Mercurial > emacs

--- a/lisp/skeleton.el	Fri Jul 07 19:20:09 1995 +0000
+++ b/lisp/skeleton.el	Fri Jul 07 19:21:17 1995 +0000
@@ -1,9 +1,9 @@
-;;; skeleton.el --- Metalanguage for writing statement skeletons
-;; Copyright (C) 1993 by Free Software Foundation, Inc.
+;;; skeleton.el --- Lisp language extension for writing statement skeletons
+;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc.

-;; Author: Daniel Pfeiffer, fax (+49 69) 75 88 529, c/o <bonhoure@cict.fr>
+;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
 ;; Maintainer: FSF
-;; Keywords: shell programming
+;; Keywords: extensions, abbrev, languages, tools

 ;; This file is part of GNU Emacs.

@@ -23,7 +23,7 @@

 ;;; Commentary:

-;; A very concise metalanguage for writing structured statement
+;; A very concise language extension for writing structured statement
 ;; skeleton insertion commands for programming language modes.  This
 ;; originated in shell-script mode and was applied to ada-mode's
 ;; commands which shrunk to one third.  And these commands are now
@@ -31,13 +31,13 @@

 ;;; Code:

-;; page 1:	statement skeleton metalanguage definition & interpreter
+;; page 1:	statement skeleton language definition & interpreter
 ;; page 2:	paired insertion
 ;; page 3:	mirror-mode, an example for setting up paired insertion


 (defvar skeleton-transformation nil
-  "*If non-nil, function applied to 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'.")
@@ -48,91 +48,195 @@


