Klimi's new dotfiles with stow.
Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.
 
 
 
 
 
 

355 рядки
13 KiB

;;; 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
;; https://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 (name)
(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