Categories: geek » emacs » org

RSS - Atom - Subscribe via email

Adding a custom header argument to Org Mode source blocks and using that argument during export

| org, emacs

I sometimes want to put long source blocks in a <details><summary>...</summary>...</details> block when I export to HTML, so that they're tucked away in a collapsible block. I tried using https://github.com/alhassy/org-special-block-extras to define my own #+begin_my_details "summary text" ... #+end_my_details block, but source blocks inside my_details doesn't get fontlocked properly while in the Org file. I wanted to add a :summary attribute to the regular src blocks, and to change the HTML export to wrap the code in details if the summary was specified.

Code for adding a :summary argument and using it during export
(setq org-babel-exp-code-template "#+begin_src %lang%switches%flags :summary %summary\n%body\n#+end_src")
(defun my-org-html-src-block (src-block _contents info)
  (let* ((result (org-html-src-block src-block _contents info))
         (block-info
          (org-with-point-at (org-element-property :begin src-block)
            (org-babel-get-src-block-info)))         
         (summary (assoc-default :summary (elt block-info 2))))
    (if (member summary '("%summary" ""))
        result
      (format "<details><summary>%s</summary>%s</details>"
              summary
              result))))
(with-eval-after-load 'ox-html
  (map-put! 
   (org-export-backend-transcoders (org-export-get-backend 'html))
   'src-block 'my-org-html-src-block))

So now I can use it by specifying blocks like this:

#+begin_src emacs-lisp :summary "Code for adding a :summary argument and using it during export"
;; code goes here
#+end_src

It took me a bit of digging around to figure this out. When I added the :summary attribute, org-babel-get-src-block-info found it when I was in the Org file, but by the time my-org-html-src-block was called, the block had been replaced with a copy that didn't have the header argument. I dug around using edebug's d command for displaying the backtrace, stepping through various functions. I found out that in the process for exporting source code blocks, org-babel-exp-code replaces the source block with the value of org-babel-exp-code-template, substituting certain values. Adding the summary flag to that and retrieving the summary information using org-babel-get-src-block-info worked. I originally used advice-add to override org-html-src-block, but I think I'll try replacing the transcoder.

Adding custom header arguments could be useful for different export-related tweaks (someone wanted to create an argument for highlighting certain lines but hadn't figured it out in that thread). If there's a more elegant way to do this, I'd love to find out!

This is part of my Emacs configuration.

Moving my Org post subtree to the 11ty directory

| 11ty, org, emacs, blogging

I sometimes want to move the Org source for my blog posts to the same directory as the 11ty-exported HTML. This should make it easier to update and reexport blog posts in the future. The following code copies or moves the subtree to the 11ty export directory.

(defun my-org-11ty-copy-subtree (&optional do-cut)
  "Copy the subtree for the current post to the 11ty export directory.
With prefix arg, move the subtree."
  (interactive (list current-prefix-arg))
  (let* ((file-properties
          (org-element-map
              (org-element-parse-buffer)
              'keyword
            (lambda (el)
              (list
               (org-element-property :key el)
               (org-element-property :value el)
               (buffer-substring-no-properties
                (org-element-property :begin el)
                (org-element-property :end el))))))
         (entry-properties (org-entry-properties))
         (filename (expand-file-name
                    "index.org"
                    (expand-file-name
                     (assoc-default "EXPORT_ELEVENTY_FILE_NAME" entry-properties) 
                     (car (assoc-default "ELEVENTY_BASE_DIR" file-properties))))))
    (unless (file-directory-p (file-name-directory filename))
      (make-directory (file-name-directory filename) t))
    ;; find the heading that sets the current EXPORT_ELEVENTY_FILE_NAME
    (goto-char
     (org-find-property "EXPORT_ELEVENTY_FILE_NAME" (org-entry-get-with-inheritance "EXPORT_ELEVENTY_FILE_NAME")))
    (org-copy-subtree 1 (if do-cut 'cut))
    (with-temp-file filename
      (org-mode)
      (insert (or
               (mapconcat (lambda (file-prop) (elt file-prop 2))
                          file-properties
                          "")
               "")
              "\n")
      (org-yank))
    (find-file filename)
    (goto-char (point-min))))

Then this adds a link to it:

(defun my-org-export-filter-body-add-index-link (string backend info)
  (if (and
       (member backend '(11ty html))
       (plist-get info :file-name)
       (plist-get info :base-dir)
       (file-exists-p (expand-file-name
                       "index.org"
                       (expand-file-name
                        (plist-get info :file-name)
                        (plist-get info :base-dir)))))
      (concat string
              (format "<div><a href=\"%sindex.org\">View org source for this post</a></div>"
                      (plist-get info :permalink)))
    string))

(with-eval-after-load 'ox
  (add-to-list 'org-export-filter-body-functions #'my-org-export-filter-body-add-index-link))

Then I want to wrap the whole thing up in an export function:

(defun my-org-11ty-export (&optional async subtreep visible-only body-only ext-plist)
  (let* ((info (org-11ty--get-info subtreep visible-only))
         (file (org-11ty--base-file-name subtreep visible-only)))
    (unless (string= (plist-get info :input-file)
                     (expand-file-name
                      "index.org"
                      (expand-file-name
                       (plist-get info :file-name)
                       (plist-get info :base-dir))))
      (save-window-excursion
        (my-org-11ty-copy-subtree)))
    (org-11ty-export-to-11tydata-and-html async subtreep visible-only body-only ext-plist)
    (my-org-11ty-find-file)))

Now to figure out how to override the export menu. Totally messy hack!

(with-eval-after-load 'ox-11ty
  (map-put (caddr (org-export-backend-menu (org-export-get-backend '11ty)))
           ?o (list "To Org, JSON, HTML" 'my-org-11ty-export)))
View org source for this post

Org Mode: Including portions of files between two regular expressions

| org, emacs

I'd like to refer to snippets of code, but lines are too fragile to use as references for code and posts that I want to easily update. I'd like to specify a from-regexp and a to-regexp instead in order to collect the lines between those regexps (including the ones with the regexps themselves). org-export-expand-include-keyword looked a bit hairy to extend since it uses regular expressions to match parameter values. For this quick experiment, I decided to make a custom link type instead. This allows me to refer to parts of code with a link like this:

[[my-include:~/proj/static-blog/assets/css/style.css::from-regexp=Start of copy code&to-regexp=End of copy code&wrap=src js]]

which will turn into this snippet from my stylesheet:

/* Start of copy code */
pre.src { margin: 0 }
.org-src-container {
    position: relative;
    margin: 0 0;
    padding: 1.75rem 0 1.75rem 1rem;
}
summary { position: relative; }
summary .org-src-container { padding: 0 }
summary .org-src-container pre.src { margin: 0 }
.org-src-container button.copy-code, summary button.copy-code {
    position: absolute;
    top: 0px;
    right: 0px;
}
/* End of copy code */

Here's the Emacs Lisp code to do that. my-include-complete function reuses my-include-open to narrow to the file, and my-include-complete uses consult--line so that we can specify the prompt.

(org-link-set-parameters
 "my-include"
 :follow #'my-include-open
 :export #'my-include-export
 :complete #'my-include-complete)

(defun my-include-open (path &optional _)
  "Narrow to the region specified in PATH."
  (let (params start end)
    (if (string-match "^\\(.*+?\\)::\\(.*+\\)" path)
        (setq params (save-match-data (org-protocol-convert-query-to-plist (match-string 2 path)))
              path (match-string 1 path)))
    (find-file path)
    (setq start
          (or
           (and
            (plist-get params :from-regexp)
            (progn
              (goto-char (point-min))
              (when (re-search-forward (url-unhex-string (plist-get params :from-regexp)))
                (line-beginning-position))))
           (progn
             (goto-char (point-min))
             (point))))
    (setq end
          (or
           (and
            (plist-get params :to-regexp)
            (progn
              (when (re-search-forward (url-unhex-string (plist-get params :to-regexp)))
                (line-end-position))))
           (progn
             (goto-char (point-max))
             (point))))
    (when (or (not (= start (point-min)))
              (not (= end (point-max))))
      (narrow-to-region start end))))
    
(defun my-include-export (path _ format _)
  "Export PATH to FORMAT using the specified wrap parameter."
  (let (params body start end)
    (when (string-match "^\\(.*+?\\)::\\(.*+\\)" path)
      (setq params (save-match-data (org-protocol-convert-query-to-plist (match-string 2 path)))))
    (save-window-excursion
      (my-include-open path)
      (setq body (buffer-substring (point-min) (point-max))))
    (with-temp-buffer
      (when (plist-get params :wrap)
        (let* ((wrap (plist-get params :wrap))
               block args)
          (when (string-match "\\<\\(\\S-+\\)\\( +.*\\)?" wrap)
            (setq block (match-string 1 wrap))
            (setq args (match-string 2 wrap)) 
            (setq body (format "#+BEGIN_%s%s\n%s\n#+END_%s\n"
                               block (or args "")
                               body
                               block)))))
      (insert body)
      (org-export-as format nil nil t))))

(defun my-include-complete ()
  "Include a section of a file from one line to another, specified with regexps."
  (interactive)
  (require 'consult)
  (let ((file (read-file-name "File: ")))
    (save-window-excursion
      (find-file file)
      (concat "my-include:"
              file
              "::from-regexp="
              (let ((curr-line (line-number-at-pos
                                (point)
                                consult-line-numbers-widen))
                    (prompt "From line: "))
                (goto-char (point-min))
                (consult--line
                 (or (consult--with-increased-gc
                      (consult--line-candidates
                       nil
                       curr-line))
                     (user-error "No lines"))
                 :curr-line curr-line
                 :prompt prompt)        
                (url-hexify-string
                 (regexp-quote (buffer-substring (line-beginning-position) (line-end-position)))))
              "&to-regexp="
              (let ((curr-line (line-number-at-pos
                                (point)
                                consult-line-numbers-widen))
                    (prompt "To line: "))
                (goto-char (point-min))
                (consult--line
                 (or (consult--with-increased-gc
                      (consult--line-candidates
                       nil
                       curr-line))
                     (user-error "No lines"))
                 :curr-line curr-line
                 :prompt prompt)        
                (url-hexify-string
                 (regexp-quote (buffer-substring (line-beginning-position) (line-end-position)))))
              "&wrap=src " (replace-regexp-in-string "-mode$" "" (symbol-name major-mode))))))
This is part of my Emacs configuration.

EmacsConf backstage: Using TRAMP and timers to run two tracks semi-automatically

| emacs, emacsconf, org

In previous years, organizers streamed the video feeds for EmacsConf from their own computers to the Icecast server, which was a little challenging because of CPU load. A server shared by a volunteer had a 6-core Intel Xeon E5-2420 with 48 GB of RAM, which turned out to be enough horsepower to run OBS for both the general and development track for EmacsConf 2022. One of the advantages of this setup was that I could write some Emacs Lisp to automatically play recorded intros and talk videos at scheduled times, right from the large Org file that had all the conference details. I used SCHEDULED: properties to indicate when talks should play, and that was picked up by another function that took the Org entry properties and put them into a plist.

This function scheduled the timers:

emacsconf-stream-schedule-timers
(defun emacsconf-stream-schedule-timers (&optional info)
  "Schedule PLAYING for the rest of talks and CLOSED_Q for recorded talks."
  (interactive)
  (emacsconf-stream-cancel-all-timers)
  (setq info (emacsconf-prepare-for-display (emacsconf-filter-talks (or info (emacsconf-get-talk-info)))))
  (let ((now (current-time)))
    (mapc (lambda (talk)
            (when (and (time-less-p now (plist-get talk :start-time)))
              (emacsconf-stream-schedule-talk-status-change talk (plist-get talk :start-time) "PLAYING"
                                                            `(:title (concat "Starting " (plist-get talk :slug)))))
            (when (and
                   (plist-get talk :video-file)
                   (plist-get talk :qa-time)
                   (not (string-match "none" (or (plist-get talk :q-and-a) "none")))
                   (null (plist-get talk :stream-files)) ;; can't tell when this is
                   (time-less-p now (plist-get talk :qa-time)))
              (emacsconf-stream-schedule-talk-status-change talk (plist-get talk :qa-time) "CLOSED_Q"
                                                            `(:title (concat "Q&A for " (plist-get talk :slug) " (" (plist-get talk :q-and-a) ")"))))
            )
          info)))

It turns out that TRAMP doesn't like being called from timers if there's a chance that two TRAMP processes might run at the same time. I got "Forbidden reentrant call of Tramp" errors when that happened. There was an easy fix, though. I adjusted the schedules of the talks so that they started at least a minute apart.

Sometimes I wanted to cancel just one timer:

emacsconf-stream-cancel-timer
(defun emacsconf-stream-cancel-timer (id)
  "Cancel a timer by ID."
  (interactive (list
                (completing-read
                 "ID: "
                 (lambda (string pred action)
                    (if (eq action 'metadata)
                        `(metadata (display-sort-function . ,#'identity))
                      (complete-with-action action
                                            (sort
                                             (seq-filter (lambda (o)
                                                           (and (timerp (cdr o))
                                                                (not (timer--triggered (cdr o)))))
                                                         emacsconf-stream-timers)
                                             (lambda (a b) (string< (car a) (car b))))
                                            string pred))))))
  (when (timerp (assoc-default id emacsconf-stream-timers))
    (cancel-timer (assoc-default id emacsconf-stream-timers))
    (setq emacsconf-stream-timers
          (delq (assoc id emacsconf-stream-timers)
                (seq-filter (lambda (o)
                              (and (timerp (cdr o))
                                   (not (timer--triggered (cdr o)))))
                            emacsconf-stream-timers)))))

and schedule just one timer manually:

emacsconf-stream-schedule-talk-status-change
(defun emacsconf-stream-schedule-talk-status-change (talk time new-status &optional notification)
  "Schedule a one-off timer for TALK at TIME to set it to NEW-STATUS."
  (interactive (list (emacsconf-complete-talk-info)
                     (read-string "Time: ")
                     (completing-read "Status: " (mapcar 'car emacsconf-status-types))))
  (require 'diary-lib)
  (setq talk (emacsconf-resolve-talk talk))
  (let* ((converted
          (cond
           ((listp time) time)
           ((timer-duration time) (timer-relative-time nil (timer-duration time)))
           (t                           ; HH:MM
            (date-to-time (concat (format-time-string "%Y-%m-%d" nil emacsconf-timezone)
                                  "T"
                                  (string-pad time 5 ?0 t) 
                                  emacsconf-timezone-offset)))))
         (timer-id (concat (format-time-string "%m-%dT%H:%M" converted)
                           "-"
                           (plist-get talk :slug)
                           "-"
                           new-status)))
    (emacsconf-stream-cancel-timer timer-id) 
    (add-to-list 'emacsconf-stream-timers
                  (cons
                   timer-id
                   (run-at-time time converted #'emacsconf-stream-update-talk-status-from-timer
                                talk new-status
                                notification)))))

The actual playing of talks happened using functions that were called from org-after-todo-state-change-hook. I wrote a function that extracted the talk information and then called my own list of functions.

emacsconf-org-after-todo-state-change
(defun emacsconf-org-after-todo-state-change ()
  "Run all the hooks in `emacsconf-todo-hooks'.
If an `emacsconf-todo-hooks' entry is a list, run it only for the
tracks with the ID in the cdr of that list."
  (let* ((talk (emacsconf-get-talk-info-for-subtree))
         (track (emacsconf-get-track (plist-get talk :track))))
    (mapc
     (lambda (hook-entry)
       (cond
        ((symbolp hook-entry) (funcall hook-entry talk))
        ((member (plist-get track :id) (cdr hook-entry))
         (funcall (car hook-entry) talk))))
     emacsconf-todo-hooks)))

For example, this function played the recorded intro and the talk:

emacsconf-stream-play-talk-on-change
(defun emacsconf-stream-play-talk-on-change (talk)
  "Play the talk."
  (interactive (list (emacsconf-complete-talk-info)))
  (setq talk (emacsconf-resolve-talk talk))
  (when (or (not (boundp 'org-state)) (string= org-state "PLAYING"))
    (if (plist-get talk :stream-files)
        (progn
          (emacsconf-stream-track-ssh
           talk
           "overlay"
           (plist-get talk :slug))
          (emacsconf-stream-track-ssh
           talk
           (append
            (list
             "nohup"
             "mpv")
            (split-string-and-unquote (plist-get talk :stream-files))
            (list "&"))))
      (emacsconf-stream-track-ssh
       talk
       (cons
        "nohup"
        (cond
         ((and
           (plist-get talk :recorded-intro)
           (plist-get talk :video-file)) ;; recorded intro and recorded talk
          (message "should automatically play intro and recording")
          (list "play-with-intro" (plist-get talk :slug))) ;; todo deal with stream files
         ((and
           (plist-get talk :recorded-intro)
           (null (plist-get talk :video-file))) ;; recorded intro and live talk; play the intro and join BBB
          (message "should automatically play intro; join %s" (plist-get talk :bbb-backstage))
          (list "intro" (plist-get talk :slug)))
         ((and
           (null (plist-get talk :recorded-intro))
           (plist-get talk :video-file)) ;; live intro and recorded talk, show slide and use Mumble; manually play talk
          (message "should show intro slide; play %s afterwards" (plist-get talk :slug))
          (list "intro" (plist-get talk :slug)))
         ((and
           (null (plist-get talk :recorded-intro))
           (null (plist-get talk :video-file))) ;; live intro and live talk, join the BBB
          (message "join %s for live intro and talk" (plist-get talk :bbb-backstage))
          (list "bbb" (plist-get talk :slug)))))))))

and this function handled IRC announcements when the talk state changed:

emacsconf-erc-announce-on-change
(defun emacsconf-erc-announce-on-change (talk)
  "Announce talk."
  (let ((func
         (pcase org-state
           ("PLAYING" #'erc-cmd-NOWPLAYING)
           ("CLOSED_Q" #'erc-cmd-NOWCLOSEDQ)
           ("OPEN_Q" #'erc-cmd-NOWOPENQ)
           ("UNSTREAMED_Q" #'erc-cmd-NOWUNSTREAMEDQ)
           ("TO_ARCHIVE" #'erc-cmd-NOWDONE))))
    (when func
      (funcall func talk))))

The actual announcements were handled by something like this:

erc-cmd-NOWCLOSEDQ
(defun erc-cmd-NOWCLOSEDQ (talk)
  "Announce TALK has started Q&A, but the host has not yet opened it up."
  (interactive (list (emacsconf-complete-talk-info)))
  (when (stringp talk) (setq talk (or (emacsconf-find-talk-info talk) (error "Could not find talk %s" talk))))
  (if (emacsconf-erc-recently-announced (format "-- Q&A beginning for \"%s\"" (plist-get talk :slug)))
      (message "Recently announced, skipping")
    (emacsconf-erc-with-channels (list (concat "#" (plist-get talk :channel)))
      (erc-send-message (format "-- Q&A beginning for \"%s\" (%s) Watch: %s Add notes/questions: %s"
                                (plist-get talk :title)
                                (plist-get talk :qa-info)
                                (plist-get talk :watch-url)
                                (plist-get talk :pad-url))))  
    (emacsconf-erc-with-channels (list emacsconf-erc-hallway emacsconf-erc-org)
      (erc-send-message (format "-- Q&A beginning for \"%s\" in the %s track (%s) Watch: %s Add notes/questions: %s . Chat: #%s"
                                (plist-get talk :title)
                                (plist-get talk :track)
                                (plist-get talk :qa-info)
                                (plist-get talk :watch-url)
                                (plist-get talk :pad-url)
                                (plist-get talk :channel))))))

All that code meant that during the actual conference, my role was mostly just worrying, and occasionally starting up the Q&A (if I wasn't sure if the code would do it right). The shell scripts I wrote made it easy for the other organizers to take over the second part as they saw how it worked.

Yay timers, Emacs, and TRAMP!

You can find the latest versions of these functions in the emacsconf-el repository.

Comparison-shopping with Org Mode

| emacs, org

I don't like shopping. We're lucky to be able to choose, but I get overwhelmed with all the choices. I'm trying to get the hang of it, though, since I'll need to shop for lots of things for A- over the years. One of the things that's stressful is comparing choices between different webpages, especially if I want to get A-'s opinion on something. Between the challenge of remembering things as we flip between pages and the temptations of other products she sees along the way… Ugh.

I think there are web browser extensions for shopping, but I prefer to work within Org Mode so that I can capture links from my phone's web browser, refile entries into different categories, organize them with keyboard shortcuts, and tweak things the way I like. So if I have subheadings with the NAME, PRICE, IMAGE, and URL properties, I can make a table that looks like this:

2022-12-26_11-26-35.png

Figure 1: Comparison-shopping

using code that looks like this:

#+begin_src emacs-lisp :eval yes :exports results :wrap EXPORT html
(my-org-format-shopping-subtree)
#+end_src

and I can view the table by exporting the subtree with HTML using org-export-dispatch (C-c C-e C-s h o). When I add new items, I can use C-u C-c C-e to reexport the subtree without navigating up to the root.

Here's the very rough code I use for that:

(defun my-get-shopping-details ()
  (goto-char (point-min))
  (let (data)
    (cond
     ((re-search-forward "  data-section-data
>" nil t)
      (setq data (json-read))
      (let-alist data
        (list (cons 'name .product.title)
              (cons 'brand .product.vendor)
              (cons 'description .product.description)
              (cons 'image (concat "https:" .product.featured_image))
              (cons 'price (/ .product.price 100.0)))))
     ((and (re-search-forward "<script type=\"application/ld\\+json\">" nil t)
           (null (re-search-forward "Fabric Fabric" nil t))) ; Carter's, Columbia?
      (setq data (json-read))
      (if (vectorp data) (setq data (elt data 0)))
      (if (assoc-default '@graph data)
          (setq data (assoc-default '@graph data)))
      (if (vectorp data) (setq data (elt data 0)))
      (let-alist data
        (list (cons 'name .name)
              (cons 'url (or .url .@id))
              (cons 'brand .brand.name)
              (cons 'description .description)
              (cons 'rating .aggregateRating.ratingValue)
              (cons 'ratingCount .aggregateRating.reviewCount)
              (cons 'image (if (stringp .image) .image (elt .image 0)))
              (cons 'price
                    (assoc-default 'price (if (arrayp .offers)
                                              (elt .offers 0)
                                            .offers))))))
     ((re-search-forward "amazon.ca" nil t)
      (goto-char (point-min))
      (re-search-forward "^$")
      (let ((doc (libxml-parse-html-region (point) (point-max))))
        (list (cons 'name (dom-text (dom-by-tag doc 'title)))
              (cons 'description (dom-texts (dom-by-id doc "productDescription")))
              (cons 'image (dom-attr (dom-by-tag (dom-by-id doc "imgTagWrapperId") 'img) 'src))
              (cons 'price
                    (dom-texts (dom-by-id doc "priceblock_ourprice"))))))
     (t
      (goto-char (point-min))
      (re-search-forward "^$")
      (let* ((doc (libxml-parse-html-region (point) (point-max)))
             (result
              `((name . ,(string-trim (dom-text (dom-by-tag doc "title"))))
                (description . ,(string-trim (dom-text (dom-by-tag doc "title")))))
              ))
        (mapc (lambda (property)
                (let ((node
                       (dom-search
                        doc
                        (lambda (o)
                          (delq nil
                                (mapcar (lambda (p)
                                          (or (string= (dom-attr o 'property) p)
                                              (string-match p (or (dom-attr o 'class) ""))))
                                        (cdr property)))))))
                  (when node (add-to-list 'result (cons (car property)
                                                        (or (dom-attr node 'content)
                                                            (string-trim (dom-text node))))))))
              '((name "og:title" "pdp-product-title")
                (brand "og:brand")
                (url "og:url")
                (image "og:image")
                (description "og:description")
                (price "og:price:amount" "product:price:amount" "pdp-price-label")))
        result)
      ))))
(defun my-org-insert-shopping-details ()
  (interactive)
  (org-insert-heading)
  (save-excursion (yank))
  (my-org-update-shopping-details)
  (when (org-entry-get (point) "NAME")
    (org-edit-headline (org-entry-get (point) "NAME")))
  (org-end-of-subtree))
(defun my-org-update-shopping-details ()
  (interactive)
  (when (re-search-forward org-link-any-re (save-excursion (org-end-of-subtree)) t)
    (let* ((link (org-element-property :raw-link (org-element-context)))
           data)
      (if (string-match "theshoecompany\\|dsw" link)
          (progn
            (browse-url link)
            (org-entry-put (point) "URL" link)
            (unless (org-entry-get (point) "IMAGE")
              (org-entry-put (point) "IMAGE" (read-string "Image: ")))
            (unless (org-entry-get (point) "PRICE")
              (org-entry-put (point) "PRICE" (read-string "Price: "))))
        (setq data (with-current-buffer (url-retrieve-synchronously link)
                     (my-get-shopping-details)))
        (when data
          (let-alist data
            (org-entry-put (point) "NAME" .name)
            (org-entry-put (point) "URL" link)
            (org-entry-put (point) "BRAND" .brand)
            (org-entry-put (point) "DESCRIPTION" (replace-regexp-in-string "&#039;" "'" (replace-regexp-in-string "\n" " " (or .description ""))))
            (org-entry-put (point) "IMAGE" .image)
            (org-entry-put (point) "PRICE" (cond ((stringp .price) .price) ((numberp .price) (format "%.2f" .price)) (t ""))) 
            (if .rating (org-entry-put (point) "RATING" (if (stringp .rating) .rating (format "%.1f" .rating))))
            (if .ratingCount (org-entry-put (point) "RATING_COUNT" (if (stringp .ratingCount) .ratingCount (number-to-string .ratingCount))))
            ))))))
(defun my-org-format-shopping-subtree ()
  (concat
   "<style>body { max-width: 100% !important } #content { max-width: 100% !important } .item img { max-height: 100px; }</style><div style=\"display: flex; flex-wrap: wrap; align-items: flex-start\">"
   (string-join
    (save-excursion
      (org-map-entries
       (lambda ()
         (if (org-entry-get (point) "URL")
             (format
              "<div class=item style=\"width: 200px\"><div><a href=\"%s\"><img src=\"%s\" height=100></a></div>
<div>%s</div>
<div><a href=\"%s\">%s</a></div>
<div>%s</div>
<div>%s</div></div>"
              (org-entry-get (point) "URL")
              (org-entry-get (point) "IMAGE")
              (org-entry-get (point) "PRICE")
              (org-entry-get (point) "URL")
              (url-domain (url-generic-parse-url (org-entry-get (point) "URL")))
              (org-entry-get (point) "NAME")
              (or (org-entry-get (point) "NOTES") ""))
           ""))
       nil
       (if (org-before-first-heading-p) nil 'tree)))
    "")
   "</div>"))

At some point, it would be nice to keep track of how I feel about different return policies, and to add more rules for automatically extracting information from different websites. (org-chef might be a good model.) In the meantime, this makes it a little less stressful to look for stuff.

This is part of my Emacs configuration.

Collect my recent toots in an Org file so that I can refile them

| emacs, mastodon, org

I want to use my microblog posts on Mastodon as building blocks for longer posts on my blog. Getting them into an Org file makes it easier to link to them or refile them to other parts of my Org files so that I can build up my notes.

(use-package pandoc)
(defun my-mastodon-org-feed-formatter (entry)
  (concat "* " (pandoc-convert-stdio
                (dom-text (dom-by-tag
                           (with-temp-buffer
                             (insert "<item>"
                                     (plist-get entry :item-full-text)
                                     "</item>")
                             (xml-parse-region (point-min) (point-max)))
                           'description))
                "html" "org")
          "\n\n[" (format-time-string (cdr org-time-stamp-formats)
                                      (date-to-time (plist-get entry :pubDate)))
"]\n" (plist-get entry :link)))
(setq org-feed-alist '(("Mastodon" "https://emacs.ch/@sachac/with_replies.rss"
                        "~/sync/orgzly/toots.org" "Toots"
                        :formatter my-mastodon-org-feed-formatter)))
(defun my-org-feed-sort (pos entries)
  (save-excursion
    (goto-char pos)
    (when (looking-at org-complex-heading-regexp)
      (org-sort-entries nil ?T))))
(advice-add #'org-feed-add-items :after #'my-org-feed-sort)

Now I can use org-feed-update-all (C-c C-x g) to pull things into my toots.org file.

This is part of my Emacs configuration.

Logging sent messages to Org Mode with message-sent-hook

| org, emacs

I wanted to e-mail all the EmacsConf speakers who had already uploaded their videos, and I wanted to keep track of the fact that I'd mailed them by adding a note to the :LOGBOOK: drawer in their talk heading. That way, organizers can just look at the logbook to see if we've mailed someone instead of digging through our mailboxes.

org-store-log-note assumes that it's called from the log buffer created by org-add-log-note. It doesn't seem to have a smaller function that can be called to store notes non-interactively, but that's okay. We can just set up the correct markers and call it from a temporary buffer.

(defun emacsconf-add-to-logbook (note)
  "Add NOTE as a logbook entry for the current subtree."
  (move-marker org-log-note-return-to (point))
  (move-marker org-log-note-marker (point))
  (with-temp-buffer
    (insert note)
    (let ((org-log-note-purpose 'note))
      (org-store-log-note))))

Then it's convenient to have a function that adds a note to a specified talk:

(defun emacsconf-add-to-talk-logbook (talk note)
  "Add NOTE as a logbook entry for TALK."
  (interactive (list (emacsconf-complete-talk) (read-string "Note: ")))
  (save-excursion
    (emacsconf-with-talk-heading talk
      (emacsconf-add-to-logbook note))))

I discard many drafts on the way to finalizing the process, so I want the note to be stored only after I actually send the mail. That's the job of message-sent-hook. My mail merge function calls compose-mail, sets up the body of the buffer, and then adds a lambda function to message-sent-hook to file the note in the logbook when sent.

(add-hook 'message-sent-hook
          `(lambda ()
             (mapc
              (lambda (o)
                (emacsconf-add-to-talk-logbook o "Sent speaker-after-video email"))
              (list ,@(mapcar (lambda (talk) (plist-get talk :slug)) talks))))
          nil t)

To see the mail merge code in context, you can check out the TODO entry at https://emacsconf.org/2022/organizers-notebook/#speaker-after-video . It uses functions from emacsconf.el and emacsconf-mail.el at https://git.emacsconf.org/emacsconf-el/ .