grep-a-lot.el

;;; grep-a-lot.el --- manages multiple search results buffers for grep.el

;; Copyright (C) 2008, 2009 Avi Rozen

;; Author: Avi Rozen <avi.rozen@gmail.com>
;; Keywords: tools, convenience, search
;; Version: %Id:%

;; 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
        (save-excursion
          (set-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)))
        (save-excursion
          (set-buffer buffer)
          (set (make-local-variable 'grep-a-lot-is-current-buffer) nil)))
      (setq buffers (cdr buffers)))
    ;; set is-current flag in current-buffer
    (save-excursion
      (set-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)))
        (save-excursion
          (set-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
                       (save-excursion
                         (set-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)))

(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)

(defun grep-a-lot-setup-keys()
  "Define some key bindings for navigating multiple
grep search results buffers."
;  (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)