branch: externals/denote
commit d1ba5e86c369633a11f7099ad8e8c83bea858cd1
Author: Protesilaos Stavrou <i...@protesilaos.com>
Commit: Protesilaos Stavrou <i...@protesilaos.com>
Add prototype of denote-sequence.el
---
denote-sequence.el | 256 +++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 256 insertions(+)
diff --git a/denote-sequence.el b/denote-sequence.el
new file mode 100644
index 0000000000..46d5d2b9ae
--- /dev/null
+++ b/denote-sequence.el
@@ -0,0 +1,256 @@
+;;; denote-sequence.el --- Sequence notes extension for Denote -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Protesilaos Stavrou <i...@protesilaos.com>
+;; Maintainer: Protesilaos Stavrou <i...@protesilaos.com>
+;; URL: https://github.com/protesilaos/denote
+;; Version: 0.0.0
+;; Package-Requires: ((emacs "28.1") (denote "3.2.0"))
+
+;; 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.
+
+(defgroup denote-sequence ()
+ "Sequence notes extension for denote."
+ :group 'files
+ :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-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
+ (lambda (file)
+ (when-let* ((signature (denote-retrieve-filename-signature file)))
+ (denote-sequence-p signature)))
+ (denote-directory-files)))
+
+(defun denote-sequence-get-all-sequences ()
+ "Return all sequences in the variable `denote-directory'.
+A sequence is a Denote signature that conforms with `denote-sequence-p'."
+ (delq nil
+ (mapcar
+ (lambda (file)
+ (when-let* ((signature (denote-retrieve-filename-signature file)))
+ (denote-sequence-p signature)))
+ (denote-directory-files))))
+
+(defun denote-sequence-get-all-sequences-with-prefix (sequence &optional
sequences)
+ "Get all sequences which extend SEQUENCE.
+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--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))
+ (s (if sequence-separator-p
+ (pcase type
+ ('parent (car (split-string sequence "=" t)))
+ ('sibling (split-string sequence "=" t))
+ (_ (butlast (split-string sequence "=" t))))
+ 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'."
+ (let* ((all (or sequences (denote-sequence-get-all-sequences)))
+ (largest (denote-sequence--get-largest all 'parent))
+ (first-component (car (split-string largest "=")))
+ (current-number (string-to-number first-component)))
+ (number-to-string (+ current-number 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* ((all (denote-sequence-get-all-sequences-with-prefix sequence
sequences))
+ (largest (denote-sequence--get-largest all 'child)))
+ (if (string-match-p "=" largest)
+ (let* ((components (split-string 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)) "="))
+ (concat largest "=" "1"))
+ (error "Cannot find sequences given sequence `%s'" 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'."
+ (if-let* ((children-p (string-match-p "=" sequence))
+ (all (if children-p
+ (denote-sequence-get-all-sequences-with-prefix sequence
sequences)
+ (denote-sequence-get-all-sequences)))
+ (largest (if children-p
+ (denote-sequence--get-largest all 'sibling)
+ (denote-sequence--get-largest all 'parent))))
+ (if children-p
+ (let* ((components (split-string 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'."
+ (let* ((relative-files (mapcar
#'denote-get-file-name-relative-to-denote-directory
+ (denote-sequence-get-all-files)))
+ (prompt "Select FILE: ")
+ (input (completing-read
+ prompt
+ (denote--completion-table 'file relative-files)
+ nil :require-match
+ nil 'denote-sequence-file-history)))
+ (concat (denote-directory) input)))
+
+;;;###autoload
+(defun denote-sequence (type &optional 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
+whose SEQUENCE will be used to derive a new sequence.
+
+When called from Lisp, SEQUENCE is a string that conforms with
`denote-sequence-p'."
+ (interactive
+ (let ((selected-type (denote-sequence-type-prompt)))
+ (list
+ selected-type
+ (when (memq selected-type (delq 'parent denote-sequence-types))
+ (denote-retrieve-filename-signature (denote-sequence-file-prompt))))))
+ (let* ((new-sequence (denote-sequence-get type sequence))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-new-parent ()
+ "Convenience wrapper of `denote-sequence' to create new parent."
+ (declare (interactive-only t))
+ (interactive)
+ (let* ((new-sequence (denote-sequence-get 'parent))
+ (denote-use-signature new-sequence))
+ (call-interactively 'denote)))
+
+;;;###autoload
+(defun denote-sequence-new-sibling (sequence)
+ "Convenience wrapper of `denote-sequence' to create new sibling of SEQUENCE."
+ (declare (interactive-only t))
+ (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)
+ "Convenience wrapper of `denote-sequence' to create new child of SEQUENCE."
+ (declare (interactive-only t))
+ (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)))
+
+(provide 'denote-sequence)
+;;; denote-sequence.el ends here
