Download
(require 'naked nil t)
(defvar picture-killed-rectangle)
(defvar mouse-drag-copy-region)
(defgroup mouse3 nil
"Behaviors for `mouse-3' 2nd click at same spot, including popup menu."
:prefix "mouse3-"
:group 'mouse
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=mouse3.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs version and mouse3.el `Update #'."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download"
"http://www.emacswiki.org/cgi-bin/wiki/mouse3.el")
:link '(url-link :tag "Description"
"http://www.emacswiki.org/cgi-bin/wiki/Mouse3")
:link '(emacs-commentary-link :tag "Doc" "mouse3"))
(defvar mouse3-save-then-kill-command nil
"Command used for a 2nd `mouse-3' click at the same location, or nil.
The command must accept 2 args: mouse click event and prefix arg.
If non-nil, the command is used in priority over the value of user
option `mouse3-second-click-default-command'. If nil, this var has no
effect on `mouse-3' behavior.")
(defcustom mouse3-second-click-default-command 'mouse3-region-popup-menu
"*Command used for a second `mouse-3' click at the same location.
The command must accept 2 args: mouse click event and prefix arg.
This is a default value, which can be programmatically overridden in
various contexts. This option is used only if variable
`mouse3-save-then-kill-command' is nil.
Two particular values:
`mouse3-region-popup-menu': Pop up a menu of actions on the region.
`mouse3-kill/delete-region': Kill or delete the region, according to
`mouse-drag-copy-region'.
See also `mouse3-double-click-command'. You will probably want to
customize these two options together. To make either a no-op, set the
value to command `ignore'.
Note that setting `mouse3-double-click-command' to
`mouse3-region-popup-menu' and `mouse3-second-click-default-command'
to `mouse3-kill/delete-region' is not recommended, because in Emacs a
double-click event is always preceded automatically by the associated
single-click event. See `(elisp) Repeat Events'."
:type '(choice
(const :tag "Menu" :value mouse3-region-popup-menu)
(const :tag "Kill/delete, per `mouse-drag-copy-region'" :value mouse3-kill/delete-region)
(restricted-sexp :tag "Other Command (two args)" :match-alternatives (commandp)))
:initialize 'custom-initialize-set
:group 'mouse3)
(defcustom mouse3-double-click-command 'mouse3-kill/delete-region
"*Command used for a `mouse-3' double-click.
The command must accept 2 args: mouse click event and prefix arg.
Two particular values:
`mouse3-region-popup-menu': Pop up a menu of actions on the region.
`mouse3-kill/delete-region': Kill or delete the region, according to
`mouse-drag-copy-region'.
See also `mouse3-second-click-default-command'. You will probably
want to customize these two options together. To make either a no-op,
set the value to command `ignore'.
Note that setting `mouse3-double-click-command' to
`mouse3-region-popup-menu' and `mouse3-second-click-default-command'
to `mouse3-kill/delete-region' is not recommended, because in Emacs a
double-click event is always preceded automatically by the associated
single-click event. See `(elisp) Repeat Events'."
:type '(choice
(const :tag "Kill/delete, per `mouse-drag-copy-region'" :value mouse3-kill/delete-region)
(const :tag "Menu" :value mouse3-region-popup-menu)
(restricted-sexp :tag "Other Command (two args)" :match-alternatives (commandp)))
:set (lambda (symbol value)
(set symbol value)
(global-set-key [double-mouse-3] value)
(global-set-key [left-fringe double-mouse-3] value)
(global-set-key [right-fringe double-mouse-3] value))
:initialize 'custom-initialize-set
:group 'mouse3)
(defcustom mouse3-region-popup-include-global-menus-flag t
"*Non-nil means `mouse-3' menu includes major-mode or menu-bar menus.
When non-nil:
If the menu bar is visible then include the major-mode menus.
Otherwise, include the menu-bar menus.
This option has no effect unless
`mouse3-region-popup-x-popup-panes-flag' is nil, and it has no effect
before Emacs 23."
:type 'boolean :group 'mouse3)
(defcustom mouse3-region-popup-x-popup-panes-flag nil
"*Non-nil means use `mouse3-region-popup-x-popup-panes'.
If nil, or if `mouse3-region-popup-x-popup-panes' is nil, use
`mouse3-region-popup-entries' instead."
:type 'boolean :group 'mouse3)
(defcustom mouse3-region-popup-x-popup-panes
`(("Remove/Replace"
,@`(("Kill" . kill-region)
("Delete" . delete-region)
("Yank (Replace)" . (lambda (start end)
"Replace selected text by last text killed."
(interactive "r")
(when (string= (buffer-substring-no-properties
(point) (mark))
(car kill-ring))
(current-kill 1))
(delete-region start end)
(yank)))
("--")
("Kill Rectangle" . kill-rectangle)
("Delete Rectangle" . delete-rectangle)
("Yank Rectangle (Replace)"
. (lambda (start end)
"Replace the selected rectangle by the last rectangle killed."
(interactive "r")
(delete-rectangle start end)
(exchange-point-and-mark)
(yank-rectangle)))
("Clear Rectangle (Replace)" . clear-rectangle)
("String Rectangle (Replace)" . string-rectangle)
("Replace Rectangle from Register"
. (lambda (start end)
"Replace the selected rectangle by the contents of a register you name.
Note that the rectangle currently selected is first killed. You can
restore it by yanking."
(interactive "r")
(kill-rectangle start end)
(exchange-point-and-mark)
(condition-case nil
(call-interactively #'insert-register)
(error (exchange-point-and-mark) (yank-rectangle)))))))
("Copy"
("Copy as Kill" . kill-ring-save)
("Copy to Register" . copy-to-register)
("--")
("Copy Rectangle to Register" . copy-rectangle-to-register))
("Register"
("Copy to..." . copy-to-register)
("Delete to..."
. (lambda (register start end)
"Delete the selected text, and copy it to a register you name."
(interactive "cDelete region to register: \nr")
(copy-to-register register start end t)))
("Append to..." . append-to-register)
("Prepend to..." . prepend-to-register)
("--")
("Copy Rectangle to..." . copy-rectangle-to-register)
("Delete Rectangle to..."
. (lambda (register start end)
"Delete the selected rectangle, and copy it to a register you name."
(interactive "cDelete rectangle to register: \nr")
(copy-rectangle-to-register register start end t))))
("Rectangle"
("Kill" . kill-rectangle)
("Delete" . delete-rectangle)
("Open" . open-rectangle)
("Yank (Replace)"
. (lambda (start end)
"Replace the selected rectangle by the last rectangle killed."
(interactive "r")
(delete-rectangle start end)
(exchange-point-and-mark)
(yank-rectangle)))
("Clear (Replace)" . clear-rectangle)
("String (Replace)" . string-rectangle)
,@`,(and (fboundp 'delimit-columns-rectangle)
'(("Delimit Columns" . delimit-columns-rectangle)))
("--")
("Delete to Register"
. (lambda (register start end)
"Delete the selected rectangle, and copy it to a register you name."
(interactive "cDelete rectangle to register: \nr")
(copy-rectangle-to-register register start end t)))
("Replace from Register"
. (lambda (start end)
"Replace the selected rectangle by the contents of a register you name.
Note that the rectangle currently selected is first killed. You can
restore it by yanking."
(interactive "r")
(kill-rectangle start end)
(exchange-point-and-mark)
(condition-case nil
(call-interactively #'insert-register)
(error (exchange-point-and-mark) (yank-rectangle)))))
("Copy to Register" . copy-rectangle-to-register))
("Change Text"
,@`,(and (fboundp 'boxquote-region)
'(("Boxquote" . boxquote-region)))
,@`,(and (fboundp 'boxquote-unbox-region)
'(("Unboxquote" . boxquote-unbox-region)))
,@`,(and (fboundp 'delimit-columns-rectangle)
'(("Delimit Columns" . delimit-columns-region)))
,@`,(if (fboundp 'comment-or-uncomment-region)
'(("Comment/Uncomment" . comment-or-uncomment-region))
'(("Comment" . comment-region)
("Uncomment" . uncomment-region)))
("--")
("Fill" . fill-region)
("Fill as Paragraph" . fill-region-as-paragraph)
("Canonically Space" . canonically-space-region)
("Indent" . indent-region)
("--")
("Capitalize" . capitalize-region)
("Upcase" . upcase-region)
("Downcase" . downcase-region)
,@`,(and (fboundp 'unaccent-region)
'(("Remove Accents" . unaccent-region)))
("--")
("Center" . center-region)
("Reverse Line Order" . reverse-region))
("Check, Correct, Convert"
("Ispell" . ispell-region)
("Flyspell" . flyspell-region)
,@`,(and (fboundp 'whitespace-cleanup-region)
'(("Check Whitespace" . whitespace-report-region)
("Clean Up Whitespace" . whitespace-cleanup-region)))
("Printify" . printify-region)
("PR Printify" . pr-printify-region)
("Compose Characters" . compose-region)
("Decompose Characters" . decompose-region)
("--")
("Encode using Coding System" . encode-coding-region)
("Decode using Coding System" . decode-coding-region)
("Encode using Format" . format-encode-region)
("Decode using Format" . format-decode-region)
,@`,(and (fboundp 'yenc-decode-region)
'(("Decode Yenc" . yenc-decode-region)))
("--")
("EPA Encrypt" . epa-encrypt-region)
("EPA Decrypt" . epa-decrypt-region)
("PGG Encrypt" . pgg-encrypt-region)
("PGG Decrypt" . pgg-decrypt-region))
,@(and (fboundp 'hlt-highlight-region)
'(("Highlight"
("Highlight" . hlt-highlight-region)
("Highlight Regexp" . hlt-highlight-regexp-region)
("Unhighlight" . hlt-unhighlight-region)
("Unhighlight for Face" . hlt-unhighlight-region-for-face))))
("Print"
("PostScript Print" . ps-print-region)
("PostScript Print with Faces" . ps-print-region-with-faces)
("PostScript Preview" . pr-ps-region-preview)
("PostScript Number of Pages" . ps-nb-pages-region)
("--")
("Print to Text Printer" . pr-txt-region)
("Print to Text Printer (`lpr')" . lpr-region)
("Print with Paging (`pr')" . print-region)
,@`,(and (fboundp 'ebnf-print-region)
'(("--")
("BNF PostScript Analyze" . ebnf-syntax-region)))
,@`,(and (fboundp 'ebnf-print-region)
'(("BNF PostScript Print " . ebnf-print-region)))
,@`,(and (fboundp 'ebnf-print-region)
'(("BNF PostScript Save" . ebnf-eps-region))))
("Misc"
,@`,(and (fboundp 'count-words-region)
'(("Count Lines, Words, Chars"
. (lambda ()
(interactive)
(call-interactively #'count-words-region)
(sleep-for 3)))))
,@`,(and (not (fboundp 'count-words-region))
'(("Count Lines and Chars"
. (lambda ()
(interactive)
(call-interactively #'count-lines-region)
(sleep-for 3)))))
("Narrow" . narrow-to-region)
("Eval" . eval-region)
("Key-Macro on Region Lines" . apply-macro-to-region-lines)
("Shell Command" . shell-command-on-region)
("Write to File" . write-region)
,@`,(and (fboundp 'bmkp-set-autonamed-regexp-region)
'(("Create Bookmarks Matching" . bmkp-set-autonamed-regexp-region)))
,@`,(and (fboundp 'bmkp-light-bookmarks-in-region)
'(("Highlight Bookmarks" . bmkp-light-bookmarks-in-region)))
,@`,(and (fboundp 'browse-url-of-region)
'(("Open in Browser" . browse-url-of-region)))))
"*Submenus of `mouse-3' `Region' popup menu.
Used only if `mouse3-region-popup-x-popup-panes-flag' is non-nil.
A list of `x-popup-menu' pane menus, where each has the form
(TITLE ITEM1 ITEM2...), with each ITEM a string or a cons cell
(STRING . VALUE). See `x-popup-menu'.
If you want to use features offered by extended menu items, then do
not use this option. Instead, set option
`mouse3-region-popup-x-popup-panes-flag' to nil and use option
`mouse3-region-popup-entries' to define the menu."
:type '(alist
:key-type (string :tag "Submenu Name")
:value-type (repeat
(choice
(cons :tag "Item"
(string :tag "Name")
(restricted-sexp :tag "Command"
:match-alternatives ((lambda (x) (not (null x)))) :value ignore))
(list :tag "Separator" (const "--")))))
:group 'mouse3)
(defun mouse3-nonempty-region-p ()
"Return non-nil if region is active and non-empty."
(and mark-active (not (zerop (length (buffer-substring (region-beginning) (region-end)))))))
(defconst mouse3-region-popup-remove/replace-items
`((kill menu-item "Kill" kill-region
:visible (and (not buffer-read-only) (mouse3-nonempty-region-p)))
(delete menu-item "Delete" delete-region
:visible (and (not buffer-read-only) (mouse3-nonempty-region-p)))
(yank menu-item "Yank (Replace)" (lambda (start end)
"Replace selected text by last text killed."
(interactive "r")
(when (string= (buffer-substring-no-properties
(point) (mark))
(car kill-ring))
(current-kill 1))
(delete-region start end)
(yank))
:keys ,(if (fboundp 'naked-key-description)
(naked-key-description (car (where-is-internal 'yank)))
(key-description (car (where-is-internal 'yank))))
:help "Replace selected text by last text killed."
:visible (not buffer-read-only)
:enable (and kill-ring (mouse3-nonempty-region-p))))
"Menu items for removing or replacing the mouse selection.")
(defconst mouse3-region-popup-remove/replace-rect-submenu
'(remove/replace-rect-menu
menu-item
"Remove/Replace Rectangle"
(keymap
(kill-rect menu-item "Kill Rectangle" kill-rectangle)
(delete-rect menu-item "Delete Rectangle" delete-rectangle)
(yank-rect menu-item "Yank Rectangle (Replace)"
(lambda (start end)
"Replace the selected rectangle by the last rectangle killed."
(interactive "r")
(delete-rectangle start end)
(exchange-point-and-mark)
(yank-rectangle))
:help "Replace the selected rectangle by the last rectangle killed."
:visible (and (boundp 'killed-rectangle) killed-rectangle))
(clear-rect menu-item "Clear Rectangle (Replace)" clear-rectangle)
(string-rect menu-item "String Rectangle (Replace)" string-rectangle)
(yank-rect menu-item "Replace Rectangle from Register"
(lambda (start end)
"Replace the selected rectangle by the contents of a register you name.
Note that the rectangle currently selected is first killed. You can
restore it by yanking."
(interactive "r")
(kill-rectangle start end)
(exchange-point-and-mark)
(condition-case nil
(call-interactively #'insert-register)
(error (exchange-point-and-mark) (yank-rectangle))))
"Replace selected rectangle by a register you name. The rectangle is killed."))
:enable (and (not buffer-read-only) (mouse3-nonempty-region-p)))
"Submenu for removing or replacing the rectangle selected by the mouse.")
(defconst mouse3-region-popup-copy-submenu
'(copy-menu
menu-item
"Copy"
(keymap
(copy-as-kill menu-item "Copy as Kill" kill-ring-save)
(copy-to-register menu-item "Copy to Register" copy-to-register)
(sep-copy "--")
(copy-rect-to-register menu-item "Copy Rectangle to Register" copy-rectangle-to-register))
:enable (mouse3-nonempty-region-p))
"Submenu for copying the mouse selection.")
(defconst mouse3-region-popup-register-submenu
'(to-register-menu
menu-item
"Register"
(keymap
(copy menu-item "Copy to..." copy-to-register)
(delete menu-item "Delete to..."
(lambda (register start end)
"Delete the selected text, and copy it to a register you name."
(interactive "cDelete region to register: \nr")
(copy-to-register register start end t))
:visible (not buffer-read-only)
:help "Delete the selected text, and copy it to a register that you name.")
(append menu-item "Append to..." append-to-register)
(prepend menu-item "Prepend to..." prepend-to-register)
(sep-to-register "--")
(copy-rectangle-to-register menu-item "Copy Rectangle to..." copy-rectangle-to-register)
(copy-rectangle-to-register menu-item "Delete Rectangle to..."
(lambda (register start end)
"Delete the selected rectangle, and copy it to a register that you name."
(interactive "cDelete rectangle to register: \nr")
(copy-rectangle-to-register register start end t))
:visible (not buffer-read-only)
:help "Delete the selected rectangle, and copy it to a register that you name."))
:enable (mouse3-nonempty-region-p))
"Submenu for putting the mouse selection in a register.")
(defconst mouse3-region-popup-rectangle-submenu
`(rectangle-menu
menu-item
"Rectangle"
(keymap
(kill-rectangle menu-item "Kill" kill-rectangle :visible (not buffer-read-only))
(delete-rectangle menu-item "Delete" delete-rectangle :visible (not buffer-read-only))
(open-rectangle menu-item "Open" open-rectangle :visible (not buffer-read-only))
(yank-rectangle menu-item "Yank (Replace)"
(lambda (start end)
"Replace the selected rectangle by the last rectangle killed."
(interactive "r")
(delete-rectangle start end)
(exchange-point-and-mark)
(yank-rectangle))
:enable (and (boundp 'killed-rectangle) killed-rectangle)
:visible (not buffer-read-only)
:keys ,(if (fboundp 'naked-key-description)
(naked-key-description (car (where-is-internal 'yank-rectangle)))
(key-description (car (where-is-internal 'yank-rectangle))))
:help "Replace the selected rectangle by the last rectangle killed.")
(clear-rectangle menu-item "Clear (Replace)" clear-rectangle
:visible (not buffer-read-only))
(string-rectangle menu-item "String (Replace)" string-rectangle
:visible (not buffer-read-only))
(delimit-columns-rectangle menu-item "Delimit Columns" delimit-columns-rectangle
:visible (and (fboundp 'delimit-columns-rectangle) (not buffer-read-only)))
(sep-rectangle menu-item "--" nil :visible (not buffer-read-only))
(delete-rectangle-to-register menu-item "Delete to Register"
(lambda (register start end)
"Delete the selected rectangle, and copy it to a register you name."
(interactive "cDelete rectangle to register: \nr")
(copy-rectangle-to-register register start end t))
:visible (not buffer-read-only)
:help "Delete the selected rectangle, and copy it to a register you name.")
(yank-rectangle menu-item "Replace from Register"
(lambda (start end)
"Replace the selected rectangle by the contents of a register you name.
Note that the rectangle currently selected is first killed. You can
restore it by yanking."
(interactive "r")
(kill-rectangle start end)
(exchange-point-and-mark)
(condition-case nil
(call-interactively #'insert-register)
(error (exchange-point-and-mark) (yank-rectangle))))
:visible (not buffer-read-only)
:help "Replace selected rectangle with register you name (rect. is killed).")
(copy-rectangle-to-register menu-item "Copy to Register" copy-rectangle-to-register))
:enable (mouse3-nonempty-region-p))
"Submenu for operations on the rectangle selected by the mouse.")
(defconst mouse3-region-popup-change-text-submenu
'(change-text-menu
menu-item
"Change Text"
(keymap
(boxquote-region menu-item "Boxquote" boxquote-region
:visible (fboundp 'boxquote-region))
(boxquote-unbox-region menu-item "Unboxquote" boxquote-unbox-region
:visible (fboundp 'boxquote-unbox-region))
(delimit-columns-region menu-item "Delimit Columns" delimit-columns-region
:visible (fboundp 'delimit-columns-rectangle))
(comment-or-uncomment-region menu-item "Comment/Uncomment" comment-or-uncomment-region
:visible (fboundp 'comment-or-uncomment-region))
(comment-region menu-item "Comment" comment-region
:visible (not (fboundp 'comment-or-uncomment-region)))
(uncomment-region menu-item "Uncomment" uncomment-region
:visible (not (fboundp 'comment-or-uncomment-region)))
(sep-fill "--")
(fill menu-item "Fill" fill-region)
(fill-as-para menu-item "Fill as Paragraph" fill-region-as-paragraph)
(canonically-space menu-item "Canonically Space" canonically-space-region)
(indent menu-item "Indent" indent-region)
(sep-word-case "--")
(capitalize menu-item "Capitalize" capitalize-region)
(upcase menu-item "Upcase" upcase-region)
(downcase menu-item "Downcase" downcase-region)
(unaccent-region menu-item "Remove Accents" unaccent-region
:visible (fboundp 'unaccent-region))
(sep-lines "--")
(center-region menu-item "Center" center-region)
(reverse-region menu-item "Reverse Line Order" reverse-region))
:enable (and (not buffer-read-only) (mouse3-nonempty-region-p)))
"Submenu for operations on the mouse selection that change the text.")
(defconst mouse3-region-popup-check-convert-submenu
'(check-convert-menu
menu-item "Check, Correct, Convert"
(keymap
(ispell-region menu-item "Ispell" ispell-region)
(flyspell-region menu-item "Flyspell" flyspell-region)
(whitespace-report-region menu-item "Check Whitespace" whitespace-report-region
:visible (fboundp 'whitespace-cleanup-region))
(whitespace-cleanup-region menu-item "Clean Up Whitespace" whitespace-cleanup-region
:visible (and (fboundp 'whitespace-cleanup-region) (not buffer-read-only)))
(printify-region menu-item "Printify" printify-region
:visible (not buffer-read-only))
(pr-printify-region menu-item "PR Printify" pr-printify-region
:visible (not buffer-read-only))
(compose-region menu-item "Compose Characters" compose-region
:visible (not buffer-read-only))
(decompose-region menu-item "Decompose Characters" decompose-region
:visible (not buffer-read-only))
(sep-encode menu-item "--" nil
:visible (not buffer-read-only))
(encode-coding-region menu-item "Encode using Coding System" encode-coding-region
:visible (not buffer-read-only))
(decode-coding-region menu-item "Decode using Coding System" decode-coding-region
:visible (not buffer-read-only))
(format-encode-region menu-item "Encode using Format" format-encode-region
:visible (not buffer-read-only))
(format-decode-region menu-item "Decode using Format" format-decode-region
:visible (not buffer-read-only))
(yenc-decode-region menu-item "Decode Yenc" yenc-decode-region
:visible (and (fboundp 'yenc-decode-region) (not buffer-read-only)))
(sep-encrypt menu-item "--" nil :visible (not buffer-read-only))
(epa-encrypt-region menu-item "EPA Encrypt" epa-encrypt-region
:visible (not buffer-read-only))
(epa-decrypt-region menu-item "EPA Decrypt" epa-decrypt-region
:visible (not buffer-read-only))
(pgg-encrypt-region menu-item "PGG Encrypt" pgg-encrypt-region
:visible (not buffer-read-only))
(pgg-decrypt-region menu-item "PGG Decrypt" pgg-decrypt-region
:visible (not buffer-read-only)))
:enable (mouse3-nonempty-region-p))
"Submenu for operations that check, correct, or convert mouse-selection text.")
(defconst mouse3-region-popup-highlight-submenu
'(hlt-highlight-menu
menu-item "Highlight"
(keymap
(hlt-highlight-region menu-item "Highlight" hlt-highlight-region)
(hlt-highlight-regexp-region menu-item "Highlight Regexp" hlt-highlight-regexp-region)
(hlt-unhighlight-region menu-item "Unhighlight" hlt-unhighlight-region)
(hlt-unhighlight-region-for-face menu-item "Unhighlight for Face" hlt-unhighlight-region-for-face))
:enable (mouse3-nonempty-region-p))
"Submenu for highlighting or unhighlighting text in the mouse selection.")
(defconst mouse3-region-popup-print-submenu
'(print-menu
menu-item "Print"
(keymap
(ps-print-region menu-item "PostScript Print" ps-print-region)
(ps-print-region-with-faces menu-item "PostScript Print with Faces" ps-print-region-with-faces)
(pr-ps-region-preview menu-item "PostScript Preview" pr-ps-region-preview)
(ps-nb-pages-region menu-item "PostScript Number of Pages" ps-nb-pages-region)
(sep-print "--")
(pr-txt-region menu-item "Print to Text Printer" pr-txt-region)
(lpr-region menu-item "Print to Text Printer (`lpr')" lpr-region)
(sep-bnf "--" :visible (fboundp 'ebnf-print-region))
(ebnf-syntax-region menu-item "BNF PostScript Analyze" ebnf-syntax-region
:visible (fboundp 'ebnf-print-region))
(ebnf-print-region menu-item "BNF PostScript Print " ebnf-print-region
:visible (fboundp 'ebnf-print-region))
(ebnf-eps-region menu-item "BNF PostScript Save" ebnf-eps-region
:visible (fboundp 'ebnf-print-region)))
:enable (mouse3-nonempty-region-p))
"Submenu for printing the mouse selection.")
(defconst mouse3-region-popup-misc-submenu
'(misc-menu
menu-item "Misc"
(keymap
(count-words-region menu-item "Count Lines, Words, Chars"
(lambda ()
(interactive)
(call-interactively #'count-words-region)
(sleep-for 3))
:visible (fboundp 'count-words-region))
(count-lines-region menu-item "Count Lines and Chars"
(lambda ()
(interactive)
(call-interactively #'count-lines-region)
(sleep-for 3))
:visible (not (fboundp 'count-words-region)))
(narrow-to-region menu-item "Narrow" narrow-to-region)
(eval-region menu-item "Eval" eval-region)
(apply-macro-to-region-lines menu-item "Key-Macro on Region Lines" apply-macro-to-region-lines
:enable last-kbd-macro
:visible (not buffer-read-only))
(shell-command-on-region menu-item "Shell Command" shell-command-on-region)
(write-region menu-item "Write to File" write-region)
(bmkp-set-autonamed-regexp menu-item "Create Bookmarks Matching" bmkp-set-autonamed-regexp-region
:visible (fboundp 'bmkp-set-autonamed-regexp-region))
(bmkp-light-bookmarks menu-item "Highlight Bookmarks" bmkp-light-bookmarks-in-region
:visible (fboundp 'bmkp-light-bookmarks-in-region))
(browse-url-of-region menu-item "Open in Browser" browse-url-of-region
:visible (fboundp 'browse-url-of-region)))
:enable (mouse3-nonempty-region-p))
"Submenu for miscellaneous operations on the mouse selection.")
(defcustom mouse3-region-popup-entries `(,@mouse3-region-popup-remove/replace-items
(sep1-std-entries menu-item "--" nil
:visible (not buffer-read-only))
,mouse3-region-popup-remove/replace-rect-submenu
,mouse3-region-popup-copy-submenu
,mouse3-region-popup-register-submenu
,mouse3-region-popup-rectangle-submenu
,mouse3-region-popup-change-text-submenu
,mouse3-region-popup-check-convert-submenu
,(and (fboundp 'hlt-highlight-region)
mouse3-region-popup-highlight-submenu)
,mouse3-region-popup-print-submenu
,mouse3-region-popup-misc-submenu
)
"*Entries for the `mouse-3' popup menu.
The option value is a list. Each element defines a submenu or a menu
item. A null element (`nil') is ignored.
Used only if `mouse3-region-popup-x-popup-panes-flag' is nil.
If `mouse3-region-popup-include-global-menus-flag' is non-nil then a
global submenu is added at the beginning of the popup menu, before the
entries from `mouse3-region-popup-entries'.
Several alternative entry formats are available. When customizing,
choose an alternative in the Customize `Value Menu'.
In this description:
SYMBOL is a symbol identifying the menu entry.
`menu-item' is just that text, literally.
NAME is a string naming the menu item or submenu.
COMMAND is the command to be invoked by an item.
MENU-KEYMAP is a menu keymap or a var whose value is a menu keymap.
KEYWORDS is a property list of menu keywords (`:enable',
`:visible', `:filter', `:keys', etc.).
1. Single menu item. For a selectable item, use
(SYMBOL menu-item NAME COMMAND . KEYWORDS). For a non-selectable
item such as a separator, use (SYMBOL NAME) or
(SYMBOL menu-item NAME nil . KEYWORDS).
2. Items taken from a menu-keymap variable, such as
`menu-bar-edit-menu'. Just use the name of the variable (a
symbol). The items appear at the top level of the popup menu, not
in a submenu.
3. Submenu. Use (SYMBOL menu-item NAME MENU-KEYMAP . KEYWORDS) or
(SYMBOL NAME . MENU-KEYMAP). Remember that MENU-KEYMAP can also be
a variable (symbol) whose value is a menu keymap.
All of these are standard menu elements, with the exception of the use
of a keymap variable to represent its value.
See also:
* (elisp) Format of Keymaps
* (elisp) Classifying Events
* (elisp) Extended Menu Items
Example submenu element:
(edit menu-item \"Edit\" menu-bar-edit-menu)
Example selectable menu-item element:
(kill menu-item \"Kill\" kill-region
:visible (and (not buffer-read-only)
(mouse3-nonempty-region-p)))
\(`mouse3-nonempty-region-p' returns non-nil if the region is active
and not empty.)"
:type '(repeat
(choice
(restricted-sexp
:tag "Submenu (SYMBOL menu-item NAME MENU-KEYMAP . KEYWORDS) or (SYMBOL NAME . MENU-KEYMAP)"
:match-alternatives
((lambda (x)
(and (consp x) (symbolp (car x))
(or (and (stringp (cadr x)) (cddr x))
(and (eq 'menu-item (cadr x))
(stringp (car (cddr x)))
(or (keymapp (car (cdr (cddr x))))
(and (symbolp (car (cdr (cddr x))))
(boundp (car (cdr (cddr x))))
(keymapp (symbol-value (car (cdr (cddr x)))))))))))
'nil))
(restricted-sexp
:tag "Items from a keymap variable's value."
:match-alternatives ((lambda (x) (and (symbolp x) (keymapp (symbol-value x))))
'nil))
(restricted-sexp
:tag "Selectable item (SYMBOL menu-item NAME COMMAND . KEYWORDS)"
:match-alternatives ((lambda (x) (and (consp x) (symbolp (car x))
(eq 'menu-item (cadr x))
(stringp (car (cddr x)))
(commandp (car (cdr (cddr x))))))
'nil))
(restricted-sexp
:tag "Non-selectable item (SYMBOL NAME) or (SYMBOL menu-item NAME nil . KEYWORDS)"
:match-alternatives ((lambda (x) (and (consp x) (symbolp (car x))
(or (and (stringp (cadr x)) (null (caddr x)))
(and (eq 'menu-item (cadr x))
(stringp (car (cddr x)))
(null (car (cdr (cddr x))))))))
'nil))))
:group 'mouse3)
(defun mouse3-region-popup-custom-entries ()
"In `mouse3-region-popup-entries', replace keymap vars by their values."
(let ((new ()))
(dolist (jj mouse3-region-popup-entries)
(cond ((and (symbolp jj) (keymapp (symbol-value jj)))
(setq jj (symbol-value jj))
(dolist (ii jj) (push ii new)))
((and (consp jj) (symbolp (car jj)) (eq 'menu-item (cadr jj))
(stringp (car (cddr jj))) (symbolp (car (cdr (cddr jj))))
(not (commandp (car (cdr (cddr jj))))) (boundp (car (cdr (cddr jj))))
(keymapp (symbol-value (car (cdr (cddr jj))))))
(setq jj `(,(car jj) menu-item ,(car (cddr jj))
,(symbol-value (car (cdr (cddr jj))))
,@(cdr (cdr (cddr jj)))))
(push jj new))
((and (consp jj) (symbolp (car jj)) (stringp (cadr jj))
(symbolp (cddr jj)) (boundp (cddr jj)) (keymapp (symbol-value (cddr jj))))
(setq jj `(,(car jj) ,(cadr jj) ,@(symbol-value (cddr jj))))
(push jj new))
(t (push jj new))))
(nreverse new)))
(defun mouse3-second-click-command ()
"Command used for a second `mouse-3' click at the same location.
The command must accept 2 args: mouse click event and prefix arg.
Return the value of `mouse3-save-then-kill-command' if non-nil, else
return the value of `mouse3-second-click-default-command'."
(or mouse3-save-then-kill-command
mouse3-second-click-default-command
'mouse3-kill/delete-region))
(defun mouse3-kill/delete-region (event killp)
"Delete the active region. Kill it if KILLP is non-nil.
Kill it anyway if `mouse-drag-copy-region' is non-nil.
For Emacs prior to Emacs 22, always kill region."
(interactive "e\nP")
(let* ((posn (event-start event))
(window (posn-window posn))
(buf (window-buffer window))
(mark-active t))
(with-current-buffer buf
(if (or killp (and (boundp 'mouse-drag-copy-region) mouse-drag-copy-region))
(kill-region (region-beginning) (region-end))
(delete-region (region-beginning) (region-end))))))
(defun mouse3-region-popup-menu (event ignored)
"Pop up a `Region' menu of actions for the selected text.
See options `mouse3-region-popup-entries',
`mouse3-region-popup-x-popup-panes-flag', and
`mouse3-region-popup-x-popup-panes'. .
You have two alternatives, which correspond to the value of option
`mouse3-region-popup-x-popup-panes-flag' (and to the
possibilities for the MENU argument of function `x-popup-menu'):
1. nil (recommended) - Define the menu as a keymap, using submenu
keymaps and `menu-item' bindings.
2. non-nil - Define the menu using a (non-keymap) `x-popup-menu' panes
list, `mouse3-region-popup-x-popup-panes'.
The first alternative lets you make use of keywords such as `:enable'
and `:visible', and it lets you reuse existing menu keymaps.
The second alternative allows easy customization of individual menu
items, but it does not let you use menu keywords or reuse existing
keymaps.
For the first alternative, in addition to the items and submenus
supplied by `mouse3-region-popup-entries', a submenu is added at the
beginning of the popup menu for either (a) the menu-bar menus (if the
menu bar is not visible) or (b) the major-mode menus. (This is only
for Emacs 23+.)"
(interactive "e\nP")
(sit-for 0)
(let* ((menus (if (and mouse3-region-popup-x-popup-panes-flag
mouse3-region-popup-x-popup-panes)
`(,(if (mouse3-nonempty-region-p) "Region" "No Region")
,@mouse3-region-popup-x-popup-panes)
`((keymap ,(if (mouse3-nonempty-region-p) "Region" "No Region")
,@(and mouse3-region-popup-include-global-menus-flag (fboundp 'mouse-menu-bar-map)
(if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
`((menu-bar-maps "Menu Bar" ,@(mouse-menu-bar-map)))
`((major-mode-map ,(format-mode-line mode-name)
,@(mouse-menu-major-mode-map)))))
,@(and mouse3-region-popup-include-global-menus-flag (fboundp 'mouse-menu-bar-map)
'((sep1-global "--")))
,@(mouse3-region-popup-custom-entries)))))
(choice (x-popup-menu event menus)))
(mouse3-region-popup-choice menus choice)))
(defun mouse3-region-popup-choice (menus choice)
"Invoke the command from MENUS that is represented by user's CHOICE.
MENUS is a list that is acceptable as the second argument for
`x-popup-menu'. That is, it is one of the following, where MENU-TITLE
is the menu title and PANE-TITLE is a submenu title.
* a keymap - MENU-TITLE is its `keymap-prompt'
* a list of keymaps - MENU-TITLE is the first keymap's `keymap-prompt'
* a menu of multiple panes, which has this form: (MENU-TITLE PANE...),
where each PANE has this form: (PANE-TITLE ITEM...),
where each ITEM has one of these forms:
- STRING - an unselectable menu item
- (STRING . COMMAND) - a selectable item that invokes COMMAND"
(catch 'mouse3-region-popup-choice (mouse3-region-popup-choice-1 menus choice)))
(defun mouse3-region-popup-choice-1 (menus choice)
"Helper function for `mouse3-region-popup-choice'."
(cond((keymapp menus)
(let (binding)
(while choice
(setq binding (lookup-key menus (vector (car choice))))
(cond ((keymapp binding)
(setq menus binding
choice (cdr choice)))
((commandp binding)
(throw 'mouse3-region-popup-choice (call-interactively binding)))
(t (error "`mouse3-region-popup-choice', binding: %s" binding))))))
((consp menus)
(dolist (menu menus)
(if (keymapp menu)
(mouse3-region-popup-choice-1 menu choice)
(when choice
(throw 'mouse3-region-popup-choice (call-interactively choice))))))))
(defun mouse-save-then-kill (click &optional prefix)
"Like vanilla `mouse-save-then-kill', but uses `mouse3-second-click-command'."
(interactive "e\nP")
(mouse-minibuffer-check click)
(let* ((posn (event-start click))
(click-pt (posn-point posn))
(window (posn-window posn))
(buf (window-buffer window))
(this-command this-command)
(click-count (if (and (eq mouse-selection-click-count-buffer buf)
(with-current-buffer buf (mark t)))
mouse-selection-click-count
0)))
(cond ((not (numberp click-pt)) nil)
((and (eq last-command 'mouse-save-then-kill)
(eq click-pt mouse-save-then-kill-posn)
(eq window (selected-window)))
(funcall (mouse3-second-click-command) click prefix)
(setq mouse-selection-click-count 0
mouse-save-then-kill-posn nil))
((or (with-current-buffer buf (and transient-mark-mode mark-active))
(and (eq window (selected-window))
(mark t)
(or (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn)
(and (memq last-command '(mouse-drag-region mouse-set-region))
(or mark-even-if-inactive (not transient-mark-mode))))))
(select-window window)
(let* ((range (mouse-start-end click-pt click-pt click-count)))
(if (< (abs (- click-pt (mark t))) (abs (- click-pt (point))))
(set-mark (car range))
(goto-char (nth 1 range)))
(setq deactivate-mark nil)
(mouse-set-region-1)
(if (boundp 'mouse-drag-copy-region)
(when mouse-drag-copy-region
(kill-new (filter-buffer-substring (mark t) (point)) t))
(kill-new (buffer-substring (point) (mark t)) t))
(setq mouse-save-then-kill-posn click-pt)))
(t
(select-window window)
(mouse-set-mark-fast click)
(let ((before-scroll (with-current-buffer buf point-before-scroll)))
(when before-scroll (goto-char before-scroll)))
(exchange-point-and-mark)
(mouse-set-region-1)
(if (boundp 'mouse-drag-copy-region)
(when mouse-drag-copy-region
(kill-new (filter-buffer-substring (mark t) (point))))
(kill-new (buffer-substring (point) (mark t))))
(setq mouse-save-then-kill-posn click-pt)))))
(defun mouse3-dired-use-menu ()
"Make a second `mouse-3' click at the same place pop up a menu in Dired."
(interactive)
(remove-hook 'dired-after-readin-hook 'mouse3-dired-set-to-toggle-marks)
(add-hook 'dired-after-readin-hook 'mouse3-dired-add-region-menu))
(defun mouse3-dired-add-region-menu ()
"Add a `Selected Files' submenu to `mouse-3' pop-up menu.
Provides commands to act on the selected files and directories."
(set (make-local-variable 'mouse3-region-popup-x-popup-panes-flag) nil)
(let ((default-entries mouse3-region-popup-entries))
(set (make-local-variable 'mouse3-region-popup-entries)
`((dired-menu
"Selected Files" keymap
(mark-region menu-item "Mark" mouse3-dired-mark-region-files)
(unmark-region menu-item "Unmark" mouse3-dired-unmark-region-files)
(toggle-marked menu-item "Toggle Marked/Unmarked" mouse3-dired-toggle-marks-in-region-from-mouse)
(flag menu-item "Flag for Deletion" mouse3-dired-flag-region-files-for-deletion)
,@(and (eq (lookup-key dired-mode-map [mouse-3]) 'mouse-save-then-kill)
'((sep1-dired "--")
(turn-off-menu menu-item "Stop Using Menu" mouse3-dired-use-toggle-marks))))
,@default-entries))))
(defcustom mouse3-dired-function 'mouse3-dired-use-menu
"*Fuction to call to update `dired-after-readin-hook' for `mouse-3' behavior."
:type '(choice
(function :tag "Use menu" 'mouse3-dired-use-menu)
(function :tag "Toggle marks" 'mouse3-dired-use-toggle-marks)
(const :tag "No special behavior" :value nil))
:set #'(lambda (sym defs)
(custom-set-default sym defs)
(if (functionp mouse3-dired-function)
(funcall mouse3-dired-function)
(remove-hook 'dired-after-readin-hook 'mouse3-dired-set-to-toggle-marks)
(remove-hook 'dired-after-readin-hook 'mouse3-dired-add-region-menu))
(when (eq major-mode 'dired-mode) (revert-buffer)))
:initialize #'custom-initialize-reset
:group 'mouse3)
(defun mouse3-dired-use-toggle-marks ()
"Make a second `mouse-3' click at the same place toggle marks in Dired.
If you use Dired+ (`dired+.el') then this is a no-op."
(interactive)
(if (not (featurep 'dired+))
(add-hook 'dired-after-readin-hook 'mouse3-dired-set-to-toggle-marks)
(ding) (message "Canceled. Use the popup menu in Dired+.")))
(defun mouse3-dired-set-to-toggle-marks ()
"Set `mouse3-save-then-kill-command' to toggle Dired marks."
(set (make-local-variable 'mouse3-save-then-kill-command) 'mouse3-dired-toggle-marks-in-region-from-mouse))
(defun mouse3-dired-toggle-marks-in-region-from-mouse (ignore1 ignore2)
"Toggle marked and unmarked files and directories in region."
(interactive "e\nP")
(mouse3-dired-toggle-marks-in-region (region-beginning) (region-end)))
(defun mouse3-dired-toggle-marks-in-region (start end)
"Toggle marks in the region."
(interactive "r")
(save-excursion
(save-restriction
(if (not (fboundp 'dired-toggle-marks))
(let ((details-hidden-p (and (boundp 'dired-details-state)
(eq 'hidden dired-details-state))))
(widen)
(when details-hidden-p (dired-details-show))
(goto-char start)
(setq start (line-beginning-position))
(goto-char end)
(setq end (line-end-position))
(narrow-to-region start end)
(dired-do-toggle)
(when details-hidden-p (dired-details-hide)))
(narrow-to-region start end)
(dired-toggle-marks))))
(when (and (get-buffer-window (current-buffer)) (fboundp 'fit-frame-if-one-window))
(fit-frame-if-one-window)))
(defun mouse3-dired-this-file-marked-p (&optional mark-char)
"Return non-nil if the file on this line is marked.
Optional arg MARK-CHAR is the type of mark to check.
If nil, then if the file has any mark, including `D', it is marked."
(and (dired-get-filename t t)
(save-excursion (beginning-of-line)
(if mark-char
(looking-at (concat "^" (char-to-string mark-char)))
(not (looking-at "^ "))))))
(defun mouse3-dired-this-file-unmarked-p (&optional mark-char)
"Return non-nil if the file on this line is unmarked.
Optional arg MARK-CHAR is the type of mark to check.
If nil, then if the file has no mark, including `D', it is unmarked.
If non-nil, then it is unmarked for MARK-CHAR if it has no mark or
it has any mark except MARK-CHAR."
(and (dired-get-filename t t)
(save-excursion (beginning-of-line)
(if mark-char
(not (looking-at (concat "^" (char-to-string mark-char))))
(looking-at "^ ")))))
(defun mouse3-dired-mark-region-files (&optional unmark-p)
"Mark all of the files in the current region (if it is active).
With non-nil prefix arg, unmark them instead."
(interactive "P")
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char (if unmark-p ?\040 dired-marker-char)))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (mouse3-dired-this-file-unmarked-p))
"region file"))))
(defun mouse3-dired-unmark-region-files (&optional mark-p)
"Unmark all of the files in the current region (if it is active).
With non-nil prefix arg, mark them instead."
(interactive "P")
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char (if mark-p dired-marker-char ?\040)))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (mouse3-dired-this-file-marked-p))
"region file"))))
(defun mouse3-dired-flag-region-files-for-deletion ()
"Flag all of the files in the current region (if it is active) for deletion."
(interactive)
(let ((beg (min (point) (mark)))
(end (max (point) (mark)))
(inhibit-field-text-motion t))
(setq beg (save-excursion (goto-char beg) (line-beginning-position))
end (save-excursion (goto-char end) (line-end-position)))
(let ((dired-marker-char dired-del-marker))
(dired-mark-if (and (<= (point) end) (>= (point) beg) (mouse3-dired-this-file-unmarked-p ?\D))
"region file"))))
(defcustom mouse3-picture-mode-x-popup-panes
`,@`(("Clear Rectangle" . picture-clear-rectangle)
("Kill Rectangle"
. (lambda (start end)
"Kill the selected rectangle.
You can yank it using \\<picture-mode-map>`\\[picture-yank-rectangle]'."
(interactive "r")
(picture-clear-rectangle start end 'KILLP)))
("Clear Rectangle to Register" . picture-clear-rectangle-to-register)
("Draw Rectangle" . picture-draw-rectangle)
("Yank Picture Rectangle (Replace)" . picture-yank-rectangle)
("Yank Rectangle from Register (Replace)"
. (lambda ()
"Replace the selected rectangle by the contents of a register you name."
(interactive)
(exchange-point-and-mark)
(call-interactively #'picture-yank-rectangle-from-register))))
"*Picture mode submenu of popup menu for `mouse-3'."
:type '(repeat
(choice
(cons :tag "Item"
(string :tag "Name")
(restricted-sexp :tag "Command"
:match-alternatives ((lambda (x) (not (null x)))) :value ignore))
(list :tag "Separator" (const "--"))))
:group 'mouse)
(add-hook
'picture-mode-hook
(lambda ()
(set (make-local-variable 'mouse3-region-popup-x-popup-panes-flag) t)
(set (make-local-variable 'mouse3-region-popup-x-popup-panes)
(cons `("Picture Mode" ,@mouse3-picture-mode-x-popup-panes)
(copy-tree mouse3-region-popup-x-popup-panes)))))
(provide 'mouse3)