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 (if (fboundp 'w32-shell-execute
)
251 (w32-shell-execute "open" (convert-standard-filename string
))
252 (message "This function currently working only in W32.")))
255 (defun mouse-me-bbdb (string)
256 "Lookup STRING in bbdb."
257 (interactive "sBBDB Lookup: ")
260 (error "BBDB not loaded")))
262 (defun mouse-me-finger (string)
263 "Finger a STRING mail address."
264 (interactive "sFinger: ")
266 (if (string-match "\\(.*\\)@\\([-.a-zA-Z0-9]+\\)$" string
)
267 (finger (match-string 1 string
) (match-string 2 string
))
268 (error "Not in user@host form: %s" string
))))
270 (defun mouse-me-grep (string)
272 (interactive "sGrep: ")
274 (grep-compute-defaults)
275 (let ((ext (mouse-me-buffer-file-extension)))
276 (grep (concat grep-command string
277 (if mouse-me-grep-use-extension
282 (defun mouse-me-find-grep (string)
284 (interactive "sGrep: ")
285 (grep-compute-defaults)
286 (let ((reg grep-find-command
)
287 (ext (mouse-me-buffer-file-extension))
289 (if (string-match "\\(^.+-type f \\)\\(.+$\\)" reg
)
290 (setq reg
(concat (match-string 1 reg
)
291 (if mouse-me-grep-use-extension
292 (concat "-name \"*" ext
"\" "))
293 (match-string 2 reg
))))
294 (grep-find (concat reg string
))))
296 ;;;; Internal Functions
298 (defun mouse-me-buffer-file-extension ()
299 "Return the extension of the current buffer's filename or nil.
300 Returned extension is a string begining with a period."
301 (let* ((bfn (buffer-file-name))
302 (filename (and bfn
(file-name-sans-versions bfn
)))
303 (index (and filename
(string-match "\\.[^.]*$" filename
))))
305 (substring filename index
)
308 (defun mouse-me-helper (event func
)
309 "Determine the string to use to process EVENT and call FUNC to get cmd."
310 (let (name sp sm mouse beg end cmd mmtype
)
311 ;; temporarily goto where the event occurred, get the name clicked
312 ;; on and enough info to figure out what to do with it
315 (setq sp
(point)) ; saved point
316 (setq sm
(mark t
)) ; saved mark
317 (set-buffer (window-buffer (posn-window (event-start event
))))
318 (setq mouse
(goto-char (posn-point (event-start event
))))
319 ;; if there is a region and point is inside it
320 ;; check for sm first incase (null (mark t))
321 ;; set name to either the thing they clicked on or region
323 (or (and transient-mark-mode mark-active
)
324 (eq last-command
'mouse-drag-region
))
325 (>= mouse
(setq beg
(min sp sm
)))
326 (<= mouse
(setq end
(max sp sm
))))
327 (setq name
(buffer-substring beg end
))
328 (setq name
(funcall mouse-me-get-string-function
))
330 (setq beg
(nth 1 name
)
334 (while (not (looking-at (regexp-quote name
)))
337 (setq end
(search-forward name
))))))
338 ;; check if name is null, meaning they clicked on no word
340 (and (stringp name
) (string= name
"" )))
341 (error "No string to pass to function"))
342 ;; popup a menu to get a command to run
343 (setq cmd
(funcall func
))
344 ;; run the command, eval'ing if it was a list
346 (setq cmd
(eval cmd
)))
347 (setq mmtype
(get cmd
'mouse-me-type
))
348 (cond ((eq mmtype
'region
)
349 (funcall cmd beg end
))
353 (funcall cmd name
)))))
357 ;;; mouseme.el ends here