all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
To: Juri Linkov <juri@linkov.net>
Cc: 国広卓也 <tkk@misasa.okayama-u.ac.jp>, emacs-devel@gnu.org
Subject: Re: Context menus and mouse-3
Date: Thu, 17 Sep 2020 11:33:18 +0900	[thread overview]
Message-ID: <8CB7DE3D-E69F-4031-B1DF-4F8271EF8660@misasa.okayama-u.ac.jp> (raw)
In-Reply-To: <26336BF5-CDA2-4CED-90B9-5CCB1155CFD2@misasa.okayama-u.ac.jp>

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

>>> * 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.
>> 
>> Thanks, this is a good starting point for adding contextual menu.
>> I tried poplife-mode, and it pops up the menu on mouse-3,
>> but it seems only when there is the selection already,
>> i.e. it doesn't pop up the menu when nothing is selected.
>> Is this intended to work this way?

I fixed it and confirm with Emacs -Q.  Can you try again to see
the approach to start with?


[-- Attachment #2: poplife.el --]
[-- Type: application/octet-stream, Size: 62823 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: 20200917.1125

;; 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 in EDIT menu, 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:

;; * Contextual menu
;; https://lists.gnu.org/archive/html/emacs-devel/2020-09/msg01277.html
;;
;; * 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)
(require 'info)

;;;###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* ((ffap-url-regexp nil) (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* ((ffap-url-regexp nil) (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

  reply	other threads:[~2020-09-17  2:33 UTC|newest]

Thread overview: 59+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
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 [this message]
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

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=8CB7DE3D-E69F-4031-B1DF-4F8271EF8660@misasa.okayama-u.ac.jp \
    --to=tkk@misasa.okayama-u.ac.jp \
    --cc=emacs-devel@gnu.org \
    --cc=juri@linkov.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.