klimi
/
dotfiles


								;;; 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