/[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.276.2.1 by handa, Fri Apr 16 12:50:34 2004 UTC revision 1.276.2.2 by miles, Mon Jun 28 07:29:42 2004 UTC
# Line 100  in the compilation output, and should re Line 100  in the compilation output, and should re
100  ;;;###autoload  ;;;###autoload
101  (defvar compilation-process-setup-function nil  (defvar compilation-process-setup-function nil
102    "*Function to call to customize the compilation process.    "*Function to call to customize the compilation process.
103  This functions is called immediately before the compilation process is  This function is called immediately before the compilation process is
104  started.  It can be used to set any variables or functions that are used  started.  It can be used to set any variables or functions that are used
105  while processing the output of the compilation process.  The function  while processing the output of the compilation process.  The function
106  is called with variables `compilation-buffer' and `compilation-window'  is called with variables `compilation-buffer' and `compilation-window'
# Line 125  describing how the process finished.") Line 125  describing how the process finished.")
125  Each function is called with two arguments: the compilation buffer,  Each function is called with two arguments: the compilation buffer,
126  and a string describing how the process finished.")  and a string describing how the process finished.")
127    
 (defvar compilation-last-buffer nil  
   "The most recent compilation buffer.  
 A buffer becomes most recent when its compilation is started  
 or when it is used with \\[next-error] or \\[compile-goto-error].")  
   
128  (defvar compilation-in-progress nil  (defvar compilation-in-progress nil
129    "List of compilation processes now running.")    "List of compilation processes now running.")
130  (or (assq 'compilation-in-progress minor-mode-alist)  (or (assq 'compilation-in-progress minor-mode-alist)
# Line 176  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 171  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
171       "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\       "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
172  \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))  \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
173    
174        (edg-1
175         "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
176         1 2 nil (3 . 4))
177        (edg-2
178         "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
179         2 1 nil 0)
180    
181      (epc      (epc
182       "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)       "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
183    
184      (iar      (iar
185       "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"       "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
# Line 187  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 189  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
189       "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\       "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
190   \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))   \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
191    
192        ;; fixme: should be `mips'
193      (irix      (irix
194       "^[a-z0-9/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\       "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
195   \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))   \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
196    
197      (java      (java
# Line 206  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 209  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
209  \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))  \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
210    
211      (gnu      (gnu
212       "^\\(?:[a-zA-Z][-a-zA-Z0-9.]+: ?\\)?\       "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
213  \\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\  \\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
214  \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\  \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
215  \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\  \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
216  \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\  \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
# Line 228  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 231  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
231        (1 (compilation-error-properties 2 3 nil nil nil 0 nil)        (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
232           append)))           append)))
233    
234        ;; Should be lint-1, lint-2 (SysV lint)
235      (mips-1      (mips-1
236       " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)       " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
237      (mips-2      (mips-2
# Line 238  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 242  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
242  : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))  : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
243    
244      (oracle      (oracle
245       "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$"       "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
246    \\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
247    \\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
248       3 1 2)       3 1 2)
249    
250      (perl      (perl
# Line 261  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"? Line 267  of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?
267       nil 1 nil (3) nil (2 (compilation-face '(3))))       nil 1 nil (3) nil (2 (compilation-face '(3))))
268    
269      (sun      (sun
270       ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[a-zA-Z0-9 ]+, \\)?\       ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
271  File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"  File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
272       3 4 5 (1 . 2))       3 4 5 (1 . 2))
273    
274      (sun-ada      (sun-ada
275       "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)       "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
276    
     (ultrix  
      "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))  
   
277      (4bsd      (4bsd
278       "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\       "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
279  \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))  \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
# Line 279  File = \\(.+\\), Line = \\([0-9]+\\)\\(? Line 282  File = \\(.+\\), Line = \\([0-9]+\\)\\(?
282  (defcustom compilation-error-regexp-alist  (defcustom compilation-error-regexp-alist
283    (mapcar 'car compilation-error-regexp-alist-alist)    (mapcar 'car compilation-error-regexp-alist-alist)
284    "Alist that specifies how to match errors in compiler output.    "Alist that specifies how to match errors in compiler output.
285  Note that on Unix exerything is a valid filename, so these  Note that on Unix everything is a valid filename, so these
286  matchers must make some common sense assumptions, which catch  matchers must make some common sense assumptions, which catch
287  normal cases.  A shorter list will be lighter on resource usage.  normal cases.  A shorter list will be lighter on resource usage.
288    
289  Instead of an alist element, you can use a symbol, which is  Instead of an alist element, you can use a symbol, which is
290  looked up in `compilation-error-regexp-alist-alist'.  You can see  looked up in `compilation-error-regexp-alist-alist'.  You can see
291  the predefined symbols and their effects in the file  the predefined symbols and their effects in the file
292  `etc/compilation.txt' (linked below if your are customizing this).  `etc/compilation.txt' (linked below if you are customizing this).
293    
294  Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK  Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
295  HIGHLIGHT...]).  If REGEXP matches, the FILE'th subexpression  HIGHLIGHT...]).  If REGEXP matches, the FILE'th subexpression
# Line 328  be added." Line 331  be added."
331                            (list 'const (car elt)))                            (list 'const (car elt)))
332                          compilation-error-regexp-alist-alist))                          compilation-error-regexp-alist-alist))
333    :link `(file-link :tag "example file"    :link `(file-link :tag "example file"
334                      ,(concat doc-directory "compilation.txt"))                      ,(expand-file-name "compilation.txt" data-directory))
335    :group 'compilation)    :group 'compilation)
336    
337  (defvar compilation-directory nil  (defvar compilation-directory nil
# Line 357  you may also want to change `compilation Line 360  you may also want to change `compilation
360        (1 font-lock-variable-name-face)        (1 font-lock-variable-name-face)
361        (2 (compilation-face '(4 . 3))))        (2 (compilation-face '(4 . 3))))
362       ;; Command output lines.  Recognize `make[n]:' lines too.       ;; Command output lines.  Recognize `make[n]:' lines too.
363       ("^\\([A-Za-z_0-9/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"       ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
364        (1 font-lock-function-name-face) (3 compilation-line-face nil t))        (1 font-lock-function-name-face) (3 compilation-line-face nil t))
365       (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)       (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1)
366       ("^Compilation finished" . compilation-info-face)       ("^Compilation finished" . compilation-info-face)
# Line 427  You might also use mode hooks to specify Line 430  You might also use mode hooks to specify
430  (defvar compilation-locs ())  (defvar compilation-locs ())
431    
432  (defvar compilation-debug nil  (defvar compilation-debug nil
433    "*Set this to `t' before creating a *compilation* buffer.    "*Set this to t before creating a *compilation* buffer.
434  Then every error line will have a debug text property with the matcher that  Then every error line will have a debug text property with the matcher that
435  fit this line and the match data.  Use `describe-text-properties'.")  fit this line and the match data.  Use `describe-text-properties'.")
436    
# Line 447  starting the compilation process.") Line 450  starting the compilation process.")
450  (defvar compile-history nil)  (defvar compile-history nil)
451    
452  (defface compilation-warning-face  (defface compilation-warning-face
453    '((((type tty) (class color)) (:foreground "cyan" :weight bold))    '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
454      (((class color)) (:foreground "Orange" :weight bold))      (((class color)) (:foreground "cyan" :weight bold))
455      (t (:weight bold)))      (t (:weight bold)))
456    "Face used to highlight compiler warnings."    "Face used to highlight compiler warnings."
457    :group 'font-lock-highlighting-faces    :group 'font-lock-highlighting-faces
458    :version "21.4")    :version "21.4")
459    
460  (defface compilation-info-face  (defface compilation-info-face
461    '((((type tty) (class color)) (:foreground "green" :weight bold))    '((((class color) (min-colors 16) (background light))
462      (((class color) (background light)) (:foreground "Green3" :weight bold))       (:foreground "Green3" :weight bold))
463      (((class color) (background dark)) (:foreground "Green" :weight bold))      (((class color) (min-colors 16) (background dark))
464         (:foreground "Green" :weight bold))
465        (((class color)) (:foreground "green" :weight bold))
466      (t (:weight bold)))      (t (:weight bold)))
467    "Face used to highlight compiler warnings."    "Face used to highlight compiler warnings."
468    :group 'font-lock-highlighting-faces    :group 'font-lock-highlighting-faces
# Line 494  Faces `compilation-error-face', `compila Line 499  Faces `compilation-error-face', `compila
499    
500    
501  ;; Used for compatibility with the old compile.el.  ;; Used for compatibility with the old compile.el.
502  (defvar compilation-parsing-end nil)  (defvaralias 'compilation-last-buffer 'next-error-last-buffer)
503    (defvar compilation-parsing-end (make-marker))
504  (defvar compilation-parse-errors-function nil)  (defvar compilation-parse-errors-function nil)
505  (defvar compilation-error-list nil)  (defvar compilation-error-list nil)
506  (defvar compilation-old-error-list nil)  (defvar compilation-old-error-list nil)
# Line 518  Faces `compilation-error-face', `compila Line 524  Faces `compilation-error-face', `compila
524                           '(nil))        ; nil only isn't a property-change                           '(nil))        ; nil only isn't a property-change
525                     (cons (match-string-no-properties idx) dir))                     (cons (match-string-no-properties idx) dir))
526        mouse-face highlight        mouse-face highlight
527          keymap compilation-button-map
528        help-echo "mouse-2: visit current directory")))        help-echo "mouse-2: visit current directory")))
529    
530  ;; Data type `reverse-ordered-alist' retriever.  This function retrieves the  ;; Data type `reverse-ordered-alist' retriever.  This function retrieves the
# Line 528  Faces `compilation-error-face', `compila Line 535  Faces `compilation-error-face', `compila
535  ;; may be nil.  The other KEYs are ordered backwards so that growing line  ;; may be nil.  The other KEYs are ordered backwards so that growing line
536  ;; numbers can be inserted in front and searching can abort after half the  ;; numbers can be inserted in front and searching can abort after half the
537  ;; list on average.  ;; list on average.
538    (eval-when-compile                  ;Don't keep it at runtime if not needed.
539  (defmacro compilation-assq (key alist)  (defmacro compilation-assq (key alist)
540    `(let* ((l1 ,alist)    `(let* ((l1 ,alist)
541            (l2 (cdr l1)))            (l2 (cdr l1)))
# Line 538  Faces `compilation-error-face', `compila Line 546  Faces `compilation-error-face', `compila
546                          l2 (cdr l1)))                          l2 (cdr l1)))
547                  (if l2 (eq ,key (caar l2))))                  (if l2 (eq ,key (caar l2))))
548                l2                l2
549              (setcdr l1 (cons (list ,key) l2))))))              (setcdr l1 (cons (list ,key) l2)))))))
550    
551    
552  ;; This function is the central driver, called when font-locking to gather  ;; This function is the central driver, called when font-locking to gather
# Line 556  Faces `compilation-error-face', `compila Line 564  Faces `compilation-error-face', `compila
564                (setq dir (previous-single-property-change (point) 'directory)                (setq dir (previous-single-property-change (point) 'directory)
565                      dir (if dir (or (get-text-property (1- dir) 'directory)                      dir (if dir (or (get-text-property (1- dir) 'directory)
566                                      (get-text-property dir 'directory)))))                                      (get-text-property dir 'directory)))))
567              (setq file (cons file (car dir)) ; top of dir stack is current              (setq file (cons file (car dir)))))
                   file (or (gethash file compilation-locs)  
                            (puthash file (list file fmt) compilation-locs)))))  
