1;;; skeleton.el --- Metalanguage for writing statement skeletons 2;; Copyright (C) 1993 by Free Software Foundation, Inc. 3 4;; Author: Daniel Pfeiffer, fax (+49 69) 75 88 529, c/o <bonhoure@cict.fr> 5;; Maintainer: FSF 6;; Keywords: shell programming 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to 22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 24;;; Commentary: 25 26;; A very concise metalanguage for writing structured statement 27;; skeleton insertion commands for programming language modes. This 28;; originated in shell-script mode and was applied to ada-mode's 29;; commands which shrunk to one third. And these commands are now 30;; user configurable. 31 32;;; Code: 33 34;; page 1: statement skeleton metalanguage definition & interpreter 35;; page 2: paired insertion 36;; page 3: mirror-mode, an example for setting up paired insertion 37 38 39(defvar skeleton-transformation nil 40 "*If non-nil, function applied to strings before they are inserted. 41It should take strings and characters and return them transformed, or nil 42which means no transformation. 43Typical examples might be `upcase' or `capitalize'.") 44 45; this should be a fourth argument to defvar 46(put 'skeleton-transformation 'variable-interactive 47 "aTransformation function: ") 48 49 50 51(defvar skeleton-subprompt 52 (substitute-command-keys 53 "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") 54 "*Replacement for %s in prompts of recursive skeleton definitions.") 55 56 57 58(defvar skeleton-debug nil 59 "*If non-nil `define-skeleton' will override previous definition.") 60 61 62 63;;;###autoload 64(defmacro define-skeleton (command documentation &rest definition) 65 "Define a user-configurable COMMAND that enters a statement skeleton. 66DOCUMENTATION is that of the command, while the variable of the same name, 67which contains the definition, has a documentation to that effect. 68PROMPT and ELEMENT ... are as defined under `skeleton-insert'." 69 (if skeleton-debug 70 (set command definition)) 71 (require 'backquote) 72 (`(progn 73 (defvar (, command) '(, definition) 74 (, (concat "*Definition for the " 75 (symbol-name command) 76 " skeleton command. 77See function `skeleton-insert' for meaning.")) ) 78 (defun (, command) () 79 (, documentation) 80 (interactive) 81 ;; Don't use last-command to guarantee command does the same thing, 82 ;; whatever other name it is given. 83 (skeleton-insert (, command)))))) 84 85 86 87;;;###autoload 88(defun skeleton-insert (definition &optional no-newline) 89 "Insert the complex statement skeleton DEFINITION describes very concisely. 90If optional NO-NEWLINE is nil the skeleton will end on a line of its own. 91 92DEFINITION is made up as (PROMPT ELEMENT ...). PROMPT may be nil if not 93needed, a prompt-string or an expression for complex read functions. 94 95If ELEMENT is a string or a character it gets inserted (see also 96`skeleton-transformation'). Other possibilities are: 97 98 \\n go to next line and align cursor 99 > indent according to major mode 100 < undent tab-width spaces but not beyond beginning of line 101 _ cursor after termination 102 & skip next ELEMENT if previous didn't move point 103 | skip next ELEMENT if previous moved point 104 -num delete num preceding characters 105 resume: skipped, continue here if quit is signaled 106 nil skipped 107 108ELEMENT may itself be DEFINITION with a PROMPT. The user is prompted 109repeatedly for different inputs. The DEFINITION is processed as often 110as the user enters a non-empty string. \\[keyboard-quit] terminates 111skeleton insertion, but continues after `resume:' and positions at `_' 112if any. If PROMPT in such a sub-definition contains a \".. %s ..\" it 113is replaced by `skeleton-subprompt'. 114 115Other lisp-expressions are evaluated and the value treated as above. 116The following local variables are available: 117 118 str first time: read a string prompting with PROMPT and insert it 119 if PROMPT is not a string it is evaluated instead 120 then: insert previously read string once more 121 quit non-nil when resume: section is entered by keyboard quit 122 v1, v2 local variables for memorising anything you want" 123 (let (modified opoint point resume: quit v1 v2) 124 (skeleton-internal-list definition (car definition)) 125 (or no-newline 126 (eolp) 127 (newline) 128 (indent-relative t)) 129 (if point 130 (goto-char point)))) 131 132 133 134(defun skeleton-internal-read (str) 135 (let ((minibuffer-help-form "\ 136As long as you provide input you will insert another subskeleton. 137 138If you enter the empty string, the loop inserting subskeletons is 139left, and the current one is removed as far as it has been entered. 140 141If you quit, the current subskeleton is removed as far as it has been 142entered. No more of the skeleton will be inserted, except maybe for a 143syntactically necessary termination.")) 144 (setq str (if (stringp str) 145 (read-string 146 (format str skeleton-subprompt)) 147 (eval str)))) 148 (if (string= str "") 149 (signal 'quit t) 150 str)) 151 152 153(defun skeleton-internal-list (definition &optional str recursive start line) 154 (condition-case quit 155 (progn 156 (setq start (save-excursion (beginning-of-line) (point)) 157 column (current-column) 158 line (buffer-substring start 159 (save-excursion (end-of-line) (point))) 160 str (list 'setq 'str 161 (if recursive 162 (list 'skeleton-internal-read (list 'quote str)) 163 (list (if (stringp str) 164 'read-string 165 'eval) 166 str)))) 167 (while (setq modified (eq opoint (point)) 168 opoint (point) 169 definition (cdr definition)) 170 (skeleton-internal-1 (car definition))) 171 ;; maybe continue loop 172 recursive) 173 (quit ;; remove the subskeleton as far as it has been shown 174 (if (eq (cdr quit) 'recursive) 175 () 176 ;; the subskeleton shouldn't have deleted outside current line 177 (end-of-line) 178 (delete-region start (point)) 179 (insert line) 180 (move-to-column column)) 181 (if (eq (cdr quit) t) 182 ;; empty string entered 183 nil 184 (while (if definition 185 (not (eq (car (setq definition (cdr definition))) 186 'resume:)))) 187 (if definition 188 (skeleton-internal-list definition) 189 ;; propagate signal we can't handle 190 (if recursive (signal 'quit 'recursive))))))) 191 192 193 194(defun skeleton-internal-1 (element) 195 (cond ((and (integerp element) 196 (< element 0)) 197 (delete-char element)) 198 ((char-or-string-p element) 199 (insert (if skeleton-transformation 200 (funcall skeleton-transformation element) 201 element)) ) 202 ((eq element '\n) ; actually (eq '\n 'n) 203 (newline) 204 (indent-relative t) ) 205 ((eq element '>) 206 (indent-for-tab-command) ) 207 ((eq element '<) 208 (backward-delete-char-untabify (min tab-width (current-column))) ) 209 ((eq element '_) 210 (or point 211 (setq point (point))) ) 212 ((eq element '&) 213 (if modified 214 (setq definition (cdr definition))) ) 215 ((eq element '|) 216 (or modified 217 (setq definition (cdr definition))) ) 218 ((if (consp element) 219 (or (stringp (car element)) 220 (consp (car element)))) 221 (while (skeleton-internal-list element (car element) t)) ) 222 ((null element) ) 223 ((skeleton-internal-1 (eval element)) ))) 224 225 226;; variables and command for automatically inserting pairs like () or "" 227 228(defvar pair nil 229 "*If this is nil pairing is turned off, no matter what else is set. 230Otherwise modes with `pair-insert-maybe' on some keys will attempt this.") 231 232 233(defvar pair-on-word nil 234 "*If this is nil pairing is not attempted before or inside a word.") 235 236 237(defvar pair-filter (lambda ()) 238 "Attempt pairing if this function returns nil, before inserting. 239This allows for context-sensitive checking whether pairing is appropriate.") 240 241 242(defvar pair-alist () 243 "An override alist of pairing partners matched against 244`last-command-char'. Each alist element, which looks like (ELEMENT 245...), is passed to `skeleton-insert' with no prompt. Variable `str' 246does nothing. 247 248Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n < ?}).") 249 250 251 252;;;###autoload 253(defun pair-insert-maybe (arg) 254 "Insert the character you type ARG times. 255 256With no ARG, if `pair' is non-nil, and if 257`pair-on-word' is non-nil or we are not before or inside a 258word, and if `pair-filter' returns nil, pairing is performed. 259 260If a match is found in `pair-alist', that is inserted, else 261the defaults are used. These are (), [], {}, <> and `' for the 262symmetrical ones, and the same character twice for the others." 263 (interactive "*P") 264 (if (or arg 265 (not pair) 266 (if (not pair-on-word) (looking-at "\\w")) 267 (funcall pair-filter)) 268 (self-insert-command (prefix-numeric-value arg)) 269 (insert last-command-char) 270 (if (setq arg (assq last-command-char pair-alist)) 271 ;; typed char is inserted, and car means no prompt 272 (skeleton-insert arg t) 273 (save-excursion 274 (insert (or (cdr (assq last-command-char 275 '((?( . ?)) 276 (?[ . ?]) 277 (?{ . ?}) 278 (?< . ?>) 279 (?` . ?')))) 280 last-command-char)))))) 281 282 283;; a more serious example can be found in sh-script.el 284;;;(defun mirror-mode () 285;;; "This major mode is an amusing little example of paired insertion. 286;;;All printable characters do a paired self insert, while the other commands 287;;;work normally." 288;;; (interactive) 289;;; (kill-all-local-variables) 290;;; (make-local-variable 'pair) 291;;; (make-local-variable 'pair-on-word) 292;;; (make-local-variable 'pair-filter) 293;;; (make-local-variable 'pair-alist) 294;;; (setq major-mode 'mirror-mode 295;;; mode-name "Mirror" 296;;; pair-on-word t 297;;; ;; in the middle column insert one or none if odd window-width 298;;; pair-filter (lambda () 299;;; (if (>= (current-column) 300;;; (/ (window-width) 2)) 301;;; ;; insert both on next line 302;;; (next-line 1) 303;;; ;; insert one or both? 304;;; (= (* 2 (1+ (current-column))) 305;;; (window-width)))) 306;;; ;; mirror these the other way round as well 307;;; pair-alist '((?) _ ?() 308;;; (?] _ ?[) 309;;; (?} _ ?{) 310;;; (?> _ ?<) 311;;; (?/ _ ?\\) 312;;; (?\\ _ ?/) 313;;; (?` ?` _ "''") 314;;; (?' ?' _ "``")) 315;;; ;; in this mode we exceptionally ignore the user, else it's no fun 316;;; pair t) 317;;; (let ((map (make-keymap)) 318;;; (i ? )) 319;;; (use-local-map map) 320;;; (setq map (car (cdr map))) 321;;; (while (< i ?\^?) 322;;; (aset map i 'pair-insert-maybe) 323;;; (setq i (1+ i)))) 324;;; (run-hooks 'mirror-mode-hook)) 325 326;; skeleton.el ends here 327