X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/06626cf2afbfba299ec9e54c5dcd0c1f5a799fae..1a9203d09eb108a7c9d3b79c20783c36e938a634:/lisp/progmodes/grep.el diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c85a3db492..fd4b716ae4 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, 02, 2004 -;; 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,6 +185,7 @@ 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) ;; This is intolerable -- rms ;;; (define-key map [remap next-line] 'compilation-next-error) @@ -194,6 +224,8 @@ 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 @@ -213,12 +245,63 @@ 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]+\\([0-9]+\\)[:) \t]" 1 2)) + ;; rms: I removed the code to match parens around the line number + ;; because it causes confusion and so we will find out if anyone needs it. + ;; It causes confusion with a file name that contains a number in parens. + '(("^\\(.+?\\)[: \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. @@ -233,10 +316,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. @@ -246,14 +331,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) @@ -264,15 +356,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 @@ -318,12 +404,7 @@ Sets `grep-last-buffer' and runs `grep-setup-hook'." 'gnu))) (unless grep-find-command (setq grep-find-command - (cond ((not (executable-command-find-posix-p "find")) - (message - (concat "compile.el: Posix-style find(1) not found. " - "Please set `grep-find-command'.")) - nil) - ((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 @@ -343,15 +424,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. @@ -373,13 +465,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. @@ -407,33 +499,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) @@ -535,12 +613,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 +;; arch-tag: 5a5b9169-a79d-4f38-9c38-f69615f39c4d ;;; grep.el ends here