emacs -Q \
    --batch \
    -l publish.el \
    -f org-publish-all

;; [[https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting/38515#38515][org-mode batch export: Missing syntax highlighting - Emacs Stack Exchange]]
(require 'font-lock)
(require 'subr-x) ;; for `when-let'

(require 'fish-mode)
;; (require 'sh-script)
(require 'ob-shell)

(require 'lua-mode)
(require 'typescript-mode)
(require 'ob-typescript)

(org-babel-do-load-languages
 'org-babel-load-languages
 `(;; (fish . t)
   (shell . t)
   (typescript . t)
   (emacs-lisp . t)
   (dart . t)))

(progn
  (font-lock-add-keywords
   'emacs-lisp-mode
   (append
    `(;; custom Doom cookies
      ("^;;;###\\(autodef\\|if\\|package\\)[ \n]" (1 font-lock-warning-face t)))
    ;; Shorten the :pin of `package!' statements to 10 characters
    `(("(package!\\_>" (0 font-lock-keyword-face)))
    `(("(use-package!\\_>" (0 font-lock-keyword-face)))
    )))

(unless (boundp 'maximal-integer)
  (defconst maximal-integer (lsh -1 -1)
    "Maximal integer value representable natively in emacs lisp."))

(defun face-spec-default (spec)
  "Get list containing at most the default entry of face SPEC.
Return nil if SPEC has no default entry."
  (let* ((first (car-safe spec))
         (display (car-safe first)))
    (when (eq display 'default)
      (list (car-safe spec)))))

(defun face-spec-min-color (display-atts)
  "Get min-color entry of DISPLAY-ATTS pair from face spec."
  (let* ((display (car-safe display-atts)))
    (or (car-safe (cdr (assoc 'min-colors display)))
        maximal-integer)))

(defun face-spec-highest-color (spec)
  "Search face SPEC for highest color.
That means the DISPLAY entry of SPEC
with class 'color and highest min-color value."
  (let ((color-list (cl-remove-if-not
                     (lambda (display-atts)
                       (when-let ((display (car-safe display-atts))
                                  (class (and (listp display)
                                              (assoc 'class display)))
                                  (background (assoc 'background display)))
                         (and (member 'light (cdr background))
                              (member 'color (cdr class)))))
                     spec)))
    (cl-reduce (lambda (display-atts1 display-atts2)
                 (if (> (face-spec-min-color display-atts1)
                        (face-spec-min-color display-atts2))
                     display-atts1
                   display-atts2))
               (cdr color-list)
               :initial-value (car color-list))))

(defun face-spec-t (spec)
  "Search face SPEC for fall back."
  (cl-find-if (lambda (display-atts)
                (eq (car-safe display-atts) t))
              spec))

(defun my-face-attribute (face attribute &optional frame inherit)
  "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'."
  (let* ((face-spec (face-user-default-spec face))
         (display-attr (or (face-spec-highest-color face-spec)
                           (face-spec-t face-spec)))
         (attr (cdr display-attr))
         (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr))))))
    ;; (message "attribute: %S" attribute) ;; for debugging
    (when (and (null (eq attribute :inherit))
               (null val))
      (let ((inherited-face (my-face-attribute face :inherit)))
        (when (and inherited-face
                   (null (eq inherited-face 'unspecified)))
          (setq val (my-face-attribute inherited-face attribute)))))
    ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging
    (or val 'unspecified)))

(advice-add 'face-attribute :override #'my-face-attribute)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Debugging:
(defmacro print-args-and-ret (fun)
  "Prepare FUN for printing args and return value."
  `(advice-add (quote ,fun) :around
    (lambda (oldfun &rest args)
      (let ((ret (apply oldfun args)))
        (message ,(concat "Calling " (symbol-name fun) " with args %S returns %S.") args ret)
        ret))
    '((name "print-args-and-ret"))))

;; (print-args-and-ret htmlize-faces-in-buffer)
;; (print-args-and-ret htmlize-get-override-fstruct)
;; (print-args-and-ret htmlize-face-to-fstruct)
;; (print-args-and-ret htmlize-attrlist-to-fstruct)
;; (print-args-and-ret face-foreground)
;; (print-args-and-ret face-background)
;; (print-args-and-ret face-attribute)

(require 'org-roam)

(setq org-roam-db-location "~/doomemacs/.local/cache/org-roam.db")

(defun collect-backlinks-string (backend)
  (when (org-roam-node-at-point)
    (let* ((source-node (org-roam-node-at-point))
           (source-file (org-roam-node-file source-node))
           (nodes-in-file (--filter (s-equals? (org-roam-node-file it) source-file)
                                    (org-roam-node-list)))
           (nodes-start-position (-map 'org-roam-node-point nodes-in-file))
           ;; Nodes don't store the last position, so get the next headline position
           ;; and subtract one character (or, if no next headline, get point-max)
           (nodes-end-position (-map (lambda (nodes-start-position)
                                       (goto-char nodes-start-position)
                                       (if (org-before-first-heading-p) ;; file node
                                           (point-max)
                                         ('org-forward-heading-same-level)
                                         (if (> (point) nodes-start-position)
                                             (- (point) 1) ;; successfully found next
                                           (point-max)))) ;; there was no next
                                     nodes-start-position))
           ;; sort in order of decreasing end position
           (nodes-in-file-sorted (->> (-zip nodes-in-file nodes-end-position)
                                      (--sort (> (cdr it) (cdr other))))))
      (dolist (node-and-end nodes-in-file-sorted)
        (-when-let* (((node . end-position) node-and-end)
                     (backlinks (--filter (->> (org-roam-backlink-source-node it)
                                               (org-roam-node-file)
                                               (s-contains? "private/") (not))
                                          (org-roam-backlinks-get node)))
                     (heading (format "\n\n%s Backlinks\n"
                                      (s-repeat (+ (org-roam-node-level node) 1) "*")))
                     (properties-drawer ":PROPERTIES:\n:HTML_CONTAINER_CLASS: references\n:END:\n"))
          (goto-char end-position)
          (insert heading)
          (insert properties-drawer)
          (dolist (backlink backlinks)
            (let* ((source-node (org-roam-backlink-source-node backlink))
                   (source-file (org-roam-node-file source-node))
                   (properties (org-roam-backlink-properties backlink))
                   (outline (when-let ((outline (plist-get properties :outline)))
                              (when (> (length outline) 1)
                                (mapconcat #'org-link-display-format outline " > "))))
                   (point (org-roam-backlink-point backlink))
                   (text  (org-roam-preview-get-contents
                           source-file
                           point))
                   (reference (format "\n ----- \n%s [[id:%s][%s]]\n%s\n%s\n\n"
                                      (s-repeat (+ (org-roam-node-level node) 2) "*")
                                      (org-roam-node-id source-node)
                                      (org-roam-node-title source-node)
                                      (if outline (format "%s (/%s/)"
                                                          (s-repeat (+ (org-roam-node-level node) 3) "*") outline) "")
                                      text))
                   (label-list (with-temp-buffer
                                 (insert text)
                                 (org-element-map (org-element-parse-buffer) 'footnote-reference
                                   (lambda (reference)
                                     (org-element-property :label reference)))))
                   (footnote-string-list
                    (with-temp-buffer
                      (insert-file-contents source-file)
                      (-map (lambda (label) (buffer-substring-no-properties
                                             (nth 1 (org-footnote-get-definition label))
                                             (nth 2 (org-footnote-get-definition label))))
                            label-list))))
              (-map (lambda (footnote-string) (insert footnote-string)) footnote-string-list)
              (insert reference))))))))

(add-hook 'org-export-before-processing-hook 'collect-backlinks-string)