Moving my Org post subtree to the 11ty directory

| 11ty, org, emacs, blogging

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

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

Then this adds a link to it:

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

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

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

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

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

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

Tweaking my writing workflow using SuperNote's new handwriting recognition

| blogging, supernote

Both Google Cloud Vision and SuperNote's new handwriting recognition handle my print fine. Neither handle columns the way I'd like, but to be fair, I'm not really sure how I want columns and wrapping handled anyway. I can always experiment with the standard use-case: one column of text, to export as text (with perhaps the occasional sketch, which I can crop and include).

If I can get the hang of writing my thoughts, then it turns some of those bedtime hours into writing hours. Writing by hand feels slow and linear, but it's better than nothing, and thinking takes most of the time anyway. While speech recognition feels like it might be faster in short bursts, I don't have a lot of "talking to myself" time (aside from sleepy brain dumps), and my workflow for processing audio is still slow and disjointed. I can't type on my phone because then A- will want to be on a screen too. I'm glad e-ink devices are different enough not to trigger her sense of unfairness, although sometimes she does ask if she can do mazes or connect-the-dots. Then I switch to knitting until it's really really time to go to bed.

I'm slowly figuring out my workflows for experimenting with and writing about code. Naturally, that's a little more challenging to write about by hand, but I could draft the context. I can think through life stuff too, and maybe look into saving more notes in my Org files.

I've experimented with handwritten blog posts before. Now that I have a little more time to tweak my workflow and think thoughts, maybe I'll get the hang of them!


It looks like the Supernote's real-time recognition is pretty accurate for my handwriting, getting the text out of multiple pages is pretty straightforward.

Here's the raw TXT output from the Supernote.

Here's what it took to edit it into the first part of this post - just adding line-breaks and fixing up some words:

"A screen recording showing editing"
Figure 1: My editing process - just added line breaks and fixed some words
Source images

