--- a/lisp/subr.el	Mon Aug 13 11:19:22 2007 +0200
+++ b/lisp/subr.el	Mon Aug 13 11:20:41 2007 +0200
@@ -3,7 +3,6 @@
 ;; Copyright (C) 1985, 1986, 1992, 1994-5, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
 ;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 2000 Ben Wing.
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: extensions, dumped
@@ -118,9 +117,7 @@
 This function does nothing if HOOK is already local in the current
 buffer.
 
-Do not use `make-local-variable' to make a hook variable buffer-local.
-
-See also `add-local-hook' and `remove-local-hook'."
+Do not use `make-local-variable' to make a hook variable buffer-local."
   (if (local-variable-p hook (current-buffer)) ; XEmacs
       nil
     (or (boundp hook) (set hook nil))
@@ -142,11 +139,7 @@
 
 HOOK should be a symbol, and FUNCTION may be any valid function.  If
 HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions.
-
-You can remove this hook yourself using `remove-hook'.
-
-See also `add-local-hook' and `add-one-shot-hook'."
+function, it is changed to a list of functions."
   (or (boundp hook) (set hook nil))
   (or (default-boundp hook) (set-default hook nil))
   ;; If the hook value is a single function, turn it into a list.
@@ -192,114 +185,25 @@
 	  (null (symbol-value hook))	;value is nil, or
 	  (null function))		;function is nil, then
       nil				;Do nothing.
