Categories: geek » emacs » org

RSS - Atom - Subscribe via email

EmacsConf backstage: capturing submissions from e-mails

| emacsconf, emacs, org

2023-09-11: Updated code for recognizing fields.

People submit proposals for EmacsConf sessions via e-mail following this submission template. (You can still submit a proposal until Sept 14!) I mostly handle acceptance and scheduling, so I copy this information into our private conf.org file so that we can use it to plan the draft schedule, mail-merge speakers, and so on. I used to do this manually, but I'm experimenting with using functions to create the heading automatically so that it includes the date, talk title, and e-mail address from the e-mail, and it calculates the notification date for early acceptances as well. I use Notmuch for e-mail, so I can get the properties from (notmuch-show-get-message-properties).

2023-09-05_13-09-57.png
Figure 1: E-mail submission

emacsconf-mail-add-submission: Add the submission from the current e-mail.
(defun emacsconf-mail-add-submission (slug)
  "Add the submission from the current e-mail."
  (interactive "MTalk ID: ")
  (let* ((props (notmuch-show-get-message-properties))
         (from (or (plist-get (plist-get props :headers) :Reply-To)
                   (plist-get (plist-get props :headers) :From)))
         (body (plist-get
                (car
                 (plist-get props :body))
                :content))
         (date (format-time-string "%Y-%m-%d"
                                   (date-to-time (plist-get (plist-get props :headers) :Date))))
         (to-notify (format-time-string
                     "%Y-%m-%d"
                     (time-add
                      (days-to-time emacsconf-review-days)
                      (date-to-time (plist-get (plist-get props :headers) :Date)))))
         (data (emacsconf-mail-parse-submission body)))
    (when (string-match "<\\(.*\\)>" from)
      (setq from (match-string 1 from)))
    (with-current-buffer
        (find-file emacsconf-org-file)
      ;;  go to the submissions entry
      (goto-char (org-find-property "CUSTOM_ID" "submissions"))
      (when (org-find-property "CUSTOM_ID" slug)
        (error "Duplicate talk ID")))
    (find-file emacsconf-org-file)
    (delete-other-windows)
    (outline-next-heading)
    (org-insert-heading)
    (insert " " (or (plist-get data :title) "") "\n")
    (org-todo "TO_REVIEW")
    (org-entry-put (point) "CUSTOM_ID" slug)
    (org-entry-put (point) "SLUG" slug)
    (org-entry-put (point) "TRACK" "General")
    (org-entry-put (point) "EMAIL" from)
    (org-entry-put (point) "DATE_SUBMITTED" date)
    (org-entry-put (point) "DATE_TO_NOTIFY" to-notify)
    (when (plist-get data :time)
      (org-entry-put (point) "TIME" (plist-get data :time)))
    (when (plist-get data :availability)
      (org-entry-put (point) "AVAILABILITY"
                     (replace-regexp-in-string "\n+" " "
                                               (plist-get data :availability))))
    (when (plist-get data :public)
      (org-entry-put (point) "PUBLIC_CONTACT"
                     (replace-regexp-in-string "\n+" " "
                                               (plist-get data :public))))
    (when (plist-get data :private)
      (org-entry-put (point) "EMERGENCY"
                     (replace-regexp-in-string "\n+" " "
                                               (plist-get data :private))))
    (when (plist-get data :q-and-a)
      (org-entry-put (point) "Q_AND_A"
                     (replace-regexp-in-string "\n+" " "
                                               (plist-get data :q-and-a))))
    (save-excursion
      (insert (plist-get data :body)))
    (re-search-backward org-drawer-regexp)
    (org-fold-hide-drawer-toggle 'off)
    (org-end-of-meta-data)
    (split-window-below)))

emacsconf-mail-parse-submission: Extract data from EmacsConf 2023 submissions in BODY.
(defun emacsconf-mail-parse-submission (body)
  "Extract data from EmacsConf 2023 submissions in BODY."
  (when (listp body) (setq body (plist-get (car body) :content)))
  (let ((data (list :body body))
        (fields '((:title "^[* ]*Talk title")
                  (:description "^[* ]*Talk description")
                  (:format "^[* ]*Format")
                  (:intro "^[* ]*Introduction for you and your talk")
                  (:name "^[* ]*Speaker name")
                  (:availability "^[* ]*Speaker availability")
                  (:q-and-a "^[* ]*Preferred Q&A approach")
                  (:public "^[* ]*Public contact information")
                  (:private "^[* ]*Private emergency contact information")
                  (:release "^[* ]*Please include this speaker release"))))
    (with-temp-buffer
      (insert body)
      (goto-char (point-min))
      ;; Try to parse it
      (while fields
        ;; skip the field title
        (when (and (or (looking-at (cadar fields))
                       (re-search-forward (cadar fields) nil t))
                   (re-search-forward "\\(:[ \t\n]+\\|\n\n\\)" nil t))
          ;; get the text between this and the next field
          (setq data (plist-put data (caar fields)
                                (buffer-substring (point)
                                                  (or
                                                   (when (and (cdr fields)
                                                              (re-search-forward (cadr (cadr fields)) nil t))
                                                     (goto-char (match-beginning 0))
                                                     (point))
                                                   (point-max))))))
        (setq fields (cdr fields)))
      (if (string-match "[0-9]+" (or (plist-get data :format) ""))
          (plist-put data :time (match-string 0 (or (plist-get data :format) ""))))
      data)))

