Tyblog

(defun weblorg-input-aggregate-with-navigation (posts)
  "Add next and previous links to each post in POSTS.
POSTS should be sorted in reverse chronological order (newest first).
Returns a list in the same format as weblorg-input-aggregate-each."
  (let* ((sorted-posts (sort (copy-sequence posts) #'weblorg--compare-posts-desc))
         (len (length sorted-posts)))
    (cl-loop for i from 0 below len
             for post = (nth i sorted-posts)
             collect
             (let ((post-with-nav (copy-alist post)))
               (when (> i 0)
                 (let ((next-post (nth (1- i) sorted-posts)))
                   (push (cons "next"
                               `(("title" . ,(cdr (assoc "title" next-post)))
                                 ("file_slug" . ,(cdr (assoc "file_slug" next-post)))))
                         post-with-nav)))
               (when (< i (1- len))
                 (let ((prev-post (nth (1+ i) sorted-posts)))
                   (push (cons "prev"
                               `(("title" . ,(cdr (assoc "title" prev-post)))
                                 ("file_slug" . ,(cdr (assoc "file_slug" prev-post)))))
                         post-with-nav)))
               `(("post" . ,post-with-nav))))))

(defun tjl/weblorg-parse-org-file-extras (input-path)
  "Like weblorg--parse-org but more fields for static site gen."
  (let* ((input-data (with-temp-buffer
                       (insert-file-contents input-path)
                       (buffer-string)))
         (org-tree (with-temp-buffer
                     (insert input-data)
                     (org-element-parse-buffer)))
         ;; I desperately wish that I didn't have to parse it twice,
         ;; but the interaction between `copy-tree` and
         ;; `org-element-map` is unreliable.
         (excerpt-tree (org-remove-image-links
                        (weblorg--extract-excerpt-from-tree
                         (with-temp-buffer
                           (insert input-data)
                           (org-element-parse-buffer)))))
         ;; Get standard parse results
         (keywords (with-temp-dir-file tmpfile "tjl-weblorg"
                                       (file-name-base input-path)
                                       (org-element-interpret-data
                                        (remove-first-horizontal-rule org-tree))
                                       (weblorg--parse-org-file tmpfile)))
         (words (org-prose-word-count org-tree))
         ;; Convert excerpt tree back to org syntax
         (excerpt-org (when excerpt-tree
                        (with-temp-buffer
                          (insert (org-element-interpret-data excerpt-tree))
                          (buffer-string)))))
    ;; If we got an excerpt, parse it to HTML and add to keywords
    (when excerpt-org
      (let ((excerpt-html 
             (with-temp-buffer
               (insert excerpt-org)
               (org-export-as 'html nil nil t))))
        (push (cons "excerpt" excerpt-html) keywords)))
    (push (cons "words" (cl-format nil "~:d" words)) keywords)
    (push (cons "reading_minutes" (max 1 (/ words 233))) keywords)
    keywords))

(defun org-prose-word-count (element)
  "Count words in prose sections of an org-mode ELEMENT tree.
ELEMENT should be the result of `org-element-parse-buffer'.
Returns number of words in regular paragraphs, excluding source blocks,
drawers, and other metadata."
  (let ((word-count 0))
    (org-element-map element '(paragraph plain-text)
      (lambda (elem)
        ;; Only process paragraphs that aren't inside special blocks
        (when (and (eq (org-element-type elem) 'paragraph)
                   (not (member (org-element-type (org-element-property :parent elem))
                                '(src-block example-block verse-block
                                            quote-block center-block comment-block
                                            drawer property-drawer keyword))))
          (cl-incf word-count
                   (count-words-string
                    (org-element-interpret-data elem))))))
    word-count))

(defun count-words-string (str)
  "Count words in STR, considering only regular prose words."
  (with-temp-buffer
    (insert str)
    ;; Remove any remaining org markup
    (goto-char (point-min))
    (while (re-search-forward "\\[\\[.*?\\]\\]\\|\\[.*?\\]" nil t)
      (replace-match " "))
    ;; Count remaining words
    (count-words (point-min) (point-max))))

(defun remove-first-horizontal-rule (tree)
  "Remove the first horizontal rule from an org-element tree.
The tree should be obtained from `org-element-parse-buffer'."
  (let ((found nil))
    (org-element-map tree 'horizontal-rule
      (lambda (hr)
        (unless found
          (setq found t)
          (org-element-set-element
           hr
           (org-element-create 'paragraph))))
      nil nil t))
  tree)

(defun weblorg--find-horizontal-rule (tree)
  "Find first horizontal rule in parsed org TREE.
Returns the position of the horizontal rule, or nil if none found."
  (org-element-map tree 'horizontal-rule
    (lambda (hr)
      (org-element-property :begin hr))
    nil t)) ; use t to stop after first match

(defun weblorg--truncate-tree-at-pos (tree pos)
  "Truncate org element TREE at position POS."
  (org-element-map tree '(section paragraph plain-list table special-block)
    (lambda (element)
      (let ((elem-end (org-element-property :end element)))
        (when (<= elem-end pos)
          element)))
    nil nil nil t)) ; Keep all matches, don't filter nil

(defun weblorg--extract-excerpt-from-tree (tree)
  "Extract excerpt from org TREE up to first horizontal rule.
Returns the excerpt as a new org element tree."
  (let ((hr-pos (weblorg--find-horizontal-rule tree)))
    (if hr-pos
        (weblorg--truncate-tree-at-pos tree hr-pos)
      tree))) ; If no horizontal rule, use entire tree

(defmacro with-temp-dir-file (file-var prefix name content &rest body)
  "Create a temporary file in a new directory, execute BODY, then clean up.
FILE-VAR is bound to the temp file path during execution.
PREFIX and SUFFIX are passed to `make-temp-file'.
CONTENT is written to the file before BODY executes."
  (declare (indent 1))
  (let ((temp-dir-sym (make-symbol "temp-dir")))
    `(let* ((,temp-dir-sym (make-temp-file ,prefix t))
            (,file-var (expand-file-name ,name ,temp-dir-sym)))
       (unwind-protect
           (progn 
             (with-temp-file ,file-var
               (insert ,content))
             ,@body)
         (delete-directory ,temp-dir-sym t)))))

(defun org-remove-image-links (element)
  "Remove all image link elements from an org-element tree.
ELEMENT is the root of the tree, as returned by `org-element-parse-buffer'.
Returns a new tree with all image links removed."
  (org-element-map element t
    (lambda (node)
      (when (and (eq 'link (org-element-type node))
                 (string-match-p (rx bos (or "file" "http" "https"))
                                 (org-element-property :type node))
                 (string-match-p (rx "." (or "jpg" "jpeg" "png" "gif" "svg" "webp") eos)
                                 (org-element-property :path node)))
        (org-element-extract-element node)))
    nil nil t)
  element)