(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,
(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))
+
\f
;;;; Keymap support.
(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))
(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 ()
(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)
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'.
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.
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.
(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 "")
. ,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
(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.
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
nil)
file))
+\f
+(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