The functions above are in the emacsconf-el repository. When I call emacsconf-mail-parse-submission and give it the talk ID I want to use, it makes the Org entry.

2023-09-05_13-12-34.png
Figure 2: Creating the entry

We store structured data in Org Mode properties such as NAME, EMAIL and EMERGENCY. I tend to make mistakes when typing, so I have a short function that sets an Org property based on a region. This is the code from my personal config:

my-org-set-property: In the current entry, set PROPERTY to VALUE.
(defun my-org-set-property (property value)
  "In the current entry, set PROPERTY to VALUE.
Use the region if active."
  (interactive (list (org-read-property-name)
                     (when (region-active-p) (replace-regexp-in-string "[ \n\t]+" " " (buffer-substring (point) (mark))))))
  (org-set-property property value))

I've bound it to C-c C-x p. This is what it looks like when I use it:

output-2023-09-05-13:13:30.gif
Figure 3: Setting Org properties from the region

That helps me reduce errors in entering data. I sometimes forget details, so I ask other people to double-check my work, especially when it comes to speaker availability. That's how I copy the submission e-mails into our Org file.

Using Org Mode tables and Emacs Lisp to create Minecraft Java JSON command books

| minecraft, org, emacs, play
  • [2023-04-12 Wed]: Remove / from the beginning so that I can use this in a function. Split book function into JSON and command. Updated effects to hide particles.
  • [2023-04-10 Mon]: Separated trident into channeling and riptide.

A+ likes playing recent Minecraft snapshots because of the new features. The modding systems haven't been updated for the snaphots yet, so we couldn't use mods like JourneyMap to teleport around. I didn't want to be the keeper of coordinates and be in charge of teleporting people to various places.

It turns out that you can make clickable books using JSON. I used the Minecraft book editor to make a prototype book and figure out the syntax. Then I used a command block to give it to myself in order to work around the length limits on commands in chat. A+ loved being able to carry around a book that could teleport her to either of us or to specified places, change the time of day, clear the weather, and change game mode. That also meant that I no longer had to type all the commands to give her water breathing, night vision, or slow falling, or give her whatever tools she forgot to pack before she headed out. It was so handy, W- and I got our own copies too.

Manually creating the clickable targets was annoying, especially since we wanted the book to have slightly different content depending on the instance we were in. I wanted to be able to specify the contents using Org Mode tables and generate the JSON for the book using Emacs.

Here's a screenshot:

2023-04-09_10-09-48.png
Figure 1: Screenshot of command book

This is the code to make it:

(defun my-minecraft-remove-markup (s)
  (if (string-match "^[=~]\\(.+?\\)[=~]$" s)
      (match-string 1 s)
    s))

(defun my-minecraft-book-json (title author book)
  "Generate the JSON for TITLE AUTHOR BOOK.
BOOK should be a list of lists of the form (text click-command color)."
  (json-encode
   `((pages . 
            ,(apply 'vector
                    (mapcar
                     (lambda (page)
                       (json-encode
                        (apply 'vector 
                               (seq-mapcat
                                (lambda (command)
                                  (let ((text (my-minecraft-remove-markup (or (elt command 0) "")))
                                        (click (my-minecraft-remove-markup (or (elt command 1) "")))
                                        (color (or (elt command 2) "")))
                                    (unless (or (string-match "^<.*>$" text)
                                                (string-match "^<.*>$" click)
                                                (string-match "^<.*>$" color))
                                      (list
                                       (append
                                        (list (cons 'text text))
                                        (unless (string= click "")
                                          `((clickEvent 
                                             (action . "run_command")
                                             (value . ,(concat "/" click)))))                                    
                                        (unless (string= color "")
                                          (list (cons 'color
                                                      color))))
                                       (if (string= color "")
                                           '((text . "\n"))
                                         '((text . "\n")
                                           (color . "reset")))))))
                                page))))
                     (seq-partition book 14)
                     )))
     (author . ,author)
     (title . ,title))))

