Categories: geek » emacs

RSS - Atom - Subscribe via email

Using the calendar-date-echo-text variable to help plot a heatmap on a year-long calendar in Emacs

| emacs
output-2023-01-06-10-26-49.gif
Figure 1: Sketch heatmap from 2008-2023

Building on Display a calendar heat map using Emacs Lisp, I figured out how to use calendar-date-echo-text to store the date so that I can pick it up when plotting the heatmap:

;; This seems to be the only way we can hack the date in for now
(setq calendar-date-echo-text '(apply #'format (list "%04d-%02d-%02d" year month day)))

(defun my-calendar-heat-map-using-echo-text (&rest _)
  (when my-calendar-count-scaled
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (let* ((help (get-text-property (point) 'help-echo))
               (next-change
                (or (next-single-property-change (point) 'help-echo)
                    (point-max)))
               (inhibit-read-only t)
               (count-scaled (and help
                                  (assoc-default
                                   help
                                   my-calendar-count-scaled))))
          (when (and help
                     (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" help)
                     count-scaled)
            (put-text-property
             (point) (+ 2 (point))
             'face (intern (format "calendar-scale-%d" count-scaled))))
          (goto-char next-change))))))

(advice-add #'calendar :after #'my-calendar-heat-map-using-echo-text)
(advice-add #'calendar-redraw :after #'my-calendar-heat-map-using-echo-text)
(advice-add #'year-calendar :after #'my-calendar-heat-map-using-echo-text)
(add-hook 'calendar-move-hook #'my-calendar-heat-map-using-echo-text)

So now I don't need the advice around calendar-generate-month, just the code that sets up the faces, loads the values, and figures out the data.

Previous source code (tweaked foreground colours)
(defface calendar-scale-1  '((((background light)) :foreground "black" :background "#eceff1")
                             (((background dark))  :foreground "white" :background "#263238")) "")
(defface calendar-scale-2  '((((background light)) :foreground "black" :background "#cfd8dc")
                             (((background dark))  :foreground "white" :background "#37474f")) "")
(defface calendar-scale-3  '((((background light)) :foreground "black" :background "#b0bec5")
                             (((background dark))  :foreground "white" :background "#455a64")) "")
(defface calendar-scale-4  '((((background light)) :foreground "black" :background "#90a4ae")
                             (((background dark))  :foreground "white" :background "#546e7a")) "")
(defface calendar-scale-5  '((((background light)) :foreground "black" :background "#78909c")
                             (((background dark))  :foreground "white" :background "#607d8b")) "")
(defface calendar-scale-6  '((((background light)) :foreground "white" :background "#607d8b")
                             (((background dark))  :foreground "black" :background "#78909c")) "")
(defface calendar-scale-7  '((((background light)) :foreground "white" :background "#546e7a")
                             (((background dark))  :foreground "black" :background "#90a4ae")) "")
(defface calendar-scale-8  '((((background light)) :foreground "white" :background "#455a64")
                             (((background dark))  :foreground "black" :background "#b0bec5")) "")
(defface calendar-scale-9  '((((background light)) :foreground "white" :background "#37474f")
                             (((background dark))  :foreground "black" :background "#cfd8dc")) "")
(defun my-count-calendar-entries (grouped-entries)
  (mapcar (lambda (entry) (cons (car entry) (length (cdr entry)))) grouped-entries))

(defface calendar-scale-10 '((((background light)) :foreground "white" :background "#263238")
                             (((background dark))  :foreground "black" :background "#eceff1")) "")

(defun my-scale-calendar-entries (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (cdr entry)) count-max)))
            count)))

(defun my-scale-calendar-entries-logarithmically (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (log (cdr entry))) (log count-max))))
            count)))

(defvar my-calendar-count-scaled nil "Values to display.")

Now I can have it display the last year of data or so.

(defun my-calendar-visualize (values)
  (setq my-calendar-count-scaled values)
  (let* ((date (calendar-current-date))
         (month (calendar-extract-month date))
         (year (calendar-extract-year date)))
    (year-calendar month (1- year))))

The code to load the data stays the same.

