Function: context-menu-map

context-menu-map is a byte-compiled function defined in mouse.el.gz.

Signature

(context-menu-map &optional CLICK)

Documentation

Return menu map constructed for context near mouse CLICK.

The menu is populated by calling functions from context-menu-functions. Each function receives the menu and the mouse click event and returns the same menu after adding own menu items to the composite menu. When there is a text property context-menu-function at CLICK, it overrides all functions from context-menu-functions. Whereas the property context-menu-functions doesn't override the variable context-menu-functions, but adds menus from the list in the property after adding menus from the variable. At the end, it's possible to modify the final menu by specifying the function context-menu-filter-function.

Source Code

;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(defun context-menu-map (&optional click)
  "Return menu map constructed for context near mouse CLICK.
The menu is populated by calling functions from `context-menu-functions'.
Each function receives the menu and the mouse click event
and returns the same menu after adding own menu items to the composite menu.
When there is a text property `context-menu-function' at CLICK,
it overrides all functions from `context-menu-functions'.
Whereas the property `context-menu-functions' doesn't override
the variable `context-menu-functions', but adds menus from the
list in the property after adding menus from the variable.
At the end, it's possible to modify the final menu by specifying
the function `context-menu-filter-function'."
  (let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t)))
         (click (or click last-input-event))
         (start (event-start click))
         (window (posn-window start))
         (fun (mouse-posn-property start 'context-menu-function))
         (funs (mouse-posn-property start 'context-menu-functions)))

    (unless (eq (selected-window) window)
      (select-window window))

    (if (functionp fun)
        (setq menu (funcall fun menu click))
      (run-hook-wrapped 'context-menu-functions
                        (lambda (fun)
                          (setq menu (funcall fun menu click))
                          nil))
      (dolist (fun funs)
        (setq menu (funcall fun menu click))))

    ;; Remove duplicate separators as well as ones at the beginning or
    ;; end of the menu.
    (let ((l menu) (last-saw-separator t))
      (while (and (consp l)
                  (consp (cdr l)))
        (if (equal (cdr-safe (cadr l)) menu-bar-separator)
            (progn
              ;; The next item is a separator.  Remove it if the last
              ;; item we saw was a separator too.
              (if last-saw-separator
                  (setcdr l (cddr l))
                ;; If we didn't delete this separator, update the last
                ;; separator we saw to this one.
                (setq last-saw-separator l
                      l (cdr l))))
          ;; If the next item is a cons cell, we found a non-separator
          ;; item.  Don't remove the next separator we see.  We
          ;; specifically check for cons cells to avoid treating the
          ;; overall prompt string as a menu item.
          (when (consp (cadr l))
            (setq last-saw-separator nil))
          (setq l (cdr l))))
      ;; If the last item we saw was a separator, remove it.
      (when (consp last-saw-separator)
        (setcdr last-saw-separator (cddr last-saw-separator))))

    (when (functionp context-menu-filter-function)
      (setq menu (funcall context-menu-filter-function menu click)))
    menu))