X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a9853251a342e86260db1005fb0b55639ad7a426..0b2cf11f544cf39b7e79ca9a049027557f6921a0:/lisp/subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 29af26732d..4d0cef6a08 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -135,6 +135,22 @@ If N is bigger than the length of X, return X."
       (setq x (cdr x)))
     x))
 
+(defun remove (elt seq)
+  "Return a copy of SEQ with all occurences of ELT removed.
+SEQ must be a list, vector, or string.  The comparison is done with `equal'."
+  (if (nlistp seq)
+      ;; If SEQ isn't a list, there's no need to copy SEQ because
+      ;; `delete' will return a new object.
+      (delete elt seq)
+    (delete elt (copy-sequence seq))))
+
+(defun remq (elt list)
+  "Return a copy of LIST with all occurences of ELT removed.
+The comparison is done with `eq'."
+  (if (memq elt list)
+      (delq elt (copy-sequence list))
+    list))
+
 (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,
@@ -174,6 +190,18 @@ Unibyte strings are converted to multibyte for comparison."
 	  (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.
+Unibyte strings are converted to multibyte for comparison."
+  (let (element)
+    (while (and list (not element))
+      (if (eq t (compare-strings elt 0 nil (car list) 0 nil t))
+	  (setq element (car list)))
+      (setq list (cdr list)))
+      element))
+
 
 ;;;; Keymap support.
 
@@ -214,8 +242,15 @@ but optional second arg NODIGITS non-nil treats them like other chars."
 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
-If optional fourth argument OLDMAP is specified, we redefine
+Alternatively, if optional fourth argument OLDMAP is specified, we redefine
 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
+  ;; Don't document PREFIX in the doc string because we don't want to
+  ;; advertise it.  It's meant for recursive calls only.  Here's its
+  ;; meaning
+  
+  ;; If optional argument PREFIX is specified, it should be a key
+  ;; prefix, a string.  Redefined bindings will then be bound to the
+  ;; original key, with PREFIX added at the front.
   (or prefix (setq prefix ""))
   (let* ((scan (or oldmap keymap))
 	 (vec1 (vector nil))
@@ -596,8 +631,8 @@ as returned by the `event-start' and `event-end' functions."
 (defalias 'define-function 'defalias)
 
 (defalias 'sref 'aref)
-(make-obsolete 'sref 'aref)
-(make-obsolete 'char-bytes "Now this function always returns 1")
+(make-obsolete 'sref 'aref "20.4")
+(make-obsolete 'char-bytes "Now this function always returns 1" "20.4")
 
 ;; Some programs still use this as a function.
 (defun baud-rate ()
@@ -623,6 +658,7 @@ Please convert your programs to use the variable `baud-rate' directly."
 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
 (defalias 'int-to-string 'number-to-string)
 (defalias 'store-match-data 'set-match-data)
+;; These are the XEmacs names:
 (defalias 'point-at-eol 'line-end-position)
 (defalias 'point-at-bol 'line-beginning-position)
 
@@ -668,7 +704,7 @@ 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.
+This makes the hook buffer-local if needed.
 To make a hook variable buffer-local, always use
 `make-local-hook', not `make-local-variable'.
 
@@ -677,32 +713,23 @@ 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."
   (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)
-	       (not (memq t (symbol-value hook)))))
-      ;; Alter the local value only.
-      (or (if (or (consp function) (byte-code-function-p 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 (or (consp function) (byte-code-function-p 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 (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.
@@ -712,34 +739,27 @@ list of hooks to run in HOOK, then nothing is done.  See `add-hook'.
 
 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.
-    (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)
-		  (consp (symbol-value hook))
-		  (not (memq t (symbol-value hook)))))
-	(let ((hook-value (symbol-value hook)))
-	  (if (consp 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)))))
+  (or (boundp hook) (set hook nil))
+  (or (default-boundp hook) (set-default hook nil))
+  (if local (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.
+    (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))))
+    ;; If the function is on the global hook, we need to shadow it locally
+    ;;(when (and local (member function (default-value hook))
+    ;;	       (not (member (cons 'not function) hook-value)))
+    ;;  (push (cons 'not function) hook-value))
+    ;; Set the actual variable
+    (if local (set hook hook-value) (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.
@@ -872,7 +892,7 @@ Optional DEFAULT is a default password to use instead of empty input."
       (while (progn (message "%s%s"
 			     prompt
 			     (make-string (length pass) ?.))
-		    (setq c (read-char nil t))
+		    (setq c (read-char-exclusive nil t))
 		    (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
 	(if (= c ?\C-u)
 	    (setq pass "")
@@ -1089,6 +1109,35 @@ in BODY."
 	 . ,body)
      (combine-after-change-execute)))
 
+
+(defvar combine-run-hooks t
+  "List of hooks delayed. Or t if we're not delaying hooks.")
+
+(defmacro combine-run-hooks (&rest body)
+  "Execute BODY, but delay any `run-hooks' until the end."
+  (let ((saved-combine-run-hooks (make-symbol "saved-combine-run-hooks"))
+	(saved-run-hooks (make-symbol "saved-run-hooks")))
+    `(let ((,saved-combine-run-hooks combine-run-hooks)
+	   (,saved-run-hooks (symbol-function 'run-hooks)))
+       (unwind-protect
+	   (progn
+	     ;; If we're not delaying hooks yet, setup the delaying mode
+	     (unless (listp combine-run-hooks)
+	       (setq combine-run-hooks nil)
+	       (fset 'run-hooks
+		     ,(lambda (&rest hooks)
+			(setq combine-run-hooks
+			      (append combine-run-hooks hooks)))))
+	     ,@body)
+	 ;; If we were not already delaying, then it's now time to set things
+	 ;; back to normal and to execute the delayed hooks.
+	 (unless (listp ,saved-combine-run-hooks)
+	   (setq ,saved-combine-run-hooks combine-run-hooks)
+	   (fset 'run-hooks ,saved-run-hooks)
+	   (setq combine-run-hooks t)
+	   (apply 'run-hooks ,saved-combine-run-hooks))))))
+
+
 (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
@@ -1196,8 +1245,8 @@ Unless optional argument INPLACE is non-nil, return a new string."
 	  (aset newstr i tochar)))
     newstr))
 
-(defun replace-regexps-in-string (regexp rep string &optional
-					 fixedcase literal subexp start)
+(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.
@@ -1211,7 +1260,11 @@ 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.
 
-To replace a single match, make REGEXP match up to \\'."
+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\"
+"
 
   ;; To avoid excessive consing from multiple matches in long strings,
   ;; don't just call `replace-match' continually.  Walk down the
@@ -1440,4 +1493,80 @@ If DIR-FLAG is non-nil, create a new empty directory instead of a file."
       nil)
     file))
 
+
+(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+  "Register a new minor mode.
+
+This is an XEmacs-compatibility function.  Use `define-minor-mode' instead.
+
+TOGGLE is a symbol which is the name of a buffer-local variable that
+is toggled on or off to say whether the minor mode is active or not.
+
+NAME specifies what will appear in the mode line when the minor mode
+is active.  NAME should be either a string starting with a space, or a
+symbol whose value is such a string.
+
+Optional KEYMAP is the keymap for the minor mode that will be added
+to `minor-mode-map-alist'.
+
+Optional AFTER specifies that TOGGLE should be added after AFTER
+in `minor-mode-alist'.
+
+Optional TOGGLE-FUN is an interactive function to toggle the mode.
+It defaults to (and should by convention be) TOGGLE.
+
+If TOGGLE has a non-nil `:included' property, an entry for the mode is
+included in the mode-line minor mode menu.
+If TOGGLE has a `:menu-tag', that is used for the menu item's label."
+  (unless toggle-fun (setq toggle-fun toggle))
+  ;; Add the toggle to the minor-modes menu if requested.
+  (when (get toggle :included)
+    (define-key mode-line-mode-menu
+      (vector toggle)
+      (list 'menu-item
+	    (or (get toggle :menu-tag)
+		(if (stringp name) name (symbol-name toggle)))
+	    toggle-fun
+	    :button (cons :toggle toggle))))
+  ;; Add the name to the minor-mode-alist.
+  (when name
+    (let ((existing (assq toggle minor-mode-alist)))
+      (when (and (stringp name) (not (get-text-property 0 'local-map name)))
+	(setq name
+	      (apply 'propertize name
+		     'local-map (make-mode-line-mouse2-map toggle-fun)
+		     (unless (get-text-property 0 'help-echo name)
+		       (list 'help-echo
+			     (format "mouse-2: turn off %S" toggle))))))
+      (if existing
+	  (setcdr existing (list name))
+	(let ((tail minor-mode-alist) found)
+	  (while (and tail (not found))
+	    (if (eq after (caar tail))
+		(setq found tail)
+	      (setq tail (cdr tail))))
+	  (if found
+	      (let ((rest (cdr found)))
+		(setcdr found nil)
+		(nconc found (list (list toggle name)) rest))
+	    (setq minor-mode-alist (cons (list toggle name)
+					 minor-mode-alist)))))))
+  ;; Add the map to the minor-mode-map-alist.    
+  (when keymap
+    (let ((existing (assq toggle minor-mode-map-alist)))
+      (if existing
+	  (setcdr existing keymap)
+	(let ((tail minor-mode-map-alist) found)
+	  (while (and tail (not found))
+	    (if (eq after (caar tail))
+		(setq found tail)
+	      (setq tail (cdr tail))))
+	  (if found
+	      (let ((rest (cdr found)))
+		(setcdr found nil)
+		(nconc found (list (cons toggle keymap)) rest))
+	    (setq minor-mode-map-alist (cons (cons toggle keymap)
+					     minor-mode-map-alist))))))))
+
+
 ;;; subr.el ends here