X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/318e2976570e4d2fd6859ff99946ab66fdd5944e..7c511b96e0cc692a4b772fe34ed7470b4020c20e:/lisp/progmodes/grep.el diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 2793280687..7a13ddba6e 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1,7 +1,7 @@ ;;; grep.el --- run compiler as inferior of Emacs, parse error messages -;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2001, 2002, 2004 Free Software Foundation, Inc. ;; Author: Roland McGrath ;; Maintainer: FSF @@ -64,6 +64,26 @@ will be parsed and highlighted as soon as you try to move to them." :version "21.4" :group 'grep) +(defcustom grep-highlight-matches 'auto-detect + "If t, use special markers to highlight grep matches. + +Some grep programs are able to surround matches with special +markers in grep output. Such markers can be used to highlight +matches in grep mode. + +This option sets the environment variable GREP_COLOR to specify +markers for highlighting and GREP_OPTIONS to add the --color +option in front of any explicit grep options before starting +the grep. + +The default value of this variable is set up by `grep-compute-defaults'; +call that function before using this variable in your program." + :type '(choice (const :tag "Do not highlight matches with grep markers" nil) + (const :tag "Highlight matches with grep markers" t) + (other :tag "Not Set" auto-detect)) + :version "21.4" + :group 'grep) + (defcustom grep-scroll-output nil "*Non-nil to scroll the *grep* buffer window as output appears. @@ -74,6 +94,7 @@ than the begining." :version "21.4" :group 'grep) +;;;###autoload (defcustom grep-command nil "The default grep command for \\[grep]. If the grep program used supports an option to always include file names @@ -94,12 +115,12 @@ necessary if the grep program used supports the `-H' option. The default value of this variable is set up by `grep-compute-defaults'; call that function before using this variable in your program." - :type 'boolean :type '(choice (const :tag "Do Not Append Null Device" nil) (const :tag "Append Null Device" t) (other :tag "Not Set" auto-detect)) :group 'grep) +;;;###autoload (defcustom grep-find-command nil "The default find command for \\[grep-find]. The default value of this variable is set up by `grep-compute-defaults'; @@ -146,6 +167,14 @@ The following place holders should be present in the string: :type 'boolean :group 'grep) +(defcustom grep-error-screen-columns nil + "*If non-nil, column numbers in grep hits are screen columns. +See `compilation-error-screen-columns'" + :type '(choice (const :tag "Default" nil) + integer) + :version "21.4" + :group 'grep) + ;;;###autoload (defcustom grep-setup-hook nil "List of hook functions run by `grep-process-setup' (see `run-hooks')." @@ -156,9 +185,11 @@ The following place holders should be present in the string: (let ((map (cons 'keymap compilation-minor-mode-map))) (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) + (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [remap next-line] 'compilation-next-error) - (define-key map [remap previous-line] 'compilation-previous-error) + ;; This is intolerable -- rms +;;; (define-key map [remap next-line] 'compilation-next-error) +;;; (define-key map [remap previous-line] 'compilation-previous-error) (define-key map "\r" 'compile-goto-error) ;; ? (define-key map "n" 'next-error-no-select) @@ -193,16 +224,18 @@ The following place holders should be present in the string: "Keymap for grep buffers. `compilation-minor-mode-map' is a cdr of this.") +(defalias 'kill-grep 'kill-compilation) + ;;;; TODO --- refine this!! -(defcustom grep-use-compilation-buffer t - "When non-nil, grep specific commands update `compilation-last-buffer'. -This means that standard compile commands like \\[next-error] and \\[compile-goto-error] -can be used to navigate between grep matches (the default). -Otherwise, the grep specific commands like \\[grep-next-match] must -be used to navigate between grep matches." - :type 'boolean - :group 'grep) +;;; (defcustom grep-use-compilation-buffer t +;;; "When non-nil, grep specific commands update `compilation-last-buffer'. +;;; This means that standard compile commands like \\[next-error] and \\[compile-goto-error] +;;; can be used to navigate between grep matches (the default). +;;; Otherwise, the grep specific commands like \\[grep-next-match] must +;;; be used to navigate between grep matches." +;;; :type 'boolean +;;; :group 'grep) ;; override compilation-last-buffer (defvar grep-last-buffer nil @@ -212,12 +245,60 @@ or when it is used with \\[grep-next-match]. Notice that using \\[next-error] or \\[compile-goto-error] modifies `complation-last-buffer' rather than `grep-last-buffer'.") -;; Note: the character class after the optional drive letter does not -;; include a space to support file names with blanks. +;;;###autoload (defvar grep-regexp-alist - '(("\\([a-zA-Z]?:?[^:(\t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) + '(("^\\(.+?\\)[:( \t]+\ +\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ +\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) + ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + 1 2 + ;; Calculate column positions (beg . end) of first grep match on a line + ((lambda () + (setq compilation-error-screen-columns nil) + (- (match-beginning 5) (match-end 3) 8)) + . + (lambda () (- (match-end 5) (match-end 3) 8)))) + ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") +(defvar grep-error "grep hit" + "Message to print when no matches are found.") + +;; Reverse the colors because grep hits are not errors (though we jump there +;; with `next-error'), and unreadable files can't be gone to. +(defvar grep-hit-face compilation-info-face + "Face name to use for grep hits.") + +(defvar grep-error-face compilation-error-face + "Face name to use for grep error messages.") + +(defvar grep-mode-font-lock-keywords + '(;; Command output lines. + ("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face) + (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" + 1 grep-error-face) + ;; remove match from grep-regexp-alist before fontifying + ("^Grep finished \\(?:(\\(matches found\\))\\|with \\(no matches found\\)\\).*" + (0 '(face nil message nil help-echo nil mouse-face nil) t) + (1 grep-hit-face nil t) + (2 grep-error-face nil t)) + ("^Grep \\(exited abnormally\\) with code \\([0-9]+\\).*" + (0 '(face nil message nil help-echo nil mouse-face nil) t) + (1 compilation-warning-face) + (2 compilation-line-face)) + ;; Highlight grep matches and delete markers + ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + (2 compilation-column-face) + ((lambda (p)) + (progn + ;; Delete markers with `replace-match' because it updates + ;; the match-data, whereas `delete-region' would render it obsolete. + (replace-match "" t t nil 3) + (replace-match "" t t nil 1))))) + "Additional things to highlight in grep output. +This gets tacked on the end of the generated expressions.") + +;;;###autoload (defvar grep-program ;; Currently zgrep has trouble. It runs egrep instead of grep, ;; and it doesn't pass along long options right. @@ -232,10 +313,12 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies "The default grep program for `grep-command' and `grep-find-command'. This variable's value takes effect when `grep-compute-defaults' is called.") +;;;###autoload (defvar find-program "find" "The default find program for `grep-find-command'. This variable's value takes effect when `grep-compute-defaults' is called.") +;;;###autoload (defvar grep-find-use-xargs nil "Whether \\[grep-find] uses the `xargs' utility by default. @@ -245,14 +328,21 @@ if not nil and not `gnu', it uses `find -print' and `xargs'. This variable's value takes effect when `grep-compute-defaults' is called.") ;; History of grep commands. +;;;###autoload (defvar grep-history nil) +;;;###autoload (defvar grep-find-history nil) +;;;###autoload (defun grep-process-setup () "Setup compilation variables and buffer for `grep'. -Set up `compilation-exit-message-function' and `compilation-window-height'. -Sets `grep-last-buffer' and runs `grep-setup-hook'." - (setq grep-last-buffer (current-buffer)) +Set up `compilation-exit-message-function' and run `grep-setup-hook'." + (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) + (grep-compute-defaults)) + (when (eq grep-highlight-matches t) + ;; Modify `process-environment' locally bound in `compilation-start' + (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always")) + (setenv "GREP_COLOR" "01;41")) (set (make-local-variable 'compilation-exit-message-function) (lambda (status code msg) (if (eq status 'exit) @@ -263,15 +353,9 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'." (t (cons msg code))) (cons msg code)))) - (if grep-window-height - (set (make-local-variable 'compilation-window-height) - grep-window-height)) - (set (make-local-variable 'compile-auto-highlight) - grep-auto-highlight) - (set (make-local-variable 'compilation-scroll-output) - grep-scroll-output) (run-hooks 'grep-setup-hook)) +;;;###autoload (defun grep-compute-defaults () (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) (setq grep-use-null-device @@ -317,7 +401,7 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'." 'gnu))) (unless grep-find-command (setq grep-find-command - (cond ((eq grep-find-use-xargs 'gnu) + (cond ((eq grep-find-use-xargs 'gnu) (format "%s . -type f -print0 | xargs -0 -e %s" find-program grep-command)) (grep-find-use-xargs @@ -337,15 +421,26 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'." (format "%s -type f -print | xargs %s " find-program gcmd)) (t (format "%s -type f -exec %s {} %s \\;" - find-program gcmd null-device))))))) + find-program gcmd null-device)))))) + (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) + (setq grep-highlight-matches + (with-temp-buffer + (and (equal (condition-case nil + (call-process grep-program nil t nil "--help") + (error nil)) + 0) + (progn + (goto-char (point-min)) + (search-forward "--color" nil t)) + t))))) (defun grep-default-command () (let ((tag-default - (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - ;; We use grep-tag-default instead of - ;; find-tag-default, to avoid loading etags. - 'grep-tag-default))) + (shell-quote-argument + (or (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + ""))) (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; Replace the thing matching for with that around cursor. @@ -367,13 +462,13 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'." 0 (match-beginning 2)) " *." (file-name-extension buffer-file-name)))) - (replace-match (or tag-default "") t t grep-default 1)))) + (replace-match tag-default t t grep-default 1)))) ;;;###autoload (defun grep (command-args &optional highlight-regexp) "Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use \\[next-error] (M-x next-error), -or \\\\[compile-goto-error] in the grep \ +or \\\\[compile-goto-error] in the grep \ output buffer, to go to the lines where grep found matches. @@ -401,33 +496,19 @@ temporarily highlight in visited source lines." ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. - (let* ((compilation-process-setup-function 'grep-process-setup) - (buf (compile-internal (if (and grep-use-null-device null-device) - (concat command-args " " null-device) - command-args) - "No more grep hits" "grep" - ;; Give it a simpler regexp to match. - nil grep-regexp-alist - nil nil nil nil nil nil - highlight-regexp grep-mode-map))))) - -;; This is a copy of find-tag-default from etags.el. -(defun grep-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (when (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (goto-char (match-end 0)) - (buffer-substring (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))))) + (let ((compilation-process-setup-function 'grep-process-setup)) + (compilation-start (if (and grep-use-null-device null-device) + (concat command-args " " null-device) + command-args) + 'grep-mode nil highlight-regexp))) + +(define-compilation-mode grep-mode "Grep" + "Sets `grep-last-buffer' and `compilation-window-height'." + (setq grep-last-buffer (current-buffer)) + (set (make-local-variable 'compilation-error-face) + grep-hit-face) + (set (make-local-variable 'compilation-error-regexp-alist) + grep-regexp-alist)) ;;;###autoload (defun grep-find (command-args) @@ -442,11 +523,17 @@ easily repeat a find command." (progn (unless grep-find-command (grep-compute-defaults)) - (list (read-from-minibuffer "Run find (like this): " - grep-find-command nil nil - 'grep-find-history)))) - (let ((null-device nil)) ; see grep - (grep command-args))) + (if grep-find-command + (list (read-from-minibuffer "Run find (like this): " + grep-find-command nil nil + 'grep-find-history)) + ;; No default was set + (read-string + "compile.el: No `grep-find-command' command available. Press RET.") + (list nil)))) + (when (and grep-find-command command-args) + (let ((null-device nil)) ; see grep + (grep command-args)))) (defun grep-expand-command-macros (command &optional regexp files dir excl case-fold) "Patch grep COMMAND replacing , etc." @@ -523,12 +610,12 @@ those sub directories of DIR." nil) ;; we change default-directory to dir (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") grep-tree-ignore-case)) - (default-directory dir) + (default-directory (file-name-as-directory (expand-file-name dir))) (null-device nil)) ; see grep (grep command-args regexp))) (provide 'grep) +;; arch-tag: 5a5b9169-a79d-4f38-9c38-f69615f39c4d ;;; grep.el ends here -