568        ;; This message didn't mention one, get it from previous        ;; This message didn't mention one, get it from previous
569        (setq file (previous-single-property-change (point) 'message)        (setq file (previous-single-property-change (point) 'message)
570              file (or (if file              file (or (if file
571                           (nth 2 (car (or (get-text-property (1- file) 'message)                           (car (nth 2 (car (or (get-text-property (1- file) 'message)
572                                           (get-text-property file 'message)))))                                           (get-text-property file 'message))))))
573                       ;; no previous either -- let font-lock continue                       '("*unknown*"))))
                      (gethash (setq file '("*unknown*")) compilation-locs)  
                      (puthash file (list file fmt) compilation-locs))))  
574      ;; All of these fields are optional, get them only if we have an index, and      ;; All of these fields are optional, get them only if we have an index, and
575      ;; it matched some part of the message.      ;; it matched some part of the message.
576      (and line      (and line
# Line 579  Faces `compilation-error-face', `compila Line 583  Faces `compilation-error-face', `compila
583           (setq col (match-string-no-properties col))           (setq col (match-string-no-properties col))
584           (setq col (- (string-to-number col) compilation-first-column)))           (setq col (- (string-to-number col) compilation-first-column)))
585      (if (and end-col (setq end-col (match-string-no-properties end-col)))      (if (and end-col (setq end-col (match-string-no-properties end-col)))
586          (setq end-col (- (string-to-number end-col) compilation-first-column))          (setq end-col (- (string-to-number end-col) compilation-first-column -1))
587        (if end-line (setq end-col -1)))        (if end-line (setq end-col -1)))
588      (if (consp type)                    ; not a preset type, check what it is.      (if (consp type)                    ; not a static type, check what it is.
589          (setq type (or (and (car type) (match-end (car type)) 1)          (setq type (or (and (car type) (match-end (car type)) 1)
590                         (and (cdr type) (match-end (cdr type)) 0)                         (and (cdr type) (match-end (cdr type)) 0)
591                         2)))                         2)))
592      ;; Get any (first) already existing marker (if any has one, all have one).      (compilation-internal-error-properties file line end-line col end-col type fmt)))
593      ;; Do this first, as the next assq`s may create new nodes.  
594      (let ((marker (nth 3 (car (cdar (cddr file)))))  (defun compilation-internal-error-properties (file line end-line col end-col type fmt)
595            (loc (compilation-assq line (cdr file)))    "Get the meta-info that will be added as text-properties.
596            end-loc)  LINE, END-LINE, COL, END-COL are integers or nil.
597        (if end-line  TYPE can be 0, 1, or 2.
598            (setq end-loc (compilation-assq end-line (cdr file))  FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
599                  end-loc (compilation-assq end-col end-loc))    (unless file (setq file '("*unknown*")))
600          (if end-col                     ; use same line element    (setq file (compilation-get-file-structure file fmt))
601              (setq end-loc (compilation-assq end-col loc))))    ;; Get first already existing marker (if any has one, all have one).
602        (setq loc (compilation-assq col loc))    ;; Do this first, as the compilation-assq`s may create new nodes.
603        ;; If they are new, make the loc(s) reference the file they point to.    (let* ((marker-line (car (cddr file)))        ; a line structure
604        (or (cdr loc) (setcdr loc (list line file)))           (marker (nth 3 (cadr marker-line)))    ; its marker
605        (if end-loc           (compilation-error-screen-columns compilation-error-screen-columns)
606            (or (cdr end-loc) (setcdr end-loc (list (or end-line line) file))))           end-marker loc end-loc)
607        ;; If we'd found a marker, ensure that the new locs also get markers      (if (not (and marker (marker-buffer marker)))
608        (when (and marker          (setq marker)                   ; no valid marker for this file
609                   (not (or (cddr loc) (cddr end-loc))) ; maybe new node w/o marker        (setq loc (or line 1))            ; normalize no linenumber to line 1
610                   (marker-buffer marker)) ; other marker still valid        (catch 'marker                    ; find nearest loc, at least one exists
611          (or line (setq line 1))          ; normalize no linenumber to line 1          (dolist (x (nthcdr 3 file))     ; loop over remaining lines
612          (catch 'marker                 ; find nearest loc, at least one exists            (if (> (car x) loc)           ; still bigger
613            (dolist (x (cddr file))                (setq marker-line x)
614              (if (> (or (car x) 1) line)              (if (> (- (or (car marker-line) 1) loc)
615                  (setq marker x)                     (- loc (car x)))     ; current line is nearer
616                (if (eq (or (car x) 1) line)                  (setq marker-line x))
617                    (if (cdr (cddr x))    ; at least one other column              (throw 'marker t))))
618                        (throw 'marker (setq marker x))        (setq marker (nth 3 (cadr marker-line))
619                      (if marker (throw 'marker t)))              marker-line (or (car marker-line) 1))
620                  (throw 'marker (or marker (setq marker x)))))))        (with-current-buffer (marker-buffer marker)
621          (setq marker (if (eq (car (cddr marker)) col)          (save-restriction
622                           (nthcdr 3 marker)            (widen)
623                         (cddr marker))            (goto-char (marker-position marker))
624                file compilation-error-screen-columns)            (when (or end-col end-line)
625          (with-current-buffer (marker-buffer (cddr marker))              (beginning-of-line (- (or end-line line) marker-line -1))
626            (save-restriction              (if (< end-col 0)
627              (widen)                  (end-of-line)
628              (goto-char (marker-position (cddr marker)))                (if compilation-error-screen-columns
629              (beginning-of-line (- line (car (cadr marker)) -1))                    (move-to-column end-col)
630              (if file                    ; original c.-error-screen-columns                  (forward-char end-col)))
631                  (move-to-column (car loc))              (setq end-marker (list (point-marker))))
632                (forward-char (car loc)))            (beginning-of-line (if end-line
633              (setcdr (cdr loc) (point-marker))                                   (- end-line line -1)
634              (when end-loc                                 (- loc marker-line -1)))
635                (beginning-of-line (- end-line line -1))            (if col
636                (if (< end-col 0)                (if compilation-error-screen-columns
637                    (end-of-line)                    (move-to-column col)
638                  (if file                ; original c.-error-screen-columns                  (forward-char col))
639                      (move-to-column (car end-loc))              (forward-to-indentation 0))
640                    (forward-char (car end-loc))))            (setq marker (list (point-marker))))))
641                (setcdr (cdr end-loc) (point-marker))))))  
642        ;; Must start with face      (setq loc (compilation-assq line (cdr file)))
643        `(face ,compilation-message-face      (if end-line
644               message (,loc ,type ,end-loc)          (setq end-loc (compilation-assq end-line (cdr file))
645               ,@(if compilation-debug                end-loc (compilation-assq end-col end-loc))
646                     `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)        (if end-col                       ; use same line element
647                              ,@(match-data))))            (setq end-loc (compilation-assq end-col loc))))
648               help-echo ,(if col      (setq loc (compilation-assq col loc))
649                              "mouse-2: visit this file, line and column"      ;; If they are new, make the loc(s) reference the file they point to.
650                            (if line      (or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
651                                "mouse-2: visit this file and line"      (if end-loc
652                              "mouse-2: visit this file"))          (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
653               keymap compilation-button-map  
654               mouse-face highlight))))      ;; Must start with face
655        `(face ,compilation-message-face
656               message (,loc ,type ,end-loc)
657               ,@(if compilation-debug
658                     `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
659                              ,@(match-data))))
660               help-echo ,(if col
661                              "mouse-2: visit this file, line and column"
662                            (if line
663                                "mouse-2: visit this file and line"
664                              "mouse-2: visit this file"))
665               keymap compilation-button-map
666               mouse-face highlight)))
667    
668  (defun compilation-mode-font-lock-keywords ()  (defun compilation-mode-font-lock-keywords ()
669    "Return expressions to highlight in Compilation mode."    "Return expressions to highlight in Compilation mode."
# Line 686  Faces `compilation-error-face', `compila Line 702  Faces `compilation-error-face', `compila
702                ;; error location.  Let's do our best.                ;; error location.  Let's do our best.
703                `(,(car item)                `(,(car item)
704                  (0 (compilation-compat-error-properties                  (0 (compilation-compat-error-properties
705                      (funcall ',line (list* (match-string ,file)                      (funcall ',line (cons (match-string ,file)
706                                             default-directory                                            (cons default-directory
707                                             ',(nthcdr 4 item))                                                  ',(nthcdr 4 item)))
708                               ,(if col `(match-string ,col)))))                               ,(if col `(match-string ,col)))))
709                  (,file compilation-error-face t))                  (,file compilation-error-face t))
710    
711                (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
712                  (error "HYPERLINK should be an integer: %s" (nth 5 item)))
713    
714              `(,(nth 0 item)              `(,(nth 0 item)
715    
716                ,@(when (integerp file)                ,@(when (integerp file)
# Line 729  Faces `compilation-error-face', `compila Line 748  Faces `compilation-error-face', `compila
748  Runs COMMAND, a shell command, in a separate process asynchronously  Runs COMMAND, a shell command, in a separate process asynchronously
749  with output going to the buffer `*compilation*'.  with output going to the buffer `*compilation*'.
750    
751  If optional second arg COMINT is t the buffer will be in comint mode with  If optional second arg COMINT is t the buffer will be in Comint mode with
752  `compilation-shell-minor-mode'.  `compilation-shell-minor-mode'.
753    
754  You can then use the command \\[next-error] to find the next error message  You can then use the command \\[next-error] to find the next error message
# Line 737  and move to the source code that caused Line 756  and move to the source code that caused
756    
757  Interactively, prompts for the command if `compilation-read-command' is  Interactively, prompts for the command if `compilation-read-command' is
758  non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.  non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
759    Additionally, with universal prefix arg, compilation buffer will be in
760    comint mode, i.e. interactive.
761    
762  To run more than one compilation at once, start one and rename  To run more than one compilation at once, start one and rename
763  the \`*compilation*' buffer to some other name with  the \`*compilation*' buffer to some other name with
# Line 748  The name used for the buffer is actually Line 769  The name used for the buffer is actually
769  the function in `compilation-buffer-name-function', so you can set that  the function in `compilation-buffer-name-function', so you can set that
770  to a function that generates a unique name."  to a function that generates a unique name."
771    (interactive    (interactive
772     (if (or compilation-read-command current-prefix-arg)     (list
773         (list (read-from-minibuffer "Compile command: "      (if (or compilation-read-command current-prefix-arg)
774                                   (eval compile-command) nil nil          (read-from-minibuffer "Compile command: "
775                                   '(compile-history . 1)))                                (eval compile-command) nil nil
776       (list (eval compile-command))))                                '(compile-history . 1))
777          (eval compile-command))
778        (consp current-prefix-arg)))
779    (unless (equal command (eval compile-command))    (unless (equal command (eval compile-command))
780      (setq compile-command command))      (setq compile-command command))
781    (save-some-buffers (not compilation-ask-about-save) nil)    (save-some-buffers (not compilation-ask-about-save) nil)
# Line 762  to a function that generates a unique na Line 785  to a function that generates a unique na
785  ;; run compile with the default command line  ;; run compile with the default command line
786  (defun recompile ()  (defun recompile ()
787    "Re-compile the program including the current buffer.    "Re-compile the program including the current buffer.
788  If this is run in a compilation-mode buffer, re-use the arguments from the  If this is run in a Compilation mode buffer, re-use the arguments from the
789  original use.  Otherwise, it recompiles using `compile-command'."  original use.  Otherwise, recompile using `compile-command'."
790    (interactive)    (interactive)
791    (save-some-buffers (not compilation-ask-about-save) nil)    (save-some-buffers (not compilation-ask-about-save) nil)
792    (let ((default-directory (or compilation-directory default-directory)))    (let ((default-directory (or compilation-directory default-directory)))
# Line 773  original use.  Otherwise, it recompiles Line 796  original use.  Otherwise, it recompiles
796  (defcustom compilation-scroll-output nil  (defcustom compilation-scroll-output nil
797    "*Non-nil to scroll the *compilation* buffer window as output appears.    "*Non-nil to scroll the *compilation* buffer window as output appears.
798    
799  Setting it causes the compilation-mode commands to put point at the  Setting it causes the Compilation mode commands to put point at the
800  end of their output window so that the end of the output is always  end of their output window so that the end of the output is always
801  visible rather than the begining."  visible rather than the beginning."
802    :type 'boolean    :type 'boolean
803    :version "20.3"    :version "20.3"
804    :group 'compilation)    :group 'compilation)
# Line 822  Otherwise, construct a buffer name from Line 845  Otherwise, construct a buffer name from
845  The rest of the arguments are optional; for them, nil means use the default.  The rest of the arguments are optional; for them, nil means use the default.
846    
847  MODE is the major mode to set in the compilation buffer.  Mode  MODE is the major mode to set in the compilation buffer.  Mode
848  may also be `t' meaning `compilation-shell-minor-mode' under `comint-mode'.  may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
849  NAME-FUNCTION is a function called to name the buffer.  NAME-FUNCTION is a function called to name the buffer.
850    
851  If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight  If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
852  matching section of the visited source line; the default is to use the  the matching section of the visited source line; the default is to use the
853  global value of `compilation-highlight-regexp'.  global value of `compilation-highlight-regexp'.
854    
855  Returns the compilation buffer created."  Returns the compilation buffer created."
# Line 838  Returns the compilation buffer created." Line 861  Returns the compilation buffer created."
861          (process-environment          (process-environment
862           (append           (append
863            compilation-environment            compilation-environment
864            (if (and (boundp 'system-uses-terminfo)            (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
865                     system-uses-terminfo)                    system-uses-terminfo)
866                (list "TERM=dumb" "TERMCAP="                (list "TERM=dumb" "TERMCAP="
867                      (format "COLUMNS=%d" (window-width)))                      (format "COLUMNS=%d" (window-width)))
868              (list "TERM=emacs"              (list "TERM=emacs"
# Line 903  Returns the compilation buffer created." Line 926  Returns the compilation buffer created."
926             'compilation-revert-buffer)             'compilation-revert-buffer)
927        (set-window-start outwin (point-min))        (set-window-start outwin (point-min))
928        (or (eq outwin (selected-window))        (or (eq outwin (selected-window))
929            (set-window-point outwin (point)))            (set-window-point outwin (if compilation-scroll-output
930                                           (point)
931                                         (point-min))))
932        ;; The setup function is called before compilation-set-window-height        ;; The setup function is called before compilation-set-window-height
933        ;; so it can set the compilation-window-height buffer locally.        ;; so it can set the compilation-window-height buffer locally.
934        (if compilation-process-setup-function        (if compilation-process-setup-function
# Line 930  Returns the compilation buffer created." Line 955  Returns the compilation buffer created."
955          ;; Fake modeline display as if `start-process' were run.          ;; Fake modeline display as if `start-process' were run.
956          (setq mode-line-process ":run")          (setq mode-line-process ":run")
957          (force-mode-line-update)          (force-mode-line-update)
958            (sit-for 0)                     ; Force redisplay
959          (let ((status (call-process shell-file-name nil outbuf nil "-c"          (let ((status (call-process shell-file-name nil outbuf nil "-c"
960                                      command)))                                      command)))
961            (cond ((numberp status)            (cond ((numberp status)
# Line 944  exited abnormally with code %d\n" Line 970  exited abnormally with code %d\n"
970                                            (concat status "\n")))                                            (concat status "\n")))
971                  (t                  (t
972                   (compilation-handle-exit 'bizarre status status))))                   (compilation-handle-exit 'bizarre status status))))
973            ;; Without async subprocesses, the buffer is not yet
974            ;; fontified, so fontify it now.
975            (let ((font-lock-verbose nil))  ; shut up font-lock messages
976              (font-lock-fontify-buffer))
977          (message "Executing `%s'...done" command)))          (message "Executing `%s'...done" command)))
978      (if (buffer-local-value 'compilation-scroll-output outbuf)      (if (buffer-local-value 'compilation-scroll-output outbuf)
979          (save-selected-window          (save-selected-window
980            (select-window outwin)            (select-window outwin)
981            (goto-char (point-max))))            (goto-char (point-max))))
982      ;; Make it so the next C-x ` will use this buffer.      ;; Make it so the next C-x ` will use this buffer.
983      (setq compilation-last-buffer outbuf)))      (setq next-error-last-buffer outbuf)))
984    
985  (defun compilation-set-window-height (window)  (defun compilation-set-window-height (window)
986    "Set the height of WINDOW according to `compilation-window-height'."    "Set the height of WINDOW according to `compilation-window-height'."
# Line 960  exited abnormally with code %d\n" Line 990  exited abnormally with code %d\n"
990           ;; If window is alone in its frame, aside from a minibuffer,           ;; If window is alone in its frame, aside from a minibuffer,
991           ;; don't change its height.           ;; don't change its height.
992           (not (eq window (frame-root-window (window-frame window))))           (not (eq window (frame-root-window (window-frame window))))
993           ;; This save-current-buffer prevents us from changing the current           ;; Stef said that doing the saves in this order is safer:
994           ;; buffer, which might not be the same as the selected window's buffer.           (save-excursion
          (save-current-buffer  
995             (save-selected-window             (save-selected-window
996               (select-window window)               (select-window window)
997               (enlarge-window (- height (window-height))))))))               (enlarge-window (- height (window-height))))))))
# Line 1132  variable exists." Line 1161  variable exists."
1161    "Marker to the location from where the next error will be found.    "Marker to the location from where the next error will be found.
1162  The global commands next/previous/first-error/goto-error use this.")  The global commands next/previous/first-error/goto-error use this.")
1163    
1164    (defvar compilation-messages-start nil
1165      "Buffer position of the beginning of the compilation messages.
1166    If nil, use the beginning of buffer.")
1167    
1168  ;; A function name can't be a hook, must be something with a value.  ;; A function name can't be a hook, must be something with a value.
1169  (defconst compilation-turn-on-font-lock 'turn-on-font-lock)  (defconst compilation-turn-on-font-lock 'turn-on-font-lock)
1170    
1171  (defun compilation-setup (&optional minor)  (defun compilation-setup (&optional minor)
1172    "Prepare the buffer for the compilation parsing commands to work."    "Prepare the buffer for the compilation parsing commands to work.
1173    Optional argument MINOR indicates this is called from
1174    `compilation-minor-mode'."
1175    (make-local-variable 'compilation-current-error)    (make-local-variable 'compilation-current-error)
1176      (make-local-variable 'compilation-messages-start)
1177    (make-local-variable 'compilation-error-screen-columns)    (make-local-variable 'compilation-error-screen-columns)
1178    (make-local-variable 'overlay-arrow-position)    (make-local-variable 'overlay-arrow-position)
1179    (setq compilation-last-buffer (current-buffer))    ;; Note that compilation-next-error-function is for interfacing
1180      ;; with the next-error function in simple.el, and it's only
1181      ;; coincidentally named similarly to compilation-next-error.
1182      (setq next-error-function 'compilation-next-error-function)
1183    (set (make-local-variable 'font-lock-extra-managed-props)    (set (make-local-variable 'font-lock-extra-managed-props)
1184         '(directory message help-echo mouse-face debug))         '(directory message help-echo mouse-face debug))
1185    (set (make-local-variable 'compilation-locs)    (set (make-local-variable 'compilation-locs)
1186         (make-hash-table :test 'equal :weakness 'value))         (make-hash-table :test 'equal :weakness 'value))
1187    ;; lazy-lock would never find the message unless it's scrolled to    ;; lazy-lock would never find the message unless it's scrolled to.
1188    ;; jit-lock might fontify some things too late.    ;; jit-lock might fontify some things too late.
1189    (set (make-local-variable 'font-lock-support-mode) nil)    (set (make-local-variable 'font-lock-support-mode) nil)
1190    (set (make-local-variable 'font-lock-maximum-size) nil)    (set (make-local-variable 'font-lock-maximum-size) nil)
# Line 1193  Turning the mode on runs the normal hook Line 1232  Turning the mode on runs the normal hook
1232      (font-lock-fontify-buffer)))      (font-lock-fontify-buffer)))
1233    
1234  (defun compilation-handle-exit (process-status exit-status msg)  (defun compilation-handle-exit (process-status exit-status msg)
1235    "Write msg in the current buffer and hack its mode-line-process."    "Write MSG in the current buffer and hack its mode-line-process."
1236    (let ((buffer-read-only nil)    (let ((buffer-read-only nil)
1237          (status (if compilation-exit-message-function          (status (if compilation-exit-message-function
1238                      (funcall compilation-exit-message-function                      (funcall compilation-exit-message-function
# Line 1257  Just inserts the text, but uses `insert- Line 1296  Just inserts the text, but uses `insert-
1296              (insert-before-markers string)              (insert-before-markers string)
1297              (run-hooks 'compilation-filter-hook))))))              (run-hooks 'compilation-filter-hook))))))
1298    
1299    ;;; test if a buffer is a compilation buffer, assuming we're in the buffer
1300    (defsubst compilation-buffer-internal-p ()
1301      "Test if inside a compilation buffer."
1302      (local-variable-p 'compilation-locs))
1303    
1304    ;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
1305  (defsubst compilation-buffer-p (buffer)  (defsubst compilation-buffer-p (buffer)
1306    (local-variable-p 'compilation-locs buffer))    "Test if BUFFER is a compilation buffer."
1307      (with-current-buffer buffer
1308        (compilation-buffer-internal-p)))
1309    
1310  (defmacro compilation-loop (< property-change 1+ error)  (defmacro compilation-loop (< property-change 1+ error)
1311    `(while (,< n 0)    `(while (,< n 0)
# Line 1289  Does NOT find the source line like \\[ne Line 1336  Does NOT find the source line like \\[ne
1336    (or (compilation-buffer-p (current-buffer))    (or (compilation-buffer-p (current-buffer))
1337        (error "Not in a compilation buffer"))        (error "Not in a compilation buffer"))
1338    (or pt (setq pt (point)))    (or pt (setq pt (point)))
   (setq compilation-last-buffer (current-buffer))  
1339    (let* ((msg (get-text-property pt 'message))    (let* ((msg (get-text-property pt 'message))
1340           (loc (car msg))           (loc (car msg))
1341           last)           last)
# Line 1327  Does NOT find the source line like \\[pr Line 1373  Does NOT find the source line like \\[pr
1373    (interactive "p")    (interactive "p")
1374    (compilation-next-error (- n)))    (compilation-next-error (- n)))
1375    
 (defun next-error-no-select (n)  
   "Move point to the next error in the compilation buffer and highlight match.  
 Prefix arg N says how many error messages to move forwards (or  
 backwards, if negative).  
 Finds and highlights the source line like \\[next-error], but does not  
 select the source buffer."  
   (interactive "p")  
   (next-error n)  
   (pop-to-buffer compilation-last-buffer))  
   
 (defun previous-error-no-select (n)  
   "Move point to the previous error in the compilation buffer and highlight match.  
 Prefix arg N says how many error messages to move backwards (or  
 forwards, if negative).  
 Finds and highlights the source line like \\[previous-error], but does not  
 select the source buffer."  
   (interactive "p")  
   (next-error-no-select (- n)))  
   
1376  (defun compilation-next-file (n)  (defun compilation-next-file (n)
1377    "Move point to the next error for a different file than the current one.    "Move point to the next error for a different file than the current one.
1378  Prefix arg N says how many files to move forwards (or backwards, if negative)."  Prefix arg N says how many files to move forwards (or backwards, if negative)."
# Line 1383  Use this command in a compilation log bu Line 1410  Use this command in a compilation log bu
1410    
1411  ;; Return a compilation buffer.  ;; Return a compilation buffer.
1412  ;; If the current buffer is a compilation buffer, return it.  ;; If the current buffer is a compilation buffer, return it.
 ;; If compilation-last-buffer is set to a live buffer, use that.  
1413  ;; Otherwise, look for a compilation buffer and signal an error  ;; Otherwise, look for a compilation buffer and signal an error
1414  ;; if there are none.  ;; if there are none.
1415  (defun compilation-find-buffer (&optional other-buffer)  (defun compilation-find-buffer (&optional other-buffer)
1416    (if (and (not other-buffer)    (next-error-find-buffer other-buffer 'compilation-buffer-internal-p))
            (compilation-buffer-p (current-buffer)))  
       ;; The current buffer is a compilation buffer.  
       (current-buffer)  
     (if (and compilation-last-buffer (buffer-name compilation-last-buffer)  
              (compilation-buffer-p compilation-last-buffer)  
              (or (not other-buffer) (not (eq compilation-last-buffer  
                                              (current-buffer)))))  
         compilation-last-buffer  
       (let ((buffers (buffer-list)))  
         (while (and buffers (or (not (compilation-buffer-p (car buffers)))  
                                 (and other-buffer  
                                      (eq (car buffers) (current-buffer)))))  
           (setq buffers (cdr buffers)))  
         (if buffers  
             (car buffers)  
           (or (and other-buffer  
                    (compilation-buffer-p (current-buffer))  
                    ;; The current buffer is a compilation buffer.  
                    (progn  
                      (if other-buffer  
                          (message "This is the only compilation buffer."))  
                      (current-buffer)))  
               (error "No compilation started!")))))))  
1417    
1418  ;;;###autoload  ;;;###autoload
1419  (defun next-error (&optional n)  (defun compilation-next-error-function (n &optional reset)
   "Visit next compilation error message and corresponding source code.  
 Prefix arg N says how many error messages to move forwards (or  
 backwards, if negative).  
   
 \\[next-error] normally uses the most recently started compilation or  
 grep buffer.  However, it can operate on any buffer with output from  
 the \\[compile] and \\[grep] commands, or, more generally, on any  
 buffer in Compilation mode or with Compilation Minor mode enabled.  To  
 specify use of a particular buffer for error messages, type  
 \\[next-error] in that buffer.  
   
 Once \\[next-error] has chosen the buffer for error messages,  
 it stays with that buffer until you use it in some other buffer which  
 uses Compilation mode or Compilation Minor mode.  
   
 See variable `compilation-error-regexp-alist' for customization ideas."  
1420    (interactive "p")    (interactive "p")
1421    (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))    (set-buffer (compilation-find-buffer))
1422      (when reset
1423        (setq compilation-current-error nil))
1424    (let* ((columns compilation-error-screen-columns) ; buffer's local value    (let* ((columns compilation-error-screen-columns) ; buffer's local value
1425           (last 1)           (last 1)
1426           (loc (compilation-next-error (or n 1) nil           (loc (compilation-next-error (or n 1) nil
1427                                        (or compilation-current-error (point-min))))                                        (or compilation-current-error
1428                                              compilation-messages-start
1429                                              (point-min))))
1430           (end-loc (nth 2 loc))           (end-loc (nth 2 loc))
1431           (marker (point-marker)))           (marker (point-marker)))
1432      (setq compilation-current-error (point-marker)      (setq compilation-current-error (point-marker)
1433            overlay-arrow-position            overlay-arrow-position
1434              (if (bolp)              (if (bolp)
1435                  compilation-current-error                  compilation-current-error
1436                (save-excursion                (copy-marker (line-beginning-position)))
                 (beginning-of-line)  
                 (point-marker)))  
1437            loc (car loc))            loc (car loc))
1438      ;; If loc contains no marker, no error in that file has been visited.  If      ;; If loc contains no marker, no error in that file has been visited.  If
1439      ;; the marker is invalid the buffer has been killed.  So, recalculate all      ;; the marker is invalid the buffer has been killed.  So, recalculate all
1440      ;; markers for that file.      ;; markers for that file.
1441      (unless (and (nthcdr 3 loc) (marker-buffer (nth 3 loc)))      (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
1442        (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))        (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
1443                                                    (or (cdar (nth 2 loc))                                                    (or (cdar (nth 2 loc))
1444                                                        default-directory))                                                        default-directory))
# Line 1472  See variable `compilation-error-regexp-a Line 1461  See variable `compilation-error-regexp-a
1461                        (forward-char (car col))))                        (forward-char (car col))))
1462                  (beginning-of-line)                  (beginning-of-line)
1463                  (skip-chars-forward " \t"))                  (skip-chars-forward " \t"))
1464                (if (nthcdr 3 col)                (if (nth 3 col)
1465                    (set-marker (nth 3 col) (point))                    (set-marker (nth 3 col) (point))
1466                  (setcdr (nthcdr 2 col) `(,(point-marker)))))))))                  (setcdr (nthcdr 2 col) `(,(point-marker)))))))))
1467      (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))      (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
1468      (setcdr (nthcdr 3 loc) t)))         ; Set this one as visited.      (setcdr (nthcdr 3 loc) t)))         ; Set this one as visited.
1469    
1470  ;;;###autoload (define-key ctl-x-map "`" 'next-error)  (defvar compilation-gcpro nil
1471      "Internal variable used to keep some values from being GC'd.")
1472  (defun previous-error (n)  (make-variable-buffer-local 'compilation-gcpro)
1473    "Visit previous compilation error message and corresponding source code.  
1474  Prefix arg N says how many error messages to move backwards (or  (defun compilation-fake-loc (marker file &optional line col)
1475  forwards, if negative).    "Preassociate MARKER with FILE.
1476    FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
1477  This operates on the output from the \\[compile] and \\[grep] commands."  This is useful when you compile temporary files, but want
1478    (interactive "p")  automatic translation of the messages to the real buffer from
1479    (next-error (- n)))  which the temporary file came.  This only works if done before a
1480    message about FILE appears!
1481  (defun first-error (n)  
1482    "Restart at the first error.  Optional args LINE and COL default to 1 and beginning of
1483  Visit corresponding source code.  indentation respectively.  The marker is expected to reflect
1484  With prefix arg N, visit the source code of the Nth error.  this.  In the simplest case the marker points to the first line
1485  This operates on the output from the \\[compile] command."  of the region that was saved to the temp file.
1486    (interactive "p")  
1487    (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))  If you concatenate several regions into the temp file (e.g. a
1488    (setq compilation-current-error nil)  header with variable assignments and a code region), you must
1489    (next-error n))  call this several times, once each for the last line of one
1490    region and the first line of the next region."
1491  (defcustom compilation-context-lines next-screen-context-lines    (or (consp file) (setq file (list file)))
1492    "*Display this many lines of leading context before message."    (setq file (compilation-get-file-structure file))
1493    :type 'integer    ;; Between the current call to compilation-fake-loc and the first occurrence
1494      ;; of an error message referring to `file', the data is only kept is the
1495      ;; weak hash-table compilation-locs, so we need to prevent this entry
1496      ;; in compilation-locs from being GC'd away.  --Stef
1497      (push file compilation-gcpro)
1498      (let ((loc (compilation-assq (or line 1) (cdr file))))
1499        (setq loc (compilation-assq col loc))
1500        (if (cdr loc)
1501            (setcdr (cddr loc) (list marker))
1502          (setcdr loc (list line file marker)))
1503        loc))
1504    
1505    (defcustom compilation-context-lines 0
1506      "*Display this many lines of leading context before message.
1507    If nil, don't scroll the compilation output window."
1508      :type '(choice integer (const :tag "No window scrolling" nil))
1509    :group 'compilation    :group 'compilation
1510    :version "21.4")    :version "21.4")
1511    
1512  (defsubst compilation-set-window (w mk)  (defsubst compilation-set-window (w mk)
1513    ;; Align the compilation output window W with marker MK near top.    "Align the compilation output window W with marker MK near top."
1514    (set-window-start w (save-excursion    (if (integerp compilation-context-lines)
1515                          (goto-char mk)        (set-window-start w (save-excursion
1516                          (beginning-of-line (- 1 compilation-context-lines))                              (goto-char mk)
1517                          (point)))                              (beginning-of-line (- 1 compilation-context-lines))
1518                                (point))))
1519    (set-window-point w mk))    (set-window-point w mk))
1520    
1521  (defun compilation-goto-locus (msg mk end-mk)  (defun compilation-goto-locus (msg mk end-mk)
1522    "Jump to an error MESSAGE and SOURCE.    "Jump to an error corresponding to MSG at MK.
1523  All arguments are markers.  If SOURCE-END is non nil, mark is set there."  All arguments are markers.  If END-MK is non nil, mark is set there."
1524    (if (eq (window-buffer (selected-window))    (if (eq (window-buffer (selected-window))
1525            (marker-buffer msg))            (marker-buffer msg))
1526        ;; If the compilation buffer window is selected,        ;; If the compilation buffer window is selected,
# Line 1622  Pop up the buffer containing MARKER and Line 1627  Pop up the buffer containing MARKER and
1627                (overlays-in (point-min) (point-max)))                (overlays-in (point-min) (point-max)))
1628        buffer)))        buffer)))
1629    
1630  (defun compilation-normalize-filename (filename)  (defun compilation-get-file-structure (file &optional fmt)
1631    "Convert a filename string found in an error message to make it usable."    "Retrieve FILE's file-structure or create a new one.
1632    FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
1633    ;; Check for a comint-file-name-prefix and prepend it if  
1634    ;; appropriate.  (This is very useful for    (or (gethash file compilation-locs)
1635    ;; compilation-minor-mode in an rlogin-mode buffer.)        ;; File was not previously encountered, at least not in the form passed.
1636    (and (boundp 'comint-file-name-prefix)        ;; Let's normalize it and look again.
1637         ;; If file name is relative, default-directory will        (let ((filename (car file))
1638         ;; already contain the comint-file-name-prefix (done              (default-directory (if (cdr file)
1639         ;; by compile-abbreviate-directory).                                     (file-truename (cdr file))
1640         (file-name-absolute-p filename)                                   default-directory)))
1641         (setq filename  
1642               (concat (with-no-warnings 'comint-file-name-prefix) filename)))          ;; Check for a comint-file-name-prefix and prepend it if appropriate.
1643            ;; (This is very useful for compilation-minor-mode in an rlogin-mode
1644    ;; If compilation-parse-errors-filename-function is          ;; buffer.)
1645    ;; defined, use it to process the filename.          (if (boundp 'comint-file-name-prefix)
1646    (when compilation-parse-errors-filename-function              (if (file-name-absolute-p filename)
1647      (setq filename                  (setq filename
1648            (funcall compilation-parse-errors-filename-function                        (concat (with-no-warnings comint-file-name-prefix) filename))
1649                     filename)))                (setq default-directory
1650                        (file-truename
1651    ;; Some compilers (e.g. Sun's java compiler, reportedly)                       (concat (with-no-warnings comint-file-name-prefix) default-directory)))))
1652    ;; produce bogus file names like "./bar//foo.c" for file  
1653    ;; "bar/foo.c"; expand-file-name will collapse these into          ;; If compilation-parse-errors-filename-function is
1654    ;; "/foo.c" and fail to find the appropriate file.  So we          ;; defined, use it to process the filename.
1655    ;; look for doubled slashes in the file name and fix them          (when compilation-parse-errors-filename-function
1656    ;; up in the buffer.            (setq filename
1657    (setq filename (command-line-normalize-file-name filename)))                  (funcall compilation-parse-errors-filename-function
1658                             filename)))
1659    
1660  ;; If directory DIR is a subdir of ORIG or of ORIG's parent,          ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
1661  ;; return a relative name for it starting from ORIG or its parent.          ;; file names like "./bar//foo.c" for file "bar/foo.c";
1662  ;; ORIG-EXPANDED is an expanded version of ORIG.          ;; expand-file-name will collapse these into "/foo.c" and fail to find
1663  ;; PARENT-EXPANDED is an expanded version of ORIG's parent.          ;; the appropriate file.  So we look for doubled slashes in the file
1664  ;; Those two args could be computed here, but we run faster by          ;; name and fix them.
1665  ;; having the caller compute them just once.          (setq filename (command-line-normalize-file-name filename))
1666  (defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)  
1667    ;; Apply canonical abbreviations to DIR first thing.          ;; Now eliminate any "..", because find-file would get them wrong.
1668    ;; Those abbreviations are already done in the other arguments passed.          ;; Make relative and absolute filenames, with or without links, the
1669    (setq dir (abbreviate-file-name dir))          ;; same.
1670            (setq filename
1671    ;; Check for a comint-file-name-prefix and prepend it if appropriate.                (list (abbreviate-file-name
1672    ;; (This is very useful for compilation-minor-mode in an rlogin-mode                       (file-truename (if (cdr file)
1673    ;; buffer.)                                          (expand-file-name filename)
1674    (if (boundp 'comint-file-name-prefix)                                        filename)))))
1675        (setq dir (concat comint-file-name-prefix dir)))  
1676            ;; Store it for the possibly unnormalized name
1677    (if (and (> (length dir) (length orig-expanded))          (puthash file
1678             (string= orig-expanded                   ;; Retrieve or create file-structure for normalized name
1679                      (substring dir 0 (length orig-expanded))))                   (or (gethash filename compilation-locs)
1680        (setq dir                       (puthash filename (list filename fmt) compilation-locs))
1681              (concat orig                   compilation-locs))))
                     (substring dir (length orig-expanded)))))  
   (if (and (> (length dir) (length parent-expanded))  
            (string= parent-expanded  
                     (substring dir 0 (length parent-expanded))))  
     (setq dir  
           (concat (file-name-directory  
                    (directory-file-name orig))  
                   (substring dir (length parent-expanded)))))  
   dir)  
1682    
1683  (add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")  (add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
1684    
# Line 1691  Pop up the buffer containing MARKER and Line 1687  Pop up the buffer containing MARKER and
1687  (defun compile-buffer-substring (n) (if n (match-string n)))  (defun compile-buffer-substring (n) (if n (match-string n)))
1688    
1689  (defun compilation-compat-error-properties (err)  (defun compilation-compat-error-properties (err)
1690    ;; Map old-style ERROR to new-style MESSAGE.    "Map old-style error ERR to new-style message."
1691    (let* ((dst (cdr err))    ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
1692           (loc (cond ((markerp dst) (list nil nil nil dst))    ;; (MARKER . MARKER).
1693                      ((consp dst)    (let ((dst (cdr err)))
1694                       (list (nth 2 dst) (nth 1 dst)      (if (markerp dst)
1695                             (cons (cdar dst) (caar dst)))))))          ;; Must start with a face, for font-lock.
1696      ;; Must start with a face, for font-lock.          `(face nil
1697      `(face nil            message ,(list (list nil nil nil dst) 2)
1698        message ,(list loc 2)            help-echo "mouse-2: visit the source location"
1699        help-echo "mouse-2: visit the source location"            keymap compilation-button-map
1700        mouse-face highlight)))            mouse-face highlight)
1701          ;; Too difficult to do it by hand: dispatch to the normal code.
1702          (let* ((file (pop dst))
1703                 (line (pop dst))
1704                 (col (pop dst))
1705                 (filename (pop file))
1706                 (dirname (pop file))
1707                 (fmt (pop file)))
1708            (compilation-internal-error-properties
1709             (cons filename dirname) line nil col nil 2 fmt)))))
1710    
1711  (defun compilation-compat-parse-errors (limit)  (defun compilation-compat-parse-errors (limit)
1712    (when compilation-parse-errors-function    (when compilation-parse-errors-function
# Line 1739  Pop up the buffer containing MARKER and Line 1744  Pop up the buffer containing MARKER and
1744    (goto-char limit)    (goto-char limit)
1745    nil)    nil)
1746    
1747    ;; Beware: this is not only compatiblity code.  New code stil uses it.  --Stef
1748  (defun compilation-forget-errors ()  (defun compilation-forget-errors ()
1749    ;; In case we hit the same file/line specs, we want to recompute a new    ;; In case we hit the same file/line specs, we want to recompute a new
1750    ;; marker for them, so flush our cache.    ;; marker for them, so flush our cache.
1751    (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))    (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
1752      (setq compilation-gcpro nil)
1753    ;; FIXME: the old code reset the directory-stack, so maybe we should    ;; FIXME: the old code reset the directory-stack, so maybe we should
1754    ;; put a `directory change' marker of some sort, but where?  -stef    ;; put a `directory change' marker of some sort, but where?  -stef
1755    ;;    ;;
# Line 1754  Pop up the buffer containing MARKER and Line 1761  Pop up the buffer containing MARKER and
1761    ;; something equivalent to point-max.  So we speculatively move    ;; something equivalent to point-max.  So we speculatively move
1762    ;; compilation-current-error to point-max (since the external package    ;; compilation-current-error to point-max (since the external package
1763    ;; won't know that it should do it).  --stef    ;; won't know that it should do it).  --stef
1764    (setq compilation-current-error (point-max)))    (setq compilation-current-error nil)
1765      (let* ((proc (get-buffer-process (current-buffer)))
1766             (mark (if proc (process-mark proc)))
1767             (pos (or mark (point-max))))
1768        (setq compilation-messages-start
1769              ;; In the future, ignore the text already present in the buffer.
1770              ;; Since many process filter functions insert before markers,
1771              ;; we need to put ours just before the insertion point rather
1772              ;; than at the insertion point.  If that's not possible, then
1773              ;; don't use a marker.  --Stef
1774              (if (> pos (point-min)) (copy-marker (1- pos)) pos))))
1775    
1776  (provide 'compile)  (provide 'compile)
1777    
1778  ;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c  ;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
1779  ;;; compile.el ends here  ;;; compile.el ends here

Legend:
Removed from v.1.276.2.1  
changed lines
  Added in v.1.276.2.2

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