Xref: funic comp.emacs:5892 gnu.emacs.sources:1092
Path: funic!fuug!mcsun!uknet!doc.ic.ac.uk!agate!stanford.edu!CSD-NewsHost.Stanford.EDU!times!wmesard
From: wmesard@Pescadero.Stanford.EDU (Wayne Mesard)
Newsgroups: comp.emacs,gnu.emacs.sources
Subject: wsm-xm-expand v1.1 (was Re: better compile.el available?)
Message-ID: <WMESARD.92Sep23160151@Pescadero.Stanford.EDU>
Date: 23 Sep 92 15:01:51 GMT
References: <MUTS.92Sep21203216@ruunfs.fys.ruu.nl>
Sender: news@CSD-NewsHost.Stanford.EDU
Organization: /pescadero/u3/wmesard/.organization
Lines: 422
In-Reply-To: muts@fys.ruu.nl's message of 21 Sep 92 18:32:18 GMT

muts@fys.ruu.nl (Peter Mutsaers) writes:
> I wonder if there is a better compile function available. What I would
> like is to point (with mouse...) to a specific error line...

wsm-xm-expand includes, among other things, a function that does that.
It requires Sullivan Beck's x-sb-mouse package (don't ask me for it, I
don't have it; it's available in
archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/misc/x-sb-mouse.tar.Z).

Since I made a few additions since I last posted it (support for GDB
mode, Outline mode, *Completions* buffer and MH-E), here it is again.

Wayne();

---
;;; wsm-xm-expand.el: WSM's Control-left-click customizations for x-sb-mouse
;;; Copyright (C) 1992 Wayne Mesard
;;;
;;; This program 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 1, or (at your option)
;;; any later version.
;;;
;;; This program 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.
;;;
;;; The GNU General Public License is available by anonymouse ftp from
;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
;;; USA.
;;--------------------------------------------------------------------

;;; DESCRIPTION
;;    This file binds the mouse gesture Control-Left-click to various
;;    functions which "expand" the thing being pointed to according to
;;    the buffer's mode or name:
;;
;;     Mode		Action
;;     ----     	------
;;     Info     	Follows the indicated cross-reference, menu item, 
;;              	 or the "Next", "Previous" or "Up" field from the
;;			 top line of the node.
;;     Outline  	Shows or hides the indicated subtree
;;     *compilation*	Jumps to the indicated line of source code.
;;     C and Emacs-Lisp	Does a find-tag on the thing being pointed to.
;;     GDB      	Selects the indicated stack frame.
;;     GNUS     	Selects the indicated newsgroup or article.
;;     RMail-Summary	Selects the indicated message.
;;     mh-e show	Selects the indicated message.
;;     *mh-temp*	Opens the indicated folder (from output of M-l).
;;     *Completions*	Enter the indicated text in the minibuffer.
;;     Dired    	Selects the indicated file.
;;     Buffer   	Selects the indicated buffer in another window.

;;; NOTES
;;    Several of these handlers (particular for *compilation* and 
;;    *Completions*) use private constructs.  They work in Emacs
;;    18.58, but could easily break in a later release.  Contact me
;;    if you need an update.
;;
;;    Wayne Mesard: wmesard@cs.stanford.edu

;;; HISTORY
;;    1.1 wmesard - Sep 10, 1992: Added stuff for: gdb, outline, 
;;                                completions, and MH. Fixed minor bugs.
;;                                Shortened function names.
;;    1.0 wmesard - Jul 16, 1992: Created

;;;
;;; DEPENDENCIES
;;;

