(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 ()
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)))))
nil)
file))
+\f
+(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+ "Register a new minor mode.
+
+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 there for compatiblity with other Emacsen.
+It is currently not used.
+
+In most cases, `define-minor-mode' should be used instead."
+ (when name
+ (let ((existing (assq toggle minor-mode-alist))
+ (name (if (symbolp name) (symbol-value name) name)))
+ (cond ((null existing)
+ (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)))))
+ (t
+ (setcdr existing (list name))))))
+
+ (when keymap
+ (let ((existing (assq toggle minor-mode-map-alist)))
+ (cond ((null existing)
+ (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)))))
+ (t
+ (setcdr existing keymap))))))
+
+
;;; subr.el ends here