Mercurial > hg > xemacs-beta
diff lisp/efs/dired-grep.el @ 22:8fc7fe29b841 r19-15b94
Import from CVS: tag r19-15b94
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:29 +0200 |
parents | |
children | 7e54bd776075 9f59509498e1 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/efs/dired-grep.el Mon Aug 13 08:50:29 2007 +0200 @@ -0,0 +1,482 @@ +;; -*-Emacs-Lisp-*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; File: dired-grep.el +;; RCS: +;; Dired Version: $Revision: 1.1 $ +;; Description: Support for running grep on marked files in a dired buffer. +;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> +;; Created: Tue Jul 13 22:59:37 1993 by sandy on ibm550 +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Copyright (C) 1993 Sandy Rutherford + +;;; 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. +;;; +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to sandy@ibm550.sissa.it) or +;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +;;; MA 02139, USA. + +;;; The user-level command in this file is dired-grep-file. The command +;;; grep is defined in compile.el. This file does not change that command. + +;;; Requirements and provisions + +(provide 'dired-grep) +(or (fboundp 'file-local-copy) (require 'emacs-19)) +(or (fboundp 'generate-new-buffer) (require 'emacs-19)) +(require 'dired) + +;;; Variables + +(defvar dired-grep-program "grep" + "Name of program to use to grep files. +When used with the \"-n\" flag, program must precede each match with \"###:\", +where \"###\" is the line number of the match. +If there are grep programs which don't do this, we'll try to think of +some way to accomodate them.") + +(defvar dired-grep-switches nil + "*Switches to pass to the grep program. +This may be either a string or a list of strings. It is not necessary to +include \"-n\" as that switch is always used.") + +(defvar dired-grep-zcat-program "zcat" + "Name of program to cat compressed files.") + +(defvar dired-grep-compressed-file ".\\.\\(gz\\|[zZ]\\)$" + "Regexp to match names of compressed files.") + +(defvar dired-grep-pop-up-buffer t + "*If non-nil, the grep output is displayed in the other window upon +completion of the grep process.") + +(defvar dired-grep-results-buffer "*Dired Grep*" + "Name of buffer where grep results are logged.") + +(defvar dired-grep-mode-hook nil + "Hook run after going into grep-mode") + +(defvar grep-history nil + "History of previous grep patterns used.") + +(defvar dired-grep-parse-flags-cache nil) +(defvar dired-grep-parse-flags-cache-result nil) + +(defvar dired-grep-mode-map nil + "Keymap for dired-grep-mode buffers.") + +(if dired-grep-mode-map + () + (setq dired-grep-mode-map (make-keymap)) + (suppress-keymap dired-grep-mode-map) + (define-key dired-grep-mode-map "[" 'backward-page) + (define-key dired-grep-mode-map "]" 'forward-page) + (define-key dired-grep-mode-map ">" 'dired-grep-next-hit) + (define-key dired-grep-mode-map "<" 'dired-grep-previous-hit) + (define-key dired-grep-mode-map "n" 'dired-grep-advertized-next-hit) + (define-key dired-grep-mode-map "p" 'dired-grep-advertized-previous-hit) + (define-key dired-grep-mode-map "k" 'dired-grep-delete-line) + (define-key dired-grep-mode-map "d" 'dired-grep-delete-page) + (define-key dired-grep-mode-map "^" 'dired-grep-delete-preceding-pages) + (define-key dired-grep-mode-map "f" 'dired-grep-find-file) + (define-key dired-grep-mode-map "e" 'dired-grep-find-file) + (define-key dired-grep-mode-map "m" 'dired-grep-delete-misses) + (define-key dired-grep-mode-map "o" 'dired-grep-find-file-other-window) + (define-key dired-grep-mode-map "v" 'dired-grep-view-file) + (define-key dired-grep-mode-map "w" 'dired-grep-delete-grep-for) + (define-key dired-grep-mode-map "\C-_" 'dired-grep-undo) + (define-key dired-grep-mode-map "\C-xu" 'dired-grep-undo)) + +;;; Entry functions from dired.el + +(defun dired-grep (pattern flags) + ;; grep the file on the current line for PATTERN, using grep flags FLAGS. + ;; Return nil on success. Offending filename otherwise. + (let* ((file (dired-get-filename)) + (result (dired-grep-file pattern file flags))) + (and result + (progn + (dired-log (buffer-name (current-buffer)) (concat result "\n")) + file)))) + +(defun dired-do-grep (pattern &optional flags arg) + "Grep marked files for a pattern. With a \C-u prefix prompts for grep flags." + (interactive + (let* ((switches (if (consp current-prefix-arg) + (read-string "Switches for grep: ") + dired-grep-switches)) + (prompt (format "grep %sfor pattern" + (if (stringp switches) + (if (string-equal switches "") + switches + (concat switches " ")) + (if switches + (concat (mapconcat 'identity switches " ") " ") + "")))) + (pattern (dired-read-with-history (concat prompt ": ") + nil 'grep-history))) + (list pattern switches + (and (not (consp current-prefix-arg)) current-prefix-arg)))) + (dired-map-over-marks-check + (function + (lambda () + (dired-grep pattern flags))) + arg 'grep (concat "grep " flags (if flags " \"" "\"") pattern "\"") t)) + +;;; Utility functions + +(defun dired-grep-get-results-buffer () + ;; Return the buffer object of the dired-grep-results-buffer, creating and + ;; initializing it if necessary. + (let ((buffer (get-buffer dired-grep-results-buffer))) + (or buffer + (save-excursion + (set-buffer (setq buffer (get-buffer-create dired-grep-results-buffer))) + (dired-grep-mode) + buffer)))) + +;; Only define if undefined, in case efs has got to it already. +(or (fboundp 'dired-grep-delete-local-temp-file) + (defun dired-grep-delete-local-temp-file (file) + (condition-case nil (delete-file file) (error nil)))) + +;;; Commands in the dired-grep-results-buffer buffer. + +(defun dired-grep-mode () + "\\<dired-grep-mode-map>Mode for perusing grep output generated from dired. +The output is divided into pages, one page per grepped file. + +Summary of commands: + +Move to next grep hit \\[dired-grep-advertized-next-hit], \\[dired-grep-next-hit] +Move to previous grep hit \\[dired-grep-advertized-previous-hit], \\[dired-grep-previous-hit] +Move to output for next file \\[forward-page] +Move to output for previous file \\[backward-page] + +Delete the current grep line \\[dired-grep-delete-line] +Delete all output for current file \\[dired-grep-delete-page] +Delete all preceding pages \\[dired-grep-delete-preceding-pages] +Delete all pages for files with no hits \\[dired-grep-delete-misses] +Delete all pages which grep for the + same pattern as the current page \\[dired-grep-delete-grep-for] + +Find current grep hit in file \\[dired-grep-find-file] +Find current grep hit in other window \\[dired-grep-find-file-other-window] +View current grep hit \\[dired-grep-view-file] + +Undo changes to the grep buffer \\[dired-grep-undo] + +Keybindings: +\\{dired-grep-mode-map}" + (kill-all-local-variables) + (use-local-map dired-grep-mode-map) + (setq major-mode 'dired-grep-mode + mode-name "Dired-Grep" + buffer-read-only t) + (set (make-local-variable 'page-delimiter) "\n\n") + (run-hooks 'dired-grep-mode-hook)) + +(defun dired-grep-current-file-and-line () + ;; Returns a list \(FILENAME . LINE\) corresponding to the filename + ;; and line number associated with the position of the point in a + ;; grep buffer. Returns nil if there is none. + (save-excursion + (let (file line) + (and + (progn + (beginning-of-line) + (looking-at "[0-9]+:")) + (progn + (setq line (string-to-int (buffer-substring (point) + (1- (match-end 0))))) + (if (search-backward "\n\n" nil 'move) (forward-char 2)) + (looking-at "Hits for ")) + (progn + (forward-line 1) + (looking-at " ")) + (progn + (setq file (buffer-substring (match-end 0) + (progn (end-of-line) (1- (point))))) + (cons file line)))))) + +(defun dired-grep-find-file () + (interactive) + (let ((file (dired-grep-current-file-and-line))) + (if file + (progn + (find-file (car file)) + (goto-line (cdr file)) + (recenter '(4))) + (error "No file specified by this line.")))) + +(defun dired-grep-find-file-other-window () + (interactive) + (let ((file (dired-grep-current-file-and-line))) + (if file + (progn + (find-file-other-window (car file)) + (goto-line (cdr file)) + (recenter '(4))) + (error "No file specified by this line.")))) + +(defun dired-grep-view-file () + (interactive) + (let ((file (dired-grep-current-file-and-line))) + (if file + (let* ((fun (function + (lambda () (goto-line (cdr file)) (recenter '(4))))) + (view-hook + (if (boundp 'view-hook) + (if (and (listp view-hook) + (not (eq (car view-hook) 'lambda))) + (cons fun view-hook) + (list fun view-hook)) + fun))) + (view-file (car file))) + (error "No file specified by this line.")))) + +(defun dired-grep-next-hit (arg) + "Moves to the next, or next ARGth, grep hit." + (interactive "p") + (forward-line 1) + (if (re-search-forward "^[0-9]" nil 'move arg) + (goto-char (match-beginning 0)) + (error "No further grep hits"))) + +(defun dired-grep-previous-hit (arg) + "Moves to the previous, or previous ARGth, grep hit." + (interactive "p") + (beginning-of-line) + (or (re-search-backward "^[0-9]" nil 'move arg) + (error "No further grep hits"))) + +;; These are only so we can get a decent looking help buffer. +(fset 'dired-grep-advertized-next-hit 'dired-grep-next-hit) +(fset 'dired-grep-advertized-previous-hit 'dired-grep-previous-hit) + +(defun dired-grep-delete-page (arg) + "Deletes the current and ARG - 1 following grep output pages. +If ARG is negative, deletes preceding pages." + (interactive "p") + (let ((done 0) + (buffer-read-only nil) + (backward (< arg 0)) + start) + (if backward (setq arg (- arg))) + (while (and (< done arg) (not (if backward (bobp) (eobp)))) + (or (looking-at "^\n") + (if (search-backward "\n\n" nil 'move) (forward-char 1))) + (setq start (point)) + (if (search-forward "\n\n" nil 'move) (forward-char -1)) + (delete-region start (point)) + (and (bobp) (not (eobp)) (delete-char 1)) + (if backward (skip-chars-backward "\n")) + (setq done (1+ done))))) + +(defun dired-grep-delete-preceding-pages () + "Deletes the current, and all preceding pages from the grep buffer." + (interactive) + (let ((buffer-read-only nil)) + (if (looking-at "^\n") + (forward-char 1) + (search-forward "\n\n" nil 'move)) + (delete-region (point-min) (point)))) + +(defun dired-grep-delete-line (arg) + "Deletes the current line and ARG following lines from the grep buffer. +Only operates on lines which correspond to file lines for grep hits." + (interactive "p") + (let ((opoint (point)) + (buffer-read-only nil) + (backward (< arg 0)) + (done 0)) + (beginning-of-line) + (if backward (setq arg (- arg))) + (if (looking-at "[0-9]+:") + (while (< done arg) + (delete-region (point) (progn (forward-line 1) (point))) + (if backward (forward-line -1)) + (if (looking-at "[0-9]+:") + (setq done (1+ done)) + (setq done arg))) + ;; Do nothing. + (goto-char opoint)))) + +(defun dired-grep-delete-grep-for () + "Deletes all pages which grep some file for the pattern of the current page." + (interactive) + (save-excursion + ;; In case we happen to be right at the beginning of a page. + (or (eobp) (eolp) (forward-char 1)) + (forward-page -1) ; gets to the beginning of the page. + (let* ((eol (save-excursion (end-of-line) (point))) + (line (and (search-forward " grep " eol t) + (buffer-substring (point) eol)))) + (if line + (progn + (goto-char (point-min)) + (while (not (eobp)) + (let* ((eol (save-excursion (end-of-line) (point))) + (this-line (and (search-forward " grep " eol t) + (buffer-substring (point) eol)))) + (if (equal line this-line) + (progn + (dired-grep-delete-page 1) + (skip-chars-forward "\n")) + (or (eobp) (forward-page 1)))))))))) + +(defun dired-grep-delete-misses () + "Delete all pages for which there were no grep hits. +Deletes pages for which grep failed because of an error too." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "Grep failed \\|No hits ") + (progn + (dired-grep-delete-page 1) + (skip-chars-forward "\n")) + (forward-page 1))))) + +(defun dired-grep-undo () + "Undoes deletions in a grep buffer." + (interactive) + (let (buffer-read-only) + (undo))) + +;;; Commands for grepping files. + +(defun dired-grep-parse-flags (string) + ;; Breaks a string of switches into a list. + (if (equal dired-grep-parse-flags-cache string) + dired-grep-parse-flags-cache-result + (let ((length (length string)) + (pointer 0) + (start 0) + (result nil)) + (while (and (< pointer length) (= (aref string pointer) ?\ )) + (setq pointer (1+ pointer))) + (while (< pointer length) + (setq start pointer) + (while (and (< pointer length) (/= (aref string pointer) ?\ )) + (setq pointer (1+ pointer))) + (setq result (cons (substring string start pointer) result)) + (while (and (< pointer length) (= (aref string pointer) ?\ )) + (setq pointer (1+ pointer)))) + (setq dired-grep-parse-flags-cache string + dired-grep-parse-flags-cache-result (nreverse result))))) + +(defun dired-grep-file (pattern file &optional flags) + "Grep for PATTERN in FILE. +Optional FLAGS are flags to pass to the grep program. +When used interactively, will prompt for FLAGS if a prefix argument is used." + (interactive + (let* ((switches (if (consp current-prefix-arg) + (read-string "Switches for grep: ") + dired-grep-switches)) + (prompt (format "grep %sfor pattern" + (if (stringp switches) + (if (string-match switches "^ *$") + "" + (concat switches " ")) + (if switches + (concat (mapconcat 'identity switches " ") " ") + "")))) + (pattern (dired-read-with-history (concat prompt ": ") + nil 'grep-history)) + (file (read-file-name (concat prompt " \"" pattern "\" in file :")))) + (list pattern file switches))) + (setq file (expand-file-name file)) + (if (listp flags) + (setq flags (mapconcat 'identity flags " ")) + (if (string-match "^ +$" flags) + (setq flags ""))) + (let ((file-buff (get-file-buffer file))) + (if (and file-buff (buffer-modified-p file-buff)) + (if (y-or-n-p (format "Save buffer %s? " (buffer-name file-buff))) + (save-excursion + (set-buffer file-buff) + (save-buffer))))) + (let ((buffer (dired-grep-get-results-buffer)) + (compressed (string-match dired-grep-compressed-file file)) + failed temp-file jka-compr-compression-info-list) + (setq temp-file + (condition-case err + (file-local-copy file) + (error (progn (setq failed (format "%s" err)) nil)))) + (or failed + (save-excursion + (set-buffer buffer) + (goto-char (point-max)) + (let ((buffer-read-only nil) + pos-1 pos-2) + (or (bobp) (insert "\n")) + (setq pos-1 (point)) + (insert "Hits for grep ") + (or (string-equal flags "") (insert flags " ")) + (insert "\"" pattern "\" in\n " file ":\n") + (setq pos-2 (point)) + (condition-case err + (apply + 'call-process + (if compressed "sh" dired-grep-program) + (or temp-file file) + buffer t + (if compressed + (list "-c" (concat dired-grep-zcat-program + " |" dired-grep-program + " " flags " -n '" pattern "'")) + (append (dired-grep-parse-flags flags) + (list "-n" pattern)))) + (error (setq failed (format "%s" err)))) + (if failed + (progn + (if (= pos-2 (point-max)) + (progn + (goto-char (1- pos-2)) + (delete-char -1) + (insert "."))) + (goto-char pos-1) + (delete-char 4) + (insert "Grep failed") + failed) + (if (= pos-2 (point-max)) + (progn + (goto-char pos-1) + (delete-char 1) + (insert "No h") + (forward-line 1) + (end-of-line) + (delete-char -1) + (insert ".")) + (goto-char pos-2) + (or (looking-at "[0-9]+:") + (setq failed (buffer-substring pos-2 + (progn (end-of-line) + (point)))))))))) + (let ((curr-wind (selected-window))) + (unwind-protect + (progn + (pop-to-buffer buffer) + (goto-char (point-max))) + (select-window curr-wind))) + (if temp-file + (dired-grep-delete-local-temp-file temp-file)) + failed)) + +;;; Run the load hook + +(run-hooks 'dired-grep-load-hook) + +;;; end of dired-grep.el