]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
(toplevel): Support faces on tty's.
[gnu-emacs] / lisp / subr.el
index 88526bd98cc4f3ffd7249f4b63634c5727e6ba61..767e2a8cde3f452b823b246f73780eb4d7c31df1 100644 (file)
@@ -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,
@@ -226,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))
@@ -608,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 ()
@@ -680,7 +703,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'.
 
@@ -689,32 +712,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.
@@ -724,34 +738,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.
@@ -1485,4 +1492,61 @@ If DIR-FLAG is non-nil, create a new empty directory instead of a file."
       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