Commit | Line | Data |
---|---|---|
f3611c70 KH |
1 | ;;; skeleton.el --- Lisp language extension for writing statement skeletons |
2 | ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc. | |
ac59aed8 | 3 | |
f3611c70 | 4 | ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 |
ac59aed8 | 5 | ;; Maintainer: FSF |
f3611c70 | 6 | ;; Keywords: extensions, abbrev, languages, tools |
ac59aed8 RS |
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 | ||
f3611c70 | 26 | ;; A very concise language extension for writing structured statement |
ac59aed8 RS |
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 | ||
f3611c70 | 34 | ;; page 1: statement skeleton language definition & interpreter |
ac59aed8 RS |
35 | ;; page 2: paired insertion |
36 | ;; page 3: mirror-mode, an example for setting up paired insertion | |
37 | ||
38 | ||
39 | (defvar skeleton-transformation nil | |
f3611c70 | 40 | "*If non-nil, function applied to literal strings before they are inserted. |
ac59aed8 RS |
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 | ||
f3611c70 KH |
51 | ;;;###autoload |
52 | (defvar skeleton-filter 'identity | |
53 | "Function for transforming a skeleton-proxy's aliases' variable value.") | |
54 | ||
55 | ||
56 | (defvar skeleton-untabify t | |
57 | "When non-`nil' untabifies when deleting backwards with element -ARG.") | |
58 | ||
59 | ||
60 | (defvar skeleton-further-elements () | |
61 | "A buffer-local varlist (see `let') of mode specific skeleton elements. | |
62 | These variables are bound while interpreting a skeleton. Their value may | |
63 | in turn be any valid skeleton element if they are themselves to be used as | |
64 | skeleton elements.") | |
65 | (make-variable-buffer-local 'skeleton-further-elements) | |
66 | ||
67 | ||
ac59aed8 RS |
68 | (defvar skeleton-subprompt |
69 | (substitute-command-keys | |
70 | "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") | |
f3611c70 KH |
71 | "*Replacement for %s in prompts of recursive subskeletons.") |
72 | ||
ac59aed8 | 73 | |
f3611c70 | 74 | (defvar skeleton-abbrev-cleanup nil) |
ac59aed8 RS |
75 | |
76 | ||
77 | (defvar skeleton-debug nil | |
78 | "*If non-nil `define-skeleton' will override previous definition.") | |
79 | ||
80 | ||
ac59aed8 | 81 | ;;;###autoload |
f3611c70 | 82 | (defmacro define-skeleton (command documentation &rest skeleton) |
ac59aed8 RS |
83 | "Define a user-configurable COMMAND that enters a statement skeleton. |
84 | DOCUMENTATION is that of the command, while the variable of the same name, | |
f3611c70 KH |
85 | which contains the skeleton, has a documentation to that effect. |
86 | INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." | |
ac59aed8 | 87 | (if skeleton-debug |
f3611c70 | 88 | (set command skeleton)) |
ac59aed8 RS |
89 | (require 'backquote) |
90 | (`(progn | |
f3611c70 KH |
91 | (defvar (, command) '(, skeleton) |
92 | (, documentation)) | |
93 | (defalias '(, command) 'skeleton-proxy)))) | |
94 | ||
95 | ||
ac59aed8 | 96 | |
f3611c70 KH |
97 | ;; This command isn't meant to be called, only it's aliases with meaningful |
98 | ;; names are. | |
99 | ;;;###autoload | |
100 | (defun skeleton-proxy (&optional arg) | |
101 | "Insert a skeleton defined by variable of same name (see `skeleton-insert'). | |
102 | Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). | |
103 | This command can also be an abbrev expansion (3rd and 4th columns in | |
104 | \\[edit-abbrevs] buffer: \"\" command-name)." | |
105 | (interactive "*P") | |
106 | (let ((function (nth 1 (backtrace-frame 1)))) | |
107 | (if (eq function 'nth) ; uncompiled lisp function | |
108 | (setq function (nth 1 (backtrace-frame 5))) | |
109 | (if (eq function 'byte-code) ; tracing byte-compiled function | |
110 | (setq function (nth 1 (backtrace-frame 2))))) | |
111 | (if (not (setq function (funcall skeleton-filter (symbol-value function)))) | |
112 | (if (or (eq this-command 'self-insert-command) | |
113 | (eq this-command 'pair-insert-maybe) | |
114 | (eq this-command 'expand-abbrev)) | |
115 | (setq buffer-undo-list | |
116 | (primitive-undo 1 buffer-undo-list))) | |
117 | (skeleton-insert function | |
118 | nil | |
119 | (if (setq skeleton-abbrev-cleanup | |
120 | (or (eq this-command 'self-insert-command) | |
121 | (eq this-command 'pair-insert-maybe))) | |
122 | () | |
123 | ;; Pretend C-x a e passed the prefix arg to us | |
124 | (if (or arg current-prefix-arg) | |
125 | (prefix-numeric-value (or arg | |
126 | current-prefix-arg))))) | |
127 | (if skeleton-abbrev-cleanup | |
128 | (setq deferred-action-list t | |
129 | deferred-action-function 'skeleton-abbrev-cleanup | |
130 | skeleton-abbrev-cleanup (point)))))) | |
131 | ||
132 | ||
133 | (defun skeleton-abbrev-cleanup (&rest list) | |
134 | "Value for `post-command-hook' to remove char that expanded abbrev." | |
135 | (if (integerp skeleton-abbrev-cleanup) | |
136 | (progn | |
137 | (delete-region skeleton-abbrev-cleanup (point)) | |
138 | (setq deferred-action-list () | |
139 | deferred-action-function nil | |
140 | skeleton-abbrev-cleanup nil)))) | |
ac59aed8 RS |
141 | |
142 | ||
143 | ;;;###autoload | |
f3611c70 KH |
144 | (defun skeleton-insert (skeleton &optional no-newline regions) |
145 | "Insert the complex statement skeleton SKELETON describes very concisely. | |
ac59aed8 RS |
146 | If optional NO-NEWLINE is nil the skeleton will end on a line of its own. |
147 | ||
f3611c70 KH |
148 | With optional third REGIONS wrap first interesting point (`_') in skeleton |
149 | around next REGIONS words, if REGIONS is positive. If REGIONS is negative, | |
150 | wrap REGIONS preceding interregions into first REGIONS interesting positions | |
151 | \(successive `_'s) in skeleton. An interregion is the stretch of text between | |
152 | two contiguous marked points. If you marked A B C [] (where [] is the cursor) | |
153 | in alphabetical order, the 3 interregions are simply the last 3 regions. But | |
154 | if you marked B A [] C, the interregions are B-A, A-[], []-C. | |
155 | ||
156 | SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if | |
157 | not needed, a prompt-string or an expression for complex read functions. | |
ac59aed8 RS |
158 | |
159 | If ELEMENT is a string or a character it gets inserted (see also | |
160 | `skeleton-transformation'). Other possibilities are: | |
161 | ||
162 | \\n go to next line and align cursor | |
f3611c70 KH |
163 | _ interesting point, interregion here, point after termination |
164 | > indent line (or interregion if > _) according to major mode | |
165 | & do next ELEMENT if previous moved point | |
166 | | do next ELEMENT if previous didn't move point | |
167 | -num delete num preceding characters (see `skeleton-untabify') | |
ac59aed8 RS |
168 | resume: skipped, continue here if quit is signaled |
169 | nil skipped | |
170 | ||
f3611c70 KH |
171 | Further elements can be defined via `skeleton-further-elements'. ELEMENT may |
172 | itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for | |
173 | different inputs. The SKELETON is processed as often as the user enters a | |
174 | non-empty string. \\[keyboard-quit] terminates skeleton insertion, but | |
175 | continues after `resume:' and positions at `_' if any. If INTERACTOR in such | |
176 | a subskeleton is a prompt-string which contains a \".. %s ..\" it is | |
177 | formatted with `skeleton-subprompt'. | |
ac59aed8 | 178 | |
f3611c70 | 179 | Quoted lisp-expressions are evaluated evaluated for their side-effect. |
ac59aed8 | 180 | Other lisp-expressions are evaluated and the value treated as above. |
f3611c70 KH |
181 | Note that expressions may not return `t' since this impplies an |
182 | endless loop. Modes can define other symbols by locally setting them | |
183 | to any valid skeleton element. The following local variables are | |
184 | available: | |
ac59aed8 | 185 | |
f3611c70 | 186 | str first time: read a string according to INTERACTOR |
ac59aed8 | 187 | then: insert previously read string once more |
f3611c70 KH |
188 | help help-form during interaction with the user or `nil' |
189 | quit non-nil after resume: section is entered by keyboard quit | |
ac59aed8 | 190 | v1, v2 local variables for memorising anything you want" |
f3611c70 KH |
191 | (and regions |
192 | (setq regions | |
193 | (if (> regions 0) | |
194 | (list (point-marker) | |
195 | (save-excursion (forward-word regions) (point-marker))) | |
196 | (setq regions (- regions)) | |
197 | ;; copy regions - 1 elements from `mark-ring' | |
198 | (let ((l1 (cons (mark-marker) mark-ring)) | |
199 | (l2 (list (point-marker)))) | |
200 | (while (and l1 (> regions 0)) | |
201 | (setq l2 (cons (car l1) l2) | |
202 | regions (1- regions) | |
203 | l1 (cdr l1))) | |
204 | (sort l2 '<)))) | |
205 | (goto-char (car regions)) | |
206 | (setq regions (cdr regions))) | |
207 | (let (modified point resume: help quit v1 v2) | |
ac59aed8 RS |
208 | (or no-newline |
209 | (eolp) | |
f3611c70 KH |
210 | ;;(save-excursion |
211 | ;; (indent-to (prog1 | |
212 | ;; (current-indentation) | |
213 | ;; (newline)))) | |
214 | (goto-char (prog1 (point) | |
215 | (indent-to (prog1 | |
216 | (current-indentation) | |
217 | (newline)))))) | |
218 | (unwind-protect | |
219 | (eval (list 'let skeleton-further-elements | |
220 | '(skeleton-internal-list skeleton (car skeleton)))) | |
221 | (if point | |
222 | (goto-char point))))) | |
223 | ||
224 | ||
225 | ||
226 | (defun skeleton-read (str &optional initial-input recursive) | |
227 | "Function for reading a string from the minibuffer in skeletons. | |
228 | PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'. | |
229 | If non-`nil' second arg INITIAL-INPUT is a string to insert before reading. | |
230 | While reading, the value of `minibuffer-help-form' is variable `help' if that is | |
231 | non-`nil' or a default string if optional ITERATIVE is non-`nil'." | |
232 | ||
233 | (or no-newline | |
234 | (eolp) | |
235 | (goto-char (prog1 (point) | |
236 | (indent-to (prog1 | |
237 | (current-indentation) | |
238 | (newline)))))) | |
239 | (let ((minibuffer-help-form (or help (if recursive "\ | |
ac59aed8 RS |
240 | As long as you provide input you will insert another subskeleton. |
241 | ||
242 | If you enter the empty string, the loop inserting subskeletons is | |
243 | left, and the current one is removed as far as it has been entered. | |
244 | ||
245 | If you quit, the current subskeleton is removed as far as it has been | |
246 | entered. No more of the skeleton will be inserted, except maybe for a | |
f3611c70 KH |
247 | syntactically necessary termination." |
248 | " | |
249 | You are inserting a skeleton. Standard text gets inserted into the buffer | |
250 | automatically, and you are prompted to fill in the variable parts.")))) | |
ac59aed8 | 251 | (setq str (if (stringp str) |
f3611c70 | 252 | (read-string (format str skeleton-subprompt) initial-input) |
ac59aed8 | 253 | (eval str)))) |
f3611c70 | 254 | (if (or (null str) (string= str "")) |
ac59aed8 RS |
255 | (signal 'quit t) |
256 | str)) | |
257 | ||
258 | ||
f3611c70 KH |
259 | (defun skeleton-internal-list (skeleton &optional str recursive) |
260 | (let* ((start (save-excursion (beginning-of-line) (point))) | |
261 | (column (current-column)) | |
262 | (line (buffer-substring start | |
263 | (save-excursion (end-of-line) (point)))) | |
264 | opoint) | |
265 | (condition-case quit | |
266 | (progn | |
267 | '(setq str (list 'setq 'str | |
268 | (if recursive | |
269 | (list 'skeleton-read (list 'quote str)) | |
270 | (list (if (stringp str) | |
271 | 'read-string | |
272 | 'eval) | |
273 | str)))) | |
274 | (setq str (list 'setq 'str | |
275 | (list 'skeleton-read | |
276 | (list 'quote str nil recursive)))) | |
277 | (while (setq modified (eq opoint (point)) | |
278 | opoint (point) | |
279 | skeleton (cdr skeleton)) | |
280 | (skeleton-internal-1 (car skeleton))) | |
281 | ;; maybe continue loop | |
282 | recursive) | |
283 | (quit ;; remove the subskeleton as far as it has been shown | |
284 | (if (eq (cdr quit) 'recursive) | |
285 | () | |
286 | ;; the subskeleton shouldn't have deleted outside current line | |
287 | (end-of-line) | |
288 | (delete-region start (point)) | |
289 | (insert line) | |
290 | (move-to-column column)) | |
291 | (if (eq (cdr quit) t) | |
292 | ;; empty string entered | |
293 | nil | |
294 | (while (if skeleton | |
295 | (not (eq (car (setq skeleton (cdr skeleton))) | |
296 | 'resume:)))) | |
297 | (if skeleton | |
298 | (skeleton-internal-list skeleton) | |
299 | ;; propagate signal we can't handle | |
300 | (if recursive (signal 'quit 'recursive))) | |
301 | (signal 'quit nil)))))) | |
302 | ||
303 | ||
304 | (defun skeleton-internal-1 (element &optional literal) | |
305 | (cond ((and (integerp element) ; -num | |
c93d212a | 306 | (< element 0)) |
f3611c70 KH |
307 | (if skeleton-untabify |
308 | (backward-delete-char-untabify (- element)) | |
309 | (delete-backward-char (- element)))) | |
c93d212a | 310 | ((char-or-string-p element) |
f3611c70 KH |
311 | (insert-before-markers (if (and skeleton-transformation |
312 | (not literal)) | |
313 | (funcall skeleton-transformation element) | |
314 | element))) | |
c93d212a RS |
315 | ((eq element '\n) ; actually (eq '\n 'n) |
316 | (newline) | |
f3611c70 | 317 | (indent-relative t)) |
c93d212a | 318 | ((eq element '>) |
f3611c70 KH |
319 | (if (and regions |
320 | (eq (nth 1 skeleton) '_)) | |
321 | (indent-region (point) (car regions) nil) | |
322 | (indent-for-tab-command))) | |
c93d212a | 323 | ((eq element '_) |
f3611c70 KH |
324 | (if regions |
325 | (progn | |
326 | (goto-char (car regions)) | |
327 | (setq regions (cdr regions))) | |
328 | (or point | |
329 | (setq point (point))))) | |
c93d212a RS |
330 | ((eq element '&) |
331 | (if modified | |
f3611c70 | 332 | (setq skeleton (cdr skeleton)))) |
c93d212a RS |
333 | ((eq element '|) |
334 | (or modified | |
f3611c70 | 335 | (setq skeleton (cdr skeleton)))) |
c93d212a RS |
336 | ((if (consp element) |
337 | (or (stringp (car element)) | |
338 | (consp (car element)))) | |
f3611c70 KH |
339 | (while (skeleton-internal-list element (car element) t))) |
340 | ((if (consp element) | |
341 | (eq 'quote (car element))) | |
342 | (eval (nth 1 element))) | |
343 | ((null element)) | |
344 | ((skeleton-internal-1 (eval element) t)))) | |
ac59aed8 | 345 | |
f3611c70 KH |
346 | ;; Maybe belongs into simple.el or elsewhere |
347 | ||
348 | ;;;###autoload | |
349 | (define-skeleton local-variables-section | |
350 | "Insert a local variables section. Use current comment syntax if any." | |
351 | () | |
352 | '(save-excursion | |
353 | (if (re-search-forward page-delimiter nil t) | |
354 | (error "Not on last page."))) | |
355 | comment-start "Local Variables:" comment-end \n | |
356 | comment-start "mode: " | |
357 | (completing-read "Mode: " obarray | |
358 | (lambda (symbol) | |
359 | (if (commandp symbol) | |
360 | (string-match "-mode$" (symbol-name symbol)))) | |
361 | t) | |
362 | & -5 | '(kill-line 0) & -1 | comment-end \n | |
363 | ( (completing-read (format "Variable, %s: " skeleton-subprompt) | |
364 | obarray | |
365 | (lambda (symbol) | |
366 | (or (eq symbol 'eval) | |
367 | (user-variable-p symbol))) | |
368 | t) | |
369 | comment-start str ": " | |
370 | (read-from-minibuffer "Expression: " nil read-expression-map nil | |
371 | 'read-expression-history) | _ | |
372 | comment-end \n) | |
373 | resume: | |
374 | comment-start "End:" comment-end) | |
ac59aed8 RS |
375 | \f |
376 | ;; variables and command for automatically inserting pairs like () or "" | |
377 | ||
378 | (defvar pair nil | |
379 | "*If this is nil pairing is turned off, no matter what else is set. | |
380 | Otherwise modes with `pair-insert-maybe' on some keys will attempt this.") | |
381 | ||
382 | ||
383 | (defvar pair-on-word nil | |
384 | "*If this is nil pairing is not attempted before or inside a word.") | |
385 | ||
386 | ||
387 | (defvar pair-filter (lambda ()) | |
388 | "Attempt pairing if this function returns nil, before inserting. | |
389 | This allows for context-sensitive checking whether pairing is appropriate.") | |
390 | ||
391 | ||
392 | (defvar pair-alist () | |
393 | "An override alist of pairing partners matched against | |
394 | `last-command-char'. Each alist element, which looks like (ELEMENT | |
f3611c70 | 395 | ...), is passed to `skeleton-insert' with no interactor. Variable `str' |
ac59aed8 RS |
396 | does nothing. |
397 | ||
f3611c70 | 398 | Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") |
ac59aed8 RS |
399 | |
400 | ||
401 | ||
402 | ;;;###autoload | |
403 | (defun pair-insert-maybe (arg) | |
404 | "Insert the character you type ARG times. | |
405 | ||
406 | With no ARG, if `pair' is non-nil, and if | |
407 | `pair-on-word' is non-nil or we are not before or inside a | |
408 | word, and if `pair-filter' returns nil, pairing is performed. | |
409 | ||
410 | If a match is found in `pair-alist', that is inserted, else | |
411 | the defaults are used. These are (), [], {}, <> and `' for the | |
412 | symmetrical ones, and the same character twice for the others." | |
413 | (interactive "*P") | |
414 | (if (or arg | |
415 | (not pair) | |
416 | (if (not pair-on-word) (looking-at "\\w")) | |
417 | (funcall pair-filter)) | |
418 | (self-insert-command (prefix-numeric-value arg)) | |
f3611c70 KH |
419 | (self-insert-command 1) |
420 | (if skeleton-abbrev-cleanup | |
421 | () | |
422 | ;; (preceding-char) is stripped of any Meta-stuff in last-command-char | |
423 | (if (setq arg (assq (preceding-char) pair-alist)) | |
424 | ;; typed char is inserted, and car means no interactor | |
425 | (skeleton-insert arg t) | |
426 | (save-excursion | |
427 | (insert (or (cdr (assq (preceding-char) | |
428 | '((?( . ?)) | |
429 | (?[ . ?]) | |
430 | (?{ . ?}) | |
431 | (?< . ?>) | |
432 | (?` . ?')))) | |
433 | last-command-char))))))) | |
ac59aed8 RS |
434 | |
435 | \f | |
f3611c70 KH |
436 | ;; A more serious example can be found in sh-script.el |
437 | ;; The quote before (defun prevents this from being byte-compiled. | |
438 | '(defun mirror-mode () | |
439 | "This major mode is an amusing little example of paired insertion. | |
440 | All printable characters do a paired self insert, while the other commands | |
441 | work normally." | |
442 | (interactive) | |
443 | (kill-all-local-variables) | |
444 | (make-local-variable 'pair) | |
445 | (make-local-variable 'pair-on-word) | |
446 | (make-local-variable 'pair-filter) | |
447 | (make-local-variable 'pair-alist) | |
448 | (setq major-mode 'mirror-mode | |
449 | mode-name "Mirror" | |
450 | pair-on-word t | |
451 | ;; in the middle column insert one or none if odd window-width | |
452 | pair-filter (lambda () | |
453 | (if (>= (current-column) | |
454 | (/ (window-width) 2)) | |
455 | ;; insert both on next line | |
456 | (next-line 1) | |
457 | ;; insert one or both? | |
458 | (= (* 2 (1+ (current-column))) | |
459 | (window-width)))) | |
460 | ;; mirror these the other way round as well | |
461 | pair-alist '((?) _ ?() | |
462 | (?] _ ?[) | |
463 | (?} _ ?{) | |
464 | (?> _ ?<) | |
465 | (?/ _ ?\\) | |
466 | (?\\ _ ?/) | |
467 | (?` ?` _ "''") | |
468 | (?' ?' _ "``")) | |
469 | ;; in this mode we exceptionally ignore the user, else it's no fun | |
470 | pair t) | |
471 | (let ((map (make-keymap)) | |
472 | (i ? )) | |
473 | (use-local-map map) | |
474 | (setq map (car (cdr map))) | |
475 | (while (< i ?\^?) | |
476 | (aset map i 'pair-insert-maybe) | |
477 | (setq i (1+ i)))) | |
478 | (run-hooks 'mirror-mode-hook)) | |
ac59aed8 RS |
479 | |
480 | ;; skeleton.el ends here |