1 ;;; mouseme.el --- mouse menu with commands that operate on strings
3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
5 ;; Author: Howard Melman <howard@silverstream.com>
6 ;; Keywords: mouse menu
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This package provides a command `mouse-me' to be bound to a mouse
28 ;; button. It pops up a menu of commands that operate on strings or a
29 ;; region. The string passed to the selected command is the word or
30 ;; symbol clicked on (with surrounding quotes or other punctuation
31 ;; removed), or the region (if either it was just selected with the
32 ;; mouse or if it was active with `transient-mark-mode' on). If the
33 ;; command accepts a region, the selected region (or the region of the
34 ;; word or symbol clicked on) will be passed to the command.
36 ;; The idea is that for any given string in a buffer you may want to
37 ;; do different things regardless of the mode of the buffer. URLs
38 ;; now appear in email, news articles, comments in code, and in plain
39 ;; text. You may want to visit that URL in a browser or you may just
40 ;; want to copy it to the kill-ring. For an email address you might
41 ;; want to compose mail to it, finger it, look it up in bbdb, copy it to
42 ;; the kill ring. For a word you may want to spell check it, copy it,
43 ;; change its case, grep for it, etc. Mouse-me provides a menu to
46 ;; The menu popped up is generated by calling the function in the
47 ;; variable `mouse-me-build-menu-function' which defaults to calling
48 ;; `mouse-me-build-menu' which builds the menu from the variable
49 ;; `mouse-me-menu-commands'. See the documentation for these
50 ;; functions and variables for details.
52 ;; To install, add something like the following to your ~/.emacs:
54 ;; (global-set-key [S-mouse-2] 'mouse-me)
61 (eval-when-compile (require 'compile))
66 "Popup menu of commands that work on strings."
70 (defcustom mouse-me-get-string-function 'mouse-me-get-string
71 "*Function used by `mouse-me' to get string when no region selected.
72 The default is `mouse-me-get-string' but this variable may commonly
73 be made buffer local and set to something more appropriate for
74 a specific mode (e.g., `word-at-point'). The function will be called
75 with no arguments and with point at where the mouse was clicked.
76 It can return either the string or to be most efficient, a list of
77 three elements: the string and the beginning and ending points of the
78 string in the buffer."
80 :options '(mouse-me-get-string)
83 (defcustom mouse-me-build-menu-function 'mouse-me-build-menu
84 "*Function used by `mouse-me' to build the popup menu.
85 The default is `mouse-me-build-menu' but this variable may commonly
86 be made buffer local and set to something more appropriate for
87 a specific mode. The function will be called with one argument,
88 the string selected, as returned by `mouse-me-get-string-function'."
90 :options '(mouse-me-build-menu)
93 (defvar mouse-me-grep-use-extension 't
94 "*If non-nil `mouse-me-grep' grep's in files with current file's extension.")
96 (defcustom mouse-me-menu-commands
98 ("Kill" . kill-region)
99 ("Capitalize" . capitalize-region)
100 ("Lowercase" . downcase-region)
101 ("Uppercase" . upcase-region)
102 ("ISpell" . ispell-region)
104 ("Browse URL" . browse-url)
106 ("Execute File" . mouse-me-execute)
107 ("Mail to" . compose-mail)
108 ("Finger" . mouse-me-finger)
109 ("BBDB Lookup" . mouse-me-bbdb)
112 ("Find Tag" . find-tag)
113 ("Grep" . mouse-me-grep)
114 ("Find-Grep" . mouse-me-find-grep)
116 ("Apropos" . apropos)
117 ("Describe Function" . mouse-me-describe-function)
118 ("Describe Variable" . mouse-me-describe-variable)
119 ("Command Info" . mouse-me-emacs-command-info)
120 ("Man Page" . (if (fboundp 'woman) 'woman 'man))
121 ("Profile Function" . mouse-me-elp-instrument-function))
122 "*Command menu used by `mouse-me-build-menu'.
123 A list of elements where each element is either a cons cell or a string.
124 If a cons cell the car is a string to be displayed in the menu and the
125 cdr is either a function to call passing a string to, or a list which evals
126 to a function to call passing a string to. If the element is a string
127 it makes a non-selectable element in the menu. To make a separator line
128 use a string consisting solely of hyphens.
130 The function returned from this menu will be called with one string
131 argument. Or if the function has the symbol property `mouse-me-type'
132 and if its value is the symbol `region' it will be called with the
133 beginning and ending points of the selected string. If the value is
134 the symbol `string' it will be called with one string argument."
138 (put 'kill-region 'mouse-me-type 'region)
139 (put 'ispell-region 'mouse-me-type 'region)
140 (put 'capitalize-region 'mouse-me-type 'region)
141 (put 'downcase-region 'mouse-me-type 'region)
142 (put 'upcase-region 'mouse-me-type 'region)
147 (defun mouse-me (event)
148 "Popup a menu of functions to run on selected string or region."
150 (mouse-me-helper event #'(lambda ()
151 (or (x-popup-menu event (funcall mouse-me-build-menu-function name))
152 (error "No command to run")))))
154 ;;;; Exposed Functions
157 ;; <URL:http://foo.bar.com/sss/ss.html>
158 ;; <http://foo.bar.com/sss/ss.html>
159 ;; http://foo.bar.com/sss/ss.html
160 ;; http://www.ditherdog.com/howard/
161 ;; mailto:howard@silverstream.com
162 ;; howard@silverstream.com
163 ;; <howard@silverstream.com>
164 ;; import com.sssw.srv.agents.AgentsRsrc;
165 ;; public AgoHttpRequestEvent(Object o, String db, Request r)
166 ;; <DIV><A href=3D"http://www.amazon.com/exec/obidos/ASIN/156592391X"><IMG =
167 ;; <A HREF="http://www.suntimes.com/ebert/ebert.html">
168 ;; d:\howard\elisp\spoon
169 ;; \howard\elisp\spoon
170 ;; \\absolut\howard\elisp\spoon
171 ;; //absolut/d/Howard/Specs/servlet-2.1.pdf
172 ;; \\absolut\d\Howard\Specs\servlet-2.1.pdf
175 (defun mouse-me-get-string ()
176 "Return a string from the buffer of text surrounding point.
177 Returns a list of three elements, the string and the beginning and
178 ending positions of the string in the buffer in that order."
181 (let ((start (point)) beg end str p)
182 (skip-syntax-forward "^ >()\"")
185 (skip-syntax-backward "^ >()\"")
187 (setq str (buffer-substring-no-properties beg end))
188 ;; remove junk from the beginning
189 (if (string-match "^\\([][\"'`.,?:;!@#$%^&*()_+={}|<>-]+\\)" str)
190 (setq str (substring str (match-end 1))
191 beg (+ beg (match-end 1))))
192 ;; remove URL: from the front, it's common in email
193 (if (string-match "^\\(URL:\\)" str)
194 (setq str (substring str (match-end 1))
195 beg (+ beg (match-end 1))))
196 ;; remove junk from the end
197 (if (string-match "\\([][\"'.,?:;!@#$%^&*()_+={}|<>-]+\\)$" str)
198 (setq end (- end (length (match-string 1 str))) ; must set end first
199 str (substring str 0 (match-beginning 1))))
200 (list str beg end)))))
202 (defun mouse-me-build-menu (name)
203 "Return a menu tailored for NAME for `mouse-me' from `mouse-me-menu-commands'."
204 (list "Mouse Me" (cons "Mouse Me"
206 (if (< (length name) 65)
211 mouse-me-menu-commands))))
213 ;;;; Commands for the menu
215 (defun mouse-me-emacs-command-info (string)
216 "Look in Emacs info for command named STRING."
217 (interactive "sCommand: ")
218 (let ((s (intern-soft string)))
219 (if (and s (commandp s))
220 (Info-goto-emacs-command-node s)
221 (error "No command named `%s'" string))))
223 (defun mouse-me-describe-function (string)
224 "Describe function named STRING."
225 (interactive "sFunction: ")
226 (let ((s (intern-soft string)))
227 (if (and s (fboundp s))
228 (describe-function s)
229 (error "No function named `%s'" string))))
231 (defun mouse-me-describe-variable (string)
232 "Desribe variable named STRING."
233 (interactive "sVariable: ")
234 (let ((s (intern-soft string)))
235 (if (and s (boundp s))
236 (describe-variable s)
237 (error "No variable named `%s'" string))))
239 (defun mouse-me-elp-instrument-function (string)
240 "Instrument Lisp function named STRING."
241 (interactive "sFunction: ")
242 (let ((s (intern-soft string)))
243 (if (and s (fboundp s))
244 (elp-instrument-function s)
245 (error "Must be the name of an existing Lisp function"))))
247 (defun mouse-me-execute (string)
248 "Execute STRING as a filename."
249 (interactive "sFile: ")
250 (w32-shell-execute "open" (convert-standard-filename string)))
252 (defun mouse-me-bbdb (string)
253 "Lookup STRING in bbdb."
254 (interactive "sBBDB Lookup: ")
257 (error "BBDB not loaded")))
259 (defun mouse-me-finger (string)
260 "Finger a STRING mail address."
261 (interactive "sFinger: ")
263 (if (string-match "\\(.*\\)@\\([-.a-zA-Z0-9]+\\)$" string)
264 (finger (match-string 1 string) (match-string 2 string))
265 (error "Not in user@host form: %s" string))))
267 (defun mouse-me-grep (string)
269 (interactive "sGrep: ")
271 (grep-compute-defaults)
272 (let ((ext (mouse-me-buffer-file-extension)))
273 (grep (concat grep-command string
274 (if mouse-me-grep-use-extension
279 (defun mouse-me-find-grep (string)
281 (interactive "sGrep: ")
282 (grep-compute-defaults)
283 (let ((reg grep-find-command)
284 (ext (mouse-me-buffer-file-extension))
286 (if (string-match "\\(^.+-type f \\)\\(.+$\\)" reg)
287 (setq reg (concat (match-string 1 reg)
288 (if mouse-me-grep-use-extension
289 (concat "-name \"*" ext "\" "))
290 (match-string 2 reg))))
291 (grep-find (concat reg string))))
293 ;;;; Internal Functions
295 (defun mouse-me-buffer-file-extension ()
296 "Return the extension of the current buffer's filename or nil.
297 Returned extension is a string begining with a period."
298 (let* ((bfn (buffer-file-name))
299 (filename (and bfn (file-name-sans-versions bfn)))
300 (index (and filename (string-match "\\.[^.]*$" filename))))
302 (substring filename index)
305 (defun mouse-me-helper (event func)
306 "Determine the string to use to process EVENT and call FUNC to get cmd."
307 (let (name sp sm mouse beg end cmd mmtype)
308 ;; temporarily goto where the event occurred, get the name clicked
309 ;; on and enough info to figure out what to do with it
312 (setq sp (point)) ; saved point
313 (setq sm (mark t)) ; saved mark
314 (set-buffer (window-buffer (posn-window (event-start event))))
315 (setq mouse (goto-char (posn-point (event-start event))))
316 ;; if there is a region and point is inside it
317 ;; check for sm first incase (null (mark t))
318 ;; set name to either the thing they clicked on or region
320 (or (and transient-mark-mode mark-active)
321 (eq last-command 'mouse-drag-region))
322 (>= mouse (setq beg (min sp sm)))
323 (<= mouse (setq end (max sp sm))))
324 (setq name (buffer-substring beg end))
325 (setq name (funcall mouse-me-get-string-function))
327 (setq beg (nth 1 name)
331 (while (not (looking-at (regexp-quote name)))
334 (setq end (search-forward name))))))
335 ;; check if name is null, meaning they clicked on no word
337 (and (stringp name) (string= name "" )))
338 (error "No string to pass to function"))
339 ;; popup a menu to get a command to run
340 (setq cmd (funcall func))
341 ;; run the command, eval'ing if it was a list
343 (setq cmd (eval cmd)))
344 (setq mmtype (get cmd 'mouse-me-type))
345 (cond ((eq mmtype 'region)
346 (funcall cmd beg end))
350 (funcall cmd name)))))
354 ;;; mouseme.el ends here