aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKim F. Storm2003-11-23 20:57:47 +0000
committerKim F. Storm2003-11-23 20:57:47 +0000
commit9ac5747987e4df08683ce2af46c8a7d09744dbd7 (patch)
treea26295f1e6078c125ad85514692f043f24350d63
parent318e2976570e4d2fd6859ff99946ab66fdd5944e (diff)
downloademacs-9ac5747987e4df08683ce2af46c8a7d09744dbd7.tar.gz
emacs-9ac5747987e4df08683ce2af46c8a7d09744dbd7.zip
(grep-command, grep-use-null-device)
(grep-find-command, grep-tree-command, grep-tree-files-aliases) (grep-tree-ignore-case, grep-tree-ignore-CVS-directories) (grep-regexp-alist, grep-program, find-program) (grep-find-use-xargs, grep-history, grep-find-history) (grep-process-setup, grep-compute-defaults) (grep-default-command, grep, grep-tag-default, grep-find) (grep-expand-command-macros, grep-tree-last-regexp) (grep-tree-last-files, grep-tree): Move grep variables, functions and commands to new file grep.el. (compilation-mode-map): Remove grep commands from Compile sub-menu. (compilation-process-setup-function): Doc fix. (compilation-highlight-regexp, compilation-highlight-overlay): New defvars used for highlighting current compile error in source buffer. (compile-internal): New optional args HIGHLIGHT-REGEXP and LOCAL-MAP which overrides compilation-highlight-regexp and compilation-mode-map for this compilation. Delay calling compilation-set-window-height until after running compilation-process-setup-function so it can buffer-local override compilation-window-height. Check buffer-local value of compilation-scroll-output. (compilation-set-window-height): Use buffer-local value of compilation-window-height. (compilation-revert-buffer): Don't pass (undefined) preserve-modes arg to revert-buffer. (next-error-no-select, previous-error-no-select): New commands. (compilation-goto-locus): Temporarily highlight current match in source buffer using compilation-highlight-regexp.
-rw-r--r--lisp/progmodes/compile.el505
1 files changed, 102 insertions, 403 deletions
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index eaaa1634b52..6d76fe3384a 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -66,78 +66,6 @@ will be parsed and highlighted as soon as you try to move to them."
66 (integer :tag "First N lines")) 66 (integer :tag "First N lines"))
67 :group 'compilation) 67 :group 'compilation)
68 68
69(defcustom grep-command nil
70 "The default grep command for \\[grep].
71If the grep program used supports an option to always include file names
72in its output (such as the `-H' option to GNU grep), it's a good idea to
73include it when specifying `grep-command'.
74
75The default value of this variable is set up by `grep-compute-defaults';
76call that function before using this variable in your program."
77 :type '(choice string
78 (const :tag "Not Set" nil))
79 :group 'compilation)
80
81(defcustom grep-use-null-device 'auto-detect
82 "If t, append the value of `null-device' to `grep' commands.
83This is done to ensure that the output of grep includes the filename of
84any match in the case where only a single file is searched, and is not
85necessary if the grep program used supports the `-H' option.
86
87The default value of this variable is set up by `grep-compute-defaults';
88call that function before using this variable in your program."
89 :type 'boolean
90 :type '(choice (const :tag "Do Not Append Null Device" nil)
91 (const :tag "Append Null Device" t)
92 (other :tag "Not Set" auto-detect))
93 :group 'compilation)
94
95(defcustom grep-find-command nil
96 "The default find command for \\[grep-find].
97The default value of this variable is set up by `grep-compute-defaults';
98call that function before using this variable in your program."
99 :type '(choice string
100 (const :tag "Not Set" nil))
101 :group 'compilation)
102
103(defcustom grep-tree-command nil
104 "The default find command for \\[grep-tree].
105The default value of this variable is set up by `grep-compute-defaults';
106call that function before using this variable in your program.
107The following place holders should be present in the string:
108 <D> - base directory for find
109 <X> - find options to restrict or expand the directory list
110 <F> - find options to limit the files matched
111 <C> - place to put -i if case insensitive grep
112 <R> - the regular expression searched for."
113 :type '(choice string
114 (const :tag "Not Set" nil))
115 :version "21.4"
116 :group 'compilation)
117
118(defcustom grep-tree-files-aliases '(
119 ("ch" . "*.[ch]")
120 ("c" . "*.c")
121 ("h" . "*.h")
122 ("m" . "[Mm]akefile*")
123 ("asm" . "*.[sS]")
124 ("all" . "*")
125 ("el" . "*.el")
126 )
127 "*Alist of aliases for the FILES argument to `grep-tree'."
128 :type 'alist
129 :group 'compilation)
130
131(defcustom grep-tree-ignore-case t
132 "*If non-nil, `grep-tree' ignores case in matches."
133 :type 'boolean
134 :group 'compilation)
135
136(defcustom grep-tree-ignore-CVS-directories t
137 "*If non-nil, `grep-tree' does no recurse into CVS directories."
138 :type 'boolean
139 :group 'compilation)
140
141(defvar compilation-error-list nil 69(defvar compilation-error-list nil
142 "List of error message descriptors for visiting erring functions. 70 "List of error message descriptors for visiting erring functions.
143Each error descriptor is a cons (or nil). Its car is a marker pointing to 71Each error descriptor is a cons (or nil). Its car is a marker pointing to
@@ -177,7 +105,9 @@ in the compilation output, and should return a transformed file name.")
177 "*Function to call to customize the compilation process. 105 "*Function to call to customize the compilation process.
178This functions is called immediately before the compilation process is 106This functions is called immediately before the compilation process is
179started. It can be used to set any variables or functions that are used 107started. It can be used to set any variables or functions that are used
180while processing the output of the compilation process.") 108while processing the output of the compilation process. The function
109is called with variables `compilation-buffer' and `compilation-window'
110bound to the compilation buffer and window, respectively.")
181 111
182;;;###autoload 112;;;###autoload
183(defvar compilation-buffer-name-function nil 113(defvar compilation-buffer-name-function nil
@@ -510,6 +440,13 @@ Note that the match is done at the beginning of lines.
510Each elt has the form (REGEXP). This alist is by default empty, but if 440Each elt has the form (REGEXP). This alist is by default empty, but if
511you have some good regexps here, the parsing of messages will be faster.") 441you have some good regexps here, the parsing of messages will be faster.")
512 442
443(defvar compilation-highlight-regexp t
444 "Regexp matching part of visited source lines to highlight temporarily.
445Highlight entire line if t; don't highlight source lines if nil.")
446
447(defvar compilation-highlight-overlay nil
448 "Overlay used to temporarily highlight compilation matches.")
449
513(defcustom compilation-error-screen-columns t 450(defcustom compilation-error-screen-columns t
514 "*If non-nil, column numbers in error messages are screen columns. 451 "*If non-nil, column numbers in error messages are screen columns.
515Otherwise they are interpreted as character positions, with 452Otherwise they are interpreted as character positions, with
@@ -534,38 +471,6 @@ Otherwise, it saves all modified buffers without asking."
534 :type 'boolean 471 :type 'boolean
535 :group 'compilation) 472 :group 'compilation)
536 473
537;; Note: the character class after the optional drive letter does not
538;; include a space to support file names with blanks.
539(defvar grep-regexp-alist
540 '(("\\([a-zA-Z]?:?[^:(\t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
541 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
542
543(defvar grep-program
544 ;; Currently zgrep has trouble. It runs egrep instead of grep,
545 ;; and it doesn't pass along long options right.
546 "grep"
547 ;; (if (equal (condition-case nil ; in case "zgrep" isn't in exec-path
548 ;; (call-process "zgrep" nil nil nil
549 ;; "foo" null-device)
550 ;; (error nil))
551 ;; 1)
552 ;; "zgrep"
553 ;; "grep")
554 "The default grep program for `grep-command' and `grep-find-command'.
555This variable's value takes effect when `grep-compute-defaults' is called.")
556
557(defvar find-program "find"
558 "The default find program for `grep-find-command'.
559This variable's value takes effect when `grep-compute-defaults' is called.")
560
561(defvar grep-find-use-xargs nil
562 "Whether \\[grep-find] uses the `xargs' utility by default.
563
564If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0';
565if not nil and not `gnu', it uses `find -print' and `xargs'.
566
567This variable's value takes effect when `grep-compute-defaults' is called.")
568
569;;;###autoload 474;;;###autoload
570(defcustom compilation-search-path '(nil) 475(defcustom compilation-search-path '(nil)
571 "*List of directories to search for source files named in error messages. 476 "*List of directories to search for source files named in error messages.
@@ -609,9 +514,6 @@ starting the compilation process.")
609 514
610;; History of compile commands. 515;; History of compile commands.
611(defvar compile-history nil) 516(defvar compile-history nil)
612;; History of grep commands.
613(defvar grep-history nil)
614(defvar grep-find-history nil)
615 517
616(defun compilation-mode-font-lock-keywords () 518(defun compilation-mode-font-lock-keywords ()
617 "Return expressions to highlight in Compilation mode." 519 "Return expressions to highlight in Compilation mode."
@@ -688,269 +590,6 @@ original use. Otherwise, it recompiles using `compile-command'."
688 (apply 'compile-internal (or compilation-arguments 590 (apply 'compile-internal (or compilation-arguments
689 `(,(eval compile-command) "No more errors")))) 591 `(,(eval compile-command) "No more errors"))))
690 592
691(defun grep-process-setup ()
692 "Set up `compilation-exit-message-function' for `grep'."
693 (set (make-local-variable 'compilation-exit-message-function)
694 (lambda (status code msg)
695 (if (eq status 'exit)
696 (cond ((zerop code)
697 '("finished (matches found)\n" . "matched"))
698 ((= code 1)
699 '("finished with no matches found\n" . "no match"))
700 (t
701 (cons msg code)))
702 (cons msg code)))))
703
704(defun grep-compute-defaults ()
705 (unless (or (not grep-use-null-device) (eq grep-use-null-device t))
706 (setq grep-use-null-device
707 (with-temp-buffer
708 (let ((hello-file (expand-file-name "HELLO" data-directory)))
709 (not
710 (and (equal (condition-case nil
711 (if grep-command
712 ;; `grep-command' is already set, so
713 ;; use that for testing.
714 (call-process-shell-command
715 grep-command nil t nil
716 "^English" hello-file)
717 ;; otherwise use `grep-program'
718 (call-process grep-program nil t nil
719 "-nH" "^English" hello-file))
720 (error nil))
721 0)
722 (progn
723 (goto-char (point-min))
724 (looking-at
725 (concat (regexp-quote hello-file)
726 ":[0-9]+:English")))))))))
727 (unless grep-command
728 (setq grep-command
729 (let ((required-options (if grep-use-null-device "-n" "-nH")))
730 (if (equal (condition-case nil ; in case "grep" isn't in exec-path
731 (call-process grep-program nil nil nil
732 "-e" "foo" null-device)
733 (error nil))
734 1)
735 (format "%s %s -e " grep-program required-options)
736 (format "%s %s " grep-program required-options)))))
737 (unless grep-find-use-xargs
738 (setq grep-find-use-xargs
739 (if (and
740 (equal (call-process "find" nil nil nil
741 null-device "-print0")
742 0)
743 (equal (call-process "xargs" nil nil nil
744 "-0" "-e" "echo")
745 0))
746 'gnu)))
747 (unless grep-find-command
748 (setq grep-find-command
749 (cond ((eq grep-find-use-xargs 'gnu)
750 (format "%s . -type f -print0 | xargs -0 -e %s"
751 find-program grep-command))
752 (grep-find-use-xargs
753 (format "%s . -type f -print | xargs %s"
754 find-program grep-command))
755 (t (cons (format "%s . -type f -exec %s {} %s \\;"
756 find-program grep-command null-device)
757 (+ 22 (length grep-command)))))))
758 (unless grep-tree-command
759 (setq grep-tree-command
760 (let* ((glen (length grep-program))
761 (gcmd (concat grep-program " <C>" (substring grep-command glen))))
762 (cond ((eq grep-find-use-xargs 'gnu)
763 (format "%s <D> <X> -type f <F> -print0 | xargs -0 -e %s <R>"
764 find-program gcmd))
765 (grep-find-use-xargs
766 (format "%s <D> <X> -type f <F> -print | xargs %s <R>"
767 find-program gcmd))
768 (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;"
769 find-program gcmd null-device)))))))
770
771(defun grep-default-command ()
772 (let ((tag-default
773 (funcall (or find-tag-default-function
774 (get major-mode 'find-tag-default-function)
775 ;; We use grep-tag-default instead of
776 ;; find-tag-default, to avoid loading etags.
777 'grep-tag-default)))
778 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
779 (grep-default (or (car grep-history) grep-command)))
780 ;; Replace the thing matching for with that around cursor.
781 (when (or (string-match
782 (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*"
783 sh-arg-re "\\(\\s +\\(\\S +\\)\\)?")
784 grep-default)
785 ;; If the string is not yet complete.
786 (string-match "\\(\\)\\'" grep-default))
787 (unless (or (not (stringp buffer-file-name))
788 (when (match-beginning 2)
789 (save-match-data
790 (string-match
791 (wildcard-to-regexp
792 (file-name-nondirectory
793 (match-string 3 grep-default)))
794 (file-name-nondirectory buffer-file-name)))))
795 (setq grep-default (concat (substring grep-default
796 0 (match-beginning 2))
797 " *."
798 (file-name-extension buffer-file-name))))
799 (replace-match (or tag-default "") t t grep-default 1))))
800
801;;;###autoload
802(defun grep (command-args)
803 "Run grep, with user-specified args, and collect output in a buffer.
804While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
805or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
806output buffer, to go to the lines
807where grep found matches.
808
809This command uses a special history list for its COMMAND-ARGS, so you can
810easily repeat a grep command.
811
812A prefix argument says to default the argument based upon the current
813tag the cursor is over, substituting it into the last grep command
814in the grep command history (or into `grep-command'
815if that history list is empty)."
816 (interactive
817 (progn
818 (unless (and grep-command
819 (or (not grep-use-null-device) (eq grep-use-null-device t)))
820 (grep-compute-defaults))
821 (let ((default (grep-default-command)))
822 (list (read-from-minibuffer "Run grep (like this): "
823 (if current-prefix-arg
824 default grep-command)
825 nil nil 'grep-history
826 (if current-prefix-arg nil default))))))
827
828 ;; Setting process-setup-function makes exit-message-function work
829 ;; even when async processes aren't supported.
830 (let* ((compilation-process-setup-function 'grep-process-setup)
831 (buf (compile-internal (if (and grep-use-null-device null-device)
832 (concat command-args " " null-device)
833 command-args)
834 "No more grep hits" "grep"
835 ;; Give it a simpler regexp to match.
836 nil grep-regexp-alist)))))
837
838;; This is a copy of find-tag-default from etags.el.
839(defun grep-tag-default ()
840 (save-excursion
841 (while (looking-at "\\sw\\|\\s_")
842 (forward-char 1))
843 (when (or (re-search-backward "\\sw\\|\\s_"
844 (save-excursion (beginning-of-line) (point))
845 t)
846 (re-search-forward "\\(\\sw\\|\\s_\\)+"
847 (save-excursion (end-of-line) (point))
848 t))
849 (goto-char (match-end 0))
850 (buffer-substring (point)
851 (progn (forward-sexp -1)
852 (while (looking-at "\\s'")
853 (forward-char 1))
854 (point))))))
855
856;;;###autoload
857(defun grep-find (command-args)
858 "Run grep via find, with user-specified args COMMAND-ARGS.
859Collect output in a buffer.
860While find runs asynchronously, you can use the \\[next-error] command
861to find the text that grep hits refer to.
862
863This command uses a special history list for its arguments, so you can
864easily repeat a find command."
865 (interactive
866 (progn
867 (unless grep-find-command
868 (grep-compute-defaults))
869 (list (read-from-minibuffer "Run find (like this): "
870 grep-find-command nil nil
871 'grep-find-history))))
872 (let ((null-device nil)) ; see grep
873 (grep command-args)))
874
875(defun grep-expand-command-macros (command &optional regexp files dir excl case-fold)
876 "Patch grep COMMAND replacing <D>, etc."
877 (setq command
878 (replace-regexp-in-string "<D>"
879 (or dir ".") command t t))
880 (setq command
881 (replace-regexp-in-string "<X>"
882 (or excl "") command t t))
883 (setq command
884 (replace-regexp-in-string "<F>"
885 (or files "") command t t))
886 (setq command
887 (replace-regexp-in-string "<C>"
888 (if case-fold "-i" "") command t t))
889 (setq command
890 (replace-regexp-in-string "<R>"
891 (or regexp "") command t t))
892 command)
893
894(defvar grep-tree-last-regexp "")
895(defvar grep-tree-last-files (car (car grep-tree-files-aliases)))
896
897;;;###autoload
898(defun grep-tree (regexp files dir &optional subdirs)
899 "Grep for REGEXP in FILES in directory tree rooted at DIR.
900Collect output in a buffer.
901Interactively, prompt separately for each search parameter.
902With prefix arg, reuse previous REGEXP.
903The search is limited to file names matching shell pattern FILES.
904FILES may use abbreviations defined in `grep-tree-files-aliases', e.g.
905entering `ch' is equivalent to `*.[ch]'.
906
907While find runs asynchronously, you can use the \\[next-error] command
908to find the text that grep hits refer to.
909
910This command uses a special history list for its arguments, so you can
911easily repeat a find command.
912
913When used non-interactively, optional arg SUBDIRS limits the search to
914those sub directories of DIR."
915 (interactive
916 (let* ((regexp
917 (if current-prefix-arg
918 grep-tree-last-regexp
919 (let* ((default (current-word))
920 (spec (read-string
921 (concat "Search for"
922 (if (and default (> (length default) 0))
923 (format " (default %s): " default) ": ")))))
924 (if (equal spec "") default spec))))
925 (files
926 (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): ")))
927 (dir
928 (read-directory-name "Base directory: " nil default-directory t)))
929 (list regexp files dir)))
930 (unless grep-tree-command
931 (grep-compute-defaults))
932 (unless (and (stringp files) (> (length files) 0))
933 (setq files grep-tree-last-files))
934 (when files
935 (setq grep-tree-last-files files)
936 (let ((mf (assoc files grep-tree-files-aliases)))
937 (if mf
938 (setq files (cdr mf)))))
939 (let ((command-args (grep-expand-command-macros
940 grep-tree-command
941 (setq grep-tree-last-regexp regexp)
942 (and files (concat "-name '" files "'"))
943 (if subdirs
944 (if (stringp subdirs)
945 subdirs
946 (mapconcat 'identity subdirs " "))
947 nil) ;; we change default-directory to dir
948 (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ")
949 grep-tree-ignore-case))
950 (default-directory dir)
951 (null-device nil)) ; see grep
952 (grep command-args)))
953
954(defcustom compilation-scroll-output nil 593(defcustom compilation-scroll-output nil
955 "*Non-nil to scroll the *compilation* buffer window as output appears. 594 "*Non-nil to scroll the *compilation* buffer window as output appears.
956 595
@@ -986,15 +625,20 @@ Otherwise, construct a buffer name from MODE-NAME."
986 error-regexp-alist name-function 625 error-regexp-alist name-function
987 enter-regexp-alist leave-regexp-alist 626 enter-regexp-alist leave-regexp-alist
988 file-regexp-alist nomessage-regexp-alist 627 file-regexp-alist nomessage-regexp-alist
989 no-async) 628 no-async highlight-regexp local-map)
990 "Run compilation command COMMAND (low level interface). 629 "Run compilation command COMMAND (low level interface).
991ERROR-MESSAGE is a string to print if the user asks to see another error 630ERROR-MESSAGE is a string to print if the user asks to see another error
992and there are no more errors. The rest of the arguments, 3-10 are optional. 631and there are no more errors.
993For them nil means use the default. 632
633The rest of the arguments are optional; for them, nil means use the default.
634
994NAME-OF-MODE is the name to display as the major mode in the compilation 635NAME-OF-MODE is the name to display as the major mode in the compilation
995buffer. PARSER is the error parser function. ERROR-REGEXP-ALIST is the error 636buffer.
996message regexp alist to use. NAME-FUNCTION is a function called to name the 637
997buffer. ENTER-REGEXP-ALIST is the enter directory message regexp alist to use. 638PARSER is the error parser function.
639ERROR-REGEXP-ALIST is the error message regexp alist to use.
640NAME-FUNCTION is a function called to name the buffer.
641ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
998LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use. 642LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use.
999FILE-REGEXP-ALIST is the change current file message regexp alist to use. 643FILE-REGEXP-ALIST is the change current file message regexp alist to use.
1000NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use. 644NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
@@ -1007,6 +651,12 @@ For arg 7-10 a value t means an empty alist.
1007 651
1008If NO-ASYNC is non-nil, start the compilation process synchronously. 652If NO-ASYNC is non-nil, start the compilation process synchronously.
1009 653
654If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
655matching section of the visited source line; the default is to use the
656global value of `compilation-highlight-regexp'.
657
658If LOCAL-MAP is non-nil, use the given keymap instead of `compilation-mode-map'.
659
1010Returns the compilation buffer created." 660Returns the compilation buffer created."
1011 (unless no-async 661 (unless no-async
1012 (setq no-async (not (fboundp 'start-process)))) 662 (setq no-async (not (fboundp 'start-process))))
@@ -1046,6 +696,8 @@ Returns the compilation buffer created."
1046 (setq file-regexp-alist compilation-file-regexp-alist)) 696 (setq file-regexp-alist compilation-file-regexp-alist))
1047 (or nomessage-regexp-alist 697 (or nomessage-regexp-alist
1048 (setq nomessage-regexp-alist compilation-nomessage-regexp-alist)) 698 (setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
699 (or highlight-regexp
700 (setq highlight-regexp compilation-highlight-regexp))
1049 (or parser (setq parser compilation-parse-errors-function)) 701 (or parser (setq parser compilation-parse-errors-function))
1050 (let ((thisdir default-directory) 702 (let ((thisdir default-directory)
1051 outwin) 703 outwin)
@@ -1069,6 +721,8 @@ Returns the compilation buffer created."
1069 (setq outwin (display-buffer outbuf nil t)) 721 (setq outwin (display-buffer outbuf nil t))
1070 (with-current-buffer outbuf 722 (with-current-buffer outbuf
1071 (compilation-mode name-of-mode) 723 (compilation-mode name-of-mode)
724 (if local-map
725 (use-local-map local-map))
1072 ;; In what way is it non-ergonomic ? -stef 726 ;; In what way is it non-ergonomic ? -stef
1073 ;; (toggle-read-only 1) ;;; Non-ergonomic. 727 ;; (toggle-read-only 1) ;;; Non-ergonomic.
1074 (set (make-local-variable 'compilation-parse-errors-function) parser) 728 (set (make-local-variable 'compilation-parse-errors-function) parser)
@@ -1083,23 +737,29 @@ Returns the compilation buffer created."
1083 file-regexp-alist) 737 file-regexp-alist)
1084 (set (make-local-variable 'compilation-nomessage-regexp-alist) 738 (set (make-local-variable 'compilation-nomessage-regexp-alist)
1085 nomessage-regexp-alist) 739 nomessage-regexp-alist)
740 (set (make-local-variable 'compilation-highlight-regexp)
741 highlight-regexp)
1086 (set (make-local-variable 'compilation-arguments) 742 (set (make-local-variable 'compilation-arguments)
1087 (list command error-message 743 (list command error-message
1088 name-of-mode parser 744 name-of-mode parser
1089 error-regexp-alist name-function 745 error-regexp-alist name-function
1090 enter-regexp-alist leave-regexp-alist 746 enter-regexp-alist leave-regexp-alist
1091 file-regexp-alist nomessage-regexp-alist)) 747 file-regexp-alist nomessage-regexp-alist
748 nil ; or no-async ??
749 highlight-regexp local-map))
1092 ;; This proves a good idea if the buffer's going to scroll 750 ;; This proves a good idea if the buffer's going to scroll
1093 ;; with lazy-lock on. 751 ;; with lazy-lock on.
1094 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t) 752 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
1095 (setq default-directory thisdir 753 (setq default-directory thisdir
1096 compilation-directory-stack (list default-directory)) 754 compilation-directory-stack (list default-directory))
1097 (compilation-set-window-height outwin)
1098 (set-window-start outwin (point-min)) 755 (set-window-start outwin (point-min))
1099 (or (eq outwin (selected-window)) 756 (or (eq outwin (selected-window))
1100 (set-window-point outwin (point-min))) 757 (set-window-point outwin (point-min)))
758 ;; The setup function is called before compilation-set-window-height
759 ;; so it can set the compilation-window-height buffer locally.
1101 (if compilation-process-setup-function 760 (if compilation-process-setup-function
1102 (funcall compilation-process-setup-function)) 761 (funcall compilation-process-setup-function))
762 (compilation-set-window-height outwin)
1103 ;; Start the compilation. 763 ;; Start the compilation.
1104 (if (not no-async) 764 (if (not no-async)
1105 (let* ((process-environment 765 (let* ((process-environment
@@ -1146,27 +806,27 @@ exited abnormally with code %d\n"
1146 (t 806 (t
1147 (compilation-handle-exit 'bizarre status status)))) 807 (compilation-handle-exit 'bizarre status status))))
1148 (message "Executing `%s'...done" command))) 808 (message "Executing `%s'...done" command)))
1149 (if compilation-scroll-output 809 (if (buffer-local-value 'compilation-scroll-output outbuf)
1150 (save-selected-window 810 (save-selected-window
1151 (select-window outwin) 811 (select-window outwin)
1152 (goto-char (point-max))))) 812 (goto-char (point-max)))))
1153 ;; Make it so the next C-x ` will use this buffer. 813 ;; Make it so the next C-x ` will use this buffer.
1154 (setq compilation-last-buffer outbuf))) 814 (setq compilation-last-buffer outbuf)))
1155 815
1156(defun compilation-set-window-height (window) 816(defun compilation-set-window-height (window)
1157 "Set the height of WINDOW according to `compilation-window-height'." 817 "Set the height of WINDOW according to `compilation-window-height'."
1158 (and compilation-window-height 818 (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
1159 (= (window-width window) (frame-width (window-frame window))) 819 (and height
1160 ;; If window is alone in its frame, aside from a minibuffer, 820 (= (window-width window) (frame-width (window-frame window)))
1161 ;; don't change its height. 821 ;; If window is alone in its frame, aside from a minibuffer,
1162 (not (eq window (frame-root-window (window-frame window)))) 822 ;; don't change its height.
1163 ;; This save-current-buffer prevents us from changing the current 823 (not (eq window (frame-root-window (window-frame window))))
1164 ;; buffer, which might not be the same as the selected window's buffer. 824 ;; This save-current-buffer prevents us from changing the current
1165 (save-current-buffer 825 ;; buffer, which might not be the same as the selected window's buffer.
1166 (save-selected-window 826 (save-current-buffer
1167 (select-window window) 827 (save-selected-window
1168 (enlarge-window (- compilation-window-height 828 (select-window window)
1169 (window-height))))))) 829 (enlarge-window (- height (window-height))))))))
1170 830
1171(defvar compilation-menu-map 831(defvar compilation-menu-map
1172 (let ((map (make-sparse-keymap "Errors"))) 832 (let ((map (make-sparse-keymap "Errors")))
@@ -1174,11 +834,11 @@ exited abnormally with code %d\n"
1174 '("Stop Compilation" . kill-compilation)) 834 '("Stop Compilation" . kill-compilation))
1175 (define-key map [compilation-mode-separator2] 835 (define-key map [compilation-mode-separator2]
1176 '("----" . nil)) 836 '("----" . nil))
1177 (define-key map [compilation-mode-first-error] 837 (define-key map [compilation-first-error]
1178 '("First Error" . first-error)) 838 '("First Error" . first-error))
1179 (define-key map [compilation-mode-previous-error] 839 (define-key map [compilation-previous-error]
1180 '("Previous Error" . previous-error)) 840 '("Previous Error" . previous-error))
1181 (define-key map [compilation-mode-next-error] 841 (define-key map [compilation-next-error]
1182 '("Next Error" . next-error)) 842 '("Next Error" . next-error))
1183 map)) 843 map))
1184 844
@@ -1217,16 +877,17 @@ exited abnormally with code %d\n"
1217 (set-keymap-parent map compilation-minor-mode-map) 877 (set-keymap-parent map compilation-minor-mode-map)
1218 (define-key map " " 'scroll-up) 878 (define-key map " " 'scroll-up)
1219 (define-key map "\^?" 'scroll-down) 879 (define-key map "\^?" 'scroll-down)
880
1220 ;; Set up the menu-bar 881 ;; Set up the menu-bar
1221 (define-key map [menu-bar compilation] 882 (define-key map [menu-bar compilation]
1222 (cons "Compile" (make-sparse-keymap "Compile"))) 883 (cons "Compile" (make-sparse-keymap "Compile")))
1223 (define-key map [menu-bar compilation compilation-separator2] 884 (define-key map [menu-bar compilation compilation-separator2]
1224 '("----" . nil)) 885 '("----" . nil))
1225 (define-key map [menu-bar compilation compilation-mode-grep] 886 (define-key map [menu-bar compilation compilation-grep]
1226 '("Search Files (grep)" . grep)) 887 '("Search Files (grep)" . grep))
1227 (define-key map [menu-bar compilation compilation-mode-recompile] 888 (define-key map [menu-bar compilation compilation-recompile]
1228 '("Recompile" . recompile)) 889 '("Recompile" . recompile))
1229 (define-key map [menu-bar compilation compilation-mode-compile] 890 (define-key map [menu-bar compilation compilation-compile]
1230 '("Compile..." . compile)) 891 '("Compile..." . compile))
1231 map) 892 map)
1232 "Keymap for compilation log buffers. 893 "Keymap for compilation log buffers.
@@ -1257,7 +918,7 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
1257(defun compilation-revert-buffer (ignore-auto noconfirm) 918(defun compilation-revert-buffer (ignore-auto noconfirm)
1258 (if buffer-file-name 919 (if buffer-file-name
1259 (let (revert-buffer-function) 920 (let (revert-buffer-function)
1260 (revert-buffer ignore-auto noconfirm preserve-modes)) 921 (revert-buffer ignore-auto noconfirm))
1261 (if (or noconfirm (yes-or-no-p (format "Restart compilation? "))) 922 (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
1262 (apply 'compile-internal compilation-arguments)))) 923 (apply 'compile-internal compilation-arguments))))
1263 924
@@ -1449,6 +1110,23 @@ Does NOT find the source line like \\[next-error]."
1449 (interactive "p") 1110 (interactive "p")
1450 (compilation-next-error (- n))) 1111 (compilation-next-error (- n)))
1451 1112
1113(defun next-error-no-select (n)
1114 "Move point to the next error in the compilation buffer and highlight match.
1115Prefix arg N says how many error messages to move forwards.
1116Finds and highlights the source line like \\[next-error], but does not
1117select the source buffer."
1118 (interactive "p")
1119 (next-error n)
1120 (pop-to-buffer compilation-last-buffer))
1121
1122(defun previous-error-no-select (n)
1123 "Move point to the previous error in the compilation buffer and highlight match.
1124Prefix arg N says how many error messages to move forwards.
1125Finds and highlights the source line like \\[next-error], but does not
1126select the source buffer."
1127 (interactive "p")
1128 (next-error (- n))
1129 (pop-to-buffer compilation-last-buffer))
1452 1130
1453;; Given an elt of `compilation-error-list', return an object representing 1131;; Given an elt of `compilation-error-list', return an object representing
1454;; the referenced file which is equal to (but not necessarily eq to) what 1132;; the referenced file which is equal to (but not necessarily eq to) what
@@ -1961,10 +1639,31 @@ Selects a window with point at SOURCE, with another window displaying ERROR."
1961 ;; Use an existing window if it is in a visible frame. 1639 ;; Use an existing window if it is in a visible frame.
1962 (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible) 1640 (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
1963 ;; Pop up a window. 1641 ;; Pop up a window.
1964 (display-buffer (marker-buffer (car next-error)))))) 1642 (display-buffer (marker-buffer (car next-error)))))
1643 (highlight-regexp (with-current-buffer (marker-buffer (car next-error))
1644 compilation-highlight-regexp)))
1965 (set-window-point w (car next-error)) 1645 (set-window-point w (car next-error))
1966 (set-window-start w (car next-error)) 1646 (set-window-start w (car next-error))
1967 (compilation-set-window-height w))) 1647 (compilation-set-window-height w)
1648
1649 (when highlight-regexp
1650 (unless compilation-highlight-overlay
1651 (setq compilation-highlight-overlay (make-overlay 1 1))
1652 (overlay-put compilation-highlight-overlay 'face 'region))
1653 (with-current-buffer (marker-buffer (cdr next-error))
1654 (save-excursion
1655 (end-of-line)
1656 (let ((end (point)) olay)
1657 (beginning-of-line)
1658 (if (and (stringp highlight-regexp)
1659 (re-search-forward highlight-regexp end t))
1660 (progn
1661 (goto-char (match-beginning 0))
1662 (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
1663 (move-overlay compilation-highlight-overlay (point) end))
1664 (sit-for 0 500)
1665 (delete-overlay compilation-highlight-overlay)))))))
1666
1968 1667
1969(defun compilation-find-file (marker filename dir &rest formats) 1668(defun compilation-find-file (marker filename dir &rest formats)
1970 "Find a buffer for file FILENAME. 1669 "Find a buffer for file FILENAME.