master f16a85e317d: New property 'context-menu-functions' (bug#62250)

[Juri Linkov]

branch: master
commit f16a85e317d940aa2e0f0375ec5d1917cb04ade3
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    New property 'context-menu-functions' (bug#62250)
    
    * lisp/iimage.el (iimage-mode-buffer): Set context-menu-functions
    text property to '(image-context-menu)'.
    
    * lisp/image.el (image-context-menu): New function.
    (put-image): Set context-menu-functions overlay property
    to '(image-context-menu)'.
    (insert-image, insert-sliced-image): Set context-menu-functions
    text property to '(image-context-menu)'.
    
    * lisp/mouse.el (context-menu-map): Use mouse-posn-property
    'context-menu-functions' and call its funs at the end.
---
 etc/NEWS       |  4 ++++
 lisp/iimage.el |  1 +
 lisp/image.el  | 33 ++++++++++++++++++++++++++++++---
 lisp/mouse.el  | 14 ++++++++++----
 4 files changed, 45 insertions(+), 7 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..a4b42263c36 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2087,6 +2087,10 @@ treesitter grammar.
 ** New buffer-local variable 'tabulated-list-groups'.
 It controls display and separate sorting of groups of entries.
 
+---
+** New property 'context-menu-functions'.
+Like the variable with the same name it adds a list of context menus.
+
 
 * Changes in Emacs 30.1 on Non-Free Operating Systems
 
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 205141577c9..0f2297465fe 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -134,6 +134,7 @@ Examples of image filename patterns to match:
                                     :max-width (- (nth 2 edges) (nth 0 edges))
                                    :max-height (- (nth 3 edges) (nth 1 edges)))
                      keymap ,image-map
+                     context-menu-functions (image-context-menu)
                      modification-hooks
                      (iimage-modification-hook)))
                 (remove-list-of-text-properties
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..662e7eaf25d 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -193,6 +193,29 @@ or \"ffmpeg\") is installed."
         "h" #'image-flip-horizontally
         "v" #'image-flip-vertically))
 
+(defun image-context-menu (menu click)
+  "Populate MENU with image-related commands at CLICK."
+  (when (mouse-posn-property (event-start click) 'display)
+    (define-key menu [image-separator] menu-bar-separator)
+    (let ((easy-menu (make-sparse-keymap "Image")))
+      (easy-menu-define nil easy-menu nil
+        '("Image"
+          ["Zoom In" image-increase-size
+           :help "Enlarge the image"]
+          ["Zoom Out" image-decrease-size
+           :help "Shrink the image"]
+          ["Rotate Clockwise" image-rotate
+           :help "Rotate the image"]
+          ["Flip horizontally" image-flip-horizontally
+           :help "Flip horizontally"]
+          ["Flip vertically" image-flip-vertically
+           :help "Flip vertically"]))
+      (dolist (item (reverse (lookup-key easy-menu [menu-bar image])))
+        (when (consp item)
+          (define-key menu (vector (car item)) (cdr item))))))
+
+  menu)
+
 (defun image-load-path-for-library (library image &optional path no-error)
   "Return a suitable search path for images used by LIBRARY.
 
@@ -620,6 +643,7 @@ means display it in the right marginal area."
       (overlay-put overlay 'put-image t)
       (overlay-put overlay 'before-string string)
       (overlay-put overlay 'keymap image-map)
+      (overlay-put overlay 'context-menu-functions '(image-context-menu))
       overlay)))
 
 
@@ -672,8 +696,9 @@ is non-nil, this is inhibited."
                                   inhibit-isearch ,inhibit-isearch
                                    keymap ,(if slice
                                                image-slice-map
-                                             image-map)))))
-
+                                             image-map)
+                                   context-menu-functions
+                                   (image-context-menu)))))
 
 ;;;###autoload
 (defun insert-sliced-image (image &optional string area rows cols)
@@ -709,7 +734,9 @@ The image is automatically split into ROWS x COLS slices."
          (add-text-properties start (point)
                               `(display ,(list (list 'slice x y dx dy) image)
                                         rear-nonsticky (display keymap)
-                                         keymap ,image-slice-map))
+                                         keymap ,image-slice-map
+                                         context-menu-functions
+                                         (image-context-menu)))
          (setq x (+ x dx))))
       (setq x 0.0
            y (+ y dy))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index d1b06c2040d..26835437c08 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -414,13 +414,17 @@ 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))
-         (window (posn-window (event-start click)))
-         (fun (mouse-posn-property (event-start click)
-                                   'context-menu-function)))
+         (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))
@@ -430,7 +434,9 @@ the function `context-menu-filter-function'."
       (run-hook-wrapped 'context-menu-functions
                         (lambda (fun)
                           (setq menu (funcall fun menu click))
-                          nil)))
+                          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.