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
next prev parent 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.