1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
|
;;; 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
;; http://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 ()
(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
|
