Categories: geek » emacs

View topic page - RSS - Atom - Subscribe via email
Recommended links:

2025-02-17 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Mastodon #emacs, Bluesky #emacs, Hacker News, lobste.rs, programming.dev, lemmy.world, lemmy.ml, communick.news, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, and emacs-devel. Thanks to Andrés Ramírez for emacs-devel links. Do you have an Emacs-related link or announcement? Please e-mail me at sacha@sachachua.com. Thank you!

View org source for this post

2025-02-10 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Mastodon #emacs, Bluesky #emacs, Hacker News, lobste.rs, programming.dev, lemmy.world, lemmy.ml, communick.news, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, and emacs-devel. Thanks to Andrés Ramírez for emacs-devel links. Do you have an Emacs-related link or announcement? Please e-mail me at sacha@sachachua.com. Thank you!

View org source for this post

2025-02-03 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Mastodon #emacs, Bluesky #emacs, Hacker News, lobste.rs, programming.dev, lemmy.world, lemmy.ml, communick.news, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, and emacs-devel. Thanks to Andrés Ramírez for emacs-devel links. Do you have an Emacs-related link or announcement? Please e-mail me at sacha@sachachua.com. Thank you!

View org source for this post

Improving subed-vtt parsing; using dedicated windows in Emacs; training my intuition

| emacs, subed

While putting together some notes on how to use subed.el with auto-generated YouTube captions, I decided to get subed-word-data working with the Youtube VTT format. The sample file I downloaded from one of my YouTube videos had a cue whose text started with a blank line, so I ended up redoing the way subed-vtt.el parsed cues. Twice, actually. The first time, I changed it to handle multiple blocks in cue text (separated by blank lines). Then I came across this test suite for WebVTT parsing and found out that the timing line for a cue doesn't have to be preceded by a blank line, so then I needed to change the VTT parsing again.

Fortunately, I inherited a large Buttercup test suite from subed.el's original author. I've been adding to it over the years. As I learned more about how I wanted subed.el to behave, I added more cases. Then I worked on shifting the code to behave the way I wanted it to. At first, I didn't quite understand what I wanted the code to do, but as I pinned down more test cases, I was able to figure it out.

This was the first time I used toggle-window-dedicated (C-x w d) extensively. This function keeps the same buffer displayed in the window instead of letting Emacs Lisp functions replace it. First, I set up a large window for my subed-vtt.el. I split the other side into a smaller window for my test-subed-vtt.el, another window for a temporary VTT file, and a window for output from whatever command I'm running. I set most of the windows to dedicated except for my temporary output window. I also enabled winner-mode just in case I messed things up so that I could restore with winner-undo. Dedicating the windows meant I didn't have to keep fussing around with my windows and buffers to get things back to where I wanted them to be. I did use C-x o (other-window) a lot, so maybe it'll be worth getting the hang of ace-window.

2025-01-28_12-40-04.png
Figure 1: Dedicated windows for the code, the test file, and a VTT buffer for interactive testing; a spare window for other output

Sometimes I wanted to focus on one of those small windows. prot/window-single-toggle was helpful for maximizing a window and then returning to the previous configuration.

I mostly evaluated or edebugged my code and then used my-buttercup-run-dwim to run a suite in my test-subed-vtt.el. sp-backward-up-sexp and sp-narrow-to-sexp were also helpful for navigating the suites and focusing on whatever I was working on.

I'm looking forward to exploring the other test cases from that repository. It feels good to get better as a coder.

I just finished reading Mathematica: a Secret World of Imagination and Curiosity, by David Bessis. The idea of training your intuition echoed in my mind as I wrote test cases and changed the code. I started to look forward to the gaps between my understanding of the spec and my understanding of the test cases, and the gaps between the test cases and my implementation. It felt almost like a conversation. Sometimes it was hard to translate an idea into code. I felt myself getting muddled and turned around. Whenever I noticed that, I just had to back up and start from something I understood, figure out what I was uncertain about, and then go from there.

I like the way that subed.el gives me tools for thinking about text, times, and metadata together. That abstraction has been helpful for editing audio and making videos. The more solid I can make it, the easier it will be to imagine other things that use those ideas.

View org source for this post

2025-01-27 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Mastodon #emacs, Bluesky #emacs, Hacker News, lobste.rs, programming.dev, lemmy.world, lemmy.ml, communick.news, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, and emacs-devel. Thanks to Andrés Ramírez for emacs-devel links. Do you have an Emacs-related link or announcement? Please e-mail me at sacha@sachachua.com. Thank you!

View org source for this post

