master ac6afe9: Many improvements for Context Menus (bug#9054)

[Juri Linkov]

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

    Many improvements for Context Menus (bug#9054)
    
    * lisp/menu-bar.el (menu-bar-showhide-menu): Add "Context Menus".
    
    * lisp/mouse.el (context-menu-undo): Add "in Region" to the titles
    when the region is active.
    (context-menu-region): Use 'mouse-yank-from-menu' in menu items
    created from 'yank-menu' for submenu "Paste from Kill Menu".
    (context-menu-region): Add submenu "Select" with things to mark.
    (mark-thing-at-mouse, mouse-yank-from-menu): New functions.
    
    * lisp/thingatpt.el (bounds-of-thing-at-mouse): New function.
    
    * lisp/progmodes/elisp-mode.el (elisp-context-menu):
    * lisp/progmodes/prog-mode.el (prog-context-menu):
    Use full symbol/identifier names in :help strings.
    
    Suggested by Martin Rudalics <rudalics@gmx.at>
---
 lisp/menu-bar.el             |  5 +++
 lisp/mouse.el                | 77 ++++++++++++++++++++++++++++++++++++--------
 lisp/progmodes/elisp-mode.el | 19 +++++------
 lisp/progmodes/prog-mode.el  | 33 +++++++++----------
 lisp/thingatpt.el            | 27 ++++++++++------
 5 files changed, 111 insertions(+), 50 deletions(-)

diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index d863f34..07f7beb 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1315,6 +1315,11 @@ mail status in mode line"))
                   :visible (and (display-graphic-p) (fboundp 'x-show-tip))
                   :button (:toggle . tooltip-mode)))
 
+    (bindings--define-key menu [showhide-context-menu]
+      '(menu-item "Context Menus" context-menu-mode
+                  :help "Turn mouse-3 context menus on/off"
+                  :button (:toggle . context-menu-mode)))
+
     (bindings--define-key menu [menu-bar-mode]
       '(menu-item "Menu Bar" toggle-menu-bar-mode-from-frame
                   :help "Turn menu bar on/off"
diff --git a/lisp/mouse.el b/lisp/mouse.el
index f33a73f..edac508 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -418,16 +418,16 @@ Some context functions add menu items below the 
separator."
                  (listp pending-undo-list)
                (consp buffer-undo-list)))
     (define-key-after menu [undo]
-      '(menu-item "Undo" undo
+      `(menu-item ,(if (region-active-p) "Undo in Region" "Undo") undo
                   :help "Undo last edits")))
   (when (and (not buffer-read-only)
              (undo--last-change-was-undo-p buffer-undo-list))
     (define-key-after menu [undo-redo]
-      '(menu-item "Redo" undo-redo
+      `(menu-item (if undo-in-region "Redo in Region" "Redo") undo-redo
                   :help "Redo last undone edits")))
   menu)
 
