diff lisp/subr.el @ 1333:1b0339b048ce

[xemacs-hg @ 2003-03-02 09:38:37 by ben] To: xemacs-patches@xemacs.org PROBLEMS: Include nt/PROBLEMS and update. Add note about incremental linking badness. cmdloop.el, custom.el, dumped-lisp.el, files.el, keydefs.el, keymap.el, lisp-mode.el, make-docfile.el, replace.el, simple.el, subr.el, view-less.el, wid-edit.el: Lots of syncing with FSF 21.2. Use if-fboundp in wid-edit.el. New file newcomment.el from FSF. internals/internals.texi: Fix typo. (Build-Time Dependencies): New node. PROBLEMS: Delete. config.inc.samp, xemacs.mak: Eliminate HAVE_VC6, use SUPPORT_EDIT_AND_CONTINUE in its place. No incremental linking unless SUPPORT_EDIT_AND_CONTINUE, since it can cause nasty crashes in pdump. Put warnings about this in config.inc.samp. Report the full compile flags used for src and lib-src in the Installation output. alloc.c, lisp.h, ralloc.c, regex.c: Use ALLOCA() in regex.c to avoid excessive stack allocation. Also fix subtle problem with REL_ALLOC() -- any call to malloc() (direct or indirect) may relocate rel-alloced data, causing buffer text to shift. After any such call, regex must update all its pointers to such data. Add a system, when ERROR_CHECK_MALLOC, whereby regex.c indicates all the places it is prepared to handle malloc()/realloc()/free(), and any calls anywhere in XEmacs outside of this will trigger an abort. alloc.c, dialog-msw.c, eval.c, event-stream.c, general-slots.h, insdel.c, lisp.h, menubar-msw.c, menubar-x.c: Change *run_hook*_trapping_problems to take a warning class, not a string. Factor out code to issue warnings, add flag to call_trapping_problems() to postpone warning issue, and make *run_hook*_trapping_problems issue their own warnings tailored to the hook, postponed in the case of safe_run_hook_trapping_problems() so that the appropriate message can be issued about resetting to nil only when not `quit'. Make record_unwind_protect_restoring_int() non-static. dumper.c: Issue notes about incremental linking problems under Windows. fileio.c: Mule-ize encrypt/decrypt-string code. text.h: Spacing changes.
author ben
date Sun, 02 Mar 2003 09:38:54 +0000
parents 3a01f3148bff
children c9b6a2fec10d
line wrap: on
line diff
--- a/lisp/subr.el	Sun Mar 02 02:18:12 2003 +0000
+++ b/lisp/subr.el	Sun Mar 02 09:38:54 2003 +0000
@@ -3,7 +3,7 @@
 ;; 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, 2001, 2002 Ben Wing.
+;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing.
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: extensions, dumped
@@ -25,7 +25,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 19.34.  Some things synched up with later versions.
 
 ;;; Commentary:
 
@@ -36,8 +36,18 @@
 ;; of commentary just to give diff(1) something to synch itself with to
 ;; provide useful context diffs. -sb
 
+;; BEGIN SYNCHED WITH FSF 21.2
+
 ;;; Code:
+(defvar custom-declare-variable-list nil
+  "Record `defcustom' calls made before `custom.el' is loaded to handle them.
+Each element of this list holds the arguments to one call to `defcustom'.")
 
+;; Use this, rather than defcustom, in subr.el and other files loaded
+;; before custom.el.
+(defun custom-declare-variable-early (&rest arguments)
+  (setq custom-declare-variable-list
+	(cons arguments custom-declare-variable-list)))
 
 ;;;; Lisp language features.
 
@@ -58,6 +68,36 @@
 BODY should be a list of lisp expressions."
   `(function (lambda ,@cdr)))
 
