;;; skeleton.el --- Lisp language extension for writing statement skeletons
-;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; page 3: mirror-mode, an example for setting up paired insertion
-(defvar skeleton-transformation nil
+(defvar skeleton-transformation 'identity
"*If non-nil, function applied to literal strings before they are inserted.
It should take strings and characters and return them transformed, or nil
which means no transformation.
(defvar skeleton-autowrap t
- "Controls wrapping behaviour of functions created with `define-skeleton'.
+ "Controls wrapping behavior of functions created with `define-skeleton'.
When the region is visible (due to `transient-mark-mode' or marking a region
-with the mouse) and this is non-`nil' and the function was called without an
+with the mouse) and this is non-nil and the function was called without an
explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
region.
"Function for transforming a skeleton proxy's aliases' variable value.")
(defvar skeleton-untabify t
- "When non-`nil' untabifies when deleting backwards with element -ARG.")
+ "When non-nil untabifies when deleting backwards with element -ARG.")
(defvar skeleton-newline-indent-rigidly nil
- "When non-`nil', indent rigidly under current line for element `\\n'.
+ "When non-nil, indent rigidly under current line for element `\\n'.
Else use mode's `indent-line-function'.")
(defvar skeleton-further-elements ()
"*Replacement for %s in prompts of recursive subskeletons.")
-(defvar skeleton-abbrev-cleanup nil
- "Variable used to delete the character that led to abbrev expansion.")
-
-
(defvar skeleton-debug nil
"*If non-nil `define-skeleton' will override previous definition.")
(defvar skeleton-point)
(defvar skeleton-regions)
+(def-edebug-spec skeleton-edebug-spec
+ ([&or null stringp (stringp &rest stringp) [[¬ atom] def-form]]
+ &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:"
+ ("quote" def-form) skeleton-edebug-spec def-form))
;;;###autoload
(defmacro define-skeleton (command documentation &rest skeleton)
"Define a user-configurable COMMAND that enters a statement skeleton.
-DOCUMENTATION is that of the command, while the variable of the same name,
-which contains the skeleton, has a documentation to that effect.
-INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
+DOCUMENTATION is that of the command.
+SKELETON is as defined under `skeleton-insert'."
+ (declare (debug (&define name stringp skeleton-edebug-spec)))
(if skeleton-debug
(set command skeleton))
`(progn
+ ;; Tell self-insert-command that this function, if called by an
+ ;; abbrev, should cause the self-insert to be skipped.
+ (put ',command 'no-self-insert t)
(defun ,command (&optional str arg)
,(concat documentation
- (if (string-match "\n\\>" documentation)
+ (if (string-match "\n\\'" documentation)
"" "\n")
"\n"
"This is a skeleton command (see `skeleton-insert').
;;;###autoload
(defun skeleton-proxy-new (skeleton &optional str arg)
- "Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs] buffer: \"\" command-name).
-
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
- (interactive "*P\nP")
- (setq skeleton (funcall skeleton-filter skeleton))
- (if (not skeleton)
- (if (memq this-command '(self-insert-command
- skeleton-pair-insert-maybe
- expand-abbrev))
- (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
- (skeleton-insert skeleton
- (if (setq skeleton-abbrev-cleanup
- (or (eq this-command 'self-insert-command)
- (eq this-command
- 'skeleton-pair-insert-maybe)))
- ()
- ;; 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))))
-
-;; This command isn't meant to be called, only its aliases with meaningful
-;; names are.
-;;;###autoload
-(defun skeleton-proxy (&optional str arg)
- "Insert skeleton defined by variable of same name (see `skeleton-insert').
+ "Insert SKELETON.
Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
If no ARG was given, but the region is visible, ARG defaults to -1 depending
on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
This command can also be an abbrev expansion (3rd and 4th columns in
\\[edit-abbrevs] buffer: \"\" command-name).
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
- (interactive "*P\nP")
- (let ((function (nth 1 (backtrace-frame 1))))
- (if (eq function 'nth) ; uncompiled Lisp function
- (setq function (nth 1 (backtrace-frame 5)))
- (if (eq function 'byte-code) ; tracing byte-compiled function
- (setq function (nth 1 (backtrace-frame 2)))))
- (if (not (setq function (funcall skeleton-filter (symbol-value function))))
- (if (memq this-command '(self-insert-command
- skeleton-pair-insert-maybe
- expand-abbrev))
- (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
- (skeleton-insert function
- (if (setq skeleton-abbrev-cleanup
- (or (eq this-command 'self-insert-command)
- (eq this-command
- 'skeleton-pair-insert-maybe)))
- ()
- ;; 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)))))
-
-
-(defun skeleton-abbrev-cleanup (&rest list)
- "Value for `post-command-hook' to remove char that expanded abbrev."
- (if (integerp skeleton-abbrev-cleanup)
- (progn
- (delete-region skeleton-abbrev-cleanup (point))
- (setq skeleton-abbrev-cleanup)
- (remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t))))
-
+Optional second argument STR may also be a string which will be the value
+of `str' whereas the skeleton's interactor is then ignored."
+ (skeleton-insert (funcall skeleton-filter skeleton)
+ ;; 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))
+ ;; Deactivate the mark, in case one of the
+ ;; elements of the skeleton is sensitive
+ ;; to such situations (e.g. it is itself a
+ ;; skeleton).
+ (progn (deactivate-mark)
+ -1)))
+ (if (stringp str)
+ str))
+ ;; Return non-nil to tell expand-abbrev that expansion has happened.
+ ;; Otherwise the no-self-insert is ignored.
+ t)
;;;###autoload
(defun skeleton-insert (skeleton &optional regions str)
\\n go to next line and indent according to mode
_ interesting point, interregion here
+ - interesting point, no interregion interaction, overrides
+ interesting point set by _
> indent line (or interregion if > _) according to major mode
@ add position to `skeleton-positions'
& do next ELEMENT iff previous moved point
resume: skipped, continue here if quit is signaled
nil skipped
-After termination, point will be positioned at the first occurrence
-of _ or @ or at the end of the inserted text.
+After termination, point will be positioned at the last occurrence of -
+or at the first occurrence of _ or at the end of the inserted text.
Further elements can be defined via `skeleton-further-elements'. ELEMENT may
itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
Quoted Lisp expressions are evaluated for their side-effects.
Other Lisp expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this implies an
+Note that expressions may not return t since this implies an
endless loop. Modes can define other symbols by locally setting them
to any valid skeleton element. The following local variables are
available:
str first time: read a string according to INTERACTOR
then: insert previously read string once more
- help help-form during interaction with the user or `nil'
+ help help-form during interaction with the user or nil
input initial input (string or cons with index) while reading str
v1, v2 local variables for memorizing anything you want
When done with skeleton, but before going back to `_'-point call
-`skeleton-end-hook' if that is non-`nil'."
+`skeleton-end-hook' if that is non-nil."
(let ((skeleton-regions regions))
(and skeleton-regions
(setq skeleton-regions
(if (> skeleton-regions 0)
- (list (point-marker)
+ (list (copy-marker (point) t)
(save-excursion (forward-word skeleton-regions)
(point-marker)))
(setq skeleton-regions (- skeleton-regions))
;; copy skeleton-regions - 1 elements from `mark-ring'
(let ((l1 (cons (mark-marker) mark-ring))
- (l2 (list (point-marker))))
+ (l2 (list (copy-marker (point) t))))
(while (and l1 (> skeleton-regions 0))
- (setq l2 (cons (car l1) l2)
- skeleton-regions (1- skeleton-regions)
- l1 (cdr l1)))
+ (push (copy-marker (pop l1) t) l2)
+ (setq skeleton-regions (1- skeleton-regions)))
(sort l2 '<))))
(goto-char (car skeleton-regions))
(setq skeleton-regions (cdr skeleton-regions)))
PROMPT must be a string or a form that evaluates to a string.
It may contain a `%s' which will be replaced by `skeleton-subprompt'.
-If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or
-cons with index to insert before reading. If third arg RECURSIVE is non-`nil'
+If non-nil second arg INITIAL-INPUT or variable `input' is a string or
+cons with index to insert before reading. If third arg RECURSIVE is non-nil
i.e. we are handling the iterator of a subskeleton, returns empty string if
user didn't modify input.
While reading, the value of `minibuffer-help-form' is variable `help' if that
(defun skeleton-internal-list (skeleton &optional str recursive)
(let* ((start (save-excursion (beginning-of-line) (point)))
(column (current-column))
- (line (buffer-substring start
- (save-excursion (end-of-line) (point))))
+ (line (buffer-substring start (line-end-position)))
opoint)
(or str
(setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive))))
- (when (and (eq (cadr skeleton) '\n)
- (<= (current-column) (current-indentation)))
+ (when (and (eq (cadr skeleton) '\n) (not recursive)
+ (save-excursion (skip-chars-backward " \t") (bolp)))
(setq skeleton (cons nil (cons '> (cddr skeleton)))))
(while (setq skeleton-modified (eq opoint (point))
opoint (point)
skeleton (cdr skeleton))
(condition-case quit
- (skeleton-internal-1 (car skeleton))
+ (skeleton-internal-1 (car skeleton) nil recursive)
(quit
(if (eq (cdr quit) 'recursive)
(setq recursive 'quit
skeleton (memq 'resume: skeleton))
- ;; remove the subskeleton as far as it has been shown
- ;; the subskeleton shouldn't have deleted outside current line
+ ;; Remove the subskeleton as far as it has been shown
+ ;; the subskeleton shouldn't have deleted outside current line.
(end-of-line)
(delete-region start (point))
(insert line)
(signal 'quit 'recursive)
recursive))
-
-(defun skeleton-internal-1 (element &optional literal)
- (cond ((char-or-string-p element)
- (if (and (integerp element) ; -num
- (< element 0))
- (if skeleton-untabify
- (backward-delete-char-untabify (- element))
- (delete-backward-char (- element)))
- (insert-before-markers (if (and skeleton-transformation
- (not literal))
- (funcall skeleton-transformation element)
- element))))
- ((eq element '\n) ; actually (eq '\n 'n)
- (cond
- ((and skeleton-regions (eq (nth 1 skeleton) '_))
- (or (eolp) (newline))
- (indent-region (line-beginning-position)
- (car skeleton-regions) nil))
- ;; \n as last element only inserts \n if not at eol.
- ((and (null (cdr skeleton)) (eolp)) nil)
- (skeleton-newline-indent-rigidly
- (indent-to (prog1 (current-indentation) (newline))))
- (t (newline) (indent-according-to-mode))))
- ((eq element '>)
- (if (and skeleton-regions (eq (nth 1 skeleton) '_))
- (indent-region (line-beginning-position)
- (car skeleton-regions) nil)
- (indent-according-to-mode)))
- ((eq element '_)
- (if skeleton-regions
- (progn
- (goto-char (car skeleton-regions))
- (setq skeleton-regions (cdr skeleton-regions))
- (and (<= (current-column) (current-indentation))
- (eq (nth 1 skeleton) '\n)
- (end-of-line 0)))
- (or skeleton-point
- (setq skeleton-point (point)))))
- ((eq element '&)
- (when skeleton-modified (pop skeleton)))
- ((eq element '|)
- (unless skeleton-modified (pop skeleton)))
- ((eq element '@)
- (push (point) skeleton-positions)
- (unless skeleton-point (setq skeleton-point (point))))
- ((eq 'quote (car-safe element))
- (eval (nth 1 element)))
- ((or (stringp (car-safe element))
- (consp (car-safe element)))
- (if (symbolp (car-safe (car element)))
- (while (skeleton-internal-list element nil t))
- (setq literal (car element))
- (while literal
- (skeleton-internal-list element (car literal))
- (setq literal (cdr literal)))))
- ((null element))
- ((skeleton-internal-1 (eval element) t))))
-
-
+(defun skeleton-internal-1 (element &optional literal recursive)
+ (cond
+ ((char-or-string-p element)
+ (if (and (integerp element) ; -num
+ (< element 0))
+ (if skeleton-untabify
+ (backward-delete-char-untabify (- element))
+ (delete-backward-char (- element)))
+ (insert (if (not literal)
+ (funcall skeleton-transformation element)
+ element))))
+ ((or (eq element '\n) ; actually (eq '\n 'n)
+ ;; The sequence `> \n' is handled specially so as to indent the first
+ ;; line after inserting the newline (to get the proper indentation).
+ (and (eq element '>) (eq (nth 1 skeleton) '\n) (pop skeleton)))
+ (let ((pos (if (eq element '>) (point))))
+ (cond
+ ((and skeleton-regions (eq (nth 1 skeleton) '_))
+ (or (eolp) (newline))
+ (if pos (save-excursion (goto-char pos) (indent-according-to-mode)))
+ (indent-region (line-beginning-position)
+ (car skeleton-regions) nil))
+ ;; \n as last element only inserts \n if not at eol.
+ ((and (null (cdr skeleton)) (not recursive) (eolp))
+ (if pos (indent-according-to-mode)))
+ (skeleton-newline-indent-rigidly
+ (let ((pt (point)))
+ (newline)
+ (indent-to (save-excursion
+ (goto-char pt)
+ (if pos (indent-according-to-mode))
+ (current-indentation)))))
+ (t (if pos (reindent-then-newline-and-indent)
+ (newline)
+ (indent-according-to-mode))))))
+ ((eq element '>)
+ (if (and skeleton-regions (eq (nth 1 skeleton) '_))
+ (indent-region (line-beginning-position)
+ (car skeleton-regions) nil)
+ (indent-according-to-mode)))
+ ((eq element '_)
+ (if skeleton-regions
+ (progn
+ (goto-char (pop skeleton-regions))
+ (and (<= (current-column) (current-indentation))
+ (eq (nth 1 skeleton) '\n)
+ (end-of-line 0)))
+ (or skeleton-point
+ (setq skeleton-point (point)))))
+ ((eq element '-)
+ (setq skeleton-point (point)))
+ ((eq element '&)
+ (when skeleton-modified (pop skeleton)))
+ ((eq element '|)
+ (unless skeleton-modified (pop skeleton)))
+ ((eq element '@)
+ (push (point) skeleton-positions))
+ ((eq 'quote (car-safe element))
+ (eval (nth 1 element)))
+ ((and (consp element)
+ (or (stringp (car element)) (listp (car element))))
+ ;; Don't forget: `symbolp' is also true for nil.
+ (if (symbolp (car-safe (car element)))
+ (while (and (skeleton-internal-list element nil t)
+ ;; If the interactor is nil, don't infinite loop.
+ (car element)))
+ (setq literal (car element))
+ (while literal
+ (skeleton-internal-list element (car literal))
+ (setq literal (cdr literal)))))
+ ((null element))
+ (t (skeleton-internal-1 (eval element) t recursive))))
+\f
;; Maybe belongs into simple.el or elsewhere
-;; ;###autoload
-;;; (define-skeleton local-variables-section
+;; ;;;###autoload
+;; (define-skeleton local-variables-section
;; "Insert a local variables section. Use current comment syntax if any."
;; (completing-read "Mode: " obarray
;; (lambda (symbol)
Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).")
+(defvar skeleton-pair-default-alist '((?( _ ?)) (?\))
+ (?[ _ ?]) (?\])
+ (?{ _ ?}) (?\})
+ (?< _ ?>) (?\>)
+ (?« _ ?») (?\»)
+ (?` _ ?')))
;;;###autoload
(defun skeleton-pair-insert-maybe (arg)
the defaults are used. These are (), [], {}, <> and `' for the
symmetrical ones, and the same character twice for the others."
(interactive "*P")
- (let ((mark (and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))))
- (skeleton-end-hook))
- (if (or arg
- (not skeleton-pair)
- (memq (char-syntax (preceding-char)) '(?\\ ?/))
- (and (not mark)
- (or overwrite-mode
- (if (not skeleton-pair-on-word) (looking-at "\\w"))
- (funcall skeleton-pair-filter))))
- (self-insert-command (prefix-numeric-value arg))
- (setq last-command-char (logand last-command-char 255))
- (or skeleton-abbrev-cleanup
- (skeleton-insert
- (cons nil (or (assq last-command-char skeleton-pair-alist)
- (assq last-command-char '((?( _ ?))
- (?[ _ ?])
- (?{ _ ?})
- (?< _ ?>)
- (?` _ ?')))
- `(,last-command-char _ ,last-command-char)))
- (if mark -1))))))
+ (if (or arg (not skeleton-pair))
+ (self-insert-command (prefix-numeric-value arg))
+ (let* ((mark (and skeleton-autowrap
+ (or (eq last-command 'mouse-drag-region)
+ (and transient-mark-mode mark-active))))
+ (skeleton-end-hook)
+ (char last-command-char)
+ (skeleton (or (assq char skeleton-pair-alist)
+ (assq char skeleton-pair-default-alist)
+ `(,char _ ,char))))
+ (if (or (memq (char-syntax (preceding-char)) '(?\\ ?/))
+ (and (not mark)
+ (or overwrite-mode
+ (if (not skeleton-pair-on-word) (looking-at "\\w"))
+ (funcall skeleton-pair-filter))))
+ (self-insert-command (prefix-numeric-value arg))
+ (skeleton-insert (cons nil skeleton) (if mark -1))))))
\f
;; A more serious example can be found in sh-script.el
;; (aset map i nil)
;; (aset map (+ i 128) nil)
;; (setq i (1+ i))))
-;; (run-hooks 'mirror-mode-hook))
+;; (run-mode-hooks 'mirror-mode-hook))
(provide 'skeleton)
+;;; arch-tag: ccad7bd5-eb5d-40de-9ded-900197215c3e
;;; skeleton.el ends here