home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / sources / 552 < prev    next >
Encoding:
Text File  |  1992-07-25  |  8.8 KB  |  288 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!stanford.edu!CSD-NewsHost.Stanford.EDU!times!wmesard
  3. From: wmesard@Pescadero.Stanford.EDU (Wayne Mesard)
  4. Subject: wsm-xm-expand: an x-sb-mouse customization
  5. Message-ID: <WMESARD.92Jul24161825@Pescadero.Stanford.EDU>
  6. Sender: news@CSD-NewsHost.Stanford.EDU
  7. Organization: /pescadero/u3/wmesard/.organization
  8. Date: 24 Jul 92 16:18:25
  9. Lines: 277
  10.  
  11. Enclosed is a file which implements a bunch of mode-specific extensions
  12. to Sullivan Beck's excellent mouse handler that he posted here a couple
  13. of weeks ago.
  14.  
  15. Basically, it "expands" whatever the mouse is pointing at when you click
  16. the left button while holding down the Control key.  The exact meaning
  17. of "expand" depends on the mode of the buffer.  See the DESCRIPTION
  18. section at the top of the file for details.
  19.  
  20. Comments, suggestions, questions welcome.
  21.  
  22. Wayne();
  23. WMesard@cs.stanford.edu
  24.  
  25. ---snip---crickle---pip---
  26. ;;; wsm-xm-expand.el: WSM's Control-left-click customizations for x-sb-mouse
  27. ;;; Copyright (C) 1992 Wayne Mesard
  28. ;;;
  29. ;;; This program is free software; you can redistribute it and/or modify
  30. ;;; it under the terms of the GNU General Public License as published by
  31. ;;; the Free Software Foundation; either version 1, or (at your option)
  32. ;;; any later version.
  33. ;;;
  34. ;;; This program is distributed in the hope that it will be useful,
  35. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  37. ;;; GNU General Public License for more details.
  38. ;;;
  39. ;;; The GNU General Public License is available by anonymouse ftp from
  40. ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  41. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  42. ;;; USA.
  43. ;;--------------------------------------------------------------------
  44.  
  45. ;;; DESCRIPTION
  46. ;;    This file binds the mouse gesture Control-Left-click to various
  47. ;;    functions which "expand" the thing being pointed to according to
  48. ;;    the buffer's mode.
  49. ;;
  50. ;;     Mode     Action
  51. ;;     ----     -----------
  52. ;;     Info     follows the indicated cross-reference, menu item, or the
  53. ;;              "Next", "Previous" or "Up" field from the top line of the node.
  54. ;;     Compile  goes to the indicated line of source code.
  55. ;;     C and Emacs-Lisp
  56. ;;              does a find-tag on the thing being pointed to.
  57. ;;     GNUS     selects the indicated newsgroup or article.
  58. ;;     Dired    selects the indicated file.
  59. ;;     RMail-Summary
  60. ;;              selects the indicated message.
  61. ;;     Buffer   selects the indicated buffer in another window.
  62.  
  63. ;;; NOTES
  64. ;;    The compilation stuff uses several private constructs from
  65. ;;    compile.el.  It works in Emacs 18.58.  But it could easily break
  66. ;;    in a later release.  Contact me if you need an update.
  67. ;;
  68. ;;    I know I'm missing "expanders" for mh-letter-mode and mh-folder-mode.
  69. ;;    I plan to start using MH-E sometime soon, so I'll add these then.
  70. ;;    Send me email if you want the mod's when they're ready.
  71. ;;
  72. ;;    Wayne Mesard: wmesard@cs.stanford.edu
  73.  
  74. ;;; HISTORY
  75. ;;    1.0 wmesard - Jul 16, 1992: Created
  76.  
  77. ;;;
  78. ;;; DEPENDENCIES
  79. ;;;
  80.  
  81. ;; x-sb-mouse version 1.6
  82. (require 'x-sb-mouse)
  83.  
  84. ;;; 
  85. ;;; BINDINGS
  86. ;;; 
  87.  
  88. (x-mouse-define-key "x-mouse-c1-window-click" t
  89.  'default            'x-mouse-set-point
  90.  'gnus-Group-mode    'wsm-x-mouse-Group-read
  91.  'gnus-Subject-mode    'wsm-x-mouse-Subject-select
  92.  'dired-mode        'wsm-x-mouse-dired-find-file
  93.  'rmail-summary-mode    'wsm-x-mouse-rmail-summary-jump
  94.  'Buffer-menu-mode    'wsm-x-mouse-buffer-menu
  95.  'Info-mode         'wsm-x-mouse-Info-follow-link
  96.  ;; There is no compilation mode, so this function will have to check
  97.  ;; to make sure that it really is a *compilation* buffer.
  98.  'fundamental-mode    'wsm-x-mouse-maybe-compilation-goto
  99.  'c-mode            'wsm-x-mouse-find-tag
  100.  'emacs-lisp-mode    'wsm-x-mouse-find-tag
  101. )
  102.  
  103.  
  104. ;; We have to restore Left-click to set-point anyway, since we just
  105. ;; stole Control-left-click, which is the only way to do set-point in
  106. ;; GNUS using vanilla x-sb-mouse.
  107.  
  108. (x-mouse-undefine-key "x-mouse-1-window-click"
  109.  'gnus-Group-mode
  110.  'gnus-Subject-mode)
  111.  
  112. ;;; 
  113. ;;; GNUS
  114. ;;; 
  115.  
  116. (defun wsm-x-mouse-Group-read ()
  117.   "For GNUS: Move point to the mouse location and read the indicated newsgroup"
  118.   (x-mouse-set-point)
  119.   (gnus-Group-read-group nil))
  120.  
  121. (defun wsm-x-mouse-Subject-select ()
  122.   "For GNUS: Move point to the mouse location and read the indicated article"
  123.   (x-mouse-set-point)
  124.   (gnus-Subject-select-article))
  125.  
  126. ;;; 
  127. ;;; DIRED
  128. ;;; 
  129.  
  130. (defun wsm-x-mouse-dired-find-file ()
  131.   "For Dired: Move point to the mouse location and find the indicated file."
  132.   (x-mouse-set-point)
  133.   (dired-find-file-other-window))
  134.  
  135. ;;; 
  136. ;;; RMAIL SUMMARY
  137. ;;; 
  138.  
  139. (defun wsm-x-mouse-rmail-summary-jump ()
  140.   (x-mouse-set-point)
  141.   (rmail-summary-goto-msg))
  142.  
  143. ;;; 
  144. ;;; BUFFER MENU
  145. ;;; 
  146.  
  147. (defun wsm-x-mouse-buffer-menu ()
  148.   "For Buffer Menu: Move to mouse location and select the indicated buffer."
  149.   (x-mouse-set-point)
  150.   (Buffer-menu-other-window))
  151.  
  152. ;;; 
  153. ;;; COMPILATION
  154. ;;; 
  155.  
  156. (defun wsm-x-mouse-maybe-compilation-goto ()
  157.   "Jump to the source code line indicated by a message in *compilation* buffer.
  158. This is essentially a random-access version of the sequential \\[next-error].
  159. \\[next-error] clears markers once it visits an error, so if you use both of
  160. these at the same time, this function may have to reparse the compilation
  161. buffer to reacquire the markers.
  162.  
  163. If it isn't a compilation buffer, simply moves point to the mouse location."
  164.     (if (equal (buffer-name (window-buffer x-mouse-win-u))
  165.                    "*compilation*")
  166.                (wsm-compilation-jump x-mouse-point-u)
  167.              (x-mouse-set-point)))
  168.  
  169. ;; Private variable used to detect clicking in the same place twice in a row
  170. ;; when there's no marker there.  This forces a reparse.
  171.  
  172. (defvar wsm-compilation-last-msgloc nil)
  173.  
  174. (defun wsm-compilation-jump (msgloc)
  175.   (if (or (eq compilation-error-list t)
  176.       (eq wsm-compilation-last-msgloc msgloc))
  177.       (progn (compilation-forget-errors)
  178.          (setq compilation-parsing-end 1)))
  179.   (if (or (null compilation-error-list)
  180.       (> msgloc compilation-parsing-end))
  181.       (save-excursion
  182.     (set-buffer "*compilation*")
  183.     (set-buffer-modified-p nil)
  184.     (compilation-parse-errors)))
  185.   (let ((lst compilation-error-list)
  186.     curr)
  187.     (while (and lst (<= (car (car lst)) msgloc))
  188.       (setq curr (car lst))
  189.       (setq lst (cdr lst))
  190.       )
  191.     (if (null curr)
  192.     (progn
  193.       (setq wsm-compilation-last-msgloc msgloc)
  194.       (error
  195.        "Marker is null.  Click again to force a reparse of the buffer.")
  196.       )
  197.       (setq wsm-compilation-last-msgloc nil))
  198.     (if (<= (car curr) msgloc)
  199.     (progn
  200.       (if (string= "*compilation*" (buffer-name (current-buffer)))
  201.           (other-window 1))
  202.       (switch-to-buffer (marker-buffer (car (cdr curr))))
  203.       (goto-char (car (cdr curr)))
  204.       )
  205.       (error "Couldn't find mark"))
  206.     ))
  207.  
  208. ;;;
  209. ;;; INFO
  210. ;;;
  211.  
  212. (defun wsm-x-mouse-Info-follow-link ()
  213.   "For Info mode: Go to the indicated cross-reference, menu item or link
  214. (where a link is the Prev, Next or Up fields in the first line of a node)."
  215.   (select-window x-mouse-win-u)
  216.   (wsm-Info-goto-link-at x-mouse-point-u))
  217.  
  218. (defun wsm-Info-goto-link-at (loc)
  219.   (let (func arg)
  220.     (save-excursion
  221.       (goto-char loc)
  222.       ;; Links in first line of node
  223.       (if (save-excursion (beginning-of-line)
  224.               (bobp))
  225.     (let (end)
  226.       (if (not
  227.            (progn            ; Point in link type (Next, Up, Prev)
  228.          (skip-chars-forward "A-Za-z")
  229.          (= ?\: (char-after (point)))
  230.          ))
  231.           (progn            ; Point in name ("(dir)", "top", etc)
  232.         (goto-char loc)
  233.         (search-backward ":" nil t)
  234.         ))
  235.       (setq end (point))
  236.       (forward-word -1)
  237.       ;; Okay, now we know point is at the start of the link type
  238.       (setq func
  239.         (cdr (assoc (buffer-substring (point) end)
  240.                 '(("Up" . Info-up) ("Next" . Info-next)
  241.                   ("Prev" . Info-prev)("Previous" . Info-prev)
  242.                   ))))
  243.       )
  244.     ;; Menus and References
  245.     (if (or (= ?\* (char-after (point))) (search-backward "*" nil t))
  246.         (let ((starloc (point))
  247.           (link-func
  248.            (if (re-search-forward
  249.             "^\\* \\([^:]*\\):[^.,:\n]*" nil t)
  250.                (function Info-menu)
  251.              (if (re-search-forward
  252.               "\\*note \\([^:]*\\):[^.,:]*" nil t)
  253.              (function Info-follow-reference))))
  254.           )
  255.           (if (and (= starloc (match-beginning 0))
  256.                (<= starloc loc)
  257.                (< loc (point)))
  258.           ;; loc really was w/in the link. Set func and arg.
  259.           (setq func link-func
  260.             arg (buffer-substring (match-beginning 1)
  261.                           (match-end 1)))
  262.         )
  263.           ))
  264.     ))
  265.     (if func
  266.     (if arg (funcall func arg)
  267.       (funcall func))
  268.       (error "Point at a link or don't point at all"))
  269.     ))
  270.  
  271. ;;; 
  272. ;;; C / ELisp
  273. ;;; 
  274.  
  275. (defun wsm-x-mouse-find-tag ()
  276.   "For C: Do a find-tag on the indicated symbol."
  277.   ;; The awkward nested let's are to handle the case mouse-point isn't
  278.   ;; in the current buffer.
  279.   (let (str)
  280.     (save-excursion
  281.       (set-buffer (window-buffer x-mouse-win-u))
  282.       (let ((begend (thing-boundaries x-mouse-point-u)))
  283.     (setq str (buffer-substring (car begend) (cdr begend)))
  284.     ))
  285.     (find-tag str)
  286.     ))
  287.  
  288.