Klimi's new dotfiles with stow.
Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

355 rindas
13 KiB

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