/[emacs]/emacs/lisp/progmodes/compile.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/compile.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.256 by kfstorm, Thu May 30 22:11:29 2002 UTC revision 1.256.2.1 by miles, Fri Apr 4 06:20:32 2003 UTC
# Line 66  will be parsed and highlighted as soon a Line 66  will be parsed and highlighted as soon a
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
# Line 143  include it when specifying `grep-command Line 74  include it when specifying `grep-command
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.
# Line 158  necessary if the grep program used suppo Line 87  necessary if the grep program used suppo
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
# Line 184  The following place holders should be pr Line 110  The following place holders should be pr
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 '(
# Line 325  or when it is used with \\[next-error] o Line 249  or when it is used with \\[next-error] o
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.
# Line 370  or when it is used with \\[next-error] o Line 294  or when it is used with \\[next-error] o
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]*$"
# Line 522  subexpression.") Line 452  subexpression.")
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.
# Line 534  The default value matches lines printed Line 466  The default value matches lines printed
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.
# Line 619  This variable's value takes effect when Line 553  This variable's value takes effect when
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.")
# Line 751  original use.  Otherwise, it recompiles Line 685  original use.  Otherwise, it recompiles
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.
# Line 767  tag the cursor is over, substituting it Line 798  tag the cursor is over, substituting it
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.
# Line 856  easily repeat a find command." Line 875  easily repeat a find command."
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
# Line 889  easily repeat a find command." Line 917  easily repeat a find command."
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)
# Line 922  Likewise if `compilation-buffer-name-fun Line 954  Likewise if `compilation-buffer-name-fun
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)))
# Line 937  Otherwise, construct a buffer name from Line 969  Otherwise, construct a buffer name from
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.
# Line 956  NOMESSAGE-REGEXP-ALIST is the nomessage Line 989  NOMESSAGE-REGEXP-ALIST is the nomessage
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
# Line 1049  Returns the compilation buffer created." Line 1086  Returns the compilation buffer created."
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)
# Line 1121  exited abnormally with code %d\n" Line 1158  exited abnormally with code %d\n"
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)
# Line 1131  exited abnormally with code %d\n" Line 1182  exited abnormally with code %d\n"
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    
# Line 1143  exited abnormally with code %d\n" Line 1197  exited abnormally with code %d\n"
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    
# Line 1211  Runs `compilation-mode-hook' with `run-h Line 1245  Runs `compilation-mode-hook' with `run-h
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."
# Line 1226  Runs `compilation-mode-hook' with `run-h Line 1263  Runs `compilation-mode-hook' with `run-h
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."
# Line 1563  Does NOT find the source line like \\[ne Line 1567  Does NOT find the source line like \\[ne
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
# Line 1570  Does NOT find the source line like \\[ne Line 1575  Does NOT find the source line like \\[ne
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)
# Line 1988  Pop up the buffer containing MARKER and Line 1994  Pop up the buffer containing MARKER and
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.
# Line 2132  See variable `compilation-parse-errors-f Line 2166  See variable `compilation-parse-errors-f
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))))
# Line 2227  An error message with no file name and n Line 2238  An error message with no file name and n
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))

Legend:
Removed from v.1.256  
changed lines
  Added in v.1.256.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26