You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
355 rivejä
13 KiB
355 rivejä
13 KiB
;;; mouseme.el --- mouse menu with commands that operate on strings
|
|
|
|
;; Copyright (C) 1997 by Free Software Foundation, Inc.
|
|
|
|
;; Author: Howard Melman <howard@silverstream.com>
|
|
;; Keywords: mouse, menu
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs 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 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; GNU Emacs 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.
|
|
|
|
;; A copy of the GNU General Public License is available at
|
|
;; https://www.r-project.org/Licenses/
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package provides a command `mouse-me' to be bound to a mouse
|
|
;; button. It pops up a menu of commands that operate on strings or a
|
|
;; region. The string passed to the selected command is the word or
|
|
;; symbol clicked on (with surrounding quotes or other punctuation
|
|
;; removed), or the region (if either it was just selected with the
|
|
;; mouse or if it was active with `transient-mark-mode' on). If the
|
|
;; command accepts a region, the selected region (or the region of the
|
|
;; word or symbol clicked on) will be passed to the command.
|
|
|
|
;; The idea is that for any given string in a buffer you may want to
|
|
;; do different things regardless of the mode of the buffer. URLs
|
|
;; now appear in email, news articles, comments in code, and in plain
|
|
;; text. You may want to visit that URL in a browser or you may just
|
|
;; want to copy it to the kill-ring. For an email address you might
|
|
;; want to compose mail to it, finger it, look it up in bbdb, copy it to
|
|
;; the kill ring. For a word you may want to spell check it, copy it,
|
|
;; change its case, grep for it, etc. Mouse-me provides a menu to
|
|
;; make this easy.
|
|
|
|
;; The menu popped up is generated by calling the function in the
|
|
;; variable `mouse-me-build-menu-function' which defaults to calling
|
|
;; `mouse-me-build-menu' which builds the menu from the variable
|
|
;; `mouse-me-menu-commands'. See the documentation for these
|
|
;; functions and variables for details.
|
|
|
|
;; To install, add something like the following to your ~/.emacs:
|
|
;; (require 'mouseme)
|
|
;; (global-set-key [S-mouse-2] 'mouse-me)
|
|
|
|
;;; Code:
|
|
|
|
(require 'browse-url)
|
|
(require 'thingatpt)
|
|
|
|
(eval-when-compile (require 'compile))
|
|
|
|
;;;; Variables
|
|
|
|
(defgroup mouseme nil
|
|
"Popup menu of commands that work on strings."
|
|
:prefix "mouse-me-"
|
|
:group 'hypermedia)
|
|
|
|
(defcustom mouse-me-get-string-function 'mouse-me-get-string
|
|
"Function used by `mouse-me' to get string when no region selected.
|
|
The default is `mouse-me-get-string' but this variable may commonly
|
|
be made buffer local and set to something more appropriate for
|
|
a specific mode (e.g., `word-at-point'). The function will be called
|
|
with no arguments and with point at where the mouse was clicked.
|
|
It can return either the string or to be most efficient, a list of
|
|
three elements: the string and the beginning and ending points of the
|
|
string in the buffer."
|
|
:type 'function
|
|
:options '(mouse-me-get-string)
|
|
:group 'mouseme)
|
|
|
|
(defcustom mouse-me-build-menu-function 'mouse-me-build-menu
|
|
"Function used by `mouse-me' to build the popup menu.
|
|
The default is `mouse-me-build-menu' but this variable may commonly
|
|
be made buffer local and set to something more appropriate for
|
|
a specific mode. The function will be called with one argument,
|
|
the string selected, as returned by `mouse-me-get-string-function'."
|
|
:type 'function
|
|
:options '(mouse-me-build-menu)
|
|
:group 'mouseme)
|
|
|
|
(defvar mouse-me-grep-use-extension 't
|
|
"If non-nil `mouse-me-grep' grep's in files with current file's extension.")
|
|
|
|
(defcustom mouse-me-menu-commands
|
|
'(("Copy" . kill-new)
|
|
("Kill" . kill-region)
|
|
("Capitalize" . capitalize-region)
|
|
("Lowercase" . downcase-region)
|
|
("Uppercase" . upcase-region)
|
|
("ISpell" . ispell-region)
|
|
"----"
|
|
("Browse URL" . browse-url)
|
|
("Dired" . dired)
|
|
("Execute File" . mouse-me-execute)
|
|
("Mail to" . compose-mail)
|
|
("Finger" . mouse-me-finger)
|
|
("BBDB Lookup" . mouse-me-bbdb)
|
|
"----"
|
|
("Imenu" . imenu)
|
|
("Find Tag" . find-tag)
|
|
("Grep" . mouse-me-grep)
|
|
("Find-Grep" . mouse-me-find-grep)
|
|
"----"
|
|
("Apropos" . apropos)
|
|
("Describe Function" . mouse-me-describe-function)
|
|
("Describe Variable" . mouse-me-describe-variable)
|
|
("Command Info" . mouse-me-emacs-command-info)
|
|
("Man Page" . (if (fboundp 'woman) 'woman 'man))
|
|
("Profile Function" . mouse-me-elp-instrument-function))
|
|
"Command menu used by `mouse-me-build-menu'.
|
|
A list of elements where each element is either a cons cell or a string.
|
|
If a cons cell the car is a string to be displayed in the menu and the
|
|
cdr is either a function to call passing a string to, or a list which evals
|
|
to a function to call passing a string to. If the element is a string
|
|
it makes a non-selectable element in the menu. To make a separator line
|
|
use a string consisting solely of hyphens.
|
|
|
|
The function returned from this menu will be called with one string
|
|
argument. Or if the function has the symbol property `mouse-me-type'
|
|
and if its value is the symbol `region' it will be called with the
|
|
beginning and ending points of the selected string. If the value is
|
|
the symbol `string' it will be called with one string argument."
|
|
:type '(repeat sexp)
|
|
:group 'mouseme)
|
|
|
|
(put 'kill-region 'mouse-me-type 'region)
|
|
(put 'ispell-region 'mouse-me-type 'region)
|
|
(put 'capitalize-region 'mouse-me-type 'region)
|
|
(put 'downcase-region 'mouse-me-type 'region)
|
|
(put 'upcase-region 'mouse-me-type 'region)
|
|
|
|
;;;; Commands
|
|
|
|
;;;###autoload
|
|
(defun mouse-me (event)
|
|
"Popup a menu of functions to run on selected string or region."
|
|
(interactive "e")
|
|
(mouse-me-helper event (lambda (name)
|
|
(or (x-popup-menu event (funcall mouse-me-build-menu-function name))
|
|
(error "No command to run")))))
|
|
|
|
;;;; Exposed Functions
|
|
|
|
;; Some tests:
|
|
;; <URL:http://foo.bar.com/sss/ss.html>
|
|
;; <http://foo.bar.com/sss/ss.html>
|
|
;; http://foo.bar.com/sss/ss.html
|
|
;; http://www.ditherdog.com/howard/
|
|
;; mailto:howard@silverstream.com
|
|
;; howard@silverstream.com
|
|
;; <howard@silverstream.com>
|
|
;; import com.sssw.srv.agents.AgentsRsrc;
|
|
;; public AgoHttpRequestEvent(Object o, String db, Request r)
|
|
;; <DIV><A href=3D"http://www.amazon.com/exec/obidos/ASIN/156592391X"><IMG =
|
|
;; <A HREF="http://www.suntimes.com/ebert/ebert.html">
|
|
;; d:\howard\elisp\spoon
|
|
;; \howard\elisp\spoon
|
|
;; \\absolut\howard\elisp\spoon
|
|
;; //absolut/d/Howard/Specs/servlet-2.1.pdf
|
|
;; \\absolut\d\Howard\Specs\servlet-2.1.pdf
|
|
;; gnuserv-frame.
|
|
|
|
(defun mouse-me-get-string ()
|
|
"Return a string from the buffer of text surrounding point.
|
|
Returns a list of three elements, the string and the beginning and
|
|
ending positions of the string in the buffer in that order."
|
|
(save-match-data
|
|
(save-excursion
|
|
(let ((start (point)) beg end str p)
|
|
(skip-syntax-forward "^ >()\"")
|
|
(setq end (point))
|
|
(goto-char start)
|
|
(skip-syntax-backward "^ >()\"")
|
|
(setq beg (point))
|
|
(setq str (buffer-substring-no-properties beg end))
|
|
;; remove junk from the beginning
|
|
(if (string-match "^\\([][\"'`.,?:;!@#$%^&*()_+={}|<>-]+\\)" str)
|
|
(setq str (substring str (match-end 1))
|
|
beg (+ beg (match-end 1))))
|
|
;; remove URL: from the front, it's common in email
|
|
(if (string-match "^\\(URL:\\)" str)
|
|
(setq str (substring str (match-end 1))
|
|
beg (+ beg (match-end 1))))
|
|
;; remove junk from the end
|
|
(if (string-match "\\([][\"'.,?:;!@#$%^&*()_+={}|<>-]+\\)$" str)
|
|
(setq end (- end (length (match-string 1 str))) ; must set end first
|
|
str (substring str 0 (match-beginning 1))))
|
|
(list str beg end)))))
|
|
|
|
(defun mouse-me-build-menu (name)
|
|
"Return a menu tailored for NAME for `mouse-me' from `mouse-me-menu-commands'."
|
|
(list "Mouse Me" (cons "Mouse Me"
|
|
(append (list (cons
|
|
(if (< (length name) 65)
|
|
name
|
|
"...Long String...")
|
|
'kill-new)
|
|
"---")
|
|
mouse-me-menu-commands))))
|
|
|
|
;;;; Commands for the menu
|
|
|
|
(defun mouse-me-emacs-command-info (string)
|
|
"Look in Emacs info for command named STRING."
|
|
(interactive "sCommand: ")
|
|
(let ((s (intern-soft string)))
|
|
(if (and s (commandp s))
|
|
(Info-goto-emacs-command-node s)
|
|
(error "No command named `%s'" string))))
|
|
|
|
(defun mouse-me-describe-function (string)
|
|
"Describe function named STRING."
|
|
(interactive "sFunction: ")
|
|
(let ((s (intern-soft string)))
|
|
(if (and s (fboundp s))
|
|
(describe-function s)
|
|
(error "No function named `%s'" string))))
|
|
|
|
(defun mouse-me-describe-variable (string)
|
|
"Desribe variable named STRING."
|
|
(interactive "sVariable: ")
|
|
(let ((s (intern-soft string)))
|
|
(if (and s (boundp s))
|
|
(describe-variable s)
|
|
(error "No variable named `%s'" string))))
|
|
|
|
(defun mouse-me-elp-instrument-function (string)
|
|
"Instrument Lisp function named STRING."
|
|
(interactive "sFunction: ")
|
|
(let ((s (intern-soft string)))
|
|
(if (and s (fboundp s))
|
|
(elp-instrument-function s)
|
|
(error "Must be the name of an existing Lisp function"))))
|
|
|
|
(defun mouse-me-execute (string)
|
|
"Execute STRING as a filename."
|
|
(interactive "sFile: ")
|
|
(if (fboundp 'w32-shell-execute)
|
|
(w32-shell-execute "open" (convert-standard-filename string))
|
|
(message "This function currently working only in W32.")))
|
|
|
|
|
|
(defun mouse-me-bbdb (string)
|
|
"Lookup STRING in bbdb."
|
|
(interactive "sBBDB Lookup: ")
|
|
(if (fboundp 'bbdb)
|
|
(bbdb string nil)
|
|
(error "BBDB not loaded")))
|
|
|
|
(defun mouse-me-finger (string)
|
|
"Finger a STRING mail address."
|
|
(interactive "sFinger: ")
|
|
(save-match-data
|
|
(if (string-match "\\(.*\\)@\\([-.a-zA-Z0-9]+\\)$" string)
|
|
(finger (match-string 1 string) (match-string 2 string))
|
|
(error "Not in user@host form: %s" string))))
|
|
|
|
(defun mouse-me-grep (string)
|
|
"Grep for a STRING."
|
|
(interactive "sGrep: ")
|
|
(require 'compile)
|
|
(grep-compute-defaults)
|
|
(let ((ext (mouse-me-buffer-file-extension)))
|
|
(grep (concat grep-command string
|
|
(if mouse-me-grep-use-extension
|
|
(if ext
|
|
(concat " *" ext)
|
|
" *"))))))
|
|
|
|
(defun mouse-me-find-grep (string)
|
|
"Grep for a STRING."
|
|
(interactive "sGrep: ")
|
|
(grep-compute-defaults)
|
|
(let ((reg grep-find-command)
|
|
(ext (mouse-me-buffer-file-extension))
|
|
beg end)
|
|
(if (string-match "\\(^.+-type f \\)\\(.+$\\)" reg)
|
|
(setq reg (concat (match-string 1 reg)
|
|
(if mouse-me-grep-use-extension
|
|
(concat "-name \"*" ext "\" "))
|
|
(match-string 2 reg))))
|
|
(grep-find (concat reg string))))
|
|
|
|
;;;; Internal Functions
|
|
|
|
(defun mouse-me-buffer-file-extension ()
|
|
"Return the extension of the current buffer's filename or nil.
|
|
Returned extension is a string begining with a period."
|
|
(let* ((bfn (buffer-file-name))
|
|
(filename (and bfn (file-name-sans-versions bfn)))
|
|
(index (and filename (string-match "\\.[^.]*$" filename))))
|
|
(if index
|
|
(substring filename index)
|
|
"")))
|
|
|
|
(defun mouse-me-helper (event func)
|
|
"Determine the string to use to process EVENT and call FUNC to get cmd."
|
|
(let (name sp sm mouse beg end cmd mmtype)
|
|
;; temporarily goto where the event occurred, get the name clicked
|
|
;; on and enough info to figure out what to do with it
|
|
(save-match-data
|
|
(save-excursion
|
|
(setq sp (point)) ; saved point
|
|
(setq sm (mark t)) ; saved mark
|
|
(set-buffer (window-buffer (posn-window (event-start event))))
|
|
(setq mouse (goto-char (posn-point (event-start event))))
|
|
;; if there is a region and point is inside it
|
|
;; check for sm first incase (null (mark t))
|
|
;; set name to either the thing they clicked on or region
|
|
(if (and sm
|
|
(or (and transient-mark-mode mark-active)
|
|
(eq last-command 'mouse-drag-region))
|
|
(>= mouse (setq beg (min sp sm)))
|
|
(<= mouse (setq end (max sp sm))))
|
|
(setq name (buffer-substring beg end))
|
|
(setq name (funcall mouse-me-get-string-function))
|
|
(if (listp name)
|
|
(setq beg (nth 1 name)
|
|
end (nth 2 name)
|
|
name (car name))
|
|
(goto-char mouse)
|
|
(while (not (looking-at (regexp-quote name)))
|
|
(backward-char 1))
|
|
(setq beg (point))
|
|
(setq end (search-forward name))))))
|
|
;; check if name is null, meaning they clicked on no word
|
|
(if (or (null name)
|
|
(and (stringp name) (string= name "" )))
|
|
(error "No string to pass to function"))
|
|
;; popup a menu to get a command to run
|
|
(setq cmd (funcall func))
|
|
;; run the command, eval'ing if it was a list
|
|
(if (listp cmd)
|
|
(setq cmd (eval cmd)))
|
|
(setq mmtype (get cmd 'mouse-me-type))
|
|
(cond ((eq mmtype 'region)
|
|
(funcall cmd beg end))
|
|
((eq mmtype 'string)
|
|
(funcall cmd name))
|
|
(t
|
|
(funcall cmd name)))))
|
|
|
|
(provide 'mouseme)
|
|
|
|
;;; mouseme.el ends here
|