Function: keymap-canonicalize

keymap-canonicalize is a byte-compiled function defined in subr.el.gz.

Signature

(keymap-canonicalize MAP)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/subr.el.gz
(defun keymap-canonicalize (map)
  "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."
  (declare (important-return-value t))
  ;; 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
                 (lambda (key item)
                   (if (consp key)
                       (if (= (car key) (1- (cdr key)))
                           ;; If we have a two-character range, then
                           ;; treat it as two separate characters
                           ;; (because this makes `describe-bindings'
                           ;; look better and shouldn't affect
                           ;; anything else).
                           (progn
                             (push (cons (car key) item) bindings)
                             (push (cons (cdr key) item) bindings))
                         ;; 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.  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))
             (oldbind (assq key 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)))