Commit | Line | Data |
---|---|---|
ac59aed8 RS |
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 |