poplife-mode

[Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>]

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

With following line, one can cut and paste text using a pop-up menu
triggered by right click.

(define-key global-map [mouse-3] menu-bar-edit-menu)

I noticed that menu-bar items that lead visiting files, buffers,
frames, bookmarks, and recentf can be gathered into a pop-up menu.

I wrote a minor mode `poplife' that provides an integrated pop-up menu
triggered by right click.  Also this minor mode offers contextual
pop-up menus.  When a thing under mouse click is file/directory, word,
and url, this provides pop-up menus of list of files, candidates of
words, and url-opening-menu, respectively.

(require 'poplife)
(setq poplife-word-flag t)
(setq poplife-url-flag t)
(setq poplife-edit-cottager '(:imenu t :buffer t :frame t :bookmark t :recentf t))
(poplife-mode 1)

Contextual pop-up menu by right click is very common interface
nowadays and I propose to include this (or something like this) to
Emacs.


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

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

;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
;; Keywords: mouse
;; Package: emacs

;; 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 contextual menu triggered by right click.  On a
;; click, depending on a thing under the mouse event, (1)
;; FILE/DIRECTORY menu, (2) WORD menu, (3) URL menu, or (4) EDIT menu
;; will be popped.  The edit menu lets you revise buffer and visit a
;; file in a directory.  As an option, the edit menu also lets you
;; jump by iMenu, switch to a buffer, switch to a frame, visit a
;; bookmark, and visit a recent file.  The four menus are detailed as
;; below.
;;
;; (1) FILE/DIRECTORY menu
;;
;; List how-to-open-a-file menu or files in
;; default-directory under a mouse event.
;;
;; (2) WORD menu
;;
;; Pop word candidates when word under a mouse event is incorrect,
;; when `poplife-word-flag' is non-nil.
;;
;; (3) URL menu
;;
;; Pop how-to-open-an-url menu under a mouse event, when
;; `poplife-url-flag' is non-nil.
;;
;; (4) EDIT menu
;;
;; List basic edition-commands, optional edition-commands,
;; and visiting menus.
;;
;; Basic edition-commands are defined by `poplife-edit-cmd-0'.
;;
;; Optional edition-commands are defined by `poplife-edit-cmd-1'.
;; with format similar to `recentf-menu-items-for-commands'.
;;
;; Visiting menu to visit files in default-directory is included by
;; default.  To include a series of visiting menus, set each item of
;; `poplife-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'.

;;; References

;; Following discussions were referred to 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
;;
;; 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))
;; (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
;;
;; Keymaps from imenu, menu-bar, bookmark, and recentf are united.
;; They are formatted to be 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:
(defcustom poplife-word-flag nil
  "Popup words under mouse event using `flyspell-correct-word'."
  :group 'mouse
  :type 'boolean
  :version "26.1")

(defcustom poplife-url-flag nil
  "Popup URL menu under mouse event using `eww'."
  :group 'mouse
  :type 'boolean
  :version "26.1")

(defcustom poplife-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'."
  :group 'mouse
  :type '(repeat symbol)
  :version "26.1")