+;;;###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-further-elements ()
+  "A buffer-local varlist (see `let') of mode specific skeleton elements.
+These variables are bound while interpreting a skeleton.  Their value may
+in turn be any valid skeleton element if they are themselves to be used as
+skeleton elements.")
+(make-variable-buffer-local 'skeleton-further-elements)
+
+
 (defvar skeleton-subprompt
   (substitute-command-keys
    "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
-  "*Replacement for %s in prompts of recursive skeleton definitions.")
+  "*Replacement for %s in prompts of recursive subskeletons.")


+(defvar skeleton-abbrev-cleanup nil)
+

 (defvar skeleton-debug nil
   "*If non-nil `define-skeleton' will override previous definition.")


-
 ;;;###autoload
-(defmacro define-skeleton (command documentation &rest definition)
+(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 definition, has a documentation to that effect.
-PROMPT and ELEMENT ... are as defined under `skeleton-insert'."
+which contains the skeleton, has a documentation to that effect.
+INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
   (if skeleton-debug
-      (set command definition))
+      (set command skeleton))
   (require 'backquote)
   (`(progn
-      (defvar (, command) '(, definition)
-	(, (concat "*Definition for the "
-		   (symbol-name command)
-		   " skeleton command.
-See function `skeleton-insert' for meaning."))	)
-      (defun (, command) ()
-	(, documentation)
-	(interactive)
-	;; Don't use last-command to guarantee command does the same thing,
-	;; whatever other name it is given.
-	(skeleton-insert (, command))))))
+      (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-insert (definition &optional no-newline)
-  "Insert the complex statement skeleton DEFINITION describes very concisely.
+(defun skeleton-proxy (&optional arg)
+  "Insert a 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")
+  (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 'pair-insert-maybe)
+		(eq this-command '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 'pair-insert-maybe)))
+			   ()
+			 ;; Pretend  C-x a e  passed the prefix arg to us
+			 (if (or arg current-prefix-arg)
+			     (prefix-numeric-value (or arg
+						       current-prefix-arg)))))
+      (if skeleton-abbrev-cleanup
+	  (setq deferred-action-list t
+		deferred-action-function 'skeleton-abbrev-cleanup
+		skeleton-abbrev-cleanup (point))))))
+
+
+(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 deferred-action-list ()
+	      deferred-action-function nil
+	      skeleton-abbrev-cleanup nil))))
+
+
+;;;###autoload
+(defun skeleton-insert (skeleton &optional no-newline regions)
+  "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.

-DEFINITION is made up as (PROMPT ELEMENT ...).  PROMPT may be nil if not
-needed, a prompt-string or an expression for complex read functions.
+With optional third REGIONS wrap first interesting point (`_') in skeleton
+around next REGIONS words, if REGIONS is positive.  If REGIONS is negative,
+wrap REGIONS preceding interregions into first REGIONS interesting positions
+\(successive `_'s) in skeleton.  An interregion is the stretch of text between
+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.
+
+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
-	>	indent according to major mode
-	<	undent tab-width spaces but not beyond beginning of line
-	_	cursor after termination
-	&	skip next ELEMENT if previous didn't move point
-	|	skip next ELEMENT if previous moved point
-	-num	delete num preceding characters
+	_	interesting point, interregion here, point after termination
+	>	indent line (or interregion if > _) according to major mode
+	&	do next ELEMENT if previous moved point
+	|	do next ELEMENT if previous didn't move point
+	-num	delete num preceding characters (see `skeleton-untabify')
 	resume:	skipped, continue here if quit is signaled
 	nil	skipped

-ELEMENT may itself be DEFINITION with a PROMPT.  The user is prompted
-repeatedly for different inputs.  The DEFINITION 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 PROMPT in such a sub-definition contains a \".. %s ..\" it
-is replaced by `skeleton-subprompt'.
+Further elements can be defined via `skeleton-further-elements'.  ELEMENT may
+itself be a SKELETON with an INTERACTOR.  The user is prompted repeatedly for
+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'.

+Quoted lisp-expressions are evaluated evaluated for their side-effect.
 Other lisp-expressions are evaluated and the value treated as above.
-The following local variables are available:
+Note that expressions may not return `t' since this impplies 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 prompting with PROMPT and insert it
-			    if PROMPT is not a string it is evaluated instead
+	str	first time: read a string according to INTERACTOR
 		then: insert previously read string once more
-	quit	non-nil when resume: section is entered by keyboard quit
+	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"
-  (let (modified opoint point resume: quit v1 v2)
-    (skeleton-internal-list definition (car definition))
+  (and regions
+       (setq regions
+	     (if (> regions 0)
+		 (list (point-marker)
+		       (save-excursion (forward-word regions) (point-marker)))
+	       (setq regions (- regions))
+	       ;; copy regions - 1 elements from `mark-ring'
+	       (let ((l1 (cons (mark-marker) mark-ring))
+		     (l2 (list (point-marker))))
+		 (while (and l1 (> regions 0))
+		   (setq l2 (cons (car l1) l2)
+			 regions (1- 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)
-	(newline)
-	(indent-relative t))
-    (if point
-	(goto-char point))))
+	;;(save-excursion
+	;;  (indent-to (prog1
+	;;		 (current-indentation)
+	;;	       (newline))))
+	(goto-char (prog1 (point)
+		     (indent-to (prog1
+				    (current-indentation)
+				  (newline))))))
+    (unwind-protect
+	(eval (list 'let skeleton-further-elements
+		    '(skeleton-internal-list skeleton (car skeleton))))
+      (if point
+	  (goto-char point)))))


-(defun skeleton-internal-read (str)
-  (let ((minibuffer-help-form "\
+(defun skeleton-read (str &optional initial-input recursive)
+  "Function for reading a string from the minibuffer in 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 "\
 As long as you provide input you will insert another subskeleton.

 If you enter the empty string, the loop inserting subskeletons is
@@ -140,88 +244,134 @@

 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."))
+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))
+		  (read-string (format str skeleton-subprompt) initial-input)
 		(eval str))))
-  (if (string= str "")
+  (if (or (null str) (string= str ""))
       (signal 'quit t)
     str))


-(defun skeleton-internal-list (definition &optional str recursive start line)
-  (condition-case quit
-      (progn
-	(setq start (save-excursion (beginning-of-line) (point))
-	      column (current-column)
-	      line (buffer-substring start
-				     (save-excursion (end-of-line) (point)))
-	      str (list 'setq 'str
-			(if recursive
-			    (list 'skeleton-internal-read (list 'quote str))
-			  (list (if (stringp str)
-				    'read-string
-				  'eval)
-				str))))
-	(while (setq modified (eq opoint (point))
-		     opoint (point)
-		     definition (cdr definition))
-	  (skeleton-internal-1 (car definition)))
-	;; 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 definition
-		       (not (eq (car (setq definition (cdr definition)))
-				'resume:))))
-	    (if definition
-		(skeleton-internal-list definition)
-	      ;; propagate signal we can't handle
-	      (if recursive (signal 'quit '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))))
+	 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))))))


-
-(defun skeleton-internal-1 (element)
-  (cond ((and (integerp element)
+(defun skeleton-internal-1 (element &optional literal)
+  (cond ((and (integerp element)	; -num
 	      (< element 0))
-	 (delete-char element))
+	 (if skeleton-untabify
+	     (backward-delete-char-untabify (- element))
+	   (delete-backward-char (- element))))
 	((char-or-string-p element)
-	 (insert (if skeleton-transformation
-		     (funcall skeleton-transformation element)
-		   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) )
+	 (indent-relative t))
 	((eq element '>)
-	 (indent-for-tab-command) )
-	((eq element '<)
-	 (backward-delete-char-untabify (min tab-width (current-column))) )
+	 (if (and regions
+		  (eq (nth 1 skeleton) '_))
+	     (indent-region (point) (car regions) nil)
+	   (indent-for-tab-command)))
 	((eq element '_)
-	 (or point
-	     (setq point (point))) )
+	 (if regions
+	     (progn
+	       (goto-char (car regions))
+	       (setq regions (cdr regions)))
+	   (or point
+	       (setq point (point)))))
 	((eq element '&)
 	 (if modified
-	     (setq definition (cdr definition))) )
+	     (setq skeleton (cdr skeleton))))
 	((eq element '|)
 	 (or modified
-	     (setq definition (cdr definition))) )
+	     (setq skeleton (cdr skeleton))))
 	((if (consp element)
 	     (or (stringp (car element))
 		 (consp (car element))))
-	 (while (skeleton-internal-list element (car element) t)) )
-	((null element) )
-	((skeleton-internal-1 (eval element)) )))
+	 (while (skeleton-internal-list element (car element) t)))
+	((if (consp element)
+	     (eq 'quote (car element)))
+	 (eval (nth 1 element)))
+	((null element))
+	((skeleton-internal-1 (eval element) t))))
+
+;; Maybe belongs into simple.el or elsewhere

+;;;###autoload
+(define-skeleton local-variables-section
+  "Insert a local variables section.  Use current comment syntax if any."
+  ()
+  '(save-excursion
+     (if (re-search-forward page-delimiter nil t)
+	 (error "Not on last page.")))
+  comment-start "Local Variables:" comment-end \n
+  comment-start "mode: "
+  (completing-read "Mode: " obarray
+		   (lambda (symbol)
+		     (if (commandp symbol)
+			 (string-match "-mode$" (symbol-name symbol))))
+		   t)
+  & -5 | '(kill-line 0) & -1 | comment-end \n
+  ( (completing-read (format "Variable, %s: " skeleton-subprompt)
+		     obarray
+		     (lambda (symbol)
+		       (or (eq symbol 'eval)
+			   (user-variable-p symbol)))
+		     t)
+    comment-start str ": "
+    (read-from-minibuffer "Expression: " nil read-expression-map nil
+			  'read-expression-history) | _
+    comment-end \n)
+  resume:
+  comment-start "End:" comment-end)

 ;; variables and command for automatically inserting pairs like () or ""

@@ -242,10 +392,10 @@
 (defvar pair-alist ()
   "An override alist of pairing partners matched against
 `last-command-char'.  Each alist element, which looks like (ELEMENT
-...), is passed to `skeleton-insert' with no prompt.  Variable `str'
+...), is passed to `skeleton-insert' with no interactor.  Variable `str'
 does nothing.

-Elements might be (?` ?` _ \"''\"), (?\\( ?  _ \" )\") or (?{ \\n > _ \\n < ?}).")
+Elements might be (?` ?` _ \"''\"), (?\\( ?  _ \" )\") or (?{ \\n > _ \\n ?} >).")


@@ -266,61 +416,65 @@
 	  (if (not pair-on-word) (looking-at "\\w"))
 	  (funcall pair-filter))
       (self-insert-command (prefix-numeric-value arg))
-    (insert last-command-char)
-    (if (setq arg (assq last-command-char pair-alist))
-	;; typed char is inserted, and car means no prompt
-	(skeleton-insert arg t)
-      (save-excursion
-	(insert (or (cdr (assq last-command-char
-			       '((?( . ?))
-				 (?[ . ?])
-				 (?{ . ?})
-				 (?< . ?>)
-				 (?` . ?'))))
-		    last-command-char))))))
+    (self-insert-command 1)
+    (if skeleton-abbrev-cleanup
+	()
+      ;; (preceding-char) is stripped of any Meta-stuff in last-command-char
+      (if (setq arg (assq (preceding-char) pair-alist))
+	  ;; typed char is inserted, and car means no interactor
+	  (skeleton-insert arg t)
+	(save-excursion
+	  (insert (or (cdr (assq (preceding-char)
+				 '((?( . ?))
+				   (?[ . ?])
+				   (?{ . ?})
+				   (?< . ?>)
+				   (?` . ?'))))
+		      last-command-char)))))))


-;; a more serious example can be found in sh-script.el
-;;;(defun mirror-mode ()
-;;;  "This major mode is an amusing little example of paired insertion.
-;;;All printable characters do a paired self insert, while the other commands
-;;;work normally."
-;;;  (interactive)
-;;;  (kill-all-local-variables)
-;;;  (make-local-variable 'pair)
-;;;  (make-local-variable 'pair-on-word)
-;;;  (make-local-variable 'pair-filter)
-;;;  (make-local-variable 'pair-alist)
-;;;  (setq major-mode 'mirror-mode
-;;;	mode-name "Mirror"
-;;;	pair-on-word t
-;;;	;; in the middle column insert one or none if odd window-width
-;;;	pair-filter (lambda ()
-;;;		      (if (>= (current-column)
-;;;			      (/ (window-width) 2))
-;;;			  ;; insert both on next line
-;;;			  (next-line 1)
-;;;			;; insert one or both?
-;;;			(= (* 2 (1+ (current-column)))
-;;;			   (window-width))))
-;;;	;; mirror these the other way round as well
-;;;	pair-alist '((?) _ ?()
-;;;			      (?] _ ?[)
-;;;			      (?} _ ?{)
-;;;			      (?> _ ?<)
-;;;			      (?/ _ ?\\)
-;;;			      (?\\ _ ?/)
-;;;			      (?` ?` _ "''")
-;;;			      (?' ?' _ "``"))
-;;;	;; in this mode we exceptionally ignore the user, else it's no fun
-;;;	pair t)
-;;;  (let ((map (make-keymap))
-;;;	(i ? ))
-;;;    (use-local-map map)
-;;;    (setq map (car (cdr map)))
-;;;    (while (< i ?\^?)
-;;;      (aset map i 'pair-insert-maybe)
-;;;      (setq i (1+ i))))
-;;;  (run-hooks 'mirror-mode-hook))
+;; A more serious example can be found in sh-script.el
+;; The quote before (defun prevents this from being byte-compiled.
+'(defun mirror-mode ()
+  "This major mode is an amusing little example of paired insertion.
+All printable characters do a paired self insert, while the other commands
+work normally."
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'pair)
+  (make-local-variable 'pair-on-word)
+  (make-local-variable 'pair-filter)
+  (make-local-variable 'pair-alist)
+  (setq major-mode 'mirror-mode
+	mode-name "Mirror"
+	pair-on-word t
+	;; in the middle column insert one or none if odd window-width
+	pair-filter (lambda ()
+		      (if (>= (current-column)
+			      (/ (window-width) 2))
+			  ;; insert both on next line
+			  (next-line 1)
+			;; insert one or both?
+			(= (* 2 (1+ (current-column)))
+			   (window-width))))
+	;; mirror these the other way round as well
+	pair-alist '((?) _ ?()
+		     (?] _ ?[)
+		     (?} _ ?{)
+		     (?> _ ?<)
+		     (?/ _ ?\\)
+		     (?\\ _ ?/)
+		     (?` ?` _ "''")
+		     (?' ?' _ "``"))
+	;; in this mode we exceptionally ignore the user, else it's no fun
+	pair t)
+  (let ((map (make-keymap))
+	(i ? ))
+    (use-local-map map)
+    (setq map (car (cdr map)))
+    (while (< i ?\^?)
+      (aset map i 'pair-insert-maybe)
+      (setq i (1+ i))))
+  (run-hooks 'mirror-mode-hook))

 ;; skeleton.el ends here