;; Tested against x-sb-mouse version 1.6
(require 'x-sb-mouse)

;;; 
;;; BINDINGS
;;; 

(x-mouse-define-key "x-mouse-c1-window-click" t
 'default        	'wsm-xm-fake-modes
 'gnus-Group-mode	'wsm-xm-Group-read
 'gnus-Subject-mode	'wsm-xm-Subject-select
 'dired-mode    	'wsm-xm-dired-find-file
 'rmail-summary-mode	'wsm-xm-rmail-summary-jump
 'Buffer-menu-mode	'wsm-xm-buffer-menu
 'Info-mode     	'wsm-xm-Info-follow-link
 'c-mode        	'wsm-xm-find-tag
 'emacs-lisp-mode	'wsm-xm-find-tag
 'gdb-mode		'wsm-xm-frame
 'outline-mode		'wsm-xm-outline
 'mh-folder-mode	'wsm-xm-mh-show
 )

;; Left-click should ALWAYS be set-point.  It's too common an operation
;; to be overloading it.  Besides, the mouse is a _pointing_ device.  The
;; only things that should be on it are location-sensitive functions.
;; But religious convictions aside, we have to restore Left-click to
;; set-point anyway, since we just stole Control-left-click, which is the
;; only way to do set-point in GNUS using vanilla x-sb-mouse.

(x-mouse-undefine-key "x-mouse-1-window-click"
 'gnus-Group-mode
 'gnus-Subject-mode)


;;;
;;; DISPATCHER for things that don't have modes of their own
;;;

(defun wsm-xm-fake-modes ()
  "*compilation*, *mh-temp* and *Completions* don't have modes of their own.
This handler looks at the buffer name and figures out which function to call:
wsm-xm-compilation-jump, wsm-xm-mh-visit-folder or wsm-xm-minibuffer-complete,
respectively."
  (funcall
   (or (cdr (assoc (buffer-name (window-buffer x-mouse-win-u))
		   '(("*compilation*" . wsm-xm-compilation-jump)
		     (" *mh-temp*" . wsm-xm-mh-visit-folder)
		     (" *Completions*" . wsm-xm-minibuffer-complete))
		   ))
       x-mouse-set-point)
   ))


;;; 
;;; GNUS
;;; 

(defun wsm-xm-Group-read ()
  "For GNUS: Move point to the mouse location and read the indicated newsgroup"
  (x-mouse-set-point)
  (gnus-Group-read-group nil))

(defun wsm-xm-Subject-select ()
  "For GNUS: Move point to the mouse location and read the indicated article"
  (x-mouse-set-point)
  (gnus-Subject-select-article))

;;; 
;;; DIRED
;;; 

(defun wsm-xm-dired-find-file ()
  "For Dired: Move point to the mouse location and find the indicated file."
  (x-mouse-set-point)
  (dired-find-file-other-window))

;;; 
;;; RMAIL SUMMARY
;;; 

(defun wsm-xm-rmail-summary-jump ()
  "For Rmail-summary: show indicated message."
  (x-mouse-set-point)
  (rmail-summary-goto-msg))

;;; 
;;; BUFFER MENU
;;; 

(defun wsm-xm-buffer-menu ()
  "For Buffer Menu: Move to mouse location and select the indicated buffer."
  (x-mouse-set-point)
  (Buffer-menu-other-window))

;;; 
;;; COMPILATION
;;; 

;; Private variable used to detect clicking in the same place twice in a row
;; when there's no marker there.  This forces a reparse.
(defvar wsm-compilation-last-msgloc nil)

(defun wsm-xm-compilation-jump ()
  (wsm-xm-compilation-jump-to x-mouse-point-u))

(defun wsm-xm-compilation-jump-to (target)
  "Jump to the source code line indicated by a message in *compilation* buffer.
This is essentially a random-access version of the sequential \\[next-error].
\\[next-error] clears markers once it visits an error, so if you use both of
these at the same time, this function may have to reparse the compilation
buffer to reacquire the markers."
  (if (or (eq compilation-error-list t)
	  (eq wsm-compilation-last-msgloc target))
      (progn (compilation-forget-errors)
	     (setq compilation-parsing-end 1)))
  (if (or (null compilation-error-list)
	  (> target compilation-parsing-end))
      (save-excursion
	(set-buffer "*compilation*")
	(set-buffer-modified-p nil)
	(compilation-parse-errors)))
  (let ((lst compilation-error-list)
	curr)
    ;; Why not use beginning-of-line and memq? So that multi-line errors work
    (while (and lst (<= (car (car lst)) target))
      (setq curr (car lst))
      (setq lst (cdr lst))
      )
    (if (null curr)
	(progn
	  (setq wsm-compilation-last-msgloc target)
	  (error
	   "Marker is null.  Click again to force a reparse of the buffer.")
	  )
      (setq wsm-compilation-last-msgloc nil))
    (if (<= (car curr) target)
	(progn
	  (if (string= "*compilation*" (buffer-name (current-buffer)))
	      (other-window 1))
	  (switch-to-buffer (marker-buffer (car (cdr curr))))
	  (goto-char (car (cdr curr)))
	  )
      (error "Couldn't find mark"))
    ))

;;;
;;; INFO
;;;

(defun wsm-xm-Info-follow-link ()
  "For Info mode: Go to the indicated cross-reference, menu item or link
(where a link is the Prev, Next or Up fields in the first line of a node)."
  (select-window x-mouse-win-u)
  (wsm-Info-goto-link-at x-mouse-point-u))

(defun wsm-Info-goto-link-at (loc)
  (let (func arg)
    (save-excursion
      (goto-char loc)
      ;; Links in first line of node
      (if (save-excursion (beginning-of-line)
			  (bobp))
	(let (end)
	  (if (not
	       (progn			; Point in link type (Next, Up, Prev)
		 (skip-chars-forward "A-Za-z")
		 (= ?\: (char-after (point)))
		 ))
	      (progn			; Point in name ("(dir)", "top", etc)
		(goto-char loc)
		(search-backward ":" nil t)
		))
	  (setq end (point))
	  (forward-word -1)
	  ;; Okay, now we know point is at the start of the link type
	  (setq func
		(cdr (assoc (buffer-substring (point) end)
			    '(("Up" . Info-up) ("Next" . Info-next)
			      ("Prev" . Info-prev)("Previous" . Info-prev)
			      ))))
	  )
	;; Menus and References
	(if (or (= ?\* (char-after (point))) (search-backward "*" nil t))
	    (let ((starloc (point))
		  (link-func
		   (if (re-search-forward
			"^\\* \\([^:]*\\):[^.,:\n]*" nil t)
		       (function Info-menu)
		     (if (re-search-forward
			  "\\*note[ \n]\\([^:]*\\):[^.,:]*" nil t)
			 (function Info-follow-reference))))
		  )
	      (if (and (= starloc (match-beginning 0))
		       (<= starloc loc)
		       (< loc (point)))
		  ;; loc really was w/in the link. Set func and arg.
		  (setq func link-func
			arg (buffer-substring (match-beginning 1)
					      (match-end 1)))
		)
	      ))
	))
    (if func
	(if arg (funcall func arg)
	  (funcall func))
      (error "Point at a link or don't point at all"))
    ))