Scaling a BigBlueButton server down to a 1 GB node between uses

| geek, tech, emacsconf, emacs

Now that we've survived EmacsConf, I've been looking into running a BigBlueButton server so that various Emacs meetups can use it if they like instead of relying on Jitsi or other free video-conferencing services. (I spent some time looking into Galene, but I'm not quite sure that's ready for our uses yet, like this issue that LibrePlanet ran into with recording.)

BigBlueButton requires a server with at least 4 CPU cores and 8 GB of RAM to even start up, and it doesn't like to share with other services. This costs about USD 48+tax/month on Linode or USD 576+tax/year, which is not an efficient use of funds yet. I could delete it after each instance, but I've been having a hard time properly restoring it from backup after deploying to a new IP address. bbb-conf --setip doesn't seem to catch everything, so I was still getting curl errors related to verifying the certificate.

A reasonable in-between is to run it on Linode's lowest plan (1 core, 1GB RAM; USD 60+tax for the year) in between meetups, and then spin things up for maybe 6-12 hours around each meetup. If I go with the 4-core 8 GB setup, that would be an extra USD 0.43 - 0.86 USD per meetup, which is eminently doable. I could even go with the recommended configuration of 8 cores and 16 GB memory on a dedicated CPU plan (USD 0.216/hour, so USD 1.30 to 2.59 per meetup). This was the approach that we used while preparing for EmacsConf. Since I didn't have a lot of programming time, I scaled the node up to 4 core / 8GB RAM whenever I had time to work on it, and I scaled it down to 1GB at the end of each of my working sessions. I scaled it up to dedicated 8 core / 16 GB RAM for EmacsConf, during which we used roughly half of the CPU capacity in order to host a max of 107 simultaneous users over 7 meetings.

I reviewed my BigBlueButton setup notes in the EmacsConf organizers notebook and the 2024 notebook and set up a Linode instance under my account, so that I can handle the billing and also so that Amin Bandali doesn't get spammed by all the notifications (up, down, up, down…). And then I'll be able to just scale it up when EmacsConf comes around again, which is nice.

Anyway, BBB refuses to install on a machine with fewer than 4 cores or 8 GB RAM, but once you set it up, it'll valiantly thrash around even on an underpowered server, which makes working with the server over ssh a lot slower. Besides, that's not friendly to other people using the same server. I wanted to configure the services so that they would only run on a server of the correct size. It turns out that systemd will let you specify either ConditionMemory and ConditionCPUs in the unit configuration file, and that you can use files ending in .conf in a directory named like yourservicename.service.d to override part of the configuration. Clear examples were hard to find, so I wanted to share these notes.

Since ConditionMemory is specified in bytes (ex: 8000000000), I found ConditionCPUs to be easier to read.

I used this command to check if I'd gotten the syntax right:

systemd-analyze condition 'ConditionCPUs=>=4'

and then I wrote this script to set up the overrides:

CPUS_REQUIRED=4
for ID in coturn.service redis-server.service bigbluebutton.target multi-user.target bbb-graphql-server.service haproxy.service bbb-rap-resque-worker.service bbb-webrtc-sfu.service bbb-fsesl-akka.service bbb-webrtc-recorder.service bbb-pads.service bbb-export-annotations.service bbb-web.service freeswitch.service etherpad.service bbb-rap-starter.service bbb-rap-caption-inbox.service freeswitch.service bbb-apps-akka.service bbb-graphql-actions postgresql@14-main.service; do
    mkdir -p /etc/systemd/system/$ID.d
    printf "[Unit]\nConditionCPUs=>=$CPUS_REQUIRED\n" > /etc/systemd/system/$ID.d/require-cpu.conf
done
systemctl daemon-reload
systemd-analyze verify bigbluebutton.target

It seems to work. When I use linode-cli to resize to the testing size, BigBlueButton works:

linode-cli linodes resize $BBB_ID --type g6-standard-4 --allow_auto_disk_resize false
sleep 5m
linode-cli linodes boot $BBB_ID
ssh root@bbb.emacsverse.org "cd ~/greenlight-v3; docker compose restart"
notify-send "Should be ready"

And when I resize it down to a 1 GB nanode, BigBlueButton doesn't get started and the VPS is nice and responsive when I SSH in.

echo Powering off
linode-cli linodes shutdown $BBB_ID
sleep 30
echo "Resizing BBB node to nanode, dormant"
linode-cli linodes resize $BBB_ID --type g6-nanode-1 --allow_auto_disk_resize false

