]> code.delx.au - gnu-emacs/blobdiff - lisp/skeleton.el
(mouse-show-mark): Use temporary highlighting if possible instead of a pause.
[gnu-emacs] / lisp / skeleton.el
index 7ee3c8fff6c0ee59fdc92a0bcd6ee303f1f806d5..399aead1dba85ec5f9ed5827cb6cb9c5b865e9bb 100644 (file)
@@ -1,4 +1,5 @@
 ;;; skeleton.el --- Lisp language extension for writing statement skeletons
+
 ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc.
 
 ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
@@ -18,8 +19,9 @@
 ;; GNU General Public License for more details.
 
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.
 
 ;;; Commentary:
 
@@ -48,14 +50,24 @@ Typical examples might be `upcase' or `capitalize'.")
 
 
 
+(defvar skeleton-end-hook
+  (lambda ()
+    (or (eolp) (newline-and-indent)))
+  "Hook called at end of skeleton but before going to point of interest.
+By default this moves out anything following to next line.
+The variables `v1' and `v2' are still set when calling this.")
+
+
 ;;;###autoload
 (defvar skeleton-filter 'identity
   "Function for transforming a skeleton-proxy's aliases' variable value.")
 
-
 (defvar skeleton-untabify t
   "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'.
+Else use mode's `indent-line-function'.")
 
 (defvar skeleton-further-elements ()
   "A buffer-local varlist (see `let') of mode specific skeleton elements.
@@ -77,6 +89,11 @@ skeleton elements.")
 (defvar skeleton-debug nil
   "*If non-nil `define-skeleton' will override previous definition.")
 
+;; reduce the number of compiler warnings
+(defvar skeleton)
+(defvar skeleton-modified)
+(defvar skeleton-point)
+(defvar skeleton-regions)
 
 ;;;###autoload
 (defmacro define-skeleton (command documentation &rest skeleton)
@@ -86,44 +103,47 @@ which contains the skeleton, has a documentation to that effect.
 INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
   (if skeleton-debug
       (set command skeleton))
-  (require 'backquote)
-  (`(progn
-      (defvar (, command) '(, skeleton)
-       (, documentation))
-      (defalias '(, command) 'skeleton-proxy))))
+  `(progn
+     (defvar ,command ',skeleton ,documentation)
+     (defalias ',command 'skeleton-proxy)))
 
 
 
 ;; This command isn't meant to be called, only it's aliases with meaningful
 ;; names are.
 ;;;###autoload
-(defun skeleton-proxy (&optional arg)
-  "Insert skeleton defined by variable of same name (see `skeleton-insert').
+(defun skeleton-proxy (&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').
 This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name)."
-  (interactive "*P")
+\\[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 (or (eq this-command 'self-insert-command)
-               (eq this-command 'skeleton-pair-insert-maybe)
-               (eq this-command 'expand-abbrev))
-           (setq buffer-undo-list
-                 (primitive-undo 1 buffer-undo-list)))
+       (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
-                      nil
                       (if (setq skeleton-abbrev-cleanup
                                 (or (eq this-command 'self-insert-command)
-                                    (eq this-command 'skeleton-pair-insert-maybe)))
+                                    (eq this-command
+                                        'skeleton-pair-insert-maybe)))
                           ()
-                        ;; Pretend  C-x a e  passed the prefix arg to us
+                        ;; 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)))))
+                                                      current-prefix-arg))))
+                      (if (stringp str)
+                          str))
       (if skeleton-abbrev-cleanup
          (setq deferred-action-list t
                deferred-action-function 'skeleton-abbrev-cleanup
@@ -141,9 +161,8 @@ This command can also be an abbrev expansion (3rd and 4th columns in
 
 
 ;;;###autoload
-(defun skeleton-insert (skeleton &optional no-newline regions)
+(defun skeleton-insert (skeleton &optional skeleton-regions str)
   "Insert the complex statement skeleton SKELETON describes very concisely.
-If optional NO-NEWLINE is nil the skeleton will end on a line of its own.
 
 With optional third REGIONS wrap first interesting point (`_') in skeleton
 around next REGIONS words, if REGIONS is positive.  If REGIONS is negative,
@@ -153,13 +172,17 @@ two contiguous marked points.  If you marked A B C [] (where [] is the cursor)
 in alphabetical order, the 3 interregions are simply the last 3 regions.  But
 if you marked B A [] C, the interregions are B-A, A-[], []-C.
 
+Optional fourth STR is the value for the variable `str' within the skeleton.
+When this is non-`nil' the interactor gets ignored, and this should be a valid
+skeleton element.
+
 SKELETON is made up as (INTERACTOR ELEMENT ...).  INTERACTOR may be nil if
 not needed, a prompt-string or an expression for complex read functions.
 
 If ELEMENT is a string or a character it gets inserted (see also
 `skeleton-transformation').  Other possibilities are:
 
-       \\n     go to next line and align cursor
+       \\n     go to next line and indent according to mode
        _       interesting point, interregion here, point after termination
        >       indent line (or interregion if > _) according to major mode
        &       do next ELEMENT if previous moved point
@@ -174,11 +197,12 @@ different inputs.  The SKELETON is processed as often as the user enters a
 non-empty string.  \\[keyboard-quit] terminates skeleton insertion, but
 continues after `resume:' and positions at `_' if any.  If INTERACTOR in such
 a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'.
+formatted with `skeleton-subprompt'.  Such an INTERACTOR may also a list of
+strings with the subskeleton being repeated once for each string.
 
 Quoted lisp-expressions are evaluated evaluated for their side-effect.
 Other lisp-expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this impplies 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:
@@ -186,57 +210,53 @@ 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'
-       quit    non-nil after resume: section is entered by keyboard quit
-       v1, v2  local variables for memorising anything you want"
-  (and regions
-       (setq regions
-            (if (> regions 0)
+       input   initial input (string or cons with index) while reading str
+       v1, v2  local variables for memorising anything you want
+
+When done with skeleton, but before going back to `_'-point call
+`skeleton-end-hook' if that is non-`nil'."
+  (and skeleton-regions
+       (setq skeleton-regions
+            (if (> skeleton-regions 0)
                 (list (point-marker)
-                      (save-excursion (forward-word regions) (point-marker)))
-              (setq regions (- regions))
-              ;; copy regions - 1 elements from `mark-ring'
+                      (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))))
-                (while (and l1 (> regions 0))
+                (while (and l1 (> skeleton-regions 0))
                   (setq l2 (cons (car l1) l2)
-                        regions (1- regions)
+                        skeleton-regions (1- skeleton-regions)
                         l1 (cdr l1)))
                 (sort l2 '<))))
-       (goto-char (car regions))
-       (setq regions (cdr regions)))
-  (let (modified point resume: help quit v1 v2)
-    (or no-newline
-       (eolp)
-       ;;(save-excursion
-       ;;  (indent-to (prog1
-       ;;               (current-indentation)
-       ;;             (newline))))
-       (goto-char (prog1 (point)
-                    (indent-to (prog1
-                                   (current-indentation)
-                                 (newline))))))
+       (goto-char (car skeleton-regions))
+       (setq skeleton-regions (cdr skeleton-regions)))
+  (let ((beg (point))
+       skeleton-modified skeleton-point resume: help input v1 v2)
     (unwind-protect
-       (eval (list 'let skeleton-further-elements
-                   '(skeleton-internal-list skeleton (car skeleton))))
-      (if point
-         (goto-char point)))))
-
-
+       (eval `(let ,skeleton-further-elements
+                (skeleton-internal-list skeleton str)))
+      (run-hooks 'skeleton-end-hook)
+      (sit-for 0)
+      (or (pos-visible-in-window-p beg)
+         (progn
+           (goto-char beg)
+           (recenter 0)))
+      (if skeleton-point
+         (goto-char skeleton-point)))))
 
 (defun skeleton-read (str &optional initial-input recursive)
-  "Function for reading a string from the minibuffer in skeletons.
+  "Function for reading a string from the minibuffer within skeletons.
 PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'.
-If non-`nil' second arg INITIAL-INPUT is a string to insert before reading.
-While reading, the value of `minibuffer-help-form' is variable `help' if that is
-non-`nil' or a default string if optional ITERATIVE is non-`nil'."
-
-  (or no-newline
-      (eolp)
-      (goto-char (prog1 (point)
-                  (indent-to (prog1
-                                 (current-indentation)
-                               (newline))))))
-  (let ((minibuffer-help-form (or help (if recursive "\
+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
+is non-`nil' or a default string."
+  (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
+                                 (if recursive "\
 As long as you provide input you will insert another subskeleton.
 
 If you enter the empty string, the loop inserting subskeletons is
@@ -245,104 +265,121 @@ left, and the current one is removed as far as it has been entered.
 If you quit, the current subskeleton is removed as far as it has been
 entered.  No more of the skeleton will be inserted, except maybe for a
 syntactically necessary termination."
-                                        "
+                                        "\
 You are inserting a skeleton.  Standard text gets inserted into the buffer
-automatically, and you are prompted to fill in the variable parts."))))
-    (setq str (if (stringp str)
-                 (read-string (format str skeleton-subprompt) initial-input)
-               (eval str))))
-  (if (or (null str) (string= str ""))
+automatically, and you are prompted to fill in the variable parts.")))
+       (eolp (eolp)))
+    ;; since Emacs doesn't show main window's cursor, do something noticeable
+    (or eolp
+       (open-line 1))
+    (unwind-protect
+       (setq str (if (stringp str)
+                     (read-string (format str skeleton-subprompt)
+                                  (setq initial-input
+                                        (or initial-input
+                                            (symbol-value 'input))))
+                   (eval str)))
+      (or eolp
+         (delete-char 1))))
+  (if (and recursive
+          (or (null str)
+              (string= str "")
+              (equal str initial-input)
+              (equal str (car-safe initial-input))))
       (signal 'quit t)
     str))
 
-
 (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))))
         opoint)
-    (condition-case quit
-       (progn
-         '(setq str (list 'setq 'str
-                         (if recursive
-                             (list 'skeleton-read (list 'quote str))
-                           (list (if (stringp str)
-                                     'read-string
-                                   'eval)
-                                 str))))
-         (setq str (list 'setq 'str
-                         (list 'skeleton-read
-                               (list 'quote str nil recursive))))
-         (while (setq modified (eq opoint (point))
-                      opoint (point)
-                      skeleton (cdr skeleton))
-           (skeleton-internal-1 (car skeleton)))
-         ;; maybe continue loop
-         recursive)
-      (quit ;; remove the subskeleton as far as it has been shown
-       (if (eq (cdr quit) 'recursive)
-          ()
-        ;; the subskeleton shouldn't have deleted outside current line
-        (end-of-line)
-        (delete-region start (point))
-        (insert line)
-        (move-to-column column))
-       (if (eq (cdr quit) t)
-          ;; empty string entered
-          nil
-        (while (if skeleton
-                   (not (eq (car (setq skeleton (cdr skeleton)))
-                            'resume:))))
-        (if skeleton
-            (skeleton-internal-list skeleton)
-          ;; propagate signal we can't handle
-          (if recursive (signal 'quit 'recursive)))
-        (signal 'quit nil))))))
+    (or str
+       (setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive))))
+    (while (setq skeleton-modified (eq opoint (point))
+                opoint (point)
+                skeleton (cdr skeleton))
+      (condition-case quit
+         (skeleton-internal-1 (car skeleton))
+       (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
+          (end-of-line)
+          (delete-region start (point))
+          (insert line)
+          (move-to-column column)
+          (if (cdr quit)
+              (setq skeleton ()
+                    recursive nil)
+            (signal 'quit 'recursive)))))))
+  ;; maybe continue loop or go on to next outer resume: section
+  (if (eq recursive 'quit)
+      (signal 'quit 'recursive)
+    recursive))
 
 
 (defun skeleton-internal-1 (element &optional literal)
-  (cond ((and (integerp element)       ; -num
-             (< element 0))
-        (if skeleton-untabify
-            (backward-delete-char-untabify (- element))
-          (delete-backward-char (- element))))
-       ((char-or-string-p element)
-        (insert-before-markers (if (and skeleton-transformation
-                                        (not literal))
-                                   (funcall skeleton-transformation element)
-                                 element)))
+  (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)
-        (newline)
-        (indent-relative t))
+        (if (and skeleton-regions
+                 (eq (nth 1 skeleton) '_))
+            (progn
+              (or (eolp)
+                  (newline))
+              (indent-region (point) (car skeleton-regions) nil))
+          (if skeleton-newline-indent-rigidly
+              (indent-to (prog1 (current-indentation)
+                           (newline)))
+            (newline)
+            (indent-according-to-mode))))
        ((eq element '>)
-        (if (and regions
+        (if (and skeleton-regions
                  (eq (nth 1 skeleton) '_))
-            (indent-region (point) (car regions) nil)
-          (indent-for-tab-command)))
+            (indent-region (point) (car skeleton-regions) nil)
+          (indent-according-to-mode)))
        ((eq element '_)
-        (if regions
+        (if skeleton-regions
             (progn
-              (goto-char (car regions))
-              (setq regions (cdr regions)))
-          (or point
-              (setq point (point)))))
+              (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 '&)
-        (if modified
+        (if skeleton-modified
             (setq skeleton (cdr skeleton))))
        ((eq element '|)
-        (or modified
+        (or skeleton-modified
             (setq skeleton (cdr skeleton))))
-       ((if (consp element)
-            (or (stringp (car element))
-                (consp (car element))))
-        (while (skeleton-internal-list element (car element) t)))
-       ((if (consp element)
-            (eq 'quote (car element)))
+       ((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))))
 
+
 ;; Maybe belongs into simple.el or elsewhere
 
 (define-skeleton local-variables-section
@@ -410,6 +447,7 @@ the defaults are used.  These are (), [], {}, <> and `' for the
 symmetrical ones, and the same character twice for the others."
   (interactive "*P")
   (if (or arg
+         overwrite-mode
          (not skeleton-pair)
          (if (not skeleton-pair-on-word) (looking-at "\\w"))
          (funcall skeleton-pair-filter))
@@ -419,8 +457,9 @@ symmetrical ones, and the same character twice for the others."
        ()
       ;; (preceding-char) is stripped of any Meta-stuff in last-command-char
       (if (setq arg (assq (preceding-char) skeleton-pair-alist))
-         ;; typed char is inserted, and car means no interactor
-         (skeleton-insert arg t)
+         ;; typed char is inserted (car is no real interactor)
+         (let (skeleton-end-hook)
+           (skeleton-insert arg))
        (save-excursion
          (insert (or (cdr (assq (preceding-char)
                                 '((?( . ?))
@@ -475,4 +514,6 @@ symmetrical ones, and the same character twice for the others."
 ;;;      (setq i (1+ i))))
 ;;;  (run-hooks 'mirror-mode-hook))
 
+(provide 'skeleton)
+
 ;; skeleton.el ends here