Loading the data
(defun my-calendar-visualize-journal-entries ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (+ 1 (* 7.0 (cdr o))))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (cdr (pcsv-parse-file "~/Downloads/entries.csv")))))))

(defun my-calendar-visualize-sketches ()
  (interactive)
  (let ((my-calendar-sketches
         (assoc-delete-all
          nil
          (seq-group-by
           (lambda (o)
             (when (string-match "^\\([0-9][0-9][0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)" o)
               (format "%s-%s-%s"
                       (match-string 1 o)
                       (match-string 2 o)
                       (match-string 3 o))))
           (append
            (directory-files "~/sync/sketches" nil "\\.\\(png\\|jpg\\)\\'")
            (directory-files "~/sync/private-sketches" nil "\\.\\(png\\|jpg\\)\\'"))))))
    (my-calendar-visualize
     (mapcar
      (lambda (o)
        (cons (car o)
              ;; many days have just 1 sketch, so I set the low end of the scale
              ;; to make them visible, and use a logarithmic scale for the rest
              (ceiling (+ 3 (* 7.0 (cdr o))))))
      (my-scale-calendar-entries-logarithmically my-calendar-sketches)))))

(defun my-calendar-visualize-tantrums ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (* 10.0 (cdr o)))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (seq-filter (lambda (o) (string-match "tantrum\\|grump\\|angry\\|meltdown"
                                                           (my-journal-note o)))
                               (cdr (pcsv-parse-file "~/Downloads/entries.csv"))))))))

Here's the code from lawlist's StackOverflow answer that displays the Emacs calendar for a year:

