Categories: geek » emacs » org

RSS - Atom - Subscribe via email

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:

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)

(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)."
   `((pages . 
            ,(apply 'vector
                     (lambda (page)
                        (apply 'vector 
                                (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 (cons 'text text))
                                        (unless (string= click "")
                                             (action . "run_command")
                                             (value . ,(concat "/" click)))))                                    
                                        (unless (string= color "")
                                          (list (cons 'color
                                       (if (string= color "")
                                           '((text . "\n"))
                                         '((text . "\n")
                                           (color . "reset")))))))
                     (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)

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 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:

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))

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

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."
   (replace-regexp-in-string "[() ]+" " " alg)))

(defun my-cubing-reverse-alg (alg)
  "Reverse the given ALG."
   (lambda (step)
     (if (string-match "\\`\\([rludfsbRLUDFSBxyz]\\)\\(['i]\\)?\\'" step)
         (concat (match-string 1 step)
                 (if (match-string 2 step)
    (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)))
     (lambda (cube o)
       (when (intern (format "rubik-%s"
                             (replace-regexp-in-string "'" "i" o)))
         (unless (string= o "")
              (format "rubik-%s"
                      (replace-regexp-in-string "'" "i" o)))))))
     (split-string reversed " ")

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)))
      (lambda (i)
        (char-to-string (elt my-cubing-rubik-faces (aref cube i))))
       (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))))))
      (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
          (my-cubing-rubik-top-face-strings (my-cubing-rubik-alg alg))

So I can invoke it with:

 "R U R' F' R U R' U' R' F R2 U' R' U'"
 '((1 7 t) (2 8 t)))

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)
   (lambda (step)
      (format "rubik-%s-command"
              (replace-regexp-in-string "'" "i" step))))
   (split-string (my-cubing-normalize alg) " ")))

  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: ")
  (setq rubik-cube-state (my-cubing-rubik-alg alg))
  (setq rubik-cube-redo (append (list 'redo)
  (setq rubik-cube-undo '(undo))
  (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.

 :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)
(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))
            (mapcar (lambda (entry)
                      (mapcar 'string-to-number
                               (split-string entry "-"))) 
                     (plist-get params :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, 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:

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>

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 -*- -->
 .roofpig { max-width: 400px; margin-bottom: 80px; }

  function waitToAddSpeech() {
    if (window.cubesSpeakMoves || !window.speechSynthesis) return;
    if (window.CubeAnimation) {
      window.cubesSpeakMoves = true;
      } 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');
  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);

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)))

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)))