(defun my-minecraft-book (title author book)
  "Generate a command to put into a command block in order to get a book.
Label it with TITLE and AUTHOR.
BOOK should be a list of lists of the form (text click-command color).
Copy the command text to the kill ring for pasting into a command block."
  (let ((s (concat "item replace entity @p weapon.mainhand with written_book"
                   (my-minecraft-book-json title author book))))
    (kill-new s)
    s))

With this code, I can generate a simple book like this:

(my-minecraft-book "Simple book" "sachac"
                   '(("Daytime" "set time 0800")
                     ("Creative" "gamemode creative" "#0000cd")))
item replace entity @p weapon.mainhand with written_book{"pages":["[{\"text\":\"Daytime\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/set time 0800\"}},{\"text\":\"\\n\"},{\"text\":\"Creative\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/gamemode creative\"},\"color\":\"#0000cd\"},{\"text\":\"\\n\",\"color\":\"reset\"}]"],"author":"sachac","title":"Simple book"}

To place it in the world:

  1. I changed my server.properties to set enable-command-block=true.
  2. In the game, I used /gamemode creative to switch to creative mode.
  3. I used /give @p minecraft:command_block to give myself a command block.
  4. I right-clicked an empty place to set the block there.
  5. I right-clicked on the command block and pasted in the command.
  6. I added a button.

Then I clicked on the button and it replaced whatever I was holding with the book. I used item replace instead of give so that it's easy to replace old versions.

On the Org Mode side, it's much nicer to specify commands in a named table. For example, if I name the following table with #+name: mc-quick, I can refer to it with :var quick=mc-quick in the Emacs Lisp source block. (You can check the Org source for this post if that makes it easier to understand.)

Daytime time set 0800  
Clear weather weather clear  
Creative gamemode creative #0000cd
Survival gamemode survival #ff4500
Spectator gamemode spectator #228b22
(my-minecraft-book "Book from table" "sachac" quick)
item replace entity @p weapon.mainhand with written_book{"pages":["[{\"text\":\"Daytime\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/time set 0800\"}},{\"text\":\"\\n\"},{\"text\":\"Clear weather\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/weather clear\"}},{\"text\":\"\\n\"},{\"text\":\"Creative\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/gamemode creative\"},\"color\":\"#0000cd\"},{\"text\":\"\\n\",\"color\":\"reset\"},{\"text\":\"Survival\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/gamemode survival\"},\"color\":\"#ff4500\"},{\"text\":\"\\n\",\"color\":\"reset\"},{\"text\":\"Spectator\",\"clickEvent\":{\"action\":\"run_command\",\"value\":\"/gamemode spectator\"},\"color\":\"#228b22\"},{\"text\":\"\\n\",\"color\":\"reset\"}]"],"author":"sachac","title":"Book from table"}

Then I can define several named tables and append them together. Here's one for different effects:

Water breathing effect give @p minecraft:water_breathing infinite 255 true  
Night vision effect give @p minecraft:night_vision infinite 255 true  
Regeneration effect give @p minecraft:regeneration infinite 255 true  
Haste effect give @p minecraft:haste infinite 2 true  
Health boost effect give @p minecraft:health_boost infinite 255 true  
Slow falling effect give @p minecraft:slow_falling infinite 255 true  
Fire resist effect give @p minecraft:fire_resistance infinite 255 true  
Resistance effect give @p minecraft:resistance infinite 255 true  
Clear effects effect clear @p  

Some commands are pretty long. Specifying a width like <20> in the first row lets me use C-c TAB to toggle width.

