231 lines
		
	
	
		
			7.5 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
			
		
		
	
	
			231 lines
		
	
	
		
			7.5 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
;;; fm.el --- follow mode for compilation/output buffers
 | 
						|
 | 
						|
;; Copyright (C) 1997 Stephen Eglen
 | 
						|
 | 
						|
;; Author: Stephen Eglen <stephen@anc.ed.ac.uk>
 | 
						|
;; Maintainer: Stephen Eglen <stephen@anc.ed.ac.uk>, Joe Bloggs <vapniks@yahoo.com>
 | 
						|
;; Created: 03 Jul 1997
 | 
						|
;; Version: 20130612.1
 | 
						|
;; Keywords: outlines
 | 
						|
;; location: https://github.com/vapniks/fm
 | 
						|
 
 | 
						|
;; 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 2, 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.
 | 
						|
 | 
						|
;; You should have received a copy of the GNU General Public License
 | 
						|
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 | 
						|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 | 
						|
;; Boston, MA 02111-1307, USA.
 | 
						|
 | 
						|
;;; Commentary:
 | 
						|
 | 
						|
;; As you move through the lines of an output buffer (such as from
 | 
						|
;; `grep' or `occur'), another window highlights the corresponding
 | 
						|
;; line of the source buffer.
 | 
						|
 | 
						|
;; This is inspired by the table of contents code from reftex.el.
 | 
						|
;; http://www.strw.leidenuniv.nl/~dominik/Tools/
 | 
						|
 | 
						|
;; To use the mode, do M-x fm-start in the output buffer.  Or just add
 | 
						|
;; it to the mode hooks, e.g.:
 | 
						|
;; (add-hook 'occur-mode-hook 'fm-start)
 | 
						|
;; (add-hook 'compilation-mode-hook 'fm-start)
 | 
						|
;; 
 | 
						|
 | 
						|
;;; Examples:
 | 
						|
;;  
 | 
						|
;; Do an occur for the word `package' in the NEWS file:
 | 
						|
;; C-h n
 | 
						|
;; M-x occur RTN package RTN
 | 
						|
 | 
						|
;; or test it on the current file:
 | 
						|
;; (grep "grep -n 'def' fm.el")
 | 
						|
;; (occur "def")
 | 
						|
 | 
						|
;; Once following is activated in a buffer, it can be toggled with the
 | 
						|
;; "f" key in that buffer.
 | 
						|
 | 
						|
;; To extend this code to handle other types of output buffer, you
 | 
						|
;; need to add an entry to the alist `fm-modes', e.g:
 | 
						|
;; (add-to-list 'fm-modes '(my-mode my-mode-goto-item))
 | 
						|
;; where my-mode-goto-item is a function that opens the source buffer
 | 
						|
;; at the place appropriate for the current item.
 | 
						|
;; You can set the number of lines to display in the items buffer when
 | 
						|
;; in fm-mode by setting the buffer local variable `fm-window-lines'. 
 | 
						|
 | 
						|
 | 
						|
;; If you want to use fm in a buffer that doesn't have a useful major
 | 
						|
;; mode, you can always set the value of fm-defun yourself.  For
 | 
						|
;; example, the cscope buffer is in fundamental mode, so in this case
 | 
						|
;; we set fm-defun as a local variable to be the defun to use for
 | 
						|
;; visiting the corresponding line of the source buffer.
 | 
						|
 | 
						|
(add-hook 'cscope-query-hook 'cscope-run-fm)
 | 
						|
 | 
						|
(defun cscope-run-fm ()
 | 
						|
  "Run cscope in the fm buffer."
 | 
						|
  (set (make-local-variable 'fm-defun) '(cscope-interpret-output-line))
 | 
						|
;; You can set the number of lines to show to 10 by uncommenting the following line.  
 | 
						|
;;  (setq fm-window-lines 10)
 | 
						|
  (fm-start))
 | 
						|
 | 
						|
;; If you are using this in the compile mode, you may find it easier
 | 
						|
;; to use the key M-p to go to the previous error.  Otherwise, you may
 | 
						|
;; find that if you go up one line, and this line doesn't have an
 | 
						|
;; error on it, it goes down one line again, taking you back where you
 | 
						|
;; started!
 | 
						|
 | 
						|
;;; Installation:
 | 
						|
;;
 | 
						|
;; Put fm.el in a directory in your load-path, e.g. ~/.emacs.d/
 | 
						|
;; You can add a directory to your load-path with the following line in ~/.emacs
 | 
						|
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
 | 
						|
;; where ~/elisp is the directory you want to add 
 | 
						|
;; (you don't need to do this for ~/.emacs.d - it's added by default).
 | 
						|
;;
 | 
						|
;; Add the following to your ~/.emacs startup file.
 | 
						|
;;
 | 
						|
;; (require 'fm)
 | 
						|
 | 
						|
 | 
						|
;;; TODO
 | 
						|
;; ??
 | 
						|
 | 
						|
;;; Code:
 | 
						|
 | 
						|
;; fm-highlight is currently used to highlight the regions of both
 | 
						|
;; the source(0) and output(1) buffers.
 | 
						|
 | 
						|
(defvar fm-modes 
 | 
						|
  '( (compilation-mode compile-goto-error)
 | 
						|
     (occur-mode  occur-mode-goto-occurrence)
 | 
						|
     (outlines-mode  outlines-goto-line) ;; sje hack
 | 
						|
     ;;(fundamental-mode cscope-interpret-output-line) ;;todo big time
 | 
						|
     )
 | 
						|
  "Alist of modes and the corresponding defun to visit source buffer.")
 | 
						|
 | 
						|
;; toggles...
 | 
						|
(defvar fm-working t)
 | 
						|
(defvar fm-window-lines nil
 | 
						|
  "If non-nil then set the output buffer to this many lines in height when follow mode is on.")
 | 
						|
(make-variable-buffer-local 'fm-window-lines)
 | 
						|
 | 
						|
(defun fm-start ()
 | 
						|
  "Set up `follow-mode' to run on the current buffer.
 | 
						|
This should be added to buffers through hooks, such as
 | 
						|
`occur-mode-hook'."
 | 
						|
  (interactive)
 | 
						|
  (let ((l))
 | 
						|
    ;; first check to see if it is worth running fm in this mode.
 | 
						|
    (if (not (boundp 'fm-defun))
 | 
						|
	(progn
 | 
						|
	  (setq f (cdr (assoc major-mode fm-modes)))
 | 
						|
	  (if f 
 | 
						|
	      (set (make-local-variable 'fm-defun) f))))
 | 
						|
    
 | 
						|
    (if (boundp 'fm-defun)
 | 
						|
	(progn
 | 
						|
	  (add-hook 'post-command-hook 'fm-post-command-hook nil 'local)
 | 
						|
	  (add-hook 'pre-command-hook  'fm-pre-command-hook  nil 'local)
 | 
						|
	  (local-set-key "f" 'fm-toggle)
 | 
						|
	  )
 | 
						|
      ;; else 
 | 
						|
      (error "Cannot use fm in this mode."))))
 | 
						|
 | 
						|
(defun fm-pre-command-hook ()
 | 
						|
  "Remove highlighing in both source and output buffers."
 | 
						|
  ;; used as pre command hook in *toc* buffer
 | 
						|
  (if fm-working
 | 
						|
      (progn
 | 
						|
	(fm-unhighlight 0)
 | 
						|
	(fm-unhighlight 1)
 | 
						|
	)))
 | 
						|
 | 
						|
(defun fm-post-command-hook (&optional lines)
 | 
						|
  "Add the highlighting if possible to both source and output buffers."
 | 
						|
  ;;(message (format "run post in %s" (buffer-name)) )
 | 
						|
  (if fm-working
 | 
						|
      (let (ret)
 | 
						|
	(progn
 | 
						|
	  (let ((buf (buffer-name))
 | 
						|
		(f nil))
 | 
						|
	    
 | 
						|
	    
 | 
						|
	    ;; select current line.
 | 
						|
	    (if (not (boundp 'fm-defun))
 | 
						|
		(error "Cannot use fm in this buffer."))
 | 
						|
 | 
						|
	    (setq ret
 | 
						|
		  (condition-case nil
 | 
						|
		      (eval fm-defun)
 | 
						|
		    (error 'failed)))
 | 
						|
	    ;;(message "ret is %s" ret)
 | 
						|
 | 
						|
	    (if (not (eq ret 'failed))
 | 
						|
		(progn
 | 
						|
		  ;; make the highlight in the source buffer.
 | 
						|
		  (save-excursion
 | 
						|
		    (fm-highlight 0
 | 
						|
				  (progn (beginning-of-line) (point))
 | 
						|
				  (progn (end-of-line) (point))))
 | 
						|
		
 | 
						|
		
 | 
						|
		  ;; make the highlight in the output buffer.    
 | 
						|
		  (pop-to-buffer buf)
 | 
						|
 | 
						|
		  (and (> (point) 1) 
 | 
						|
		       (save-excursion
 | 
						|
			 (fm-highlight 1 
 | 
						|
				       (progn (beginning-of-line) (point))
 | 
						|
				       (progn (end-of-line) (point)))))
 | 
						|
                  (if fm-window-lines
 | 
						|
                      (shrink-window (- (window-body-height) fm-window-lines))))
 | 
						|
	      ;; else there was an error 
 | 
						|
	      (progn
 | 
						|
		;; make sure we stay in output buffer.
 | 
						|
		(pop-to-buffer buf)
 | 
						|
	      (message "couldn't find line..."))))))))
 | 
						|
 | 
						|
(defun fm-toggle ()
 | 
						|
  "Toggle the fm behaviour on and off."
 | 
						|
  (interactive)
 | 
						|
  (setq fm-working (not fm-working)))
 | 
						|
 | 
						|
;;; Highlighting (copied from reftex.el -- cheers Carsten!)
 | 
						|
 | 
						|
;; Highlighting uses overlays.  If this is for XEmacs, we need to load
 | 
						|
;; the overlay library, available in version 19.15
 | 
						|
(and (not (fboundp 'make-overlay))
 | 
						|
     (condition-case nil
 | 
						|
         (require 'overlay)
 | 
						|
       ('error 
 | 
						|
        (error "Fm needs overlay emulation (available in XEmacs 19.15)"))))
 | 
						|
 | 
						|
;; We keep a vector with several different overlays to do our highlighting.
 | 
						|
(defvar fm-highlight-overlays [nil nil])
 | 
						|
 | 
						|
;; Initialize the overlays
 | 
						|
(aset fm-highlight-overlays 0 (make-overlay 1 1))
 | 
						|
(overlay-put (aref fm-highlight-overlays 0) 'face 'highlight)
 | 
						|
(aset fm-highlight-overlays 1 (make-overlay 1 1))
 | 
						|
(overlay-put (aref fm-highlight-overlays 1) 'face 'highlight)
 | 
						|
 | 
						|
;; Two functions for activating and deactivation highlight overlays
 | 
						|
(defun fm-highlight (index begin end &optional buffer)
 | 
						|
  "Highlight a region with overlay INDEX."
 | 
						|
  (move-overlay (aref fm-highlight-overlays index)
 | 
						|
                begin end (or buffer (current-buffer))))
 | 
						|
(defun fm-unhighlight (index)
 | 
						|
  "Detatch overlay INDEX."
 | 
						|
  (delete-overlay (aref fm-highlight-overlays index)))
 | 
						|
 | 
						|
(provide 'fm)
 | 
						|
;;; fm.el ends here
 |