Source code for showing an Emacs calendar year
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                            ;;;
;;; Scroll a yearly calendar by month -- in a forwards or backwards direction. ;;;
;;;                                                                            ;;;
;;; To try out this example, evaluate the entire code snippet and type:        ;;;
;;;                                                                            ;;;
;;;     M-x year-calendar                                                      ;;;
;;;                                                                            ;;;
;;; To scroll forward by month, type the key:  >                               ;;;
;;;                                                                            ;;;
;;; To scroll backward by month, type the key:  <                              ;;;
;;;                                                                            ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(eval-after-load "calendar" '(progn
  (define-key calendar-mode-map "<" 'lawlist-scroll-year-calendar-backward)
  (define-key calendar-mode-map ">" 'lawlist-scroll-year-calendar-forward) ))

(defmacro lawlist-calendar-for-loop (var from init to final do &rest body)
  "Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
inclusive.  The standard macro `dotimes' is preferable in most cases."
  `(let ((,var (1- ,init)))
    (while (>= ,final (setq ,var (1+ ,var)))
      ,@body)))

(defun year-calendar (&optional month year)
  "Generate a one (1) year calendar that can be scrolled by month in each direction.
This is a modification of:  http://homepage3.nifty.com/oatu/emacs/calendar.html
See also:  http://ivan.kanis.fr/caly.el"
(interactive)
  (require 'calendar)
  (let* ((current-year (number-to-string (nth 5 (decode-time (current-time)))))
         (month (if month month
           (string-to-number
             (read-string "Please enter a month number (e.g., 1):  " nil nil "1"))))
         (year (if year year
           (string-to-number
             (read-string "Please enter a year (e.g., 2014):  "
               nil nil current-year)))))
    (switch-to-buffer (get-buffer-create calendar-buffer))
    (when (not (eq major-mode 'calendar-mode))
      (calendar-mode))
    (setq displayed-month month)
    (setq displayed-year year)
    (setq buffer-read-only nil)
    (erase-buffer)
    ;; horizontal rows
    (lawlist-calendar-for-loop j from 0 to 3 do
      ;; vertical columns
      (lawlist-calendar-for-loop i from 0 to 2 do
        (calendar-generate-month
          ;; month
          (cond
            ((> (+ (* j 3) i month) 12)
              (- (+ (* j 3) i month) 12))
            (t
              (+ (* j 3) i month)))
          ;; year
          (cond
            ((> (+ (* j 3) i month) 12)
             (+ year 1))
            (t
              year))
          ;; indentation / spacing between months
          (+ 5 (* 25 i))))
      (goto-char (point-max))
      (insert (make-string (- 10 (count-lines (point-min) (point-max))) ?\n))
      (widen)
      (goto-char (point-max))
      (narrow-to-region (point-max) (point-max)))
    (widen)
    (goto-char (point-min))
    (setq buffer-read-only t)))

(defun lawlist-scroll-year-calendar-forward (&optional arg event)
  "Scroll the yearly calendar by month in a forward direction."
  (interactive (list (prefix-numeric-value current-prefix-arg)
                     last-nonmenu-event))
  (unless arg (setq arg 1))
  (save-selected-window
    (if (setq event (event-start event)) (select-window (posn-window event)))
    (unless (zerop arg)
      (let ((month displayed-month)
            (year displayed-year))
        (calendar-increment-month month year arg)
        (year-calendar month year)))
    (goto-char (point-min))
    (run-hooks 'calendar-move-hook)))

(defun lawlist-scroll-year-calendar-backward (&optional arg event)
  "Scroll the yearly calendar by month in a backward direction."
  (interactive (list (prefix-numeric-value current-prefix-arg)
                     last-nonmenu-event))
  (lawlist-scroll-year-calendar-forward (- (or arg 1)) event))

It might be fun to scroll by year:

(defun my-scroll-year-calendar-forward-year (&optional arg event)
  "Scroll the yearly calendar by year in a forward direction."
  (interactive (list (prefix-numeric-value current-prefix-arg)
                     last-nonmenu-event))
  (unless arg (setq arg 1))
  (save-selected-window
    (if (setq event (event-start event)) (select-window (posn-window event)))
    (unless (zerop arg)
      (setq displayed-year (+ (or arg 1) displayed-year))
      (year-calendar displayed-month displayed-year))
    (goto-char (point-min))
    (run-hooks 'calendar-move-hook)))

(defun my-scroll-year-calendar-backward-year (&optional arg event)
  "Scroll the yearly calendar by month in a backward direction."
  (interactive (list (prefix-numeric-value current-prefix-arg)
                     last-nonmenu-event))
  (my-scroll-year-calendar-forward-year (- (or arg 1)) event))
(eval-after-load "calendar" '(progn
  (define-key calendar-mode-map "{" 'my-scroll-year-calendar-backward-year)
  (define-key calendar-mode-map "}" 'my-scroll-year-calendar-forward-year)))

I used M-x gif-screencast to make the animated GIF. Yay Emacs!

Display a calendar heat map using Emacs Lisp

| emacs

I was curious about how to quickly visualize my date-related data in Emacs, such as when I sketched my thoughts or which days had journal entries or how often A- had tantrums. (It's hard to be 6 years old.) I wrote this code based on nrougier's code for colouring calendar days using advice around calendar-generate-entries:

(defface calendar-scale-1  '((((background light)) :foreground "black" :background "#eceff1")
                             (((background dark))  :foreground "white" :background "#263238")) "")
(defface calendar-scale-2  '((((background light)) :foreground "black" :background "#cfd8dc")
                             (((background dark))  :foreground "white" :background "#37474f")) "")
(defface calendar-scale-3  '((((background light)) :foreground "black" :background "#b0bec5")
                             (((background dark))  :foreground "white" :background "#455a64")) "")
(defface calendar-scale-4  '((((background light)) :foreground "black" :background "#90a4ae")
                             (((background dark))  :foreground "white" :background "#546e7a")) "")
(defface calendar-scale-5  '((((background light)) :foreground "black" :background "#78909c")
                             (((background dark))  :foreground "white" :background "#607d8b")) "")
(defface calendar-scale-6  '((((background light)) :foreground "black" :background "#607d8b")
                             (((background dark))  :foreground "white" :background "#78909c")) "")
(defface calendar-scale-7  '((((background light)) :foreground "black" :background "#546e7a")
                             (((background dark))  :foreground "white" :background "#90a4ae")) "")
(defface calendar-scale-8  '((((background light)) :foreground "black" :background "#455a64")
                             (((background dark))  :foreground "white" :background "#b0bec5")) "")
(defface calendar-scale-9  '((((background light)) :foreground "black" :background "#37474f")
                             (((background dark))  :foreground "white" :background "#cfd8dc")) "")
(defface calendar-scale-10 '((((background light)) :foreground "black" :background "#263238")
                             (((background dark))  :foreground "white" :background "#eceff1")) "")

(defun my-count-calendar-entries (grouped-entries)
  (mapcar (lambda (entry) (cons (car entry) (length (cdr entry)))) grouped-entries))

(defun my-scale-calendar-entries (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (cdr entry)) count-max)))
            count)))

(defun my-scale-calendar-entries-logarithmically (grouped-entries &optional scale-max)
  (let* ((count (my-count-calendar-entries grouped-entries))
         (count-max (apply #'max (mapcar (lambda (o) (if (car o) (cdr o) 0)) count))))
    (mapcar (lambda (entry)
              (cons (car entry)
                    (/ (* 1.0 (or scale-max 1.0) (log (cdr entry))) (log count-max))))
            count)))

(defvar my-calendar-count-scaled nil "Values to display.")

(defun my-calendar-heat-map (month year indent)
  (when my-calendar-count-scaled
    (dotimes (i 31)
      (let ((date (list month (1+ i) year))
            (count-scaled (assoc-default (format "%04d-%02d-%02d" year month (1+ i))
                                         my-calendar-count-scaled)))
        (when count-scaled
          (calendar-mark-visible-date
           date
           (intern (format "calendar-scale-%d" count-scaled))))))))

(advice-add #'calendar-generate-month :after #'my-calendar-heat-map)
;(advice-remove #'calendar-generate-month #'my-calendar-heat-map)

(defun my-calendar-visualize (values)
  (setq my-calendar-count-scaled values)
  (calendar))

Journal entries

So if I want to visualize the days with journal entries, I can use this code:

(defun my-calendar-visualize-journal-entries ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (+ 1 (* 7.0 (cdr o))))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (cdr (pcsv-parse-file "~/Downloads/entries.csv")))))))
2023-01-05_21-42-06.png
Figure 1: Journal entries

Sketches

(defun my-calendar-visualize-sketches ()
  (interactive)
  (let ((my-calendar-sketches
         (assoc-delete-all
          nil
          (seq-group-by
           (lambda (o)
             (when (string-match "^\\([0-9][0-9][0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)[-_]?\\([0-9][0-9]\\)" o)
               (format "%s-%s-%s"
                       (match-string 1 o)
                       (match-string 2 o)
                       (match-string 3 o))))
           (append
            (directory-files "~/sync/sketches" nil "\\.\\(png\\|jpg\\)\\'")
            (directory-files "~/sync/private-sketches" nil "\\.\\(png\\|jpg\\)\\'"))))))
    (my-calendar-visualize
     (mapcar
      (lambda (o)
        (cons (car o)
              ;; many days have just 1 sketch, so I set the low end of the scale
              ;; to make them visible, and use a logarithmic scale for the rest
              (ceiling (+ 3 (* 7.0 (cdr o))))))
      (my-scale-calendar-entries-logarithmically my-calendar-sketches)))))
2023-01-05_21-37-03.png
Figure 2: Sketches

Big feelings

(defun my-calendar-visualize-tantrums ()
  (interactive)
  (my-calendar-visualize
   (mapcar
    (lambda (o)
      (cons
       (car o)
       (ceiling (* 10.0 (cdr o)))))
    (my-scale-calendar-entries
     (seq-group-by #'my-journal-date
                   (seq-filter (lambda (o) (string-match "tantrum\\|grump\\|angry\\|meltdown"
                                                           (my-journal-note o)))
                               (cdr (pcsv-parse-file "~/Downloads/entries.csv"))))))))
2023-01-05_21-46-22.png
Figure 3: Tantrums and meltdowns

(The start of the schoolyear was pretty rough.)

I'd like to figure out a yearly calendar view, and maybe use the calendar as a way to navigate my data too. calendar-mark-visible-date relies on the position and gets confused by the stuff I tried from these yearly calendar hacks, but maybe I can change calendar-date-echo-text to '(calendar-iso-date-string (list month day year)) and then extract the data from the help-echo property, since mysteriously, the date doesn't actually seem to be otherwise stored in the calendar. Anyway, I'll post that when I figure it out!

Linking to and exporting function definitions in Org Mode

| emacs

I'd like to write more blog posts about little Emacs hacks, and I'd like to do it with less effort. Including source code is handy even when it's missing some context from other functions defined in the same file, since sometimes people pick up ideas and having the source code right there means less flipping between links. When I'm working inside my config file or other literate programming documents, I can just write my blog post around the function definitions. When I'm talking about Emacs Lisp functions defined elsewhere, though, it's a little more annoying to copy the function definition and put it in a source block, especially if there are updates.

The following code creates a defun link type that exports the function definition. It works for functions that can be located with find-function, so only functions loaded from .el files, but that does what I need for now. Probably once I post this, someone will mention a much more elegant way to do things. Anyway, it makes it easier to use org-store-link to capture a link to the function, insert it into a blog post, navigate back to the function, and export HTML.

(defun my-org-defun-complete ()
  "Return function definitions."
  (completing-read
   "Function: "
   #'help--symbol-completion-table
   #'fboundp
   'confirm
   nil nil
   (and fn (symbol-name fn))))

(defun my-org-defun-export (symbol description format _)
  "Export the function."
  (save-window-excursion
    (find-function (intern symbol))
    (let ((function-body (buffer-substring (point)
                                           (progn (forward-sexp) (point)))))
      (pcase format
        ((or '11ty 'html)
         (format "<div class=\"org-src-container\">\n<details><summary>%s</summary><pre class=\"src src-emacs-lisp\">%s</pre></details></div>"
                 symbol
                 (org-html-do-format-code function-body "emacs-lisp" nil nil nil nil)))
        (`ascii function-body)
        (_ function-body)))))

(defun my-org-defun-store ()
  "Store a link to the function."
  (when (derived-mode-p 'emacs-lisp-mode)
    (org-link-store-props :type "defun"
                          :link (concat "defun:" (lisp-current-defun-name)))))

(defun my-org-defun-open (symbol _)
  "Jump to the function definition."
  (find-function (intern symbol)))

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

For example, if I have something like the following Org markup:

defun:emacsconf-prep-agenda

I can pull in the definition of emacsconf-prep-agenda from emacsconf.el, which you can find in the emacsconf-el repository.

emacsconf-prep-agenda
(defun emacsconf-prep-agenda ()
  (interactive)
  (let* ((org-agenda-custom-commands
         `(("a" "Agenda"
            ((tags-todo "-PRIORITY=\"C\"-SCHEDULED={.}-nextyear"
                        ((org-agenda-files (list ,emacsconf-notebook))
                         (org-agenda-sorting-strategy '(priority-down effort-up))))
             (agenda ""
                     ((org-agenda-files (list ,emacsconf-notebook))
                      (org-agenda-span 7)))
             )))))
    (org-agenda nil "a")))

This is part of my Emacs configuration.

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

| emacs, emacsconf, org

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

This function scheduled the timers:

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

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

Sometimes I wanted to cancel just one timer:

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

and schedule just one timer manually:

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

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

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

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

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

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

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

The actual announcements were handled by something like this:

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

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

Yay timers, Emacs, and TRAMP!

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

2023-01-02 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Hacker News, lobste.rs, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, emacs-devel, and lemmy/c/emacs. 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!

2022-12-26 Emacs news

| emacs, emacs-news

Links from reddit.com/r/emacs, r/orgmode, r/spacemacs, r/planetemacs, Hacker News, lobste.rs, planet.emacslife.com, YouTube, the Emacs NEWS file, Emacs Calendar, emacs-devel, and lemmy/c/emacs. 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!

Comparison-shopping with Org Mode

| emacs, org

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

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

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

Figure 1: Comparison-shopping

using code that looks like this:

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

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

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

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

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

This is part of my Emacs configuration.