Pickaxe give @p minecraft:diamond_pickaxe{Enchantments:[{id:"minecraft:fortune",lvl:4s},{id:"minecraft:mending",lvl:1s},{id:"minecraft:efficiency",lvl:4s}]}  
Silk touch pickaxe give @p minecraft:diamond_pickaxe{Enchantments:[{id:"minecraft:silk_touch",lvl:1s},{id:"minecraft:mending",lvl:1s}]}  
Sword give @p minecraft:diamond_sword{Enchantments:[{id:"minecraft:looting",lvl:4s},{id:"minecraft:mending",lvl:1s}]}  
Axe give @p minecraft:diamond_axe{Enchantments:[{id:"minecraft:looting",lvl:4s},{id:"minecraft:mending",lvl:1s}]}  
Shovel give @p minecraft:diamond_shovel{Enchantments:[{id:"minecraft:fortune",lvl:4s},{id:"minecraft:mending",lvl:1s},{id:"minecraft:efficiency",lvl:4s}]}  
Bow give @p minecraft:bow{Enchantments:[{id:"minecraft:infinity",lvl:1s},{id:"minecraft:mending",lvl:1s}]}  
Arrows give @p minecraft:arrow 64  
Torches give @p minecraft:torch 64  
Fishing give @p minecraft:fishing_rod{Enchantments:[{id:"minecraft:lure",lvl:4s},{id:"minecraft:luck_of_the_sea",lvl:4s},{id:"minecraft:mending",lvl:1s}]}  
Riptide trident give @p minecraft:trident{Enchantments:[{id:"minecraft:loyalty",lvl:4s},{id:"minecraft:mending",lvl:1s},{id:"minecraft:riptide",lvl:4s}]}  
Channeling trident give @p minecraft:trident{Enchantments:[{id:"minecraft:loyalty",lvl:4s},{id:"minecraft:mending",lvl:1s},{id:"minecraft:channeling",lvl:1s}]}  
Weather rain weather rain  
Weather thunder weather thunder  
Birch signs give @p minecraft:birch_sign 16  
Bucket of water give @p minecraft:water_bucket  
Bucket of milk give @p minecraft:milk_bucket  
Bucket of lava give @p minecraft:lava_bucket  
Water bottles give @p minecraft:potion{Potion:"minecraft:water"} 3  
Blaze powder give @p minecraft:blaze_powder 16  
Brewing stand give @p minecraft:brewing_stand  
Magma cream give @p minecraft:magma_cream  

Here's what that table looks like in Org Mode:

2023-04-10_09-55-57.png
Figure 2: With column width

Here's how to combine multiple tables:

#+begin_src emacs-lisp :results silent :var quick=mc-quick :var effects=mc-effects :var items=mc-items :exports code
(my-minecraft-book "Book from multiple tables" "sachac" (append quick effects items))
#+end_src

Now producing instance-specific books is just a matter of including the sections I want, like a table that has coordinates for different bases in that particular instance.

I thought about making an Org link type for click commands and some way of exporting that will convert to JSON and keep the whitespace. That way, I might be able to write longer notes and export them to Minecraft book JSON for in-game references, such as notes on villager blocks or potion ingredients. The table + Emacs Lisp approach is already quite useful for quick shortcuts, though, and it was easy to write. We'll see if we need more fanciness!

View org source for this post

Using rubik.el to make SVG last-layer diagrams from algorithms

| cubing, emacs, org

So I checked out emacs-cube, but I had a hard time figuring out how to work with the data model without getting into all the rendering because it figures "left" and "right" based on camera position. rubik.el seemed like an easier starting point. As far as I can tell, the rubik-cube-state local variable is an array with the faces specified as 6 groups of 9 integers in this order: top, front, right, back, left, bottom, with cells specified from left to right, top to bottom.

First, I wanted to recolour rubik so that it matched the setup of the Roofpig JS library I'm using for animations.

(defconst my-cubing-rubik-faces "YRGOBW")
;; make it match roofpig's default setup with yellow on top and red in front
(defconst rubik-faces [rubik-yellow
                       rubik-red
                       rubik-green
                       rubik-orange
                       rubik-blue
                       rubik-white])

Here are some functions to apply an algorithm (or actually, the inverse of the algorithm, which is useful for exploring a PLL case):

(defun my-cubing-normalize (alg)
  "Remove parentheses and clean up spaces in ALG."
  (string-trim
   (replace-regexp-in-string "[() ]+" " " alg)))

(defun my-cubing-reverse-alg (alg)
  "Reverse the given ALG."
  (mapconcat
   (lambda (step)
     (if (string-match "\\`\\([rludfsbRLUDFSBxyz]\\)\\(['i]\\)?\\'" step)
         (concat (match-string 1 step)
                 (if (match-string 2 step)
                     ""
                   "'"))
       step))
   (reverse
    (split-string (my-cubing-normalize alg) " "))
   " "))