(defvar poplife-edit-cmd-1
  (list
   ["Close"
    (lambda () (interactive)
      (if (one-window-p)
          (if (> (length (visible-frame-list)) 1)
              (call-interactively 'delete-frame)
            (quit-window)) ; (kill-buffer (window-buffer))
        (delete-window)))
    :help "Remove this window 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 poplife-word-flag
                  (fboundp 'flyspell-correct-word-before-point)
                  (not (region-active-p)))
    :active t]
   ["Spell-Check"
    ispell-region
    :help "Spell check selected text"
    :visible (and poplife-word-flag
                  (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 (and poplife-url-flag
                  (region-active-p))
    :active t]
   ["--"
    ignore
    :visible (and (region-active-p)
                  (or poplife-word-flag poplife-url-flag))
    :active t])
  "Optional commands in edit menu.")

(defvar poplife-edit-cottager
  '(:imenu nil :buffer nil :frame nil :bookmark nil :recentf nil)
  "Extra menus to be included in edit menu besides file.")
\f
(defvar poplife-file-max-menu-items 25
  "Maximum number of items in file 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 directory menu.")

(defvar poplife-dir-do-not-scan-regexp "inbox"
  "Contents of directory matching this regexp will not be shown.
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\\.gz\\'\\|\\.synctex\\.ico\\'\\|^Thumbs\\.db\\'\\|^Icon"
  "Filenames matching this regexp will not be displayed in file 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\\'"
  "Filenames matching this regexp will not be suggested to open by file menu.")

(defvar poplife-func-find-file 'find-file
  "Function to visit a file, and a Recentf element.
Depending on context, this is internally overwritten to be
`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 contextual menu by right click."
  :init-value nil
  :group 'mouse
  :global t
  :keymap (let ((map (make-sparse-keymap)))
            (define-key map [mouse-3]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (define-key map [drag-mouse-3]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (define-key map [C-down-mouse-1] 'ignore)
            (define-key map [C-mouse-1]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (define-key map [C-double-mouse-1]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (define-key map [C-triple-mouse-1]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (define-key map [C-drag-mouse-1]
              `(menu-item "Edit menu" poplife-menu-keymap
                          :filter ,(lambda (_) (poplife-menu-keymap (aref (this-command-keys) 0)))))
            (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)
            map))

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

(defun poplife-menu-keymap (event)
  "Define keymap for contextual edit menu on mouse click EVENT.
When point in on word that is misspelled, return symbol
flyspell-correct-word.  When mouse click EVENT is on file or
directory, return file-menu map.  Otherwise return edit-menu
map."
  (let (file-easymap
        dir-easymap
        faces-at-point
        url-easymap
        (no-region (not (region-active-p))))
    (cond
     ;; FILE menu
     ((and no-region
           (setq file-easymap (if (equal major-mode 'dired-mode)
                                  (and
                                   (mouse-posn-property (event-start event) 'dired-filename)
                                   (poplife-file-easymap (save-excursion
                                                           (mouse-set-point event)
                                                           (dired-get-file-for-visit))
                                                         t))
                                (poplife-file-on-click-easymap event))))
      (easy-menu-create-menu (car file-easymap) (cdr file-easymap)))
     ;; DIRECTORY menu
     ((and no-region
           (if (equal major-mode 'dired-mode)
               (mouse-posn-property (event-start event) 'dired-filename)
             t)
           (setq dir-easymap
                 (poplife-dir-on-click-easymap event)))
      (easy-menu-create-menu (car dir-easymap) (cdr dir-easymap)))
     ;; WORD menu
     ((and no-region
           poplife-word-flag
           ;; Check face by (what-cursor-position t) or C-u C-x =.
           (setq faces-at-point (mapcar (lambda (xxx) (overlay-get xxx 'face))
                                        (overlays-at (posn-point (event-start event)))))
           (or (member 'flyspell-incorrect faces-at-point)
               (member 'flyspell-duplicate faces-at-point)))
      #'flyspell-correct-word) ; flyspell-correct-word-before-point
     ;; URL menu
     ((and no-region
           poplife-url-flag
           (setq url-easymap (poplife-url-on-click-easymap event)))
      (easy-menu-create-menu (car url-easymap) (cdr url-easymap)))
     ;; else
     (t
      ;; menu-bar-edit-menu
      (poplife-edit-map event)))))

(defun poplife-what-mouse-position (event)
  "Evaluate text properties under mouse click."
  (interactive "e")
  ;; Check also `C-u C-x ='.
  (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)))))

(defun poplife-file-on-click-easymap (event)
  "Define easymenu of a file that is under mouse click EVENT.
The file is identified by `ffap-guesser'."
  (save-excursion
    (mouse-set-point event) ; ~/.emacs.d/init.el
    (let ((file (ffap-guesser))) ; 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)))))

(defun poplife-dir-on-click-easymap (event)
  "Define easymenu of files and directories in directory that is under mouse click EVENT.
The directory is identified by `ffap-guesser'."
  (save-excursion
    (mouse-set-point event) ; ~/.emacs.d/
    (let ((dir (ffap-guesser))) ; https://www.gnu.org/software/emacs/
      (when (and dir
                 (not (ffap-file-remote-p dir)))
        (poplife-dir-easymap (file-name-as-directory dir) t)))))

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

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

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

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

        ;; Recentf
        (when (plist-get poplife-edit-cottager :recentf)
          (easy-menu-add-item map nil (poplife-recentf-easymap)))

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

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

      ;; Option
      (when poplife-edit-cmd-1
        (dolist (item poplife-edit-cmd-1)
          (setq item (append item nil)) ; Convert vector to list.
          (let ((name (car item)))
            (bindings--define-key map (vector (easy-menu-make-symbol name))
              (append `(menu-item ,name) (cdr item))))))

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

      map)))
;; (let ((foo (poplife-edit-map 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."
  (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
                  ;; ["poplife-word-flag" (imenu--menubar-select '("poplife-edit-cottager" . #<marker at 3207 in poplife.el>))]
                  ;; (vector (car item) (list cmd `(quote ,item)))
                  (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 such for ("Variables"...), resolve it until atom
              (poplife-imenu-submenufy-easymap item))
             ((vectorp item) ; when an item is vector such for ["poplife-word-flag" (imenu--menubar-select...)]
              (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-edit-cottager"
        (cmd (nth 3 (aref elt 1))) ; (imenu--menubar-select '("poplife-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 (switch-to-buffer-other-frame ,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" (make-frame-command)] map)
    (let* ((dir-map (poplife-dir-easymap default-directory)))
      (push ["--" ignore] map)
      (when (plist-get poplife-edit-cottager :buffer)
        (push (poplife-buffer-easymap) map))
      (when (plist-get poplife-edit-cottager :bookmark)
        (push (poplife-bookmark-easymap) map))
      (when (plist-get poplife-edit-cottager :recentf)
        (push (poplife-recentf-easymap) map))
      (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-vec (nth 2 global-buffers-menu-map))
        (menu-bar-select-buffer-function (poplife-func-switch-to-buffer))
        map)

    ;; Add submenu on request.
    (dolist (elt (append buffer-vec nil)) ; Convert vector to 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)

    (let* ((dir-map (poplife-dir-easymap default-directory)))
      (push ["--" ignore] map)
      (when (plist-get poplife-edit-cottager :bookmark)
        (push (poplife-bookmark-easymap) map))
      (when (plist-get poplife-edit-cottager :recentf)
        (push (poplife-recentf-easymap) map))
      (setcar dir-map "File") ; "Open", "Directory", "File"
      (push dir-map 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-elt-easymap (elt &optional submenu)
  "Define easymenu a buffer ELT.
When SUBMENU is non-nil, this returns an easymenu with multiple actions."
  ;; 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)
         (nickname (car elt))
         (buf (nth 2 (nth (if (equal (length elt) len245) nth245 nth252) elt))))
    (if (not submenu)
        (let* (imenu-map)
          (if (and (plist-get poplife-edit-cottager :imenu)
                   (equal (current-buffer) buf)
                   (setq imenu-map (poplife-imenu-easymap)))
              imenu-map
            (vector nickname `(funcall (quote ,menu-bar-select-buffer-function) ,buf)
                    :active `(not (equal ,(current-buffer) ,buf)))))
      (list nickname
            (vector "Open" `(switch-to-buffer ,buf) :active `(not (equal ,(current-buffer) ,buf)))
            ["--" ignore]
            (vector "Open in Other Window" `(switch-to-buffer-other-window ,buf))
            (vector "Open in Frame" `(switch-to-buffer-other-frame ,buf))))))
\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 List..."
             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."
  (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 List..." 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 directory 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 in 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 in File Browser" `(poplife-find-location ,file)
                         :visible t
                         :active open-dir-flag
                         :help dir) map)
           (push (vector "Open by Default App" `(,poplife-func-find-file-by-default-app ,file)
                         :visible t
                         :active t
                         :help file) map)
           (push (vector "Open with Bookmarked..." `(progn (find-file ,file) (bookmark-set))
                         :visible (fboundp 'bookmark-set)
                         :active open-file-flag
                         :help "Open and Add to Bookmarks") 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 (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 submenu)
              ;; Single item
              (vector "." ; item to open current directory
                      `(,poplife-func-find-file ,dir ,submenu)
                      :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 in 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 t :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 "~/"))
\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-find-location (file)
  "Visit directory that contains FILE."
  (cond
   ((eq system-type 'darwin)
    ;; Select file in Finder.
    (ns-do-applescript
     (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 Explore.
    (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 (file-name)
  "Mirror slash characters in file names into backslashes."
  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24387
  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28883
  (let ((start 0))
    (while (string-match "/" file-name start)
      (aset file-name (match-beginning 0) ?\\)
      (setq start (match-end 0)))
    file-name))

(defun poplife-find-file-by-default-app (file)
  "Visit FILE by default application or default file browser."
  (when (plist-get poplife-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))))

(defun poplife-url-on-click-easymap (event)
  "Define easymenu of an URL that is under mouse click EVENT.
The URL is identified by `thing-at-point-url-at-point'."
  (save-excursion
    (mouse-set-point event)
    ;; https://www.gnu.org/software/emacs/
    (let ((url (or (thing-at-point-url-at-point t)
                   (get-text-property (point) 'shr-url)
                   (get-text-property (point) 'image-url))))
      (when url
          (list url
                (vector "Open"
                        `(eww ,url)
                        :visible t :active t :help url)
                ["--" ignore]
                (vector "Copy Link Location"
                        `(kill-new ,url)
                        :visible t :active t :help url)
                (vector "Open 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 in Frame"
                        `(progn
                          (switch-to-buffer-other-frame (generate-new-buffer "*eww*"))
                          (eww-mode)
                          (eww ,url))
                        :visible t :active t :help url)
                (vector "Open by Default App"
                        `(let ((browse-url-browser-function 'browse-url-default-browser))
                           (browse-url ,url))
                        :visible t
                        :active t
                        :help url))))))

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