1;;; skeleton.el --- Lisp language extension for writing statement skeletons 2 3;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Daniel Pfeiffer <occitan@esperanto.org> 7;; Maintainer: FSF 8;; Keywords: extensions, abbrev, languages, tools 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; A very concise language extension for writing structured statement 30;; skeleton insertion commands for programming language modes. This 31;; originated in shell-script mode and was applied to ada-mode's 32;; commands which shrunk to one third. And these commands are now 33;; user configurable. 34 35;;; Code: 36 37;; page 1: statement skeleton language definition & interpreter 38;; page 2: paired insertion 39;; page 3: mirror-mode, an example for setting up paired insertion 40 41 42(defvar skeleton-transformation-function 'identity 43 "*If non-nil, function applied to literal strings before they are inserted. 44It should take strings and characters and return them transformed, or nil 45which means no transformation. 46Typical examples might be `upcase' or `capitalize'.") 47(defvaralias 'skeleton-transformation 'skeleton-transformation-function) 48 49; this should be a fourth argument to defvar 50(put 'skeleton-transformation-function 'variable-interactive 51 "aTransformation function: ") 52 53 54(defvar skeleton-autowrap t 55 "Controls wrapping behavior of functions created with `define-skeleton'. 56When the region is visible (due to `transient-mark-mode' or marking a region 57with the mouse) and this is non-nil and the function was called without an 58explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible 59region. 60 61We will probably delete this variable in a future Emacs version 62unless we get a substantial number of complaints about the auto-wrap 63feature.") 64 65(defvar skeleton-end-newline t 66 "If non-nil, make sure that the skeleton inserted ends with a newline. 67This just influences the way the default `skeleton-end-hook' behaves.") 68 69(defvar skeleton-end-hook 70 (lambda () 71 (or (eolp) (not skeleton-end-newline) (newline-and-indent))) 72 "Hook called at end of skeleton but before going to point of interest. 73By default this moves out anything following to next line, 74 unless `skeleton-end-newline' is set to nil. 75The variables `v1' and `v2' are still set when calling this.") 76 77 78;;;###autoload 79(defvar skeleton-filter-function 'identity 80 "Function for transforming a skeleton proxy's aliases' variable value.") 81(defvaralias 'skeleton-filter 'skeleton-filter-function) 82 83(defvar skeleton-untabify t 84 "When non-nil untabifies when deleting backwards with element -ARG.") 85 86(defvar skeleton-newline-indent-rigidly nil 87 "When non-nil, indent rigidly under current line for element `\\n'. 88Else use mode's `indent-line-function'.") 89 90(defvar skeleton-further-elements () 91 "A buffer-local varlist (see `let') of mode specific skeleton elements. 92These variables are bound while interpreting a skeleton. Their value may 93in turn be any valid skeleton element if they are themselves to be used as 94skeleton elements.") 95(make-variable-buffer-local 'skeleton-further-elements) 96 97 98(defvar skeleton-subprompt 99 (substitute-command-keys 100 "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") 101 "*Replacement for %s in prompts of recursive subskeletons.") 102 103 104(defvar skeleton-debug nil 105 "*If non-nil `define-skeleton' will override previous definition.") 106 107(defvar skeleton-positions nil 108 "List of positions marked with @, after skeleton insertion. 109The list describes the most recent skeleton insertion, and its elements 110are integer buffer positions in the reverse order of the insertion order.") 111 112;; reduce the number of compiler warnings 113(defvar skeleton) 114(defvar skeleton-modified) 115(defvar skeleton-point) 116(defvar skeleton-regions) 117 118(def-edebug-spec skeleton-edebug-spec 119 ([&or null stringp (stringp &rest stringp) [[¬ atom] def-form]] 120 &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:" 121 ("quote" def-form) skeleton-edebug-spec def-form)) 122;;;###autoload 123(defmacro define-skeleton (command documentation &rest skeleton) 124 "Define a user-configurable COMMAND that enters a statement skeleton. 125DOCUMENTATION is that of the command. 126SKELETON is as defined under `skeleton-insert'." 127 (declare (debug (&define name stringp skeleton-edebug-spec))) 128 (if skeleton-debug 129 (set command skeleton)) 130 `(progn 131 ;; Tell self-insert-command that this function, if called by an 132 ;; abbrev, should cause the self-insert to be skipped. 133 (put ',command 'no-self-insert t) 134 (defun ,command (&optional str arg) 135 ,(concat documentation 136 (if (string-match "\n\\'" documentation) 137 "" "\n") 138 "\n" 139 "This is a skeleton command (see `skeleton-insert'). 140Normally the skeleton text is inserted at point, with nothing \"inside\". 141If there is a highlighted region, the skeleton text is wrapped 142around the region text. 143 144A prefix argument ARG says to wrap the skeleton around the next ARG words. 145A prefix argument of -1 says to wrap around region, even if not highlighted. 146A prefix argument of zero says to wrap around zero words---that is, nothing. 147This is a way of overriding the use of a highlighted region.") 148 (interactive "*P\nP") 149 (skeleton-proxy-new ',skeleton str arg)))) 150 151;;;###autoload 152(defun skeleton-proxy-new (skeleton &optional str arg) 153 "Insert SKELETON. 154Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). 155If no ARG was given, but the region is visible, ARG defaults to -1 depending 156on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. 157This command can also be an abbrev expansion (3rd and 4th columns in 158\\[edit-abbrevs] buffer: \"\" command-name). 159 160Optional second argument STR may also be a string which will be the value 161of `str' whereas the skeleton's interactor is then ignored." 162 (skeleton-insert (funcall skeleton-filter-function skeleton) 163 ;; Pretend C-x a e passed its prefix arg to us 164 (if (or arg current-prefix-arg) 165 (prefix-numeric-value (or arg 166 current-prefix-arg)) 167 (and skeleton-autowrap 168 (or (eq last-command 'mouse-drag-region) 169 (and transient-mark-mode mark-active)) 170 ;; Deactivate the mark, in case one of the 171 ;; elements of the skeleton is sensitive 172 ;; to such situations (e.g. it is itself a 173 ;; skeleton). 174 (progn (deactivate-mark) 175 -1))) 176 (if (stringp str) 177 str)) 178 ;; Return non-nil to tell expand-abbrev that expansion has happened. 179 ;; Otherwise the no-self-insert is ignored. 180 t) 181 182;;;###autoload 183(defun skeleton-insert (skeleton &optional regions str) 184 "Insert the complex statement skeleton SKELETON describes very concisely. 185 186With optional second argument REGIONS, wrap first interesting point 187\(`_') in skeleton around next REGIONS words, if REGIONS is positive. 188If REGIONS is negative, wrap REGIONS preceding interregions into first 189REGIONS interesting positions \(successive `_'s) in skeleton. 190 191An interregion is the stretch of text between two contiguous marked 192points. If you marked A B C [] (where [] is the cursor) in 193alphabetical order, the 3 interregions are simply the last 3 regions. 194But if you marked B A [] C, the interregions are B-A, A-[], []-C. 195 196The optional third argument STR, if specified, is the value for the 197variable `str' within the skeleton. When this is non-nil, the 198interactor gets ignored, and this should be a valid skeleton element. 199 200SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if 201not needed, a prompt-string or an expression for complex read functions. 202 203If ELEMENT is a string or a character it gets inserted (see also 204`skeleton-transformation-function'). Other possibilities are: 205 206 \\n go to next line and indent according to mode 207 _ interesting point, interregion here 208 - interesting point, no interregion interaction, overrides 209 interesting point set by _ 210 > indent line (or interregion if > _) according to major mode 211 @ add position to `skeleton-positions' 212 & do next ELEMENT iff previous moved point 213 | do next ELEMENT iff previous didn't move point 214 -num delete num preceding characters (see `skeleton-untabify') 215 resume: skipped, continue here if quit is signaled 216 nil skipped 217 218After termination, point will be positioned at the last occurrence of - 219or at the first occurrence of _ or at the end of the inserted text. 220 221Further elements can be defined via `skeleton-further-elements'. ELEMENT may 222itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for 223different inputs. The SKELETON is processed as often as the user enters a 224non-empty string. \\[keyboard-quit] terminates skeleton insertion, but 225continues after `resume:' and positions at `_' if any. If INTERACTOR in such 226a subskeleton is a prompt-string which contains a \".. %s ..\" it is 227formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list of 228strings with the subskeleton being repeated once for each string. 229 230Quoted Lisp expressions are evaluated for their side-effects. 231Other Lisp expressions are evaluated and the value treated as above. 232Note that expressions may not return t since this implies an 233endless loop. Modes can define other symbols by locally setting them 234to any valid skeleton element. The following local variables are 235available: 236 237 str first time: read a string according to INTERACTOR 238 then: insert previously read string once more 239 help help-form during interaction with the user or nil 240 input initial input (string or cons with index) while reading str 241 v1, v2 local variables for memorizing anything you want 242 243When done with skeleton, but before going back to `_'-point call 244`skeleton-end-hook' if that is non-nil." 245 (let ((skeleton-regions regions)) 246 (and skeleton-regions 247 (setq skeleton-regions 248 (if (> skeleton-regions 0) 249 (list (copy-marker (point) t) 250 (save-excursion (forward-word skeleton-regions) 251 (point-marker))) 252 (setq skeleton-regions (- skeleton-regions)) 253 ;; copy skeleton-regions - 1 elements from `mark-ring' 254 (let ((l1 (cons (mark-marker) mark-ring)) 255 (l2 (list (copy-marker (point) t)))) 256 (while (and l1 (> skeleton-regions 0)) 257 (push (copy-marker (pop l1) t) l2) 258 (setq skeleton-regions (1- skeleton-regions))) 259 (sort l2 '<)))) 260 (goto-char (car skeleton-regions)) 261 (setq skeleton-regions (cdr skeleton-regions))) 262 (let ((beg (point)) 263 skeleton-modified skeleton-point resume: help input v1 v2) 264 (setq skeleton-positions nil) 265 (unwind-protect 266 (eval `(let ,skeleton-further-elements 267 (skeleton-internal-list skeleton str))) 268 (run-hooks 'skeleton-end-hook) 269 (sit-for 0) 270 (or (pos-visible-in-window-p beg) 271 (progn 272 (goto-char beg) 273 (recenter 0))) 274 (if skeleton-point 275 (goto-char skeleton-point)))))) 276 277(defun skeleton-read (prompt &optional initial-input recursive) 278 "Function for reading a string from the minibuffer within skeletons. 279 280PROMPT must be a string or a form that evaluates to a string. 281It may contain a `%s' which will be replaced by `skeleton-subprompt'. 282If non-nil second arg INITIAL-INPUT or variable `input' is a string or 283cons with index to insert before reading. If third arg RECURSIVE is non-nil 284i.e. we are handling the iterator of a subskeleton, returns empty string if 285user didn't modify input. 286While reading, the value of `minibuffer-help-form' is variable `help' if that 287is non-nil or a default string." 288 (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help)) 289 (if recursive "\ 290As long as you provide input you will insert another subskeleton. 291 292If you enter the empty string, the loop inserting subskeletons is 293left, and the current one is removed as far as it has been entered. 294 295If you quit, the current subskeleton is removed as far as it has been 296entered. No more of the skeleton will be inserted, except maybe for a 297syntactically necessary termination." 298 "\ 299You are inserting a skeleton. Standard text gets inserted into the buffer 300automatically, and you are prompted to fill in the variable parts."))) 301 (eolp (eolp))) 302 ;; since Emacs doesn't show main window's cursor, do something noticeable 303 (or eolp 304 (open-line 1)) 305 (unwind-protect 306 (setq prompt (if (stringp prompt) 307 (read-string (format prompt skeleton-subprompt) 308 (setq initial-input 309 (or initial-input 310 (symbol-value 'input)))) 311 (eval prompt))) 312 (or eolp 313 (delete-char 1)))) 314 (if (and recursive 315 (or (null prompt) 316 (string= prompt "") 317 (equal prompt initial-input) 318 (equal prompt (car-safe initial-input)))) 319 (signal 'quit t) 320 prompt)) 321 322(defun skeleton-internal-list (skeleton &optional str recursive) 323 (let* ((start (save-excursion (beginning-of-line) (point))) 324 (column (current-column)) 325 (line (buffer-substring start (line-end-position))) 326 opoint) 327 (or str 328 (setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive)))) 329 (when (and (eq (cadr skeleton) '\n) (not recursive) 330 (save-excursion (skip-chars-backward " \t") (bolp))) 331 (setq skeleton (cons nil (cons '> (cddr skeleton))))) 332 (while (setq skeleton-modified (eq opoint (point)) 333 opoint (point) 334 skeleton (cdr skeleton)) 335 (condition-case quit 336 (skeleton-internal-1 (car skeleton) nil recursive) 337 (quit 338 (if (eq (cdr quit) 'recursive) 339 (setq recursive 'quit 340 skeleton (memq 'resume: skeleton)) 341 ;; Remove the subskeleton as far as it has been shown 342 ;; the subskeleton shouldn't have deleted outside current line. 343 (end-of-line) 344 (delete-region start (point)) 345 (insert line) 346 (move-to-column column) 347 (if (cdr quit) 348 (setq skeleton () 349 recursive nil) 350 (signal 'quit 'recursive))))))) 351 ;; maybe continue loop or go on to next outer resume: section 352 (if (eq recursive 'quit) 353 (signal 'quit 'recursive) 354 recursive)) 355 356(defun skeleton-internal-1 (element &optional literal recursive) 357 (cond 358 ((char-or-string-p element) 359 (if (and (integerp element) ; -num 360 (< element 0)) 361 (if skeleton-untabify 362 (backward-delete-char-untabify (- element)) 363 (delete-backward-char (- element))) 364 (insert (if (not literal) 365 (funcall skeleton-transformation-function element) 366 element)))) 367 ((or (eq element '\n) ; actually (eq '\n 'n) 368 ;; The sequence `> \n' is handled specially so as to indent the first 369 ;; line after inserting the newline (to get the proper indentation). 370 (and (eq element '>) (eq (nth 1 skeleton) '\n) (pop skeleton))) 371 (let ((pos (if (eq element '>) (point)))) 372 (cond 373 ((and skeleton-regions (eq (nth 1 skeleton) '_)) 374 (or (eolp) (newline)) 375 (if pos (save-excursion (goto-char pos) (indent-according-to-mode))) 376 (indent-region (line-beginning-position) 377 (car skeleton-regions) nil)) 378 ;; \n as last element only inserts \n if not at eol. 379 ((and (null (cdr skeleton)) (not recursive) (eolp)) 380 (if pos (indent-according-to-mode))) 381 (skeleton-newline-indent-rigidly 382 (let ((pt (point))) 383 (newline) 384 (indent-to (save-excursion 385 (goto-char pt) 386 (if pos (indent-according-to-mode)) 387 (current-indentation))))) 388 (t (if pos (reindent-then-newline-and-indent) 389 (newline) 390 (indent-according-to-mode)))))) 391 ((eq element '>) 392 (if (and skeleton-regions (eq (nth 1 skeleton) '_)) 393 (indent-region (line-beginning-position) 394 (car skeleton-regions) nil) 395 (indent-according-to-mode))) 396 ((eq element '_) 397 (if skeleton-regions 398 (progn 399 (goto-char (pop skeleton-regions)) 400 (and (<= (current-column) (current-indentation)) 401 (eq (nth 1 skeleton) '\n) 402 (end-of-line 0))) 403 (or skeleton-point 404 (setq skeleton-point (point))))) 405 ((eq element '-) 406 (setq skeleton-point (point))) 407 ((eq element '&) 408 (when skeleton-modified (pop skeleton))) 409 ((eq element '|) 410 (unless skeleton-modified (pop skeleton))) 411 ((eq element '@) 412 (push (point) skeleton-positions)) 413 ((eq 'quote (car-safe element)) 414 (eval (nth 1 element))) 415 ((and (consp element) 416 (or (stringp (car element)) (listp (car element)))) 417 ;; Don't forget: `symbolp' is also true for nil. 418 (if (symbolp (car-safe (car element))) 419 (while (and (skeleton-internal-list element nil t) 420 ;; If the interactor is nil, don't infinite loop. 421 (car element))) 422 (setq literal (car element)) 423 (while literal 424 (skeleton-internal-list element (car literal)) 425 (setq literal (cdr literal))))) 426 ((null element)) 427 (t (skeleton-internal-1 (eval element) t recursive)))) 428 429;; Maybe belongs into simple.el or elsewhere 430;; ;;;###autoload 431;; (define-skeleton local-variables-section 432;; "Insert a local variables section. Use current comment syntax if any." 433;; (completing-read "Mode: " obarray 434;; (lambda (symbol) 435;; (if (commandp symbol) 436;; (string-match "-mode$" (symbol-name symbol)))) 437;; t) 438;; '(save-excursion 439;; (if (re-search-forward page-delimiter nil t) 440;; (error "Not on last page"))) 441;; comment-start "Local Variables:" comment-end \n 442;; comment-start "mode: " str 443;; & -5 | '(kill-line 0) & -1 | comment-end \n 444;; ( (completing-read (format "Variable, %s: " skeleton-subprompt) 445;; obarray 446;; (lambda (symbol) 447;; (or (eq symbol 'eval) 448;; (user-variable-p symbol))) 449;; t) 450;; comment-start str ": " 451;; (read-from-minibuffer "Expression: " nil read-expression-map nil 452;; 'read-expression-history) | _ 453;; comment-end \n) 454;; resume: 455;; comment-start "End:" comment-end \n) 456 457;; Variables and command for automatically inserting pairs like () or "". 458 459(defvar skeleton-pair nil 460 "*If this is nil pairing is turned off, no matter what else is set. 461Otherwise modes with `skeleton-pair-insert-maybe' on some keys 462will attempt to insert pairs of matching characters.") 463 464 465(defvar skeleton-pair-on-word nil 466 "*If this is nil, paired insertion is inhibited before or inside a word.") 467 468 469(defvar skeleton-pair-filter-function (lambda () nil) 470 "Attempt paired insertion if this function returns nil, before inserting. 471This allows for context-sensitive checking whether pairing is appropriate.") 472 473 474(defvar skeleton-pair-alist () 475 "An override alist of pairing partners matched against `last-command-char'. 476Each alist element, which looks like (ELEMENT ...), is passed to 477`skeleton-insert' with no interactor. Variable `str' does nothing. 478 479Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") 480 481(defvar skeleton-pair-default-alist '((?( _ ?)) (?\)) 482 (?[ _ ?]) (?\]) 483 (?{ _ ?}) (?\}) 484 (?< _ ?>) (?\>) 485 (?� _ ?�) (?\�) 486 (?` _ ?'))) 487 488;;;###autoload 489(defun skeleton-pair-insert-maybe (arg) 490 "Insert the character you type ARG times. 491 492With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region 493is visible the pair is wrapped around it depending on `skeleton-autowrap'. 494Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a 495word, and if `skeleton-pair-filter-function' returns nil, pairing is performed. 496Pairing is also prohibited if we are right after a quoting character 497such as backslash. 498 499If a match is found in `skeleton-pair-alist', that is inserted, else 500the defaults are used. These are (), [], {}, <> and `' for the 501symmetrical ones, and the same character twice for the others." 502 (interactive "*P") 503 (if (or arg (not skeleton-pair)) 504 (self-insert-command (prefix-numeric-value arg)) 505 (let* ((mark (and skeleton-autowrap 506 (or (eq last-command 'mouse-drag-region) 507 (and transient-mark-mode mark-active)))) 508 (skeleton-end-hook) 509 (char last-command-char) 510 (skeleton (or (assq char skeleton-pair-alist) 511 (assq char skeleton-pair-default-alist) 512 `(,char _ ,char)))) 513 (if (or (memq (char-syntax (preceding-char)) '(?\\ ?/)) 514 (and (not mark) 515 (or overwrite-mode 516 (if (not skeleton-pair-on-word) (looking-at "\\w")) 517 (funcall skeleton-pair-filter-function)))) 518 (self-insert-command (prefix-numeric-value arg)) 519 (skeleton-insert (cons nil skeleton) (if mark -1)))))) 520 521 522;; A more serious example can be found in sh-script.el 523;;; (defun mirror-mode () 524;; "This major mode is an amusing little example of paired insertion. 525;;All printable characters do a paired self insert, while the other commands 526;;work normally." 527;; (interactive) 528;; (kill-all-local-variables) 529;; (make-local-variable 'skeleton-pair) 530;; (make-local-variable 'skeleton-pair-on-word) 531;; (make-local-variable 'skeleton-pair-filter-function) 532;; (make-local-variable 'skeleton-pair-alist) 533;; (setq major-mode 'mirror-mode 534;; mode-name "Mirror" 535;; skeleton-pair-on-word t 536;; ;; in the middle column insert one or none if odd window-width 537;; skeleton-pair-filter-function (lambda () 538;; (if (>= (current-column) 539;; (/ (window-width) 2)) 540;; ;; insert both on next line 541;; (next-line 1) 542;; ;; insert one or both? 543;; (= (* 2 (1+ (current-column))) 544;; (window-width)))) 545;; ;; mirror these the other way round as well 546;; skeleton-pair-alist '((?) _ ?() 547;; (?] _ ?[) 548;; (?} _ ?{) 549;; (?> _ ?<) 550;; (?/ _ ?\\) 551;; (?\\ _ ?/) 552;; (?` ?` _ "''") 553;; (?' ?' _ "``")) 554;; ;; in this mode we exceptionally ignore the user, else it's no fun 555;; skeleton-pair t) 556;; (let ((map (make-vector 256 'skeleton-pair-insert-maybe)) 557;; (i 0)) 558;; (use-local-map `(keymap ,map)) 559;; (while (< i ? ) 560;; (aset map i nil) 561;; (aset map (+ i 128) nil) 562;; (setq i (1+ i)))) 563;; (run-mode-hooks 'mirror-mode-hook)) 564 565(provide 'skeleton) 566 567;;; arch-tag: ccad7bd5-eb5d-40de-9ded-900197215c3e 568;;; skeleton.el ends here 569