changeset 698: |
96958d3eb5b0 |
parent: |
7efdeaebaf22
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Fri, 04 Oct 2024 22:04:59 -0400 |
permissions: |
-rw-r--r-- |
description: |
fixes |
1 ;;; skt.el --- Skel Templates -*- lexical-binding:t -*- 3 ;; Copyright (C) 2024 The Compiler Company 5 ;; Author: Richard Westhaver <richard.westhaver@gmail.com> 6 ;; Keywords: convenience 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 28 ;; ref: https://raw.githubusercontent.com/xFA25E/skempo/master/skempo.el 30 ;; (defun modify-lisp-syntax-tables () 31 ;; (modify-syntax-entry ?* "w" (syntax-table)) 32 ;; (modify-syntax-entry ?- "w" (syntax-table))) 33 ;; (dolist (hook '(lisp-mode-hook emacs-lisp-mode-hook)) 34 ;; (add-hook hook #'modify-lisp-syntax-tables)) 36 (defun skt--tags-variable (mode) 37 "Return a tempo tags variable's symbol for MODE." 39 (intern (replace-regexp-in-string 40 (rx "-mode" eos) "-skt-tags" 41 (symbol-name mode))))) 43 (defun skt--remove-tag-list (tag-list) 44 "Remove TAG-LIST from `tempo-local-tags'." 45 (setf (alist-get tag-list tempo-local-tags nil t) nil)) 47 (defun skt--insert-mark (marker) 48 "Insert a MARKER to `tempo-marks' while keeping it sorted. 49 Remove duplicate marks from `tempo-marks'. Set to nil removed 50 markers. This function is used as an :override advice to 51 `tempo-insert-mark', because the original function does not 52 remove duplicate elements. Duplicate markers appear when the 53 buffer gets smaller, markers start pointing to the same location. 54 We don't want that, because a lot of useless markers can slow 57 (setq tempo-marks (list marker)) 58 (let ((markers tempo-marks)) 60 ((< marker (car markers)) 61 (setq tempo-marks (cons marker tempo-marks))) 63 (while (and (cdr markers) (<= (cadr markers) marker)) 64 (if (/= (car markers) (cadr markers)) 65 (setq markers (cdr markers)) 66 (when (markerp (cadr markers)) (set-marker (cadr markers) nil)) 67 (setcdr markers (cddr markers)))) 69 (if (= marker (car markers)) 70 (when (markerp marker) (set-marker marker nil)) 71 (setcdr markers (cons marker (cdr markers)))))) 74 (if (/= (car markers) (cadr markers)) 75 (setq markers (cdr markers)) 76 (when (markerp (cadr markers)) (set-marker (cadr markers) nil)) 77 (setcdr markers (cddr markers))))))) 79 (defun skt-add-tag (tag template &optional tag-list) 80 "Add a TEMPLATE TAG to TAG-LIST or to `tempo-tags'. 81 It is an :override function for `tempo-add-tag'. The original 82 function does not update identical tags." 83 (interactive "sTag: \nCTemplate: ") 84 (let ((tag-list (or tag-list 'tempo-tags))) 85 (if-let ((value (assoc tag (symbol-value tag-list)))) 86 (setcdr value template) 87 (set tag-list (cons (cons tag template) (symbol-value tag-list)))) 88 (tempo-invalidate-collection))) 90 (defun skt--list-derived-modes (mode) 91 "List all derived modes of MODE + MODE itself." 94 (when-let ((alias (symbol-function mode))) 98 (setq mode (get mode 'derived-mode-parent)) ) 102 (defvar-keymap skt-minor-mode-map 103 :doc "skt-minor-mode keymap." 105 :prefix 'skt-minor-mode-map 109 (define-minor-mode skt-minor-mode 110 "Minor mode for skt-templates." 113 :keymap skt-minor-mode-map 114 (let* ((modes (skt--list-derived-modes major-mode)) 115 (tag-vars (mapcar #'skt--tags-variable modes)) 116 (bound-tag-vars (cl-delete-if-not #'boundp tag-vars))) 118 (mapc #'tempo-use-tag-list bound-tag-vars) 119 (mapc #'skt--remove-tag-list bound-tag-vars)))) 121 (defun skt-register-auto-insert (rx template) 122 "Associate a template with a file regexp and insert into `auto-insert-alist'." 123 (cl-pushnew (cons rx template) auto-insert-alist)) 125 (defun skt--define-template (function-symbol body &optional docstring) 126 "Define a tempo template with BODY. 127 This will generate a function with FUNCTION-SYMBOL and 130 The main purpose of this function is to have a better controlled 131 alternative to `tempo-define-template'." 132 (let ((template-symbol (gensym (symbol-name function-symbol)))) 133 (set template-symbol body) 134 (defalias function-symbol 135 (lambda (&optional arg) 137 (tempo-insert-template template-symbol (xor tempo-insert-region arg))) 140 (defun skt--define-skeleton (function-symbol body &optional docstring) 141 "Define a skeleton template with BODY. 142 This will generate a function with FUNCTION-SYMBOL and 145 The main purpose of this function is to have a better controlled 146 alternative to `define-skeleton', especially because it is a 147 function instead of a macro." 148 (defalias function-symbol 149 (lambda (&optional str arg) 150 (interactive "*P\nP") 151 (skeleton-proxy-new body str arg)) 154 (defun skt--define-function (function-symbol function &optional docstring) 155 "This will generate an alias to FUNCTION with FUNCTION-SYMBOL. 156 DOCSTRING is used as a docstring to FUNCTION-SYMBOL." 157 (defalias function-symbol function docstring)) 159 (defun skt--mode-name (mode) 160 "Get MODE name without a -mode suffix." 161 (string-trim-right (symbol-name mode) (rx "-mode" eos))) 163 (defun skt--function-name (name modes) 164 "Generate a name for a skt template function. 165 NAME and MODES are used to generate unique, but consistent 167 (concat "skt-template-" 168 (mapconcat (lambda (mode) (concat (skt--mode-name mode) "-")) 169 (sort modes #'string<) "") 172 (defun skt--mode-abbrev-table (mode) 173 "Get abbrev table for MODE or `global-abbrev-table' if nil." 175 (derived-mode-abbrev-table-name mode) 176 'global-abbrev-table)) 178 (defun skt--abbrev-table (mode) 179 "Get skt abbrev table for MODE." 180 (intern (concat "skt-" (symbol-name (skt--mode-abbrev-table mode))))) 182 (defun skt--abbrev-table-names (table) 183 "Return abbrev TABLE names." 185 (mapatoms (lambda (abbrev) 186 (when (symbol-value abbrev) 187 (push (symbol-name abbrev) names))) 188 (symbol-value table)) 191 (defun skt--modes (mode) 192 "Normalize MODE argument." 193 (cond ((consp mode) mode) 195 ((symbolp mode) (list mode)))) 198 (defun skt--define (define-function name modes tag abbrev docstring body) 199 "Define a skt template. 201 DEFINE-FUNCTION is a function that takes a function symbol, BODY 202 and DOCSTRING as its arguments. It must define a new function 203 with that symbol and that docstring. 205 NAME is a string used in generating a function symbol, TAG and 208 MODES is a list of modes for which TAG and ABBREV will be 209 created. If it's nil, TAG and ABBREV will be generated 212 TAG/ABBREV is a boolean, which indicates whether a tag/abbrev 213 must be created for this template. 215 DOCSTRING is a string (or nil) which will be supplied to 218 BODY is an arbitrary argument passed to DEFINE-FUNCTION." 219 (let* ((function-symbol (intern (skt--function-name name modes))) 220 (modes (or modes '(nil)))) 221 (funcall define-function function-symbol body docstring) 222 (put function-symbol 'no-self-insert t) 225 (let ((tag-symbol (gensym (symbol-name function-symbol)))) 226 (if (eq #'skt--define-template define-function) 227 (set tag-symbol body) 228 (set tag-symbol `((ignore (,function-symbol))))) 230 (let ((var (skt--tags-variable mode))) 233 (tempo-add-tag name tag-symbol var))) 234 (dolist (buffer (buffer-list)) 235 (with-current-buffer buffer 236 (when (and (or (equal '(nil) modes) (apply #'derived-mode-p modes)) 239 (skt-minor-mode 1)))))) 243 (let ((mode-table (skt--mode-abbrev-table mode)) 244 (table (skt--abbrev-table mode))) 245 (define-abbrev-table mode-table nil) 246 (define-abbrev-table table nil :case-fixed t :skt t) 247 (define-abbrev (symbol-value table) name "" function-symbol 248 :case-fixed t :system t :skt t) 250 (let* ((names (skt--abbrev-table-names table)) 251 (regexp (concat (regexp-opt names "\\_<\\(") " *"))) 252 (abbrev-table-put (symbol-value table) :regexp regexp)) 254 (let ((parents (abbrev-table-get (symbol-value mode-table) :parents))) 255 (cl-pushnew (symbol-value table) parents :test #'eq) 256 (abbrev-table-put (symbol-value mode-table) :parents parents))))) 261 (cl-defmacro skt-define-template (name (&key mode tag abbrev docstring) &body body) 262 "Define a tempo template. 263 This macro defines a new tempo template or updates the old one. 264 NAME is a symbol. ARGS is a list of the form ([KEY VALUE]...) 265 where each KEY can be one of :tag, :abbrev, :docstring or :mode. 267 If KEY is :tag, VALUE should be a boolean. If VALUE is non-nil, 268 then a tempo tag with NAME will be created for this template. 270 If KEY is :abbrev, VALUE should be a boolean. If VALUE is 271 non-nil, then a NAME abbrev will be created for this template. 273 If KEY is :docstring, VALUE should be a string. It will be a 274 docstring of the generated function. 276 If KEY is :mode, VALUE should be a list of modes or single mode. 277 If this option is provided, than a tempo tag and an abbrev will 278 be created for these modes, otherwise they will be global (if 279 :tag and :abbrev options were provided, of course). 281 BODY is a sequence of tempo elements that will be passed as a 282 list directly to `tempo-define-template's second argument. 285 \(skt-define-template defvar (:mode emacs-lisp-mode :tag t :abbrev t 286 :docstring \"defvar template\") 287 \"(defvar \" (string-trim-right (buffer-name) (rx \".el\" eos)) \"-\" p n> 289 `(skt--define 'skt--define-template ,(symbol-name name) 290 ',(skt--modes mode) ,tag ,abbrev ,docstring ',body)) 293 (cl-defmacro skt-define-skeleton (name (&key mode tag abbrev docstring) &rest body) 294 "Define skeleton template. 295 See `skt-define-template' for explanation of NAME, MODE, TAG, 296 ABBREV and DOCSTRING. 298 BODY is a sequence of skeleton elements that will be passed 299 directly to `define-skeleton'. 302 \(skt-define-skeleton defun (:mode (emacs-lisp-mode lisp-interaction-mode) 304 :docstring \"defun template\") 305 \"(defun \" str \" (\" @ - \")\" \n 307 `(skt--define #'skt--define-skeleton ,(symbol-name name) 308 ',(skt--modes mode) ,tag ,abbrev ,docstring ',body)) 311 (cl-defmacro skt-define-function (name (&key mode tag abbrev docstring) function) 312 "Define FUNCTION template. 313 See `skt-define-template' for explanation of NAME, MODE, TAG, 314 ABBREV and DOCSTRING. 316 The main purpose of this macro, is to create tempo tags and 317 abbrevs for existing skeleton templates, such as `sh-case'. 320 \(skt-define-function shcase (:tag t :abbrev t :mode `sh-mode') `sh-case')" 321 `(skt--define #'skt--define-function ,(symbol-name name) 322 ',(skt--modes mode) ,tag ,abbrev ,docstring ',function)) 325 (defun skt--complete-template (string tag-list) 326 "An :override advice function for `tempo-display-completions'. 327 Show completion for STRING in a TAG-LIST. After selection 330 Rewritten because the original function uses an old way of 331 displaying completions in a separate buffer, which is not 332 clickable anyway. Now it uses new (compared to the originial 333 tempo package) and shiny `completing-read' interface." 334 (let* ((tags (mapcar #'car tag-list)) 335 (tag (completing-read "Skt: " tags nil t string))) 336 (delete-char (- (length string))) 337 (tempo-insert-template (cdr (assoc tag tag-list)) nil))) 340 (defcustom skt-enable-tempo-elements nil 341 "Enable extra tempo elements. 342 These elements add conditionals and looping support for tempo 343 like those in skeleton, making skeleton pretty much obsolete. 345 If you want to set this option from ELisp, you have to remove 346 `skt-tempo-user-elements' from `tempo-user-elements' on nil 347 and add it on non-nil." 348 :type '(boolean :tag "Enable tempo elements?") 349 :set (lambda (variable value) 351 (add-hook 'tempo-user-functions #'skt-tempo-user-elements) 352 (remove-hook 'tempo-user-functions #'skt-tempo-user-elements)) 353 (set-default variable value)) 356 (defcustom skt-completing-read nil 357 "Override default `tempo-display-completions'. 358 By default it uses a completion buffer to show completions. This 359 option overrides this function to use `completing-read' to select 360 partial skt tag or complete tag on region. 362 If you wish to set this variable from ELisp code, you have to 363 remove `skt--complete-template' advice from 364 `tempo-display-completions' on nil and add it as on :override 366 :type '(boolean :tag "Override?") 367 :set (lambda (variable value) 369 (advice-add 'tempo-display-completions :override #'skt--complete-template) 370 (advice-remove 'tempo-display-completions #'skt--complete-template)) 371 (set-default variable value)) 374 (defcustom skt-delete-duplicate-marks nil 375 "Override default `tempo-insert-mark'. 376 Marks are used to jump on points of interest in a template. By 377 default `tempo-insert-mark' does not remove duplicate marks. 378 Duplicate marks might appear when the buffer shrinks and some of 379 the marks start pointing to the same location. This option tries 380 to fix this by checking for duplicate marks every time the 381 function is called. Emacs might get slower with a lot of 384 If you want to set this option from ELisp, you have to remove 385 `skt--insert-mark' advice from `tempo-insert-mark' on nil and 386 add it as on :override advice on non-nil." 387 :type '(boolean :tag "Override?") 388 :set (lambda (variable value) 390 (advice-add 'tempo-insert-mark :override #'skt--insert-mark) 391 (advice-remove 'tempo-insert-mark #'skt--insert-mark)) 392 (set-default variable value)) 396 (put 'tempo-define-template 'lisp-indent-function 1) 397 (put 'skt-define-template 'lisp-indent-function 2) 398 (put 'skt-define-skeleton 'lisp-indent-function 2) 399 (put 'skt-define-function 'lisp-indent-function 2)) 402 (defvar skt-tempo-else-key (kbd "C-M-g") 403 "Key used to execute else branch in tempo conditional.") 405 (defun skt-tempo--prompt (prompt) 406 "Make prompt for tempo conditional. 407 PROMPT is preceded with `skt-tempo-else-key'." 408 (concat "(" (key-description skt-tempo-else-key) " to quit) " prompt)) 410 (defun skt-tempo-user-elements (element) 411 "Support for conditional and looping tempo elements. 412 The following forms are supported for ELEMENT: 414 \(:if (PROMPT VAR) THEN ELSE) 416 \(:when (PROMPT VAR) BODY...) 418 \(:while (PROMPT VAR) BODY...) 420 PROMPT is a string used to read value for VAR. VAR is a tempo 421 variable symbol. Its value can be read with s, as usual. BODY, 422 THEN and ELSE are tempo elements. To abort the execution of 423 these elements, user must press `skt-tempo-else-key'. 425 The main purpose of this extension is to mimic skeleton conditionals." 427 (`(:if (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) ,then ,else) 428 (let ((prompt (skt-tempo--prompt prompt)) 429 (map (make-sparse-keymap))) 430 (set-keymap-parent map minibuffer-local-map) 431 (define-key map skt-tempo-else-key 432 (lambda () (interactive) (throw 'else else))) 434 (tempo-save-named var (read-from-minibuffer prompt nil map)) 436 (`(:when (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body) 437 `(:if (,prompt ,var) (l ,@body) (l))) 438 (`(:while (,(and (pred stringp) prompt) ,(and (pred symbolp) var)) . ,body) 439 `(:when (,prompt ,var) ,@body ,element))))