;;; mouseme.el --- mouse menu with commands that operate on strings ;; Copyright (C) 1997 by Free Software Foundation, Inc. ;; Author: Howard Melman ;; 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: ;; ;; ;; http://foo.bar.com/sss/ss.html ;; http://www.ditherdog.com/howard/ ;; mailto:howard@silverstream.com ;; howard@silverstream.com ;; ;; import com.sssw.srv.agents.AgentsRsrc; ;; public AgoHttpRequestEvent(Object o, String db, Request r) ;;
;; 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