Emacs Lisp functions for cubing diagrams
;; Start of cubing code
(defun my-cubing-pos (size n i)
   (* (/ 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)))
       '((id . "arrowhead")
         (markerWidth . "10")
         (markerHeight . "7")
         (refX . "0")
         (refY . "3.5")
         (orient . "auto-start-reverse"))
        `((fill . ,arrow-color)
          (points . "0 0, 4 3.5, 0 7")))
    (dotimes (i (* n n))
      (let ((pos (my-cubing-pos size n i)))
         (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
                (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))
                 :stroke-width 2
                 :stroke arrow-color
                 :marker-start (if (elt arrow 2) "url(#arrowhead)")
                 :marker-end "url(#arrowhead)")))))
      (svg-print svg)

(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 .
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)))
       '((id . "arrowhead")
         (markerWidth . "10")
         (markerHeight . "7")
         (refX . "0")
         (refY . "3.5")
         (orient . "auto-start-reverse"))
        `((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
                (list svg)
                (pcase (/ i n)
                  (0 (list (+ (* (% i n) cell-size) side-size)
                  (1 (list (+ side-size (* n cell-size))
                           (+ (* (% i n) cell-size) side-size)
                  (2 (list (+ (* (- n (% i n) 1) cell-size) side-size)
                           (+ (* n cell-size) side-size)
                  (3 (list 0
                           (+ (* (- n (% i n) 1) cell-size) side-size)
                 :stroke-width 1
                 :stroke "#666"
                 :fill (assoc-default (elt sides i)
                                      (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)))
         (+ side-size (car pos))
         (+ side-size (cadr pos))
         :fill (if top
                   (assoc-default (elt top i) my-cubing-colors
                                  (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
                (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))
                 :stroke-width 2
                 :stroke arrow-color
                 :opacity 0.5
                 :marker-start (if (elt arrow 2) "url(#arrowhead)")
                 :marker-end "url(#arrowhead)")))))
      (svg-print svg)
;; 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 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))
          (org-with-point-at (org-element-property :begin src-block)
         (summary (assoc-default :summary (elt block-info 2))))
    (if (member summary '("%summary" ""))
      (format "<details><summary>%s</summary>%s</details>"
(with-eval-after-load 'ox-html
   (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

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
            (lambda (el)
               (org-element-property :key el)
               (org-element-property :value el)
                (org-element-property :begin el)
                (org-element-property :end el))))))
         (entry-properties (org-entry-properties))
         (filename (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
     (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
      (insert (or
               (mapconcat (lambda (file-prop) (elt file-prop 2))
    (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
                        (plist-get info :file-name)
                        (plist-get info :base-dir)))))
      (concat string
              (format "<div><a href=\"\">View org source for this post</a></div>"
                      (plist-get info :permalink)))

(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)
                       (plist-get info :file-name)
                       (plist-get info :base-dir))))
    (org-11ty-export-to-11tydata-and-html async subtreep visible-only body-only ext-plist)

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.

 :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
            (plist-get params :from-regexp)
              (goto-char (point-min))
              (when (re-search-forward (url-unhex-string (plist-get params :from-regexp)))
             (goto-char (point-min))
    (setq end
            (plist-get params :to-regexp)
              (when (re-search-forward (url-unhex-string (plist-get params :to-regexp)))
             (goto-char (point-max))
    (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)))))
      (my-include-open path)
      (setq body (buffer-substring (point-min) (point-max))))
      (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 "")
      (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."
  (require 'consult)
  (let ((file (read-file-name "File: ")))
      (find-file file)
      (concat "my-include:"
              (let ((curr-line (line-number-at-pos
                    (prompt "From line: "))
                (goto-char (point-min))
                 (or (consult--with-increased-gc
                     (user-error "No lines"))
                 :curr-line curr-line
                 :prompt prompt)        
                 (regexp-quote (buffer-substring (line-beginning-position) (line-end-position)))))
              (let ((curr-line (line-number-at-pos
                    (prompt "To line: "))
                (goto-char (point-min))
                 (or (consult--with-increased-gc
                     (user-error "No lines"))
                 :curr-line curr-line
                 :prompt prompt)        
                 (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:

(defun emacsconf-stream-schedule-timers (&optional info)
  "Schedule PLAYING for the rest of talks and CLOSED_Q for recorded talks."
  (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) ")"))))

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:

(defun emacsconf-stream-cancel-timer (id)
  "Cancel a timer by ID."
  (interactive (list
                 "ID: "
                 (lambda (string pred action)
                    (if (eq action 'metadata)
                        `(metadata (display-sort-function . ,#'identity))
                      (complete-with-action action
                                             (seq-filter (lambda (o)
                                                           (and (timerp (cdr o))
                                                                (not (timer--triggered (cdr o)))))
                                             (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)))))

and schedule just one timer manually:

(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
           ((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)
                                  (string-pad time 5 ?0 t) 
         (timer-id (concat (format-time-string "%m-%dT%H:%M" converted)
                           (plist-get talk :slug)
    (emacsconf-stream-cancel-timer timer-id) 
    (add-to-list 'emacsconf-stream-timers
                   (run-at-time time converted #'emacsconf-stream-update-talk-status-from-timer
                                talk new-status

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.

(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))))
     (lambda (hook-entry)
        ((symbolp hook-entry) (funcall hook-entry talk))
        ((member (plist-get track :id) (cdr hook-entry))
         (funcall (car hook-entry) talk))))

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

(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)
           (plist-get talk :slug))
            (split-string-and-unquote (plist-get talk :stream-files))
            (list "&"))))
           (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
           (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)))
           (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)))
           (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:

(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:

(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.