+;; FSF 21.2 has various basic macros here.  We don't because they're either
+;; in cl*.el (which we dump and hence is always available) or built-in.
+
+;; More powerful versions in cl.el.
+;(defmacro push (newelt listname)
+;(defmacro pop (listname)
+
+;; Built-in.
+;(defmacro when (cond &rest body)
+;(defmacro unless (cond &rest body)
+
+;; More powerful versions in cl-macs.el.
+;(defmacro dolist (spec &rest body)
+;(defmacro dotimes (spec &rest body)
+
+;; In cl.el.  Ours are defun, but cl arranges for them to be inlined anyway.
+;(defsubst caar (x)
+;(defsubst cadr (x)
+;(defsubst cdar (x)
+;(defsubst cddr (x)
+
+;; Built-in.  Our `last' is more powerful in that it handles circularity.
+;(defun last (x &optional n)
+;(defun butlast (x &optional n)
+;(defun nbutlast (x &optional n)
+
+;; In cl-seq.el.
+;(defun remove (elt seq)
+;(defun remq (elt list)
+
 (defmacro defun-when-void (&rest args)
   "Define a function, just like `defun', unless it's already defined.
 Used for compatibility among different emacs variants."
@@ -73,6 +113,52 @@
      (define-function ,@args)))
 
 
+(defun assoc-default (key alist &optional test default)
+  "Find object KEY in a pseudo-alist ALIST.
+ALIST is a list of conses or objects.  Each element (or the element's car,
+if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
+If that is non-nil, the element matches;
+then `assoc-default' returns the element's cdr, if it is a cons,
+or DEFAULT if the element is not a cons.
+
+If no element matches, the value is nil.
+If TEST is omitted or nil, `equal' is used."
+  (let (found (tail alist) value)
+    (while (and tail (not found))
+      (let ((elt (car tail)))
+	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+	  (setq found t value (if (consp elt) (cdr elt) default))))
+      (setq tail (cdr tail)))
+    value))
+
+(defun assoc-ignore-case (key alist)
+  "Like `assoc', but ignores differences in case and text representation.
+KEY must be a string.  Upper-case and lower-case letters are treated as equal."
+  (let (element)
+    (while (and alist (not element))
+      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t))
+	  (setq element (car alist)))
+      (setq alist (cdr alist)))
+    element))
+
+(defun assoc-ignore-representation (key alist)
+  "Like `assoc', but ignores differences in text representation.
+KEY must be a string."
+  (let (element)
+    (while (and alist (not element))
+      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil))
+	  (setq element (car alist)))
+      (setq alist (cdr alist)))
+    element))
+
+(defun member-ignore-case (elt list)
+  "Like `member', but ignores differences in case and text representation.
+ELT must be a string.  Upper-case and lower-case letters are treated as equal."
+  (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t))))
+    (setq list (cdr list)))
+  list)
+
+
 ;;;; Keymap support.
 ;; XEmacs: removed to keymap.el
 
@@ -85,8 +171,22 @@
 
 ;; XEmacs: This stuff is done in C Code.
 