[["The first page of my handwritten post"

"The second page of my handwritten post"
Figure 2: Second page

If I add more lines between paragraphs when writing, I might be able to skip adding them in the text export.

For comparison, here's the text output from Google Cloud Vision.

Tweaking my handwriting workflow
Both Google Cloud Vision and Super Note's new
handwriting recognition handle my print fine. Neither
handle columns the way I'd like, but to be fair,
I'm not really sure how I want columns and wrapping
handled anyway I can always experiment with the
standard use-case
use-case: One column of text, to export
as Text (with perhaps the occasional sketch, which
can crop and include).
If I can get the hang of writing my thoughts,
then it turns some of those bedtime hours into writi
writing
hours. Writing by hand feels slow and linear, but it's
better than nothing, and thinking takes most of the time
anyway while speech recognition feels like it might be
faster in short bursts, don't have a lot of "talking to
myself" time (aside from sleepy braindumps), and my workflow
for processing audio is still slow and disjointed. I can't
type on my phone because then A- will want to be on

I'm glad e-ink devices are different enough
not to trigger her sense of unfairness, although sometimes
she does ask if she can do mazes or connect-the-dots
a screen too
Then I switch to Knitting until it's really really time to
go to bed.
I'm slowly figuring out my workflows for experimenting
with and writing about code. Naturally, that's a little
more challenging to write about by hand, but I could
draft the context. I can think through life stuff too, and
maybe look into saving more notes in my org files
I've experimented with handwritten blog posts before
Now that I have a little more time to tweak my workflow
and think thoughts, maybe I'll get the hang of them!

I'm leaning towards SuperNote's recognition results for long text, although I don't get access to the confidence data so I'll probably just have to delete the misrecognized text if I include sketches.

Org Mode: Including portions of files between two regular expressions

| org, emacs

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

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

which will turn into this snippet from my stylesheet:

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

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

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

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

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

Using Javascript to add a "Copy code" link to source code blocks in my blog posts

| css, js, blogging

I'd like to write about code more often. It's easier for people to try out ideas if they can copy the code without fiddling with selecting the text, especially on mobile browsers, so "Copy code" buttons on source code blocks would be nice. I used this tutorial for adding code buttons as a basis for the following CSS and JS code.

First, let's add the buttons with Javascript. I want the buttons to be visible in the summary line if I'm using the <details /> element. If not, they can go in the div with the org-src-container class.

/* Start of copy code */
// based on https://www.roboleary.net/2022/01/13/copy-code-to-clipboard-blog.html
const copyLabel = 'Copy code';

async function copyCode(block, button) {
  let code = block.querySelector('pre.src');
  let text = code.innerText;
  await navigator.clipboard.writeText(text);
  button.innerText = 'Copied';
  setTimeout(() => {
    button.innerText = copyLabel;
  }, 500);
}

function addCopyCodeButtons() {
  if (!navigator.clipboard) return;
  let blocks = document.querySelectorAll('.org-src-container');
  blocks.forEach((block) => {
    let button = document.createElement('button');
    button.innerText = copyLabel;
    button.classList.add('copy-code');
    let details = block.closest('details');
    let summary = details && details.querySelector('summary');
    if (summary) {
      summary.appendChild(button);
    } else {
      block.appendChild(button);
    }
    button.addEventListener('click', async() => {
      await copyCode(block, button);
    });
    block.setAttribute('tabindex', 0);
  });
}
document.addEventListener("DOMContentLoaded", function(event) { 
  addCopyCodeButtons();
});
/* End of copy code */

Then we style it:

/* 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 */

Someday I'll figure out how to make it easier to tangle things to the post's directory and make the file available for download. In the meantime, this might be a good start.

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!

Rename, recolor, and file my sketches automatically

| geek, supernote, python, drawing

I want to make it easier to process the sketchnotes I make on my Supernote. I write IDs of the form yyyy-mm-dd-nn to identify my sketches. To avoid duplicates, I get these IDs from the web-based journaling system I wrote. I've started putting the titles and tags into those journal entries as well so that I can reuse them in scripts. When I export a sketch to PNG and synchronize it, the file appears in my ~/Dropbox/Supernote/EXPORT directory on my laptop. Then it goes through this process:

  • I use Google Cloud Vision to detect handwriting so that I can find the ID.
    • I retrieve the matching entry from my journal system and rename the file based on the title and tags.
    • If there's no matching entry, I rename the file based on the ID.
  • If there are other tags or references in the sketch, I add those to the filename as well.
  • I recolor it based on the tags, so parenting-related posts are a little purple, tech/Emacs-related posts are blue, and things are generally highlighted in yellow otherwise.
  • I move it to a directory based on the tags.
    • If it's a private sketch, I move it to the directory for my private sketches.
    • If it's a public sketch, I move it to the directory that will eventually get synchronized to sketches.sachachua.com, and I reload the list of sketches after some delay.

The following code does that processing.

Download supernote-daemon

supernote-daemon source code
#!/usr/bin/python3
# -*- mode: python -*-

# (c) 2022-2023 Sacha Chua (sacha@sachachua.com) - MIT License

# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation files
# (the "Software"), to deal in the Software without restriction,
# including without limitation the rights to use, copy, modify, merge,
# publish, distribute, sublicense, and/or sell copies of the Software,
# and to permit persons to whom the Software is furnished to do so,
# subject to the following conditions:

# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.


import os
import json
import re
import requests
import time
from dotenv import load_dotenv
# Import the Google Cloud client libraries
from google.cloud import vision
from google.cloud.vision_v1 import AnnotateImageResponse
import sys
sys.path.append("/home/sacha/proj/supernote/")
import recolor   # noqa: E402  # muffles flake8 error about import
load_dotenv()


# Set the folder path where the png files are located
folder_path = '/home/sacha/Dropbox/Supernote/EXPORT/'
public_sketch_dir = '/home/sacha/sync/sketches/'
private_sketch_dir = '/home/sacha/sync/private-sketches/'

# Initialize the Google Cloud Vision client
client = vision.ImageAnnotatorClient()
refresh_counter = 0

def extract_text(client, file):
    json_file = file[:-3] + 'json'
    # TODO Preprocess to keep only black text
    with open(file, 'rb') as image_file:
        content = image_file.read()
    # Convert the png file to a Google Cloud Vision image object
    image = vision.Image(content=content)

    # Extract handwriting from the image using the Google Cloud Vision API
    response = client.document_text_detection(image=image)
    response_json = AnnotateImageResponse.to_json(response)
    json_response = json.loads(response_json)
    # Save the response to a json file with the same name as the png file
    with open(json_file, "w") as f:
        json.dump(json_response, f)


def maybe_rename(file):
    # TODO Match on ID
    json_file = file[:-3] + 'json'
    with open(json_file, 'r') as f:
        data = json.load(f)

    # Extract the text from the json file
    text = data['fullTextAnnotation']['text']

    # Check if the text contains a string matching the regex pattern
    pattern = r'(?<!ref:)[0-9]{4}-[0-9]{2}-[0-9]{2}-[0-9]{2}'
    match = re.search(pattern, text)
    if match:
        # Get the matched string
        matched_string = match.group(0)
        new_name = matched_string
        from_zid = get_journal_entry(matched_string).strip()
        if from_zid:
            new_name = matched_string + ' ' + from_zid
        tags = get_tags(new_name, text)
        if tags:
            new_name = new_name + ' ' + tags
        ref = get_references(text)
        if ref:
            new_name = new_name + ' ' + ref
        print('Renaming ' + file + ' to ' + new_name)
        # Rename the png and json files to the matched string
        new_filename = os.path.join(os.path.dirname(file), new_name + '.png')
        rename_set(file, new_filename)
        return new_filename


def get_tags(filename, text):
    tags = re.findall(r'(^|\W)#[ \n\t]+', text)
    return ' '.join(filter(lambda x: x not in filename, tags))


def get_references(text):
    refs = re.findall(r'!ref:[0-9]{4}-[0-9]{2}-[0-9]{2}-[0-9]{2}', text)
    return ' '.join(refs)


def get_journal_entry(zid):
    resp = requests.get('https://' + os.environ['JOURNAL_USER']
                        + ':' + os.environ['JOURNAL_PASS']
                        + '@journal.sachachua.com/api/entries/' + zid)
    j = resp.json()
    if j and not re.search('^I thought about', j['Note']):
        return j['Note']


def get_color_map(filename, text=None):
    if text:
        together = filename + ' ' + text
    else:
        together = filename
    if re.search('r#(parenting|purple|life)', together):
        return {'9d9d9d': '8754a1', 'c9c9c9': 'e4c1d9'}  # parenting is purplish
    elif re.search(r'#(emacs|geek|tech|blue)', together):
        return {'9d9d9d': '2b64a9', 'c9c9c9': 'b3e3f1'}  # geeky stuff in light/dark blue
    else:
        return {'9d9d9d': '884636', 'c9c9c9': 'f6f396'}  # yellow highlighter, dark brown


def rename_set(old_name, new_name):
    if old_name != new_name:
        old_json = old_name[:-3] + 'json'
        new_json = new_name[:-3] + 'json'
        os.rename(old_name, new_name)
        os.rename(old_json, new_json)


def recolor_based_on_filename(filename):
    color_map = get_color_map(filename)
    recolored = recolor.map_colors(filename, color_map)
    # possibly rename based on the filename
    new_filename = re.sub(' #(purple|blue)', '', filename)
    rename_set(filename, new_filename)
    recolored.save(new_filename)


def move_processed_sketch(file):
    global refresh_counter
    if '#private' in file:
        output_dir = private_sketch_dir
    elif '#' in file:
        output_dir = public_sketch_dir
        refresh_counter = 3
    else:
        return file
    new_filename = os.path.join(output_dir, os.path.basename(file))
    rename_set(file, new_filename)
    return new_filename


def process_file(file):
    json_file = file[:-3] + 'json'
    # Check if a corresponding json file already exists
    if not os.path.exists(json_file):
        extract_text(client, file)
    if not re.search('[0-9]{4}-[0-9]{2}-[0-9]{2}-[0-9]{2} ', file):
        file = maybe_rename(file)
    recolor_based_on_filename(file)
    move_processed_sketch(file)


def process_dir(folder_path):
    global processed_files
    # Iterate through all png files in the specified folder
    files = sorted(os.listdir(folder_path))
    for file in files:
        if file.endswith('.png') and '_' in file:
            print("Processing ", file)
            process_file(os.path.join(folder_path, file))


def daemon(folder_path, wait):
    global refresh_counter
    while True:
        process_dir(folder_path)
        time.sleep(wait)
        if refresh_counter > 0:
            refresh_counter = refresh_counter - 1
            if refresh_counter == 0:
                print("Reloading sketches")
                requests.get('https://' + os.environ['JOURNAL_USER'] + ':'
                             + os.environ['JOURNAL_PASS']
                             + '@sketches.sachachua.com/reload?python=1')


if __name__ == '__main__':
    # Create a set to store the names of processed files
    processed_files = set()
    if len(sys.argv) > 1:
        if os.path.isdir(sys.argv[1]):
            folder_path = sys.argv[1]
            daemon(folder_path, 300)
        else:
            for f in sys.argv[1:]:
                process_file(f)
    else:
        daemon(folder_path, 300)

It uses this script I wrote to recolor my sketches with Python.

I'm contemplating writing some annotation tools to make it easier to turn the detected text into useful text for searching or writing about because the sketches throw off the recognition (misrecognized text, low confidence) and the columns mess up the line wrapping. Low priority, though.

My handwriting (at least for numbers) is probably simple enough that I might be able to train Tesseract OCR to process that someday. And who knows, maybe some organization will release a pre-trained model for offline handwriting recognition that'll be as useful as OpenAI Whisper is for audio files. That would be neat!