1 |
;;; skeleton.el --- Lisp language extension for writing statement skeletons |
;;; skeleton.el --- Lisp language extension for writing statement skeletons |
2 |
|
|
3 |
;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1994, 1995, 1996, 2003 by Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Daniel Pfeiffer <occitan@esperanto.org> |
;; Author: Daniel Pfeiffer <occitan@esperanto.org> |
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
119 |
;;;###autoload |
;;;###autoload |
120 |
(defmacro define-skeleton (command documentation &rest skeleton) |
(defmacro define-skeleton (command documentation &rest skeleton) |
121 |
"Define a user-configurable COMMAND that enters a statement skeleton. |
"Define a user-configurable COMMAND that enters a statement skeleton. |
122 |
DOCUMENTATION is that of the command, while the variable of the same name, |
DOCUMENTATION is that of the command. |
123 |
which contains the skeleton, has a documentation to that effect. |
SKELETON is as defined under `skeleton-insert'." |
|
INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." |
|
124 |
(if skeleton-debug |
(if skeleton-debug |
125 |
(set command skeleton)) |
(set command skeleton)) |
126 |
`(progn |
`(progn |
127 |
|
;; Tell self-insert-command that this function, if called by an |
128 |
|
;; abbrev, should cause the self-insert to be skipped. |
129 |
|
(put ',command 'no-self-insert t) |
130 |
(defun ,command (&optional str arg) |
(defun ,command (&optional str arg) |
131 |
,(concat documentation |
,(concat documentation |
132 |
(if (string-match "\n\\>" documentation) |
(if (string-match "\n\\'" documentation) |
133 |
"" "\n") |
"" "\n") |
134 |
"\n" |
"\n" |
135 |
"This is a skeleton command (see `skeleton-insert'). |
"This is a skeleton command (see `skeleton-insert'). |
146 |
|
|
147 |
;;;###autoload |
;;;###autoload |
148 |
(defun skeleton-proxy-new (skeleton &optional str arg) |
(defun skeleton-proxy-new (skeleton &optional str arg) |
149 |
"Insert skeleton defined by variable of same name (see `skeleton-insert'). |
"Insert SKELETON. |
150 |
Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). |
Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). |
151 |
If no ARG was given, but the region is visible, ARG defaults to -1 depending |
If no ARG was given, but the region is visible, ARG defaults to -1 depending |
152 |
on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. |
on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. |
153 |
This command can also be an abbrev expansion (3rd and 4th columns in |
This command can also be an abbrev expansion (3rd and 4th columns in |
154 |
\\[edit-abbrevs] buffer: \"\" command-name). |
\\[edit-abbrevs] buffer: \"\" command-name). |
155 |
|
|
156 |
When called as a function, optional first argument STR may also be a string |
Optional first argument STR may also be a string which will be the value |
157 |
which will be the value of `str' whereas the skeleton's interactor is then |
of `str' whereas the skeleton's interactor is then ignored." |
158 |
ignored." |
(skeleton-insert (funcall skeleton-filter skeleton) |
159 |
(interactive "*P\nP") |
;; Pretend C-x a e passed its prefix arg to us |
160 |
(setq skeleton (funcall skeleton-filter skeleton)) |
(if (or arg current-prefix-arg) |
161 |
(if (not skeleton) |
(prefix-numeric-value (or arg |
162 |
(if (memq this-command '(self-insert-command |
current-prefix-arg)) |
163 |
skeleton-pair-insert-maybe |
(and skeleton-autowrap |
164 |
expand-abbrev)) |
(or (eq last-command 'mouse-drag-region) |
165 |
(setq buffer-undo-list (primitive-undo 1 buffer-undo-list))) |
(and transient-mark-mode mark-active)) |
166 |
(skeleton-insert skeleton |
-1)) |
167 |
(if (setq skeleton-abbrev-cleanup |
(if (stringp str) |
168 |
(or (eq this-command 'self-insert-command) |
str)) |
169 |
(eq this-command |
;; Return non-nil to tell expand-abbrev that expansion has happened. |
170 |
'skeleton-pair-insert-maybe))) |
;; Otherwise the no-self-insert is ignored. |
171 |
() |
t) |
|
;; Pretend C-x a e passed its prefix arg to us |
|
|
(if (or arg current-prefix-arg) |
|
|
(prefix-numeric-value (or arg |
|
|
current-prefix-arg)) |
|
|
(and skeleton-autowrap |
|
|
(or (eq last-command 'mouse-drag-region) |
|
|
(and transient-mark-mode mark-active)) |
|
|
-1))) |
|
|
(if (stringp str) |
|
|
str)) |
|
|
(and skeleton-abbrev-cleanup |
|
|
(setq skeleton-abbrev-cleanup (point)) |
|
|
(add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t)))) |
|
172 |
|
|
173 |
;; This command isn't meant to be called, only its aliases with meaningful |
;; This command isn't meant to be called, only its aliases with meaningful |
174 |
;; names are. |
;; names are. |
379 |
opoint (point) |
opoint (point) |
380 |
skeleton (cdr skeleton)) |
skeleton (cdr skeleton)) |
381 |
(condition-case quit |
(condition-case quit |
382 |
(skeleton-internal-1 (car skeleton)) |
(skeleton-internal-1 (car skeleton) nil recursive) |
383 |
(quit |
(quit |
384 |
(if (eq (cdr quit) 'recursive) |
(if (eq (cdr quit) 'recursive) |
385 |
(setq recursive 'quit |
(setq recursive 'quit |
399 |
(signal 'quit 'recursive) |
(signal 'quit 'recursive) |
400 |
recursive)) |
recursive)) |
401 |
|
|
402 |
(defun skeleton-internal-1 (element &optional literal) |
(defun skeleton-internal-1 (element &optional literal recursive) |
403 |
(cond |
(cond |
404 |
((char-or-string-p element) |
((char-or-string-p element) |
405 |
(if (and (integerp element) ; -num |
(if (and (integerp element) ; -num |
407 |
(if skeleton-untabify |
(if skeleton-untabify |
408 |
(backward-delete-char-untabify (- element)) |
(backward-delete-char-untabify (- element)) |
409 |
(delete-backward-char (- element))) |
(delete-backward-char (- element))) |
410 |
(insert (if (and skeleton-transformation |
(insert (if (not literal) |
|
(not literal)) |
|
411 |
(funcall skeleton-transformation element) |
(funcall skeleton-transformation element) |
412 |
element)))) |
element)))) |
413 |
((or (eq element '\n) ; actually (eq '\n 'n) |
((or (eq element '\n) ; actually (eq '\n 'n) |
445 |
(goto-char (pop skeleton-regions)) |
(goto-char (pop skeleton-regions)) |
446 |
(and (<= (current-column) (current-indentation)) |
(and (<= (current-column) (current-indentation)) |
447 |
(eq (nth 1 skeleton) '\n) |
(eq (nth 1 skeleton) '\n) |
448 |
(end-of-line 0))) |
(end-of-line 0))) |
449 |
(or skeleton-point |
(or skeleton-point |
450 |
(setq skeleton-point (point))))) |
(setq skeleton-point (point))))) |
451 |
((eq element '-) |
((eq element '-) |
452 |
(setq skeleton-point (point))) |
(setq skeleton-point (point))) |
453 |
((eq element '&) |
((eq element '&) |
454 |
(when skeleton-modified (pop skeleton))) |
(when skeleton-modified (pop skeleton))) |
455 |
((eq element '|) |
((eq element '|) |
456 |
(unless skeleton-modified (pop skeleton))) |
(unless skeleton-modified (pop skeleton))) |
457 |
((eq element '@) |
((eq element '@) |
458 |
(push (point) skeleton-positions)) |
(push (point) skeleton-positions)) |
459 |
((eq 'quote (car-safe element)) |
((eq 'quote (car-safe element)) |
460 |
(eval (nth 1 element))) |
(eval (nth 1 element))) |
461 |
((or (stringp (car-safe element)) |
((or (stringp (car-safe element)) |
462 |
(consp (car-safe element))) |
(consp (car-safe element))) |
463 |
(if (symbolp (car-safe (car element))) |
(if (symbolp (car-safe (car element))) |
464 |
(while (skeleton-internal-list element nil t)) |
(while (skeleton-internal-list element nil t)) |
467 |
(skeleton-internal-list element (car literal)) |
(skeleton-internal-list element (car literal)) |
468 |
(setq literal (cdr literal))))) |
(setq literal (cdr literal))))) |
469 |
((null element)) |
((null element)) |
470 |
(t (skeleton-internal-1 (eval element) t)))) |
(t (skeleton-internal-1 (eval element) t recursive)))) |
471 |
|
|
472 |
;; Maybe belongs into simple.el or elsewhere |
;; Maybe belongs into simple.el or elsewhere |
473 |
;; ;;;###autoload |
;; ;;;###autoload |