Mercurial > emacs
comparison lisp/skeleton.el @ 12501:6c57be2d372f
partly rewritten and extended.
(skeleton-filter, skeleton-untabify, skeleton-further-elements)
(skeleton-abbrev-cleanup): New variables
(skeleton-proxy, skeleton-abbrev-cleanup): New functions
(skeleton-insert): Sublanguage element < must now be handled via
`skeleton-further-elements' (used only in sh-script and ada). Lisp
expressions can be quoted to ignore the return value.
(skeleton-read): New name for `skeleton-internal-read' because this may
be useful in skeletons.
(local-variables-section): New skeleton command, might go to simple.el.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Fri, 07 Jul 1995 19:21:17 +0000 |
parents | 6106d22ab2ca |
children | 9d4a4e914215 |
comparison
equal
deleted
inserted
replaced
12500:6aba36eda051 | 12501:6c57be2d372f |
---|---|
1 ;;; skeleton.el --- Metalanguage for writing statement skeletons | 1 ;;; skeleton.el --- Lisp language extension for writing statement skeletons |
2 ;; Copyright (C) 1993 by Free Software Foundation, Inc. | 2 ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc. |
3 | 3 |
4 ;; Author: Daniel Pfeiffer, fax (+49 69) 75 88 529, c/o <bonhoure@cict.fr> | 4 ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 |
5 ;; Maintainer: FSF | 5 ;; Maintainer: FSF |
6 ;; Keywords: shell programming | 6 ;; Keywords: extensions, abbrev, languages, tools |
7 | 7 |
8 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
9 | 9 |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | 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 | 11 ;; it under the terms of the GNU General Public License as published by |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | 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. | 22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
23 | 23 |
24 ;;; Commentary: | 24 ;;; Commentary: |
25 | 25 |
26 ;; A very concise metalanguage for writing structured statement | 26 ;; A very concise language extension for writing structured statement |
27 ;; skeleton insertion commands for programming language modes. This | 27 ;; skeleton insertion commands for programming language modes. This |
28 ;; originated in shell-script mode and was applied to ada-mode's | 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 | 29 ;; commands which shrunk to one third. And these commands are now |
30 ;; user configurable. | 30 ;; user configurable. |
31 | 31 |
32 ;;; Code: | 32 ;;; Code: |
33 | 33 |
34 ;; page 1: statement skeleton metalanguage definition & interpreter | 34 ;; page 1: statement skeleton language definition & interpreter |
35 ;; page 2: paired insertion | 35 ;; page 2: paired insertion |
36 ;; page 3: mirror-mode, an example for setting up paired insertion | 36 ;; page 3: mirror-mode, an example for setting up paired insertion |
37 | 37 |
38 | 38 |
39 (defvar skeleton-transformation nil | 39 (defvar skeleton-transformation nil |
40 "*If non-nil, function applied to strings before they are inserted. | 40 "*If non-nil, function applied to literal strings before they are inserted. |
41 It should take strings and characters and return them transformed, or nil | 41 It should take strings and characters and return them transformed, or nil |
42 which means no transformation. | 42 which means no transformation. |
43 Typical examples might be `upcase' or `capitalize'.") | 43 Typical examples might be `upcase' or `capitalize'.") |
44 | 44 |
45 ; this should be a fourth argument to defvar | 45 ; this should be a fourth argument to defvar |
46 (put 'skeleton-transformation 'variable-interactive | 46 (put 'skeleton-transformation 'variable-interactive |
47 "aTransformation function: ") | 47 "aTransformation function: ") |
48 | 48 |
49 | 49 |
50 | 50 |
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 | |
51 (defvar skeleton-subprompt | 68 (defvar skeleton-subprompt |
52 (substitute-command-keys | 69 (substitute-command-keys |
53 "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") | 70 "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") |
54 "*Replacement for %s in prompts of recursive skeleton definitions.") | 71 "*Replacement for %s in prompts of recursive subskeletons.") |
55 | 72 |
73 | |
74 (defvar skeleton-abbrev-cleanup nil) | |
56 | 75 |
57 | 76 |
58 (defvar skeleton-debug nil | 77 (defvar skeleton-debug nil |
59 "*If non-nil `define-skeleton' will override previous definition.") | 78 "*If non-nil `define-skeleton' will override previous definition.") |
60 | 79 |
61 | 80 |
62 | 81 ;;;###autoload |
63 ;;;###autoload | 82 (defmacro define-skeleton (command documentation &rest skeleton) |
64 (defmacro define-skeleton (command documentation &rest definition) | |
65 "Define a user-configurable COMMAND that enters a statement skeleton. | 83 "Define a user-configurable COMMAND that enters a statement skeleton. |
66 DOCUMENTATION is that of the command, while the variable of the same name, | 84 DOCUMENTATION is that of the command, while the variable of the same name, |
67 which contains the definition, has a documentation to that effect. | 85 which contains the skeleton, has a documentation to that effect. |
68 PROMPT and ELEMENT ... are as defined under `skeleton-insert'." | 86 INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." |
69 (if skeleton-debug | 87 (if skeleton-debug |
70 (set command definition)) | 88 (set command skeleton)) |
71 (require 'backquote) | 89 (require 'backquote) |
72 (`(progn | 90 (`(progn |
73 (defvar (, command) '(, definition) | 91 (defvar (, command) '(, skeleton) |
74 (, (concat "*Definition for the " | 92 (, documentation)) |
75 (symbol-name command) | 93 (defalias '(, command) 'skeleton-proxy)))) |
76 " skeleton command. | 94 |
77 See function `skeleton-insert' for meaning.")) ) | 95 |
78 (defun (, command) () | 96 |
79 (, documentation) | 97 ;; This command isn't meant to be called, only it's aliases with meaningful |
80 (interactive) | 98 ;; names are. |
81 ;; Don't use last-command to guarantee command does the same thing, | 99 ;;;###autoload |
82 ;; whatever other name it is given. | 100 (defun skeleton-proxy (&optional arg) |
83 (skeleton-insert (, command)))))) | 101 "Insert a skeleton defined by variable of same name (see `skeleton-insert'). |
84 | 102 Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). |
85 | 103 This command can also be an abbrev expansion (3rd and 4th columns in |
86 | 104 \\[edit-abbrevs] buffer: \"\" command-name)." |
87 ;;;###autoload | 105 (interactive "*P") |
88 (defun skeleton-insert (definition &optional no-newline) | 106 (let ((function (nth 1 (backtrace-frame 1)))) |
89 "Insert the complex statement skeleton DEFINITION describes very concisely. | 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)))) | |
141 | |
142 | |
143 ;;;###autoload | |
144 (defun skeleton-insert (skeleton &optional no-newline regions) | |
145 "Insert the complex statement skeleton SKELETON describes very concisely. | |
90 If optional NO-NEWLINE is nil the skeleton will end on a line of its own. | 146 If optional NO-NEWLINE is nil the skeleton will end on a line of its own. |
91 | 147 |
92 DEFINITION is made up as (PROMPT ELEMENT ...). PROMPT may be nil if not | 148 With optional third REGIONS wrap first interesting point (`_') in skeleton |
93 needed, a prompt-string or an expression for complex read functions. | 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. | |
94 | 158 |
95 If ELEMENT is a string or a character it gets inserted (see also | 159 If ELEMENT is a string or a character it gets inserted (see also |
96 `skeleton-transformation'). Other possibilities are: | 160 `skeleton-transformation'). Other possibilities are: |
97 | 161 |
98 \\n go to next line and align cursor | 162 \\n go to next line and align cursor |
99 > indent according to major mode | 163 _ interesting point, interregion here, point after termination |
100 < undent tab-width spaces but not beyond beginning of line | 164 > indent line (or interregion if > _) according to major mode |
101 _ cursor after termination | 165 & do next ELEMENT if previous moved point |
102 & skip next ELEMENT if previous didn't move point | 166 | do next ELEMENT if previous didn't move point |
103 | skip next ELEMENT if previous moved point | 167 -num delete num preceding characters (see `skeleton-untabify') |
104 -num delete num preceding characters | |
105 resume: skipped, continue here if quit is signaled | 168 resume: skipped, continue here if quit is signaled |
106 nil skipped | 169 nil skipped |
107 | 170 |
108 ELEMENT may itself be DEFINITION with a PROMPT. The user is prompted | 171 Further elements can be defined via `skeleton-further-elements'. ELEMENT may |
109 repeatedly for different inputs. The DEFINITION is processed as often | 172 itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for |
110 as the user enters a non-empty string. \\[keyboard-quit] terminates | 173 different inputs. The SKELETON is processed as often as the user enters a |
111 skeleton insertion, but continues after `resume:' and positions at `_' | 174 non-empty string. \\[keyboard-quit] terminates skeleton insertion, but |
112 if any. If PROMPT in such a sub-definition contains a \".. %s ..\" it | 175 continues after `resume:' and positions at `_' if any. If INTERACTOR in such |
113 is replaced by `skeleton-subprompt'. | 176 a subskeleton is a prompt-string which contains a \".. %s ..\" it is |
114 | 177 formatted with `skeleton-subprompt'. |
178 | |
179 Quoted lisp-expressions are evaluated evaluated for their side-effect. | |
115 Other lisp-expressions are evaluated and the value treated as above. | 180 Other lisp-expressions are evaluated and the value treated as above. |
116 The following local variables are available: | 181 Note that expressions may not return `t' since this impplies an |
117 | 182 endless loop. Modes can define other symbols by locally setting them |
118 str first time: read a string prompting with PROMPT and insert it | 183 to any valid skeleton element. The following local variables are |
119 if PROMPT is not a string it is evaluated instead | 184 available: |
185 | |
186 str first time: read a string according to INTERACTOR | |
120 then: insert previously read string once more | 187 then: insert previously read string once more |
121 quit non-nil when resume: section is entered by keyboard quit | 188 help help-form during interaction with the user or `nil' |
189 quit non-nil after resume: section is entered by keyboard quit | |
122 v1, v2 local variables for memorising anything you want" | 190 v1, v2 local variables for memorising anything you want" |
123 (let (modified opoint point resume: quit v1 v2) | 191 (and regions |
124 (skeleton-internal-list definition (car definition)) | 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) | |
125 (or no-newline | 208 (or no-newline |
126 (eolp) | 209 (eolp) |
127 (newline) | 210 ;;(save-excursion |
128 (indent-relative t)) | 211 ;; (indent-to (prog1 |
129 (if point | 212 ;; (current-indentation) |
130 (goto-char point)))) | 213 ;; (newline)))) |
131 | 214 (goto-char (prog1 (point) |
132 | 215 (indent-to (prog1 |
133 | 216 (current-indentation) |
134 (defun skeleton-internal-read (str) | 217 (newline)))))) |
135 (let ((minibuffer-help-form "\ | 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 "\ | |
136 As long as you provide input you will insert another subskeleton. | 240 As long as you provide input you will insert another subskeleton. |
137 | 241 |
138 If you enter the empty string, the loop inserting subskeletons is | 242 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. | 243 left, and the current one is removed as far as it has been entered. |
140 | 244 |
141 If you quit, the current subskeleton is removed as far as it has been | 245 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 | 246 entered. No more of the skeleton will be inserted, except maybe for a |
143 syntactically necessary termination.")) | 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.")))) | |
144 (setq str (if (stringp str) | 251 (setq str (if (stringp str) |
145 (read-string | 252 (read-string (format str skeleton-subprompt) initial-input) |
146 (format str skeleton-subprompt)) | |
147 (eval str)))) | 253 (eval str)))) |
148 (if (string= str "") | 254 (if (or (null str) (string= str "")) |
149 (signal 'quit t) | 255 (signal 'quit t) |
150 str)) | 256 str)) |
151 | 257 |
152 | 258 |
153 (defun skeleton-internal-list (definition &optional str recursive start line) | 259 (defun skeleton-internal-list (skeleton &optional str recursive) |
154 (condition-case quit | 260 (let* ((start (save-excursion (beginning-of-line) (point))) |
155 (progn | 261 (column (current-column)) |
156 (setq start (save-excursion (beginning-of-line) (point)) | 262 (line (buffer-substring start |
157 column (current-column) | 263 (save-excursion (end-of-line) (point)))) |
158 line (buffer-substring start | 264 opoint) |
159 (save-excursion (end-of-line) (point))) | 265 (condition-case quit |
160 str (list 'setq 'str | 266 (progn |
161 (if recursive | 267 '(setq str (list 'setq 'str |
162 (list 'skeleton-internal-read (list 'quote str)) | 268 (if recursive |
163 (list (if (stringp str) | 269 (list 'skeleton-read (list 'quote str)) |
164 'read-string | 270 (list (if (stringp str) |
165 'eval) | 271 'read-string |
166 str)))) | 272 'eval) |
167 (while (setq modified (eq opoint (point)) | 273 str)))) |
168 opoint (point) | 274 (setq str (list 'setq 'str |
169 definition (cdr definition)) | 275 (list 'skeleton-read |
170 (skeleton-internal-1 (car definition))) | 276 (list 'quote str nil recursive)))) |
171 ;; maybe continue loop | 277 (while (setq modified (eq opoint (point)) |
172 recursive) | 278 opoint (point) |
173 (quit ;; remove the subskeleton as far as it has been shown | 279 skeleton (cdr skeleton)) |
174 (if (eq (cdr quit) 'recursive) | 280 (skeleton-internal-1 (car skeleton))) |
175 () | 281 ;; maybe continue loop |
176 ;; the subskeleton shouldn't have deleted outside current line | 282 recursive) |
177 (end-of-line) | 283 (quit ;; remove the subskeleton as far as it has been shown |
178 (delete-region start (point)) | 284 (if (eq (cdr quit) 'recursive) |
179 (insert line) | 285 () |
180 (move-to-column column)) | 286 ;; the subskeleton shouldn't have deleted outside current line |
181 (if (eq (cdr quit) t) | 287 (end-of-line) |
182 ;; empty string entered | 288 (delete-region start (point)) |
183 nil | 289 (insert line) |
184 (while (if definition | 290 (move-to-column column)) |
185 (not (eq (car (setq definition (cdr definition))) | 291 (if (eq (cdr quit) t) |
186 'resume:)))) | 292 ;; empty string entered |
187 (if definition | 293 nil |
188 (skeleton-internal-list definition) | 294 (while (if skeleton |
189 ;; propagate signal we can't handle | 295 (not (eq (car (setq skeleton (cdr skeleton))) |
190 (if recursive (signal 'quit 'recursive))))))) | 296 'resume:)))) |
191 | 297 (if skeleton |
192 | 298 (skeleton-internal-list skeleton) |
193 | 299 ;; propagate signal we can't handle |
194 (defun skeleton-internal-1 (element) | 300 (if recursive (signal 'quit 'recursive))) |
195 (cond ((and (integerp element) | 301 (signal 'quit nil)))))) |
302 | |
303 | |
304 (defun skeleton-internal-1 (element &optional literal) | |
305 (cond ((and (integerp element) ; -num | |
196 (< element 0)) | 306 (< element 0)) |
197 (delete-char element)) | 307 (if skeleton-untabify |
308 (backward-delete-char-untabify (- element)) | |
309 (delete-backward-char (- element)))) | |
198 ((char-or-string-p element) | 310 ((char-or-string-p element) |
199 (insert (if skeleton-transformation | 311 (insert-before-markers (if (and skeleton-transformation |
200 (funcall skeleton-transformation element) | 312 (not literal)) |
201 element)) ) | 313 (funcall skeleton-transformation element) |
314 element))) | |
202 ((eq element '\n) ; actually (eq '\n 'n) | 315 ((eq element '\n) ; actually (eq '\n 'n) |
203 (newline) | 316 (newline) |
204 (indent-relative t) ) | 317 (indent-relative t)) |
205 ((eq element '>) | 318 ((eq element '>) |
206 (indent-for-tab-command) ) | 319 (if (and regions |
207 ((eq element '<) | 320 (eq (nth 1 skeleton) '_)) |
208 (backward-delete-char-untabify (min tab-width (current-column))) ) | 321 (indent-region (point) (car regions) nil) |
322 (indent-for-tab-command))) | |
209 ((eq element '_) | 323 ((eq element '_) |
210 (or point | 324 (if regions |
211 (setq point (point))) ) | 325 (progn |
326 (goto-char (car regions)) | |
327 (setq regions (cdr regions))) | |
328 (or point | |
329 (setq point (point))))) | |
212 ((eq element '&) | 330 ((eq element '&) |
213 (if modified | 331 (if modified |
214 (setq definition (cdr definition))) ) | 332 (setq skeleton (cdr skeleton)))) |
215 ((eq element '|) | 333 ((eq element '|) |
216 (or modified | 334 (or modified |
217 (setq definition (cdr definition))) ) | 335 (setq skeleton (cdr skeleton)))) |
218 ((if (consp element) | 336 ((if (consp element) |
219 (or (stringp (car element)) | 337 (or (stringp (car element)) |
220 (consp (car element)))) | 338 (consp (car element)))) |
221 (while (skeleton-internal-list element (car element) t)) ) | 339 (while (skeleton-internal-list element (car element) t))) |
222 ((null element) ) | 340 ((if (consp element) |
223 ((skeleton-internal-1 (eval element)) ))) | 341 (eq 'quote (car element))) |
224 | 342 (eval (nth 1 element))) |
343 ((null element)) | |
344 ((skeleton-internal-1 (eval element) t)))) | |
345 | |
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) | |
225 | 375 |
226 ;; variables and command for automatically inserting pairs like () or "" | 376 ;; variables and command for automatically inserting pairs like () or "" |
227 | 377 |
228 (defvar pair nil | 378 (defvar pair nil |
229 "*If this is nil pairing is turned off, no matter what else is set. | 379 "*If this is nil pairing is turned off, no matter what else is set. |
240 | 390 |
241 | 391 |
242 (defvar pair-alist () | 392 (defvar pair-alist () |
243 "An override alist of pairing partners matched against | 393 "An override alist of pairing partners matched against |
244 `last-command-char'. Each alist element, which looks like (ELEMENT | 394 `last-command-char'. Each alist element, which looks like (ELEMENT |
245 ...), is passed to `skeleton-insert' with no prompt. Variable `str' | 395 ...), is passed to `skeleton-insert' with no interactor. Variable `str' |
246 does nothing. | 396 does nothing. |
247 | 397 |
248 Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n < ?}).") | 398 Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") |
249 | 399 |
250 | 400 |
251 | 401 |
252 ;;;###autoload | 402 ;;;###autoload |
253 (defun pair-insert-maybe (arg) | 403 (defun pair-insert-maybe (arg) |
264 (if (or arg | 414 (if (or arg |
265 (not pair) | 415 (not pair) |
266 (if (not pair-on-word) (looking-at "\\w")) | 416 (if (not pair-on-word) (looking-at "\\w")) |
267 (funcall pair-filter)) | 417 (funcall pair-filter)) |
268 (self-insert-command (prefix-numeric-value arg)) | 418 (self-insert-command (prefix-numeric-value arg)) |
269 (insert last-command-char) | 419 (self-insert-command 1) |
270 (if (setq arg (assq last-command-char pair-alist)) | 420 (if skeleton-abbrev-cleanup |
271 ;; typed char is inserted, and car means no prompt | 421 () |
272 (skeleton-insert arg t) | 422 ;; (preceding-char) is stripped of any Meta-stuff in last-command-char |
273 (save-excursion | 423 (if (setq arg (assq (preceding-char) pair-alist)) |
274 (insert (or (cdr (assq last-command-char | 424 ;; typed char is inserted, and car means no interactor |
275 '((?( . ?)) | 425 (skeleton-insert arg t) |
276 (?[ . ?]) | 426 (save-excursion |
277 (?{ . ?}) | 427 (insert (or (cdr (assq (preceding-char) |
278 (?< . ?>) | 428 '((?( . ?)) |
279 (?` . ?')))) | 429 (?[ . ?]) |
280 last-command-char)))))) | 430 (?{ . ?}) |
431 (?< . ?>) | |
432 (?` . ?')))) | |
433 last-command-char))))))) | |
281 | 434 |
282 | 435 |
283 ;; a more serious example can be found in sh-script.el | 436 ;; A more serious example can be found in sh-script.el |
284 ;;;(defun mirror-mode () | 437 ;; The quote before (defun prevents this from being byte-compiled. |
285 ;;; "This major mode is an amusing little example of paired insertion. | 438 '(defun mirror-mode () |
286 ;;;All printable characters do a paired self insert, while the other commands | 439 "This major mode is an amusing little example of paired insertion. |
287 ;;;work normally." | 440 All printable characters do a paired self insert, while the other commands |
288 ;;; (interactive) | 441 work normally." |
289 ;;; (kill-all-local-variables) | 442 (interactive) |
290 ;;; (make-local-variable 'pair) | 443 (kill-all-local-variables) |
291 ;;; (make-local-variable 'pair-on-word) | 444 (make-local-variable 'pair) |
292 ;;; (make-local-variable 'pair-filter) | 445 (make-local-variable 'pair-on-word) |
293 ;;; (make-local-variable 'pair-alist) | 446 (make-local-variable 'pair-filter) |
294 ;;; (setq major-mode 'mirror-mode | 447 (make-local-variable 'pair-alist) |
295 ;;; mode-name "Mirror" | 448 (setq major-mode 'mirror-mode |
296 ;;; pair-on-word t | 449 mode-name "Mirror" |
297 ;;; ;; in the middle column insert one or none if odd window-width | 450 pair-on-word t |
298 ;;; pair-filter (lambda () | 451 ;; in the middle column insert one or none if odd window-width |
299 ;;; (if (>= (current-column) | 452 pair-filter (lambda () |
300 ;;; (/ (window-width) 2)) | 453 (if (>= (current-column) |
301 ;;; ;; insert both on next line | 454 (/ (window-width) 2)) |
302 ;;; (next-line 1) | 455 ;; insert both on next line |
303 ;;; ;; insert one or both? | 456 (next-line 1) |
304 ;;; (= (* 2 (1+ (current-column))) | 457 ;; insert one or both? |
305 ;;; (window-width)))) | 458 (= (* 2 (1+ (current-column))) |
306 ;;; ;; mirror these the other way round as well | 459 (window-width)))) |
307 ;;; pair-alist '((?) _ ?() | 460 ;; mirror these the other way round as well |
308 ;;; (?] _ ?[) | 461 pair-alist '((?) _ ?() |
309 ;;; (?} _ ?{) | 462 (?] _ ?[) |
310 ;;; (?> _ ?<) | 463 (?} _ ?{) |
311 ;;; (?/ _ ?\\) | 464 (?> _ ?<) |
312 ;;; (?\\ _ ?/) | 465 (?/ _ ?\\) |
313 ;;; (?` ?` _ "''") | 466 (?\\ _ ?/) |
314 ;;; (?' ?' _ "``")) | 467 (?` ?` _ "''") |
315 ;;; ;; in this mode we exceptionally ignore the user, else it's no fun | 468 (?' ?' _ "``")) |
316 ;;; pair t) | 469 ;; in this mode we exceptionally ignore the user, else it's no fun |
317 ;;; (let ((map (make-keymap)) | 470 pair t) |
318 ;;; (i ? )) | 471 (let ((map (make-keymap)) |
319 ;;; (use-local-map map) | 472 (i ? )) |
320 ;;; (setq map (car (cdr map))) | 473 (use-local-map map) |
321 ;;; (while (< i ?\^?) | 474 (setq map (car (cdr map))) |
322 ;;; (aset map i 'pair-insert-maybe) | 475 (while (< i ?\^?) |
323 ;;; (setq i (1+ i)))) | 476 (aset map i 'pair-insert-maybe) |
324 ;;; (run-hooks 'mirror-mode-hook)) | 477 (setq i (1+ i)))) |
478 (run-hooks 'mirror-mode-hook)) | |
325 | 479 |
326 ;; skeleton.el ends here | 480 ;; skeleton.el ends here |