66 |
(integer :tag "First N lines")) |
(integer :tag "First N lines")) |
67 |
:group 'compilation) |
:group 'compilation) |
68 |
|
|
|
;;; This has to be here so it can be called |
|
|
;;; by the following defcustoms. |
|
|
(defun grep-compute-defaults () |
|
|
(unless (or (not grep-use-null-device) (eq grep-use-null-device t)) |
|
|
(setq grep-use-null-device |
|
|
(with-temp-buffer |
|
|
(let ((hello-file (expand-file-name "HELLO" data-directory))) |
|
|
(not |
|
|
(and (equal (condition-case nil |
|
|
(if grep-command |
|
|
;; `grep-command' is already set, so |
|
|
;; use that for testing. |
|
|
(call-process-shell-command |
|
|
grep-command nil t nil |
|
|
"^English" hello-file) |
|
|
;; otherwise use `grep-program' |
|
|
(call-process grep-program nil t nil |
|
|
"-nH" "^English" hello-file)) |
|
|
(error nil)) |
|
|
0) |
|
|
(progn |
|
|
(goto-char (point-min)) |
|
|
(looking-at |
|
|
(concat (regexp-quote hello-file) |
|
|
":[0-9]+:English"))))))))) |
|
|
(unless grep-command |
|
|
(setq grep-command |
|
|
(let ((required-options (if grep-use-null-device "-n" "-nH"))) |
|
|
(if (equal (condition-case nil ; in case "grep" isn't in exec-path |
|
|
(call-process grep-program nil nil nil |
|
|
"-e" "foo" null-device) |
|
|
(error nil)) |
|
|
1) |
|
|
(format "%s %s -e " grep-program required-options) |
|
|
(format "%s %s " grep-program required-options))))) |
|
|
(unless grep-find-use-xargs |
|
|
(setq grep-find-use-xargs |
|
|
(if (and |
|
|
(equal (call-process "find" nil nil nil |
|
|
null-device "-print0") |
|
|
0) |
|
|
(equal (call-process "xargs" nil nil nil |
|
|
"-0" "-e" "echo") |
|
|
0)) |
|
|
'gnu))) |
|
|
(unless grep-find-command |
|
|
(setq grep-find-command |
|
|
(cond ((eq grep-find-use-xargs 'gnu) |
|
|
(format "%s . -type f -print0 | xargs -0 -e %s" |
|
|
find-program grep-command)) |
|
|
(grep-find-use-xargs |
|
|
(format "%s . -type f -print | xargs %s" |
|
|
find-program grep-command)) |
|
|
(t (cons (format "%s . -type f -exec %s {} %s \\;" |
|
|
find-program grep-command null-device) |
|
|
(+ 22 (length grep-command))))))) |
|
|
(unless grep-tree-command |
|
|
(setq grep-tree-command |
|
|
(let* ((glen (length grep-program)) |
|
|
(gcmd (concat grep-program " <C>" (substring grep-command glen)))) |
|
|
(cond ((eq grep-find-use-xargs 'gnu) |
|
|
(format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>" |
|
|
find-program gcmd)) |
|
|
(grep-find-use-xargs |
|
|
(format "%s <D> <X> -type f <F> -print | xargs %s <R>" |
|
|
find-program gcmd)) |
|
|
(t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" |
|
|
find-program gcmd null-device))))))) |
|
|
|
|
69 |
(defcustom grep-command nil |
(defcustom grep-command nil |
70 |
"The default grep command for \\[grep]. |
"The default grep command for \\[grep]. |
71 |
If the grep program used supports an option to always include file names |
If the grep program used supports an option to always include file names |
74 |
|
|
75 |
The default value of this variable is set up by `grep-compute-defaults'; |
The default value of this variable is set up by `grep-compute-defaults'; |
76 |
call that function before using this variable in your program." |
call that function before using this variable in your program." |
77 |
:type 'string |
:type '(choice string |
78 |
:get '(lambda (symbol) |
(const :tag "Not Set" nil)) |
|
(or grep-command |
|
|
(progn (grep-compute-defaults) grep-command))) |
|
79 |
:group 'compilation) |
:group 'compilation) |
80 |
|
|
81 |
(defcustom grep-use-null-device 'auto-detect |
(defcustom grep-use-null-device 'auto-detect |
82 |
"If non-nil, append the value of `null-device' to grep commands. |
"If t, append the value of `null-device' to `grep' commands. |
83 |
This is done to ensure that the output of grep includes the filename of |
This is done to ensure that the output of grep includes the filename of |
84 |
any match in the case where only a single file is searched, and is not |
any match in the case where only a single file is searched, and is not |
85 |
necessary if the grep program used supports the `-H' option. |
necessary if the grep program used supports the `-H' option. |
87 |
The default value of this variable is set up by `grep-compute-defaults'; |
The default value of this variable is set up by `grep-compute-defaults'; |
88 |
call that function before using this variable in your program." |
call that function before using this variable in your program." |
89 |
:type 'boolean |
:type 'boolean |
90 |
:get '(lambda (symbol) |
:type '(choice (const :tag "Do Not Append Null Device" nil) |
91 |
(if (and grep-use-null-device (not (eq grep-use-null-device t))) |
(const :tag "Append Null Device" t) |
92 |
(progn (grep-compute-defaults) grep-use-null-device) |
(other :tag "Not Set" auto-detect)) |
|
grep-use-null-device)) |
|
93 |
:group 'compilation) |
:group 'compilation) |
94 |
|
|
95 |
(defcustom grep-find-command nil |
(defcustom grep-find-command nil |
96 |
"The default find command for \\[grep-find]. |
"The default find command for \\[grep-find]. |
97 |
The default value of this variable is set up by `grep-compute-defaults'; |
The default value of this variable is set up by `grep-compute-defaults'; |
98 |
call that function before using this variable in your program." |
call that function before using this variable in your program." |
99 |
:type 'string |
:type '(choice string |
100 |
:get (lambda (symbol) |
(const :tag "Not Set" nil)) |
|
(or grep-find-command |
|
|
(progn (grep-compute-defaults) grep-find-command))) |
|
101 |
:group 'compilation) |
:group 'compilation) |
102 |
|
|
103 |
(defcustom grep-tree-command nil |
(defcustom grep-tree-command nil |
110 |
<F> - find options to limit the files matched |
<F> - find options to limit the files matched |
111 |
<C> - place to put -i if case insensitive grep |
<C> - place to put -i if case insensitive grep |
112 |
<R> - the regular expression searched for." |
<R> - the regular expression searched for." |
113 |
:type 'string |
:type '(choice string |
114 |
|
(const :tag "Not Set" nil)) |
115 |
:version "21.4" |
:version "21.4" |
|
:get (lambda (symbol) |
|
|
(or grep-tree-command |
|
|
(progn (grep-compute-defaults) grep-tree-command))) |
|
116 |
:group 'compilation) |
:group 'compilation) |
117 |
|
|
118 |
(defcustom grep-tree-files-aliases '( |
(defcustom grep-tree-files-aliases '( |
249 |
;; GNU utilities with precise locations (line and columns), |
;; GNU utilities with precise locations (line and columns), |
250 |
;; possibly ranges: |
;; possibly ranges: |
251 |
;; foo.c:8.23-9.1: error message |
;; foo.c:8.23-9.1: error message |
252 |
("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)\ |
("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ |
253 |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
254 |
-\\([0-9]+\\)\\.\\([0-9]+\\)\ |
-\\([0-9]+\\)\\.\\([0-9]+\\)\ |
255 |
:" 1 2 3) ;; When ending points are supported, add line = 4 and col = 5. |
:" 1 2 3) ;; When ending points are supported, add line = 4 and col = 5. |
256 |
;; foo.c:8.23-45: error message |
;; foo.c:8.23-45: error message |
257 |
("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)\ |
("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ |
258 |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
259 |
-\\([0-9]+\\)\ |
-\\([0-9]+\\)\ |
260 |
:" 1 2 3) ;; When ending points are supported, add line = 2 and col = 4. |
:" 1 2 3) ;; When ending points are supported, add line = 2 and col = 4. |
261 |
;; foo.c:8-45.3: error message |
;; foo.c:8-45.3: error message |
262 |
("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)\ |
("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ |
263 |
\\([0-9]+\\)\ |
\\([0-9]+\\)\ |
264 |
-\\([0-9]+\\)\\.\\([0-9]+\\)\ |
-\\([0-9]+\\)\\.\\([0-9]+\\)\ |
265 |
:" 1 2 nil) ;; When ending points are supported, add line = 2 and col = 4. |
:" 1 2 nil) ;; When ending points are supported, add line = 2 and col = 4. |
266 |
;; foo.c:8.23: error message |
;; foo.c:8.23: error message |
267 |
("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)\ |
("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ |
268 |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
\\([0-9]+\\)\\.\\([0-9]+\\)\ |
269 |
:" 1 2 3) |
:" 1 2 3) |
270 |
;; foo.c:8-23: error message |
;; foo.c:8-23: error message |
271 |
("\\([a-zA-Z][-a-zA-Z._0-9]+: ?\\)\ |
("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\ |
272 |
\\([0-9]+\\)\ |
\\([0-9]+\\)\ |
273 |
-\\([0-9]+\\)\ |
-\\([0-9]+\\)\ |
274 |
:" 1 2 nil);; When ending points are supported, add line = 3. |
:" 1 2 nil);; When ending points are supported, add line = 3. |
294 |
\\([a-zA-Z]?:?[^:( \t\n]+\\)\ |
\\([a-zA-Z]?:?[^:( \t\n]+\\)\ |
295 |
\\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5) |
\\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5) |
296 |
|
|
297 |
|
;; Valgrind (memory debugger for x86 GNU/Linux): |
298 |
|
;; ==1332== at 0x8008621: main (vtest.c:180) |
299 |
|
;; Currently this regexp only matches the first error. |
300 |
|
;; Thanks to Hans Petter Jansson <hpj@ximian.com> for his regexp wisdom. |
301 |
|
("^==[0-9]+==[^(]+\(([^:]+):([0-9]+)" 1 2) |
302 |
|
|
303 |
;; 4.3BSD lint pass 2 |
;; 4.3BSD lint pass 2 |
304 |
;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) |
;; strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8) |
305 |
(".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" |
(".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" |
452 |
'( |
'( |
453 |
;; Matches lines printed by the `-w' option of GNU Make. |
;; Matches lines printed by the `-w' option of GNU Make. |
454 |
(".*: Entering directory `\\(.*\\)'$" 1) |
(".*: Entering directory `\\(.*\\)'$" 1) |
455 |
|
;; Matches lines made by Emacs byte compiler. |
456 |
|
("^Entering directory `\\(.*\\)'$" 1) |
457 |
) |
) |
458 |
"Alist specifying how to match lines that indicate a new current directory. |
"Alist specifying how to match lines that indicate a new current directory. |
459 |
Note that the match is done at the beginning of lines. |
Note that the match is done at the beginning of lines. |
466 |
'( |
'( |
467 |
;; Matches lines printed by the `-w' option of GNU Make. |
;; Matches lines printed by the `-w' option of GNU Make. |
468 |
(".*: Leaving directory `\\(.*\\)'$" 1) |
(".*: Leaving directory `\\(.*\\)'$" 1) |
469 |
|
;; Matches lines made by Emacs byte compiler. |
470 |
|
("^Leaving directory `\\(.*\\)'$" 1) |
471 |
) |
) |
472 |
"Alist specifying how to match lines that indicate restoring current directory. |
"Alist specifying how to match lines that indicate restoring current directory. |
473 |
Note that the match is done at the beginning of lines. |
Note that the match is done at the beginning of lines. |
553 |
(defvar grep-find-use-xargs nil |
(defvar grep-find-use-xargs nil |
554 |
"Whether \\[grep-find] uses the `xargs' utility by default. |
"Whether \\[grep-find] uses the `xargs' utility by default. |
555 |
|
|
556 |
If nil, it uses `grep -exec'; if `gnu', it uses `find -print0' and `xargs -0'; |
If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0'; |
557 |
if not nil and not `gnu', it uses `find -print' and `xargs'. |
if not nil and not `gnu', it uses `find -print' and `xargs'. |
558 |
|
|
559 |
This variable's value takes effect when `grep-compute-defaults' is called.") |
This variable's value takes effect when `grep-compute-defaults' is called.") |
685 |
(cons msg code))) |
(cons msg code))) |
686 |
(cons msg code))))) |
(cons msg code))))) |
687 |
|
|
688 |
|
(defun grep-compute-defaults () |
689 |
|
(unless (or (not grep-use-null-device) (eq grep-use-null-device t)) |
690 |
|
(setq grep-use-null-device |
691 |
|
(with-temp-buffer |
692 |
|
(let ((hello-file (expand-file-name "HELLO" data-directory))) |
693 |
|
(not |
694 |
|
(and (equal (condition-case nil |
695 |
|
(if grep-command |
696 |
|
;; `grep-command' is already set, so |
697 |
|
;; use that for testing. |
698 |
|
(call-process-shell-command |
699 |
|
grep-command nil t nil |
700 |
|
"^English" hello-file) |
701 |
|
;; otherwise use `grep-program' |
702 |
|
(call-process grep-program nil t nil |
703 |
|
"-nH" "^English" hello-file)) |
704 |
|
(error nil)) |
705 |
|
0) |
706 |
|
(progn |
707 |
|
(goto-char (point-min)) |
708 |
|
(looking-at |
709 |
|
(concat (regexp-quote hello-file) |
710 |
|
":[0-9]+:English"))))))))) |
711 |
|
(unless grep-command |
712 |
|
(setq grep-command |
713 |
|
(let ((required-options (if grep-use-null-device "-n" "-nH"))) |
714 |
|
(if (equal (condition-case nil ; in case "grep" isn't in exec-path |
715 |
|
(call-process grep-program nil nil nil |
716 |
|
"-e" "foo" null-device) |
717 |
|
(error nil)) |
718 |
|
1) |
719 |
|
(format "%s %s -e " grep-program required-options) |
720 |
|
(format "%s %s " grep-program required-options))))) |
721 |
|
(unless grep-find-use-xargs |
722 |
|
(setq grep-find-use-xargs |
723 |
|
(if (and |
724 |
|
(equal (call-process "find" nil nil nil |
725 |
|
null-device "-print0") |
726 |
|
0) |
727 |
|
(equal (call-process "xargs" nil nil nil |
728 |
|
"-0" "-e" "echo") |
729 |
|
0)) |
730 |
|
'gnu))) |
731 |
|
(unless grep-find-command |
732 |
|
(setq grep-find-command |
733 |
|
(cond ((eq grep-find-use-xargs 'gnu) |
734 |
|
(format "%s . -type f -print0 | xargs -0 -e %s" |
735 |
|
find-program grep-command)) |
736 |
|
(grep-find-use-xargs |
737 |
|
(format "%s . -type f -print | xargs %s" |
738 |
|
find-program grep-command)) |
739 |
|
(t (cons (format "%s . -type f -exec %s {} %s \\;" |
740 |
|
find-program grep-command null-device) |
741 |
|
(+ 22 (length grep-command))))))) |
742 |
|
(unless grep-tree-command |
743 |
|
(setq grep-tree-command |
744 |
|
(let* ((glen (length grep-program)) |
745 |
|
(gcmd (concat grep-program " <C>" (substring grep-command glen)))) |
746 |
|
(cond ((eq grep-find-use-xargs 'gnu) |
747 |
|
(format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>" |
748 |
|
find-program gcmd)) |
749 |
|
(grep-find-use-xargs |
750 |
|
(format "%s <D> <X> -type f <F> -print | xargs %s <R>" |
751 |
|
find-program gcmd)) |
752 |
|
(t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" |
753 |
|
find-program gcmd null-device))))))) |
754 |
|
|
755 |
|
(defun grep-default-command () |
756 |
|
(let ((tag-default |
757 |
|
(funcall (or find-tag-default-function |
758 |
|
(get major-mode 'find-tag-default-function) |
759 |
|
;; We use grep-tag-default instead of |
760 |
|
;; find-tag-default, to avoid loading etags. |
761 |
|
'grep-tag-default))) |
762 |
|
(sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") |
763 |
|
(grep-default (or (car grep-history) grep-command))) |
764 |
|
;; Replace the thing matching for with that around cursor. |
765 |
|
(when (or (string-match |
766 |
|
(concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*" |
767 |
|
sh-arg-re "\\(\\s +\\(\\S +\\)\\)?") |
768 |
|
grep-default) |
769 |
|
;; If the string is not yet complete. |
770 |
|
(string-match "\\(\\)\\'" grep-default)) |
771 |
|
(unless (or (not (stringp buffer-file-name)) |
772 |
|
(when (match-beginning 2) |
773 |
|
(save-match-data |
774 |
|
(string-match |
775 |
|
(wildcard-to-regexp |
776 |
|
(file-name-nondirectory |
777 |
|
(match-string 3 grep-default))) |
778 |
|
(file-name-nondirectory buffer-file-name))))) |
779 |
|
(setq grep-default (concat (substring grep-default |
780 |
|
0 (match-beginning 2)) |
781 |
|
" *." |
782 |
|
(file-name-extension buffer-file-name)))) |
783 |
|
(replace-match (or tag-default "") t t grep-default 1)))) |
784 |
|
|
785 |
;;;###autoload |
;;;###autoload |
786 |
(defun grep (command-args) |
(defun grep (command-args) |
787 |
"Run grep, with user-specified args, and collect output in a buffer. |
"Run grep, with user-specified args, and collect output in a buffer. |
798 |
in the grep command history (or into `grep-command' |
in the grep command history (or into `grep-command' |
799 |
if that history list is empty)." |
if that history list is empty)." |
800 |
(interactive |
(interactive |
801 |
(let (grep-default (arg current-prefix-arg)) |
(progn |
802 |
(unless (and grep-command |
(unless (and grep-command |
803 |
(or (not grep-use-null-device) (eq grep-use-null-device t))) |
(or (not grep-use-null-device) (eq grep-use-null-device t))) |
804 |
(grep-compute-defaults)) |
(grep-compute-defaults)) |
805 |
(when arg |
(let ((default (grep-default-command))) |
806 |
(let ((tag-default |
(list (read-from-minibuffer "Run grep (like this): " |
807 |
(funcall (or find-tag-default-function |
(if current-prefix-arg |
808 |
(get major-mode 'find-tag-default-function) |
default grep-command) |
809 |
;; We use grep-tag-default instead of |
nil nil 'grep-history |
810 |
;; find-tag-default, to avoid loading etags. |
(if current-prefix-arg nil default)))))) |
|
'grep-tag-default)))) |
|
|
(setq grep-default (or (car grep-history) grep-command)) |
|
|
;; Replace the thing matching for with that around cursor |
|
|
(when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)\\(\\s-+\\S-+\\)?" grep-default) |
|
|
(unless (or (match-beginning 3) (not (stringp buffer-file-name))) |
|
|
(setq grep-default (concat grep-default "*." |
|
|
(file-name-extension buffer-file-name)))) |
|
|
(setq grep-default (replace-match (or tag-default "") |
|
|
t t grep-default 2))))) |
|
|
(list (read-from-minibuffer "Run grep (like this): " |
|
|
(or grep-default grep-command) |
|
|
nil nil 'grep-history)))) |
|
811 |
|
|
812 |
;; Setting process-setup-function makes exit-message-function work |
;; Setting process-setup-function makes exit-message-function work |
813 |
;; even when async processes aren't supported. |
;; even when async processes aren't supported. |
875 |
(or regexp "") command t t)) |
(or regexp "") command t t)) |
876 |
command) |
command) |
877 |
|
|
|
;;;###autoload |
|
878 |
(defvar grep-tree-last-regexp "") |
(defvar grep-tree-last-regexp "") |
879 |
(defvar grep-tree-last-files (car (car grep-tree-files-aliases))) |
(defvar grep-tree-last-files (car (car grep-tree-files-aliases))) |
880 |
|
|
881 |
(defun grep-tree (regexp files dir) |
;;;###autoload |
882 |
"Grep in directory tree with simplified prompting for search parameters. |
(defun grep-tree (regexp files dir &optional subdirs) |
883 |
|
"Grep for REGEXP in FILES in directory tree rooted at DIR. |
884 |
Collect output in a buffer. |
Collect output in a buffer. |
885 |
|
Interactively, prompt separately for each search parameter. |
886 |
|
With prefix arg, reuse previous REGEXP. |
887 |
|
The search is limited to file names matching shell pattern FILES. |
888 |
|
FILES may use abbreviations defined in `grep-tree-files-aliases', e.g. |
889 |
|
entering `ch' is equivalent to `*.[ch]'. |
890 |
|
|
891 |
While find runs asynchronously, you can use the \\[next-error] command |
While find runs asynchronously, you can use the \\[next-error] command |
892 |
to find the text that grep hits refer to. |
to find the text that grep hits refer to. |
893 |
|
|
894 |
This command uses a special history list for its arguments, so you can |
This command uses a special history list for its arguments, so you can |
895 |
easily repeat a find command." |
easily repeat a find command. |
896 |
|
|
897 |
|
When used non-interactively, optional arg SUBDIRS limits the search to |
898 |
|
those sub directories of DIR." |
899 |
(interactive |
(interactive |
900 |
(let* ((regexp |
(let* ((regexp |
901 |
(if current-prefix-arg |
(if current-prefix-arg |
917 |
(setq files grep-tree-last-files)) |
(setq files grep-tree-last-files)) |
918 |
(when files |
(when files |
919 |
(setq grep-tree-last-files files) |
(setq grep-tree-last-files files) |
920 |
(let ((mf (assoc files match-files-aliases))) |
(let ((mf (assoc files grep-tree-files-aliases))) |
921 |
(if mf |
(if mf |
922 |
(setq files (cdr mf))))) |
(setq files (cdr mf))))) |
923 |
(let ((command-args (grep-expand-command-macros |
(let ((command-args (grep-expand-command-macros |
924 |
grep-tree-command |
grep-tree-command |
925 |
(setq grep-tree-last-regexp regexp) |
(setq grep-tree-last-regexp regexp) |
926 |
(and files (concat "-name '" files "'")) |
(and files (concat "-name '" files "'")) |
927 |
nil ;; we change default-directory to dir |
(if subdirs |
928 |
|
(if (stringp subdirs) |
929 |
|
subdirs |
930 |
|
(mapconcat 'identity subdirs " ")) |
931 |
|
nil) ;; we change default-directory to dir |
932 |
(and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") |
(and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") |
933 |
grep-tree-ignore-case)) |
grep-tree-ignore-case)) |
934 |
(default-directory dir) |
(default-directory dir) |
954 |
If current buffer is in Compilation mode for the same mode name |
If current buffer is in Compilation mode for the same mode name |
955 |
return the name of the current buffer, so that it gets reused. |
return the name of the current buffer, so that it gets reused. |
956 |
Otherwise, construct a buffer name from MODE-NAME." |
Otherwise, construct a buffer name from MODE-NAME." |
957 |
(cond (name-function |
(cond (name-function |
958 |
(funcall name-function mode-name)) |
(funcall name-function mode-name)) |
959 |
(compilation-buffer-name-function |
(compilation-buffer-name-function |
960 |
(funcall compilation-buffer-name-function mode-name)) |
(funcall compilation-buffer-name-function mode-name)) |
961 |
((and (eq major-mode 'compilation-mode) |
((and (eq major-mode 'compilation-mode) |
962 |
(equal mode-name (nth 2 compilation-arguments))) |
(equal mode-name (nth 2 compilation-arguments))) |
969 |
&optional name-of-mode parser |
&optional name-of-mode parser |
970 |
error-regexp-alist name-function |
error-regexp-alist name-function |
971 |
enter-regexp-alist leave-regexp-alist |
enter-regexp-alist leave-regexp-alist |
972 |
file-regexp-alist nomessage-regexp-alist) |
file-regexp-alist nomessage-regexp-alist |
973 |
|
no-async) |
974 |
"Run compilation command COMMAND (low level interface). |
"Run compilation command COMMAND (low level interface). |
975 |
ERROR-MESSAGE is a string to print if the user asks to see another error |
ERROR-MESSAGE is a string to print if the user asks to see another error |
976 |
and there are no more errors. The rest of the arguments, 3-10 are optional. |
and there are no more errors. The rest of the arguments, 3-10 are optional. |
989 |
\ and `compilation-nomessage-regexp-alist', respectively. |
\ and `compilation-nomessage-regexp-alist', respectively. |
990 |
For arg 7-10 a value `t' means an empty alist. |
For arg 7-10 a value `t' means an empty alist. |
991 |
|
|
992 |
|
If NO-ASYNC is non-nil, start the compilation process synchronously. |
993 |
|
|
994 |
Returns the compilation buffer created." |
Returns the compilation buffer created." |
995 |
|
(unless no-async |
996 |
|
(setq no-async (not (fboundp 'start-process)))) |
997 |
(let (outbuf) |
(let (outbuf) |
998 |
(save-excursion |
(save-excursion |
999 |
(or name-of-mode |
(or name-of-mode |
1086 |
(if compilation-process-setup-function |
(if compilation-process-setup-function |
1087 |
(funcall compilation-process-setup-function)) |
(funcall compilation-process-setup-function)) |
1088 |
;; Start the compilation. |
;; Start the compilation. |
1089 |
(if (fboundp 'start-process) |
(if (not no-async) |
1090 |
(let* ((process-environment |
(let* ((process-environment |
1091 |
(append |
(append |
1092 |
(if (and (boundp 'system-uses-terminfo) |
(if (and (boundp 'system-uses-terminfo) |
1158 |
(when (window-live-p w) |
(when (window-live-p w) |
1159 |
(select-window w))))))) |
(select-window w))))))) |
1160 |
|
|
1161 |
|
(defvar compilation-menu-map |
1162 |
|
(let ((map (make-sparse-keymap "Errors"))) |
1163 |
|
(define-key map [stop-subjob] |
1164 |
|
'("Stop Compilation" . kill-compilation)) |
1165 |
|
(define-key map [compilation-mode-separator2] |
1166 |
|
'("----" . nil)) |
1167 |
|
(define-key map [compilation-mode-first-error] |
1168 |
|
'("First Error" . first-error)) |
1169 |
|
(define-key map [compilation-mode-previous-error] |
1170 |
|
'("Previous Error" . previous-error)) |
1171 |
|
(define-key map [compilation-mode-next-error] |
1172 |
|
'("Next Error" . next-error)) |
1173 |
|
map)) |
1174 |
|
|
1175 |
(defvar compilation-minor-mode-map |
(defvar compilation-minor-mode-map |
1176 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
1177 |
(define-key map [mouse-2] 'compile-mouse-goto-error) |
(define-key map [mouse-2] 'compile-mouse-goto-error) |
1182 |
(define-key map "\M-p" 'compilation-previous-error) |
(define-key map "\M-p" 'compilation-previous-error) |
1183 |
(define-key map "\M-{" 'compilation-previous-file) |
(define-key map "\M-{" 'compilation-previous-file) |
1184 |
(define-key map "\M-}" 'compilation-next-file) |
(define-key map "\M-}" 'compilation-next-file) |
1185 |
|
;; Set up the menu-bar |
1186 |
|
(define-key map [menu-bar compilation] |
1187 |
|
(cons "Errors" compilation-menu-map)) |
1188 |
map) |
map) |
1189 |
"Keymap for `compilation-minor-mode'.") |
"Keymap for `compilation-minor-mode'.") |
1190 |
|
|
1197 |
(define-key map "\M-{" 'compilation-previous-file) |
(define-key map "\M-{" 'compilation-previous-file) |
1198 |
(define-key map "\M-}" 'compilation-next-file) |
(define-key map "\M-}" 'compilation-next-file) |
1199 |
;; Set up the menu-bar |
;; Set up the menu-bar |
1200 |
(define-key map [menu-bar errors-menu] |
(define-key map [menu-bar compilation] |
1201 |
(cons "Errors" (make-sparse-keymap "Errors"))) |
(cons "Errors" compilation-menu-map)) |
|
(define-key map [menu-bar errors-menu stop-subjob] |
|
|
'("Stop" . comint-interrupt-subjob)) |
|
|
(define-key map [menu-bar errors-menu compilation-mode-separator2] |
|
|
'("----" . nil)) |
|
|
(define-key map [menu-bar errors-menu compilation-mode-first-error] |
|
|
'("First Error" . first-error)) |
|
|
(define-key map [menu-bar errors-menu compilation-mode-previous-error] |
|
|
'("Previous Error" . previous-error)) |
|
|
(define-key map [menu-bar errors-menu compilation-mode-next-error] |
|
|
'("Next Error" . next-error)) |
|
1202 |
map) |
map) |
1203 |
"Keymap for `compilation-shell-minor-mode'.") |
"Keymap for `compilation-shell-minor-mode'.") |
1204 |
|
|
1205 |
(defvar compilation-mode-map |
(defvar compilation-mode-map |
1206 |
(let ((map (cons 'keymap compilation-minor-mode-map))) |
(let ((map (make-sparse-keymap))) |
1207 |
|
(set-keymap-parent map compilation-minor-mode-map) |
1208 |
(define-key map " " 'scroll-up) |
(define-key map " " 'scroll-up) |
1209 |
(define-key map "\^?" 'scroll-down) |
(define-key map "\^?" 'scroll-down) |
1210 |
;; Set up the menu-bar |
;; Set up the menu-bar |
1211 |
(define-key map [menu-bar compilation-menu] |
(define-key map [menu-bar compilation] |
1212 |
(cons "Compile" (make-sparse-keymap "Compile"))) |
(cons "Compile" (make-sparse-keymap "Compile"))) |
1213 |
|
(define-key map [menu-bar compilation compilation-separator2] |
|
(define-key map [menu-bar compilation-menu compilation-mode-kill-compilation] |
|
|
'("Stop Compilation" . kill-compilation)) |
|
|
(define-key map [menu-bar compilation-menu compilation-mode-separator2] |
|
|
'("----" . nil)) |
|
|
(define-key map [menu-bar compilation-menu compilation-mode-first-error] |
|
|
'("First Error" . first-error)) |
|
|
(define-key map [menu-bar compilation-menu compilation-mode-previous-error] |
|
|
'("Previous Error" . previous-error)) |
|
|
(define-key map [menu-bar compilation-menu compilation-mode-next-error] |
|
|
'("Next Error" . next-error)) |
|
|
(define-key map [menu-bar compilation-menu compilation-separator2] |
|
1214 |
'("----" . nil)) |
'("----" . nil)) |
1215 |
(define-key map [menu-bar compilation-menu compilation-mode-grep] |
(define-key map [menu-bar compilation compilation-mode-grep] |
1216 |
'("Search Files (grep)" . grep)) |
'("Search Files (grep)" . grep)) |
1217 |
(define-key map [menu-bar compilation-menu compilation-mode-recompile] |
(define-key map [menu-bar compilation compilation-mode-recompile] |
1218 |
'("Recompile" . recompile)) |
'("Recompile" . recompile)) |
1219 |
(define-key map [menu-bar compilation-menu compilation-mode-compile] |
(define-key map [menu-bar compilation compilation-mode-compile] |
1220 |
'("Compile..." . compile)) |
'("Compile..." . compile)) |
1221 |
map) |
map) |
1222 |
"Keymap for compilation log buffers. |
"Keymap for compilation log buffers. |
1223 |
`compilation-minor-mode-map' is a cdr of this.") |
`compilation-minor-mode-map' is a parent of this.") |
1224 |
|
|
1225 |
(put 'compilation-mode 'mode-class 'special) |
(put 'compilation-mode 'mode-class 'special) |
1226 |
|
|
1245 |
(run-hooks 'compilation-mode-hook)) |
(run-hooks 'compilation-mode-hook)) |
1246 |
|
|
1247 |
(defun compilation-revert-buffer (ignore-auto noconfirm) |
(defun compilation-revert-buffer (ignore-auto noconfirm) |
1248 |
(if (or noconfirm (yes-or-no-p (format "Restart compilation? "))) |
(if buffer-file-name |
1249 |
(apply 'compile-internal compilation-arguments))) |
(let (revert-buffer-function) |
1250 |
|
(revert-buffer ignore-auto noconfirm preserve-modes)) |
1251 |
|
(if (or noconfirm (yes-or-no-p (format "Restart compilation? "))) |
1252 |
|
(apply 'compile-internal compilation-arguments)))) |
1253 |
|
|
1254 |
(defun compilation-setup () |
(defun compilation-setup () |
1255 |
"Prepare the buffer for the compilation parsing commands to work." |
"Prepare the buffer for the compilation parsing commands to work." |
1263 |
(make-local-variable 'compilation-error-screen-columns) |
(make-local-variable 'compilation-error-screen-columns) |
1264 |
(setq compilation-last-buffer (current-buffer))) |
(setq compilation-last-buffer (current-buffer))) |
1265 |
|
|
|
(defvar compilation-shell-minor-mode nil |
|
|
"Non-nil when in `compilation-shell-minor-mode'. |
|
|
In this minor mode, all the error-parsing commands of the |
|
|
Compilation major mode are available but bound to keys that don't |
|
|
collide with Shell mode.") |
|
|
(make-variable-buffer-local 'compilation-shell-minor-mode) |
|
|
|
|
|
(or (assq 'compilation-shell-minor-mode minor-mode-alist) |
|
|
(setq minor-mode-alist |
|
|
(cons '(compilation-shell-minor-mode " Shell-Compile") |
|
|
minor-mode-alist))) |
|
|
(or (assq 'compilation-shell-minor-mode minor-mode-map-alist) |
|
|
(setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode |
|
|
compilation-shell-minor-mode-map) |
|
|
minor-mode-map-alist))) |
|
|
|
|
|
(defvar compilation-minor-mode nil |
|
|
"Non-nil when in `compilation-minor-mode'. |
|
|
In this minor mode, all the error-parsing commands of the |
|
|
Compilation major mode are available.") |
|
|
(make-variable-buffer-local 'compilation-minor-mode) |
|
|
|
|
|
(or (assq 'compilation-minor-mode minor-mode-alist) |
|
|
(setq minor-mode-alist (cons '(compilation-minor-mode " Compilation") |
|
|
minor-mode-alist))) |
|
|
(or (assq 'compilation-minor-mode minor-mode-map-alist) |
|
|
(setq minor-mode-map-alist (cons (cons 'compilation-minor-mode |
|
|
compilation-minor-mode-map) |
|
|
minor-mode-map-alist))) |
|
|
|
|
1266 |
;;;###autoload |
;;;###autoload |
1267 |
(defun compilation-shell-minor-mode (&optional arg) |
(define-minor-mode compilation-shell-minor-mode |
1268 |
"Toggle compilation shell minor mode. |
"Toggle compilation shell minor mode. |
1269 |
With arg, turn compilation mode on if and only if arg is positive. |
With arg, turn compilation mode on if and only if arg is positive. |
1270 |
See `compilation-mode'. |
In this minor mode, all the error-parsing commands of the |
1271 |
|
Compilation major mode are available but bound to keys that don't |
1272 |
|
collide with Shell mode. See `compilation-mode'. |
1273 |
Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." |
Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." |
1274 |
(interactive "P") |
nil " Shell-Compile" nil |
1275 |
(if (setq compilation-shell-minor-mode (if (null arg) |
:group 'compilation |
1276 |
(null compilation-shell-minor-mode) |
(let (mode-line-process) |
1277 |
(> (prefix-numeric-value arg) 0))) |
(compilation-setup))) |
|
(let ((mode-line-process)) |
|
|
(compilation-setup) |
|
|
(run-hooks 'compilation-shell-minor-mode-hook)))) |
|
1278 |
|
|
1279 |
;;;###autoload |
;;;###autoload |
1280 |
(defun compilation-minor-mode (&optional arg) |
(define-minor-mode compilation-minor-mode |
1281 |
"Toggle compilation minor mode. |
"Toggle compilation minor mode. |
1282 |
With arg, turn compilation mode on if and only if arg is positive. |
With arg, turn compilation mode on if and only if arg is positive. |
1283 |
See `compilation-mode'. |
In this minor mode, all the error-parsing commands of the |
1284 |
|
Compilation major mode are available. See `compilation-mode'. |
1285 |
Turning the mode on runs the normal hook `compilation-minor-mode-hook'." |
Turning the mode on runs the normal hook `compilation-minor-mode-hook'." |
1286 |
(interactive "P") |
nil " Compilation" nil |
1287 |
(if (setq compilation-minor-mode (if (null arg) |
:group 'compilation |
1288 |
(null compilation-minor-mode) |
(let ((mode-line-process)) |
1289 |
(> (prefix-numeric-value arg) 0))) |
(compilation-setup))) |
|
(let ((mode-line-process)) |
|
|
(compilation-setup) |
|
|
(run-hooks 'compilation-minor-mode-hook)))) |
|
1290 |
|
|
1291 |
(defun compilation-handle-exit (process-status exit-status msg) |
(defun compilation-handle-exit (process-status exit-status msg) |
1292 |
"Write msg in the current buffer and hack its mode-line-process." |
"Write msg in the current buffer and hack its mode-line-process." |
1567 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
1568 |
(buffer-undo-list t) |
(buffer-undo-list t) |
1569 |
deactivate-mark |
deactivate-mark |
1570 |
|
(buffer-was-modified (buffer-modified-p)) |
1571 |
(error-list compilation-error-list)) |
(error-list compilation-error-list)) |
1572 |
(while error-list |
(while error-list |
1573 |
(save-excursion |
(save-excursion |
1575 |
(progn (end-of-line) (point)) |
(progn (end-of-line) (point)) |
1576 |
'(mouse-face highlight help-echo "\ |
'(mouse-face highlight help-echo "\ |
1577 |
mouse-2: visit this file and line"))) |
mouse-2: visit this file and line"))) |
1578 |
(setq error-list (cdr error-list)))) |
(setq error-list (cdr error-list))) |
1579 |
|
(set-buffer-modified-p buffer-was-modified)) |
1580 |
))))) |
))))) |
1581 |
|
|
1582 |
(defun compile-mouse-goto-error (event) |
(defun compile-mouse-goto-error (event) |
1994 |
(overlays-in (point-min) (point-max))) |
(overlays-in (point-min) (point-max))) |
1995 |
buffer))) |
buffer))) |
1996 |
|
|
1997 |
|
(defun compilation-normalize-filename (filename) |
1998 |
|
"Convert a filename string found in an error message to make it usable." |
1999 |
|
|
2000 |
|
;; Check for a comint-file-name-prefix and prepend it if |
2001 |
|
;; appropriate. (This is very useful for |
2002 |
|
;; compilation-minor-mode in an rlogin-mode buffer.) |
2003 |
|
(and (boundp 'comint-file-name-prefix) |
2004 |
|
;; If file name is relative, default-directory will |
2005 |
|
;; already contain the comint-file-name-prefix (done |
2006 |
|
;; by compile-abbreviate-directory). |
2007 |
|
(file-name-absolute-p filename) |
2008 |
|
(setq filename |
2009 |
|
(concat comint-file-name-prefix filename))) |
2010 |
|
|
2011 |
|
;; If compilation-parse-errors-filename-function is |
2012 |
|
;; defined, use it to process the filename. |
2013 |
|
(when compilation-parse-errors-filename-function |
2014 |
|
(setq filename |
2015 |
|
(funcall compilation-parse-errors-filename-function |
2016 |
|
filename))) |
2017 |
|
|
2018 |
|
;; Some compilers (e.g. Sun's java compiler, reportedly) |
2019 |
|
;; produce bogus file names like "./bar//foo.c" for file |
2020 |
|
;; "bar/foo.c"; expand-file-name will collapse these into |
2021 |
|
;; "/foo.c" and fail to find the appropriate file. So we |
2022 |
|
;; look for doubled slashes in the file name and fix them |
2023 |
|
;; up in the buffer. |
2024 |
|
(setq filename (command-line-normalize-file-name filename))) |
2025 |
|
|
2026 |
;; Set compilation-error-list to nil, and unchain the markers that point to the |
;; Set compilation-error-list to nil, and unchain the markers that point to the |
2027 |
;; error messages and their text, so that they no longer slow down gap motion. |
;; error messages and their text, so that they no longer slow down gap motion. |
2166 |
(error "\ |
(error "\ |
2167 |
An error message with no file name and no file name has been seen earlier")) |
An error message with no file name and no file name has been seen earlier")) |
2168 |
|
|
2169 |
;; Check for a comint-file-name-prefix and prepend it if |
;; Clean up the file name string in several ways. |
2170 |
;; appropriate. (This is very useful for |
(setq filename (compilation-normalize-filename filename)) |
|
;; compilation-minor-mode in an rlogin-mode buffer.) |
|
|
(and (boundp 'comint-file-name-prefix) |
|
|
;; If file name is relative, default-directory will |
|
|
;; already contain the comint-file-name-prefix (done |
|
|
;; by compile-abbreviate-directory). |
|
|
(file-name-absolute-p filename) |
|
|
(setq filename |
|
|
(concat comint-file-name-prefix filename))) |
|
|
|
|
|
;; If compilation-parse-errors-filename-function is |
|
|
;; defined, use it to process the filename. |
|
|
(when compilation-parse-errors-filename-function |
|
|
(setq filename |
|
|
(funcall compilation-parse-errors-filename-function |
|
|
filename))) |
|
|
|
|
|
;; Some compilers (e.g. Sun's java compiler, reportedly) |
|
|
;; produce bogus file names like "./bar//foo.c" for file |
|
|
;; "bar/foo.c"; expand-file-name will collapse these into |
|
|
;; "/foo.c" and fail to find the appropriate file. So we |
|
|
;; look for doubled slashes in the file name and fix them |
|
|
;; up in the buffer. |
|
|
(setq filename (command-line-normalize-file-name filename)) |
|
2171 |
|
|
2172 |
(setq filename |
(setq filename |
2173 |
(cons filename (cons default-directory (cdr alist)))) |
(cons filename (cons default-directory (cdr alist)))) |
2238 |
|
|
2239 |
;; Not an error message. |
;; Not an error message. |
2240 |
(if (eq type `file) ; Change current file. |
(if (eq type `file) ; Change current file. |
2241 |
(and filename (setq compilation-current-file filename)) |
(when filename |
2242 |
|
(setq compilation-current-file |
2243 |
|
;; Clean up the file name string in several ways. |
2244 |
|
(compilation-normalize-filename filename))) |
2245 |
;; Enter or leave directory. |
;; Enter or leave directory. |
2246 |
(setq stack compilation-directory-stack) |
(setq stack compilation-directory-stack) |
2247 |
(and filename |
;; Don't check if it is really a directory. |
2248 |
(file-directory-p |
;; Let the code to search and clean up file names |
2249 |
(setq filename |
;; try to use it in any case. |
2250 |
;; The directory name in the message |
(when filename |
2251 |
;; is a truename. Try to convert it to a form |
;; Clean up the directory name string in several ways. |
2252 |
;; like what the user typed in. |
(setq filename (compilation-normalize-filename filename)) |
2253 |
(compile-abbreviate-directory |
(setq filename |
2254 |
(file-name-as-directory |
;; The directory name in the message |
2255 |
(expand-file-name filename)) |
;; is a truename. Try to convert it to a form |
2256 |
orig orig-expanded parent-expanded))) |
;; like what the user typed in. |
2257 |
(if (eq type 'leave) |
(compile-abbreviate-directory |
2258 |
(while (and stack |
(file-name-as-directory |
2259 |
(not (string-equal (car stack) |
(expand-file-name filename)) |
2260 |
filename))) |
orig orig-expanded parent-expanded)) |
2261 |
(setq stack (cdr stack))) |
(if (eq type 'leave) |
2262 |
(setq compilation-directory-stack |
;; If we are leaving a specific directory, |
2263 |
(cons filename compilation-directory-stack) |
;; as preparation, pop out of all other directories |
2264 |
default-directory filename))) |
;; that we entered nested within it. |
2265 |
|
(while (and stack |
2266 |
|
(not (string-equal (car stack) |
2267 |
|
filename))) |
2268 |
|
(setq stack (cdr stack))) |
2269 |
|
(setq compilation-directory-stack |
2270 |
|
(cons filename compilation-directory-stack) |
2271 |
|
default-directory filename))) |
2272 |
(and (eq type 'leave) |
(and (eq type 'leave) |
2273 |
stack |
stack |
2274 |
(setq compilation-directory-stack (cdr stack)) |
(setq compilation-directory-stack (cdr stack)) |