-;;;; Obsolescent names for functions.
-;; XEmacs: not used.
+;;;; Obsolescent names for functions generally appear elsewhere, in
+;;;; obsolete.el or in the files they are related do.  Many very old
+;;;; obsolete stuff has been removed entirely (e.g. anything with `dot' in
+;;;; place of `point').
+
+; alternate names (not obsolete)
+(if (not (fboundp 'mod)) (define-function 'mod '%))
+(define-function 'move-marker 'set-marker)
+(define-function 'beep 'ding)		; preserve lingual purity
+(define-function 'indent-to-column 'indent-to)
+(define-function 'backward-delete-char 'delete-backward-char)
+(define-function 'search-forward-regexp (symbol-function 're-search-forward))
+(define-function 'search-backward-regexp (symbol-function 're-search-backward))
+(define-function 'remove-directory 'delete-directory)
+(define-function 'set-match-data 'store-match-data)
+(define-function 'send-string-to-terminal 'external-debugging-output)
 
 ;; XEmacs:
 (defun local-variable-if-set-p (sym buffer)
@@ -103,6 +203,11 @@
 
 (defun make-local-hook (hook)
   "Make the hook HOOK local to the current buffer.
+The return value is HOOK.
+
+You never need to call this function now that `add-hook' does it for you
+if its LOCAL argument is non-nil.
+
 When a hook is local, its local and global values
 work in concert: running the hook actually runs all the hook
 functions listed in *either* the local value *or* the global value
@@ -118,14 +223,13 @@
 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))
     (make-local-variable hook)
-    (set hook (list t))))
+    (set hook (list t)))
+  hook)
 
 (defun add-hook (hook function &optional append local)
   "Add to the value of HOOK the function FUNCTION.
@@ -136,7 +240,7 @@
 
 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.
+This makes the hook buffer-local if needed.
 To make a hook variable buffer-local, always use
 `make-local-hook', not `make-local-variable'.
 
@@ -146,35 +250,27 @@
 
 You can remove this hook yourself using `remove-hook'.
 
-See also `add-local-hook' and `add-one-shot-hook'."
+See also `add-one-shot-hook'."
   (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.
-  (let ((old (symbol-value hook)))
-    (if (or (not (listp old)) (eq (car old) 'lambda))
-	(set hook (list old))))
-  (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-if-set-p hook (current-buffer)) ; XEmacs
-	       (not (memq t (symbol-value hook)))))
-      ;; Alter the local value only.
-      (or (if (consp function)
-	      (member function (symbol-value hook))
-	    (memq function (symbol-value hook)))
-	  (set hook
-	       (if append
-		   (append (symbol-value hook) (list function))
-		 (cons function (symbol-value hook)))))
-    ;; Alter the global value (which is also the only value,
-    ;; if the hook doesn't have a local value).
-    (or (if (consp function)
-	    (member function (default-value hook))
-	  (memq function (default-value hook)))
-	(set-default hook
-		     (if append
-			 (append (default-value hook) (list function))
-		       (cons function (default-value hook)))))))
+  (if local (unless (local-variable-if-set-p hook (current-buffer)) ; XEmacs
+	      (make-local-hook hook))
+    ;; Detect the case where make-local-variable was used on a hook
+    ;; and do what we used to do.
+    (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+      (setq local t)))
+  (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+    ;; If the hook value is a single function, turn it into a list.
+    (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+      (setq hook-value (list hook-value)))
+    ;; Do the actual addition if necessary
+    (unless (member function hook-value)
+      (setq hook-value
+	    (if append
+		(append hook-value (list function))
+	      (cons function hook-value))))
+    ;; Set the actual variable
+    (if local (set hook hook-value) (set-default hook hook-value))))
 
 (defun remove-hook (hook function &optional local)
   "Remove from the value of HOOK the function FUNCTION.
@@ -184,73 +280,54 @@
 
 The optional third 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.
+This makes the hook buffer-local if needed.
 To make a hook variable buffer-local, always use
 `make-local-hook', not `make-local-variable'."
-  (if (or (not (boundp hook))		;unbound symbol, or
-	  (not (default-boundp 'hook))
-	  (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)))))))
+  (or (boundp hook) (set hook nil))
+  (or (default-boundp hook) (set-default hook nil))
+  (if local (unless (local-variable-if-set-p hook (current-buffer)) ; XEmacs
+	      (make-local-hook hook))
+    ;; Detect the case where make-local-variable was used on a hook
+    ;; and do what we used to do.
+    (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+      (setq local t)))
+  (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+    ;; Remove the function, for both the list and the non-list cases.
+    ;; XEmacs: add hook-test, for handling one-shot hooks.
+    (flet ((hook-test
+	     (fn hel)
+	     (or (equal fn hel)
+		 (and (symbolp hel)
+		      (equal fn
+			     (get hel 'one-shot-hook-fun))))))
+      (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+	  (if (equal hook-value function) (setq hook-value nil))
+	(setq hook-value (delete* function (copy-sequence hook-value)
+				  :test 'hook-test)))
+      ;; If the function is on the global hook, we need to shadow it locally
+      ;;(when (and local (member* function (default-value hook)
+      ;;                          :test 'hook-test)
+      ;;	       (not (member* (cons 'not function) hook-value
+      ;;                             :test 'hook-test)))
+      ;;  (push (cons 'not function) hook-value))
+      ;; Set the actual variable
+      (if local (set hook hook-value) (set-default hook hook-value)))))
 
 ;; 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)
+You don't need this any more.  It's equivalent to specifying the LOCAL
+argument to `add-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)))
+You don't need this any more.  It's equivalent to specifying the LOCAL
+argument to `remove-hook'."
+  (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.
@@ -267,7 +344,7 @@
 
 You can remove this hook yourself using `remove-hook'.
 
-See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'."
+See also `add-hook'."
   (let ((sym (gensym)))
     (fset sym `(lambda (&rest args)
 		 (unwind-protect
@@ -278,27 +355,8 @@
 
 (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)
+You don't need this any more.  It's equivalent to specifying the LOCAL
+argument to `add-one-shot-hook'."
   (add-one-shot-hook hook function append t))
 
 (defun add-to-list (list-var element &optional append)
@@ -320,6 +378,8 @@
              (append (symbol-value list-var) (list element))
            (cons element (symbol-value list-var))))))
 
+;; END SYNCHED WITH FSF 21.2
+
 ;; XEmacs additions
 ;; called by Fkill_buffer()
 (defvar kill-buffer-hook nil
@@ -368,22 +428,234 @@
   (with-current-buffer buffer
     (set sym val)))
 
-;;;; String functions.
+
+;; BEGIN SYNCHED WITH FSF 21.2
+
+;; #### #### #### AAaargh!  Must be in C, because it is used insanely
+;; early in the bootstrap process.
+;(defun split-path (path)
+;  "Explode a search path into a list of strings.
+;The path components are separated with the characters specified
+;with `path-separator'."
+;  (while (or (not stringp path-separator)
+;	     (/= (length path-separator) 1))
+;    (setq path-separator (signal 'error (list "\
+;`path-separator' should be set to a single-character string"
+;					      path-separator))))
+;  (split-string-by-char path (aref separator 0)))
+
+(defmacro with-current-buffer (buffer &rest body)
+  "Temporarily make BUFFER the current buffer and execute the forms in BODY.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+  `(save-current-buffer
+     (set-buffer ,buffer)
+     ,@body))
+
+(defmacro with-temp-file (filename &rest forms)
+  "Create a new buffer, evaluate FORMS there, and write the buffer to FILENAME.
+The value of the last form in FORMS is returned, like `progn'.
+See also `with-temp-buffer'."
+  (let ((temp-file (make-symbol "temp-file"))
+	(temp-buffer (make-symbol "temp-buffer")))
+    `(let ((,temp-file ,filename)
+	   (,temp-buffer
+	    (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+       (unwind-protect
+	   (prog1
+	       (with-current-buffer ,temp-buffer
+		 ,@forms)
+	     (with-current-buffer ,temp-buffer
+               (widen)
+	       (write-region (point-min) (point-max) ,temp-file nil 0)))
+	 (and (buffer-name ,temp-buffer)
+	      (kill-buffer ,temp-buffer))))))
+
+;; FSF compatibility
+(defmacro with-temp-message (message &rest body)
+  "Display MESSAGE temporarily while BODY is evaluated.
+The original message is restored to the echo area after BODY has finished.
+The value returned is the value of the last form in BODY.
+If MESSAGE is nil, the echo area and message log buffer are unchanged.
+Use a MESSAGE of \"\" to temporarily clear the echo area.
 
-;; XEmacs
-(defun string-equal-ignore-case (str1 str2)
-  "Return t if two strings have identical contents, ignoring case differences.
-Case is not significant.  Text properties and extents are ignored.
-Symbols are also allowed; their print names are used instead.
+Note that this function exists for FSF compatibility purposes.  A better way
+under XEmacs is to give the message a particular label (see `display-message');
+then, the old message is automatically restored when you clear your message
+with `clear-message'."
+;; FSF additional doc string from 21.2:
+;; MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
+  (let ((current-message (make-symbol "current-message"))
+	(temp-message (make-symbol "with-temp-message")))
+    `(let ((,temp-message ,message)
+	   (,current-message))
+       (unwind-protect
+	   (progn
+	     (when ,temp-message
+	       (setq ,current-message (current-message))
+	       (message "%s" ,temp-message))
+	     ,@body)
+	 (and ,temp-message ,current-message
+	      (message "%s" ,current-message))))))
+
+(defmacro with-temp-buffer (&rest forms)
+  "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+  (let ((temp-buffer (make-symbol "temp-buffer")))
+    `(let ((,temp-buffer
+	    (get-buffer-create (generate-new-buffer-name " *temp*"))))
+       (unwind-protect
+	   (with-current-buffer ,temp-buffer
+	     ,@forms)
+	 (and (buffer-name ,temp-buffer)
+	      (kill-buffer ,temp-buffer))))))
+
+(defmacro with-output-to-string (&rest body)
+  "Execute BODY, return the text it sent to `standard-output', as a string."
+  `(let ((standard-output
+	  (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+     (let ((standard-output standard-output))
+       ,@body)
+     (with-current-buffer standard-output
+       (prog1
+	   (buffer-string)
+	 (kill-buffer nil)))))
+
+;; FSF 21.2.
+
+; (defmacro combine-after-change-calls (&rest body)
+;   "Execute BODY, but don't call the after-change functions till the end.
+; If BODY makes changes in the buffer, they are recorded
+; and the functions on `after-change-functions' are called several times
+; when BODY is finished.
+; The return value is the value of the last form in BODY.
+
+; If `before-change-functions' is non-nil, then calls to the after-change
+; functions can't be deferred, so in that case this macro has no effect.
+
+; Do not alter `after-change-functions' or `before-change-functions'
+; in BODY."
+;   `(unwind-protect
+;        (let ((combine-after-change-calls t))
+; 	 . ,body)
+;      (combine-after-change-execute)))
 
-See also `equalp'."
-  (if (symbolp str1)
-      (setq str1 (symbol-name str1)))
-  (if (symbolp str2)
-      (setq str2 (symbol-name str2)))
-  (eq t (compare-strings str1 nil nil str2 nil nil t)))
+(defmacro with-syntax-table (table &rest body)
+  "Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+  (let ((old-table (make-symbol "table"))
+	(old-buffer (make-symbol "buffer")))
+    `(let ((,old-table (syntax-table))
+	   (,old-buffer (current-buffer)))
+       (unwind-protect
+	   (progn
+	     (set-syntax-table (copy-syntax-table ,table))
+	     ,@body)
+	 (save-current-buffer
+	   (set-buffer ,old-buffer)
+	   (set-syntax-table ,old-table))))))
+
+(put 'with-syntax-table 'lisp-indent-function 1)
+(put 'with-syntax-table 'edebug-form-spec '(form body))
+
+
+;; Moved from mule-coding.el.
+(defmacro with-string-as-buffer-contents (str &rest body)
+  "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)))
+
+
+(defmacro save-match-data (&rest body)
+  "Execute BODY forms, restoring the global value of the match data."
+  (let ((original (make-symbol "match-data")))
+    (list 'let (list (list original '(match-data)))
+	  (list 'unwind-protect
+		(cons 'progn body)
+		(list 'store-match-data original)))))
+
+
+(defun match-string (num &optional string)
+  "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+  (if (match-beginning num)
+      (if string
+          (substring string (match-beginning num) (match-end num))
+        (buffer-substring (match-beginning num) (match-end num)))))
 
-;; XEmacs
+(defun match-string-no-properties (num &optional string)
+  "Return string of text matched by last search, without text properties.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+  (if (match-beginning num)
+      (if string
+	  (let ((result
+		 (substring string (match-beginning num) (match-end num))))
+	    (set-text-properties 0 (length result) nil result)
+	    result)
+	(buffer-substring-no-properties (match-beginning num)
+					(match-end num)))))
+
+(defun split-string (string &optional separators)
+  "Splits STRING into substrings where there are matches for SEPARATORS.
+Each match for SEPARATORS is a splitting point.
+The substrings between the splitting points are made into a list
+which is returned.
+If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
+
+If there is match for SEPARATORS at the beginning of STRING, we do not
+include a null substring for that.  Likewise, if there is a match
+at the end of STRING, we don't include a null substring for that.
+
+Modifies the match data; use `save-match-data' if necessary."
+  (let ((rexp (or separators "[ \f\t\n\r\v]+"))
+	(start 0)
+	notfirst
+	(list nil))
+    (while (and (string-match rexp string
+			      (if (and notfirst
+				       (= start (match-beginning 0))
+				       (< start (length string)))
+				  (1+ start) start))
+		(< (match-beginning 0) (length string)))
+      (setq notfirst t)
+      (or (eq (match-beginning 0) 0)
+	  (and (eq (match-beginning 0) (match-end 0))
+	       (eq (match-beginning 0) start))
+	  (setq list
+		(cons (substring string start (match-beginning 0))
+		      list)))
+      (setq start (match-end 0)))
+    (or (eq start (length string))
+	(setq list
+	      (cons (substring string start)
+		    list)))
+    (nreverse list)))
+
+(defun subst-char-in-string (fromchar tochar string &optional inplace)
+  "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+Unless optional argument INPLACE is non-nil, return a new string."
+  (let ((i (length string))
+	(newstr (if inplace string (copy-sequence string))))
+    (while (> i 0)
+      (setq i (1- i))
+      (if (eq (aref newstr i) fromchar)
+	  (aset newstr i tochar)))
+    newstr))
+
+
+;; XEmacs addition:
 (defun replace-in-string (str regexp newtext &optional literal)
   "Replace all matches in STR for REGEXP with NEWTEXT string,
  and returns the new string.
@@ -416,112 +688,80 @@
 	      str newstr))
       str)))
 
-(defun split-string (string &optional pattern)
-  "Return a list of substrings of STRING which are separated by PATTERN.
-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))))
-      (setq parts (cons (substring string start (match-beginning 0)) parts)
-	    start (match-end 0)))
-    (nreverse (cons (substring string start) parts))))
+(defun replace-regexp-in-string (regexp rep string &optional
+					fixedcase literal subexp start)
+  "Replace all matches for REGEXP with REP in STRING.
+
+Return a new string containing the replacements.
+
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'.  If START
+is non-nil, start replacements at that index in STRING.
 
-;; #### #### #### AAaargh!  Must be in C, because it is used insanely
-;; early in the bootstrap process.
-;(defun split-path (path)
-;  "Explode a search path into a list of strings.
-;The path components are separated with the characters specified
-;with `path-separator'."
-;  (while (or (not stringp path-separator)
-;	     (/= (length path-separator) 1))
-;    (setq path-separator (signal 'error (list "\
-;`path-separator' should be set to a single-character string"
-;					      path-separator))))
-;  (split-string-by-char path (aref separator 0)))
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function.  If it is a function it is applied to each match to generate
+the replacement passed to `replace-match'; the match-data at this
+point are such that match 0 is the function's argument.
 
-(defmacro with-output-to-string (&rest body)
-  "Execute BODY, return the text it sent to `standard-output', as a string."
-  `(let ((standard-output
-	  (get-buffer-create (generate-new-buffer-name " *string-output*"))))
-     (let ((standard-output standard-output))
-       ,@body)
-     (with-current-buffer standard-output
-       (prog1
-	   (buffer-string)
-	 (kill-buffer nil)))))
-
-(defmacro with-current-buffer (buffer &rest body)
-  "Temporarily make BUFFER the current buffer and execute the forms in BODY.
-The value returned is the value of the last form in BODY.
-See also `with-temp-buffer'."
-  `(save-current-buffer
-     (set-buffer ,buffer)
-     ,@body))
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+  (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
+    => \" bar foo\"
+"
 
-(defmacro with-temp-file (filename &rest forms)
-  "Create a new buffer, evaluate FORMS there, and write the buffer to FILENAME.
-The value of the last form in FORMS is returned, like `progn'.
-See also `with-temp-buffer'."
-  (let ((temp-file (make-symbol "temp-file"))
-	(temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-file ,filename)
-	   (,temp-buffer
-	    (get-buffer-create (generate-new-buffer-name " *temp file*"))))
-       (unwind-protect
-	   (prog1
-	       (with-current-buffer ,temp-buffer
-		 ,@forms)
-	     (with-current-buffer ,temp-buffer
-               (widen)
-	       (write-region (point-min) (point-max) ,temp-file nil 0)))
-	 (and (buffer-name ,temp-buffer)
-	      (kill-buffer ,temp-buffer))))))
+  ;; To avoid excessive consing from multiple matches in long strings,
+  ;; don't just call `replace-match' continually.  Walk down the
+  ;; string looking for matches of REGEXP and building up a (reversed)
+  ;; list MATCHES.  This comprises segments of STRING which weren't
+  ;; matched interspersed with replacements for segments that were.
+  ;; [For a `large' number of replacments it's more efficient to
+  ;; operate in a temporary buffer; we can't tell from the function's
+  ;; args whether to choose the buffer-based implementation, though it
+  ;; might be reasonable to do so for long enough STRING.]
+  (let ((l (length string))
+	(start (or start 0))
+	matches str mb me)
+    (save-match-data
+      (while (and (< start l) (string-match regexp string start))
+	(setq mb (match-beginning 0)
+	      me (match-end 0))
+	;; If we matched the empty string, make sure we advance by one char
+	(when (= me mb) (setq me (min l (1+ mb))))
+	;; Generate a replacement for the matched substring.
+	;; Operate only on the substring to minimize string consing.
+	;; Set up match data for the substring for replacement;
+	;; presumably this is likely to be faster than munging the
+	;; match data directly in Lisp.
+	(string-match regexp (setq str (substring string mb me)))
+	(setq matches
+	      (cons (replace-match (if (stringp rep)
+				       rep
+				     (funcall rep (match-string 0 str)))
+				   fixedcase literal str subexp)
+		    (cons (substring string start mb) ; unmatched prefix
+			  matches)))
+	(setq start me))
+      ;; Reconstruct a string from the pieces.
+      (setq matches (cons (substring string start l) matches)) ; leftover
+      (apply #'concat (nreverse matches)))))
 
-(defmacro with-temp-message (message &rest body)
-  "Display MESSAGE temporarily while BODY is evaluated.
-The original message is restored to the echo area after BODY has finished.
-The value returned is the value of the last form in BODY."
-  (let ((current-message (make-symbol "current-message"))
-	(temp-message (make-symbol "with-temp-message")))
-    `(let ((,temp-message ,message)
-	   (,current-message))
-       (unwind-protect
-	   (progn
-	     (when ,temp-message
-	       (setq ,current-message (current-message))
-	       (message "%s" ,temp-message))
-	     ,@body)
-	 (and ,temp-message ,current-message
-	      (message "%s" ,current-message))))))
+;; END SYNCHED WITH FSF 21.2
+
+
+;;; Basic string functions
 
