[elpa] externals/tempel 69f7cb3212 06/82: Reimplement without Tempo for more flexibility

[ELPA Syncer]

branch: externals/tempel
commit 69f7cb3212fe58e2c920a796b137877dac453370
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Reimplement without Tempo for more flexibility
---
 README.org |  80 +++++++-----------------
 tempel.el  | 207 +++++++++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 176 insertions(+), 111 deletions(-)

diff --git a/README.org b/README.org
index eaefca0d53..f024b04a50 100644
--- a/README.org
+++ b/README.org
@@ -9,23 +9,24 @@
 
 * Introduction
 
-Tempel is a tiny template package for Emacs, which uses the builtin Tempo Emacs
-library for expansion. Tempo is an ancient temple. It is 27 years old, but 
still
+Tempel is a tiny template package for Emacs, which uses the syntax of the
+Emacs Tempo library. Tempo is an ancient temple. It is 27 years old, but still
 in good shape since it successfully resisted change over the decades. Tempel
-provides a modernized UI on top of Tempo, in the form of two commands:
+is a modernized implementation of Tempo, in the form of two commands:
 
 + ~tempel-expand~: Expand a template at point in the buffer. If called
   non-interactively the function behaves like a completion-at-point-function
   (Capf). You may want to use my [[https://github.com/minad/corfu][Corfu]] 
completion at point UI.
 + ~tempel-insert~: Select a template by name and insert it into the current 
buffer.
 
-After inserting a template you can move between the visible template fields
-with keys ~M-left/right~ as defined in the ~tempel-map~ keymap. As soon as you 
move
+After inserting a template you can move between the visible template fields 
with
+keys ~M-left/right~ as defined in the ~tempel-map~ keymap. As soon as you move
 before (behind) the first (last) field, the fields are removed.
 
 Note that this package is not a competitor to the mature and widely used
 YASnippet library. Try Tempel only if your snippet and templating requirements
-are limited and if you like tiny and simple packages.
+are limited and if you like tiny and simple packages. Tempel took inspiration
+from the [[https://github.com/nschum/tempo-snippets.el][Tempo-Snippets]] 
package by Nikolaj Schumacher.
 
 * Quick start
 
@@ -81,53 +82,20 @@ org-mode
 (title "#+title: " p n "#+author: Daniel Mendler" n "#+language: en" n n)
 #+end_src
 
-Take a look at the documentation of ~tempo-define-template~ for the 
documentation
-of the template elements. You can even define your own template elements via
-~tempo-user-elements~.
-
-#+begin_quote
- - A string: It is sent to the hooks in `tempo-insert-string-functions',
-   and the result is inserted.
- - The symbol `p': This position is saved in `tempo-marks'.
- - The symbol `r': If `tempo-insert' is called with ON-REGION non-nil
-   the current region is placed here.  Otherwise it works like `p'.
- - (p PROMPT <NAME> <NOINSERT>): If `tempo-interactive' is non-nil, the
-   user is prompted in the minibuffer with PROMPT for a string to be
-   inserted.  If the optional parameter NAME is non-nil, the text is
-   saved for later insertion with the `s' tag.  If there already is
-   something saved under NAME that value is used instead and no
-   prompting is made.  If NOINSERT is provided and non-nil, nothing is
-   inserted, but text is still saved when a NAME is provided.  For
-   clarity, the symbol `noinsert' should be used as argument.
- - (P PROMPT <NAME> <NOINSERT>): Works just like the previous tag, but
-   forces `tempo-interactive' to be true.
- - (r PROMPT <NAME> <NOINSERT>): Like the previous tag, but if
-   `tempo-interactive' is nil and `tempo-insert' is called with
-   ON-REGION non-nil, the current region is placed here.  This usually
-   happens when you call the template function with a prefix argument.
- - (s NAME): Inserts text previously read with the (p ..) construct.
-   Finds the insertion saved under NAME and inserts it.  Acts like `p'
-   if tempo-interactive is nil.
- - `&': If there is only whitespace between the line start and point,
-   nothing happens.  Otherwise a newline is inserted.
- - `%': If there is only whitespace between point and end of line,
-   nothing happens.  Otherwise a newline is inserted.
- - `n': Inserts a newline.
- - `>': The line is indented using `indent-according-to-mode'.  Note
-   that you often should place this item after the text you want on
-   the line.
- - `r>': Like `r', but it also indents the region.
- - (r> PROMPT <NAME> <NOINSERT>): Like (r ...), but is also indents
-   the region.
- - `n>': Inserts a newline and indents line.
- - `o': Like `%' but leaves the point before the newline.
- - nil: It is ignored.
- - Anything else: Each function in `tempo-user-elements' is called
-   with it as argument until one of them returns non-nil, and the
-   result is inserted.  If all of them return nil, it is evaluated and
-   the result is treated as an element to be inserted.  One additional
-   tag is useful for these cases.  If an expression returns a list (l
-   foo bar), the elements after `l' will be inserted according to the
-   usual rules.  This makes it possible to return several elements
-   from one expression."
-#+end_quote
+All the syntax elements of ~tempo-define-template~ are supported. We document
+the important ones here:
+
+ - "string" :: Inserts a string literal.
+ - ~p~ :: Inserts an unnamed prompt field.
+ - ~r~ :: Inserts the current region.
+ - ~(s NAME)~ :: Inserts a named field.
+ - ~(q PROMPT NAME)~ :: Query the user via ~read-string~, store variable 
~NAME~.
+ - ~n~ :: Inserts a newline.
+ - ~>~ :: Indents with ~indent-according-to-mode~.
+ - ~r>~ :: The region, but indented.
+ - ~n>~ :: Inserts a newline and indents.
+ - ~&~ :: Insert newline if there is only whitespace between line start and 
point.
+ - ~%~ :: Insert newline if there is only whitespace between point and line 
end.
+ - ~o~ :: Like ~%~ but leaves the point before newline.
+ - ~(form ...)~ :: Other lisp forms are evaluated. Named fields are lexically 
bound.
+   Use caution with templates which execute code!
diff --git a/tempel.el b/tempel.el
index 158c2e4e0c..bb773b16c0 100644
--- a/tempel.el
+++ b/tempel.el
@@ -1,4 +1,4 @@
-;;; tempel.el --- Tempo Templates -*- lexical-binding: t -*-
+;;; tempel.el --- Simple templates for Emacs -*- lexical-binding: t -*-
 
 ;; Author: Daniel Mendler
 ;; Created: 2022
@@ -24,26 +24,27 @@
 
 ;;; Commentary:
 
-;; This package provides a modern user interface to the Emacs Tempo
-;; template library. Your templates are stored in the `tempel-file' (by
-;; default the file "templates" in the `user-emacs-directory'). Bind the
+;; Tempel implements a simple template/snippet system. The template
+;; format is compatible with the template format of the Emacs Tempo
+;; library. Your templates are stored in the `tempel-file' (by default
+;; the file "templates" in the `user-emacs-directory'). Bind the
 ;; commands `tempel-expand' or `tempel-insert' to some keys in your user
 ;; configuration. You can jump with the keys M-up/down from field to
 ;; field. `tempel-expands' works best with the Corfu completion UI,
-;; while `temple-insert' uses `completing-read' under the hood.
+;; while `tempel-insert' uses `completing-read' under the hood.
 
 ;;; Code:
 
-(require 'tempo)
 (require 'seq)
 (eval-when-compile (require 'subr-x))
 
 (defvar tempel-file (expand-file-name "templates" user-emacs-directory))
+(defvar tempel-region nil)
 (defvar tempel--templates nil)
 (defvar tempel--modified nil)
-(defvar tempel--current nil)
 (defvar tempel--history nil)
-(defvar-local tempel--fields nil)
+(defvar tempel--state nil)
+(defvar-local tempel--overlays nil)
 
 (defvar tempel-map
   (let ((map (make-sparse-keymap)))
@@ -53,7 +54,7 @@
   "Keymap to navigate across template markers.")
 
 (defun tempel--load (file)
-  "Load Tempo templates from FILE."
+  "Load templates from FILE."
   (with-temp-buffer
     (insert "(\n")
     (insert-file-contents-literally file)
@@ -78,83 +79,183 @@
        (propertize
         (replace-regexp-in-string
          "\\s-+" " "
-         (mapconcat (lambda (x)
-                      (pcase x
-                        ((pred stringp) x)
-                        ((or 'n 'n>) " ")
-                        (_ "_")))
+         (mapconcat (lambda (x) (pcase x
+                                  ((pred stringp) x)
+                                  ((or 'n 'n>) " ")
+                                  (_ "_")))
                     def ""))
         'face 'completions-annotations))
       20 0 ?\s))))
 
-(defun tempel--insert (templates region name)
-  "Insert template NAME given the list of TEMPLATES and REGION flag."
+(defun tempel--replace-field (ov str)
+  "Replace OV content with STR."
+  (let ((inhibit-modification-hooks t)
+        (beg (overlay-start ov)))
+    (goto-char beg)
+    (delete-char (- (overlay-end ov) beg))
+    (insert str)
+    (move-overlay ov beg (point))))
+
+(defun tempel--update-field (ov after beg end &optional _len)
+  "Update field overlay OV.
+AFTER is non-nil after the modification.
+BEG and END are the boundaries of the modification."
+  (when (and after (>= beg (overlay-start ov)) (<= beg (overlay-end ov)))
+    (move-overlay ov (overlay-start ov) (max end (overlay-end ov)))
+    (when-let (name (overlay-get ov 'tempel--name))
+      (let ((state (overlay-get ov 'tempel--state))
+            (str (buffer-substring-no-properties (overlay-start ov) 
(overlay-end ov))))
+        (setf (alist-get name (cddr state)) str)
+        (save-excursion
+          ;; Update overlays
+          (dolist (other (alist-get name (car state)))
+            (unless (eq other ov)
+              (tempel--replace-field other str)))
+          ;; Update forms
+          (dolist (other (cadr state))
+            (tempel--replace-field other (eval (overlay-get other 
'tempel--form) (cddr state)))))))))
+
+(defun tempel--field ()
+  "Create template field."
+  (let ((ov (make-overlay (point) (point))))
+    (overlay-put ov 'face 'highlight)
+    (overlay-put ov 'before-string #(" " 0 1 (face highlight display (space 
:width (1)))))
+    (overlay-put ov 'modification-hooks (list #'tempel--update-field))
+    (overlay-put ov 'insert-behind-hooks (list #'tempel--update-field))
+    (push ov tempel--overlays)
+    ov))
+
+(defun tempel--named (name)
+  "Create template field named NAME."
+  (let ((ov (tempel--field)))
+    (push ov (alist-get name (car tempel--state)))
+    (overlay-put ov 'tempel--name name)
+    (overlay-put ov 'tempel--state tempel--state)
+    (when-let (str (alist-get name (cddr tempel--state)))
+      (insert str)
+      (move-overlay ov (overlay-start ov) (point)))))
+
+(defun tempel--form (form)
+  "Create template field evaluating FORM."
+  (let ((ov (tempel--field)))
+    (push ov (cadr tempel--state))
+    (overlay-put ov 'tempel--form form)
+    (insert (eval form (cddr tempel--state)))
+    (move-overlay ov (overlay-start ov) (point))))
+
+(defun tempel--query (prompt name)
+  "Read input with PROMPT and assign to NAME."
+  (setf (alist-get name (cddr tempel--state)) (read-string prompt)))
+
+(defun tempel--element (element)
+  "Insert template ELEMENT."
+  (pcase element
+    ('nil)
+    ('n (insert "\n"))
+    ('n> (insert "\n") (indent-according-to-mode))
+    ('> (indent-according-to-mode))
+    ((pred stringp) (insert element))
+    ('& (unless (or (bolp) (save-excursion (re-search-backward "^\\s-*\\=" nil 
t)))
+          (insert "\n")))
+    ('% (unless (or (eolp) (save-excursion (re-search-forward "\\=\\s-*$" nil 
t)))
+          (insert "\n")))
+    ('o (unless (or tempel-region (eolp)
+                   (save-excursion (re-search-forward "\\=\\s-*$" nil t)))
+         (open-line 1)))
+    ('p (tempel--field))
+    ((or 'r `(r . ,_)) (if tempel-region (goto-char (cdr tempel-region)) 
(tempel--field)))
+    ((or 'r> `(r> . ,_))
+     (if (not tempel-region) (tempel--field)
+       (goto-char (cdr tempel-region))
+       (indent-region (car tempel-region) (cdr tempel-region) nil)))
+    (`(,(or 'p 'P) ,prompt . ,rest) ;; Tempo legacy, use i, s, or plain p 
instead
+     (cond
+      ((cadr rest) (tempel--query prompt (car rest)))
+      ((car rest) (tempel--named (car rest)))
+      (t (tempel--field))))
+    (`(q ,prompt ,name) (tempel--query prompt name)) ;; Tempel Extension over 
Tempo
+    (`(s ,name) (tempel--named name))
+    (_ (tempel--form element))))
+
+(defun tempel--insert (templates name)
+  "Insert template NAME given the list of TEMPLATES."
   (when-let* ((name (intern-soft name))
               (template (cdr (assoc name templates))))
-    (setf (alist-get 'tempo-marks minor-mode-overriding-map-alist) tempel-map)
-    (let ((tempel--current template))
-      (mapc #'delete-overlay tempel--fields)
-      (setq tempel--fields nil)
-      (tempo-insert-template 'tempel--current region)
-      (dolist (x tempo-marks)
-        (let ((ov (make-overlay x x nil nil t)))
-          (overlay-put ov 'face 'highlight)
-          (overlay-put ov 'before-string #(" " 0 1 (face highlight display 
(space :width (1)))))
-          (push ov tempel--fields))))))
+    (setf (alist-get 'tempel--overlays minor-mode-overriding-map-alist) 
tempel-map)
+    (save-excursion
+      ;; Split old overlays
+      (dolist (ov tempel--overlays)
+        (when (and (<= (overlay-start ov) (point)) (>= (overlay-end ov) 
(point)))
+          (setf (overlay-end ov) (point))))
+      ;; Begin marker
+      (push (make-overlay (point) (point)) tempel--overlays)
+      (let ((tempel--state (list nil nil))
+            (inhibit-modification-hooks t))
+        (mapc #'tempel--element template))
+      ;; End marker
+      (push (make-overlay (point) (point)) tempel--overlays))
+    (setq tempel--overlays (sort tempel--overlays (lambda (x y) (< 
(overlay-start x) (overlay-start y)))))
+    ;; Jump to first field
+    (tempel-next-field 1)))
 
 (defun tempel--save ()
-  "Save Tempo file buffer."
+  "Save template file buffer."
   (when-let (buf (get-file-buffer tempel-file))
     (with-current-buffer buf
       (when (and (buffer-modified-p) (y-or-n-p (format "Save file %s? " 
tempel-file)))
         (save-buffer buf)))))
 
 (defun tempel--templates ()
-  "Return Tempo templates for current mode."
+  "Return templates for current mode."
   (let ((mod (file-attribute-modification-time (file-attributes tempel-file))))
     (unless (equal tempel--modified mod)
       (setq tempel--templates (tempel--load tempel-file)
             tempel--modified mod)))
   (cdr (seq-find (lambda (x) (derived-mode-p (car x))) tempel--templates)))
 
+(defun tempel--region ()
+  "Return region bounds."
+  (when (use-region-p)
+    (when (< (mark) (point)) (exchange-point-and-mark))
+    (deactivate-mark)
+    (cons (point-marker) (mark-marker))))
+
 (defun tempel-next-field (arg)
-  "Move to next template field and quit at the end."
+  "Move ARG fields forward and quit at the end."
   (interactive "p")
   (catch 'tempel--break
     (cond
      ((> arg 0)
-      (dolist (ov (reverse tempel--fields))
+      (dolist (ov tempel--overlays)
         (when (> (overlay-start ov) (point))
-          (if (> arg 1) (cl-decf arg)
-            (goto-char (overlay-start ov))
+          (if (> arg 1) (setq arg (1- arg))
+            (goto-char (overlay-end ov))
             (throw 'tempel--break nil)))))
      ((< arg 0)
-      (dolist (ov tempel--fields)
+      (dolist (ov (reverse tempel--overlays))
         (when (< (overlay-end ov) (point))
-          (if (< arg -1) (cl-incf arg)
-            (goto-char (overlay-start ov))
+          (if (< arg -1) (setq arg (1+ arg))
+            (goto-char (overlay-end ov))
             (throw 'tempel--break nil))))))
     (tempel-done)))
 
 (defun tempel-previous-field (arg)
-  "Move to previous template field and quit at the beginning."
+  "Move ARG fields backward and quit at the beginning."
   (interactive "p")
   (tempel-next-field (- arg)))
 
 (defun tempel-done ()
   "Template completion is done."
   (interactive)
-  (dolist (mark tempo-marks) (set-marker mark nil))
-  (mapc #'delete-overlay tempel--fields)
-  (setq tempo-marks nil
-        tempel--fields nil
+  (mapc #'delete-overlay tempel--overlays)
+  (setq tempel--overlays nil
         minor-mode-overriding-map-alist
-        (delq (assq-delete-all 'tempo-marks minor-mode-overriding-map-alist)
+        (delq (assq-delete-all 'tempel--overlays 
minor-mode-overriding-map-alist)
               minor-mode-overriding-map-alist)))
 
 ;;;###autoload
 (defun tempel-expand (&optional interactive)
-  "Complete Tempo template at point.
+  "Complete template at point.
 If INTERACTIVE is nil the function acts like a capf."
   (interactive (list t))
   (if interactive
@@ -163,25 +264,20 @@ If INTERACTIVE is nil the function acts like a capf."
         (tempel--save)
         (or (completion-at-point) (user-error "Tempel: No completions")))
     (when-let (templates (tempel--templates))
-      (let ((region (use-region-p)) bounds)
-        (when region
-          (when (< (mark) (point)) (exchange-point-and-mark))
-          (deactivate-mark))
-        (setq bounds
-              (or (and (not region) (bounds-of-thing-at-point 'symbol))
-                  (cons (point) (point))))
-        (list (car bounds)
-              (cdr bounds)
-              templates
+      (let* ((region (tempel--region))
+             (bounds (or (and (not region) (bounds-of-thing-at-point 'symbol))
+                         (cons (point) (point)))))
+        (list (car bounds) (cdr bounds) templates
               :exclusive 'no
               :exit-function (lambda (name _status)
                                (delete-region (max (point-min) (- (point) 
(length name))) (point))
-                               (tempel--insert templates region name))
+                               (let ((tempel-region region))
+                                 (tempel--insert templates name)))
               :annotation-function (apply-partially #'tempel--annotate 
templates " "))))))
 
 ;;;###autoload
 (defun tempel-insert ()
-  "Insert Tempo template using `completing-read'."
+  "Insert template using `completing-read'."
   (interactive)
   (let* ((templates (or (tempel--templates)
                         (error "Tempel: No templates for %s" major-mode)))
@@ -190,7 +286,8 @@ If INTERACTIVE is nil the function acts like a capf."
                 (apply-partially #'tempel--annotate templates
                                  #("  " 1 2 (display (space :align-to (+ left 
20)))))))
          (name (completing-read "Template: " templates nil t nil 
'tempel--history)))
-    (tempel--insert templates (use-region-p) name)))
+    (let ((tempel-region (tempel--region)))
+      (tempel--insert templates name))))
 
 (provide 'tempel)
 ;;; tempel.el ends here