Function: tmm-get-keymap

tmm-get-keymap is a byte-compiled function defined in tmm.el.gz.

Signature

(tmm-get-keymap ELT &optional IN-X-MENU)

Documentation

Prepend (DOCSTRING EVENT BINDING) to free variable tmm-km-list.

The values are deduced from the argument ELT, that should be an element of keymap, an x-popup-menu argument, or an element of x-popup-menu argument (when IN-X-MENU is not-nil). This function adds the element only if it is not already present. It uses the free variable tmm-table-undef to keep undefined keys.

Source Code

;; Defined in /usr/src/emacs/lisp/tmm.el.gz
(defun tmm-get-keymap (elt &optional in-x-menu)
  "Prepend (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
The values are deduced from the argument ELT, that should be an
element of keymap, an `x-popup-menu' argument, or an element of
`x-popup-menu' argument (when IN-X-MENU is not-nil).
This function adds the element only if it is not already present.
It uses the free variable `tmm-table-undef' to keep undefined keys."
  (let (km str plist filter visible enable (event (car elt)))
    (setq elt (cdr elt))
    (if (eq elt 'undefined)
	(setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
      (unless (assoc event tmm-table-undef)
	(cond ((or (functionp elt) (keymapp elt))
	       (setq km elt))

	      ((or (keymapp (cdr-safe elt)) (functionp (cdr-safe elt)))
	       (setq km (cdr elt))
	       (and (stringp (car elt)) (setq str (car elt))))

	      ((or (keymapp (cdr-safe (cdr-safe elt)))
		   (functionp (cdr-safe (cdr-safe elt))))
	       (setq km (cddr elt))
	       (and (stringp (car elt)) (setq str (car elt))))

	      ((eq (car-safe elt) 'menu-item)
	       ;; (menu-item TITLE COMMAND KEY ...)
	       (setq plist (cdr-safe (cdr-safe (cdr-safe elt))))
	       (when (consp (car-safe plist))
		 (setq plist (cdr-safe plist)))
	       (setq km (nth 2 elt))
	       (setq str (eval (nth 1 elt)))
	       (setq filter (plist-get plist :filter))
	       (if filter
		   (setq km (funcall filter km)))
	       (setq visible (plist-get plist :visible))
	       (if visible
		   (setq km (and (eval visible) km)))
	       (setq enable (plist-get plist :enable))
	       (if enable
                   (setq km (if (eval enable) km 'ignore))))

	      ((or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
		   (functionp (cdr-safe (cdr-safe (cdr-safe elt)))))
                                        ; New style of easy-menu
	       (setq km (cdr (cddr elt)))
	       (and (stringp (car elt)) (setq str (car elt))))

	      ((stringp event)		; x-popup or x-popup element
               (setq str event)
               (setq event nil)
	       (setq km (if (or in-x-menu (stringp (car-safe elt)))
                            elt (cons 'keymap elt)))))
        (unless (or (eq km 'ignore) (null str))
          (let ((binding (where-is-internal km nil t)))
            (when binding
              (setq binding (key-description binding))
              ;; Try to align the keybindings.
              (let* ((window (get-buffer-window "*Completions*"))
                     (colwidth (min 30 (- (/ (if window
                                                 (window-width window)
                                               (frame-width))
                                             2)
                                          10)))
                     (nspaces (max 2 (- colwidth
                                        (string-width str)
                                        (string-width binding)))))
                (setq str
                      (concat str
                              (propertize (make-string nspaces ?\s)
                                          'display
                                          (cons 'space (list :width nspaces)))
                              binding)))))))
      (and km (stringp km) (setq str km))
      ;; Verify that the command is enabled;
      ;; if not, don't mention it.
      (when (and km (symbolp km) (get km 'menu-enable))
	  (setq km (if (eval (get km 'menu-enable)) km 'ignore)))
      (and km str
	   (or (assoc str tmm-km-list)
	       (push (cons str (cons event km)) tmm-km-list))))))