;;; 
;;; C / ELisp
;;; 

(defun wsm-xm-find-tag ()
  "For C&Elisp: Do a find-tag on the indicated symbol."
  (find-tag (save-excursion
	      (set-buffer (window-buffer x-mouse-win-u))
	      (let ((begend (thing-boundaries x-mouse-point-u)))
		(buffer-substring (car begend) (cdr begend)))
	      )))


;;; 
;;; GDB
;;; 

(defun wsm-xm-frame ()
  "For GDB: Execute 'frame' command on a line produced by 'where'."
  ;; Need to change windows and not save-excursion here because the gdb
  ;; process-filter will only pop up the appropriate file if point is at
  ;; the right place in the gdb buffer.
  (select-window x-mouse-win-u)
  (goto-char x-mouse-point-u)
  (beginning-of-line nil)
  (if (looking-at "#\\([0-9]+\\) ")
      (gdb-call (concat "frame " 
			(buffer-substring (match-beginning 1)
					  (match-end 1))))
    (error "Point at a backtrace line or don't point at all")
    ))

;;; 
;;; Outline
;;; 

(defun wsm-xm-outline ()
  "For Outline: Show or hide the indicated subtree"
  (save-excursion
    (set-buffer (window-buffer x-mouse-win-u))
    (goto-char x-mouse-point-u)
    (end-of-line nil)
    (let ((eoln (point)))
      (beginning-of-line nil)
      (if (save-excursion (search-forward "\^M" eoln t nil))
	  (show-subtree)
	(hide-subtree)
	))
    ))

;;; 
;;; COMPLETIONS
;;; 

(defun wsm-xm-minibuffer-complete ()
  "For the *Completions* buffer when the cursor's in the minibuffer:
Insert the indicated text into the minibuffer and pretend the user hit Return"
  (save-excursion
    (set-buffer (window-buffer x-mouse-win-u))
    (goto-char x-mouse-point-u)
    (let ((beg (save-excursion
		 (move-to-column (if (< (current-column) 35) 0 35))
		 (point))))
      ;; No-op if this is line 1 (which reads "Possible completions are:")
      (if (and (> beg (point-min))
	       (eq (selected-window) (minibuffer-window)))
	  (progn
	    (princ
	     (wsm-xm-string-rest 
	      (save-excursion 
		(set-buffer (window-buffer (minibuffer-window)))
		(buffer-string))
	      (buffer-substring beg
				(save-excursion
				  (if (< (current-column) 35)
				      (progn
					(move-to-column 35)
					(skip-chars-backward " \t" beg))
				      (end-of-line nil)
				      )
				  (point)
				  ))
	      )
	     (window-buffer (minibuffer-window)))
	    (exit-minibuffer)
	    ))
      ))
  )


;; BUF      TARGET  RESULT
;; "a"      "abc"   "bc"
;; "abc"    "abc"   ""
;; "abcab"  "abc"   "c"
;; "abcabc" "abc"   ""
;; "x"      "abc"   "abc"
;; "abx"    "abc"   "abc"
;;
;; 1. Look at b[s-$]
;; 2. If it matches t[0-x], return t[x+1-$]
;;    Else incr s, goto 1.
(defun wsm-xm-string-rest (buf target)
  (let* ((lb (length buf))
	 (split (max 0 (- lb (length target)))))
    (while (and (< split lb)
		(not (string= (substring buf split) 
			      (substring target 0 (- lb split)))
		     ))
      (setq split (1+ split))
      )
    (substring target (- lb split))
    ))


;;;
;;; MH
;;;

(defun wsm-xm-mh-show ()
  "For MH folder: Select the indicated message."
  (save-excursion
    (set-buffer (window-buffer x-mouse-win-u))
    (goto-char x-mouse-point-u)
    (mh-show)
    ))

(defun wsm-xm-mh-visit-folder ()
  "For MH folder list (i.e. the output from M-l): visit indicated folder"
  (mh-visit-folder
   (concat "+"
	   (progn
	     (set-buffer (window-buffer x-mouse-win-u))
	     (goto-char x-mouse-point-u)
	     (beginning-of-line nil)
	     (if (re-search-forward "\\(\\<.+\\>\\)[ +] has")
		 (buffer-substring (match-beginning 1) (match-end 1)))
	     )))
  (condition-case nil 
      (delete-window x-mouse-win-u)
    (error nil)))