(defun my-cubing-rubik-alg (alg)
  "Apply the reversed ALG to a solved cube.
Return the rubik.el cube state."
  (let ((reversed (my-cubing-reverse-alg alg)))
    (seq-reduce
     (lambda (cube o)
       (when (intern (format "rubik-%s"
                             (replace-regexp-in-string "'" "i" o)))
         (unless (string= o "")
           (rubik-apply-transformation
            cube
            (symbol-value
             (intern
              (format "rubik-%s"
                      (replace-regexp-in-string "'" "i" o)))))))
       cube)
     (split-string reversed " ")
     (rubik-make-initial-cube))))

Then I got the strings specifying the side colours and the top colours in the format that I needed for the SVG diagrams. I'm optimistically using number-sequence here instead of hard-coding the numbers so that I can figure out how to extend the idea for 4x4 someday.

(defun my-cubing-rubik-top-face-strings (&optional cube)
  ;; edges starting from back left
  (let ((cube (or cube rubik-cube-state)))
    (list
     (mapconcat
      (lambda (i)
        (char-to-string (elt my-cubing-rubik-faces (aref cube i))))
      (append
       (reverse (number-sequence (* 3 9) (+ 2 (* 3 9))))
       (reverse (number-sequence (* 2 9) (+ 2 (* 2 9))))
       (reverse (number-sequence (* 1 9) (+ 2 (* 1 9))))
       (reverse (number-sequence (* 4 9) (+ 2 (* 4 9))))))
     (mapconcat
      (lambda (i)
        (char-to-string (elt my-cubing-rubik-faces (aref cube i))))
      (number-sequence 0 8)))))

Then theoretically, it can make a diagram like this:

(defun my-cubing-rubik-last-layer-with-sides-from-alg (alg &optional arrows)
  (apply 'my-cubing-last-layer-with-sides
         (append
          (my-cubing-rubik-top-face-strings (my-cubing-rubik-alg alg))
          (list
           arrows))))

So I can invoke it with:

