(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))
(car scan)))))
(setq scan (cdr scan)))))
-(defun define-key-after (keymap key definition after)
+(defun define-key-after (keymap key definition &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
This is like `define-key' except that the binding for KEY is placed
just after the binding for the event AFTER, instead of at the beginning
of the map. Note that AFTER must be an event type (like KEY), NOT a command
\(like DEFINITION).
-If AFTER is t, the new binding goes at the end of the keymap.
+If AFTER is t or omitted, the new binding goes at the end of the keymap.
-KEY must contain just one event type--that is to say, it must be
-a string or vector of length 1.
+KEY must contain just one event type--that is to say, it must be a
+string or vector of length 1, but AFTER should be a single event
+type--a symbol or a character, not a sequence.
-The order of bindings in a keymap matters when it is used as a menu."
+Bindings are always added before any inherited map.
+The order of bindings in a keymap matters when it is used as a menu."
+ (unless after (setq after t))
(or (keymapp keymap)
(signal 'wrong-type-argument (list 'keymapp keymap)))
(if (> (length key) 1)
(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
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
- (if (= me mb)
- (setq start l ; Matched empty string -- bail out.
- matches (list string))
- ;; 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)))
+ ;; 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)))))
; (setq tail (cdr tail))))
; alist)
-(defun assoc-delete-all (key alist)
+(defun assq-delete-all (key alist)
"Delete from ALIST all elements whose car is KEY.
Return the modified alist."
- (setq alist (copy-sequence alist))
(let ((tail alist))
(while tail
(if (eq (car (car tail)) key)
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