So now I'm going to coordinate with Ihor Radchenko about when he might want to try this out for OrgMeetup, and I can talk to other meetup organizers to figure out times. People will probably want to test things before announcing it to their meetup groups, so we just need to schedule that. It's BigBlueButton 3.0. I'm not 100% confident in the setup. We had some technical issues with some EmacsConf speakers even though we did a tech check with them before we went live with their session. Not sure what happened there.

I'm still a little nervous about accidentally forgetting to downscale the server and running up a bill, but I've scheduled downscaling with the at command before, so that's helpful. If it turns out to be something we want to do regularly, I might even be able to use a cronjob from my other server so that it happens even if my laptop is off, and maybe set up a backup nginx server with a friendly message (and maybe a list of upcoming meetups) in case people connect before it's been scaled up. Anyway, I think that's a totally good use of part of the Google Open Source Peer Bonus I received last year.

As an aside, you can change a room's friendly_id to something actually friendly. In the Rails console (docker exec -it greenlight-v3 bundle exec rails console), you could do something like this:

Room.find_by(friendly_id: "CURRENT_ROOM_ID").update_attribute(:friendly_id, "NEW_CUSTOM_ID")

Anyway, let me know if you organize an Emacs meetup and want to give this BigBlueButton instance a try!

View org source for this post

Hyperlinking SVGs

| drawing, supernote, emacs
Text and links from sketch

Hyperlinking SVGs - 2025-01-17-01

I like drawing my notes. I can jump around, draw connections, doodle for fun.

A sketch can only fit so much, though. (even if I write really small)

Idea: Links: They can be signposts for other trails.

Process:

I want to make maps for myself and other people.

This is easy to do because:

  • SVGs are XML, a text format
  • Emacs has code for XML and SVG manipulation, display
  • You can use Emacs to build a simple user interface.
  • Ideas
  • TO-DO: update sketch viewer
    • prioritize SVG
    • display Org

SuperNote also has its own hyperlinks, but:

  • typing long URLS on on-screen keyboards is not fun
  • I can't figure out how to convert those links to SVG
  • Rects are more compact

Preprocessing the image

This isn't the focus of this blog post, but I thought I'd include the code anyway in case someone might find it useful.

The fastest way to get a single file off the Supernote is to enable Browse & Access by swiping down from the top. It's the icon that looks like a two-way arrow between waves.

2025-01-21_10-28-16.png
Figure 1: Browse and Access

I have some Emacs Lisp code for downloading the latest exported file using the Supernote's web server.

