unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Re: Context menus and mouse-3
@ 2020-09-16  6:28 Tak Kunihiro
  2020-09-16 14:18 ` Eli Zaretskii
  2020-09-16 19:45 ` Juri Linkov
  0 siblings, 2 replies; 59+ messages in thread
From: Tak Kunihiro @ 2020-09-16  6:28 UTC (permalink / raw)
  To: emacs-devel; +Cc: Juri Linkov

[-- Attachment #1: Type: text/plain, Size: 686 bytes --]

> Mouse support is poor in Emacs, this is the reason
> why I don't use the mouse in Emacs.

I have an impression that relative to Emacs's capability, mouse support
is not as good as expected.

- Horizontal scroll by wheel is supported.
- Moving text using mouse is supported.
* Contextual menu is not supported yet.

I think that depending on a thing at mouse event (file, dir, or URL),
choice of operation should be popped up.  When there is no suggestion,
`Edit' menu should be popped up.  Also, by click on mode-line, buffer
list should be popped up.

I am using a global minor mode `poplife-mode' that puts commands on
mouse-3.  I attach a file with poplife-mode to show the idea.


[-- Attachment #2: poplife.el --]
[-- Type: application/octet-stream, Size: 62640 bytes --]

;;; poplife.el --- Pop choices up on mouse click

;; Copyright (C) 2017-2020 Tak Kunihiro

;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
;; Package-Requires: ((emacs "24.4"))
;; Keywords: mouse
;; Version: 1.0
;; Package-Version: 20200916.1451

;; This file is NOT part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; Usage:
;;
;; To interactively toggle the mode:
;;
;;   M-x poplife-mode RET
;;
;; To make the mode permanent, put these in your init file:
;;
;;   (require 'poplife)
;;   (poplife-mode 1)

;;; Commentary:
;;
;; This package pops context menu triggered by right click.  On a
;; click, depending on a thing under the mouse event, (1) FILE menu
;; (2) DIR menu, (3) WORD menu, (4) URL menu, (5) INFO menu, (6) HELP
;; menu, or (7) EDIT menu will be popped.  The EDIT menu lets you copy
;; and paste only using mouse.  As an option, the EDIT menu lets you
;; visit buffers, frames, bookmarks, and files.  The seven menus
;; are detailed as below.
;;
;; (1) FILE menu -- Pop how-to-open-a-file menu.
;; (2) DIR menu  -- Pop files in default-directory.
;; (3) WORD menu -- Pop word candidates when word under a mouse event is not correct.
;; (4) URL menu  -- Pop how-to-open-an-url menu.
;; (5) INFO menu -- Pop how-to-open-Info menu.
;; (6) HELP menu -- Pop how-to-open-Help menu.
;; (7) EDIT menu -- Pop basic edition-commands, optional edition-commands,
;;                  and visiting menus.  Details are shown below.
;;
;;  Basic edition-commands are defined by `poplife-mouse-edit-cmd-0'.
;;  Optional edition-commands are defined by
;;  `poplife-mouse-edit-cmd-1'.  with format similar to
;;  `recentf-menu-items-for-commands'.
;;
;;  DIR menu to visit files in default-directory is included by
;;  default.  To include a series of visiting menus, set each item of
;;  `poplife-mouse-edit-cottager' to non-nil, as listed below.
;;
;;   :buffer     List buffers by `global-buffers-menu-map'.
;;   :imenu      List table of contents of current buffer by iMenu.
;;   :frame      List frames by `global-buffers-menu-map'.
;;   :bookmark   List bookmarks by `bookmark-all-names'.
;;   :recentf    List recent files by `recentf-menu-elements'.
;;
;;  To reduce overhead, FILE menu is not shown when file-remote-p is
;;  non-nil.  To reduce overhead by a remote file that was once opened
;;  by Tramp and stored in the list for recentf, configure a variable
;;  `recentf-exclude'.

;;; References:

;; * Paste text with erasing active region.
;;
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2017-07/msg00086.html
;; http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00796.html
;;
;; * Pop menu up by long-click
;;
;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00267.html
;;
;; * Following codes from Emacs core are useful for development.
;;
;; (define-key global-map [mouse-3] menu-bar-edit-menu)
;; (popup-menu menu-bar-edit-menu)
;; (popup-menu (mouse-menu-bar-map))
;; (popup-menu (mouse-menu-major-mode-map)) ; C-mouse-3
;; (popup-menu menu-bar-bookmark-map)
;; (popup-menu global-buffers-menu-map)
;; (define-key global-map [mouse-3] 'mouse-buffer-menu)
;; (buffer-menu-open)

;;; Templates of keymap:
;;
;; This package integrates keymaps from imenu, menu-bar, bookmark, and
;; recentf.  They are converted to easymenu from standard keymap.
;; Typical easymenu and standard keymap are shown below for
;; convenience.
;;
;; (label
;;  [label callback]
;;  (label
;;   [label callback]
;;   ["--"  ignore]
;;   [label callback])
;;  [label callback])
;;
;; (keymap
;;  label
;;  (symbol menu-item label callback)
;;  [(label lambda nil (interactive) commands)
;;   (label keymap
;;          (symbol menu-item label callback)
;;          (symbol menu-item label callback))
;;   (label lambda nil (interactive) commands)]
;;  (symbol "--")
;;  (symbol menu-item label
;;          (keymap label
;;                  (symbol menu-item label callback)
;;                  (symbol menu-item label callback)))
;;  (symbol menu-item label callback))

;;; Code:
(defvar poplife-context-candidates
  '(poplife-mouse-help-menu             ; HELP menu
    poplife-mouse-info-menu             ; INFO menu
    poplife-mouse-file-menu             ; FILE menu
    poplife-mouse-dir-menu              ; DIR menu
    poplife-mouse-word-menu             ; WORD menu
    poplife-mouse-url-menu              ; URL menu
    ;; menu-bar-edit-menu    ; EDIT menu (default)
    poplife-mouse-edit-menu)            ; EDIT menu
  "List of candidates for context menu.
Candidates are function or keymap.  They will be evaluated in the
order of the list.  A function should accept mouse EVENT, and
return keymap or nil.  The last candidate should return valid
keymap.")

(defvar poplife-mouse-edit-cmd-0 '(cut copy paste select-paste paste-from-menu clear mark-whole-buffer)
  "Basic edition-commands in edit menu.
Items must be one listed in `menu-bar-edit-menu'.")

(defvar poplife-mouse-edit-cmd-1
  (list
   ["Close"
    (lambda () (interactive)
      (if (one-window-p)
          (if (> (length (visible-frame-list)) 1)
              (call-interactively 'delete-frame)
            (kill-buffer (window-buffer))) ; (quit-window)
        (delete-window)))
    :help "Remove this window or this frame, or kill this buffer"
    :visible (not (region-active-p))
    :active t]
   ;; ["Spell-Check"
   ;;  flyspell-correct-word-before-point
   ;;  :help "Spell check word at point"
   ;;  :visible (and (fboundp 'flyspell-correct-word-before-point)
   ;;                (not (region-active-p)))
   ;;  :active t]
   ["Spell-Check"
    ispell-region
    :help "Spell check selected text"
    :visible (region-active-p)
    :active t]
   ;; ["Search Web"
   ;;  (lambda () (interactive)
   ;;    (let ((keyword (buffer-substring-no-properties (region-beginning) (region-end))))
   ;;      (switch-to-buffer-other-window (generate-new-buffer "*eww*"))
   ;;      (eww-mode)
   ;;      (eww keyword)))
   ;;  :help "Search selected text by online service"
   ;;  :visible (region-active-p)
   ;;  :active t]
   ["--"
    ignore
    :visible (region-active-p)
    :active t])
  "List of optional commands in edit map.") ; recentf-menu-items-for-commands

(defvar poplife-mouse-edit-cottager
  '(:imenu t :buffer t :frame t :bookmark t :recentf t)
  "Extra menus to be included in edit menu besides file.")
\f
(defvar poplife-file-max-menu-items 20
  "Maximum number of items in DIR menu.
See also `recentf-max-menu-items', `buffers-menu-max-size', and
`imenu-max-items'.")

(defvar poplife-file-recursive 1
  "Depth of directory scan on DIR menu.")

(defvar poplife-dir-do-not-scan-regexp "inbox"
  "Contents of directory matching this regexp will not be shown in DIR menu.
Instead contents of home directory are displayed.")

(defvar poplife-file-do-not-show-regexp
  "\\`\\.\\.?$\\|\\`#\\|\\.elc\\'\\|\\.exe\\'\\|\\`\\.[^e]\\|\\.lnk\\'\\|\\~\\'\\|\\`desktop\\.ini\\'\\|\\`\\.DS_store\\'\\|\\`\\.dropbox\\'\\|\\`auto\\'\\|\\`ntuser\\|\\`_master_\\|\\`_region_\\|\\.aux\\'\\|\\.bbl\\'\\|\\.blg\\'\\|\\.fdb_latexmk\\'\\|\\.fls\\'\\|\\.lof\\'\\|\\.lot\\'\\|\\.out\\'\\|\\.toc\\'\\|\\.synctex\\'\\|\\.ico\\'\\|\\`Thumbs\\.db\\'\\|\\`Icon"
  "Filenames matching this regexp will not be displayed in DIR menu.") ; dired-trivial-filenames, dired-omit-files

(defvar poplife-file-do-not-open-regexp
  "\\.pdf\\'\\|\\.doc\\'\\|\\.docx\\'\\|\\.xls\\'\\|\\.xlsx\\'\\|\\.ppt\\'\\|\\.pptx\\'\\|\\.jpg\\'\\|\\.png\\'\\|\\.tif\\'\\|\\.tiff\\'\\|\\.bmp\\'\\|\\.aif\\'\\|\\.wav\\'\\|\\.7z\\'\\|\\.tar\\'\\|\\.dll\\'\\|\\.zip\\'\\|\\.info\\'\\|\\.igpi\\'\\|\\.ttf\\'\\|\\.otf\\'\\|\\.pkg\\'\\|\\.exe\\'"
  "Filenames matching this regexp will be displayed in DIR menu and open by `poplife-func-find-file-by-default-app'.")

(defvar poplife-func-find-file 'find-file
  "Function to visit a file, and a Recentf element.
Depending on context, this is internally overwritten by
`find-file', `find-file-other-window', and
`find-file-other-frame'.  This is referred to visit a buffer, an
imenu element, and a bookmark element via
`poplife-func-switch-to-buffer'.  A buffer is visited by
`menu-bar-select-buffer-function' on `global-buffers-menu-map'.
An imenu element is always visited on current buffer.  A bookmark
element is visited by `display-func' on `bookmark-jump'.")

(defvar poplife-func-find-file-by-default-app 'poplife-find-file-by-default-app
  "Function to visit file by default application.")
\f
(require 'ffap)
(require 'easymenu)

;;;###autoload
(define-minor-mode poplife-mode
  "A global minor-mode to show context menu by right click."
  :init-value nil
  :group 'mouse
  :global t
  :keymap (let ((map (make-sparse-keymap))
                (context-menu
                 `(menu-item "Context menu" poplife-context-menu
                             :filter ,(lambda (_) (poplife-context-menu (aref (this-command-keys) 0))))))
            ;; bug#27569 (gnus-read-ephemeral-emacs-bug-group 27569)
            ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-07/msg00086.html
            ;; https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00757.html
            ;; https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00796.html
            ;; https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00840.html
            (define-key map [mouse-3] context-menu)
            (define-key map [drag-mouse-3] context-menu)
            (define-key map [C-down-mouse-1] #'ignore)
            (define-key map [C-mouse-1] context-menu)
            (define-key map [C-double-mouse-1] context-menu)
            (define-key map [C-triple-mouse-1] context-menu)
            (define-key map [C-drag-mouse-1] context-menu)
            (define-key map [remap buffer-menu-open] #'poplife-menu-open)
            ;; (define-key map [C-S-down-mouse-1] 'mouse-buffer-menu)
            ;; (define-key map [C-M-mouse-1] 'poplife-what-mouse-position)
            ;; (define-key mode-line-buffer-identification-keymap [mode-line mouse-3] #'poplife-pwd-menu-open)
            ;; (define-key mode-line-buffer-identification-keymap [mode-line mouse-1] #'poplife-buffer-menu-open)
            (define-key map [remap mode-line-previous-buffer] #'poplife-buffer-menu-open) ; mouse-1
            ;; (define-key map [remap mode-line-previous-buffer] #'poplife-global-mark-ring-menu-open) ; mouse-1
            (define-key map [remap mode-line-next-buffer] #'poplife-pwd-menu-open) ; mouse-3
            (define-key map [mode-line C-mouse-1] #'poplife-pwd-menu-open)
            (define-key map [mode-line M-mouse-1] #'poplife-pwd-menu-open) ; as if Mac
            map))

;; * How to implement into core
;;
;; https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00416.html

;; (defvar mouse-context-menu-function #'mouse-default-context-menu
;;   "Function that builds the context-menu.
;; Takes one argument (the EVENT that requests the menu) and should return
;; a list of menu items.")

;; (defun mouse-default-context-menu (event)
;;   "Return default context menu."
;;   (interactive "e")
;;   menu-bar-edit-menu)

;; (defun mouse-context-menu (event)
;;   "Open up the context menu."
;;   (interactive "@e")
;;   (let* ((menu-items (funcall mouse-context-menu-function event))
;;          (keymap `(keymap ,(apply #'vector menu-items))))
;;     (popup-menu keymap event)))

;; (define-key global-map [mouse-3] 'mouse-context-menu)

(defun poplife-menu-open ()
  "Start key navigation of the poplife menu.
This is the keyboard interface to \\[poplife-context-menu].  This is
fork of `buffer-menu-open'."
  (interactive)
  (popup-menu (poplife-context-menu last-nonmenu-event)
              (posn-at-x-y 0 0 nil t)))

(defun poplife-context-menu (event)
  "Return key's definition depending on thing at mouse click EVENT.
Items in `poplife-context-candidates' are examined sequentially.
See `define-key' for the key's definition"
  ;; ~/.emacs.d/init.el ~/.emacs.d/ https://www.gnu.org/software/emacs/
  (when (fboundp 'secondary-selection-to-region) ; 26.1
    (secondary-selection-to-region)) ; When there is only secondary, turn it to region.
  (let ((candidates poplife-context-candidates)
        context-menu)
    (while (not context-menu)
      (let ((item (car candidates)))
        (setq candidates (cdr candidates))
        ;; See how dired-guess-shell-alist-user is used in dired-guess-default.
        (setq context-menu (cond ((fboundp item)
                                  (funcall item event))
                                 ((and (symbolp item)
                                       (keymapp (symbol-value item)))
                                  (symbol-value item))
                                 (t     ; else
                                  nil)))))
    context-menu))
;; (let ((foo (poplife-context-menu last-nonmenu-event))) (describe-variable 'foo))

(defun poplife-what-mouse-position (event)
  "Evaluate text properties under mouse click."
  (interactive "e")
  (with-output-to-temp-buffer "*Result*"
    (princ (format "Event was %S\n" event))
    (princ (format "Click was on face <%S>.\n"
                   (mouse-posn-property (event-start event) 'face)))
    (princ (format "Click was on dired-filename <%S>.\n"
                   (mouse-posn-property (event-start event) 'dired-filename)))))

(with-eval-after-load "help-mode"
  (button-type-put 'help-function-def 'help-function 'poplife-help-find-function))

(defvar poplife-help-switch-buffer-function 'pop-to-buffer
  "Function to display buffer in help-mode.
This can be `switch-to-buffer', `switch-to-buffer-other-window',
or `switch-to-buffer-other-frame'.")

(defun poplife-help-find-function (fun &optional file type)
  "Find object shown in help-mode."
  ;; This is fork of lambda function of 'help-function, that is
  ;; defined for a button type 'help-function-def in `help-mode.el'.
  (or file
      (setq file (find-lisp-object-file-name fun type)))
  (if (not file)
      (message "Unable to find defining file")
    (require 'find-func)
    (when (eq file 'C-source)
      (setq file
            (help-C-file-name (indirect-function fun) 'fun)))
    ;; Don't use find-function-noselect because it follows
    ;; aliases (which fails for built-in functions).
    (let ((location
           (find-function-search-for-symbol fun type file)))
      ;; (pop-to-buffer (car location))
      (funcall poplife-help-switch-buffer-function (car location)) ; Revised for poplife
      (run-hooks 'find-function-after-hook)
      (if (cdr location)
          (goto-char (cdr location))
        (message "Unable to find location in file")))))

(defun poplife-mouse-help-menu (event)
  "Return help-menu when thing at mouse click EVENT is button
with button type of 'help-function-def."
  (and
   (not (region-active-p))
   (let ((help-easymap
          (save-excursion
            (mouse-set-point event)
            ;; (text-properties-at (point))
            ;; '(push-button "/Applications/MacPorts/Emacs.app/Contents/Resources/lisp/button.el")
            ;; (push-button (point))
            ;; (help-button-action (button-at (point)))
            ;; (help-do-xref nil
            ;;   	(button-get (button-at (point)) 'help-function)
            ;;   	(button-get (button-at (point)) 'help-args))
            ;; (button-type (button-at (point)))
            (let ((button (button-at (point))))
              (when (and button
                         (eq (button-type button) 'help-function-def))
                (let* ((button-func (button-get button 'help-function))
                       (button-arg  (button-get button 'help-args))
                       (message (replace-regexp-in-string "[()\"]" "" (format "%S" button-arg) t t)))
                  (list
                   message
                   (vector "Open Function"
                           `(let* ((poplife-func-find-file 'find-file) ; switch-to-buffer
                                   (poplife-help-switch-buffer-function (poplife-func-switch-to-buffer)))
                              (help-button-action ,button))
                           :visible t :active t :help message)
                   ["--" ignore]
                   (vector "Open Function in Other Window"
                           `(let* ((poplife-func-find-file 'find-file-other-window) ; switch-to-buffer-other-window
                                   (poplife-help-switch-buffer-function (poplife-func-switch-to-buffer)))
                              (help-button-action ,button))
                           :visible t :active t :help message)
                   (vector "Open Function in Frame"
                           `(let* ((poplife-func-find-file 'find-file-other-frame) ; switch-to-buffer-other-frame
                                   (poplife-help-switch-buffer-function (poplife-func-switch-to-buffer)))
                              (help-button-action ,button))
                           :visible t :active t :help message))))))))
     (when help-easymap
       (easy-menu-create-menu (car help-easymap) (cdr help-easymap))))))
;; (poplife-mouse-help-menu last-nonmenu-event)

(defun poplife-info-node-at-point ()
  "Return a node reference at point.
Return non-nil if successful.  This is fork of
`Info-try-follow-nearest-node'."
  (let (file-or-node)
    (cond
     ((setq file-or-node (Info-get-token (point) "[hf]t?tps?://"
				                 "\\([hf]t?tps?://[^ \t\n\"`‘({<>})’']+\\)"))
      ;; (browse-url file-or-node)
      (setq file-or-node nil))
     ((setq file-or-node (Info-get-token (point) "\\*note[ \n\t]+"
				                 "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))) ; (system)Data format IONML
     ;; footnote
     ((setq file-or-node (Info-get-token (point) "(" "\\(([0-9]+)\\)"))
      (setq file-or-node nil))
     ;; menu item: node name
     ((setq file-or-node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))) ; What is DREAM?
     ;; menu item: node name or index entry
     ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") ; FAQ
      (save-excursion
        (beginning-of-line)
        (forward-char 2)
        (setq file-or-node (Info-extract-menu-node-name nil (Info-index-node))))) ; (pmlfaq)
     ((setq file-or-node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) ; pmlfaq.info
      (when (string-match "\\.info\\'" file-or-node)
        (string-match "\\`\\(.+\\)\\.info\\'" file-or-node) ; pmlfaq
        (setq file-or-node (format "(%s) Top" (match-string 1 file-or-node)))))) ; (pmlfaq) Top
    (when (and file-or-node
               (stringp Info-current-file)
               (not (string-match "\\`(.*)" file-or-node)))
      (setq file-or-node
            (format "(%s) %s"
                    (file-name-sans-extension
                     (file-name-nondirectory Info-current-file))
                    file-or-node))) ; see Info-copy-current-node-name
    file-or-node))

(defun poplife-mouse-info-menu (event)
  "Return info-menu when thing at mouse click EVENT is link."
  ;; see Info-try-follow-nearest-node
  (and
   (not (region-active-p))
   (let ((info-easymap
          (save-excursion
            (mouse-set-point event)
            (let ((file-or-node (poplife-info-node-at-point)))
              (when file-or-node
                (list
                 file-or-node
                 (vector "Open Info"
                         ;; `(info ,file-or-node)
                         `(info-setup
                           ,file-or-node
                           (switch-to-buffer (format "*info-%s*" ,file-or-node)))
                         :visible t :active t :help file-or-node)
                 ["--" ignore]
                 (vector "Copy Info"
                         `(progn (kill-new ,file-or-node) (message ,file-or-node))
                         :visible t :active t :help file-or-node)
                 (vector "Open Info in Other Window"
                         `(info-setup
                           ,file-or-node
                           (switch-to-buffer-other-window (format "*info-%s*" ,file-or-node)))
                         :visible t :active t :help file-or-node)
                 (vector "Open Info in Frame"
                         `(info-setup
                           ,file-or-node
                           (switch-to-buffer-other-frame (format "*info-%s*" ,file-or-node)))
                         :visible t :active t :help file-or-node)))))))
     (when info-easymap
       (easy-menu-create-menu (car info-easymap) (cdr info-easymap))))))
;; (let ((foo (poplife-mouse-info-menu last-nonmenu-event))) (describe-variable 'foo))
;; (popup-menu (poplife-mouse-info-menu last-nonmenu-event))

(defun poplife-mouse-file-menu (event)
  "Return file-menu when thing at mouse click EVENT is file.
The file is identified by `ffap-guesser'."
  (and
   (not (region-active-p))
   (let ((file-easymap
          (save-excursion
            (mouse-set-point event)
            (if (equal major-mode 'dired-mode)
                (and
                 (mouse-posn-property (event-start event) 'dired-filename)
                 (poplife-file-easymap (dired-get-file-for-visit) t))
              (let ((file (ffap-guesser))) ; ffap-at-mouse
                ;; ~/.emacs.d/init.el  ~/.emacs.d/  https://www.gnu.org/software/emacs/
                ;; ffap-guesser cannot guess file with asterisk such as "bookmark.html*"
                (when (and file
                           (not (ffap-file-remote-p file)))
                  (poplife-file-easymap file t)))))))
     (when file-easymap
       (easy-menu-create-menu (car file-easymap) (cdr file-easymap))))))

(defun poplife-mouse-dir-menu (event)
  "Return dir-menu when thing under mouse cursor on EVENT is directory.
The directory is identified by `ffap-guesser'."
  (and
   (not (region-active-p))
   (if (equal major-mode 'dired-mode)
       (mouse-posn-property (event-start event) 'dired-filename)
     t)
   (let ((dir-easymap (save-excursion
                        (mouse-set-point event)
                        ;; ~/.emacs.d/init.el  ~/.emacs.d/  https://www.gnu.org/software/emacs/
                        (let ((dir (ffap-guesser)))
                          (when (and dir
                                     (not (ffap-file-remote-p dir)))
                            (poplife-dir-easymap (file-name-as-directory dir) t))))))
     (when dir-easymap
       (easy-menu-create-menu (car dir-easymap) (cdr dir-easymap))))))

(defun poplife-mouse-word-menu (event)
  "Return 'flyspell-correct-word when word under mouse cursor on EVENT is incorrect."
  (and
   (not (region-active-p))
   ;; Check face by (what-cursor-position t) or C-u C-x =.
   (let ((faces-at-point (mapcar (lambda (xxx) (overlay-get xxx 'face))
                                 (overlays-at (posn-point (event-start event))))))
     (when (or (member 'flyspell-incorrect faces-at-point)
               (member 'flyspell-duplicate faces-at-point))
       #'flyspell-correct-word)))) ; flyspell-correct-word-before-point

(defun poplife-mouse-url-menu (event)
  "Return url-menu when thing under mouse cursor on EVENT is url.
The url is identified by `thing-at-point-url-at-point'."
  (and
   (not (region-active-p))
   (let ((url-easymap
          (save-excursion
            (mouse-set-point event)
            ;; ~/.emacs.d/init.el  ~/.emacs.d/  https://www.gnu.org/software/emacs/
            (let ((url (or (thing-at-point-url-at-point t) ; browse-url-at-mouse
                           (get-text-property (point) 'shr-url)
                           (get-text-property (point) 'image-url))))
              (when url
                (list (let ((url (replace-regexp-in-string "https?://" "" url))
                            (len 40)) ; Make URL short
                        (if (> (length url) len)
                            (concat (substring url 0 (1- len)) "...")
                          url))
                      (vector "Open Link"
                              `(eww ,url)
                              :visible t :active t :help url)
                      ["--" ignore]
                      (vector "Copy Link"
                              `(progn (kill-new ,url) (message "Copied %s" ,url))
                              :visible t :active t :help url)
                      (vector "Open Link in Other Window"
                              ;; eww-browse-url, eww-open-in-new-buffer
                              `(progn
                                 (switch-to-buffer-other-window (generate-new-buffer "*eww*"))
                                 (eww-mode)
                                 (eww ,url))
                              :visible t :active t :help url)
                      (vector "Open Link in Frame" ; "Open in Frame"
                              `(progn
                                 (switch-to-buffer-other-frame (generate-new-buffer "*eww*"))
                                 (eww-mode)
                                 (eww ,url))
                              :visible t :active t :help url)
                      (vector "Open Link by Default App" ; "Open Link using browse-url"
                              `(let ((browse-url-browser-function 'browse-url-default-browser))
                                 (browse-url ,url))
                              :visible t
                              :active t
                              :help url)))))))
     (when url-easymap
       (easy-menu-create-menu (car url-easymap) (cdr url-easymap))))))

(defun poplife-mouse-edit-menu (event)
  "Define edit menu on mouse click EVENT."
  ;; initialize
  (when (plist-get poplife-mouse-edit-cottager :bookmark)
    (require 'bookmark))
  (when (plist-get poplife-mouse-edit-cottager :recentf)
    (require 'recentf)
    (recentf-mode 1))
  (when (plist-get poplife-mouse-edit-cottager :imenu)
    (require 'imenu))

  (save-excursion
    (mouse-set-point event)
    (let ((map (make-sparse-keymap "Edit")))
      (unless (region-active-p)
        ;; Visit buffers with iMenu
        (when (plist-get poplife-mouse-edit-cottager :buffer)
          (easy-menu-add-item map nil (poplife-buffer-easymap)))

        ;; Visit frames
        (when (plist-get poplife-mouse-edit-cottager :frame)
          (easy-menu-add-item map nil (poplife-frame-easymap)))

        ;; Visit bookmarks
        (when (plist-get poplife-mouse-edit-cottager :bookmark)
          (easy-menu-add-item map nil (poplife-bookmark-easymap)))

        ;; Visit recent files
        (when (plist-get poplife-mouse-edit-cottager :recentf)
          (easy-menu-add-item map nil (poplife-recentf-easymap)))

        ;; Visit directory
        (unless (file-remote-p default-directory)
          (let ((dir-map (poplife-dir-easymap default-directory)))
            (setcar dir-map "File")      ; instead of ".emacs.d/"
            (easy-menu-add-item map nil dir-map)))

        ;; Separator
        (define-key map [separator-edit] menu-bar-separator))

      ;; Option -- TODO: Fix location of item with recursive structure.
      (when poplife-mouse-edit-cmd-1
        (dolist (item poplife-mouse-edit-cmd-1)
          (if (vectorp item)
              (let* ((item (append item nil)) ; Convert vector to list.
                     (nickname (car item)))
                (bindings--define-key map (vector (easy-menu-make-symbol nickname))
                  (append (list 'menu-item nickname) (cdr item))))
            (easy-menu-add-item map nil item)))) ; with recursive structure

      ;; Main
      (dolist (item (reverse (cdr menu-bar-edit-menu)))
        (when (and (listp item)
                   (member (car item) poplife-mouse-edit-cmd-0)) ; pick some
          (bindings--define-key map (vector (car item)) (cdr item))))

      map)))
;; (let ((foo (poplife-mouse-edit-menu last-nonmenu-event))) (describe-variable 'foo))
\f
;;; iMenu
(defun poplife-imenu-easymap (&optional submenu)
  "Define easymenu to list index by iMenu.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  ;; TODO: Selection of menu does not move point when called from
  ;; click on mode-line.
  (let* ((imenu-max-items poplife-file-max-menu-items) ; 25
         (map-0 (ignore-errors
                  (imenu--split-menu
                   (delq nil (cdr (imenu--make-index-alist t))) ; remove "*Rescan*"
                   (buffer-name))))
         (map (poplife-imenu-alist-to-easymap (car map-0) (cdr map-0)
                                            'imenu--menubar-select)))
    (when (>= (length map) 2) ; Return map only when map is with useful items.
      (if submenu
          (poplife-imenu-submenufy-easymap map)
        (let ((map-rev (reverse map)))
          (push (vector "More..."
                        '(popup-menu (poplife-imenu-easymap t)
                                     (popup-menu-normalize-position last-nonmenu-event)))
                map-rev)
          (reverse map-rev))))))
;; (let ((foo (poplife-imenu-easymap))) (describe-variable 'foo))
;; (let* ((poplife-func-find-file 'find-file-other-frame) (foo (poplife-imenu-easymap))) (describe-variable 'foo))
;; (let ((foo (poplife-imenu-easymap t))) (describe-variable 'foo))
;; (popup-menu (poplife-imenu-easymap))

(defun poplife-imenu-alist-to-easymap (title alist &optional cmd)
  "Create easymenu from alist by iMenu to display index by CMD.
This is fork of `imenu--create-keymap'."
  (let (map)
    (dolist (item alist)
      (push (cond
             ((imenu--subalist-p item)
              (poplife-imenu-alist-to-easymap (car item) (cdr item) cmd))
             (t
              (if cmd
                  (vector (car item)
                          (list 'let
                                '((display-buffer--other-frame-action ; hack for switch-to-buffer-other-frame
                                   '((display-buffer-pop-up-frame)
                                     (inhibit-same-window . t))))
                                `(funcall (quote ,(poplife-func-switch-to-buffer)) ,(current-buffer))
                                `(,cmd (quote ,item))))
                (list 'quote item))))
            map))
    (setq map (reverse map))
    (push title map)
    map))

(defun poplife-imenu-submenufy-easymap (map)
  "Return easymenu of iMenu MAP with recursive structure."
  (let (map-1)
    (dolist (item map)
      (push (cond
             ((listp item) ; when an item is a list
              (poplife-imenu-submenufy-easymap item))
             ((vectorp item) ; when an item is vector
              (poplife-imenu-elt-easymap item))
             (t item)) ; else such for "poplife.el"
            map-1))
    (reverse map-1)))

(defun poplife-imenu-elt-easymap (elt)
  "Return easymenu of iMenu ELT with submenu added."
  (let ((label (aref elt 0)) ; "poplife-mouse-edit-cottager"
        (cmd (nth 3 (aref elt 1))) ; (imenu--menubar-select '("poplife-mouse-edit-cottager" . #<marker at 3207 in poplife.el>))
        (buf (current-buffer))) ; #<buffer poplife.el>
    (list label
          (vector "Open" `(progn (switch-to-buffer ,buf) ,cmd))
          ["--" ignore]
          (vector "Open in Other Window" `(progn (switch-to-buffer-other-window ,buf) ,cmd))
          (vector "Open in Frame" `(progn (pop-to-buffer ,buf '((display-buffer-pop-up-frame) (inhibit-same-window . t))) ,cmd)))))
\f
;;; Frame
(defun poplife-frame-easymap ()
  "Define easymenu to list frames."
  (let ((frame-vec (nth 2 (cadddr (assoc 'frames global-buffers-menu-map))))
        (poplife-func-find-file 'find-file-other-frame)
        map)
    (dolist (elt (append frame-vec nil)) ; Convert vector to list.
      (let* ((nickname (car elt))
             (cmd (nth 4 elt))
             (frame (cadr cmd)))
        (push (vector nickname cmd :active (not (equal frame (selected-frame)))) map)))
    (push ["New" (progn (make-frame-command) (menu-find-file-existing))] map)
    (push ["--" ignore] map)
    (when (plist-get poplife-mouse-edit-cottager :buffer)
      (push (poplife-buffer-easymap) map))
    (when (plist-get poplife-mouse-edit-cottager :bookmark)
      (push (poplife-bookmark-easymap) map))
    (when (plist-get poplife-mouse-edit-cottager :recentf)
      (push (poplife-recentf-easymap) map))
    (unless (file-remote-p default-directory)
      (let ((dir-map (poplife-dir-easymap default-directory)))
        (setcar dir-map "File")        ; "Directory"
        (push dir-map map)))
    (setq map (reverse map))
    (push "Frames" map)
    map))
;; (let ((foo (poplife-frame-easymap))) (describe-variable 'foo))
\f
;;; Buffer
(defun poplife-buffer-easymap (&optional submenu)
  "Define easymenu to list buffers.
This extracts list of buffers from `global-buffers-menu-map'.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  (let ((buffer-list (poplife-buffer-list))
        ;; (poplife-func-find-file 'find-file) ; 20190128.1647
        (menu-bar-select-buffer-function (poplife-func-switch-to-buffer))
        map)

    ;; Add submenu on request.
    (dolist (elt buffer-list)
      (push (poplife-buffer-elt-easymap elt submenu) map))

    ;; Add option.
    (push (vector "More..."
                  '(let (buffer-full-map)
                     (let (buffers-menu-max-size)
                       (menu-bar-update-buffers t)
                       (setq buffer-full-map
                             (poplife-buffer-easymap t)))
                     (menu-bar-update-buffers t)
                     (popup-menu buffer-full-map
                                 (popup-menu-normalize-position last-nonmenu-event)))
                  :visible t
                  :active (not submenu))
          map)

    ;; Reverse map and add a key.
    (setq map (reverse map))
    (push "Buffers" map)

    map))
;; (let ((foo (poplife-buffer-easymap))) (describe-variable 'foo))
;; (let ((foo (poplife-buffer-easymap t))) (describe-variable 'foo))

(defun poplife-buffer-list-on-menu ()
  "Return a list of buffers on `global-buffers-menu-map'."
  ;; on 25.2, pick 4th out of 5 items
  ;; ("menu-bar.el.gz  " lambda nil (interactive) (funcall menu-bar-select-buffer-function #<buffer menu-bar.el.gz>))
  ;; on 24.5, pick 5th out of 6 items
  ;; ("menu-bar.el.gz  " (nil) lambda nil (interactive) (funcall menu-bar-select-buffer-function #<buffer menu-bar.el.gz>))
  (let ((len245 6)
        (nth252 4)
        (nth245 5)
        (buffers-menu (nth 2 global-buffers-menu-map))
        ;; nickname-list
        buffer-list)
    (dolist (elt (append buffers-menu nil)) ; Convert vector to list.
      ;; (push (car elt) nickname-list)
      (push (nth 2 (nth (if (equal (length elt) len245)
                            nth245
                          nth252)
                        elt)) buffer-list))
    (reverse buffer-list)))
;; (let ((foo (poplife-buffer-list-on-menu))) (describe-variable 'foo))
;; (let ((foo (buffer-list))) (describe-variable 'foo))

(defun poplife-buffer-list ()
  "Return a list of buffers."
  (delete-dups (append (list (current-buffer))
                       (poplife-buffer-list-with-marks)
                       (poplife-buffer-list-on-menu))))
;; (let ((foo (poplife-buffer-list))) (describe-variable 'foo))

(defun poplife-buffer-list-with-marks ()
  "Return a list of buffers on `global-mark-ring'."
  (let (buffer-list buf)
    (dolist (marker (reverse global-mark-ring))
      (when (setq buf (marker-buffer marker)) ; See `pop-global-mark'
        (push buf buffer-list)))
    buffer-list))
;; (let ((foo (poplife-buffer-list-with-marks))) (describe-variable 'foo))

(defun poplife-buffer-elt-easymap (buffer &optional submenu)
  "Define easymenu for a BUFFER.
When SUBMENU is non-nil, this returns an easymenu with multiple
actions."
  (let ((nickname (buffer-name buffer)))
    (if (not submenu)
        (let (imenu-map)
          (if (and (plist-get poplife-mouse-edit-cottager :imenu)
                   (equal (current-buffer) buffer)
                   (setq imenu-map (poplife-imenu-easymap)))
              imenu-map
            (vector nickname `(funcall (quote ,menu-bar-select-buffer-function) ,buffer)
                    :active `(not (equal ,(current-buffer) ,buffer)))))
      (list nickname
            (vector "Open" `(switch-to-buffer ,buffer) :active `(not (equal ,(current-buffer) ,buffer)))
            ["--" ignore]
            (vector "Open in Other Window" `(switch-to-buffer-other-window ,buffer))
            (vector "Open in Frame" `(switch-to-buffer-other-frame ,buffer))))))
\f
;;; Recentf
(defun poplife-recentf-easymap (&optional submenu)
  "Define easymenu to list recentf.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  (let (map
        (recentf-menu-shortcuts 0)
        (elements (recentf-menu-elements recentf-max-menu-items)))
    ;; See `recentf-make-menu-items'.
    (setq map (mapcar (lambda (elt)
                        (funcall 'poplife-recentf-elt-easymap elt submenu))
                      (recentf-apply-menu-filter
                       recentf-menu-filter
                       elements)))
    (let ((map-rev (reverse map)))
      (push (vector "More..."
                    '(let ((recentf-max-menu-items recentf-max-saved-items))
                       (popup-menu (poplife-recentf-easymap t)
                                   (popup-menu-normalize-position last-nonmenu-event)))
                    :help "Show more Recentf"
                    :visible t
                    :active (not submenu))
            map-rev)
      (push ["--" ignore] map-rev)
      (push ["Edit..."
             recentf-edit-list
             :help "Manually remove files from the recent list"
             :active t]
            map-rev)
      ;; (push ["Save List Now"
      ;;        recentf-save-list
      ;;        :help "Save the list of recently opened files now"
      ;;        :active t]
      ;;       map-rev)
      (setq map (reverse map-rev)))
    (cons "Recent" map)))
;; (let ((foo (poplife-recentf-easymap))) (describe-variable 'foo))

(defun poplife-recentf-elt-easymap (elt &optional submenu)
  "Define easymenu to popup recentf item ELT.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  ;; This is fork of `recentf-make-menu-item'.
  (let ((name (recentf-menu-element-item elt))
        (file (recentf-menu-element-value elt)))
    (if (recentf-sub-menu-element-p elt)
        (cons name (mapcar (lambda (elt) (funcall 'poplife-recentf-elt-easymap elt)) file)) ; for `recentf-arrange-by-dir'
      ;; (vector name
      ;;         `(,recentf-menu-action ,file) ; poplife-func-find-file
      ;;         :help (concat "Open " file)
      ;;         :active t)
      (let ((map
             (if (file-directory-p file)
                 (poplife-dir-easymap file submenu) ; directory
               (poplife-file-easymap file submenu)))) ; file
        (when (listp map)
          (setcar map name))
        map))))
\f
;;; Bookmark
(defun poplife-bookmark-easymap (&optional submenu)
  "Define easymenu to list bookmarks.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  ;; TODO: On emacs-27.1 with smb, I see "tramp-error: Method ‘smb’ is
  ;; not known".
  (let ((map
         (list
          (vector "More..." '(popup-menu (poplife-bookmark-easymap t)
                                         (popup-menu-normalize-position last-nonmenu-event))
                  :visible t
                  :active (not submenu)
                  :help "Set a bookmark named inside a file.")
          ["--" ignore]
          ["Add..." bookmark-set :visible t :active (or (buffer-file-name) (eq major-mode 'dired-mode))
           :help "Set a bookmark named inside a file."]
          ["Edit..." bookmark-bmenu-list :visible t :active t
           :help "Display a list of existing bookmarks"]
          ;; ["Save List Now" bookmark-save :visible t :active t
          ;;  :help "Save currently defined bookmarks"]
          )))
    (dolist (bookmark (bookmark-all-names))
      (push (poplife-bookmark-elt-easymap bookmark submenu) map))
    (cons "Bookmark" map)))
;; (let ((foo (poplife-bookmark-easymap))) (describe-variable 'foo))
;; (let ((foo (poplife-bookmark-easymap t))) (describe-variable 'foo))

(defun poplife-bookmark-elt-easymap (bookmark &optional submenu)
  "Define easymenu to list a BOOKMARK.
When SUBMENU it non-nil, this returns an easymenu with multiple actions."
  (let (map)
    (if (not submenu)
        (let ((file (bookmark-get-filename bookmark)))
          (if (and (not (file-remote-p file)) ; when bookmark is directory
                   (file-exists-p file)
                   (file-directory-p file))
              (poplife-dir-easymap file submenu) ; offer DIR menu
            (vector bookmark
                    ;; `(bookmark-jump ,bookmark DISPLAY-FUNC)
                    `(bookmark-jump ,bookmark (quote ,(poplife-func-switch-to-buffer))) ; switch-to-buffer
                    :visible t
                    :active (not (string= ; gray the vising file out
                                  (and (buffer-file-name) (expand-file-name (buffer-file-name)))
                                  (expand-file-name (bookmark-get-filename bookmark))))
                    :help (format "Jump to %s" bookmark))))

      ;; (push (vector "Show Annotation..." `(bookmark-show-annotation ,bookmark) :visible t :active `(bookmark-get-annotation ,bookmark) :help bookmark) map)
      ;; (push (vector "Edit Annotation..." `(bookmark-edit-annotation ,bookmark) :visible t :help bookmark) map)
      (let ((annot-map (poplife-bookmark-annotation-easymap bookmark)))
        (if (vectorp annot-map) ; with no annotation and with "Add Annotation..."
            (push annot-map map)
          (dolist (annot-item (reverse (cdr annot-map)))
            (push annot-item map))
          (push ["--" ignore] map)
          (push (vector "Edit Annotation..." `(bookmark-edit-annotation ,bookmark) :visible t :help bookmark) map)))
      (push (vector "Delete..." `(and (y-or-n-p (format "Are you sure you want to delete a bookmark %s? " ,bookmark)) (bookmark-delete ,bookmark)) :visible t :help bookmark) map)
      (push (vector "Edit Location..." `(bookmark-relocate ,bookmark) :visible t :help bookmark) map)
      (push (vector "Rename..." `(bookmark-rename ,bookmark) :visible t :help bookmark) map)
      (push (vector "Insert Location" `(bookmark-locate ,bookmark) :visible t :help bookmark) map)
      (push (vector "Insert Contents" `(bookmark-insert ,bookmark) :visible t :help bookmark) map)
      (push (vector "Open by File Browser" `(poplife-find-location (expand-file-name (bookmark-get-filename ,bookmark))) :visible t :active t :help bookmark) map)
      (push (vector "Open in Frame" `(bookmark-jump ,bookmark 'switch-to-buffer-other-frame) :visible t :help bookmark) map)
      (push (vector "Open in Other Window" `(bookmark-jump-other-window ,bookmark) :visible t :help bookmark) map)
      (push ["--" ignore] map)
      (push (vector "Open" `(bookmark-jump ,bookmark) :visible t :help bookmark) map) ; switch-to-buffer
      (push (vector ".." `(let ((poplife-file-recursive ,poplife-file-recursive)
                                (poplife-func-find-file (quote ,poplife-func-find-file)))
                            (poplife-find-dir (expand-file-name "../" (bookmark-get-filename ,bookmark)) ,submenu))
                    :visible t :active t) map)
      (let ((annotation (bookmark-get-annotation bookmark)))
        (cons (format "%s%s" bookmark (if (and annotation (not (string-equal annotation ""))) "*" "")) map)))))
;; (let ((foo (poplife-bookmark-elt-easymap "poplife.el\\site-lisp"))) (describe-variable 'foo))
;; (let ((foo (poplife-bookmark-elt-easymap "poplife.el\\site-lisp" t))) (describe-variable 'foo))

(defvar poplife-bookmark-annotation-detail-flag t
  "Show full contents of annotation in popup-menu.")

(defun poplife-bookmark-annotation-easymap (bookmark)
  "Define easymenu to list annotation."
  (let ((annot (bookmark-get-annotation bookmark))
        (annot-column 36)) ; 36 is arbitrary number or (length "Open in Other Window")
    (if (and annot (not (string-equal annot "")))
        (if poplife-bookmark-annotation-detail-flag
            (let ((lines (poplife-split-string annot annot-column))
                  map)
              (dolist (line (reverse lines))
                (push (vector line `(bookmark-edit-annotation ,bookmark) :visible t :active t :help bookmark) map))
              (cons "Edit Annotation..." map))
          (let (annot-name)
            (setq annot-name (format "Edit Annotation `%s'..." (if (> (length annot) annot-column) (substring annot 0 annot-column) annot)))
            (vector annot-name `(bookmark-edit-annotation ,bookmark) :visible t :active t :help bookmark)))
      (vector "Add Annotation..." `(bookmark-edit-annotation ,bookmark) :visible t :active t :help bookmark))))

(defun poplife-split-string (string fill-length)
  "Split STRING into list of string.
Argument FILL-LENGTH determines length of each line."
  (setq string (replace-regexp-in-string
                (rx (* (any " \t\n")) eos) "" string)) ; Chomp text.
  (with-temp-buffer
    (insert string)
    (let ((fill-column fill-length) ; Replace text.
          (find-repl-list '(("\\`\\'" . " ") (" +" . " ")))) ; Avoid having "--" on menu.
      (fill-region (point-min) (point-max))
      (dolist (find-repl find-repl-list)
        (goto-char (point-min))
        (while (re-search-forward (car find-repl) nil t)
          (replace-match (cdr find-repl)))))
    (split-string (buffer-string) "\n"))) ; List of text lines.
\f
;;; File
(defun poplife-file-easymap (file &optional submenu)
  "Define easymenu to list a FILE.
When SUBMENU it non-nil, this returns an easymenu with multiple actions."
  (setq file (expand-file-name file))
  (and (not (file-directory-p file))
       (let* (map
              (file-nickname (file-name-nondirectory file))
              (file-readable-flag (and (file-regular-p file)
                                       (file-readable-p file)))
              (open-file-flag (and (not (string-match-p poplife-file-do-not-open-regexp file))
                                   file-readable-flag))
              (dir (file-name-directory file))
              (open-dir-flag (and (file-directory-p dir)
                                  (file-accessible-directory-p dir))))
         (if (not submenu)
             (vector file-nickname
                     `(funcall (if ,open-file-flag
                                   (quote ,poplife-func-find-file)
                                 (quote ,poplife-func-find-file-by-default-app)) ,file)
                     :active (and file-readable-flag ; gray the vising file out
                                  (not (string=
                                        (and (buffer-file-name) (expand-file-name (buffer-file-name)))
                                        file)))
                     :help file)
           (push (vector "Open with File Browser" `(poplife-find-location ,file)
                         :visible t
                         :active open-dir-flag
                         :help dir) map)
           (push (vector "Open with Default App" `(,poplife-func-find-file-by-default-app ,file)
                         :visible t
                         :active t
                         :help file) map)
           (push (vector "Open and Bookmark..." `(progn (find-file ,file) (bookmark-set))
                         :visible (fboundp 'bookmark-set)
                         :active open-file-flag
                         :help "Open and Bookmark this file") map)
           (push (vector "Open in Frame" `(find-file-other-frame ,file)
                         :visible t
                         :active open-file-flag
                         :help file) map)
           (push (vector "Open in Other Window" `(find-file-other-window ,file)
                         :visible t
                         :active open-file-flag
                         :help file) map)
           (push ["--" ignore] map)
           (push (vector "Open" `(find-file ,file)
                         :visible t
                         :active (and open-file-flag ; gray the vising file out
                                      (not (string=
                                            (and (buffer-file-name) (expand-file-name (buffer-file-name)))
                                            file)))
                         :help file) map)
           (push (vector ".." `(let ((poplife-file-recursive ,poplife-file-recursive)
                                     (poplife-func-find-file (quote ,poplife-func-find-file)))
                                 (poplife-find-dir ,dir, submenu))
                         :visible t :active open-dir-flag :help dir) map)
           (cons file-nickname map)))))
;; (let ((foo (poplife-file-easymap "~/.emacs.d/init.el"))) (describe-variable 'foo))
;; (let ((foo (poplife-file-easymap "~/.emacs.d/init.el" t))) (describe-variable 'foo))

(defun poplife-dir-easymap (dir &optional submenu depth)
  "Define easymenu to list files and directories in DIR.
When SUBMENU is non-nil, this returns an easymenu with multiple actions.
When DEPTH is more than 1, DIR is recursively scanned."
  (when (string-match-p poplife-dir-do-not-scan-regexp dir)
    (setq dir "~"))
  (setq dir (directory-file-name (expand-file-name dir))) ; Remove slash at the end.
  (or depth (setq depth 1))
  (let (map base-dir parent-dir rawfiles menufiles)
    (setq base-dir (file-name-as-directory (if (string= (file-name-nondirectory dir) "")
                                               dir ; In a case for "c:/"
                                             (file-name-nondirectory dir)))) ; Add slash at the end.
    (setq parent-dir (directory-file-name (file-name-directory dir)))
    ;; Obtain a file list.
    (setq rawfiles (ignore-errors (directory-files dir t)))
    ;; Filter out trivial files.
    (dolist (fullfile rawfiles)
      (let ((file-nickname (file-name-nondirectory fullfile)))
        (unless (string-match-p poplife-file-do-not-show-regexp file-nickname)
          (push fullfile menufiles))))
    ;; Limit number of menufiles
    (when (and poplife-file-max-menu-items
               (not submenu))
      (let ((nfile (length menufiles)))
        (setq menufiles (nthcdr (- nfile poplife-file-max-menu-items) menufiles))))
    ;; Add more menu.
    (push (vector "More..." ; Item to open a current directory.
                  `(let (poplife-file-max-menu-items
                         ;; (poplife-file-recursive ,(1+ poplife-file-recursive))
                         (poplife-file-recursive ,poplife-file-recursive)
                         (poplife-func-find-file (quote ,poplife-func-find-file)))
                     (poplife-find-dir ,dir t))
                  :active `(not ,submenu)
                  :visible t
                  :help dir)
          map)
    ;; Create map with files and directories.
    (dolist (fullfile menufiles)
      (let ((file-nickname (file-name-nondirectory fullfile)))
        (if (file-directory-p fullfile) ; when item is directory
            (push (if (or (>= depth poplife-file-recursive)
                          (not (file-accessible-directory-p fullfile)))
                      (vector (file-name-as-directory file-nickname)
                              `(let ((poplife-file-recursive ,poplife-file-recursive)
                                     (poplife-func-find-file (quote ,poplife-func-find-file)))
                                 (poplife-find-dir ,fullfile ,submenu))
                              :active (file-accessible-directory-p fullfile) :help fullfile)
                    (poplife-dir-easymap fullfile submenu (1+ depth))) ; recursive
                  map)
          (push ; when item is file (that is defined as `not a directory')
           (poplife-file-easymap fullfile submenu)
           map))))
    (push ["--" ignore] map)
    (push (if (not (or submenu poplife-dir-.-submenu)) ; (not submenu)
              ;; Single item
              (vector "." ; item to open current directory
                      `(,poplife-func-find-file ,dir)
                      ;; `(,poplife-func-find-file-by-default-app ,dir)
                      :visible t :active t :help dir)
            ;; Multiple items in submenu.
            (delq nil
                  (list "."
                        (vector "Open" ; item to open current directory
                                `(find-file ,dir) ; ,poplife-func-find-file
                                :visible t :active t :help dir)
                        ["--" ignore]
                        (vector "Open in Other Window"
                                `(find-file-other-window ,dir)
                                :visible t :active t :help dir)
                        (vector "Open in Frame"
                                `(find-file-other-frame ,dir)
                                :visible t :active t :help dir)
                        (vector "Open with Bookmarked..."
                                `(progn (find-file ,dir) (bookmark-set))
                                :visible (fboundp 'bookmark-set) :active t :help "Open and Add to Bookmarks")
                        (vector "Open by File Browser"
                                `(,poplife-func-find-file-by-default-app ,dir)
                                :visible t
                                :active t
                                :help dir))))
          map)
    (push (vector ".." ; Item to open parent directory.
                  `(let ((poplife-file-recursive ,poplife-file-recursive)
                         (poplife-func-find-file (quote ,poplife-func-find-file)))
                     (poplife-find-dir ,parent-dir ,submenu))
                  :active `(not (equal ,parent-dir ,dir)) :help parent-dir)
          map)
    (setq base-dir (replace-regexp-in-string "^@" "at" base-dir t t))
    (cons base-dir map)))
;; (let ((foo (poplife-dir-easymap "~/.emacs.d"))) (describe-variable 'foo))
;; (let ((foo (poplife-dir-easymap "~/.emacs.d" t))) (describe-variable 'foo))
;; (popup-menu (poplife-dir-easymap "~/.emacs.d"))
;; (popup-menu (poplife-dir-easymap "~/"))
;; (let ((foo (poplife-dir-easymap "c:/"))) (describe-variable 'foo))
;; (popup-menu (poplife-dir-easymap "c:/"))

(defvar poplife-dir-.-submenu t
  "Show always submenu for the current directory.")

(defun poplife-pwd-easymap (path &optional submenu)
  "Define easymenu to list directories that are above PATH."
  (setq path (directory-file-name (expand-file-name path))) ; remove slash
  (let* ((title (format (if (file-directory-p path)
                            "%s/"
                          "%s")
                        (file-name-nondirectory path)))
         dirpath
         map)
    (while (not (string= (file-name-nondirectory path) "" ))
      (setq dirpath (directory-file-name (file-name-directory path))) ; remove slash
      (push (vector (format "%s/" (file-name-nondirectory dirpath)) ; dirname
                    `(poplife-find-location ,path)) map)
      (setq path dirpath))
    (cons title (reverse map))))
;; (let ((foo (poplife-pwd-easymap "~/.emacs.d/site-lisp/poplife.el"))) (describe-variable 'foo))
;; (popup-menu (poplife-pwd-easymap default-directory))
;; (popup-menu (poplife-pwd-easymap "~/.emacs.d/site-lisp/"))

(defun poplife-pwd-menu-open (event)
  "Open popup-menu that opens a folder by File Browser."
  (interactive "e")
  (mouse-set-point event)
  (popup-menu
   (poplife-pwd-easymap (or buffer-file-name default-directory))))
;; (poplife-pwd-menu-open last-nonmenu-event)

(defun poplife-buffer-menu-open (event)
  "Open popup-menu that switches current buffer."
  (interactive "e")
  (mouse-set-point event)
  (popup-menu (poplife-buffer-easymap)))
;; (poplife-buffer-menu-open last-nonmenu-event)

\f
;;; Util
(defun poplife-func-switch-to-buffer ()
  "Return switch-to-buffer function that corresponds to `poplife-func-find-file'."
  (cdr (assoc poplife-func-find-file
              '((find-file . switch-to-buffer)
                (find-file-other-window . switch-to-buffer-other-window)
                (find-file-other-frame . switch-to-buffer-other-frame)))))
;; (let ((foo (poplife-func-switch-to-buffer))) (describe-variable 'foo))

(defun poplife-find-dir (dir &optional submenu)
  "Visit directory DIR using `popup-menu'.
When SUBMENU is non-nil, this offers multiple actions."
  ;; (interactive (list (read-directory-name "Find directory: ")))
  (popup-menu (poplife-dir-easymap dir submenu)
              (popup-menu-normalize-position last-nonmenu-event)))

(defun poplife-finder-directory ()
  "Return directory where Finder is visiting."
  (when (eq system-type 'darwin)
    (ns-do-applescript
     "tell application \"Finder\"
        if exists Finder window 1 then
          set currentDir to target of Finder window 1 as alias
        else
          set currentDir to desktop as alias
        end if
          set thePath to POSIX path of currentDir
      end tell")))
;; (let ((foo (poplife-finder-selection))) (describe-variable 'foo))

(defun poplife-find-location (file)
  "Visit directory that contains FILE."
  ;; org-open-file
  (cond
   ((eq system-type 'darwin)
    ;; Select file in Finder.
    (ns-do-applescript                  ; do-applescript, osascript
     (format "tell application \"Finder\"
                  set thePath to POSIX file \"%s\" as string
                  activate
                  reveal thePath
              end tell" file)))
   ((eq system-type 'windows-nt)
    ;; Select file in File Explorer.
    (w32-shell-execute "open" "explorer"
                       (concat "/e,/select,"
                               (poplife-convert-w32-filename file))))
   ((eq system-type 'gnu/linux)
    ;; Visit dir that contains file by default-app.
    ;; (start-process "select-file-by-nautilus" nil "nautilus" file)
    (start-process "open-dir-by-xdg-open" nil "xdg-open" (file-name-directory file)))
   (t
    ;; Select file in Dired
    (dired-other-frame (file-name-directory file)) ; Visit dir that contains file
    (dired-goto-file file)))) ; Move point to file

(defun poplife-convert-w32-filename (filename)
  "Mirror slash characters in FILENAME into backslashes."
  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24387 (bug#24387)
  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28883 (bug#28883)

  ;; (setq filename (convert-standard-filename filename))
  (let ((start 0))
    (while (string-match "/" filename start)
      (aset filename (match-beginning 0) ?\\)
      (setq start (match-end 0)))
    filename))
;;; (poplife-convert-w32-filename "c:/Users/dream/.emacs.d")

(defun poplife-find-file-by-default-app (file)
  "Visit FILE by default application or default file browser."
  (when (plist-get poplife-mouse-edit-cottager :recentf)
    (recentf-push file))
  (cond
   ((eq system-type 'gnu/linux)
    (start-process "find-file-by-default-app" nil "xdg-open" file)) ; Visit file by default-app.
   ((eq system-type 'darwin)
    (start-process "find-file-by-default-app" nil "open" file)) ; Visit file by default-app.
   ((eq system-type 'cygwin)
    (start-process "find-file-by-default-app" nil "cygstart" file)) ; Visit file by default-app.
   ((eq system-type 'windows-nt)
    (w32-shell-execute "open" "explorer" (poplife-convert-w32-filename file))) ; Visit file by default-app.
   (t
    (find-file-other-frame file))))

(provide 'poplife)
;;; poplife.el ends here

[-- Attachment #3: Type: text/plain, Size: 2 bytes --]




^ permalink raw reply	[flat|nested] 59+ messages in thread
* Context menus and mouse-3       [was: Changes for emacs 28]
@ 2020-09-14  3:06 Drew Adams
  2020-09-14  6:11 ` Ergus
  0 siblings, 1 reply; 59+ messages in thread
From: Drew Adams @ 2020-09-14  3:06 UTC (permalink / raw)
  To: Ergus
  Cc: philipk, Richard Stallman, emacs-devel, Arthur Miller,
	Dmitry Gutov, Gregory Heytings

Ergus> The real problem is that now the right click
Ergus> is bind to mouse-save-then-kill which I have
Ergus> never ever used, but probably others have.

and earlier:

Ergus> Sadly we have <mouse-3> bind to mouse-save-then-kill
Ergus> which I don't find useful at all, but maybe
Ergus> somebody will complain if we change it to
Ergus> C-<mouse-3> and move the panel to <mouse-3>.

I suspect that people who use a mouse but feel
that `mouse-save-then-kill' isn't useful have
never really understood what it offers.

Part of the lack of understanding may come from
not having read the manual about it.  Node `Mouse
Commands' of the Emacs manual makes the behavior
clear, and thus how useful it can be.

`mouse-3' lets you select text, delete or kill
text, and extend or reduce the selection.
That's a lot, and the actions to do those things
fit well together.

The extend-or-reduce bit works in a special way
if you've selected text by multiple clicking:
double-clicking or triple-clicking `mouse-1'.
I invite you to read the full text, if you
haven't already.  And then play with it a bit.
___

What happens if you just read the doc string?
You don't get a great idea of the richness of
`mouse-3' behavior, IMO.  It's OK, as far as a
doc string goes.  But it's unlikely to teach
someone what they can do with it.

Here's a suggestion for that doc string, and
also for the doc strings for other `mouse-*'
bindings (keys and commands): Provide a link
to that `Mouse Commands' node in the manual.
___

To me, the behavior of `mouse-save-then-kill'
is super useful.  So much so that my library
`mouse3.el' has, as a big part of its design,
to keep that behavior, while supplementing it
with `mouse-3' context menus.

You can of course optionally just get the menus.
But that's not where it's at - not the default
behavior.  The idea is to let you use the normal
behavior as many times as you like - extend,
reduce, kill, whatever - and then, if you like,
click `mouse-3' at the same place again, to pop
up a context menu.

The first part is optional, and so is the menu
popping.  Click in the same spot for the menu.
Click anywhere else for the vanilla behavior.

The other big part of the design is context
menu definition and behavior.  Those two parts
are logically independent, but it makes sense
for them to be in the same library.

There are alternative ways to define the menus,
and alternative ways to present them.  Menus can
be mode-dependent or not, dynamic (programmed)
or static.

Menus can, and generally do, differ, depending
on whether or not the region is active.  When
active, a context menu provides actions on the
region or things in it.  When inactive, it
provides actions on thing(s) located where you
click.

(There are always multiple things located at the
spot where you click.  It's up to a particular
menu to decide which things to act on.)
___

Should a context menu include _only_ items that
pertain to the region or the location clicked?
In general, no.  But you can certainly have
menus that do provide only that, if you want.

Should a context menu include global menus as
submenus, i.e., major-mode menus or menu-bar
menus?  That's up to you - an option controls
this.  If non-nil then yes: if the menu-bar is
visible then include the major-mode menus; else
include the menu-bar menus.
___

There are two alternative ways to define the
menus: (1) use keymaps and extended menu items
or (2) use the `x-poup-menu' form.  The former
is the default method.  It gives you more
control: keywords such as :visible and :enable,
for instance.  The latter is a bit simpler for
defining, perhaps.

Simple example code of using each method is
provided in `mouse3.el', with explanation.
An example of method #1 is provided for use
with Dired mode.  An example of #2 is provided
for use with Picture mode.
___

`mouse3.el' is completely compatible with the
traditional Emacs `mouse-3' behavior.  The
only place where they overlap is if you click
`mouse-3' twice at the same spot.

If you do that to delete the selected text,
then to get that effect with `mouse3.el' you
double-click instead.  Vanilla Emacs doesn't
distinguish a double-click from two clicks
separated by more than the double-click time.

(You can swap those two behaviors: slow 2-click
to delete instead of to show menu.)



^ permalink raw reply	[flat|nested] 59+ messages in thread
end of thread, other threads:[~2021-07-22  3:49 UTC | newest]

Thread overview: 59+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-09-16  6:28 Context menus and mouse-3 Tak Kunihiro
2020-09-16 14:18 ` Eli Zaretskii
2020-09-16 14:37   ` Thibaut Verron
2020-09-16 15:06     ` Eli Zaretskii
2020-09-16 15:39       ` Thibaut Verron
2020-09-17  3:57     ` Richard Stallman
2020-09-16 19:45 ` Juri Linkov
2020-09-16 23:49   ` Tak Kunihiro
2020-09-17  2:33     ` Tak Kunihiro
2020-09-17  7:43     ` Juri Linkov
2020-09-17  9:22       ` Robert Pluim
2020-09-17 18:59         ` Juri Linkov
2020-09-17 19:41       ` chad
2020-09-18  8:23         ` Juri Linkov
2020-09-18 18:41           ` chad
  -- strict thread matches above, loose matches on Subject: below --
2020-09-14  3:06 Context menus and mouse-3 [was: Changes for emacs 28] Drew Adams
2020-09-14  6:11 ` Ergus
2020-09-14  6:28   ` Stefan Monnier
2020-09-15  4:35     ` Richard Stallman
2020-09-15 13:11       ` Stefan Monnier
2021-07-11 23:38         ` Context menus and mouse-3 Juri Linkov
2021-07-12 11:55           ` Eli Zaretskii
2021-07-12 20:56             ` Juri Linkov
2021-07-13 11:32               ` Eli Zaretskii
2021-07-13 23:46                 ` Juri Linkov
2021-07-14  4:30                   ` Eli Zaretskii
2021-07-14 23:37                     ` Juri Linkov
2021-07-15  6:22                       ` Eli Zaretskii
2021-07-15 22:23                         ` Juri Linkov
2021-07-16  6:49                           ` Eli Zaretskii
2021-07-16 18:59                             ` Juri Linkov
2021-07-18  5:13                               ` Tak Kunihiro
2021-07-18 15:53                                 ` Stefan Monnier
2021-07-19 15:55                                   ` Juri Linkov
2021-07-19 16:37                                     ` Stefan Monnier
2021-07-20 20:52                                       ` Juri Linkov
2021-07-20 22:24                                         ` Stefan Monnier
2021-07-20 23:15                                           ` Juri Linkov
2021-07-21  4:39                                             ` Tak Kunihiro
2021-07-21 12:45                                               ` Stefan Monnier
2021-07-21 17:26                                                 ` [External] : " Drew Adams
2021-07-22  3:49                                                   ` Tak Kunihiro
2021-07-19 19:59                                     ` Ergus via Emacs development discussions.
2021-07-20 20:51                                       ` Juri Linkov
2021-07-12 22:32           ` Stefan Monnier
2021-07-12 23:56             ` Juri Linkov
2021-07-13  3:01               ` Stefan Monnier
2021-07-13 23:32                 ` Juri Linkov
2021-07-14  2:14                   ` Stefan Monnier
2021-07-14 23:32                     ` Juri Linkov
2021-07-15  1:18                       ` Stefan Monnier
2021-07-15 22:31                         ` Juri Linkov
2021-07-16 15:46                           ` Stefan Monnier
2021-07-16 18:50                             ` Juri Linkov
2021-07-16 19:25                               ` Stefan Monnier
2021-07-15  6:24                       ` Eli Zaretskii
2021-07-15 22:28                         ` Juri Linkov
2021-07-16  6:51                           ` Eli Zaretskii
2021-07-16 18:56                             ` Juri Linkov
2021-07-16 23:13                               ` Stefan Kangas
2021-07-17  6:22                                 ` Eli Zaretskii
2021-07-17 21:46                                   ` Juri Linkov
2021-07-17  6:02                               ` Eli Zaretskii
2021-07-19 17:48                                 ` Stefan Kangas
2021-07-19 18:08                                   ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).