;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*-
-;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2013 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: FSF
(defvar skeleton-transformation-function 'identity
- "*If non-nil, function applied to literal strings before they are inserted.
+ "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.
Typical examples might be `upcase' or `capitalize'.")
"Function for transforming a skeleton proxy's aliases' variable value.")
(defvaralias 'skeleton-filter 'skeleton-filter-function)
-(defvar skeleton-untabify t
+(defvar skeleton-untabify nil ; bug#12223
"When non-nil untabifies when deleting backwards with element -ARG.")
(defvar skeleton-newline-indent-rigidly nil
(defvar skeleton-subprompt
(substitute-command-keys
"RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
- "*Replacement for %s in prompts of recursive subskeletons.")
+ "Replacement for %s in prompts of recursive subskeletons.")
(defvar skeleton-debug nil
- "*If non-nil `define-skeleton' will override previous definition.")
+ "If non-nil `define-skeleton' will override previous definition.")
(defvar skeleton-positions nil
"List of positions marked with @, after skeleton insertion.
are integer buffer positions in the reverse order of the insertion order.")
;; reduce the number of compiler warnings
-(defvar skeleton)
+(defvar skeleton-il)
(defvar skeleton-modified)
(defvar skeleton-point)
(defvar skeleton-regions)
"Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'."
- (declare (debug (&define name stringp skeleton-edebug-spec)))
+ (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)))
(if skeleton-debug
(set command skeleton))
`(progn
(eolp (eolp)))
;; since Emacs doesn't show main window's cursor, do something noticeable
(or eolp
- (open-line 1))
+ ;; We used open-line before, but that can do a lot more than we want,
+ ;; since it runs self-insert-command. E.g. it may remove spaces
+ ;; before point.
+ (save-excursion (insert "\n")))
(unwind-protect
(setq prompt (if (stringp prompt)
(read-string (format prompt skeleton-subprompt)
(signal 'quit t)
prompt))
-(defun skeleton-internal-list (skeleton &optional str recursive)
+(defun skeleton-internal-list (skeleton-il &optional str recursive)
(let* ((start (line-beginning-position))
(column (current-column))
(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) (not recursive)
+ (setq str `(setq str
+ (skeleton-read ',(car skeleton-il) nil ,recursive))))
+ (when (and (eq (cadr skeleton-il) '\n) (not recursive)
(save-excursion (skip-chars-backward " \t") (bolp)))
- (setq skeleton (cons nil (cons '> (cddr skeleton)))))
+ (setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
(while (setq skeleton-modified (eq opoint (point))
opoint (point)
- skeleton (cdr skeleton))
+ skeleton-il (cdr skeleton-il))
(condition-case quit
- (skeleton-internal-1 (car skeleton) nil recursive)
+ (skeleton-internal-1 (car skeleton-il) nil recursive)
(quit
(if (eq (cdr quit) 'recursive)
(setq recursive 'quit
- skeleton (memq 'resume: skeleton))
+ skeleton-il (memq 'resume: skeleton-il))
;; Remove the subskeleton as far as it has been shown
;; the subskeleton shouldn't have deleted outside current line.
(end-of-line)
(insert line)
(move-to-column column)
(if (cdr quit)
- (setq skeleton ()
+ (setq skeleton-il ()
recursive nil)
(signal 'quit 'recursive)))))))
;; maybe continue loop or go on to next outer resume: section
(signal 'quit 'recursive)
recursive))
+(defun skeleton-newline ()
+ (if (or (eq (point) skeleton-point)
+ (eq (point) (car skeleton-positions)))
+ ;; If point is recorded, avoid `newline' since it may do things like
+ ;; strip trailing spaces, and since recorded points are commonly placed
+ ;; right after a trailing space, calling `newline' can destroy the
+ ;; position and renders the recorded position incorrect.
+ (insert "\n")
+ (newline)))
+
(defun skeleton-internal-1 (element &optional literal recursive)
(cond
((or (integerp element) (stringp 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)))
+ (and (eq element '>) (eq (nth 1 skeleton-il) '\n) (pop skeleton-il)))
(let ((pos (if (eq element '>) (point))))
(cond
- ((and skeleton-regions (eq (nth 1 skeleton) '_))
+ ((and skeleton-regions (eq (nth 1 skeleton-il) '_))
(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))
+ ((and (null (cdr skeleton-il)) (not recursive) (eolp))
(if pos (indent-according-to-mode)))
(skeleton-newline-indent-rigidly
(let ((pt (point)))
- (newline)
+ (skeleton-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)
+ (skeleton-newline)
(indent-according-to-mode))))))
((eq element '>)
- (if (and skeleton-regions (eq (nth 1 skeleton) '_))
+ (if (and skeleton-regions (eq (nth 1 skeleton-il) '_))
(indent-region (line-beginning-position)
(car skeleton-regions) nil)
(indent-according-to-mode)))
(progn
(goto-char (pop skeleton-regions))
(and (<= (current-column) (current-indentation))
- (eq (nth 1 skeleton) '\n)
+ (eq (nth 1 skeleton-il) '\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)))
+ (when skeleton-modified (pop skeleton-il)))
((eq element '|)
- (unless skeleton-modified (pop skeleton)))
+ (unless skeleton-modified (pop skeleton-il)))
((eq element '@)
(push (point) skeleton-positions))
((eq 'quote (car-safe element))
;; obarray
;; (lambda (symbol)
;; (or (eq symbol 'eval)
-;; (user-variable-p symbol)))
+;; (custom-variable-p symbol)))
;; t)
;; comment-start str ": "
;; (read-from-minibuffer "Expression: " nil read-expression-map nil
;; Variables and command for automatically inserting pairs like () or "".
(defvar skeleton-pair nil
- "*If this is nil pairing is turned off, no matter what else is set.
+ "If this is nil pairing is turned off, no matter what else is set.
Otherwise modes with `skeleton-pair-insert-maybe' on some keys
will attempt to insert pairs of matching characters.")
(defvar skeleton-pair-on-word nil
- "*If this is nil, paired insertion is inhibited before or inside a word.")
+ "If this is nil, paired insertion is inhibited before or inside a word.")
(defvar skeleton-pair-filter-function (lambda () nil)