my-supernote-get-exported-files
(defvar my-supernote-ip-address "192.168.1.221")
(defun my-supernote-get-exported-files ()
  (condition-case nil
      (let ((data (plz 'get (format "http://%s:8089/EXPORT" my-supernote-ip-address)))
            (list))
        (when (string-match "const json = '\\(.*\\)'" data)
          (sort
           (alist-get 'fileList (json-parse-string (match-string 1 data) :object-type 'alist :array-type 'list))
           :key (lambda (o) (alist-get 'date o))
           :lessp 'string<
           :reverse t)))
    (error nil)))

my-supernote-download-latest-exported-file: Save exported file in downloads dir.
(defun my-supernote-download-latest-exported-file ()
  "Save exported file in downloads dir."
  (interactive)
  (let* ((info (car (my-supernote-get-exported-files)))
         (dest-dir my-download-dir)
         (new-file (and info (expand-file-name (file-name-nondirectory (alist-get 'name info)) dest-dir)))
         renamed)
    (when info
      (copy-file
       (plz 'get (format "http://%s:8089%s" my-supernote-ip-address
                         (alist-get 'uri info))
         :as 'file)
       new-file
       t)
      new-file)))

Once I've downloaded the file, I process it:

  1. my-image-recognize: use Google Cloud Vision to recognize the text, rename it based on the ID
  2. my-sketch-rename: rename the file based on the ID if I've written one on the sketch
  3. my-sketch-convert-pdf: convert to SVG, copying over the links from the previous SVG if one exists
  4. my-sketch-clean: remove any images or templates
  5. my-sketch-color-to-hex: change the hex values for easier replacement and tinkering
  6. my-sketch-add-bg: add a plain white background rectangle
  7. my-sketch-change-fill-to-style: make the attributes more consistent
  8. my-sketch-recolor: change the highlight colour from gray to light yellow
  9. my-image-store: store it in either my private-sketches directory or my sketches directory, depending on the tags in the filename; leave untitled sketches in the same directory

my-supernote-process-sketch
(defun my-supernote-process-sketch (file)
  (interactive "FFile: ")
  (my-image-recognize file)
  (setq file (my-sketch-rename file))
  (pcase (file-name-extension file)
    ("pdf"
     (setq file
           (my-image-store
            (my-sketch-svg-prepare file))))
    ("png"
     (setq file
           (my-image-store
            (my-image-autorotate
             (my-image-autocrop
              (my-sketch-recolor-png
               file)))))))
  file)

my-sketch-svg-prepare: Clean up SVG for publishing.
(defvar my-debug-buffer (get-buffer-create "*temp*"))
(defun my-sketch-convert-pdf (pdf-file)
  "Returns the SVG filename."
  (interactive "FPDF: ")
  (if-let ((links (and (file-exists-p (concat (file-name-sans-extension pdf-file) ".svg"))
                       (dom-by-tag
                        (car (xml-parse-file (concat (file-name-sans-extension pdf-file) ".svg")))
                        'a))))
      ;; copy links over
      (let ((temp-file (concat (make-temp-name "svg-conversion") ".svg"))
            new-file)
        (unwind-protect
            (progn
              (call-process "pdftocairo" nil my-debug-buffer nil "-svg" (expand-file-name pdf-file)
                            temp-file)
              (setq new-file (car (xml-parse-file temp-file)))
              (dolist (link links)
                (dom-append-child new-file link))
              (with-temp-file (file-exists-p (concat (file-name-sans-extension pdf-file) ".svg"))
                (svg-print new-file)))
          (error
           (delete-file temp-file))))
    (delete-file (concat (file-name-sans-extension pdf-file) ".svg"))
    (call-process "pdftocairo" nil my-debug-buffer nil "-svg" (expand-file-name pdf-file)
                  (expand-file-name (concat (file-name-sans-extension pdf-file) ".svg"))))
  (concat (file-name-sans-extension pdf-file) ".svg"))

(defun my-sketch-change-fill-to-style (dom)
  "Inkscape handles these better when we split paths."
  (dolist (path (dom-by-tag dom 'path))
    (when (dom-attr path 'fill)
      (dom-set-attribute
       path 'style
       (if (dom-attr path 'style)
           (concat (dom-attr path 'style) ";fill:" (dom-attr path 'fill))
         (concat "fill:" (dom-attr path 'fill))))
      (dom-remove-attribute path 'fill)))
  dom)

(defun my-sketch-recolor (dom color-map &optional selector)
  "Colors are specified as ((\"#input\" . \"#output\") ...)."
  (if (symbolp color-map)
      (setq color-map
            (assoc-default color-map my-sketch-color-map)))
  (let ((map-re (regexp-opt (mapcar 'car color-map))))
    (dolist (path (if selector (dom-search dom selector)
                    (dom-by-tag dom 'path)))
      (dolist (attr '(style fill))
        (when (and (dom-attr path attr)
                   (string-match map-re (dom-attr path attr)))
          (dom-set-attribute
           path attr
           (replace-regexp-in-string
            map-re
            (lambda (match)
              (assoc-default match color-map))
            (or (dom-attr path attr) "")))))))
  dom)

(defun my-sketch-add-bg (dom)
  ;; add background rectangle
  (unless (dom-search dom (lambda (elem) (and (dom-attr elem 'class) (string-match "\\<background\\>" (dom-attr elem 'class)))))
    (let* ((view-box (mapcar 'string-to-number (split-string (dom-attr dom 'viewBox))))
           (bg-node (dom-node 'rect `((x . 0)
                                      (y . 0)
                                      (class . "background")
                                      (width . ,(elt view-box 2))
                                      (height . ,(elt view-box 3))
                                      (fill . "#ffffff")))))
      (if (dom-by-id dom "surface1")
          (push bg-node (cddr (car (dom-by-id dom "surface1"))))
        (push bg-node (cddr (car dom))))))
  dom)

(defun my-sketch-clean (dom)
  "Remove USE and IMAGE tags."
  (dolist (use (dom-by-tag dom 'use))
    (dom-remove-node dom use))
  (dolist (use (dom-by-tag dom 'image))
    (dom-remove-node dom use))
  dom)

(defun my-sketch-rotate (dom)
  (let* ((old-width (dom-attr dom 'width))
         (old-height (dom-attr dom 'height))
         (view-box (mapcar 'string-to-number (split-string (dom-attr dom 'viewBox))))
         (rotate (format "rotate(90) translate(0 %s)" (- (elt view-box 3)))))
    (dom-set-attribute dom 'width old-height)
    (dom-set-attribute dom 'height old-width)
    (dom-set-attribute dom 'viewBox (format "0 0 %d %d" (elt view-box 3) (elt view-box 2)))
    (dolist (g (dom-by-tag dom 'g))
      (dom-set-attribute g 'transform rotate)))
  dom)

(defun my-sketch-mix-blend-mode-darken (dom &optional selector)
  (dolist (p (if (functionp selector) (dom-search dom selector) (or selector (dom-by-tag dom 'path))))
    (when (and (dom-attr p 'style)
               (not (string-match "mix-blend-mode" (dom-attr p 'style))))
      (dom-set-attribute
       p 'style
       (replace-regexp-in-string ";;\\|^;" ""
                                 (concat
                                  (or (dom-attr p 'style) "")
                                  ";mix-blend-mode:darken")))))
  dom)

(defun my-sketch-color-to-hex (dom &optional selector)
  (dolist (p (if (functionp selector) (dom-search dom selector)
               (or selector (dom-search dom
                                        (lambda (p) (or (dom-attr p 'style)
                                                        (dom-attr p 'fill)))))))
    (dolist (attr '(style fill))
      (when (dom-attr p attr)
        (dom-set-attribute
         p attr
         (replace-regexp-in-string
          "rgb(\\([0-9\\.]+\\)%, *\\([0-9\\.%]+\\)%, *\\([0-9\\.]+\\)%)"
          (lambda (s)
            (color-rgb-to-hex
             (* 0.01 (string-to-number (match-string 1 s)))
             (* 0.01 (string-to-number (match-string 2 s)))
             (* 0.01 (string-to-number (match-string 3 s)))
             2))
          (dom-attr p attr))))))
  dom)

;; default for now, but will support more colour schemes someday
(defvar my-sketch-color-map
  '((blue
     ("#9d9d9d" . "#2b64a9")
     ("#9c9c9c" . "#2b64a9")
     ("#c9c9c9" . "#b3e3f1")
     ("#c8c8c8" . "#b3e3f1")
     ("#cacaca" . "#b3e3f1")
     ("#a6d2ff" . "#ffffff"))
    (t
     ("#9d9d9d" . "#888888")
     ("#9c9c9c" . "#888888")
     ("#cacaca" . "#f6f396")
     ("#c8c8c8" . "#f6f396")
     ("#a6d2ff" . "#ffffff")
     ("#c9c9c9" . "#f6f396"))))

(cl-defun my-sketch-svg-prepare (file &key color-map color-scheme new-file)
  "Clean up SVG for publishing."
  (when (string= (file-name-extension file) "pdf")
    (setq file (my-sketch-convert-pdf file)))
  (let ((dom (xml-parse-file file)))
    (setq dom (my-sketch-clean dom))
    (setq dom (my-sketch-color-to-hex dom))
    (setq dom (my-sketch-add-bg dom))
    (setq dom (my-sketch-change-fill-to-style dom))
    (setq dom (my-sketch-recolor dom
                                 (or color-map
                                     color-scheme
                                     t)))
    (with-temp-file (or new-file file) (svg-print (car dom)))
    (or new-file file)))

Editing and linking text

I've started keeping the text of the sketch in the same directory so that I can someday have full-text search for images. I have a keyboard shortcut for jumping to the text file. I like to open it in Org Mode.

my-org-sketch-open-text-file
(defun my-org-sketch-open-text-file (sketch)
  (interactive (list (my-complete-sketch-filename)))
  (find-file (concat (file-name-sans-extension sketch) ".txt"))
  (with-current-buffer (find-file-noselect sketch)
    (display-buffer-in-side-window
     (current-buffer)
     '((window-width . 0.5)
       (side . right)))))

The raw text from Google Cloud Vision is reasonably accurate but jumbled. I can move lines around with M-S-up and M-S-down in Org (org-shiftmetaup and org-shiftmetadown), which drag lines around. Once I add newlines, I can reorganize paragraphs with M-up and M-down (org-metaup and org-metadown). I can move list elements with M-S-right and M-S-left. (Idea: Avy probably has some awesome line-management functions I could get the hang of using.)

Once I've reorganized and cleaned up the text, I add links. Between my consult-omni shortcut and the new bookmarks I'm trying out (I should make a post about that), it's pretty easy.

Prompting for rectangles

Then it's a quick trip to Inkscape to draw rectangles over the things I want to link. It's easy to see where to draw the links because Org Mode highlights the links in the text. The style of the rectangles doesn't matter. After I save the SVG, I hop back into Emacs to turn them into links. This is the fun new part I just added.

Linkify rects

I like this because I got to reuse some code I'd written before to identify and reorder paths for easier animation of SVG topic maps. Using the links I defined in the previous step, all I needed to do was go through the rects (excluding the background rectangle) and offer completing-read on the titles and URLs. Then I createed the link elements and restyled the rectangles.

my-svg-linkify-rects
(defun my-svg-display (buffer-name svg &optional highlight-id full-window)
  "HIGHLIGHT-ID is a string ID or a node."
  (with-current-buffer (get-buffer-create buffer-name)
    (when highlight-id
      ;; make a copy
      (setq svg (with-temp-buffer (svg-print svg) (car (xml-parse-region (point-min) (point-max)))))
      (if-let* ((path (if (stringp highlight-id) (dom-by-id svg highlight-id) highlight-id))
                (view-box (split-string (dom-attr svg 'viewBox)))
                (box (my-svg-bounding-box path))
                (parent (car path)))
          (progn
            ;; find parents for possible rotation
            (while (and parent (not (dom-attr parent 'transform)))
              (setq parent (dom-parent svg parent)))
            (dom-set-attribute path 'style
                               (concat (dom-attr path 'style) "; stroke: 1px red; fill: #ff0000 !important"))
            ;; add a crosshair
            (dom-append-child
             (or parent svg)
             (dom-node 'path
                       `((d .
                            ,(format "M %f,0 V %s M %f,0 V %s M 0,%f H %s M 0,%f H %s"
                                     (elt box 0)
                                     (elt view-box 3)
                                     (elt box 2)
                                     (elt view-box 3)
                                     (elt box 1)
                                     (elt view-box 2)
                                     (elt box 3)
                                     (elt view-box 2)))
                         (stroke-dasharray . "5,5")
                         (style . "fill:none;stroke:gray;stroke-width:3px")))))
        (error "Could not find %s" highlight-id)))
    (let* ((inhibit-read-only t)
           (image (svg-image svg))
           (edges (window-inside-pixel-edges (get-buffer-window))))
      (erase-buffer)
      (if full-window
          (progn
            (delete-other-windows)
            (switch-to-buffer (current-buffer)))
        (display-buffer (current-buffer)))
      (insert-image (append image
                            (list :max-width
                                  (floor (* 0.8 (- (nth 2 edges) (nth 0 edges))))
                                  :max-height
                                  (floor (* 0.8 (- (nth 3 edges) (nth 1 edges)))) )))
      ;; (my-svg-resize-with-window (selected-window))
      ;; (add-hook 'window-state-change-functions #'my-svg-resize-with-window t)
      (current-buffer))))

(cl-defun my-svg-identify-paths (filename &key selector node-func dom)
  "Prompt for IDs for each path in FILENAME."
  (interactive (list (read-file-name "SVG: " nil nil
                                     (lambda (f)
                                       (or (string-match "\\.svg$" f)
                                           (file-directory-p f))))))
  (let* ((dom (or dom (car (xml-parse-file filename))))
         (paths (if (functionp selector)
                    (dom-search dom selector)
                  (or selector
                      (dom-by-tag dom 'path))))
         (vertico-count 3)
         (ids (seq-keep (lambda (path)
                          (and (dom-attr path 'id)
                               (unless (string-match "\\(path\\|rect\\)[0-9]+"
                                                     (or (dom-attr path 'id) "path0"))
                                 (dom-attr path 'id))))
                        paths))
         (edges (window-inside-pixel-edges (get-buffer-window)))
         id)
    (my-svg-display "*image*" dom nil t)
    (dolist (path paths)
      ;; display the image with an outline
      (unwind-protect
          (progn
            (my-svg-display "*image*" dom (dom-attr path 'id) t)
            (if (functionp node-func)
                (funcall node-func path dom)
              (setq id (completing-read
                        (format "ID (%s): " (dom-attr path 'id))
                        ids))
              ;; already exists, merge with existing element
              (if-let* ((old (dom-by-id dom id)))
                  (progn
                    (dom-set-attribute
                     old
                     'd
                     (concat (dom-attr (dom-by-id dom id) 'd)
                             " "
                             ;; change relative to absolute
                             (replace-regexp-in-string "^m" "M"
                                                       (dom-attr path 'd))))
                    (dom-remove-node dom path)
                    (setq id nil))
                (dom-set-attribute path 'id id)
                (add-to-list 'ids id)))))
      ;; save the image just in case we get interrupted halfway through
      (with-temp-file filename
        (svg-print dom)))))

(defun my-svg-identify-rects (filename)
  (interactive (list (read-file-name "SVG: " nil nil
                                     (lambda (f)
                                       (or (string-match "\\.svg$" f)
                                           (file-directory-p f))))))
  (my-svg-identify-paths
   filename
   :selector
   (lambda (elem)
     (and (eq (dom-tag elem) 'rect)
          (not (and (dom-attr elem 'class)
                    (string-match "\\<background\\>" (dom-attr elem 'class))))))))

(defun my-org-links-from-file (filename)
  "Return a list of (description . link) of the Org links in FILENAME."
  (when (file-exists-p filename)
    (let (results)
      (with-temp-buffer
        (insert-file-contents filename)
        (goto-char (point-min))
        (while (re-search-forward org-link-any-re nil t)
          (push (cons (match-string-no-properties 3)
                      (or (match-string-no-properties 2)
                          (match-string-no-properties 0)))
                results)))
      (reverse results))))

(defun my-svg-linkify-rects (filename)
  (interactive (list (read-file-name "SVG: " nil nil
                                     (lambda (f)
                                       (or (string-match "\\.svg$" f)
                                           (file-directory-p f))))))
  (let ((dom (car (xml-parse-file filename)))
        (links-from-text (my-org-links-from-file (concat (file-name-sans-extension filename) ".txt"))))
    (my-svg-identify-paths
     filename
     :dom
     dom
     :selector
     (append
      ;; not yet linked
      (dom-search dom
                  (lambda (elem)
                    (and (eq (dom-tag elem) 'rect)
                         (not (and (dom-attr elem 'class)
                                   (string-match "\\<background\\|link-rect\\>" (dom-attr elem 'class)))))))
      ;; linked
      (dom-search dom
                  (lambda (elem)
                    (and (eq (dom-tag elem) 'rect)
                         (string-match "\\<link-rect\\>" (or (dom-attr elem 'class) ""))))))

     :node-func
     (lambda (elem dom)
       (let* ((current-link-node (my-dom-closest dom elem 'a))
              (current-title-node (or (dom-by-tag elem 'title)
                                      (dom-by-tag current-link-node 'title)))
              (title (string-trim
                      (completing-read
                      "Title: "
                      (mapcar 'car links-from-text)
                      nil nil
                      (dom-text current-title-node))))
              (link (string-trim
                     (read-string
                       "URL: "
                       (or (dom-attr current-link-node 'href)
                           (assoc-default title links-from-text 'string=)))
                     )))
         (cond
          ((and current-link-node (not (string= link "")))
           (dom-set-attribute elem
                              'style
                              "stroke: blue; stroke-dasharray: 4; fill: #006fff; fill-opacity: 0.25")
           (dom-set-attribute current-link-node 'href link))
          ((and current-link-node (string= link ""))
           (dom-add-child-before
            (dom-parent dom current-link-node)
            elem)
           (dom-remove-node current-link-node))
          ((and (null current-link-node) (not (string= link "")))
           (setq current-link-node (dom-node
                                    'a
                                    `((href . ,link)
                                      (class . "link"))))
           (dom-add-child-before (dom-parent dom elem) current-link-node elem)
           (dom-remove-node dom elem)
           (dom-append-child current-link-node elem)
           (dom-remove-attribute elem 'fill)
           (dom-set-attribute elem
                              'style
                              "stroke: blue; stroke-dasharray: 4; fill: #006fff; fill-opacity: 0.25")
           (dom-set-attribute
            elem
            'class
            (if (dom-attr elem 'class)
                (concat (dom-attr elem 'class) " link-rect")
              "link-rect"))))
         (cond
          ((and (string= title "") current-title-node)
           (dom-remove-node current-title-node))
          ((and (not (string= title "")) (not current-title-node))
           (dom-append-child current-link-node (dom-node 'title nil title)))
          ((and (not (string= title "")) current-title-node)
           (setf (car (dom-children current-title-node))
                 title))))))))

(defun my-svg-update-links-from-text (filename)
  (interactive (list (read-file-name
                      "SVG: " nil
                      (if (file-exists-p (concat (file-name-sans-extension (buffer-file-name)) ".svg"))
                          (concat (file-name-sans-extension (buffer-file-name)) ".svg")
                        (cdr (my-embark-image)))
                      (lambda (f)
                        (or (string-match "\\.svg$" f)
                            (file-directory-p f))))))
  (let ((dom (car (xml-parse-file filename)))
        (links-from-text (my-org-links-from-file (concat (file-name-sans-extension filename) ".txt"))))
    (dolist (link (dom-by-tag dom 'a))
      (when (and
             (assoc-default (dom-text (dom-by-tag link 'title))
                            links-from-text)
             (not (string=
                   (dom-attr link 'href)
                   (assoc-default (dom-text (dom-by-tag link 'title))
                                  links-from-text))))
        (dom-set-attribute
         link
         'href
         (assoc-default (dom-text (dom-by-tag link 'title))
                        links-from-text))))
    (with-temp-file filename
      (svg-print dom))))



Writing about the sketch

I tweaked my function for drafting a blog post about a sketch. I added panning and zooming capabilities using Javascript, included the sketch text, and added any sections that I referred to using anchors. (TODO: Come to think of it, I should rewrite those to be absolute links using the permalink so that they'll still make sense even if people bookmark them from the main page of my blog.)

my-write-about-sketch
(defun my-insert-sketch-and-text (sketch)
  (interactive (list (my-complete-sketch-filename)))
  (insert
   (format "#+begin_panzoom\n%s\n#+end_panzoom\n\n"
           (if (string= (file-name-extension sketch) "svg")
               (org-link-make-string (concat "file:" sketch))
             (org-link-make-string (concat "sketchFull:" sketch)))))
  (let ((links (my-org-links-from-file (concat (file-name-sans-extension sketch) ".txt")))
        (subheading-level (1+ (org-current-level))))
    (insert (if links
                "#+begin_my_details Text and links from sketch\n"
              "#+begin_my_details Text from sketch\n"))
    (my-sketch-insert-text sketch)
    (unless (bolp) (insert "\n"))
    (insert "#+end_my_details")
    (dolist (section (seq-filter (lambda (entry) (string-match "^#" (cdr entry)))
                                 links))
      (org-end-of-subtree)
      (insert "\n\n")
      (org-insert-heading nil nil subheading-level)
      (insert (car section))
      (org-entry-put (point) "CUSTOM_ID" (substring (cdr section) 1)))))

(defun my-write-about-sketch (sketch)
  (interactive (list (my-complete-sketch-filename)))
  (shell-command "make-sketch-thumbnails")
  (find-file "~/sync/orgzly/posts.org")
  (goto-char (point-min))
  (unless (org-at-heading-p) (outline-next-heading))
  (org-insert-heading nil nil t)
  (insert (file-name-base sketch) "\n\n")
  (my-insert-sketch-and-text sketch)
  (delete-other-windows)
  (save-excursion
    (with-selected-window (split-window-horizontally)
      (find-file sketch))))

And then I can export the image as an inline SVGs in Org Mode HTML and Markdown exports, yay!

Other functions not included above are probably somewhere in my Emacs config.

Using an SVG as a sticky table of contents

… and now I can make the image a sticky table of contents as you scroll down, by wrapping it in something like this:

#+begin_sticky-toc-after-scrolling
#+begin_panzoom
file:/home/sacha/sync/sketches/2025-01-17-01 Hyperlinking SVGs -- drawing supernote inkscape svg.svg
#+end_panzoom
#+end_sticky-toc-after-scrolling

Mwahahaha! (Now I just need to make it highlight different sections as we scroll…)

Here's the snippet from my misc.js:

Sticky table of contents after scrolling
function stickyTocAfterScrolling() {
  const elements = document.querySelectorAll('.sticky-toc-after-scrolling');
  let lastScroll = window.scrollY;
  const cloneMap = new WeakMap();

  elements.forEach(element => {
    const clone = element.cloneNode(true);
    clone.setAttribute('class', 'sticky-toc');
    cloneMap.set(element, clone);
    element.parentNode.insertBefore(clone, element.nextSibling);
    const zoom = panZoom = svgPanZoom(clone.querySelector('svg'));
    zoom.resetZoom();
  });

  const observer = new IntersectionObserver(
    (entries) => {
      const currentScroll = window.scrollY;
      const scrollingDown = currentScroll > lastScroll;
      lastScroll = currentScroll;

      entries.forEach(entry => {
        const element = entry.target;
        const clone = cloneMap.get(element);

        if (!entry.isIntersecting && scrollingDown) {
          clone.setAttribute('class', 'sticky-toc');
          clone.style.display = 'block';
        } else if (entry.isIntersecting && !scrollingDown) {
          element.style.visibility = 'visible';
          clone.style.display = 'none';
        }
      });
    },
    {
      root: null,
      threshold: 0,
      rootMargin: '-10px 0px 0px 0px'
    }
  );

  elements.forEach(element => {
    observer.observe(element);
  });

  window.addEventListener('resize', () => {
    elements.forEach(element => {
      const clone = cloneMap.get(element);
      if (clone.style.display != 'none') {
        // reset didn't seem to work
        svgPanZoom(clone.querySelector('svg')).destroy();
        addPanZoomToElement(clone.querySelector('svg'));
      }
    });
  }, { passive: true });
}

stickyTocAfterScrolling();
View org source for this post