branch: externals/denote
commit 2a3436e1112540868c388c577c6b88d6c1caac66
Merge: 90372d9627 27ef655bc8
Author: Protesilaos Stavrou <i...@protesilaos.com>
Commit: Protesilaos Stavrou <i...@protesilaos.com>
Merge branch 'sequence-notes-extension'
---
denote-sequence.el | 325 +++++++++++++++++++++++++++++++++++++++++++++++++++
tests/denote-test.el | 69 +++++++++++
2 files changed, 394 insertions(+)
diff --git a/denote-sequence.el b/denote-sequence.el
new file mode 100644
index 0000000000..c719706acc
--- /dev/null
+++ b/denote-sequence.el
@@ -0,0 +1,325 @@
+;;; denote-sequence.el --- Sequence notes extension for Denote -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
+
+;; Author: Protesilaos Stavrou <i...@protesilaos.com>
+;; Maintainer: Protesilaos Stavrou <i...@protesilaos.com>
+;; URL: https://github.com/protesilaos/denote
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; WORK-IN-PROGRESS. Sequence notes extension for Denote.
+
+;;; Code:
+
+;; FIXME 2024-12-25: Right now I am hardcoding the = as a field
+;; separator inside of the Denote signature. This is the default
+;; behaviour, though we provide the `denote-file-name-slug-functions'
+;; which, in principle, make the separator anything the user wants.
+;; If we can accommodate such open-endedness, then I am happy to make
+;; the relevant changes, but I prefer to keep it restricted at this
+;; early stage.
+;;
+;; Similarly, I am not giving the option for Luhmann-style sequences
+;; that include numbers and letters. Ours consist only of numbers,
+;; since (i) it is simpler and (ii) we already have the field
+;; separator to give a sufficient sense of place.
+
+(require 'denote)
+
+(defgroup denote-sequence ()
+ "Sequence notes extension for Denote."
+ :group 'denote
+ :link '(info-link "(denote) top")
+ :link '(url-link :tag "homepage" "https://protesilaos.com/emacs/denote";))
+
+(defconst denote-sequence-regexp "=?[0-9]+"
+ "Pattern of a sequence.")
+
+(defconst denote-sequence-types '(parent child sibling)
+ "Types of sequence.")
+
+(defun denote-sequence-p (sequence)
+ "Return SEQUENCE string if it matches `denote-sequence-regexp'."
+ (when (and (string-match-p denote-sequence-regexp sequence)
+ (not (string-match-p "[a-zA-Z]" sequence))
+ (not (string-suffix-p "=" sequence)))
+ sequence))
+
+(defun denote-sequence-file-p (file)
+ "Return non-nil if Denote signature of FILE is a sequence.
+A sequence is string that matches `denote-sequence-regexp'."
+ (when-let* ((signature (denote-retrieve-filename-signature file)))
+ (denote-sequence-p signature)))
+
+(defun denote-sequence-split (sequence)
+ "Split the SEQUENCE string into a list.
+SEQUENCE conforms with `denote-sequence-p'."
+ (if (denote-sequence-p sequence)
+ (split-string sequence "=" t)
+ (error "The sequence `%s' does not pass `denote-sequence-p'" sequence)))
+
+(defun denote-sequence-depth (sequence)
+ "Get the depth of SEQUENCE.
+For example, 1=2=1 is three levels deep."
+ (length (denote-sequence-split sequence)))
+
+(defun denote-sequence-get-all-files ()
+ "Return all files in variable `denote-directory' with a sequence.
+A sequence is a Denote signature that conforms with `denote-sequence-p'."
+ (seq-filter #'denote-sequence-file-p (denote-directory-files)))
+
+(defun denote-sequence-get-all-sequences (&optional files)
+ "Return all sequences in `denote-directory-files'.
+A sequence is a Denote signature that conforms with `denote-sequence-p'.
+
+With optional FILES return all sequences among them instead."
+ (delq nil (mapcar #'denote-sequence-file-p (or files
(denote-directory-files)))))
+
+(defun denote-sequence-get-all-sequences-with-prefix (sequence &optional
sequences)
+ "Get all sequences which extend SEQUENCE.
+A sequence is a Denote signature that conforms with `denote-sequence-p'.
+
+With optional SEQUENCES operate on those, else use the return value of
+`denote-sequence-get-all-sequences'."
+ (seq-filter
+ (lambda (string)
+ (string-prefix-p sequence string))
+ (or sequences (denote-sequence-get-all-sequences))))
+
+(defun denote-sequence-get-sequences-with-max-depth (depth &optional sequences)
+ "Get sequences up to DEPTH (inclusive).
+With optional SEQUENCES operate on those, else use the return value of
+`denote-sequence-get-all-sequences'."
+ (let* ((strings (or sequences (denote-sequence-get-all-sequences)))
+ (lists-all (mapcar #'denote-sequence-split strings))
+ (lists (seq-filter (lambda (element) (>= (length element) depth))
lists-all)))
+ (delete-dups
+ (mapcar
+ (lambda (sequence)
+ (mapconcat #'identity (seq-take sequence depth) "="))
+ lists))))
+
+(defun denote-sequence--pad (sequence type)
+ "Create a new SEQUENCE with padded spaces for TYPE.
+TYPE is a symbol among `denote-sequence-types'."
+ (let* ((sequence-separator-p (string-match-p "=" sequence))
+ (split (denote-sequence-split sequence))
+ (s (if sequence-separator-p
+ (pcase type
+ ('parent (car split))
+ ('sibling split)
+ ('child (car (nreverse split)))
+ (_ (error "The type `%s' is not among
`denote-sequence-types'" type)))
+ sequence)))
+ (if (listp s)
+ (combine-and-quote-strings
+ (mapcar
+ (lambda (part)
+ (string-pad part 5 32 :pad-from-start))
+ s)
+ "=")
+ (string-pad s 32 32 :pad-from-start))))
+
+(defun denote-sequence--get-largest (sequences type)
+ "Return largest sequence in SEQUENCES given TYPE.
+TYPE is a symbol among `denote-sequence-types'."
+ (car (sort sequences
+ :lessp (lambda (s1 s2)
+ (string<
+ (denote-sequence--pad s1 type)
+ (denote-sequence--pad s2 type)))
+ :reverse t)))
+
+(defun denote-sequence--get-new-parent (&optional sequences)
+ "Return a new to increment largest among sequences.
+With optional SEQUENCES consider only those, otherwise operate on the
+return value of `denote-sequence-get-all-sequences'."
+ (if-let* ((all (or sequences (denote-sequence-get-all-sequences))))
+ (let* ((largest (denote-sequence--get-largest all 'parent))
+ (first-component (car (denote-sequence-split largest)))
+ (current-number (string-to-number first-component)))
+ (number-to-string (+ current-number 1)))
+ "1"))
+
+(defun denote-sequence--get-new-child (sequence &optional sequences)
+ "Return a new child of SEQUENCE.
+Optional SEQUENCES has the same meaning as that specified in the
+function `denote-sequence-get-all-sequences-with-prefix'."
+ (if-let* ((depth (+ (denote-sequence-depth sequence) 1))
+ (all-unfiltered (denote-sequence-get-all-sequences-with-prefix
sequence sequences)))
+ (if (= (length all-unfiltered) 1)
+ (format "%s=1" (car all-unfiltered))
+ (let* ((all (cond
+ ((= (length all-unfiltered) 1)
+ all-unfiltered)
+ ((denote-sequence-get-sequences-with-max-depth depth
all-unfiltered))
+ (t all-unfiltered)))
+ (largest (denote-sequence--get-largest all 'child)))
+ (if (string-match-p "=" largest)
+ (let* ((components (denote-sequence-split largest))
+ (butlast (butlast components))
+ (last-component (car (nreverse components)))
+ (current-number (string-to-number last-component))
+ (new-number (number-to-string (+ current-number 1))))
+ (if butlast
+ (mapconcat #'identity (append butlast (list new-number))
"=")
+ (mapconcat #'identity (list largest new-number) "=")))
+ (format "%s=1" largest))))
+ (error "Cannot find sequences given sequence `%s'" sequence)))
+
+(defun denote-sequence--get-prefix-for-siblings (sequence)
+ "Get the prefix of SEQUENCE such that it is possible to find its siblings."
+ (when (string-match-p "=" sequence)
+ (mapconcat #'identity (butlast (denote-sequence-split sequence)) "=")))
+
+(defun denote-sequence--get-new-sibling (sequence &optional sequences)
+ "Return a new sibling SEQUENCE.
+Optional SEQUENCES has the same meaning as that specified in the
+function `denote-sequence-get-all-sequences-with-prefix'."
+ (let* ((children-p (string-match-p "=" sequence)))
+ (if-let* ((depth (denote-sequence-depth sequence))
+ (all-unfiltered (if children-p
+
(denote-sequence-get-all-sequences-with-prefix
+ (denote-sequence--get-prefix-for-siblings
sequence)
+ sequences)
+ (denote-sequence-get-all-sequences)))
+ (all (denote-sequence-get-sequences-with-max-depth depth
all-unfiltered))
+ ((member sequence all))
+ (largest (if children-p
+ (denote-sequence--get-largest all 'sibling)
+ (denote-sequence--get-largest all 'parent))))
+ (if children-p
+ (let* ((components (denote-sequence-split largest))
+ (butlast (butlast components))
+ (last-component (car (nreverse components)))
+ (current-number (string-to-number last-component))
+ (new-number (number-to-string (+ current-number 1))))
+ (mapconcat #'identity (append butlast (list new-number)) "="))
+ (number-to-string (+ (string-to-number largest) 1)))
+ (error "Cannot find sequences given sequence `%s'" sequence))))
+
+(defun denote-sequence-get (type &optional sequence)
+ "Return a sequence given TYPE among `denote-sequence-types'.
+If TYPE is either `child' or `sibling', then optional SEQUENCE must be
+non-nil and conform with `denote-sequence-p'."
+ (pcase type
+ ('parent (denote-sequence--get-new-parent))
+ ('child (denote-sequence--get-new-child sequence))
+ ('sibling (denote-sequence--get-new-sibling sequence))
+ (_ (error "The type `%s' is not among `denote-sequence-types'" type))))
+
+(defvar denote-sequence-type-history nil
+ "Minibuffer history of `denote-sequence-type-prompt'.")
+
+(defun denote-sequence-type-prompt ()
+ "Prompt for sequence type among `denote-sequence-types'.
+Return selected type as a symbol."
+ (let ((default (car denote-sequence-type-history)))
+ (intern
+ (completing-read
+ (format-prompt "Select sequence type" default)
+ denote-sequence-types nil :require-match nil
+ 'denote-sequence-type-history default))))
+
+(defvar denote-sequence-file-history nil
+ "Minibuffer history for `denote-sequence-file-prompt'.")
+
+(defun denote-sequence-file-prompt ()
+ "Prompt for file with sequence in variable `denote-directory'.
+A sequence is a Denote signature that conforms with `denote-sequence-p'."
+ (if-let* ((relative-files (mapcar
#'denote-get-file-name-relative-to-denote-directory
+ (denote-sequence-get-all-files)))
+ (prompt "Select FILE with sequence: ")
+ (input (completing-read
+ prompt
+ (denote--completion-table 'file relative-files)
+ nil :require-match
+ nil 'denote-sequence-file-history)))
+ (concat (denote-directory) input)
+ (error "There are no sequence notes in the `denote-directory'")))
+
+;;;###autoload
+(defun denote-sequence (type &optional file-with-sequence)
+ "Create a new sequence note of TYPE among `denote-sequence-types'.
+If TYPE is either `child' or `sibling', then it is an extension of SEQUENCE.
+
+When called interactively, prompt for TYPE and, when necessary, for
+FILE-WITH-SEQUENCE whose sequence will be used to derive a new sequence.
+Files available at the minibuffer prompt are those returned by
+`denote-sequence-get-all-files'."
+ (interactive
+ (let ((selected-type (denote-sequence-type-prompt)))
+ (list
+ selected-type
+ (when (memq selected-type (delq 'parent denote-sequence-types))
+ (denote-sequence-file-prompt)))))
+ ;; TODO 2024-12-30: Do we need to wrap this in the following?
+ ;;
+ ;; (cl-letf (((alist-get 'signature denote-file-name-slug-functions)
#'denote-sluggify-signature))
+ (let* ((sequence (denote-retrieve-filename-signature file-with-sequence))
+ (new-sequence (denote-sequence-get type sequence))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-new-parent ()
+ "Like `denote-sequence' to directly create new parent."
+ (interactive)
+ (let* ((new-sequence (denote-sequence-get 'parent))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-new-sibling (sequence)
+ "Like `denote-sequence' to directly create new sibling of SEQUENCE.
+When called from Lisp, SEQUENCE is a string that conforms with
+`denote-sequence-p'."
+ (interactive (list (denote-retrieve-filename-signature
(denote-sequence-file-prompt))))
+ (let* ((new-sequence (denote-sequence-get 'sibling sequence))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-new-child (sequence)
+ "Like `denote-sequence' to directly create new child of SEQUENCE.
+When called from Lisp, SEQUENCE is a string that conforms with
+`denote-sequence-p'."
+ (interactive (list (denote-retrieve-filename-signature
(denote-sequence-file-prompt))))
+ (let* ((new-sequence (denote-sequence-get 'child sequence))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-link (file &optional id-only)
+ "Link to FILE with sequence.
+This is like the `denote-link' command but only accepts to link to a
+file that conforms with `denote-sequence-file-p'. When called
+interactively, only relevant files are shown for minibuffer completion
+from the variable `denote-directory'.
+
+Optional ID-ONLY has the same meaning as the `denote-link' command."
+ (interactive (list (denote-sequence-file-prompt)))
+ (unless (denote-sequence-file-p file)
+ (error "Can only link to file with a sequence; else use `denote-link' and
related"))
+ (let* ((type (denote-filetype-heuristics buffer-file-name))
+ (description (denote-get-link-description file)))
+ (denote-link file type description id-only)))
+
+(provide 'denote-sequence)
+;;; denote-sequence.el ends here
diff --git a/tests/denote-test.el b/tests/denote-test.el
index 0c6028b1b7..a0e1f158bd 100644
--- a/tests/denote-test.el
+++ b/tests/denote-test.el
@@ -581,5 +581,74 @@ does not involve the time zone."
(let ((denote-journal-extras-title-format
'day-date-month-year-24h))
(denote-journal-extras-daily--title-format))))))
+;;;; denote-sequence.el
+
+;; TODO 2024-12-31: Maybe we can share some state between tests? It
+;; is expensive to create those files over and over.
+(ert-deftest denote-test--denote-sequence--get-new-child ()
+ "Make sure `denote-sequence--get-new-child' gets the child of a sequence."
+ (let* ((denote-directory (expand-file-name "denote-test"
temporary-file-directory))
+ (files
+ (mapcar
+ (lambda (file)
+ (let ((path (expand-file-name file (denote-directory))))
+ (if (file-exists-p path)
+ path
+ (with-current-buffer (find-file-noselect path)
+ (save-buffer)
+ (kill-buffer (current-buffer)))
+ path)))
+ '("20241230T075004==1--some-new-title__testing.txt"
+ "20241230T075023==1=1--child-of-note__testing.txt"
+ "20241230T075023==1=1=1--test__testing.txt"
+ "20241230T075023==1=1=2--test__testing.txt"
+ "20241230T075023==1=2--test__testing.txt"
+ "20241230T075023==1=2=1--test__testing.txt"
+ "20241230T075023==2--test__testing.txt")))
+ (sequences (denote-sequence-get-all-sequences files)))
+ (should
+ (and
+ (equal (denote-sequence--get-new-child "1" sequences) "1=3")
+ (equal (denote-sequence--get-new-child "1=1" sequences) "1=1=3")
+ (equal (denote-sequence--get-new-child "1=1=2" sequences) "1=1=2=1")
+ (equal (denote-sequence--get-new-child "1=2" sequences) "1=2=2")
+ (equal (denote-sequence--get-new-child "1=2=1" sequences) "1=2=1=1")
+ (equal (denote-sequence--get-new-child "2" sequences) "2=1")))
+ (should-error (denote-sequence--get-new-child "3" sequences))
+ (delete-directory denote-directory :delete-contents-as-well)))
+
+(ert-deftest denote-test--denote-sequence--get-new-sibling ()
+ "Make sure `denote-sequence--get-new-sibling' gets the sibling of a
sequence."
+ (let* ((denote-directory (expand-file-name "denote-test"
temporary-file-directory))
+ (files
+ (mapcar
+ (lambda (file)
+ (let ((path (expand-file-name file (denote-directory))))
+ (if (file-exists-p path)
+ path
+ (with-current-buffer (find-file-noselect path)
+ (save-buffer)
+ (kill-buffer (current-buffer)))
+ path)))
+ '("20241230T075004==1--some-new-title__testing.txt"
+ "20241230T075023==1=1--sibling-of-note__testing.txt"
+ "20241230T075023==1=1=1--test__testing.txt"
+ "20241230T075023==1=1=2--test__testing.txt"
+ "20241230T075023==1=2--test__testing.txt"
+ "20241230T075023==1=2=1--test__testing.txt"
+ "20241230T075023==2--test__testing.txt")))
+ (sequences (denote-sequence-get-all-sequences files)))
+ (should
+ (and
+ (equal (denote-sequence--get-new-sibling "1" sequences) "3")
+ (equal (denote-sequence--get-new-sibling "1=1" sequences) "1=3")
+ (equal (denote-sequence--get-new-sibling "1=1=1" sequences) "1=1=3")
+ (equal (denote-sequence--get-new-sibling "1=1=2" sequences) "1=1=3")
+ (equal (denote-sequence--get-new-sibling "1=2" sequences) "1=3")
+ (equal (denote-sequence--get-new-sibling "1=2=1" sequences) "1=2=2")
+ (equal (denote-sequence--get-new-sibling "2" sequences) "3")))
+ (should-error (denote-sequence--get-new-sibling "4" sequences))
+ (delete-directory denote-directory :delete-contents-as-well)))
+
(provide 'denote-test)
;;; denote-test.el ends here