-    (flet ((hook-remove
-	    (function hook-value)
-	    (flet ((hook-test
-		    (fn hel)
-		    (or (equal fn hel)
-			(and (symbolp hel)
-			     (equal fn
-				    (get hel 'one-shot-hook-fun))))))
-	      (if (and (consp hook-value)
-		       (not (functionp hook-value)))
-		  (if (member* function hook-value :test 'hook-test)
-		      (setq hook-value
-			    (delete* function (copy-sequence hook-value)
-				     :test 'hook-test)))
-		(if (equal hook-value function)
-		    (setq hook-value nil)))
-	      hook-value)))
-      (if (or local
-	      ;; Detect the case where make-local-variable was used on a hook
-	      ;; and do what we used to do.
-	      (and (local-variable-p hook (current-buffer))
-		   (not (memq t (symbol-value hook)))))
-	  (set hook (hook-remove function (symbol-value hook)))
-	(set-default hook (hook-remove function (default-value hook)))))))
-
-;; XEmacs addition
-;; #### we need a coherent scheme for indicating compatibility info,
-;; so that it can be programmatically retrieved.
-(defun add-local-hook (hook function &optional append)
-  "Add to the local value of HOOK the function FUNCTION.
-This modifies only the buffer-local value for the hook (which is
-automatically make buffer-local, if necessary), not its default value.
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions.
-
-You can remove this hook yourself using `remove-local-hook'.
-
-See also `add-hook' and `make-local-hook'."
-  (make-local-hook hook)
-  (add-hook hook function append t))
-
-;; XEmacs addition
-(defun remove-local-hook (hook function)
-  "Remove from the local value of HOOK the function FUNCTION.
-This modifies only the buffer-local value for the hook, not its default
-value. (Nothing happens if the hook is not buffer-local.)
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
-list of hooks to run in HOOK, then nothing is done.  See `add-hook'.
-
-See also `add-local-hook' and `make-local-hook'."
-  (if (local-variable-p hook (current-buffer))
-      (remove-hook hook function t)))
-
-(defun add-one-shot-hook (hook function &optional append local)
-  "Add to the value of HOOK the one-shot function FUNCTION.
-FUNCTION will automatically be removed from the hook the first time
-after it runs (whether to completion or to an error).
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions.
-
-You can remove this hook yourself using `remove-hook'.
-
-See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'."
-  (let ((sym (gensym)))
-    (fset sym `(lambda (&rest args)
-		 (unwind-protect
-		     (apply ',function args)
-		   (remove-hook ',hook ',sym ',local))))
-    (put sym 'one-shot-hook-fun function)
-    (add-hook hook sym append local)))
-
-(defun add-local-one-shot-hook (hook function &optional append)
-  "Add to the local value of HOOK the one-shot function FUNCTION.
-FUNCTION will automatically be removed from the hook the first time
-after it runs (whether to completion or to an error).
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-The optional fourth argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes no difference if the hook is not buffer-local.
-To make a hook variable buffer-local, always use
-`make-local-hook', not `make-local-variable'.
-
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions.
-
-You can remove this hook yourself using `remove-local-hook'.
-
-See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'."
-  (make-local-hook hook)
-  (add-one-shot-hook hook function append t))
+    (if (or local
+	    ;; Detect the case where make-local-variable was used on a hook
+	    ;; and do what we used to do.
+	    (and (local-variable-p hook (current-buffer))
+		 (not (memq t (symbol-value hook)))))
+	(let ((hook-value (symbol-value hook)))
+	  (if (and (consp hook-value) (not (functionp hook-value)))
+	      (if (member function hook-value)
+		  (setq hook-value (delete function (copy-sequence hook-value))))
+	    (if (equal hook-value function)
+		(setq hook-value nil)))
+	  (set hook hook-value))
+      (let ((hook-value (default-value hook)))
+	(if (and (consp hook-value) (not (functionp hook-value)))
+	    (if (member function hook-value)
+		(setq hook-value (delete function (copy-sequence hook-value))))
+	  (if (equal hook-value function)
+	      (setq hook-value nil)))
+	(set-default hook hook-value)))))
 
 (defun add-to-list (list-var element)
   "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
@@ -335,22 +239,6 @@
 (define-function 'rplaca 'setcar)
 (define-function 'rplacd 'setcdr)
 
-(defun copy-symbol (symbol &optional copy-properties)
-  "Return a new uninterned symbol with the same name as SYMBOL.
-If COPY-PROPERTIES is non-nil, the new symbol will have a copy of
-SYMBOL's value, function, and property lists."
-  (let ((new (make-symbol (symbol-name symbol))))
-    (when copy-properties
-      ;; This will not copy SYMBOL's chain of forwarding objects, but
-      ;; I think that's OK.  Callers should not expect such magic to
-      ;; keep working in the copy in the first place.
-      (and (boundp symbol)
-	   (set new (symbol-value symbol)))
-      (and (fboundp symbol)
-	   (fset new (symbol-function symbol)))
-      (setplist new (copy-list (symbol-plist symbol))))
-    new))
-
 ;;;; String functions.
 
 ;; XEmacs
@@ -406,14 +294,10 @@
 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
   (or pattern
       (setq pattern "[ \f\t\n\r\v]+"))
-  (let (parts (start 0) (len (length string)))
-    (if (string-match pattern string)
-	(setq parts (cons (substring string 0 (match-beginning 0)) parts)
-	      start (match-end 0)))
-    (while (and (< start len)
-		(string-match pattern string (if (> start (match-beginning 0))
-						 start
-					       (1+ start))))
+  ;; The FSF version of this function takes care not to cons in case
+  ;; of infloop.  Maybe we should synch?
+  (let (parts (start 0))
+    (while (string-match pattern string start)
       (setq parts (cons (substring string start (match-beginning 0)) parts)
 	    start (match-end 0)))
     (nreverse (cons (substring string start) parts))))
@@ -435,8 +319,7 @@
   "Collect output to `standard-output' while evaluating FORMS and return
 it as a string."
   ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig
-  `(with-current-buffer (get-buffer-create
-			 (generate-new-buffer-name " *string-output*"))
+  `(with-current-buffer (get-buffer-create " *string-output*")
      (setq buffer-read-only nil)
      (buffer-disable-undo (current-buffer))
      (erase-buffer)
@@ -447,7 +330,7 @@
        (erase-buffer))))
 
 (defmacro with-current-buffer (buffer &rest body)
-  "Temporarily make BUFFER the current buffer and execute the forms in BODY.
+  "Execute the forms in BODY with BUFFER as the current buffer.
 The value returned is the value of the last form in BODY.
 See also `with-temp-buffer'."
   `(save-current-buffer
@@ -490,10 +373,16 @@
   "With the contents of the current buffer being STR, run BODY.
 Returns the new contents of the buffer, as modified by BODY.
 The original current buffer is restored afterwards."
-  `(with-temp-buffer
-     (insert ,str)
-     ,@body
-     (buffer-string)))
+  `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*")))
+     (with-current-buffer tempbuf
+       (unwind-protect
+	   (progn
+	     (buffer-disable-undo (current-buffer))
+	     (erase-buffer)
+	     (insert ,str)
+	     ,@body
+	     (buffer-string))
+	 (erase-buffer tempbuf)))))
 
 (defun insert-face (string face)
   "Insert STRING and highlight with FACE.  Return the extent created."
@@ -676,6 +565,9 @@
   (interactive)
   nil)
 
+(define-function 'mapc-internal 'mapc)
+(make-obsolete 'mapc-internal 'mapc)
+
 (define-function 'eval-in-buffer 'with-current-buffer)
 (make-obsolete 'eval-in-buffer 'with-current-buffer)
 
@@ -722,12 +614,6 @@
 	(t
 	 (error "Non-funcallable object: %s" function))))
 
-(defun function-allows-args (function n)
-  "Return whether FUNCTION can be called with N arguments."
-  (and (<= (function-min-args function) n)
-       (or (null (function-max-args function))
-	   (<= n (function-max-args function)))))
-
 ;; This function used to be an alias to `buffer-substring', except
 ;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way.
 ;; The new FSF's semantics makes more sense, but we try to support
@@ -742,17 +628,13 @@
 The arguments OLD-END and OLD-BUFFER are supported for backward
 compatibility with pre-21.2 XEmacsen times when arguments to this
 function were (buffer-string &optional START END BUFFER)."
-  (cond
-   ((or (stringp buffer) (bufferp buffer))
-    ;; Most definitely the new way.
-    (buffer-substring nil nil buffer))
-   ((or (stringp old-buffer) (bufferp old-buffer)
-	(natnump buffer) (natnump old-end))
-    ;; Definitely the old way.
-    (buffer-substring buffer old-end old-buffer))
-   (t
-    ;; Probably the old way.
-    (buffer-substring buffer old-end old-buffer))))
+  (if (or (null buffer)
+	  (bufferp buffer)
+	  (stringp buffer))
+      ;; The new way
+      (buffer-substring nil nil buffer)
+    ;; The old way
+    (buffer-substring buffer old-end old-buffer)))
 
 ;; This was not present before.  I think Jamie had some objections
 ;; to this, so I'm leaving this undefined for now. --ben