1.1--- a/emacs/default.el Thu Jun 06 17:25:21 2024 -0400
1.2+++ b/emacs/default.el Thu Jun 06 17:53:22 2024 -0400
1.3@@ -918,5 +918,10 @@
1.4 (org-agenda-remove-restriction-lock t)
1.5 (message nil))))
1.6
1.7+;;; Skel
1.8+(add-to-load-path user-emacs-lib-directory)
1.9+(require 'sk)
1.10+(require 'skt)
1.11+
1.12 (provide 'default)
1.13 ;; default.el ends here
2.1--- a/emacs/lib/sk.el Thu Jun 06 17:25:21 2024 -0400
2.2+++ b/emacs/lib/sk.el Thu Jun 06 17:53:22 2024 -0400
2.3@@ -22,8 +22,9 @@
2.4
2.5 ;;; Commentary:
2.6
2.7+;;
2.8+
2.9 ;;; Code:
2.10-
2.11 (eval-and-compile (require 'eieio)
2.12 (require 'cl-lib)
2.13 (require 'sxp (expand-file-name "sxp.el" (join-paths user-emacs-directory "lib/")))
2.14@@ -71,8 +72,7 @@
2.15 :lighter " Sk"
2.16 :group 'skel
2.17 :keymap skel-minor-mode-map
2.18- :version skel-version
2.19- (keymap-local-set skel-minor-mode-map-prefix skt-minor-mode-map))
2.20+ :version skel-version)
2.21
2.22 ;; TODO 2023-09-06:
2.23 (define-derived-mode skel-mode lisp-mode "SKEL"
2.24@@ -147,418 +147,6 @@
2.25 (add-to-list 'auto-mode-alist '("skelfile" . skel-mode))
2.26 (add-to-list 'auto-mode-alist '("\\.sk\\'" . skel-mode)))
2.27
2.28-;;; Autotype
2.29-;; ref: https://raw.githubusercontent.com/xFA25E/skempo/master/skempo.el
2.30-
2.31-;; (defun modify-lisp-syntax-tables ()
2.32-;; (modify-syntax-entry ?* "w" (syntax-table))
2.33-;; (modify-syntax-entry ?- "w" (syntax-table)))
2.34-;; (dolist (hook '(lisp-mode-hook emacs-lisp-mode-hook))
2.35-;; (add-hook hook #'modify-lisp-syntax-tables))
2.36-
2.37-(defun skt--tags-variable (mode)
2.38- "Return a tempo tags variable's symbol for MODE."
2.39- (when mode
2.40- (intern (replace-regexp-in-string
2.41- (rx "-mode" eos) "-skt-tags"
2.42- (symbol-name mode)))))
2.43-
2.44-(defun skt--remove-tag-list (tag-list)
2.45- "Remove TAG-LIST from `tempo-local-tags'."
2.46- (setf (alist-get tag-list tempo-local-tags nil t) nil))
2.47-
2.48-(defun skt--insert-mark (marker)
2.49- "Insert a MARKER to `tempo-marks' while keeping it sorted.
2.50-Remove duplicate marks from `tempo-marks'. Set to nil removed
2.51-markers. This function is used as an :override advice to
2.52-`tempo-insert-mark', because the original function does not
2.53-remove duplicate elements. Duplicate markers appear when the
2.54-buffer gets smaller, markers start pointing to the same location.
2.55-We don't want that, because a lot of useless markers can slow
2.56-down Emacs."
2.57- (if (not tempo-marks)
2.58- (setq tempo-marks (list marker))
2.59- (let ((markers tempo-marks))
2.60- (cond
2.61- ((< marker (car markers))
2.62- (setq tempo-marks (cons marker tempo-marks)))
2.63- (t
2.64- (while (and (cdr markers) (<= (cadr markers) marker))
2.65- (if (/= (car markers) (cadr markers))
2.66- (setq markers (cdr markers))
2.67- (when (markerp (cadr markers)) (set-marker (cadr markers) nil))
2.68- (setcdr markers (cddr markers))))
2.69-
2.70- (if (= marker (car markers))
2.71- (when (markerp marker) (set-marker marker nil))
2.72- (setcdr markers (cons marker (cdr markers))))))
2.73-
2.74- (while (cdr markers)
2.75- (if (/= (car markers) (cadr markers))
2.76- (setq markers (cdr markers))
2.77- (when (markerp (cadr markers)) (set-marker (cadr markers) nil))
2.78- (setcdr markers (cddr markers)))))))
2.79-
2.80-(defun skt-add-tag (tag template &optional tag-list)
2.81- "Add a TEMPLATE TAG to TAG-LIST or to `tempo-tags'.
2.82-It is an :override function for `tempo-add-tag'. The original
2.83-function does not update identical tags."
2.84- (interactive "sTag: \nCTemplate: ")
2.85- (let ((tag-list (or tag-list 'tempo-tags)))
2.86- (if-let ((value (assoc tag (symbol-value tag-list))))
2.87- (setcdr value template)
2.88- (set tag-list (cons (cons tag template) (symbol-value tag-list))))
2.89- (tempo-invalidate-collection)))
2.90-
2.91-(defun skt--list-derived-modes (mode)
2.92- "List all derived modes of MODE + MODE itself."
2.93- (let ((modes nil))
2.94- (while mode
2.95- (when-let ((alias (symbol-function mode)))
2.96- (when (symbolp alias)
2.97- (setq mode alias)))
2.98- (push mode modes)
2.99- (setq mode (get mode 'derived-mode-parent)) )
2.100- (nreverse modes)))
2.101-
2.102-;;; Commands
2.103-(defvar-keymap skt-minor-mode-map
2.104- :doc "skt-minor-mode keymap."
2.105- :repeat (:enter)
2.106- :prefix 'skt-minor-mode-map
2.107- "a" #'edit-abbrevs)
2.108-
2.109-(define-minor-mode skt-minor-mode
2.110- "Minor mode for skt-templates."
2.111- :init-value nil
2.112- :lighter " Skt"
2.113- :keymap skt-minor-mode-map
2.114- (let* ((modes (skt--list-derived-modes major-mode))
2.115- (tag-vars (mapcar #'skt--tags-variable modes))
2.116- (bound-tag-vars (cl-delete-if-not #'boundp tag-vars)))
2.117- (if skt-minor-mode
2.118- (mapc #'tempo-use-tag-list bound-tag-vars)
2.119- (mapc #'skt--remove-tag-list bound-tag-vars))))
2.120-
2.121-(defun skt-register-auto-insert (rx template)
2.122- "Associate a template with a file regexp and insert into `auto-insert-alist'."
2.123- (cl-pushnew (cons rx template) auto-insert-alist))
2.124-
2.125-(defun skt--define-template (function-symbol body &optional docstring)
2.126- "Define a tempo template with BODY.
2.127-This will generate a function with FUNCTION-SYMBOL and
2.128-DOCSTRING.
2.129-
2.130-The main purpose of this function is to have a better controlled
2.131-alternative to `tempo-define-template'."
2.132- (let ((template-symbol (gensym (symbol-name function-symbol))))
2.133- (set template-symbol body)
2.134- (defalias function-symbol
2.135- (lambda (&optional arg)
2.136- (interactive "*P")
2.137- (tempo-insert-template template-symbol (xor tempo-insert-region arg)))
2.138- docstring)))
2.139-
2.140-(defun skt--define-skeleton (function-symbol body &optional docstring)
2.141- "Define a skeleton template with BODY.
2.142-This will generate a function with FUNCTION-SYMBOL and
2.143-DOCSTRING.
2.144-
2.145-The main purpose of this function is to have a better controlled
2.146-alternative to `define-skeleton', especially because it is a
2.147-function instead of a macro."
2.148- (defalias function-symbol
2.149- (lambda (&optional str arg)
2.150- (interactive "*P\nP")
2.151- (skeleton-proxy-new body str arg))
2.152- docstring))
2.153-
2.154-(defun skt--define-function (function-symbol function &optional docstring)
2.155- "This will generate an alias to FUNCTION with FUNCTION-SYMBOL.
2.156-DOCSTRING is used as a docstring to FUNCTION-SYMBOL."
2.157- (defalias function-symbol function docstring))
2.158-
2.159-(defun skt--mode-name (mode)
2.160- "Get MODE name without a -mode suffix."
2.161- (string-trim-right (symbol-name mode) (rx "-mode" eos)))
2.162-
2.163-(defun skt--function-name (name modes)
2.164- "Generate a name for a skt template function.
2.165-NAME and MODES are used to generate unique, but consistent
2.166-names."
2.167- (concat "skt-template-"
2.168- (mapconcat (lambda (mode) (concat (skt--mode-name mode) "-"))
2.169- (sort modes #'string<) "")
2.170- name))
2.171-
2.172-(defun skt--mode-abbrev-table (mode)
2.173- "Get abbrev table for MODE or `global-abbrev-table' if nil."
2.174- (if mode
2.175- (derived-mode-abbrev-table-name mode)
2.176- 'global-abbrev-table))
2.177-
2.178-(defun skt--abbrev-table (mode)
2.179- "Get skt abbrev table for MODE."
2.180- (intern (concat "skt-" (symbol-name (skt--mode-abbrev-table mode)))))
2.181-
2.182-(defun skt--abbrev-table-names (table)
2.183- "Return abbrev TABLE names."
2.184- (let ((names nil))
2.185- (mapatoms (lambda (abbrev)
2.186- (when (symbol-value abbrev)
2.187- (push (symbol-name abbrev) names)))
2.188- (symbol-value table))
2.189- names))
2.190-
2.191-(defun skt--modes (mode)
2.192- "Normalize MODE argument."
2.193- (cond ((consp mode) mode)
2.194- ((null mode) nil)
2.195- ((symbolp mode) (list mode))))
2.196-
2.197-;;;###autoload
2.198-(defun skt--define (define-function name modes tag abbrev docstring body)
2.199- "Define a skt template.
2.200-
2.201-DEFINE-FUNCTION is a function that takes a function symbol, BODY
2.202-and DOCSTRING as its arguments. It must define a new function
2.203-with that symbol and that docstring.
2.204-
2.205-NAME is a string used in generating a function symbol, TAG and
2.206-ABBREV.
2.207-
2.208-MODES is a list of modes for which TAG and ABBREV will be
2.209-created. If it's nil, TAG and ABBREV will be generated
2.210-globally.
2.211-
2.212-TAG/ABBREV is a boolean, which indicates whether a tag/abbrev
2.213-must be created for this template.
2.214-
2.215-DOCSTRING is a string (or nil) which will be supplied to
2.216-DEFINE-FUNCTION.
2.217-
2.218-BODY is an arbitrary argument passed to DEFINE-FUNCTION."
2.219- (let* ((function-symbol (intern (skt--function-name name modes)))
2.220- (modes (or modes '(nil))))
2.221- (funcall define-function function-symbol body docstring)
2.222- (put function-symbol 'no-self-insert t)
2.223-
2.224- (when tag
2.225- (let ((tag-symbol (gensym (symbol-name function-symbol))))
2.226- (if (eq #'skt--define-template define-function)
2.227- (set tag-symbol body)
2.228- (set tag-symbol `((ignore (,function-symbol)))))
2.229- (dolist (mode modes)
2.230- (let ((var (skt--tags-variable mode)))
2.231- (unless (boundp var)
2.232- (set var nil))
2.233- (tempo-add-tag name tag-symbol var)))
2.234- (dolist (buffer (buffer-list))
2.235- (with-current-buffer buffer
2.236- (when (and (or (equal '(nil) modes) (apply #'derived-mode-p modes))
2.237- skt-minor-mode)
2.238- (skt-minor-mode -1)
2.239- (skt-minor-mode 1))))))
2.240-
2.241- (when abbrev
2.242- (dolist (mode modes)
2.243- (let ((mode-table (skt--mode-abbrev-table mode))
2.244- (table (skt--abbrev-table mode)))
2.245- (define-abbrev-table mode-table nil)
2.246- (define-abbrev-table table nil :case-fixed t :skt t)
2.247- (define-abbrev (symbol-value table) name "" function-symbol
2.248- :case-fixed t :system t :skt t)
2.249-
2.250- (let* ((names (skt--abbrev-table-names table))
2.251- (regexp (concat (regexp-opt names "\\_<\\(") " *")))
2.252- (abbrev-table-put (symbol-value table) :regexp regexp))
2.253-
2.254- (let ((parents (abbrev-table-get (symbol-value mode-table) :parents)))
2.255- (cl-pushnew (symbol-value table) parents :test #'eq)
2.256- (abbrev-table-put (symbol-value mode-table) :parents parents)))))
2.257-
2.258- function-symbol))
2.259-
2.260-;;;###autoload
2.261-(cl-defmacro skt-define-template (name (&key mode tag abbrev docstring) &body body)
2.262- "Define a tempo template.
2.263-This macro defines a new tempo template or updates the old one.
2.264-NAME is a symbol. ARGS is a list of the form ([KEY VALUE]...)
2.265-where each KEY can be one of :tag, :abbrev, :docstring or :mode.
2.266-
2.267-If KEY is :tag, VALUE should be a boolean. If VALUE is non-nil,
2.268-then a tempo tag with NAME will be created for this template.
2.269-
2.270-If KEY is :abbrev, VALUE should be a boolean. If VALUE is
2.271-non-nil, then a NAME abbrev will be created for this template.
2.272-
2.273-If KEY is :docstring, VALUE should be a string. It will be a
2.274-docstring of the generated function.
2.275-
2.276-If KEY is :mode, VALUE should be a list of modes or single mode.
2.277-If this option is provided, than a tempo tag and an abbrev will
2.278-be created for these modes, otherwise they will be global (if
2.279-:tag and :abbrev options were provided, of course).
2.280-
2.281-BODY is a sequence of tempo elements that will be passed as a
2.282-list directly to `tempo-define-template's second argument.
2.283-
2.284-Example:
2.285-\(skt-define-template defvar (:mode emacs-lisp-mode :tag t :abbrev t
2.286- :docstring \"defvar template\")
2.287- \"(defvar \" (string-trim-right (buffer-name) (rx \".el\" eos)) \"-\" p n>
2.288- r> \")\")"
2.289- `(skt--define 'skt--define-template ,(symbol-name name)
2.290- ',(skt--modes mode) ,tag ,abbrev ,docstring ',body))
2.291-
2.292-;;;###autoload
2.293-(cl-defmacro skt-define-skeleton (name (&key mode tag abbrev docstring) &rest body)
2.294- "Define skeleton template.
2.295-See `skt-define-template' for explanation of NAME, MODE, TAG,
2.296-ABBREV and DOCSTRING.
2.297-
2.298-BODY is a sequence of skeleton elements that will be passed
2.299-directly to `define-skeleton'.
2.300-
2.301-Example:
2.302-\(skt-define-skeleton defun (:mode (emacs-lisp-mode lisp-interaction-mode)
2.303- :tag t :abbrev t
2.304- :docstring \"defun template\")
2.305- \"(defun \" str \" (\" @ - \")\" \n
2.306- @ _ \")\" \n)"
2.307- `(skt--define #'skt--define-skeleton ,(symbol-name name)
2.308- ',(skt--modes mode) ,tag ,abbrev ,docstring ',body))
2.309-
2.310-;;;###autoload
2.311-(cl-defmacro skt-define-function (name (&key mode tag abbrev docstring) function)
2.312- "Define FUNCTION template.
2.313-See `skt-define-template' for explanation of NAME, MODE, TAG,
2.314-ABBREV and DOCSTRING.
2.315-
2.316-The main purpose of this macro, is to create tempo tags and
2.317-abbrevs for existing skeleton templates, such as `sh-case'.
2.318-
2.319-Example:
2.320-\(skt-define-function shcase (:tag t :abbrev t :mode `sh-mode') `sh-case')"
2.321- `(skt--define #'skt--define-function ,(symbol-name name)
2.322- ',(skt--modes mode) ,tag ,abbrev ,docstring ',function))
2.323-
2.324-(defun skt--complete-template (string tag-list)
2.325- "An :override advice function for `tempo-display-completions'.
2.326-Show completion for STRING in a TAG-LIST. After selection
2.327-expand template.
2.328-
2.329-Rewritten because the original function uses an old way of
2.330-displaying completions in a separate buffer, which is not
2.331-clickable anyway. Now it uses new (compared to the originial
2.332-tempo package) and shiny `completing-read' interface."
2.333- (let* ((tags (mapcar #'car tag-list))
2.334- (tag (completing-read "Skt: " tags nil t string)))
2.335- (delete-char (- (length string)))
2.336- (tempo-insert-template (cdr (assoc tag tag-list)) nil)))
2.337-
2.338-;;;###autoload
2.339-(defcustom skt-enable-tempo-elements nil
2.340- "Enable extra tempo elements.
2.341-These elements add conditionals and looping support for tempo
2.342-like those in skeleton, making skeleton pretty much obsolete.
2.343-
2.344-If you want to set this option from ELisp, you have to remove
2.345-`skt-tempo-user-elements' from `tempo-user-elements' on nil
2.346-and add it on non-nil."
2.347- :type '(boolean :tag "Enable tempo elements?")
2.348- :set (lambda (variable value)
2.349- (if value
2.350- (add-hook 'tempo-user-functions #'skt-tempo-user-elements)
2.351- (remove-hook 'tempo-user-functions #'skt-tempo-user-elements))
2.352- (set-default variable value))
2.353- :group 'skel)
2.354-
2.355-(defcustom skt-completing-read nil
2.356- "Override default `tempo-display-completions'.
2.357-By default it uses a completion buffer to show completions. This
2.358-option overrides this function to use `completing-read' to select
2.359-partial skt tag or complete tag on region.
2.360-
2.361-If you wish to set this variable from ELisp code, you have to
2.362-remove `skt--complete-template' advice from
2.363-`tempo-display-completions' on nil and add it as on :override
2.364-advice on non-nil."
2.365- :type '(boolean :tag "Override?")
2.366- :set (lambda (variable value)
2.367- (if value
2.368- (advice-add 'tempo-display-completions :override #'skt--complete-template)
2.369- (advice-remove 'tempo-display-completions #'skt--complete-template))
2.370- (set-default variable value))
2.371- :group 'skel)
2.372-
2.373-(defcustom skt-delete-duplicate-marks nil
2.374- "Override default `tempo-insert-mark'.
2.375-Marks are used to jump on points of interest in a template. By
2.376-default `tempo-insert-mark' does not remove duplicate marks.
2.377-Duplicate marks might appear when the buffer shrinks and some of
2.378-the marks start pointing to the same location. This option tries
2.379-to fix this by checking for duplicate marks every time the
2.380-function is called. Emacs might get slower with a lot of
2.381-marks.
2.382-
2.383-If you want to set this option from ELisp, you have to remove
2.384-`skt--insert-mark' advice from `tempo-insert-mark' on nil and
2.385-add it as on :override advice on non-nil."
2.386- :type '(boolean :tag "Override?")
2.387- :set (lambda (variable value)
2.388- (if value
2.389- (advice-add 'tempo-insert-mark :override #'skt--insert-mark)
2.390- (advice-remove 'tempo-insert-mark #'skt--insert-mark))
2.391- (set-default variable value))
2.392- :group 'skel)
2.393-
2.394-(progn
2.395- (put 'tempo-define-template 'lisp-indent-function 1)
2.396- (put 'skt-define-template 'lisp-indent-function 2)
2.397- (put 'skt-define-skeleton 'lisp-indent-function 2)
2.398- (put 'skt-define-function 'lisp-indent-function 2))
2.399-
2.400-;;; Tempo Elements
2.401-(defvar skt-tempo-else-key (kbd "C-M-g")
2.402- "Key used to execute else branch in tempo conditional.")
2.403-
2.404-(defun skt-tempo--prompt (prompt)
2.405- "Make prompt for tempo conditional.
2.406-PROMPT is preceded with `skt-tempo-else-key'."
2.407- (concat "(" (key-description skt-tempo-else-key) " to quit) " prompt))
2.408-
2.409-(defun skt-tempo-user-elements (element)
2.410- "Support for conditional and looping tempo elements.
2.411-The following forms are supported for ELEMENT:
2.412-
2.413-\(:if (PROMPT VAR) THEN ELSE)
2.414-
2.415-\(:when (PROMPT VAR) BODY...)
2.416-
2.417-\(:while (PROMPT VAR) BODY...)
2.418-
2.419-PROMPT is a string used to read value for VAR. VAR is a tempo
2.420-variable symbol. Its value can be read with s, as usual. BODY,
2.421-THEN and ELSE are tempo elements. To abort the execution of
2.422-these elements, user must press `skt-tempo-else-key'.
2.423-
2.424-The main purpose of this extension is to mimic skeleton conditionals."
2.425- (pcase element
2.426- (`(:if (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) ,then ,else)
2.427- (let ((prompt (skt-tempo--prompt prompt))
2.428- (map (make-sparse-keymap)))
2.429- (set-keymap-parent map minibuffer-local-map)
2.430- (define-key map skt-tempo-else-key
2.431- (lambda () (interactive) (throw 'else else)))
2.432- (catch 'else
2.433- (tempo-save-named var (read-from-minibuffer prompt nil map))
2.434- then)))
2.435- (`(:when (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body)
2.436- `(:if (,prompt ,var) (l ,@body) (l)))
2.437- (`(:while (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body)
2.438- `(:when (,prompt ,var) ,@body ,element))))
2.439-
2.440 (provide 'skel)
2.441 (provide 'sk)
2.442 ;;; sk.el ends here
3.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
3.2+++ b/emacs/lib/skt.el Thu Jun 06 17:53:22 2024 -0400
3.3@@ -0,0 +1,442 @@
3.4+;;; skt.el --- Skel Templates -*- lexical-binding: t; -*-
3.5+
3.6+;; Copyright (C) 2024 The Compiler Company
3.7+
3.8+;; Author: Richard Westhaver <richard.westhaver@gmail.com>
3.9+;; Keywords: convenience
3.10+
3.11+;; This program is free software; you can redistribute it and/or modify
3.12+;; it under the terms of the GNU General Public License as published by
3.13+;; the Free Software Foundation, either version 3 of the License, or
3.14+;; (at your option) any later version.
3.15+
3.16+;; This program is distributed in the hope that it will be useful,
3.17+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
3.18+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3.19+;; GNU General Public License for more details.
3.20+
3.21+;; You should have received a copy of the GNU General Public License
3.22+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
3.23+
3.24+;;; Commentary:
3.25+
3.26+;;
3.27+
3.28+;;; Code:
3.29+(require 'skel)
3.30+
3.31+;; ref: https://raw.githubusercontent.com/xFA25E/skempo/master/skempo.el
3.32+
3.33+;; (defun modify-lisp-syntax-tables ()
3.34+;; (modify-syntax-entry ?* "w" (syntax-table))
3.35+;; (modify-syntax-entry ?- "w" (syntax-table)))
3.36+;; (dolist (hook '(lisp-mode-hook emacs-lisp-mode-hook))
3.37+;; (add-hook hook #'modify-lisp-syntax-tables))
3.38+
3.39+(defun skt--tags-variable (mode)
3.40+ "Return a tempo tags variable's symbol for MODE."
3.41+ (when mode
3.42+ (intern (replace-regexp-in-string
3.43+ (rx "-mode" eos) "-skt-tags"
3.44+ (symbol-name mode)))))
3.45+
3.46+(defun skt--remove-tag-list (tag-list)
3.47+ "Remove TAG-LIST from `tempo-local-tags'."
3.48+ (setf (alist-get tag-list tempo-local-tags nil t) nil))
3.49+
3.50+(defun skt--insert-mark (marker)
3.51+ "Insert a MARKER to `tempo-marks' while keeping it sorted.
3.52+Remove duplicate marks from `tempo-marks'. Set to nil removed
3.53+markers. This function is used as an :override advice to
3.54+`tempo-insert-mark', because the original function does not
3.55+remove duplicate elements. Duplicate markers appear when the
3.56+buffer gets smaller, markers start pointing to the same location.
3.57+We don't want that, because a lot of useless markers can slow
3.58+down Emacs."
3.59+ (if (not tempo-marks)
3.60+ (setq tempo-marks (list marker))
3.61+ (let ((markers tempo-marks))
3.62+ (cond
3.63+ ((< marker (car markers))
3.64+ (setq tempo-marks (cons marker tempo-marks)))
3.65+ (t
3.66+ (while (and (cdr markers) (<= (cadr markers) marker))
3.67+ (if (/= (car markers) (cadr markers))
3.68+ (setq markers (cdr markers))
3.69+ (when (markerp (cadr markers)) (set-marker (cadr markers) nil))
3.70+ (setcdr markers (cddr markers))))
3.71+
3.72+ (if (= marker (car markers))
3.73+ (when (markerp marker) (set-marker marker nil))
3.74+ (setcdr markers (cons marker (cdr markers))))))
3.75+
3.76+ (while (cdr markers)
3.77+ (if (/= (car markers) (cadr markers))
3.78+ (setq markers (cdr markers))
3.79+ (when (markerp (cadr markers)) (set-marker (cadr markers) nil))
3.80+ (setcdr markers (cddr markers)))))))
3.81+
3.82+(defun skt-add-tag (tag template &optional tag-list)
3.83+ "Add a TEMPLATE TAG to TAG-LIST or to `tempo-tags'.
3.84+It is an :override function for `tempo-add-tag'. The original
3.85+function does not update identical tags."
3.86+ (interactive "sTag: \nCTemplate: ")
3.87+ (let ((tag-list (or tag-list 'tempo-tags)))
3.88+ (if-let ((value (assoc tag (symbol-value tag-list))))
3.89+ (setcdr value template)
3.90+ (set tag-list (cons (cons tag template) (symbol-value tag-list))))
3.91+ (tempo-invalidate-collection)))
3.92+
3.93+(defun skt--list-derived-modes (mode)
3.94+ "List all derived modes of MODE + MODE itself."
3.95+ (let ((modes nil))
3.96+ (while mode
3.97+ (when-let ((alias (symbol-function mode)))
3.98+ (when (symbolp alias)
3.99+ (setq mode alias)))
3.100+ (push mode modes)
3.101+ (setq mode (get mode 'derived-mode-parent)) )
3.102+ (nreverse modes)))
3.103+
3.104+;;; Commands
3.105+(defvar-keymap skt-minor-mode-map
3.106+ :doc "skt-minor-mode keymap."
3.107+ :repeat (:enter)
3.108+ :prefix 'skt-minor-mode-map
3.109+ "a" #'edit-abbrevs)
3.110+
3.111+;;;###autoload
3.112+(define-minor-mode skt-minor-mode
3.113+ "Minor mode for skt-templates."
3.114+ :init-value nil
3.115+ :lighter " Skt"
3.116+ :keymap skt-minor-mode-map
3.117+ (let* ((modes (skt--list-derived-modes major-mode))
3.118+ (tag-vars (mapcar #'skt--tags-variable modes))
3.119+ (bound-tag-vars (cl-delete-if-not #'boundp tag-vars)))
3.120+ (if skt-minor-mode
3.121+ (mapc #'tempo-use-tag-list bound-tag-vars)
3.122+ (mapc #'skt--remove-tag-list bound-tag-vars))))
3.123+
3.124+(defun skt-register-auto-insert (rx template)
3.125+ "Associate a template with a file regexp and insert into `auto-insert-alist'."
3.126+ (cl-pushnew (cons rx template) auto-insert-alist))
3.127+
3.128+(defun skt--define-template (function-symbol body &optional docstring)
3.129+ "Define a tempo template with BODY.
3.130+This will generate a function with FUNCTION-SYMBOL and
3.131+DOCSTRING.
3.132+
3.133+The main purpose of this function is to have a better controlled
3.134+alternative to `tempo-define-template'."
3.135+ (let ((template-symbol (gensym (symbol-name function-symbol))))
3.136+ (set template-symbol body)
3.137+ (defalias function-symbol
3.138+ (lambda (&optional arg)
3.139+ (interactive "*P")
3.140+ (tempo-insert-template template-symbol (xor tempo-insert-region arg)))
3.141+ docstring)))
3.142+
3.143+(defun skt--define-skeleton (function-symbol body &optional docstring)
3.144+ "Define a skeleton template with BODY.
3.145+This will generate a function with FUNCTION-SYMBOL and
3.146+DOCSTRING.
3.147+
3.148+The main purpose of this function is to have a better controlled
3.149+alternative to `define-skeleton', especially because it is a
3.150+function instead of a macro."
3.151+ (defalias function-symbol
3.152+ (lambda (&optional str arg)
3.153+ (interactive "*P\nP")
3.154+ (skeleton-proxy-new body str arg))
3.155+ docstring))
3.156+
3.157+(defun skt--define-function (function-symbol function &optional docstring)
3.158+ "This will generate an alias to FUNCTION with FUNCTION-SYMBOL.
3.159+DOCSTRING is used as a docstring to FUNCTION-SYMBOL."
3.160+ (defalias function-symbol function docstring))
3.161+
3.162+(defun skt--mode-name (mode)
3.163+ "Get MODE name without a -mode suffix."
3.164+ (string-trim-right (symbol-name mode) (rx "-mode" eos)))
3.165+
3.166+(defun skt--function-name (name modes)
3.167+ "Generate a name for a skt template function.
3.168+NAME and MODES are used to generate unique, but consistent
3.169+names."
3.170+ (concat "skt-template-"
3.171+ (mapconcat (lambda (mode) (concat (skt--mode-name mode) "-"))
3.172+ (sort modes #'string<) "")
3.173+ name))
3.174+
3.175+(defun skt--mode-abbrev-table (mode)
3.176+ "Get abbrev table for MODE or `global-abbrev-table' if nil."
3.177+ (if mode
3.178+ (derived-mode-abbrev-table-name mode)
3.179+ 'global-abbrev-table))
3.180+
3.181+(defun skt--abbrev-table (mode)
3.182+ "Get skt abbrev table for MODE."
3.183+ (intern (concat "skt-" (symbol-name (skt--mode-abbrev-table mode)))))
3.184+
3.185+(defun skt--abbrev-table-names (table)
3.186+ "Return abbrev TABLE names."
3.187+ (let ((names nil))
3.188+ (mapatoms (lambda (abbrev)
3.189+ (when (symbol-value abbrev)
3.190+ (push (symbol-name abbrev) names)))
3.191+ (symbol-value table))
3.192+ names))
3.193+
3.194+(defun skt--modes (mode)
3.195+ "Normalize MODE argument."
3.196+ (cond ((consp mode) mode)
3.197+ ((null mode) nil)
3.198+ ((symbolp mode) (list mode))))
3.199+
3.200+;;;###autoload
3.201+(defun skt--define (define-function name modes tag abbrev docstring body)
3.202+ "Define a skt template.
3.203+
3.204+DEFINE-FUNCTION is a function that takes a function symbol, BODY
3.205+and DOCSTRING as its arguments. It must define a new function
3.206+with that symbol and that docstring.
3.207+
3.208+NAME is a string used in generating a function symbol, TAG and
3.209+ABBREV.
3.210+
3.211+MODES is a list of modes for which TAG and ABBREV will be
3.212+created. If it's nil, TAG and ABBREV will be generated
3.213+globally.
3.214+
3.215+TAG/ABBREV is a boolean, which indicates whether a tag/abbrev
3.216+must be created for this template.
3.217+
3.218+DOCSTRING is a string (or nil) which will be supplied to
3.219+DEFINE-FUNCTION.
3.220+
3.221+BODY is an arbitrary argument passed to DEFINE-FUNCTION."
3.222+ (let* ((function-symbol (intern (skt--function-name name modes)))
3.223+ (modes (or modes '(nil))))
3.224+ (funcall define-function function-symbol body docstring)
3.225+ (put function-symbol 'no-self-insert t)
3.226+
3.227+ (when tag
3.228+ (let ((tag-symbol (gensym (symbol-name function-symbol))))
3.229+ (if (eq #'skt--define-template define-function)
3.230+ (set tag-symbol body)
3.231+ (set tag-symbol `((ignore (,function-symbol)))))
3.232+ (dolist (mode modes)
3.233+ (let ((var (skt--tags-variable mode)))
3.234+ (unless (boundp var)
3.235+ (set var nil))
3.236+ (tempo-add-tag name tag-symbol var)))
3.237+ (dolist (buffer (buffer-list))
3.238+ (with-current-buffer buffer
3.239+ (when (and (or (equal '(nil) modes) (apply #'derived-mode-p modes))
3.240+ skt-minor-mode)
3.241+ (skt-minor-mode -1)
3.242+ (skt-minor-mode 1))))))
3.243+
3.244+ (when abbrev
3.245+ (dolist (mode modes)
3.246+ (let ((mode-table (skt--mode-abbrev-table mode))
3.247+ (table (skt--abbrev-table mode)))
3.248+ (define-abbrev-table mode-table nil)
3.249+ (define-abbrev-table table nil :case-fixed t :skt t)
3.250+ (define-abbrev (symbol-value table) name "" function-symbol
3.251+ :case-fixed t :system t :skt t)
3.252+
3.253+ (let* ((names (skt--abbrev-table-names table))
3.254+ (regexp (concat (regexp-opt names "\\_<\\(") " *")))
3.255+ (abbrev-table-put (symbol-value table) :regexp regexp))
3.256+
3.257+ (let ((parents (abbrev-table-get (symbol-value mode-table) :parents)))
3.258+ (cl-pushnew (symbol-value table) parents :test #'eq)
3.259+ (abbrev-table-put (symbol-value mode-table) :parents parents)))))
3.260+
3.261+ function-symbol))
3.262+
3.263+;;;###autoload
3.264+(cl-defmacro skt-define-template (name (&key mode tag abbrev docstring) &body body)
3.265+ "Define a tempo template.
3.266+This macro defines a new tempo template or updates the old one.
3.267+NAME is a symbol. ARGS is a list of the form ([KEY VALUE]...)
3.268+where each KEY can be one of :tag, :abbrev, :docstring or :mode.
3.269+
3.270+If KEY is :tag, VALUE should be a boolean. If VALUE is non-nil,
3.271+then a tempo tag with NAME will be created for this template.
3.272+
3.273+If KEY is :abbrev, VALUE should be a boolean. If VALUE is
3.274+non-nil, then a NAME abbrev will be created for this template.
3.275+
3.276+If KEY is :docstring, VALUE should be a string. It will be a
3.277+docstring of the generated function.
3.278+
3.279+If KEY is :mode, VALUE should be a list of modes or single mode.
3.280+If this option is provided, than a tempo tag and an abbrev will
3.281+be created for these modes, otherwise they will be global (if
3.282+:tag and :abbrev options were provided, of course).
3.283+
3.284+BODY is a sequence of tempo elements that will be passed as a
3.285+list directly to `tempo-define-template's second argument.
3.286+
3.287+Example:
3.288+\(skt-define-template defvar (:mode emacs-lisp-mode :tag t :abbrev t
3.289+ :docstring \"defvar template\")
3.290+ \"(defvar \" (string-trim-right (buffer-name) (rx \".el\" eos)) \"-\" p n>
3.291+ r> \")\")"
3.292+ `(skt--define 'skt--define-template ,(symbol-name name)
3.293+ ',(skt--modes mode) ,tag ,abbrev ,docstring ',body))
3.294+
3.295+;;;###autoload
3.296+(cl-defmacro skt-define-skeleton (name (&key mode tag abbrev docstring) &rest body)
3.297+ "Define skeleton template.
3.298+See `skt-define-template' for explanation of NAME, MODE, TAG,
3.299+ABBREV and DOCSTRING.
3.300+
3.301+BODY is a sequence of skeleton elements that will be passed
3.302+directly to `define-skeleton'.
3.303+
3.304+Example:
3.305+\(skt-define-skeleton defun (:mode (emacs-lisp-mode lisp-interaction-mode)
3.306+ :tag t :abbrev t
3.307+ :docstring \"defun template\")
3.308+ \"(defun \" str \" (\" @ - \")\" \n
3.309+ @ _ \")\" \n)"
3.310+ `(skt--define #'skt--define-skeleton ,(symbol-name name)
3.311+ ',(skt--modes mode) ,tag ,abbrev ,docstring ',body))
3.312+
3.313+;;;###autoload
3.314+(cl-defmacro skt-define-function (name (&key mode tag abbrev docstring) function)
3.315+ "Define FUNCTION template.
3.316+See `skt-define-template' for explanation of NAME, MODE, TAG,
3.317+ABBREV and DOCSTRING.
3.318+
3.319+The main purpose of this macro, is to create tempo tags and
3.320+abbrevs for existing skeleton templates, such as `sh-case'.
3.321+
3.322+Example:
3.323+\(skt-define-function shcase (:tag t :abbrev t :mode `sh-mode') `sh-case')"
3.324+ `(skt--define #'skt--define-function ,(symbol-name name)
3.325+ ',(skt--modes mode) ,tag ,abbrev ,docstring ',function))
3.326+
3.327+;;;###autoload
3.328+(defun skt--complete-template (string tag-list)
3.329+ "An :override advice function for `tempo-display-completions'.
3.330+Show completion for STRING in a TAG-LIST. After selection
3.331+expand template.
3.332+
3.333+Rewritten because the original function uses an old way of
3.334+displaying completions in a separate buffer, which is not
3.335+clickable anyway. Now it uses new (compared to the originial
3.336+tempo package) and shiny `completing-read' interface."
3.337+ (let* ((tags (mapcar #'car tag-list))
3.338+ (tag (completing-read "Skt: " tags nil t string)))
3.339+ (delete-char (- (length string)))
3.340+ (tempo-insert-template (cdr (assoc tag tag-list)) nil)))
3.341+
3.342+;;;###autoload
3.343+(defcustom skt-enable-tempo-elements nil
3.344+ "Enable extra tempo elements.
3.345+These elements add conditionals and looping support for tempo
3.346+like those in skeleton, making skeleton pretty much obsolete.
3.347+
3.348+If you want to set this option from ELisp, you have to remove
3.349+`skt-tempo-user-elements' from `tempo-user-elements' on nil
3.350+and add it on non-nil."
3.351+ :type '(boolean :tag "Enable tempo elements?")
3.352+ :set (lambda (variable value)
3.353+ (if value
3.354+ (add-hook 'tempo-user-functions #'skt-tempo-user-elements)
3.355+ (remove-hook 'tempo-user-functions #'skt-tempo-user-elements))
3.356+ (set-default variable value))
3.357+ :group 'skel)
3.358+
3.359+(defcustom skt-completing-read nil
3.360+ "Override default `tempo-display-completions'.
3.361+By default it uses a completion buffer to show completions. This
3.362+option overrides this function to use `completing-read' to select
3.363+partial skt tag or complete tag on region.
3.364+
3.365+If you wish to set this variable from ELisp code, you have to
3.366+remove `skt--complete-template' advice from
3.367+`tempo-display-completions' on nil and add it as on :override
3.368+advice on non-nil."
3.369+ :type '(boolean :tag "Override?")
3.370+ :set (lambda (variable value)
3.371+ (if value
3.372+ (advice-add 'tempo-display-completions :override #'skt--complete-template)
3.373+ (advice-remove 'tempo-display-completions #'skt--complete-template))
3.374+ (set-default variable value))
3.375+ :group 'skel)
3.376+
3.377+(defcustom skt-delete-duplicate-marks nil
3.378+ "Override default `tempo-insert-mark'.
3.379+Marks are used to jump on points of interest in a template. By
3.380+default `tempo-insert-mark' does not remove duplicate marks.
3.381+Duplicate marks might appear when the buffer shrinks and some of
3.382+the marks start pointing to the same location. This option tries
3.383+to fix this by checking for duplicate marks every time the
3.384+function is called. Emacs might get slower with a lot of
3.385+marks.
3.386+
3.387+If you want to set this option from ELisp, you have to remove
3.388+`skt--insert-mark' advice from `tempo-insert-mark' on nil and
3.389+add it as on :override advice on non-nil."
3.390+ :type '(boolean :tag "Override?")
3.391+ :set (lambda (variable value)
3.392+ (if value
3.393+ (advice-add 'tempo-insert-mark :override #'skt--insert-mark)
3.394+ (advice-remove 'tempo-insert-mark #'skt--insert-mark))
3.395+ (set-default variable value))
3.396+ :group 'skel)
3.397+
3.398+(progn
3.399+ (put 'tempo-define-template 'lisp-indent-function 1)
3.400+ (put 'skt-define-template 'lisp-indent-function 2)
3.401+ (put 'skt-define-skeleton 'lisp-indent-function 2)
3.402+ (put 'skt-define-function 'lisp-indent-function 2))
3.403+
3.404+;;; Tempo Elements
3.405+(defvar skt-tempo-else-key (kbd "C-M-g")
3.406+ "Key used to execute else branch in tempo conditional.")
3.407+
3.408+(defun skt-tempo--prompt (prompt)
3.409+ "Make prompt for tempo conditional.
3.410+PROMPT is preceded with `skt-tempo-else-key'."
3.411+ (concat "(" (key-description skt-tempo-else-key) " to quit) " prompt))
3.412+
3.413+(defun skt-tempo-user-elements (element)
3.414+ "Support for conditional and looping tempo elements.
3.415+The following forms are supported for ELEMENT:
3.416+
3.417+\(:if (PROMPT VAR) THEN ELSE)
3.418+
3.419+\(:when (PROMPT VAR) BODY...)
3.420+
3.421+\(:while (PROMPT VAR) BODY...)
3.422+
3.423+PROMPT is a string used to read value for VAR. VAR is a tempo
3.424+variable symbol. Its value can be read with s, as usual. BODY,
3.425+THEN and ELSE are tempo elements. To abort the execution of
3.426+these elements, user must press `skt-tempo-else-key'.
3.427+
3.428+The main purpose of this extension is to mimic skeleton conditionals."
3.429+ (pcase element
3.430+ (`(:if (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) ,then ,else)
3.431+ (let ((prompt (skt-tempo--prompt prompt))
3.432+ (map (make-sparse-keymap)))
3.433+ (set-keymap-parent map minibuffer-local-map)
3.434+ (define-key map skt-tempo-else-key
3.435+ (lambda () (interactive) (throw 'else else)))
3.436+ (catch 'else
3.437+ (tempo-save-named var (read-from-minibuffer prompt nil map))
3.438+ then)))
3.439+ (`(:when (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body)
3.440+ `(:if (,prompt ,var) (l ,@body) (l)))
3.441+ (`(:while (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body)
3.442+ `(:when (,prompt ,var) ,@body ,element))))
3.443+
3.444+(provide 'skt)
3.445+;;; skt.el ends here
