--- a/lisp/utils/skeleton.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/utils/skeleton.el	Mon Aug 13 08:46:35 2007 +0200
@@ -5,23 +5,24 @@
 ;; Maintainer: FSF
 ;; Keywords: extensions, abbrev, languages, tools
 
-;; This file is part of GNU Emacs.
+;; This file is part of XEmacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
 
 ;;; Commentary:
 
@@ -49,6 +50,16 @@
      "aTransformation function: ")
 
 
+(defvar skeleton-autowrap t
+  "Controls wrapping behaviour 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
+explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
+region.
+
+We will probably delete this variable in a future Emacs version
+unless we get a substantial number of complaints about the auto-wrap
+feature.")
 
 (defvar skeleton-end-hook
   (lambda ()
@@ -60,7 +71,7 @@
 
 ;;;###autoload
 (defvar skeleton-filter 'identity
-  "Function for transforming a skeleton-proxy's aliases' variable value.")
+  "Function for transforming a skeleton proxy's aliases' variable value.")
 
 (defvar skeleton-untabify t
   "When non-`nil' untabifies when deleting backwards with element -ARG.")
@@ -83,9 +94,10 @@
   "*Replacement for %s in prompts of recursive subskeletons.")
 
 
-(defvar skeleton-abbrev-cleanup nil)
+(defvar skeleton-abbrev-cleanup nil
+  "Variable used to delete the character that led to abbrev expansion.")
 
-
+;; XEmacs -- won't byte compile without the wrapper
 (eval-and-compile
   (defvar skeleton-debug nil
     "*If non-nil `define-skeleton' will override previous definition."))
@@ -105,10 +117,61 @@
   (if skeleton-debug
       (set command skeleton))
   `(progn
-     (defvar ,command ',skeleton ,documentation)
-     (defalias ',command 'skeleton-proxy)))
+     (defun ,command (&optional str arg)
+       ,(concat documentation
+		(if (string-match "\n\\>" documentation)
+		    "" "\n")
+		"\n"
+		"This is a skeleton command (see `skeleton-insert').
+Normally the skeleton text is inserted at point, with nothing \"inside\".
+If there is a highlighted region, the skeleton text is wrapped
+around the region text.
+
+A prefix argument ARG says to wrap the skeleton around the next ARG words.
+A prefix argument of zero says to wrap around zero words---that is, nothing.
+This is a way of overiding the use of a highlighted region.")
+       (interactive "*P\nP")
+       (skeleton-proxy-new ',skeleton str arg))))
 
-
+;;;###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 (boundp 'transient-mark-mode)
+				       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 it's aliases with meaningful
 ;; names are.
@@ -116,6 +179,8 @@
 (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').
+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).
 
@@ -124,7 +189,7 @@
 ignored."
   (interactive "*P\nP")
   (let ((function (nth 1 (backtrace-frame 1))))
-    (if (eq function 'nth)		; uncompiled lisp function
+    (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)))))
@@ -142,13 +207,17 @@
 			 ;; 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))
+			   (and skeleton-autowrap
+				(or (eq last-command 'mouse-drag-region)
+				    (and (boundp 'transient-mark-mode)
+					 transient-mark-mode mark-active))
+				-1)))
 		       (if (stringp str)
 			   str))
-      (if skeleton-abbrev-cleanup
-	  (setq deferred-action-list t
-		deferred-action-function 'skeleton-abbrev-cleanup
-		skeleton-abbrev-cleanup (point))))))
+      (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)
@@ -156,10 +225,8 @@
   (if (integerp skeleton-abbrev-cleanup)
       (progn
 	(delete-region skeleton-abbrev-cleanup (point))
-	(setq deferred-action-list ()
-	      deferred-action-function nil
-	      skeleton-abbrev-cleanup nil))))
-
+	(setq skeleton-abbrev-cleanup nil)
+	(remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t))))
 
 ;;;###autoload
 (defun skeleton-insert (skeleton &optional skeleton-regions str)
@@ -201,9 +268,9 @@
 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
+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 implies an
 endless loop.  Modes can define other symbols by locally setting them
 to any valid skeleton element.  The following local variables are
 available:
@@ -212,7 +279,7 @@
 		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
-	v1, v2	local variables for memorising anything you want
+	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'."
@@ -382,20 +449,19 @@
 
 
 ;; 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)
