Clarify manual and `add-hook' doc string about buffer-local hooks

[bpt/emacs.git] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 4d2f3b1..a2f5604 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -490,6 +490,7 @@ SEQ must be a list, vector, or string.  The comparison is done with `equal'."
   "Return LIST with all occurrences of ELT removed.
 The comparison is done with `eq'.  Contrary to `delq', this does not use
 side-effects, and the argument LIST is not modified."
+  (while (and (eq elt (car list)) (setq list (cdr list))))
   (if (memq elt list)
       (delq elt (copy-sequence list))
     list))
@@ -591,31 +592,88 @@ Don't call this function; it is for internal use only."
     (dolist (p list)
       (funcall function (car p) (cdr p)))))
 
+(defun keymap--menu-item-binding (val)
+  "Return the binding part of a menu-item."
+  (cond
+   ((not (consp val)) val)              ;Not a menu-item.
+   ((eq 'menu-item (car val))
+    (let* ((binding (nth 2 val))
+           (plist (nthcdr 3 val))
+           (filter (plist-get plist :filter)))
+      (if filter (funcall filter binding)
+        binding)))
+   ((and (consp (cdr val)) (stringp (cadr val)))
+    (cddr val))
+   ((stringp (car val))
+    (cdr val))
+   (t val)))                            ;Not a menu-item either.
+
+(defun keymap--menu-item-with-binding (item binding)
+  "Build a menu-item like ITEM but with its binding changed to BINDING."
+  (cond
+   ((eq 'menu-item (car item))
+    (setq item (copy-sequence item))
+    (let ((tail (nthcdr 2 item)))
+      (setcar tail binding)
+      ;; Remove any potential filter.
+      (if (plist-get (cdr tail) :filter)
+          (setcdr tail (plist-put (cdr tail) :filter nil))))
+    item)
+   ((and (consp (cdr item)) (stringp (cadr item)))
+    (cons (car item) (cons (cadr item) binding)))
+   (t (cons (car item) binding))))
+
+(defun keymap--merge-bindings (val1 val2)
+  "Merge bindings VAL1 and VAL2."
+  (let ((map1 (keymap--menu-item-binding val1))
+        (map2 (keymap--menu-item-binding val2)))
+    (if (not (and (keymapp map1) (keymapp map2)))
+        ;; There's nothing to merge: val1 takes precedence.
+        val1
+      (let ((map (list 'keymap map1 map2))
+            (item (if (keymapp val1) (if (keymapp val2) nil val2) val1)))
+        (keymap--menu-item-with-binding item map)))))
+
 (defun keymap-canonicalize (map)
-  "Return an equivalent keymap, without inheritance."
+  "Return a simpler equivalent keymap.
+This resolves inheritance and redefinitions.  The returned keymap
+should behave identically to a copy of KEYMAP w.r.t `lookup-key'
+and use in active keymaps and menus.
+Subkeymaps may be modified but are not canonicalized."
+  ;; FIXME: Problem with the difference between a nil binding
+  ;; that hides a binding in an inherited map and a nil binding that's ignored
+  ;; to let some further binding visible.  Currently a nil binding hides all.
+  ;; FIXME: we may want to carefully (re)order elements in case they're
+  ;; menu-entries.
   (let ((bindings ())
         (ranges ())
        (prompt (keymap-prompt map)))
     (while (keymapp map)
-      (setq map (map-keymap-internal
+      (setq map (map-keymap ;; -internal
                  (lambda (key item)
                    (if (consp key)
                        ;; Treat char-ranges specially.
                        (push (cons key item) ranges)
                      (push (cons key item) bindings)))
                  map)))
+    ;; Create the new map.
     (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
     (dolist (binding ranges)
-      ;; Treat char-ranges specially.
+      ;; Treat char-ranges specially.  FIXME: need to merge as well.
       (define-key map (vector (car binding)) (cdr binding)))
+    ;; Process the bindings starting from the end.
     (dolist (binding (prog1 bindings (setq bindings ())))
       (let* ((key (car binding))
              (item (cdr binding))
              (oldbind (assq key bindings)))
-        ;; Newer bindings override older.
-        (if oldbind (setq bindings (delq oldbind bindings)))
-        (when item                      ;nil bindings just hide older ones.
-          (push binding bindings))))
+        (push (if (not oldbind)
+                  ;; The normal case: no duplicate bindings.
+                  binding
+                ;; This is the second binding for this key.
+                (setq bindings (delq oldbind bindings))
+                (cons key (keymap--merge-bindings (cdr binding)
+                                                  (cdr oldbind))))
+              bindings)))
     (nconc map bindings)))
 
 (put 'keyboard-translate-table 'char-table-extra-slots 0)
@@ -1204,10 +1262,10 @@ unless the optional argument APPEND is non-nil, in which case
 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 the hook buffer-local if needed, and it makes t a member
-of the buffer-local value.  That acts as a flag to run the hook
-functions in the default value as well as in the local value.
+the hook's buffer-local value rather than its global value.
+This makes the hook buffer-local, and it makes t a member of the
+buffer-local value.  That acts as a flag to run the hook
+functions of the global value as well as in the local value.
 
 HOOK should be a symbol, and FUNCTION may be any valid function.  If
 HOOK is void, it is first set to nil.  If HOOK's value is a single