Mercurial > emacs
annotate lisp/skeleton.el @ 8767:441af4b664ac
(yank-menu): New variable; kill-ring in menu format.
(menu-bar-update-yank-menu, menu-bar-select-yank): New function.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Thu, 15 Sep 1994 22:16:49 +0000 |
parents | 6106d22ab2ca |
children | 6c57be2d372f |
rev | line source |
---|---|
6463 | 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) | |
7393
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
195 (cond ((and (integerp element) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
196 (< element 0)) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
197 (delete-char element)) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
198 ((char-or-string-p element) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
199 (insert (if skeleton-transformation |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
200 (funcall skeleton-transformation element) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
201 element)) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
202 ((eq element '\n) ; actually (eq '\n 'n) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
203 (newline) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
204 (indent-relative t) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
205 ((eq element '>) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
206 (indent-for-tab-command) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
207 ((eq element '<) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
208 (backward-delete-char-untabify (min tab-width (current-column))) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
209 ((eq element '_) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
210 (or point |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
211 (setq point (point))) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
212 ((eq element '&) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
213 (if modified |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
214 (setq definition (cdr definition))) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
215 ((eq element '|) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
216 (or modified |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
217 (setq definition (cdr definition))) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
218 ((if (consp element) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
219 (or (stringp (car element)) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
220 (consp (car element)))) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
221 (while (skeleton-internal-list element (car element) t)) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
222 ((null element) ) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
223 ((skeleton-internal-1 (eval element)) ))) |
6463 | 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. | |
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 | |
7394 | 283 ;; a more serious example can be found in sh-script.el |
7393
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
284 ;;;(defun mirror-mode () |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
285 ;;; "This major mode is an amusing little example of paired insertion. |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
286 ;;;All printable characters do a paired self insert, while the other commands |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
287 ;;;work normally." |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
288 ;;; (interactive) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
289 ;;; (kill-all-local-variables) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
290 ;;; (make-local-variable 'pair) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
291 ;;; (make-local-variable 'pair-on-word) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
292 ;;; (make-local-variable 'pair-filter) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
293 ;;; (make-local-variable 'pair-alist) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
294 ;;; (setq major-mode 'mirror-mode |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
295 ;;; mode-name "Mirror" |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
296 ;;; pair-on-word t |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
297 ;;; ;; in the middle column insert one or none if odd window-width |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
298 ;;; pair-filter (lambda () |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
299 ;;; (if (>= (current-column) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
300 ;;; (/ (window-width) 2)) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
301 ;;; ;; insert both on next line |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
302 ;;; (next-line 1) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
303 ;;; ;; insert one or both? |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
304 ;;; (= (* 2 (1+ (current-column))) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
305 ;;; (window-width)))) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
306 ;;; ;; mirror these the other way round as well |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
307 ;;; pair-alist '((?) _ ?() |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
308 ;;; (?] _ ?[) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
309 ;;; (?} _ ?{) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
310 ;;; (?> _ ?<) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
311 ;;; (?/ _ ?\\) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
312 ;;; (?\\ _ ?/) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
313 ;;; (?` ?` _ "''") |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
314 ;;; (?' ?' _ "``")) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
315 ;;; ;; in this mode we exceptionally ignore the user, else it's no fun |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
316 ;;; pair t) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
317 ;;; (let ((map (make-keymap)) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
318 ;;; (i ? )) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
319 ;;; (use-local-map map) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
320 ;;; (setq map (car (cdr map))) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
321 ;;; (while (< i ?\^?) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
322 ;;; (aset map i 'pair-insert-maybe) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
323 ;;; (setq i (1+ i)))) |
e4a565cee722
(mirror-mode): Commented out.
Richard M. Stallman <rms@gnu.org>
parents:
6463
diff
changeset
|
324 ;;; (run-hooks 'mirror-mode-hook)) |
6463 | 325 |
326 ;; skeleton.el ends here |