]> code.delx.au - gnu-emacs/blobdiff - lisp/skeleton.el
(describe-mouse-briefly): Fix message spelling.
[gnu-emacs] / lisp / skeleton.el
index ed72d076c7ed4a3796492890effc51c82f561b8f..d9c8d40f84102a97ef040bf0279dae1b7b9726eb 100644 (file)
@@ -48,14 +48,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 +87,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)
@@ -95,33 +110,38 @@ INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
 ;; 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
@@ -139,9 +159,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,
@@ -151,13 +170,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
@@ -172,7 +195,8 @@ 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.
@@ -185,43 +209,40 @@ available:
                then: insert previously read string once more
        help    help-form during interaction with the user or `nil'
        input   initial input (string or cons with index) while reading str
-       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)
+       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)))
+       (goto-char (car skeleton-regions))
+       (setq skeleton-regions (cdr skeleton-regions)))
   (let ((beg (point))
-       modified point resume: help input quit v1 v2)
-    (or no-newline
-       (eolp)
-       (goto-char (prog1 (point)
-                    (indent-to (prog1 (current-indentation)
-                                 (newline))))))
+       skeleton-modified skeleton-point resume: help input v1 v2)
     (unwind-protect
        (eval `(let ,skeleton-further-elements
-                (skeleton-internal-list skeleton)))
+                (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 point
-         (goto-char point)))))
-
-
+      (if skeleton-point
+         (goto-char skeleton-point)))))
 
 (defun skeleton-read (str &optional initial-input recursive)
   "Function for reading a string from the minibuffer within skeletons.
@@ -232,13 +253,8 @@ 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."
-  (or no-newline
-      (eolp)
-      (goto-char (prog1 (point)
-                  (indent-to (prog1
-                                 (current-indentation)
-                               (newline))))))
-  (let ((minibuffer-help-form (or help (if recursive "\
+  (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
@@ -249,11 +265,20 @@ 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)
-                              (setq initial-input (or initial-input input)))
-               (eval 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 "")
@@ -262,29 +287,25 @@ automatically, and you are prompted to fill in the variable parts."))))
       (signal 'quit t)
     str))
 
-
-(defun skeleton-internal-list (skeleton &optional recursive)
+(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))))
-        (str `(setq str (skeleton-read ',(car skeleton) nil ,recursive)))
         opoint)
-    (while (setq modified (eq opoint (point))
+    (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)
-            (progn
-              (setq recursive 'quit)
-              (while (if skeleton
-                         (not (eq (car (setq skeleton (cdr skeleton)))
-                                  'resume:)))))
+            (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
-          ;; problematic when wrapping text starting on same line
           (end-of-line)
           (delete-region start (point))
           (insert line)
@@ -300,47 +321,63 @@ automatically, and you are prompted to fill in the variable parts."))))
 
 
 (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 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
@@ -418,8 +455,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)
                                 '((?( . ?))