| 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. |
| 41 | It should take strings and characters and return them transformed, or nil |
| 42 | which means no transformation. |
| 43 | Typical 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. |
| 66 | DOCUMENTATION is that of the command, while the variable of the same name, |
| 67 | which contains the definition, has a documentation to that effect. |
| 68 | PROMPT 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. |
| 77 | See 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. |
| 90 | If optional NO-NEWLINE is nil the skeleton will end on a line of its own. |
| 91 | |
| 92 | DEFINITION is made up as (PROMPT ELEMENT ...). PROMPT may be nil if not |
| 93 | needed, a prompt-string or an expression for complex read functions. |
| 94 | |
| 95 | If 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 | |
| 108 | ELEMENT may itself be DEFINITION with a PROMPT. The user is prompted |
| 109 | repeatedly for different inputs. The DEFINITION is processed as often |
| 110 | as the user enters a non-empty string. \\[keyboard-quit] terminates |
| 111 | skeleton insertion, but continues after `resume:' and positions at `_' |
| 112 | if any. If PROMPT in such a sub-definition contains a \".. %s ..\" it |
| 113 | is replaced by `skeleton-subprompt'. |
| 114 | |
| 115 | Other lisp-expressions are evaluated and the value treated as above. |
| 116 | The 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 "\ |
| 136 | As long as you provide input you will insert another subskeleton. |
| 137 | |
| 138 | If you enter the empty string, the loop inserting subskeletons is |
| 139 | left, and the current one is removed as far as it has been entered. |
| 140 | |
| 141 | If you quit, the current subskeleton is removed as far as it has been |
| 142 | entered. No more of the skeleton will be inserted, except maybe for a |
| 143 | syntactically 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 | \f |
| 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. |
| 230 | Otherwise 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. |
| 239 | This 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' |
| 246 | does nothing. |
| 247 | |
| 248 | Elements 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 | |
| 256 | With no ARG, if `pair' is non-nil, and if |
| 257 | `pair-on-word' is non-nil or we are not before or inside a |
| 258 | word, and if `pair-filter' returns nil, pairing is performed. |
| 259 | |
| 260 | If a match is found in `pair-alist', that is inserted, else |
| 261 | the defaults are used. These are (), [], {}, <> and `' for the |
| 262 | symmetrical 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 | \f |
| 283 | |
| 284 | ;;;###autoload |
| 285 | ;; a more serious example can be found in shell-script.el |
| 286 | (defun mirror-mode () |
| 287 | "This major mode is an amusing little example of paired insertion. |
| 288 | All printable characters do a paired self insert, while the other commands |
| 289 | work normally." |
| 290 | (interactive) |
| 291 | (kill-all-local-variables) |
| 292 | (make-local-variable 'pair) |
| 293 | (make-local-variable 'pair-on-word) |
| 294 | (make-local-variable 'pair-filter) |
| 295 | (make-local-variable 'pair-alist) |
| 296 | (setq major-mode 'mirror-mode |
| 297 | mode-name "Mirror" |
| 298 | pair-on-word t |
| 299 | ;; in the middle column insert one or none if odd window-width |
| 300 | pair-filter (lambda () |
| 301 | (if (>= (current-column) |
| 302 | (/ (window-width) 2)) |
| 303 | ;; insert both on next line |
| 304 | (next-line 1) |
| 305 | ;; insert one or both? |
| 306 | (= (* 2 (1+ (current-column))) |
| 307 | (window-width)))) |
| 308 | ;; mirror these the other way round as well |
| 309 | pair-alist '((?) _ ?() |
| 310 | (?] _ ?[) |
| 311 | (?} _ ?{) |
| 312 | (?> _ ?<) |
| 313 | (?/ _ ?\\) |
| 314 | (?\\ _ ?/) |
| 315 | (?` ?` _ "''") |
| 316 | (?' ?' _ "``")) |
| 317 | ;; in this mode we exceptionally ignore the user, else it's no fun |
| 318 | pair t) |
| 319 | (let ((map (make-keymap)) |
| 320 | (i ? )) |
| 321 | (use-local-map map) |
| 322 | (setq map (car (cdr map))) |
| 323 | (while (< i ?\^?) |
| 324 | (aset map i 'pair-insert-maybe) |
| 325 | (setq i (1+ i)))) |
| 326 | (run-hooks 'mirror-mode-hook)) |
| 327 | |
| 328 | ;; skeleton.el ends here |