-(defmacro with-temp-buffer (&rest forms)
-  "Create a temporary buffer, and evaluate FORMS there like `progn'.
-See also `with-temp-file' and `with-output-to-string'."
-  (let ((temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-buffer
-	    (get-buffer-create (generate-new-buffer-name " *temp*"))))
-       (unwind-protect
-	   (with-current-buffer ,temp-buffer
-	     ,@forms)
-	 (and (buffer-name ,temp-buffer)
-	      (kill-buffer ,temp-buffer))))))
+;; XEmacs
+(defun string-equal-ignore-case (str1 str2)
+  "Return t if two strings have identical contents, ignoring case differences.
+Case is not significant.  Text properties and extents are ignored.
+Symbols are also allowed; their print names are used instead.
 
-;; Moved from mule-coding.el.
-(defmacro with-string-as-buffer-contents (str &rest body)
-  "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)))
+See also `equalp'."
+  (if (symbolp str1)
+      (setq str1 (symbol-name str1)))
+  (if (symbolp str2)
+      (setq str2 (symbol-name str2)))
+  (eq t (compare-strings str1 nil nil str2 nil nil t)))
 
 (defun insert-face (string face)
   "Insert STRING and highlight with FACE.  Return the extent created."
@@ -606,7 +846,7 @@
 ;; From FSF 21.1; ELLIPSES is XEmacs addition.
 
 (defun truncate-string-to-width (str end-column &optional start-column padding
-				     ellipses)
+				 ellipses)
   "Truncate string STR to end at column END-COLUMN.
 The optional 3rd arg START-COLUMN, if non-nil, specifies
 the starting column; that means to return the characters occupying
@@ -1224,6 +1464,8 @@
     ;; Probably the old way.
     (buffer-substring buffer old-end old-buffer))))
 
+;; BEGIN SYNC WITH FSF 21.2
+
 ;; This was not present before.  I think Jamie had some objections
 ;; to this, so I'm leaving this undefined for now. --ben
 
@@ -1244,7 +1486,13 @@
 This makes or adds to an entry on `after-load-alist'.
 If FILE is already loaded, evaluate FORM right now.
 It does nothing if FORM is already on the list for FILE.
-FILE should be the name of a library, with no directory name."
+FILE must match exactly.  Normally FILE is the name of a library,
+with no directory or extension specified, since that is how `load'
+is normally called."
+  ;; Make sure `load-history' contains the files dumped with Emacs
+  ;; for the case that FILE is one of the files dumped with Emacs.
+  (if-fboundp 'load-symbol-file-load-history
+      (load-symbol-file-load-history))
   ;; Make sure there is an element for FILE.
   (or (assoc file after-load-alist)
       (setq after-load-alist (cons (list file) after-load-alist)))
@@ -1266,16 +1514,6 @@
   (eval-after-load file (read)))
 (make-compatible 'eval-next-after-load "")
 
-; alternate names (not obsolete)
-(if (not (fboundp 'mod)) (define-function 'mod '%))
-(define-function 'move-marker 'set-marker)
-(define-function 'beep 'ding)		; preserve lingual purity
-(define-function 'indent-to-column 'indent-to)
-(define-function 'backward-delete-char 'delete-backward-char)
-(define-function 'search-forward-regexp (symbol-function 're-search-forward))
-(define-function 'search-backward-regexp (symbol-function 're-search-backward))
-(define-function 'remove-directory 'delete-directory)
-(define-function 'set-match-data 'store-match-data)
-(define-function 'send-string-to-terminal 'external-debugging-output)
+;; END SYNC WITH FSF 21.2
 
 ;;; subr.el ends here