-(defun context-menu-region (menu _click)
+(defun context-menu-region (menu click)
   "Populate MENU with region commands."
   (define-key-after menu [separator-region] menu-bar-separator)
   (when (and mark-active (not buffer-read-only))
@@ -455,21 +455,52 @@ Some context functions add menu items below the 
separator."
       `(menu-item "Paste" mouse-yank-at-click
                   :help "Paste (yank) text most recently cut/copied")))
   (when (and (cdr yank-menu) (not buffer-read-only))
-    (define-key-after menu (if (featurep 'ns) [select-paste]
-                             [paste-from-menu])
-      ;; ns-win.el said: Change text to be more consistent with
-      ;; surrounding menu items `paste', etc."
-      `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill 
Menu")
-                  yank-menu
-                  :help "Choose a string from the kill ring and paste it")))
+    (let ((submenu (make-sparse-keymap (propertize "Paste from Kill Menu"))))
+      (dolist (item yank-menu)
+        (when (consp item)
+          (define-key-after submenu (vector (car item))
+            `(menu-item ,(cadr item)
+                        ,(lambda () (interactive)
+                           (mouse-yank-from-menu click (car item)))))))
+      (define-key-after menu (if (featurep 'ns) [select-paste] 
[paste-from-menu])
+        `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill 
Menu")
+                    ,submenu
+                    :help "Choose a string from the kill ring and paste it"))))
   (when (and mark-active (not buffer-read-only))
     (define-key-after menu [clear]
       '(menu-item "Clear" delete-active-region
                   :help
                   "Delete text in region between mark and current position")))
-  (define-key-after menu [mark-whole-buffer]
-    '(menu-item "Select All" mark-whole-buffer
-                :help "Mark the whole buffer for a subsequent cut/copy"))
+
+  (let ((submenu (make-sparse-keymap (propertize "Select"))))
+    (define-key-after submenu [mark-whole-buffer]
+      `(menu-item "All"
+                  ,(lambda (e) (interactive "e") (mark-thing-at-mouse e 
'buffer))
+                  :help "Mark the whole buffer for a subsequent cut/copy"))
+    (define-key-after submenu [mark-line]
+      `(menu-item "Line"
+                  ,(lambda (e) (interactive "e") (mark-thing-at-mouse e 'line))
+                  :help "Mark the line at click for a subsequent cut/copy"))
+    (define-key-after submenu [mark-defun]
+      `(menu-item "Defun"
+                  ,(lambda (e) (interactive "e") (mark-thing-at-mouse e 
'defun))
+                  :help "Mark the defun at click for a subsequent cut/copy"))
+    (define-key-after submenu [mark-list]
+      `(menu-item "List"
+                  ,(lambda (e) (interactive "e") (mark-thing-at-mouse e 'list))
+                  :help "Mark the list at click for a subsequent cut/copy"))
+    (define-key-after submenu [mark-symbol]
+      `(menu-item "Symbol"
+                  ,(lambda (e) (interactive "e") (mark-thing-at-mouse e 
'symbol))
+                  :help "Mark the symbol at click for a subsequent cut/copy"))
+    (when (region-active-p)
+      (define-key-after submenu [mark-none]
+        `(menu-item "None"
+                    ,(lambda (_e) (interactive "e") (deactivate-mark))
+                    :help "Deactivate the region")))
+
+    (define-key-after menu [select-region]
+      `(menu-item "Select" ,submenu)))
   menu)
 
 (defun context-menu-ffap (menu click)
@@ -517,6 +548,26 @@ This is the keyboard interface to \\[context-menu-map]."
 
 (global-set-key [S-f10] 'context-menu-open)
 
+(defun mark-thing-at-mouse (click thing)
+  "Activate the region around THING found near the mouse CLICK."
+  (let ((bounds (bounds-of-thing-at-mouse click thing)))
+    (when bounds
+      (goto-char (if mouse-select-region-move-to-beginning
+                     (car bounds) (cdr bounds)))
+      (push-mark (if mouse-select-region-move-to-beginning
+                     (cdr bounds) (car bounds))
+                 t 'activate))))
+
+(defun mouse-yank-from-menu (click string)
+  "Insert STRING at mouse CLICK."
+  ;; Give temporary modes such as isearch a chance to turn off.
+  (run-hooks 'mouse-leave-buffer-hook)
+  (when select-active-regions
+    (deactivate-mark))
+  (or mouse-yank-at-point (mouse-set-point click))
+  (push-mark)
+  (insert string))
+
 
 ;; Commands that operate on windows.
 
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ce45de7..0b2395d 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -158,22 +158,13 @@ All commands in `lisp-mode-shared-map' are inherited by 
this map.")
   (when (thing-at-mouse click 'symbol)
     (define-key-after menu [elisp-separator] menu-bar-separator
       'middle-separator)
-    (define-key-after menu [info-lookup-symbol]
-      '(menu-item "Look up in Manual"
-                  (lambda (click) (interactive "e")
-                    (info-lookup-symbol
-                     (intern (thing-at-mouse click 'symbol t))))
-                  :help "Display definition in relevant manual")
-      'elisp-separator)
+
     (let* ((string (thing-at-mouse click 'symbol t))
            (symbol (when (stringp string) (intern string)))
            (title (cond
                    ((not (symbolp symbol)) nil)
                    ((and (facep symbol) (not (fboundp symbol)))
                     "Face")
-                   ((and (fboundp symbol) (boundp symbol)
-                         (memq symbol minor-mode-list))
-                    "Mode")
                    ((and (fboundp symbol)
                          (not (or (boundp symbol) (facep symbol))))
                     "Function")
@@ -183,11 +174,17 @@ All commands in `lisp-mode-shared-map' are inherited by 
this map.")
                    ((or (fboundp symbol) (boundp symbol) (facep symbol))
                     "Symbol"))))
       (when title
+        (define-key-after menu [info-lookup-symbol]
+          `(menu-item "Look up in Manual"
+                      (lambda (_click) (interactive "e")
+                        (info-lookup-symbol ',symbol))
+                      :help ,(format "Find `%s' in relevant manual" symbol))
+          'elisp-separator)
         (define-key-after menu [describe-symbol]
           `(menu-item (format "Describe %s" ,title)
                       (lambda (_click) (interactive "e")
                         (describe-symbol ',symbol))
-                      :help "Display the full documentation of symbol")
+                      :help ,(format "Display the documentation of `%s'" 
symbol))
           'elisp-separator))))
   menu)
 
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 88d55a6..7f70e02 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -48,27 +48,26 @@
   (require 'xref)
   (define-key-after menu [prog-separator] menu-bar-separator
     'middle-separator)
-  (when (not (xref-marker-stack-empty-p))
+
+  (unless (xref-marker-stack-empty-p)
     (define-key-after menu [xref-pop]
       '(menu-item "Back Definition" xref-pop-marker-stack
                   :help "Back to the position of the last search")
       'prog-separator))
-  (when (save-excursion
-          (mouse-set-point click)
-          (xref-backend-identifier-at-point
-           (xref-find-backend)))
-    (define-key-after menu [xref-find-ref]
-      '(menu-item "Find References" xref-find-references-at-mouse
-                  :help "Find references to identifier")
-      'prog-separator))
-  (when (save-excursion
-          (mouse-set-point click)
-          (xref-backend-identifier-at-point
-           (xref-find-backend)))
-    (define-key-after menu [xref-find-def]
-      '(menu-item "Find Definition" xref-find-definitions-at-mouse
-                  :help "Find definition of identifier")
-      'prog-separator))
+
+  (let ((identifier (save-excursion
+                      (mouse-set-point click)
+                      (xref-backend-identifier-at-point
+                       (xref-find-backend)))))
+    (when identifier
+      (define-key-after menu [xref-find-ref]
+        `(menu-item "Find References" xref-find-references-at-mouse
+                    :help ,(format "Find references to `%s'" identifier))
+        'prog-separator)
+      (define-key-after menu [xref-find-def]
+        `(menu-item "Find Definition" xref-find-definitions-at-mouse
+                    :help ,(format "Find definition of `%s'" identifier))
+        'prog-separator)))
   menu)
 
 (defvar prog-mode-map
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 0af6d56..6670857 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -152,15 +152,6 @@ positions of the thing found."
                    (cons real-beg end))))))))))
 
 ;;;###autoload
-(defun thing-at-mouse (event thing &optional no-properties)
-  "Return the THING at mouse click.
-Like `thing-at-point', but tries to use the event
-where the mouse button is clicked to find a thing nearby."
-  (save-excursion
-    (mouse-set-point event)
-    (thing-at-point thing no-properties)))
-
-;;;###autoload
 (defun thing-at-point (thing &optional no-properties)
   "Return the THING at point.
 THING should be a symbol specifying a type of syntactic entity.
@@ -196,6 +187,24 @@ a symbol as a valid THING."
         (set-text-properties 0 (length text) nil text))
       text)))
 
+;;;###autoload
+(defun bounds-of-thing-at-mouse (event thing)
+  "Determine the start and end locations for the THING at mouse click.
+Like `bounds-of-thing-at-point', but tries to use the EVENT
+where the mouse button is clicked to find the thing nearby."
+  (save-excursion
+    (mouse-set-point event)
+    (bounds-of-thing-at-point thing)))
+
+;;;###autoload
+(defun thing-at-mouse (event thing &optional no-properties)
+  "Return the THING at mouse click.
+Like `thing-at-point', but tries to use the EVENT
+where the mouse button is clicked to find the thing nearby."
+  (save-excursion
+    (mouse-set-point event)
+    (thing-at-point thing no-properties)))
+
 ;; Go to beginning/end
 
 (defun beginning-of-thing (thing)