+  '(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: " str
   & -5 | '(kill-line 0) & -1 | comment-end \n
   ( (completing-read (format "Variable, %s: " skeleton-subprompt)
 		     obarray
@@ -406,9 +472,9 @@
     comment-start str ": "
     (read-from-minibuffer "Expression: " nil read-expression-map nil
 			  'read-expression-history) | _
-    comment-end \n)
+			  comment-end \n)
   resume:
-  comment-start "End:" comment-end)
+  comment-start "End:" comment-end \n)
 
 ;; Variables and command for automatically inserting pairs like () or "".
 
@@ -439,80 +505,83 @@
 (defun skeleton-pair-insert-maybe (arg)
   "Insert the character you type ARG times.
 
-With no ARG, if `skeleton-pair' is non-nil, and if
-`skeleton-pair-on-word' is non-nil or we are not before or inside a
+With no ARG, if `skeleton-pair' is non-nil, pairing can occur.  If the region
+is visible the pair is wrapped around it depending on `skeleton-autowrap'.
+Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
 word, and if `skeleton-pair-filter' returns nil, pairing is performed.
 
 If a match is found in `skeleton-pair-alist', that is inserted, else
 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))
-      (self-insert-command (prefix-numeric-value arg))
-    (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) skeleton-pair-alist))
-	  ;; typed char is inserted (car is no real interactor)
-	  (let (skeleton-end-hook)
-	    (skeleton-insert arg))
-	(save-excursion
-	  (insert (or (cdr (assq (preceding-char)
-				 '((?( . ?))
-				   (?[ . ?])
-				   (?{ . ?})
-				   (?< . ?>)
-				   (?` . ?'))))
-		      last-command-char)))))))
+  (let ((mark (and skeleton-autowrap
+		   (or (eq last-command 'mouse-drag-region)
+		       (and (boundp 'transient-mark-mode)
+			    transient-mark-mode mark-active))))
+	(skeleton-end-hook))
+    (if (or arg
+	    (not skeleton-pair)
+	    (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))))))
 
 
-;;; ;; 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 'skeleton-pair-insert-maybe)
-;;;      (setq i (1+ i))))
-;;;  (run-hooks 'mirror-mode-hook))
+;; 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 'skeleton-pair)
+;;  (make-local-variable 'skeleton-pair-on-word)
+;;  (make-local-variable 'skeleton-pair-filter)
+;;  (make-local-variable 'skeleton-pair-alist)
+;;  (setq major-mode 'mirror-mode
+;;	mode-name "Mirror"
+;;	skeleton-pair-on-word t
+;;	;; in the middle column insert one or none if odd window-width
+;;	skeleton-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
+;;	skeleton-pair-alist '((?) _ ?()
+;;			      (?] _ ?[)
+;;			      (?} _ ?{)
+;;			      (?> _ ?<)
+;;			      (?/ _ ?\\)
+;;			      (?\\ _ ?/)
+;;			      (?` ?` _ "''")
+;;			      (?' ?' _ "``"))
+;;	;; in this mode we exceptionally ignore the user, else it's no fun
+;;	skeleton-pair t)
+;;  (let ((map (make-vector 256 'skeleton-pair-insert-maybe))
+;;	(i 0))
+;;    (use-local-map `(keymap ,map))
+;;    (while (< i ? )
+;;      (aset map i nil)
+;;      (aset map (+ i 128) nil)
+;;      (setq i (1+ i))))
+;;  (run-hooks 'mirror-mode-hook))
+
+(provide 'skeleton)
 
 ;; skeleton.el ends here