Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
299 lines (257 sloc) 11.2 KB
;;; grep-a-lot.el --- manages multiple search results buffers for grep.el
;; Copyright (C) 2008-2013 Avi Rozen
;; Author: Avi Rozen <avi.rozen@gmail.com>
;; Keywords: tools, convenience, search
;; URL: https://github.com/ZungBang/emacs-grep-a-lot
;; Version: 1.0.7
;; This file is NOT part of GNU Emacs.
;; 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 3, 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 this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This package manages multiple search results buffers:
;; - the search results of grep, lgrep, rgrep, and find-grep are sent
;; to separate buffers instead of overwriting the contents of a single
;; buffer (buffers are named *grep*<N> where N is a number)
;; - several navigation functions are provided to allow the user to treat
;; the search results buffers as a stack and/or ring, and to easily reset
;; the state of each search buffer after navigating through the results
;;
;; Installation:
;;
;; 1. Put this file in a directory that is a member of load-path, and
;; byte-compile it (e.g. with `M-x byte-compile-file') for better
;; performance.
;; 2. Add the following to your ~/.emacs:
;; (require 'grep-a-lot)
;; (grep-a-lot-setup-keys)
;; 3. If you're using igrep.el you may want to add:
;; (grep-a-lot-advise igrep)
;;
;; Currently, there are no customization options.
;;
;; Default Key Bindings:
;;
;; Ring navigation:
;; M-g ] Go to next search results buffer, restore its current search context
;; M-g [ Ditto, but selects previous buffer.
;; Navigation is cyclic.
;;
;; Stack navigation:
;; M-g - Pop to previous search results buffer (kills top search results buffer)
;; M-g _ Clear the search results stack (kills all grep-a-lot buffers!)
;;
;; Other:
;; M-g = Restore buffer and position where current search started
;;
;;; Code:
(require 'advice)
(require 'grep)
(defconst grep-a-lot-buffer-name-regexp "^\\*grep\\*<\\([0-9]+\\)>$"
"Buffer name regular expression for extracting stack position.")
(defvar grep-a-lot-is-current-buffer nil
"Default value for buffer local variable `grep-a-lot-is-current-buffer'.")
(defvar grep-a-lot-context-initial nil
"Default value for buffer local variable `grep-a-lot-context-initial'.")
(defvar grep-a-lot-context nil
"Default value for buffer local variable `grep-a-lot-context'.")
(defun grep-a-lot-buffer-p (&optional buffer)
"Return non-nil if BUFFER is a grep-a-lot search result buffer.
The buffer name must match `grep-a-lot-buffer-name-regexp'.
With no argument or nil as argument, check current buffer."
(let ((name (buffer-name buffer)))
(if (string-match grep-a-lot-buffer-name-regexp name)
(get-buffer name)
nil)))
(defun grep-a-lot-current-buffer-p (&optional buffer)
"Return non-nil if BUFFER is the current grep-a-lot search result buffer.
With no argument or nil as argument, check current buffer."
(let ((buffer (grep-a-lot-buffer-p buffer)))
(if buffer
(with-current-buffer buffer
(if grep-a-lot-is-current-buffer
buffer
nil))
nil)))
(defun grep-a-lot-buffers (&optional reverse)
"Return a sorted list of grep-a-lot search result buffers.
With REVERSE non-nil the sort order is reversed."
(let* ((buffers nil)
(all-buffers (buffer-list)))
;; filter out non grep-a-lot buffers
(while all-buffers
(let ((buffer (car all-buffers)))
(if (grep-a-lot-buffer-p buffer)
(setq buffers (append buffers (list buffer))))
(setq all-buffers (cdr all-buffers))))
;; sort buffers
(sort buffers (lambda (a b)
(let ((pos-a (grep-a-lot-buffer-position (buffer-name a)))
(pos-b (grep-a-lot-buffer-position (buffer-name b))))
(if reverse
;; assume pos-a and pos-b are not equal
(< pos-b pos-a)
(< pos-a pos-b)))))))
(defun grep-a-lot-last-buffer ()
"Return last grep-a-lot buffer."
(car (last (grep-a-lot-buffers))))
(defun grep-a-lot-get-current-buffer (&optional buffers)
"Returns the current search results buffer, from the list BUFFERS.
Returns nil if no such buffer exists.
BUFFERS can either be a list generated by `grep-a-lot-buffers' or nil,
in which case the list of buffers to consider is generated by `grep-a-lot-buffers'."
(let ((current nil)
(buffers (or buffers (grep-a-lot-buffers))))
(while buffers
(if (grep-a-lot-current-buffer-p (car buffers))
(setq current (car buffers)
buffers nil)
(setq buffers (cdr buffers))))
current))
(defun grep-a-lot-set-current-buffer (&optional current-buffer)
"Set CURRENT-BUFFER as current search results buffer.
If CURRENT-BUFFER is not specified or is nil, then use current buffer."
(let ((buffers (grep-a-lot-buffers))
(current-buffer (get-buffer (buffer-name current-buffer))))
;; reset is-current flag in all buffers
(while buffers
(let ((buffer (car buffers)))
(with-current-buffer buffer
(set (make-local-variable 'grep-a-lot-is-current-buffer) nil)))
(setq buffers (cdr buffers)))
;; set is-current flag in current-buffer
(with-current-buffer current-buffer
(set (make-local-variable 'grep-a-lot-is-current-buffer) t))))
(defun grep-a-lot-next-buffer (&optional reverse)
"Return next grep-a-lot buffer.
When REVERSE is non-nil, return previous buffer.
If current buffer is last then return first buffer.
Returns nil if there is no grep-a-lot buffer to select."
(let* ((buffers (grep-a-lot-buffers reverse))
(current (grep-a-lot-get-current-buffer buffers))
(head (car buffers))
(next (car (cdr (member current buffers)))))
(and current (or next head))))
(defun grep-a-lot-prev-buffer ()
"Return previous grep-a-lot buffer.
Actually calls `grep-a-lot-next-buffer'."
(grep-a-lot-next-buffer t))
(defun grep-a-lot-buffer-position (name)
"Return position of grep-a-lot buffer named NAME.
Return -1 if NAME is does not match `grep-a-lot-buffer-name-regexp'."
(if (and (stringp name)
(string-match grep-a-lot-buffer-name-regexp name))
(string-to-number (match-string 1 name))
-1))
(defun grep-a-lot-buffer-name (position)
"Return name of grep-a-lot buffer at POSITION."
(concat "*grep*<" (number-to-string position) ">"))
(defun grep-a-lot-buffer-name-function (name)
"Set current grep search results buffer name."
(when (string-match "^i?grep$" name)
(grep-a-lot-buffer-name (1+ (grep-a-lot-buffer-position (buffer-name (grep-a-lot-last-buffer)))))))
(defun grep-a-lot-kill-buffer-hook ()
"Select previous buffer as current, in case current buffer is being killed."
(if (and (grep-a-lot-buffer-p) grep-a-lot-is-current-buffer)
(grep-a-lot-set-current-buffer (grep-a-lot-prev-buffer))))
(defun grep-a-lot-grep-setup-hook ()
"Setup buffer local storage of original buffer context."
;; grep-a-lot-context-initial is supposed to be set already by advised grep functions
(make-local-variable 'grep-a-lot-context-initial)
(set (make-local-variable 'grep-a-lot-context) grep-a-lot-context-initial)
(grep-a-lot-set-current-buffer))
(defun grep-a-lot-next-error-hook ()
"Next error hook function used to maintain the search buffer context."
(let ((position (grep-a-lot-buffer-position (buffer-name next-error-last-buffer))))
(when (>= position 0)
(let ((context (point-marker)))
(with-current-buffer next-error-last-buffer
(set (make-local-variable 'grep-a-lot-context) context)
(grep-a-lot-set-current-buffer))))))
(defun grep-a-lot-restore-context (grep-buffer &optional initial)
"Restore GREP-BUFFER context.
If INITIAL is non nil then use initial context."
(let* ((context (and grep-buffer
(with-current-buffer grep-buffer
(if initial
grep-a-lot-context-initial
grep-a-lot-context)))))
(when grep-buffer
(pop-to-buffer grep-buffer)
(grep-a-lot-set-current-buffer grep-buffer))
(when context
(when initial
(goto-char (point-min))
(setq compilation-current-error nil))
(let* ((buffer (marker-buffer context))
(pos (marker-position context)))
(when buffer
(pop-to-buffer buffer)
(goto-char pos))))))
(defun grep-a-lot-restart-context (&optional grep-buffer)
"Restart buffer and position for the current search results buffer GREP-BUFFER.
If GREP-BUFFER is nil then restart context of current search results buffer."
(interactive)
(let ((grep-buffer (or (grep-a-lot-buffer-p grep-buffer)
(grep-a-lot-get-current-buffer))))
(grep-a-lot-restore-context grep-buffer t)))
(defun grep-a-lot-goto-next ()
"Goto next search results buffer."
(interactive)
(grep-a-lot-restore-context (grep-a-lot-next-buffer)))
(defun grep-a-lot-goto-prev ()
"Goto previous search results buffer."
(interactive)
(grep-a-lot-restore-context (grep-a-lot-prev-buffer)))
(defun grep-a-lot-pop-stack ()
"Switch to previous search results buffer, and kill current buffer."
(interactive)
(let ((buffer (grep-a-lot-last-buffer)))
(when buffer
(grep-a-lot-set-current-buffer buffer)
(grep-a-lot-goto-prev)
(kill-buffer buffer))))
(defun grep-a-lot-clear-stack ()
"Kill all grep search results buffers."
(interactive)
(mapcar 'kill-buffer (grep-a-lot-buffers)))
;;;###autoload
(defmacro grep-a-lot-advise (func)
"Advise a grep-like function FUNC with an around-type advice,
so as to enable multiple search results buffers."
(let ((name (make-symbol (concat "grep-a-lot-" (symbol-name func)))))
`(defadvice ,func (around ,name activate)
"Use multiple search-results buffers."
(let ((grep-a-lot-context-initial (point-marker))
(compilation-buffer-name-function 'grep-a-lot-buffer-name-function))
ad-do-it
ad-return-value))))
;; no need to advise grep-find, because it calls grep
(grep-a-lot-advise grep)
(grep-a-lot-advise lgrep)
(grep-a-lot-advise rgrep)
;; our hooks
(add-hook 'next-error-hook 'grep-a-lot-next-error-hook)
(add-hook 'grep-setup-hook 'grep-a-lot-grep-setup-hook)
(add-hook 'kill-buffer-hook 'grep-a-lot-kill-buffer-hook)
;;;###autoload
(defun grep-a-lot-setup-keys()
"Define some key bindings for navigating multiple
grep search results buffers."
(interactive)
(define-key esc-map "g]" 'grep-a-lot-goto-next)
(define-key esc-map "g[" 'grep-a-lot-goto-prev)
(define-key esc-map "g-" 'grep-a-lot-pop-stack)
(define-key esc-map "g_" 'grep-a-lot-clear-stack)
(define-key esc-map "g=" 'grep-a-lot-restart-context))
(provide 'grep-a-lot)
;;; grep-a-lot.el ends here