(my-cubing-rubik-last-layer-with-sides-from-alg
 "R U R' F' R U R' U' R' F R2 U' R' U'"
 '((1 7 t) (2 8 t)))
last-layer.svg

It's also nice to be able to interactively step through the algorithm. I prefer a more compact view of the undo/redo state.

;; Override undo information
(defun rubik-display-undo ()
  "Insert undo information at point."
  (cl-loop with line-str = "\nUndo: "
           for cmd in (reverse (cdr rubik-cube-undo))
           for i = 1 then (1+ i)
           do (progn
                (setq line-str (concat line-str (format "%s " (get cmd 'name))))
                (when (> (length line-str) fill-column)
                  (insert line-str)
                  (setq line-str (concat "\n" (make-string 6 ?\s)))))
           finally (insert line-str)))

;; Override redo information
(defun rubik-display-redo ()
  "Insert redo information at point."
  (cl-loop with line-str = "\nRedo: "
           for cmd in (cdr rubik-cube-redo)
           for i = 1 then (1+ i)
           do (progn
                (setq line-str (concat line-str (format "%s " (get cmd 'name))))
                (when (> (length line-str) fill-column)
                  (insert line-str)
                  (setq line-str (concat "\n" (make-string 6 ?\s)))))
           finally (insert line-str)))
  
(defun my-cubing-convert-alg-to-rubik-commands (alg)
  (mapcar
   (lambda (step)
     (intern
      (format "rubik-%s-command"
              (replace-regexp-in-string "'" "i" step))))
   (split-string (my-cubing-normalize alg) " ")))

(rubik-define-commands
  rubik-U "U" rubik-U2 "U2" rubik-Ui "U'"
  rubik-F "F" rubik-F2 "F2" rubik-Fi "F'"
  rubik-R "R" rubik-R2 "R2" rubik-Ri "R'"
  rubik-L "L" rubik-L2 "L" rubik-Li "L'"
  rubik-B "B" rubik-B2 "B" rubik-Bi "B'"
  rubik-D "D" rubik-D2 "D" rubik-Di "D'"
  rubik-x "x" rubik-x2 "x" rubik-xi "x'"
  rubik-y "y" rubik-y2 "y" rubik-yi "y'"
  rubik-z "z" rubik-z2 "z2" rubik-zi "z'")

(defun my-cubing-rubik-set-to-alg (alg)
  (interactive "MAlg: ")
  (rubik)
  (fit-window-to-buffer)
  (setq rubik-cube-state (my-cubing-rubik-alg alg))
  (setq rubik-cube-redo (append (list 'redo)
                                (my-cubing-convert-alg-to-rubik-commands
                                 alg)))
  (setq rubik-cube-undo '(undo))
  (rubik-draw-all)
  (display-buffer (current-buffer)))

And now I can combine all those pieces together in a custom Org link type that will allow me to interactively step through an algorithm if I open it within Emacs and that will export to a diagram and an animation.

(org-link-set-parameters
 "3x3"
 :follow #'my-cubing-rubik-open
 :export #'my-cubing-rubik-export)

(defun my-cubing-rubik-open (path &optional _)
  (my-cubing-rubik-set-to-alg (if (string-match "^\\(.*\\)\\?\\(.*\\)$" path)
                                  (match-string 1 path)
                                path))) 
  
(defun my-cubing-rubik-export (path _ format _)
  "Export PATH to FORMAT."
  (let (alg arrows params)
    (setq alg path)
    (when (string-match "^\\(.*\\)\\?\\(.*\\)$" path)
      (setq alg (match-string 1 path)
            params (org-protocol-convert-query-to-plist (match-string 2 path))
            arrows
            (mapcar (lambda (entry)
                      (mapcar 'string-to-number
                               (split-string entry "-"))) 
                    (split-string
                     (plist-get params :arrows) ","))))
    (concat
     (my-cubing-rubik-last-layer-with-sides-from-alg
      alg
      arrows)
     (format "<div class=\"roofpig\" data-config=\"base=PLL|alg=%s\"></div>"
             (my-cubing-normalize alg)))))

Let's try that with this F-perm, which I haven't memorized yet:

[[3x3:(R' U' F')(R U R' U')(R' F R2 U')(R' U' R U)(R' U R)?arrows=1-7,7-1,2-8,8-2]]

At some point, I'd like to change the display for rubik.el so that it uses SVGs. (Or the OpenGL hacks in https://github.com/Jimx-/emacs-gl, but that might be beyond my current ability.) In the meantime, this might be fun.

In rubik.el, M-r redoes a move and M-u undoes it. Here's what it looks like with my tweaked interface:

output-2023-02-09-15:25:42.gif
Figure 1: Animated GIF of rubik.el stepping through an F-perm
View org source for this post

Using Org Babel to learn Rubik's cube algorithms

| emacs, cubing, org

A+ has started learning Rubik's cube algorithms for permutation of the last layer (PLL) algorithms for the Rubik's cube. To help her focus on just a few at a time instead of getting distracted by the long list in the Cubeskills PLL PDF, I made a page that listed the algorithms that she was working on so that I could export it with ox-hugo to the mini-site I made for her interests.

She sometimes gets a little confused about clockwise and counter-clockwise, so I used Roofpig to add an animated view of the algorithm that she can step through. I wanted to make it easier for her to follow the algorithm without constantly moving her hands from the cube to the tablet or looking up and down all the time, but I didn't want to recompile the source just yet. I used the roofpig_and_three.min.js file and hacked speech synthesis into it by modifying the object prototype. For example, here's the Org source for adding a Jb perm:

#+begin_export html
<div class="roofpig" data-config="base=PLL|alg=R U R' F' R U R' U' R' F R2 U' R' U'"></div>
#+end_export

and here's what it looks like. Might only look nice on my website, and I added speech synthesis so you may want to mute it if you need to be quiet.

Code for setting up Roofpig with speech synthesis
<!--  -*- mode: web -*- -->
<style>
 .roofpig { max-width: 400px; margin-bottom: 80px; }
 </style>
 <script>

  function waitToAddSpeech() {
    if (window.cubesSpeakMoves || !window.speechSynthesis) return;
    if (window.CubeAnimation) {
      window.cubesSpeakMoves = true;
        addSpeechToCubeAnimations();
      } else {
        setTimeout(setUpCubes, 300);
      }
  }
  
  function setUpCubes() {
    if (!document.querySelector('script.roofpig')) {
      var script = document.createElement('script');
      script.setAttribute('src', '/blog/2023/02/using-org-babel-to-learn-rubik-s-cube-algorithms/roofpig_and_three.min.js');
      script.classList.add('roofpig');
      document.head.appendChild(script);
      waitToAddSpeech();
    }
  }
  
  function addSpeechToCubeAnimations() {
   if (!window.CubeAnimation || !window.CubeAnimation['by_id'] || !window.CubeAnimation['by_id'][1]) return;
   var cachedFunc = Object.getPrototypeOf(CubeAnimation['by_id'][1].dom).alg_changed;
   Object.getPrototypeOf(CubeAnimation['by_id'][1].dom).alg_changed = function() {
     if (arguments[4].past.length > lastNoted.length) {
       let moves = arguments[4].past.split(' ');
       let lastMove = moves[moves.length - 1];
       // is it lower-case? speak lowercase explicitly
       if (lastMove.match(/[rludbf]/)) {
         lastMove = 'lower ' + lastMove;
       } else { // avoid awkward-sounding moves like "capital R"
         lastMove = lastMove.toLowerCase();
       }
       lastMove = lastMove.replace(/'/, ' prime');
      window.speechSynthesis.speak(new SpeechSynthesisUtterance(lastMove));
     } else {
       console.log('going backwards');
     }
     lastNoted = arguments[4].past;
     return cachedFunc.apply(this, arguments);
   }
 }
 ROOFPIG_CONF_F2L = "solved=U*|hover=none|colored=U-|flags=canvas,showalg|speed=1000";
 ROOFPIG_CONF_PLL = "solved=U-|hover=near|colored=U*|flags=canvas,showalg|speed=1000";
 var lastNoted = '';
window.addEventListener('load', setUpCubes);
</script>

I also wanted to include diagrams to make it easier for her to choose the right algorithm and position the cube the right way at the beginning, but I didn't want to fuss around with lots of screenshots and little files. It turns out you can define arrows in SVG pretty easily, so I wrote some Emacs Lisp functions to generate those types of diagrams. First I started with just the arrows.

(my-cubing-last-layer-arrows '((2 8 t) (5 7 t)))
arrows.svg

For practising recognition, I wanted to also include the colors on top and on the sides:

(my-cubing-last-layer-with-sides "OOGRROGGRBBB" "YYYYYYYYY" '((2 8 t) (5 7 t)))
colors.svg

Emacs Lisp functions for cubing diagrams
;; Start of cubing code
(defun my-cubing-pos (size n i)
  (list
   (* (/ size n) (% i n))
   (* (/ size n) (/ i n))))
  
(defun my-cubing-last-layer-arrows (arrows)
  "Draw ARROWS.
Arrows are defined as a list of lists of the form
((from to) (from to t) ...). Ex: '(my-cubing-last-layer-arrows '((3 1 t) (2 8 t)))
Cells are numbered from left to right, top to bottom, with the top left box being 0.
"
  (let* ((size 99)
         (n 3)
         (arrow-color "#000")
         (svg (svg-create size size)))
    (svg--append
     svg
     (dom-node
      'defs
      nil
      (dom-node
       'marker
       '((id . "arrowhead")
         (markerWidth . "10")
         (markerHeight . "7")
         (refX . "0")
         (refY . "3.5")
         (orient . "auto-start-reverse"))
       (dom-node
        'polygon
        `((fill . ,arrow-color)
          (points . "0 0, 4 3.5, 0 7")))
       )))
    (dotimes (i (* n n))
      (let ((pos (my-cubing-pos size n i)))
        (svg-rectangle
         svg
         (car pos)
         (cadr pos)
         (/ size n)
         (/ size n)
         :fill "#fff"
         :stroke-width 1
         :stroke "#666")))
    (dolist (arrow arrows)
      (let ((from (car arrow))
            (to (cadr arrow)))
        (apply 'svg-line
               (append
                (list svg)
                (mapcar (lambda (o) (+ o (/ size (* 2 n))))
                        (my-cubing-pos size n from))
                (mapcar (lambda (o) (+ o (/ size (* 2 n))))
                        (my-cubing-pos size n to))
                (list
                 :stroke-width 2
                 :stroke arrow-color
                 :marker-start (if (elt arrow 2) "url(#arrowhead)")
                 :marker-end "url(#arrowhead)")))))
    (with-temp-buffer
      (svg-print svg)
      (buffer-string))))

(defvar my-cubing-colors '((?R  . "#ff0000")
                           (?G  . "#00ff00")
                           (?B  . "#0000ff")
                           (?O  . "#ed7117")
                           (?Y  . "#ffff00")
                           (?W  . "#ffffff")
                           (?\? . "#666666")))

(defun my-cubing-last-layer-with-sides (sides top arrows)
  "Draw a diagram of the top of the cube.
The style is similar to https://www.cubeskills.com/uploads/pdf/tutorials/pll-algorithms.pdf .
SIDES is a string specifying colors going clockwise from the back-left side.
TOP is a string specifying colors going from left to right, top to bottom.
Arrows are defined as a list of lists of the form ((from to) (from to t) ...).
Cells are numbered from left to right, top to bottom, with the top left box being 0.
Ex: (my-cubing-last-layer-with-sides \"ORRBOOGGGRBB\" \"YYYYYYYYY\" '((3 1 t) (2 8 t)))
"
  (let* ((size 99)
         (n 3)
         (side-size 10)
         (cell-size (/ (- size (* 2 side-size)) n))
         (arrow-color "#000")
         (svg (svg-create size size)))
    (svg--append
     svg
     (dom-node
      'defs
      nil
      (dom-node
       'marker
       '((id . "arrowhead")
         (markerWidth . "10")
         (markerHeight . "7")
         (refX . "0")
         (refY . "3.5")
         (orient . "auto-start-reverse"))
       (dom-node
        'polygon
        `((fill . ,arrow-color)
          (points . "0 0, 4 3.5, 0 7"))))))
    ;; Draw the sides. It's a string of colors going clockwise from back left
    (when sides
      (dotimes (i (* n 4))
        (apply 'svg-rectangle
               (append
                (list svg)
                (pcase (/ i n)
                  (0 (list (+ (* (% i n) cell-size) side-size)
                           0
                           cell-size
                           side-size))
                  (1 (list (+ side-size (* n cell-size))
                           (+ (* (% i n) cell-size) side-size)
                           side-size
                           cell-size))
                  (2 (list (+ (* (- n (% i n) 1) cell-size) side-size)
                           (+ (* n cell-size) side-size)
                           cell-size
                           side-size))
                  (3 (list 0
                           (+ (* (- n (% i n) 1) cell-size) side-size)
                           side-size
                           cell-size)))
                (list
                 :stroke-width 1
                 :stroke "#666"
                 :fill (assoc-default (elt sides i)
                                      my-cubing-colors
                                      'eq
                                      (assoc-default ?\? my-cubing-colors)))))))
    ;; Draw the top face specified by a string of colors going from left to right, top to bottom
    (dotimes (i (* n n))
      (let ((pos (my-cubing-pos (* cell-size n) n i)))
        (svg-rectangle
         svg
         (+ side-size (car pos))
         (+ side-size (cadr pos))
         cell-size
         cell-size
         :fill (if top
                   (assoc-default (elt top i) my-cubing-colors
                                  'eq
                                  (assoc-default ?\? my-cubing-colors))
                 (assoc-default ?\? my-cubing-colors))
         :stroke-width 1
         :stroke "#666")))
    ;; Draw the arrows
    (dolist (arrow arrows)
      (let ((from (car arrow))
            (to (cadr arrow)))                  
        (apply 'svg-line
               (append
                (list svg)
                (mapcar (lambda (o) (+ side-size o (/ cell-size 2)))
                        (my-cubing-pos (* n cell-size) n from))
                (mapcar (lambda (o) (+ side-size o (/ cell-size 2)))
                        (my-cubing-pos (* n cell-size) n to))
                (list
                 :stroke-width 2
                 :stroke arrow-color
                 :opacity 0.5
                 :marker-start (if (elt arrow 2) "url(#arrowhead)")
                 :marker-end "url(#arrowhead)")))))
    (with-temp-buffer
      (svg-print svg)
      (buffer-string))))
;; end of cubing code

I'll probably need to tweak the arrows when we eventually get to the G perms, but we're still a long way off. And it would probably be pretty cool to be able to generate the colours by going backwards from the algorithm, maybe building on top of emacs-cube, so that I can write my own notes about recognizing the in-between steps and recovering from the typical mistakes we make. (That wasn't around the last time I wrote about Emacs and cubing. Thanks to Akib for making and sharing it!) I'm curious about this LaTeX approach, too, but that can wait for another day.

View org source for this post

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)
              (when (string-match "ELEVENTY" (org-element-property :key 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, 11tydata.json, HTML" 'my-org-11ty-export)))
View org source for this post
This is part of my Emacs configuration.

Org Mode: Including portions of files between two regular expressions

| org, emacs

2023-09-10: Use consult-line instead of consult--line.

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;
}
div > details { padding: 20px; border: 1px solid lightgray }
.org-src-container > details  { padding: 0; border: none }
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)
                (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
                 nil (point))
                (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.