LCOV - code coverage report
Current view: top level - lisp/progmodes - compile.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 17 1034 1.6 %
Date: 2017-08-30 10:12:24 Functions: 9 71 12.7 %

          Line data    Source code
       1             : ;;; compile.el --- run compiler as inferior of Emacs, parse error messages  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1987, 1993-1999, 2001-2017 Free Software
       4             : ;; Foundation, Inc.
       5             : 
       6             : ;; Authors: Roland McGrath <roland@gnu.org>,
       7             : ;;          Daniel Pfeiffer <occitan@esperanto.org>
       8             : ;; Maintainer: emacs-devel@gnu.org
       9             : ;; Keywords: tools, processes
      10             : 
      11             : ;; This file is part of GNU Emacs.
      12             : 
      13             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      14             : ;; it under the terms of the GNU General Public License as published by
      15             : ;; the Free Software Foundation, either version 3 of the License, or
      16             : ;; (at your option) any later version.
      17             : 
      18             : ;; GNU Emacs is distributed in the hope that it will be useful,
      19             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      20             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      21             : ;; GNU General Public License for more details.
      22             : 
      23             : ;; You should have received a copy of the GNU General Public License
      24             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      25             : 
      26             : ;;; Commentary:
      27             : 
      28             : ;; This package provides the compile facilities documented in the Emacs user's
      29             : ;; manual.
      30             : 
      31             : ;;; Code:
      32             : 
      33             : (eval-when-compile (require 'cl-lib))
      34             : (require 'tool-bar)
      35             : (require 'comint)
      36             : 
      37             : (defgroup compilation nil
      38             :   "Run compiler as inferior of Emacs, parse error messages."
      39             :   :group 'tools
      40             :   :group 'processes)
      41             : 
      42             : 
      43             : ;;;###autoload
      44             : (defcustom compilation-mode-hook nil
      45             :   "List of hook functions run by `compilation-mode'."
      46             :   :type 'hook
      47             :   :group 'compilation)
      48             : 
      49             : ;;;###autoload
      50             : (defcustom compilation-start-hook nil
      51             :   "Hook run after starting a new compilation process.
      52             : The hook is run with one argument, the new process."
      53             :   :type 'hook
      54             :   :group 'compilation)
      55             : 
      56             : ;;;###autoload
      57             : (defcustom compilation-window-height nil
      58             :   "Number of lines in a compilation window.
      59             : If nil, use Emacs default."
      60             :   :type '(choice (const :tag "Default" nil)
      61             :                  integer)
      62             :   :group 'compilation)
      63             : 
      64             : (defvar compilation-filter-hook nil
      65             :   "Hook run after `compilation-filter' has inserted a string into the buffer.
      66             : It is called with the variable `compilation-filter-start' bound
      67             : to the position of the start of the inserted text, and point at
      68             : its end.
      69             : 
      70             : If Emacs lacks asynchronous process support, this hook is run
      71             : after `call-process' inserts the grep output into the buffer.")
      72             : 
      73             : (defvar compilation-filter-start nil
      74             :   "Position of the start of the text inserted by `compilation-filter'.
      75             : This is bound before running `compilation-filter-hook'.")
      76             : 
      77             : (defvar compilation-first-column 1
      78             :   "This is how compilers number the first column, usually 1 or 0.
      79             : If this is buffer-local in the destination buffer, Emacs obeys
      80             : that value, otherwise it uses the value in the *compilation*
      81             : buffer.  This enables a major-mode to specify its own value.")
      82             : 
      83             : (defvar compilation-parse-errors-filename-function nil
      84             :   "Function to call to post-process filenames while parsing error messages.
      85             : It takes one arg FILENAME which is the name of a file as found
      86             : in the compilation output, and should return a transformed file name.")
      87             : 
      88             : ;;;###autoload
      89             : (defvar compilation-process-setup-function nil
      90             :   "Function to call to customize the compilation process.
      91             : This function is called immediately before the compilation process is
      92             : started.  It can be used to set any variables or functions that are used
      93             : while processing the output of the compilation process.")
      94             : 
      95             : ;;;###autoload
      96             : (defvar compilation-buffer-name-function nil
      97             :   "Function to compute the name of a compilation buffer.
      98             : The function receives one argument, the name of the major mode of the
      99             : compilation buffer.  It should return a string.
     100             : If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
     101             : 
     102             : ;;;###autoload
     103             : (defvar compilation-finish-function nil
     104             :   "Function to call when a compilation process finishes.
     105             : It is called with two arguments: the compilation buffer, and a string
     106             : describing how the process finished.")
     107             : 
     108             : (make-obsolete-variable 'compilation-finish-function
     109             :   "use `compilation-finish-functions', but it works a little differently."
     110             :   "22.1")
     111             : 
     112             : ;;;###autoload
     113             : (defvar compilation-finish-functions nil
     114             :   "Functions to call when a compilation process finishes.
     115             : Each function is called with two arguments: the compilation buffer,
     116             : and a string describing how the process finished.")
     117             : 
     118             : (defvar compilation-in-progress nil
     119             :   "List of compilation processes now running.")
     120             : (or (assq 'compilation-in-progress minor-mode-alist)
     121             :     (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
     122             :                                  minor-mode-alist)))
     123             : 
     124             : (defvar compilation-error "error"
     125             :   "Stem of message to print when no matches are found.")
     126             : 
     127             : (defvar compilation-arguments nil
     128             :   "Arguments that were given to `compilation-start'.")
     129             : 
     130             : (defvar compilation-num-errors-found 0)
     131             : (defvar compilation-num-warnings-found 0)
     132             : (defvar compilation-num-infos-found 0)
     133             : 
     134             : (defconst compilation-mode-line-errors
     135             :   '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
     136             :                       face compilation-error
     137             :                       help-echo "Number of errors so far")
     138             :     " " (:propertize (:eval (int-to-string compilation-num-warnings-found))
     139             :                      face compilation-warning
     140             :                      help-echo "Number of warnings so far")
     141             :     " " (:propertize (:eval (int-to-string compilation-num-infos-found))
     142             :                      face compilation-info
     143             :                      help-echo "Number of informational messages so far")
     144             :     "]"))
     145             : 
     146             : ;; If you make any changes to `compilation-error-regexp-alist-alist',
     147             : ;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el.
     148             : ;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
     149             : 
     150             : (defvar compilation-error-regexp-alist-alist
     151             :   `((absoft
     152             :      "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
     153             : of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
     154             : 
     155             :     (ada
     156             :      "\\(warning: .*\\)? at \\([^ \n]+\\):\\([0-9]+\\)$" 2 3 nil (1))
     157             : 
     158             :     (aix
     159             :      " in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
     160             : 
     161             :     (ant
     162             :      "^[ \t]*\\[[^] \n]+\\][ \t]*\\(\\(?:[A-Za-z]:\\\\\\)?[^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\
     163             : \\( warning\\)?" 1 (2 . 4) (3 . 5) (6))
     164             : 
     165             :     (bash
     166             :      "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
     167             : 
     168             :     (borland
     169             :      "^\\(?:Error\\|Warnin\\(g\\)\\) \\(?:[FEW][0-9]+ \\)?\
     170             : \\([a-zA-Z]?:?[^:( \t\n]+\\)\
     171             :  \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
     172             : 
     173             :     (python-tracebacks-and-caml
     174             :      "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
     175             : \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?: [0-9]+\\)?:\\)?\\)"
     176             :      2 (3 . 4) (5 . 6) (7))
     177             : 
     178             :     (cmake
     179             :      "^CMake \\(?:Error\\|\\(Warning\\)\\) at \\(.*\\):\\([1-9][0-9]*\\) ([^)]+):$"
     180             :      2 3 nil (1))
     181             :     (cmake-info
     182             :      "^  \\(?: \\*\\)?\\(.*\\):\\([1-9][0-9]*\\) ([^)]+)$"
     183             :      1 2 nil 0)
     184             : 
     185             :     (comma
     186             :      "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
     187             : \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
     188             : 
     189             :     (cucumber
     190             :      "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
     191             : \\(?: \\)\\([^(].*\\):\\([1-9][0-9]*\\)" 1 2)
     192             : 
     193             :     (msft
     194             :      ;; Must be before edg-1, so that MSVC's longer messages are
     195             :      ;; considered before EDG.
     196             :      ;; The message may be a "warning", "error", or "fatal error" with
     197             :      ;; an error code, or "see declaration of" without an error code.
     198             :      "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) ?\
     199             : : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
     200             :      2 3 nil (4))
     201             : 
     202             :     (edg-1
     203             :      "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
     204             :      1 2 nil (3 . 4))
     205             :     (edg-2
     206             :      "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
     207             :      2 1 nil 0)
     208             : 
     209             :     (epc
     210             :      "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
     211             : 
     212             :     (ftnchek
     213             :      "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)"
     214             :      4 2 3 (1))
     215             : 
     216             :     (iar
     217             :      "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
     218             :      1 2 nil (3))
     219             : 
     220             :     (ibm
     221             :      "^\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) :\
     222             :  \\(?:warnin\\(g\\)\\|informationa\\(l\\)\\)?" 1 2 3 (4 . 5))
     223             : 
     224             :     ;; fixme: should be `mips'
     225             :     (irix
     226             :      "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
     227             : \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
     228             : 
     229             :     (java
     230             :      "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
     231             : 
     232             :     (jikes-file
     233             :      "^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
     234             : 
     235             : 
     236             :     ;; This used to be pathologically slow on long lines (Bug#3441),
     237             :     ;; due to matching filenames via \\(.*?\\).  This might be faster.
     238             :     (maven
     239             :      ;; Maven is a popular free software build tool for Java.
     240             :      "\\(\\[WARNING\\] *\\)?\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 2 3 4 (1))
     241             : 
     242             :     (jikes-line
     243             :      "^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
     244             :      nil 1 nil 2 0
     245             :      (2 (compilation-face '(3))))
     246             : 
     247             :     (clang-include
     248             :      ,(rx bol "In file included from "
     249             :           (group (+ (not (any ?\n ?:)))) ?:
     250             :           (group (+ (any (?0 . ?9)))) ?:
     251             :           eol)
     252             :      1 2 nil 0)
     253             : 
     254             :     (gcc-include
     255             :      "^\\(?:In file included \\|                 \\|\t\\)from \
     256             : \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
     257             : \\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
     258             :      1 2 3 (4 . 5))
     259             : 
     260             :     (ruby-Test::Unit
     261             :      "^[\t ]*\\[\\([^(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
     262             : 
     263             :     (gnu
     264             :      ;; The first line matches the program name for
     265             : 
     266             :      ;;     PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
     267             : 
     268             :      ;; format, which is used for non-interactive programs other than
     269             :      ;; compilers (e.g. the "jade:" entry in compilation.txt).
     270             : 
     271             :      ;; This first line makes things ambiguous with output such as
     272             :      ;; "foo:344:50:blabla" since the "foo" part can match this first
     273             :      ;; line (in which case the file name as "344").  To avoid this,
     274             :      ;; the second line disallows filenames exclusively composed of
     275             :      ;; digits.
     276             : 
     277             :      ;; Similarly, we get lots of false positives with messages including
     278             :      ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
     279             :      ;; the last line tries to rule out message where the info after the
     280             :      ;; line number starts with "SS".  --Stef
     281             : 
     282             :      ;; The core of the regexp is the one with *?.  It says that a file name
     283             :      ;; can be composed of any non-newline char, but it also rules out some
     284             :      ;; valid but unlikely cases, such as a trailing space or a space
     285             :      ;; followed by a -, or a colon followed by a space.
     286             :      ;;
     287             :      ;; The "in \\|from " exception was added to handle messages from Ruby.
     288             :      ,(rx
     289             :        bol
     290             :        (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
     291             :              (regexp "[ \t]+\\(?:in \\|from\\)")))
     292             :        (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
     293             :                      (*? (| (regexp "[^\n :]")
     294             :                             (regexp " [^-/\n]")
     295             :                             (regexp ":[^ \n]")))))
     296             :        (regexp ": ?")
     297             :        (group-n 2 (regexp "[0-9]+"))
     298             :        (? (| (: "-"
     299             :                 (group-n 4 (regexp "[0-9]+"))
     300             :                 (? "." (group-n 5 (regexp "[0-9]+"))))
     301             :              (: (in ".:")
     302             :                 (group-n 3 (regexp "[0-9]+"))
     303             :                 (? "-"
     304             :                    (? (group-n 4 (regexp "[0-9]+")) ".")
     305             :                    (group-n 5 (regexp "[0-9]+"))))))
     306             :        ":"
     307             :        (| (: (* " ")
     308             :              (group-n 6 (| "FutureWarning"
     309             :                            "RuntimeWarning"
     310             :                            "Warning"
     311             :                            "warning"
     312             :                            "W:")))
     313             :           (: (* " ")
     314             :              (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
     315             :                            "I:"
     316             :                            (: "[ skipping " (+ ".") " ]")
     317             :                            "instantiated from"
     318             :                            "required from"
     319             :                            (regexp "[Nn]ote"))))
     320             :           (: (* " ")
     321             :              (regexp "[Ee]rror"))
     322             :           (: (regexp "[0-9]?")
     323             :              (| (regexp "[^0-9\n]")
     324             :                 eol))
     325             :           (regexp "[0-9][0-9][0-9]")))
     326             :      1 (2 . 4) (3 . 5) (6 . 7))
     327             : 
     328             :     (lcc
     329             :      "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
     330             :      2 3 4 (1))
     331             : 
     332             :     (makepp
     333             :      "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\
     334             : `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
     335             :      4 5 nil (1 . 2) 3
     336             :      (0 (progn (save-match-data
     337             :                  (compilation-parse-errors
     338             :                   (match-end 0) (line-end-position)
     339             :                   `("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]"
     340             :                     2 3 nil
     341             :                     ,(cond ((match-end 1) 1) ((match-end 2) 0) (t 2))
     342             :                     1)))
     343             :                (end-of-line)
     344             :                nil)))
     345             : 
     346             :     ;; Should be lint-1, lint-2 (SysV lint)
     347             :     (mips-1
     348             :      " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
     349             :     (mips-2
     350             :      " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
     351             : 
     352             :     (msft
     353             :      ;; The message may be a "warning", "error", or "fatal error" with
     354             :      ;; an error code, or "see declaration of" without an error code.
     355             :      "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
     356             : : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
     357             :      2 3 nil (4))
     358             : 
     359             :     (omake
     360             :      ;; "omake -P" reports "file foo changed"
     361             :      ;; (useful if you do "cvs up" and want to see what has changed)
     362             :      "omake: file \\(.*\\) changed" 1 nil nil nil nil
     363             :      ;; FIXME-omake: This tries to prevent reusing pre-existing markers
     364             :      ;; for subsequent messages, since those messages's line numbers
     365             :      ;; are about another version of the file.
     366             :      (0 (progn (compilation--flush-file-structure (match-string 1))
     367             :                nil)))
     368             : 
     369             :     (oracle
     370             :      "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
     371             : \\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
     372             : \\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
     373             :      3 1 2)
     374             : 
     375             :     ;; "during global destruction": This comes out under "use
     376             :     ;; warnings" in recent perl when breaking circular references
     377             :     ;; during program or thread exit.
     378             :     (perl
     379             :      " at \\([^ \n]+\\) line \\([0-9]+\\)\\(?:[,.]\\|$\\| \
     380             : during global destruction\\.$\\)" 1 2)
     381             : 
     382             :     (php
     383             :      "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)"
     384             :      2 3 nil nil)
     385             : 
     386             :     (rxp
     387             :      "^\\(?:Error\\|Warnin\\(g\\)\\):.*\n.* line \\([0-9]+\\) char\
     388             :  \\([0-9]+\\) of file://\\(.+\\)"
     389             :      4 2 3 (1))
     390             : 
     391             :     (sparc-pascal-file
     392             :      "^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
     393             :  [12][09][0-9][0-9] +\\(.*\\):$"
     394             :      1 nil nil 0)
     395             :     (sparc-pascal-line
     396             :      "^\\(\\(?:E\\|\\(w\\)\\) +[0-9]+\\) line \\([0-9]+\\) -  "
     397             :      nil 3 nil (2) nil (1 (compilation-face '(2))))
     398             :     (sparc-pascal-example
     399             :      "^ +\\([0-9]+\\) +.*\n\\(\\(?:e\\|\\(w\\)\\) [0-9]+\\)-+"
     400             :      nil 1 nil (3) nil (2 (compilation-face '(3))))
     401             : 
     402             :     (sun
     403             :      ": \\(?:ERROR\\|WARNIN\\(G\\)\\|REMAR\\(K\\)\\) \\(?:[[:alnum:] ]+, \\)?\
     404             : File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
     405             :      3 4 5 (1 . 2))
     406             : 
     407             :     (sun-ada
     408             :      "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., (-]" 1 2 3)
     409             : 
     410             :     (watcom
     411             :      "^[ \t]*\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
     412             : \\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
     413             :      1 2 nil (4))
     414             : 
     415             :     (4bsd
     416             :      "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
     417             : \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
     418             : 
     419             :     (gcov-file
     420             :      "^ *-: *\\(0\\):Source:\\(.+\\)$"
     421             :      2 1 nil 0 nil)
     422             :     (gcov-header
     423             :      "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
     424             :      nil 1 nil 0 nil)
     425             :     ;; Underlines over all lines of gcov output are too uncomfortable to read.
     426             :     ;; However, hyperlinks embedded in the lines are useful.
     427             :     ;; So I put default face on the lines; and then put
     428             :     ;; compilation-*-face by manually to eliminate the underlines.
     429             :     ;; The hyperlinks are still effective.
     430             :     (gcov-nomark
     431             :      "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
     432             :      nil 1 nil 0 nil
     433             :      (0 'default)
     434             :      (1 compilation-line-face))
     435             :     (gcov-called-line
     436             :      "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
     437             :      nil 2 nil 0 nil
     438             :      (0 'default)
     439             :      (1 compilation-info-face) (2 compilation-line-face))
     440             :     (gcov-never-called
     441             :      "^ *\\(#####\\): *\\([0-9]+\\):.*$"
     442             :      nil 2 nil 2 nil
     443             :      (0 'default)
     444             :      (1 compilation-error-face) (2 compilation-line-face))
     445             : 
     446             :     (perl--Pod::Checker
     447             :      ;; podchecker error messages, per Pod::Checker.
     448             :      ;; The style is from the Pod::Checker::poderror() function, eg.
     449             :      ;; *** ERROR: Spurious text after =cut at line 193 in file foo.pm
     450             :      ;;
     451             :      ;; Plus end_pod() can give "at line EOF" instead of a
     452             :      ;; number, so for that match "on line N" which is the
     453             :      ;; originating spot, eg.
     454             :      ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm
     455             :      ;;
     456             :      ;; Plus command() can give both "on line N" and "at line N";
     457             :      ;; the latter is desired and is matched because the .* is
     458             :      ;; greedy.
     459             :      ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod
     460             :      ;;
     461             :      "^\\*\\*\\* \\(?:ERROR\\|\\(WARNING\\)\\).* \\(?:at\\|on\\) line \
     462             : \\([0-9]+\\) \\(?:.* \\)?in file \\([^ \t\n]+\\)"
     463             :      3 2 nil (1))
     464             :     (perl--Test
     465             :      ;; perl Test module error messages.
     466             :      ;; Style per the ok() function "$context", eg.
     467             :      ;; # Failed test 1 in foo.t at line 6
     468             :      ;;
     469             :      "^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
     470             :      1 2)
     471             :     (perl--Test2
     472             :      ;; Or when comparing got/want values, with a "fail #n" if repeated
     473             :      ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10)
     474             :      ;; # Test 3 got: "xx" (t-compilation-perl-2.t at line 10 fail #2)
     475             :      ;;
     476             :      ;; And under Test::Harness they're preceded by progress stuff with
     477             :      ;; \r and "NOK",
     478             :      ;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
     479             :      ;;
     480             :      "^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \
     481             : \\([0-9]+\\)\\( fail #[0-9]+\\)?)"
     482             :      2 3)
     483             :     (perl--Test::Harness
     484             :      ;; perl Test::Harness output, eg.
     485             :      ;; NOK 1# Test 1 got: "1234" (t/foo.t at line 46)
     486             :      ;;
     487             :      ;; Test::Harness is slightly designed for tty output, since
     488             :      ;; it prints CRs to overwrite progress messages, but if you
     489             :      ;; run it in with M-x compile this pattern can at least step
     490             :      ;; through the failures.
     491             :      ;;
     492             :      "^.*NOK.* \\([^ \t\r\n]+\\) at line \\([0-9]+\\)"
     493             :      1 2)
     494             :     (weblint
     495             :      ;; The style comes from HTML::Lint::Error::as_string(), eg.
     496             :      ;; index.html (13:1) Unknown element <fdjsk>
     497             :      ;;
     498             :      ;; The pattern only matches filenames without spaces, since that
     499             :      ;; should be usual and should help reduce the chance of a false
     500             :      ;; match of a message from some unrelated program.
     501             :      ;;
     502             :      ;; This message style is quite close to the "ibm" entry which is
     503             :      ;; for IBM C, though that ibm bit doesn't put a space after the
     504             :      ;; filename.
     505             :      ;;
     506             :      "^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) "
     507             :      1 2 3)
     508             : 
     509             :     ;; Guile compilation yields file-headers in the following format:
     510             :     ;;
     511             :     ;;   In sourcefile.scm:
     512             :     ;;
     513             :     ;; We need to catch those, but we also need to be aware that Emacs
     514             :     ;; byte-compilation yields compiler headers in similar form of
     515             :     ;; those:
     516             :     ;;
     517             :     ;;   In toplevel form:
     518             :     ;;   In end of data:
     519             :     ;;
     520             :     ;; We want to catch the Guile file-headers but not the Emacs
     521             :     ;; byte-compilation headers, because that will cause next-error
     522             :     ;; and prev-error to break, because the files "toplevel form" and
     523             :     ;; "end of data" does not exist.
     524             :     ;;
     525             :     ;; To differentiate between these two cases, we require that the
     526             :     ;; file-match must always contain an extension.
     527             :     ;;
     528             :     ;; We should also only treat this as "info", not "error", because
     529             :     ;; we do not know what lines will follow.
     530             :     (guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
     531             :     (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
     532             :     )
     533             :   "Alist of values for `compilation-error-regexp-alist'.")
     534             : 
     535             : (defcustom compilation-error-regexp-alist
     536             :   (mapcar 'car compilation-error-regexp-alist-alist)
     537             :   "Alist that specifies how to match errors in compiler output.
     538             : On GNU and Unix, any string is a valid filename, so these
     539             : matchers must make some common sense assumptions, which catch
     540             : normal cases.  A shorter list will be lighter on resource usage.
     541             : 
     542             : Instead of an alist element, you can use a symbol, which is
     543             : looked up in `compilation-error-regexp-alist-alist'.  You can see
     544             : the predefined symbols and their effects in the file
     545             : `etc/compilation.txt' (linked below if you are customizing this).
     546             : 
     547             : Each elt has the form (REGEXP FILE [LINE COLUMN TYPE HYPERLINK
     548             : HIGHLIGHT...]).  If REGEXP matches, the FILE'th subexpression
     549             : gives the file name, and the LINE'th subexpression gives the line
     550             : number.  The COLUMN'th subexpression gives the column number on
     551             : that line.
     552             : 
     553             : If FILE, LINE or COLUMN are nil or that index didn't match, that
     554             : information is not present on the matched line.  In that case the
     555             : file name is assumed to be the same as the previous one in the
     556             : buffer, line number defaults to 1 and column defaults to
     557             : beginning of line's indentation.
     558             : 
     559             : FILE can also have the form (FILE FORMAT...), where the FORMATs
     560             : \(e.g. \"%s.c\") will be applied in turn to the recognized file
     561             : name, until a file of that name is found.  Or FILE can also be a
     562             : function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
     563             : In the former case, FILENAME may be relative or absolute.
     564             : 
     565             : LINE can also be of the form (LINE . END-LINE) meaning a range
     566             : of lines.  COLUMN can also be of the form (COLUMN . END-COLUMN)
     567             : meaning a range of columns starting on LINE and ending on
     568             : END-LINE, if that matched.
     569             : 
     570             : TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
     571             : TYPE can also be of the form (WARNING . INFO).  In that case this
     572             : will be equivalent to 1 if the WARNING'th subexpression matched
     573             : or else equivalent to 0 if the INFO'th subexpression matched.
     574             : See `compilation-error-face', `compilation-warning-face',
     575             : `compilation-info-face' and `compilation-skip-threshold'.
     576             : 
     577             : What matched the HYPERLINK'th subexpression has `mouse-face' and
     578             : `compilation-message-face' applied.  If this is nil, the text
     579             : matched by the whole REGEXP becomes the hyperlink.
     580             : 
     581             : Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
     582             : SUBMATCH is the number of a submatch and FACE is an expression
     583             : which evaluates to a face name (a symbol or string).
     584             : Alternatively, FACE can evaluate to a property list of the
     585             : form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
     586             : listed text properties PROP# are given values VAL# as well."
     587             :   :type '(repeat (choice (symbol :tag "Predefined symbol")
     588             :                          (sexp :tag "Error specification")))
     589             :   :link `(file-link :tag "example file"
     590             :                     ,(expand-file-name "compilation.txt" data-directory))
     591             :   :group 'compilation)
     592             : 
     593             : ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
     594             : (defvar compilation-directory nil
     595             :   "Directory to restore to when doing `recompile'.")
     596             : 
     597             : (defvar compilation-directory-matcher
     598             :   '("\\(?:Entering\\|Leavin\\(g\\)\\) directory [`']\\(.+\\)'$" (2 . 1))
     599             :   "A list for tracking when directories are entered or left.
     600             : If nil, do not track directories, e.g. if all file names are absolute.  The
     601             : first element is the REGEXP matching these messages.  It can match any number
     602             : of variants, e.g. different languages.  The remaining elements are all of the
     603             : form (DIR .  LEAVE).  If for any one of these the DIR'th subexpression
     604             : matches, that is a directory name.  If LEAVE is nil or the corresponding
     605             : LEAVE'th subexpression doesn't match, this message is about going into another
     606             : directory.  If it does match anything, this message is about going back to the
     607             : directory we were in before the last entering message.  If you change this,
     608             : you may also want to change `compilation-page-delimiter'.")
     609             : 
     610             : (defvar compilation-page-delimiter
     611             :   "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory [`'].+'\n\\)+"
     612             :   "Value of `page-delimiter' in Compilation mode.")
     613             : 
     614             : (defvar compilation-mode-font-lock-keywords
     615             :    '(;; configure output lines.
     616             :      ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
     617             :       (1 font-lock-variable-name-face)
     618             :       (2 (compilation-face '(4 . 3))))
     619             :      ;; Command output lines.  Recognize `make[n]:' lines too.
     620             :      ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
     621             :       (1 font-lock-function-name-face) (3 compilation-line-face nil t))
     622             :      (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
     623             :      ("^Compilation \\(finished\\).*"
     624             :       (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
     625             :       (1 compilation-info-face))
     626             :      ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
     627             :       (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
     628             :       (1 compilation-error-face)
     629             :       (2 compilation-error-face nil t)))
     630             :    "Additional things to highlight in Compilation mode.
     631             : This gets tacked on the end of the generated expressions.")
     632             : 
     633             : (defvar compilation-highlight-regexp t
     634             :   "Regexp matching part of visited source lines to highlight temporarily.
     635             : Highlight entire line if t; don't highlight source lines if nil.")
     636             : 
     637             : (defvar compilation-highlight-overlay nil
     638             :   "Overlay used to temporarily highlight compilation matches.")
     639             : 
     640             : (defcustom compilation-error-screen-columns t
     641             :   "If non-nil, column numbers in error messages are screen columns.
     642             : Otherwise they are interpreted as character positions, with
     643             : each character occupying one column.
     644             : The default is to use screen columns, which requires that the compilation
     645             : program and Emacs agree about the display width of the characters,
     646             : especially the TAB character.
     647             : If this is buffer-local in the destination buffer, Emacs obeys
     648             : that value, otherwise it uses the value in the *compilation*
     649             : buffer.  This enables a major-mode to specify its own value."
     650             :   :type 'boolean
     651             :   :group 'compilation
     652             :   :version "20.4")
     653             : 
     654             : (defcustom compilation-read-command t
     655             :   "Non-nil means \\[compile] reads the compilation command to use.
     656             : Otherwise, \\[compile] just uses the value of `compile-command'.
     657             : 
     658             : Note that changing this to nil may be a security risk, because a
     659             : file might define a malicious `compile-command' as a file local
     660             : variable, and you might not notice.  Therefore, `compile-command'
     661             : is considered unsafe if this variable is nil."
     662             :   :type 'boolean
     663             :   :group 'compilation)
     664             : 
     665             : ;;;###autoload
     666             : (defcustom compilation-ask-about-save t
     667             :   "Non-nil means \\[compile] asks which buffers to save before compiling.
     668             : Otherwise, it saves all modified buffers without asking."
     669             :   :type 'boolean
     670             :   :group 'compilation)
     671             : 
     672             : (defcustom compilation-save-buffers-predicate nil
     673             :   "The second argument (PRED) passed to `save-some-buffers' before compiling.
     674             : E.g., one can set this to
     675             :   (lambda ()
     676             :     (string-prefix-p my-compilation-root (file-truename (buffer-file-name))))
     677             : to limit saving to files located under `my-compilation-root'.
     678             : Note, that, in general, `compilation-directory' cannot be used instead
     679             : of `my-compilation-root' here."
     680             :   :type '(choice
     681             :           (const :tag "Default (save all file-visiting buffers)" nil)
     682             :           (const :tag "Save all buffers" t)
     683             :           function)
     684             :   :group 'compilation
     685             :   :version "24.1")
     686             : 
     687             : ;;;###autoload
     688             : (defcustom compilation-search-path '(nil)
     689             :   "List of directories to search for source files named in error messages.
     690             : Elements should be directory names, not file names of directories.
     691             : The value nil as an element means to try the default directory."
     692             :   :type '(repeat (choice (const :tag "Default" nil)
     693             :                          (string :tag "Directory")))
     694             :   :group 'compilation)
     695             : 
     696             : ;;;###autoload
     697             : (defcustom compile-command (purecopy "make -k ")
     698             :   "Last shell command used to do a compilation; default for next compilation.
     699             : 
     700             : Sometimes it is useful for files to supply local values for this variable.
     701             : You might also use mode hooks to specify it in certain modes, like this:
     702             : 
     703             :     (add-hook \\='c-mode-hook
     704             :        (lambda ()
     705             :          (unless (or (file-exists-p \"makefile\")
     706             :                      (file-exists-p \"Makefile\"))
     707             :            (set (make-local-variable \\='compile-command)
     708             :                 (concat \"make -k \"
     709             :                         (if buffer-file-name
     710             :                           (shell-quote-argument
     711             :                             (file-name-sans-extension buffer-file-name))))))))
     712             : 
     713             : It's often useful to leave a space at the end of the value."
     714             :   :type 'string
     715             :   :group 'compilation)
     716             : ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
     717             : 
     718             : ;;;###autoload
     719             : (defcustom compilation-disable-input nil
     720             :   "If non-nil, send end-of-file as compilation process input.
     721             : This only affects platforms that support asynchronous processes (see
     722             : `start-process'); synchronous compilation processes never accept input."
     723             :   :type 'boolean
     724             :   :group 'compilation
     725             :   :version "22.1")
     726             : 
     727             : ;; A weak per-compilation-buffer hash indexed by (FILENAME . DIRECTORY).  Each
     728             : ;; value is a FILE-STRUCTURE as described above, with the car eq to the hash
     729             : ;; key.  This holds the tree seen from root, for storing new nodes.
     730             : (defvar compilation-locs ())
     731             : 
     732             : (defvar compilation-debug nil
     733             :   "Set this to t before creating a *compilation* buffer.
     734             : Then every error line will have a debug text property with the matcher that
     735             : fit this line and the match data.  Use `describe-text-properties'.")
     736             : 
     737             : (defvar compilation-exit-message-function nil "\
     738             : If non-nil, called when a compilation process dies to return a status message.
     739             : This should be a function of three arguments: process status, exit status,
     740             : and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
     741             : write into the compilation buffer, and to put in its mode line.")
     742             : 
     743             : (defcustom compilation-environment nil
     744             :   "List of environment variables for compilation to inherit.
     745             : Each element should be a string of the form ENVVARNAME=VALUE.
     746             : This list is temporarily prepended to `process-environment' prior to
     747             : starting the compilation process."
     748             :   :type '(repeat (string :tag "ENVVARNAME=VALUE"))
     749             :   :options '(("LANG=C"))
     750             :   :group 'compilation
     751             :   :version "24.1")
     752             : 
     753             : ;; History of compile commands.
     754             : (defvar compile-history nil)
     755             : 
     756             : (defface compilation-error
     757             :   '((t :inherit error))
     758             :   "Face used to highlight compiler errors."
     759             :   :group 'compilation
     760             :   :version "22.1")
     761             : 
     762             : (defface compilation-warning
     763             :   '((t :inherit warning))
     764             :   "Face used to highlight compiler warnings."
     765             :   :group 'compilation
     766             :   :version "22.1")
     767             : 
     768             : (defface compilation-info
     769             :   '((t :inherit success))
     770             :   "Face used to highlight compiler information."
     771             :   :group 'compilation
     772             :   :version "22.1")
     773             : 
     774             : ;; The next three faces must be able to stand out against the
     775             : ;; `mode-line' and `mode-line-inactive' faces.
     776             : 
     777             : (defface compilation-mode-line-fail
     778             :   '((default :inherit compilation-error)
     779             :     (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
     780             :     (((class color) (min-colors 8)) (:foreground "red"))
     781             :     (t (:inverse-video t :weight bold)))
     782             :   "Face for Compilation mode's \"error\" mode line indicator."
     783             :   :group 'compilation
     784             :   :version "24.3")
     785             : 
     786             : (defface compilation-mode-line-run
     787             :   '((t :inherit compilation-warning))
     788             :   "Face for Compilation mode's \"running\" mode line indicator."
     789             :   :group 'compilation
     790             :   :version "24.3")
     791             : 
     792             : (defface compilation-mode-line-exit
     793             :   '((default :inherit compilation-info)
     794             :     (((class color) (min-colors 16))
     795             :      (:foreground "ForestGreen" :weight bold))
     796             :     (((class color)) (:foreground "green" :weight bold))
     797             :     (t (:weight bold)))
     798             :   "Face for Compilation mode's \"exit\" mode line indicator."
     799             :   :group 'compilation
     800             :   :version "24.3")
     801             : 
     802             : (defface compilation-line-number
     803             :   '((t :inherit font-lock-keyword-face))
     804             :   "Face for displaying line numbers in compiler messages."
     805             :   :group 'compilation
     806             :   :version "22.1")
     807             : 
     808             : (defface compilation-column-number
     809             :   '((t :inherit font-lock-doc-face))
     810             :   "Face for displaying column numbers in compiler messages."
     811             :   :group 'compilation
     812             :   :version "22.1")
     813             : 
     814             : (defcustom compilation-message-face 'underline
     815             :   "Face name to use for whole messages.
     816             : Faces `compilation-error-face', `compilation-warning-face',
     817             : `compilation-info-face', `compilation-line-face' and
     818             : `compilation-column-face' get prepended to this, when applicable."
     819             :   :type 'face
     820             :   :group 'compilation
     821             :   :version "22.1")
     822             : 
     823             : (defvar compilation-error-face 'compilation-error
     824             :   "Face name to use for file name in error messages.")
     825             : 
     826             : (defvar compilation-warning-face 'compilation-warning
     827             :   "Face name to use for file name in warning messages.")
     828             : 
     829             : (defvar compilation-info-face 'compilation-info
     830             :   "Face name to use for file name in informational messages.")
     831             : 
     832             : (defvar compilation-line-face 'compilation-line-number
     833             :   "Face name to use for line numbers in compiler messages.")
     834             : 
     835             : (defvar compilation-column-face 'compilation-column-number
     836             :   "Face name to use for column numbers in compiler messages.")
     837             : 
     838             : ;; same faces as dired uses
     839             : (defvar compilation-enter-directory-face 'font-lock-function-name-face
     840             :   "Face name to use for entering directory messages.")
     841             : 
     842             : (defvar compilation-leave-directory-face 'font-lock-builtin-face
     843             :   "Face name to use for leaving directory messages.")
     844             : 
     845             : ;; Used for compatibility with the old compile.el.
     846             : (defvar compilation-parse-errors-function nil)
     847             : (make-obsolete-variable 'compilation-parse-errors-function
     848             :                         'compilation-error-regexp-alist "24.1")
     849             : 
     850             : (defcustom compilation-auto-jump-to-first-error nil
     851             :   "If non-nil, automatically jump to the first error during compilation."
     852             :   :type 'boolean
     853             :   :group 'compilation
     854             :   :version "23.1")
     855             : 
     856             : (defvar compilation-auto-jump-to-next nil
     857             :   "If non-nil, automatically jump to the next error encountered.")
     858             : (make-variable-buffer-local 'compilation-auto-jump-to-next)
     859             : 
     860             : ;; (defvar compilation-buffer-modtime nil
     861             : ;;   "The buffer modification time, for buffers not associated with files.")
     862             : ;; (make-variable-buffer-local 'compilation-buffer-modtime)
     863             : 
     864             : (defvar compilation-skip-to-next-location t
     865             :   "If non-nil, skip multiple error messages for the same source location.")
     866             : 
     867             : (defcustom compilation-skip-threshold 1
     868             :   "Compilation motion commands skip less important messages.
     869             : The value can be either 2 -- skip anything less than error, 1 --
     870             : skip anything less than warning or 0 -- don't skip any messages.
     871             : Note that all messages not positively identified as warning or
     872             : info, are considered errors."
     873             :   :type '(choice (const :tag "Skip warnings and info" 2)
     874             :                  (const :tag "Skip info" 1)
     875             :                  (const :tag "No skip" 0))
     876             :   :group 'compilation
     877             :   :version "22.1")
     878             : 
     879             : (defun compilation-set-skip-threshold (level)
     880             :   "Switch the `compilation-skip-threshold' level."
     881             :   (interactive
     882           0 :    (list
     883           0 :     (mod (if current-prefix-arg
     884           0 :              (prefix-numeric-value current-prefix-arg)
     885           0 :            (1+ compilation-skip-threshold))
     886           0 :          3)))
     887           0 :   (setq compilation-skip-threshold level)
     888           0 :   (message "Skipping %s"
     889           0 :            (pcase compilation-skip-threshold
     890             :              (0 "Nothing")
     891             :              (1 "Info messages")
     892           0 :              (2 "Warnings and info"))))
     893             : 
     894             : (defcustom compilation-skip-visited nil
     895             :   "Compilation motion commands skip visited messages if this is t.
     896             : Visited messages are ones for which the file, line and column have been jumped
     897             : to from the current content in the current compilation buffer, even if it was
     898             : from a different message."
     899             :   :type 'boolean
     900             :   :group 'compilation
     901             :   :version "22.1")
     902             : 
     903             : (defun compilation-type (type)
     904           0 :   (or (and (car type) (match-end (car type)) 1)
     905           0 :       (and (cdr type) (match-end (cdr type)) 0)
     906           0 :       2))
     907             : 
     908             : ;;   LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
     909             : 
     910             : ;; COLUMN and LINE are numbers parsed from an error message.  COLUMN and maybe
     911             : ;; LINE will be nil for a message that doesn't contain them.  Then the
     912             : ;; location refers to a indented beginning of line or beginning of file.
     913             : ;; Once any location in some file has been jumped to, the list is extended to
     914             : ;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED)
     915             : ;; for all LOCs pertaining to that file.
     916             : ;; MARKER initially points to LINE and COLUMN in a buffer visiting that file.
     917             : ;; Being a marker it sticks to some text, when the buffer grows or shrinks
     918             : ;; before that point.  VISITED is t if we have jumped there, else nil.
     919             : ;; FIXME-omake: TIMESTAMP was used to try and handle "incremental compilation":
     920             : ;; `omake -P' polls filesystem for changes and recompiles when a file is
     921             : ;; modified using the same *compilation* buffer. this necessitates
     922             : ;; re-parsing markers.
     923             : 
     924             : ;; (cl-defstruct (compilation--loc
     925             : ;;             (:constructor nil)
     926             : ;;             (:copier nil)
     927             : ;;             (:constructor compilation--make-loc
     928             : ;;                           (file-struct line col marker))
     929             : ;;             (:conc-name compilation--loc->))
     930             : ;;   col line file-struct marker timestamp visited)
     931             : 
     932             : ;; FIXME: We don't use a defstruct because of compilation-assq which looks up
     933             : ;; and creates part of the LOC (only the first cons cell containing the COL).
     934             : 
     935             : (defmacro compilation--make-cdrloc (line file-struct marker)
     936           6 :   `(list ,line ,file-struct ,marker nil))
     937           3 : (defmacro compilation--loc->col (loc) `(car ,loc))
     938           0 : (defmacro compilation--loc->line (loc) `(cadr ,loc))
     939           8 : (defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc))
     940           9 : (defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
     941             : ;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc))
     942           3 : (defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc))
     943             : 
     944             : ;;   FILE-STRUCTURE is a list of
     945             : ;;   ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...)
     946             : 
     947             : ;; FILENAME is a string parsed from an error message.  DIRECTORY is a string
     948             : ;; obtained by following directory change messages.  DIRECTORY will be nil for
     949             : ;; an absolute filename.  FORMATS is a list of formats to apply to FILENAME if
     950             : ;; a file of that name can't be found.
     951             : ;; The rest of the list is an alist of elements with LINE as key.  The keys
     952             : ;; are either nil or line numbers.  If present, nil comes first, followed by
     953             : ;; the numbers in decreasing order.  The LOCs for each line are again an alist
     954             : ;; ordered the same way.  Note that the whole file structure is referenced in
     955             : ;; every LOC.
     956             : 
     957             : (defmacro compilation--make-file-struct (file-spec formats &optional loc-tree)
     958           1 :   `(cons ,file-spec (cons ,formats ,loc-tree)))
     959           0 : (defmacro compilation--file-struct->file-spec (fs) `(car ,fs))
     960           1 : (defmacro compilation--file-struct->formats (fs) `(cadr ,fs))
     961             : ;; The FORMATS field plays the role of ANCHOR in the loc-tree.
     962           4 : (defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
     963             : 
     964             : ;;   MESSAGE is a list of (LOC TYPE END-LOC)
     965             : 
     966             : ;; TYPE is 0 for info or 1 for warning if the message matcher identified it as
     967             : ;; such, 2 otherwise (for a real error).  END-LOC is a LOC pointing to the
     968             : ;; other end, if the parsed message contained a range.  If the end of the
     969             : ;; range didn't specify a COLUMN, it defaults to -1, meaning end of line.
     970             : ;; These are the value of the `compilation-message' text-properties in the
     971             : ;; compilation buffer.
     972             : 
     973             : (cl-defstruct (compilation--message
     974             :             (:constructor nil)
     975             :             (:copier nil)
     976             :             ;; (:type list)                ;Old representation.
     977             :             (:constructor compilation--make-message (loc type end-loc))
     978             :             (:conc-name compilation--message->))
     979             :   loc type end-loc)
     980             : 
     981             : (defvar compilation--previous-directory-cache nil
     982             :   "A pair (POS . RES) caching the result of previous directory search.
     983             : Basically, this pair says that calling
     984             :    (previous-single-property-change POS \\='compilation-directory)
     985             : returned RES, i.e. there is no change of `compilation-directory' between
     986             : POS and RES.")
     987             : (make-variable-buffer-local 'compilation--previous-directory-cache)
     988             : 
     989             : (defun compilation--flush-directory-cache (start _end)
     990           0 :   (cond
     991           0 :    ((or (not compilation--previous-directory-cache)
     992           0 :         (<= (car compilation--previous-directory-cache) start)))
     993           0 :    ((or (not (cdr compilation--previous-directory-cache))
     994           0 :         (null (marker-buffer (cdr compilation--previous-directory-cache)))
     995           0 :         (<= (cdr compilation--previous-directory-cache) start))
     996           0 :     (set-marker (car compilation--previous-directory-cache) start))
     997           0 :    (t (setq compilation--previous-directory-cache nil))))
     998             : 
     999             : (defun compilation--previous-directory (pos)
    1000             :   "Like (previous-single-property-change POS \\='compilation-directory), but faster."
    1001             :   ;; This avoids an N² behavior when there's no/few compilation-directory
    1002             :   ;; entries, in which case each call to previous-single-property-change
    1003             :   ;; ends up having to walk very far back to find the last change.
    1004           0 :   (if (and compilation--previous-directory-cache
    1005           0 :            (< pos (car compilation--previous-directory-cache))
    1006           0 :            (or (null (cdr compilation--previous-directory-cache))
    1007           0 :                (< (cdr compilation--previous-directory-cache) pos)))
    1008             :       ;; No need to call previous-single-property-change.
    1009           0 :       (cdr compilation--previous-directory-cache)
    1010             : 
    1011           0 :     (let* ((cache (and compilation--previous-directory-cache
    1012           0 :                        (<= (car compilation--previous-directory-cache) pos)
    1013           0 :                        (car compilation--previous-directory-cache)))
    1014             :            (prev
    1015           0 :             (previous-single-property-change
    1016           0 :              pos 'compilation-directory nil cache))
    1017             :            (res
    1018           0 :             (cond
    1019           0 :              ((null cache)
    1020           0 :               (setq compilation--previous-directory-cache
    1021           0 :                     (cons (copy-marker pos) (if prev (copy-marker prev))))
    1022           0 :               prev)
    1023           0 :              ((and prev (= prev cache))
    1024           0 :               (set-marker (car compilation--previous-directory-cache) pos)
    1025           0 :               (cdr compilation--previous-directory-cache))
    1026             :              (t
    1027           0 :               (set-marker cache pos)
    1028           0 :               (setcdr compilation--previous-directory-cache
    1029           0 :                       (copy-marker prev))
    1030           0 :               prev))))
    1031           0 :       (if (markerp res) (marker-position res) res))))
    1032             : 
    1033             : ;; Internal function for calculating the text properties of a directory
    1034             : ;; change message.  The compilation-directory property is important, because it
    1035             : ;; is the stack of nested enter-messages.  Relative filenames on the following
    1036             : ;; lines are relative to the top of the stack.
    1037             : (defun compilation-directory-properties (idx leave)
    1038           0 :   (if leave (setq leave (match-end leave)))
    1039             :   ;; find previous stack, and push onto it, or if `leave' pop it
    1040           0 :   (let ((dir (compilation--previous-directory (match-beginning 0))))
    1041           0 :     (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
    1042           0 :                           (get-text-property dir 'compilation-directory))))
    1043           0 :     `(font-lock-face ,(if leave
    1044           0 :                           compilation-leave-directory-face
    1045           0 :                         compilation-enter-directory-face)
    1046           0 :       compilation-directory ,(if leave
    1047           0 :                                  (or (cdr dir)
    1048           0 :                                      '(nil)) ; nil only isn't a property-change
    1049           0 :                                (cons (match-string-no-properties idx) dir))
    1050             :       ;; Place a `compilation-message' everywhere we change text-properties
    1051             :       ;; so compilation--remove-properties can know what to remove.
    1052           0 :       compilation-message ,(compilation--make-message nil 0 nil)
    1053             :       mouse-face highlight
    1054             :       keymap compilation-button-map
    1055           0 :       help-echo "mouse-2: visit destination directory")))
    1056             : 
    1057             : ;; Data type `reverse-ordered-alist' retriever.  This function retrieves the
    1058             : ;; KEY element from the ALIST, creating it in the right position if not already
    1059             : ;; present. ALIST structure is
    1060             : ;; '(ANCHOR (KEY1 ...) (KEY2 ...)... (KEYn ALIST ...))
    1061             : ;; ANCHOR is ignored, but necessary so that elements can be inserted.  KEY1
    1062             : ;; may be nil.  The other KEYs are ordered backwards so that growing line
    1063             : ;; numbers can be inserted in front and searching can abort after half the
    1064             : ;; list on average.
    1065             : (eval-when-compile                  ;Don't keep it at runtime if not needed.
    1066             : (defmacro compilation-assq (key alist)
    1067             :   `(let* ((l1 ,alist)
    1068             :           (l2 (cdr l1)))
    1069             :      (car (if (if (null ,key)
    1070             :                   (if l2 (null (caar l2)))
    1071             :                 (while (if l2 (if (caar l2) (< ,key (caar l2)) t))
    1072             :                   (setq l1 l2
    1073             :                         l2 (cdr l1)))
    1074             :                 (if l2 (eq ,key (caar l2))))
    1075             :               l2
    1076             :             (setcdr l1 (cons (list ,key) l2)))))))
    1077             : 
    1078             : (defun compilation-auto-jump (buffer pos)
    1079           0 :   (with-current-buffer buffer
    1080           0 :     (goto-char pos)
    1081           0 :     (let ((win (get-buffer-window buffer 0)))
    1082           0 :       (if win (set-window-point win pos)))
    1083           0 :     (if compilation-auto-jump-to-first-error
    1084           0 :         (compile-goto-error))))
    1085             : 
    1086             : ;; This function is the central driver, called when font-locking to gather
    1087             : ;; all information needed to later jump to corresponding source code.
    1088             : ;; Return a property list with all meta information on this error location.
    1089             : 
    1090             : (defun compilation-error-properties (file line end-line col end-col type fmt)
    1091           0 :   (unless (text-property-not-all (match-beginning 0) (point)
    1092           0 :                                  'compilation-message nil)
    1093           0 :     (if file
    1094           0 :         (when (stringp
    1095           0 :                (setq file (if (functionp file) (funcall file)
    1096           0 :                             (match-string-no-properties file))))
    1097           0 :           (let ((dir
    1098           0 :             (unless (file-name-absolute-p file)
    1099           0 :                    (let ((pos (compilation--previous-directory
    1100           0 :                                (match-beginning 0))))
    1101           0 :                      (when pos
    1102           0 :                        (or (get-text-property (1- pos) 'compilation-directory)
    1103           0 :                            (get-text-property pos 'compilation-directory)))))))
    1104           0 :             (setq file (cons file (car dir)))))
    1105             :       ;; This message didn't mention one, get it from previous
    1106           0 :       (let ((prev-pos
    1107             :              ;; Find the previous message.
    1108           0 :              (previous-single-property-change (point) 'compilation-message)))
    1109           0 :         (if prev-pos
    1110             :             ;; Get the file structure that belongs to it.
    1111           0 :             (let* ((prev
    1112           0 :                     (or (get-text-property (1- prev-pos) 'compilation-message)
    1113           0 :                         (get-text-property prev-pos 'compilation-message)))
    1114             :                    (prev-file-struct
    1115           0 :                     (and prev
    1116           0 :                          (compilation--loc->file-struct
    1117           0 :                           (compilation--message->loc prev)))))
    1118             : 
    1119             :               ;; Construct FILE . DIR from that.
    1120           0 :               (if prev-file-struct
    1121           0 :                   (setq file (cons (caar prev-file-struct)
    1122           0 :                                    (cadr (car prev-file-struct)))))))
    1123           0 :         (unless file
    1124           0 :           (setq file '("*unknown*")))))
    1125             :     ;; All of these fields are optional, get them only if we have an index, and
    1126             :     ;; it matched some part of the message.
    1127           0 :     (and line
    1128           0 :          (setq line (match-string-no-properties line))
    1129           0 :          (setq line (string-to-number line)))
    1130           0 :     (and end-line
    1131           0 :          (setq end-line (match-string-no-properties end-line))
    1132           0 :          (setq end-line (string-to-number end-line)))
    1133           0 :     (if col
    1134           0 :         (if (functionp col)
    1135           0 :             (setq col (funcall col))
    1136           0 :           (and
    1137           0 :            (setq col (match-string-no-properties col))
    1138           0 :            (setq col (string-to-number col)))))
    1139           0 :     (if (and end-col (functionp end-col))
    1140           0 :         (setq end-col (funcall end-col))
    1141           0 :       (if (and end-col (setq end-col (match-string-no-properties end-col)))
    1142           0 :           (setq end-col (- (string-to-number end-col) -1))
    1143           0 :         (if end-line (setq end-col -1))))
    1144           0 :     (if (consp type)                    ; not a static type, check what it is.
    1145           0 :         (setq type (or (and (car type) (match-end (car type)) 1)
    1146           0 :                        (and (cdr type) (match-end (cdr type)) 0)
    1147           0 :                        2)))
    1148             : 
    1149           0 :     (when (and compilation-auto-jump-to-next
    1150           0 :                (>= type compilation-skip-threshold))
    1151           0 :       (kill-local-variable 'compilation-auto-jump-to-next)
    1152           0 :       (run-with-timer 0 nil 'compilation-auto-jump
    1153           0 :                       (current-buffer) (match-beginning 0)))
    1154             : 
    1155           0 :     (compilation-internal-error-properties
    1156           0 :      file line end-line col end-col type fmt)))
    1157             : 
    1158             : (defun compilation-beginning-of-line (&optional n)
    1159             :   "Like `beginning-of-line', but accounts for lines hidden by `selective-display'."
    1160           0 :   (if (or (not (eq selective-display t))
    1161           0 :           (null n)
    1162           0 :           (= n 1))
    1163           0 :       (beginning-of-line n)
    1164           0 :     (re-search-forward "[\n\r]" nil 'end (1- n))
    1165           0 :     (if (< n 0)
    1166           0 :         (beginning-of-line))))
    1167             : 
    1168             : (defun compilation-move-to-column (col screen)
    1169             :   "Go to column COL on the current line.
    1170             : If SCREEN is non-nil, columns are screen columns, otherwise, they are
    1171             : just char-counts."
    1172           0 :   (setq col (- col compilation-first-column))
    1173           0 :   (if screen
    1174             :       ;; Presumably, the compilation tool doesn't know about our current
    1175             :       ;; `tab-width' setting, so it probably assumed 8-wide TABs (bug#21038).
    1176           0 :       (let ((tab-width 8)) (move-to-column (max col 0)))
    1177           0 :     (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
    1178             : 
    1179             : (defun compilation-internal-error-properties (file line end-line col end-col type fmts)
    1180             :   "Get the meta-info that will be added as text-properties.
    1181             : LINE, END-LINE, COL, END-COL are integers or nil.
    1182             : TYPE can be 0, 1, or 2, meaning error, warning, or just info.
    1183             : FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
    1184             : FMTS is a list of format specs for transforming the file name.
    1185             :  (See `compilation-error-regexp-alist'.)"
    1186           0 :   (unless file (setq file '("*unknown*")))
    1187           0 :   (let* ((file-struct (compilation-get-file-structure file fmts))
    1188             :          ;; Get first already existing marker (if any has one, all have one).
    1189             :          ;; Do this first, as the compilation-assq`s may create new nodes.
    1190             :          (marker-line   ; a line structure
    1191           0 :           (cadr (compilation--file-struct->loc-tree file-struct)))
    1192             :          (marker
    1193           0 :           (if marker-line (compilation--loc->marker (cadr marker-line))))
    1194           0 :          (screen-columns compilation-error-screen-columns)
    1195           0 :          (first-column compilation-first-column)
    1196             :          end-marker loc end-loc)
    1197           0 :     (if (not (and marker (marker-buffer marker)))
    1198           0 :         (setq marker nil)               ; no valid marker for this file
    1199           0 :       (unless line (setq line 1))       ; normalize no linenumber to line 1
    1200           0 :       (catch 'marker                    ; find nearest loc, at least one exists
    1201           0 :         (dolist (x (cddr (compilation--file-struct->loc-tree
    1202           0 :                           file-struct)))        ; Loop over remaining lines.
    1203           0 :           (if (> (car x) line)               ; Still bigger.
    1204           0 :               (setq marker-line x)
    1205           0 :             (if (> (- (or (car marker-line) 1) line)
    1206           0 :                    (- line (car x)))    ; Current line is nearer.
    1207           0 :                 (setq marker-line x))
    1208           0 :             (throw 'marker t))))
    1209           0 :       (setq marker (compilation--loc->marker (cadr marker-line))
    1210           0 :             marker-line (or (car marker-line) 1))
    1211           0 :       (with-current-buffer (marker-buffer marker)
    1212           0 :         (let ((screen-columns
    1213             :                ;; Obey the compilation-error-screen-columns of the target
    1214             :                ;; buffer if its major mode set it buffer-locally.
    1215           0 :                (if (local-variable-p 'compilation-error-screen-columns)
    1216           0 :                    compilation-error-screen-columns screen-columns))
    1217             :               (compilation-first-column
    1218           0 :                (if (local-variable-p 'compilation-first-column)
    1219           0 :                    compilation-first-column first-column)))
    1220           0 :           (save-excursion
    1221           0 :           (save-restriction
    1222           0 :             (widen)
    1223           0 :             (goto-char (marker-position marker))
    1224             :             ;; Set end-marker if appropriate and go to line.
    1225           0 :             (if (not (or end-col end-line))
    1226           0 :                 (compilation-beginning-of-line (- line marker-line -1))
    1227           0 :               (compilation-beginning-of-line (- (or end-line line)
    1228           0 :                                                 marker-line -1))
    1229           0 :               (if (or (null end-col) (< end-col 0))
    1230           0 :                   (end-of-line)
    1231           0 :                 (compilation-move-to-column end-col screen-columns))
    1232           0 :               (setq end-marker (point-marker))
    1233           0 :               (when end-line
    1234           0 :                 (compilation-beginning-of-line (- line end-line -1))))
    1235           0 :             (if col
    1236           0 :                 (compilation-move-to-column col screen-columns)
    1237           0 :               (forward-to-indentation 0))
    1238           0 :             (setq marker (point-marker)))))))
    1239             : 
    1240           0 :     (setq loc (compilation-assq line (compilation--file-struct->loc-tree
    1241           0 :                                       file-struct)))
    1242           0 :     (setq end-loc
    1243           0 :     (if end-line
    1244           0 :               (compilation-assq
    1245             :                end-col (compilation-assq
    1246             :                         end-line (compilation--file-struct->loc-tree
    1247           0 :                                   file-struct)))
    1248           0 :       (if end-col                       ; use same line element
    1249           0 :                 (compilation-assq end-col loc))))
    1250           0 :     (setq loc (compilation-assq col loc))
    1251             :     ;; If they are new, make the loc(s) reference the file they point to.
    1252             :     ;; FIXME-omake: there's a problem with timestamps here: the markers
    1253             :     ;; relative to which we computed the current `marker' have a timestamp
    1254             :     ;; almost guaranteed to be different from compilation-buffer-modtime, so if
    1255             :     ;; we use their timestamp, we'll never use `loc' since the timestamp won't
    1256             :     ;; match compilation-buffer-modtime, and if we use
    1257             :     ;; compilation-buffer-modtime then we have different timestamps for
    1258             :     ;; locations that were computed together, which doesn't make sense either.
    1259             :     ;; I think this points to a fundamental problem in our approach to the
    1260             :     ;; "omake -P" problem.  --Stef
    1261           0 :     (or (cdr loc)
    1262           0 :         (setcdr loc (compilation--make-cdrloc line file-struct marker)))
    1263           0 :     (if end-loc
    1264           0 :         (or (cdr end-loc)
    1265           0 :             (setcdr end-loc
    1266           0 :                     (compilation--make-cdrloc (or end-line line) file-struct
    1267           0 :                                               end-marker))))
    1268             : 
    1269             :     ;; Must start with face
    1270           0 :     `(font-lock-face ,compilation-message-face
    1271           0 :       compilation-message ,(compilation--make-message loc type end-loc)
    1272           0 :       help-echo ,(if col
    1273             :                      "mouse-2: visit this file, line and column"
    1274           0 :                    (if line
    1275             :                        "mouse-2: visit this file and line"
    1276           0 :                      "mouse-2: visit this file"))
    1277             :       keymap compilation-button-map
    1278           0 :       mouse-face highlight)))
    1279             : 
    1280             : (defun compilation--put-prop (matchnum prop val)
    1281           0 :   (when (and (integerp matchnum) (match-beginning matchnum))
    1282           0 :     (put-text-property
    1283           0 :      (match-beginning matchnum) (match-end matchnum)
    1284           0 :      prop val)))
    1285             : 
    1286             : (defun compilation--remove-properties (&optional start end)
    1287           0 :   (with-silent-modifications
    1288             :     ;; When compile.el used font-lock directly, we could just remove all
    1289             :     ;; our text-properties in one go, but now that we manually place
    1290             :     ;; font-lock-face, we have to be careful to only remove the font-lock-face
    1291             :     ;; we placed.
    1292             :     ;; (remove-list-of-text-properties
    1293             :     ;;  (or start (point-min)) (or end (point-max))
    1294             :     ;;  '(compilation-debug compilation-directory compilation-message
    1295             :     ;;    font-lock-face help-echo mouse-face))
    1296           0 :     (let (next)
    1297           0 :       (unless start (setq start (point-min)))
    1298           0 :       (unless end (setq end (point-max)))
    1299           0 :       (compilation--flush-directory-cache start end)
    1300           0 :       (while
    1301           0 :           (progn
    1302           0 :             (setq next (or (next-single-property-change
    1303           0 :                             start 'compilation-message nil end)
    1304           0 :                            end))
    1305           0 :             (when (get-text-property start 'compilation-message)
    1306           0 :               (remove-list-of-text-properties
    1307           0 :                start next
    1308             :                '(compilation-debug compilation-directory compilation-message
    1309           0 :                  font-lock-face help-echo mouse-face)))
    1310           0 :             (< next end))
    1311           0 :         (setq start next)))))
    1312             : 
    1313             : (defun compilation--parse-region (start end)
    1314           0 :   (goto-char end)
    1315           0 :   (unless (bolp)
    1316             :     ;; We generally don't like to parse partial lines.
    1317           0 :     (cl-assert (eobp))
    1318           0 :     (when (let ((proc (get-buffer-process (current-buffer))))
    1319           0 :             (and proc (memq (process-status proc) '(run open))))
    1320           0 :       (setq end (line-beginning-position))))
    1321           0 :   (compilation--remove-properties start end)
    1322           0 :   (if compilation-parse-errors-function
    1323             :       ;; An old package!  Try the compatibility code.
    1324           0 :       (progn
    1325           0 :         (goto-char start)
    1326           0 :         (compilation--compat-parse-errors end))
    1327             : 
    1328             :     ;; compilation-directory-matcher is the only part that really needs to be
    1329             :     ;; parsed sequentially.  So we could split it out, handle directories
    1330             :     ;; like syntax-propertize, and the rest as font-lock-keywords.  But since
    1331             :     ;; we want to have it work even when font-lock is off, we'd then need to
    1332             :     ;; use our own compilation-parsed text-property to keep track of the parts
    1333             :     ;; that have already been parsed.
    1334           0 :     (goto-char start)
    1335           0 :     (while (re-search-forward (car compilation-directory-matcher)
    1336           0 :                               end t)
    1337           0 :       (compilation--flush-directory-cache (match-beginning 0) (match-end 0))
    1338           0 :       (when compilation-debug
    1339           0 :         (font-lock-append-text-property
    1340           0 :          (match-beginning 0) (match-end 0)
    1341             :          'compilation-debug
    1342           0 :          (vector 'directory compilation-directory-matcher)))
    1343           0 :       (dolist (elt (cdr compilation-directory-matcher))
    1344           0 :         (add-text-properties (match-beginning (car elt))
    1345           0 :                              (match-end (car elt))
    1346           0 :                              (compilation-directory-properties
    1347           0 :                               (car elt) (cdr elt)))))
    1348             : 
    1349           0 :     (compilation-parse-errors start end)))
    1350             : 
    1351             : (defun compilation--note-type (type)
    1352             :   "Note that a new message with severity TYPE was seen.
    1353             : This updates the appropriate variable used by the mode-line."
    1354           0 :   (cl-case type
    1355           0 :     (0 (cl-incf compilation-num-infos-found))
    1356           0 :     (1 (cl-incf compilation-num-warnings-found))
    1357           0 :     (2 (cl-incf compilation-num-errors-found))))
    1358             : 
    1359             : (defun compilation-parse-errors (start end &rest rules)
    1360             :   "Parse errors between START and END.
    1361             : The errors recognized are the ones specified in RULES which default
    1362             : to `compilation-error-regexp-alist' if RULES is nil."
    1363           0 :   (dolist (item (or rules compilation-error-regexp-alist))
    1364           0 :     (if (symbolp item)
    1365           0 :         (setq item (cdr (assq item
    1366           0 :                               compilation-error-regexp-alist-alist))))
    1367           0 :     (let ((file (nth 1 item))
    1368           0 :           (line (nth 2 item))
    1369           0 :           (col (nth 3 item))
    1370           0 :           (type (nth 4 item))
    1371           0 :           (pat (car item))
    1372             :           end-line end-col fmt
    1373             :           props)
    1374             : 
    1375             :       ;; omake reports some error indented, so skip the indentation.
    1376             :       ;; another solution is to modify (some?) regexps in
    1377             :       ;; `compilation-error-regexp-alist'.
    1378             :       ;; note that omake usage is not limited to ocaml and C (for stubs).
    1379             :       ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
    1380             :       ;; whether or not omake's own error messages are recognized.
    1381           0 :       (cond
    1382           0 :        ((not (memq 'omake compilation-error-regexp-alist)) nil)
    1383           0 :        ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
    1384             :         nil) ;; Not anchored or anchored but already allows empty spaces.
    1385           0 :        (t (setq pat (concat "^ *" (substring pat 1)))))
    1386             : 
    1387           0 :       (if (consp file)  (setq fmt (cdr file)      file (car file)))
    1388           0 :       (if (consp line)  (setq end-line (cdr line) line (car line)))
    1389           0 :       (if (consp col)   (setq end-col (cdr col)   col (car col)))
    1390             : 
    1391           0 :       (if (functionp line)
    1392             :           ;; The old compile.el had here an undocumented hook that
    1393             :           ;; allowed `line' to be a function that computed the actual
    1394             :           ;; error location.  Let's do our best.
    1395           0 :           (progn
    1396           0 :             (goto-char start)
    1397           0 :             (while (re-search-forward pat end t)
    1398           0 :               (save-match-data
    1399           0 :                 (when compilation-debug
    1400           0 :                   (font-lock-append-text-property
    1401           0 :                    (match-beginning 0) (match-end 0)
    1402           0 :                    'compilation-debug (vector 'functionp item)))
    1403           0 :                 (add-text-properties
    1404           0 :                  (match-beginning 0) (match-end 0)
    1405           0 :                  (compilation--compat-error-properties
    1406           0 :                   (funcall line (cons (match-string file)
    1407           0 :                                       (cons default-directory
    1408           0 :                                             (nthcdr 4 item)))
    1409           0 :                            (if col (match-string col))))))
    1410           0 :               (compilation--put-prop
    1411           0 :                file 'font-lock-face compilation-error-face)))
    1412             : 
    1413           0 :         (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
    1414           0 :           (error "HYPERLINK should be an integer: %s" (nth 5 item)))
    1415             : 
    1416           0 :         (goto-char start)
    1417           0 :         (while (re-search-forward pat end t)
    1418           0 :           (when (setq props (compilation-error-properties
    1419           0 :                              file line end-line col end-col (or type 2) fmt))
    1420             : 
    1421           0 :             (when (integerp file)
    1422           0 :               (setq type (if (consp type)
    1423           0 :                              (compilation-type type)
    1424           0 :                            (or type 2)))
    1425           0 :               (compilation--note-type type)
    1426             : 
    1427           0 :               (compilation--put-prop
    1428           0 :                file 'font-lock-face
    1429           0 :                (symbol-value (aref [compilation-info-face
    1430             :                                     compilation-warning-face
    1431             :                                     compilation-error-face]
    1432           0 :                                    type))))
    1433             : 
    1434           0 :             (compilation--put-prop
    1435           0 :              line 'font-lock-face compilation-line-face)
    1436           0 :             (compilation--put-prop
    1437           0 :              end-line 'font-lock-face compilation-line-face)
    1438             : 
    1439           0 :             (compilation--put-prop
    1440           0 :              col 'font-lock-face compilation-column-face)
    1441           0 :             (compilation--put-prop
    1442           0 :              end-col 'font-lock-face compilation-column-face)
    1443             : 
    1444             :             ;; Obey HIGHLIGHT.
    1445           0 :             (dolist (extra-item (nthcdr 6 item))
    1446           0 :               (let ((mn (pop extra-item)))
    1447           0 :                 (when (match-beginning mn)
    1448           0 :                   (let ((face (eval (car extra-item))))
    1449           0 :                     (cond
    1450           0 :                      ((null face))
    1451           0 :                      ((or (symbolp face) (stringp face))
    1452           0 :                       (put-text-property
    1453           0 :                        (match-beginning mn) (match-end mn)
    1454           0 :                        'font-lock-face face))
    1455           0 :                      ((and (listp face)
    1456           0 :                            (eq (car face) 'face)
    1457           0 :                            (or (symbolp (cadr face))
    1458           0 :                                (stringp (cadr face))))
    1459           0 :                       (compilation--put-prop mn 'font-lock-face (cadr face))
    1460           0 :                       (add-text-properties
    1461           0 :                        (match-beginning mn) (match-end mn)
    1462           0 :                        (nthcdr 2 face)))
    1463             :                      (t
    1464           0 :                       (error "Don't know how to handle face %S"
    1465           0 :                              face)))))))
    1466           0 :             (let ((mn (or (nth 5 item) 0)))
    1467           0 :               (when compilation-debug
    1468           0 :                 (font-lock-append-text-property
    1469           0 :                  (match-beginning 0) (match-end 0)
    1470           0 :                  'compilation-debug (vector 'std item props)))
    1471           0 :               (add-text-properties
    1472           0 :                (match-beginning mn) (match-end mn)
    1473           0 :                (cddr props))
    1474           0 :               (font-lock-append-text-property
    1475           0 :                (match-beginning mn) (match-end mn)
    1476           0 :                'font-lock-face (cadr props)))))))))
    1477             : 
    1478             : (defvar compilation--parsed -1)
    1479             : (make-variable-buffer-local 'compilation--parsed)
    1480             : 
    1481             : (defun compilation--ensure-parse (limit)
    1482             :   "Make sure the text has been parsed up to LIMIT."
    1483           0 :   (save-excursion
    1484           0 :     (goto-char limit)
    1485           0 :     (setq limit (line-beginning-position 2))
    1486           0 :     (unless (markerp compilation--parsed)
    1487             :       ;; We use a marker for compilation--parsed so that users (such as
    1488             :       ;; grep.el) don't need to flush-parse when they modify the buffer
    1489             :       ;; in a way that impacts buffer positions but does not require
    1490             :       ;; re-parsing.
    1491           0 :       (setq compilation--parsed (point-min-marker)))
    1492           0 :     (when (< compilation--parsed limit)
    1493           0 :       (let ((start (max compilation--parsed (point-min))))
    1494           0 :         (move-marker compilation--parsed limit)
    1495           0 :         (goto-char start)
    1496           0 :         (forward-line 0)  ;Not line-beginning-position: ignore (comint) fields.
    1497           0 :         (while (and (not (bobp))
    1498           0 :                     (get-text-property (1- (point)) 'compilation-multiline))
    1499           0 :           (forward-line -1))
    1500           0 :         (with-silent-modifications
    1501           0 :           (compilation--parse-region (point) compilation--parsed)))))
    1502             :   nil)
    1503             : 
    1504             : (defun compilation--flush-parse (start _end)
    1505             :   "Mark the region between START and END for re-parsing."
    1506           0 :   (if (markerp compilation--parsed)
    1507           0 :       (move-marker compilation--parsed (min start compilation--parsed))))
    1508             : 
    1509             : (defun compilation-mode-font-lock-keywords ()
    1510             :   "Return expressions to highlight in Compilation mode."
    1511           0 :   (append
    1512             :    '((compilation--ensure-parse))
    1513           0 :    compilation-mode-font-lock-keywords))
    1514             : 
    1515             : (defun compilation-read-command (command)
    1516           0 :   (read-shell-command "Compile command: " command
    1517           0 :                       (if (equal (car compile-history) command)
    1518             :                           '(compile-history . 1)
    1519           0 :                         'compile-history)))
    1520             : 
    1521             : 
    1522             : ;;;###autoload
    1523             : (defun compile (command &optional comint)
    1524             :   "Compile the program including the current buffer.  Default: run `make'.
    1525             : Runs COMMAND, a shell command, in a separate process asynchronously
    1526             : with output going to the buffer `*compilation*'.
    1527             : 
    1528             : You can then use the command \\[next-error] to find the next error message
    1529             : and move to the source code that caused it.
    1530             : 
    1531             : If optional second arg COMINT is t the buffer will be in Comint mode with
    1532             : `compilation-shell-minor-mode'.
    1533             : 
    1534             : Interactively, prompts for the command if the variable
    1535             : `compilation-read-command' is non-nil; otherwise uses `compile-command'.
    1536             : With prefix arg, always prompts.
    1537             : Additionally, with universal prefix arg, compilation buffer will be in
    1538             : comint mode, i.e. interactive.
    1539             : 
    1540             : To run more than one compilation at once, start one then rename
    1541             : the `*compilation*' buffer to some other name with
    1542             : \\[rename-buffer].  Then _switch buffers_ and start the new compilation.
    1543             : It will create a new `*compilation*' buffer.
    1544             : 
    1545             : On most systems, termination of the main compilation process
    1546             : kills its subprocesses.
    1547             : 
    1548             : The name used for the buffer is actually whatever is returned by
    1549             : the function in `compilation-buffer-name-function', so you can set that
    1550             : to a function that generates a unique name."
    1551             :   (interactive
    1552           0 :    (list
    1553           0 :     (let ((command (eval compile-command)))
    1554           0 :       (if (or compilation-read-command current-prefix-arg)
    1555           0 :           (compilation-read-command command)
    1556           0 :         command))
    1557           0 :     (consp current-prefix-arg)))
    1558           0 :   (unless (equal command (eval compile-command))
    1559           0 :     (setq compile-command command))
    1560           0 :   (save-some-buffers (not compilation-ask-about-save)
    1561           0 :                      compilation-save-buffers-predicate)
    1562           0 :   (setq-default compilation-directory default-directory)
    1563           0 :   (compilation-start command comint))
    1564             : 
    1565             : ;; run compile with the default command line
    1566             : (defun recompile (&optional edit-command)
    1567             :   "Re-compile the program including the current buffer.
    1568             : If this is run in a Compilation mode buffer, re-use the arguments from the
    1569             : original use.  Otherwise, recompile using `compile-command'.
    1570             : If the optional argument `edit-command' is non-nil, the command can be edited."
    1571             :   (interactive "P")
    1572           0 :   (save-some-buffers (not compilation-ask-about-save)
    1573           0 :                      compilation-save-buffers-predicate)
    1574           0 :   (let ((default-directory (or compilation-directory default-directory))
    1575           0 :         (command (eval compile-command)))
    1576           0 :     (when edit-command
    1577           0 :       (setq command (compilation-read-command (or (car compilation-arguments)
    1578           0 :                                                   command)))
    1579           0 :       (if compilation-arguments (setcar compilation-arguments command)))
    1580           0 :     (apply 'compilation-start (or compilation-arguments (list command)))))
    1581             : 
    1582             : (defcustom compilation-scroll-output nil
    1583             :   "Non-nil to scroll the *compilation* buffer window as output appears.
    1584             : 
    1585             : Setting it causes the Compilation mode commands to put point at the
    1586             : end of their output window so that the end of the output is always
    1587             : visible rather than the beginning.
    1588             : 
    1589             : The value `first-error' stops scrolling at the first error, and leaves
    1590             : point on its location in the *compilation* buffer."
    1591             :   :type '(choice (const :tag "No scrolling" nil)
    1592             :                  (const :tag "Scroll compilation output" t)
    1593             :                  (const :tag "Stop scrolling at the first error" first-error))
    1594             :   :version "20.3"
    1595             :   :group 'compilation)
    1596             : 
    1597             : 
    1598             : (defun compilation-buffer-name (name-of-mode mode-command name-function)
    1599             :   "Return the name of a compilation buffer to use.
    1600             : If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE
    1601             : to determine the buffer name.
    1602             : Likewise if `compilation-buffer-name-function' is non-nil.
    1603             : If current buffer has the major mode MODE-COMMAND,
    1604             : return the name of the current buffer, so that it gets reused.
    1605             : Otherwise, construct a buffer name from NAME-OF-MODE."
    1606           0 :   (cond (name-function
    1607           0 :          (funcall name-function name-of-mode))
    1608           0 :         (compilation-buffer-name-function
    1609           0 :          (funcall compilation-buffer-name-function name-of-mode))
    1610           0 :         ((eq mode-command major-mode)
    1611           0 :          (buffer-name))
    1612             :         (t
    1613           0 :          (concat "*" (downcase name-of-mode) "*"))))
    1614             : 
    1615             : (defcustom compilation-always-kill nil
    1616             :   "If t, always kill a running compilation process before starting a new one.
    1617             : If nil, ask to kill it."
    1618             :   :type 'boolean
    1619             :   :version "24.3"
    1620             :   :group 'compilation)
    1621             : 
    1622             : ;;;###autoload
    1623             : (defun compilation-start (command &optional mode name-function highlight-regexp)
    1624             :   "Run compilation command COMMAND (low level interface).
    1625             : If COMMAND starts with a cd command, that becomes the `default-directory'.
    1626             : The rest of the arguments are optional; for them, nil means use the default.
    1627             : 
    1628             : MODE is the major mode to set in the compilation buffer.  Mode
    1629             : may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
    1630             : 
    1631             : If NAME-FUNCTION is non-nil, call it with one argument (the mode name)
    1632             : to determine the buffer name.  Otherwise, the default is to
    1633             : reuses the current buffer if it has the proper major mode,
    1634             : else use or create a buffer with name based on the major mode.
    1635             : 
    1636             : If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
    1637             : the matching section of the visited source line; the default is to use the
    1638             : global value of `compilation-highlight-regexp'.
    1639             : 
    1640             : Returns the compilation buffer created."
    1641           0 :   (or mode (setq mode 'compilation-mode))
    1642           0 :   (let* ((name-of-mode
    1643           0 :           (if (eq mode t)
    1644             :               "compilation"
    1645           0 :             (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
    1646           0 :          (thisdir default-directory)
    1647           0 :          (thisenv compilation-environment)
    1648             :          outwin outbuf)
    1649           0 :     (with-current-buffer
    1650           0 :         (setq outbuf
    1651           0 :               (get-buffer-create
    1652           0 :                (compilation-buffer-name name-of-mode mode name-function)))
    1653           0 :       (let ((comp-proc (get-buffer-process (current-buffer))))
    1654           0 :       (if comp-proc
    1655           0 :           (if (or (not (eq (process-status comp-proc) 'run))
    1656           0 :                   (eq (process-query-on-exit-flag comp-proc) nil)
    1657           0 :                   (yes-or-no-p
    1658           0 :                    (format "A %s process is running; kill it? "
    1659           0 :                            name-of-mode)))
    1660           0 :               (condition-case ()
    1661           0 :                   (progn
    1662           0 :                     (interrupt-process comp-proc)
    1663           0 :                     (sit-for 1)
    1664           0 :                     (delete-process comp-proc))
    1665           0 :                 (error nil))
    1666           0 :             (error "Cannot have two processes in `%s' at once"
    1667           0 :                    (buffer-name)))))
    1668             :       ;; first transfer directory from where M-x compile was called
    1669           0 :       (setq default-directory thisdir)
    1670             :       ;; Make compilation buffer read-only.  The filter can still write it.
    1671             :       ;; Clear out the compilation buffer.
    1672           0 :       (let ((inhibit-read-only t)
    1673           0 :             (default-directory thisdir))
    1674             :         ;; Then evaluate a cd command if any, but don't perform it yet, else
    1675             :         ;; start-command would do it again through the shell: (cd "..") AND
    1676             :         ;; sh -c "cd ..; make"
    1677           0 :         (cd (cond
    1678           0 :              ((not (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\|'[^']*'\\|\"\\(?:[^\"`$\\]\\|\\\\.\\)*\"\\)\\)?\\s *[;&\n]"
    1679           0 :                                  command))
    1680           0 :               default-directory)
    1681           0 :              ((not (match-end 1)) "~")
    1682           0 :              ((eq (aref command (match-beginning 1)) ?\')
    1683           0 :               (substring command (1+ (match-beginning 1))
    1684           0 :                          (1- (match-end 1))))
    1685           0 :              ((eq (aref command (match-beginning 1)) ?\")
    1686           0 :               (replace-regexp-in-string
    1687             :                "\\\\\\(.\\)" "\\1"
    1688           0 :                (substring command (1+ (match-beginning 1))
    1689           0 :                           (1- (match-end 1)))))
    1690             :              ;; Try globbing as well (bug#15417).
    1691           0 :              (t (let* ((substituted-dir
    1692           0 :                         (substitute-env-vars (match-string 1 command)))
    1693             :                        ;; FIXME: This also tries to expand `*' that were
    1694             :                        ;; introduced by the envvar expansion!
    1695             :                        (expanded-dir
    1696           0 :                         (file-expand-wildcards substituted-dir)))
    1697           0 :                   (if (= (length expanded-dir) 1)
    1698           0 :                       (car expanded-dir)
    1699           0 :                     substituted-dir)))))
    1700           0 :         (erase-buffer)
    1701             :         ;; Select the desired mode.
    1702           0 :         (if (not (eq mode t))
    1703           0 :             (progn
    1704           0 :               (buffer-disable-undo)
    1705           0 :               (funcall mode))
    1706           0 :           (setq buffer-read-only nil)
    1707           0 :           (with-no-warnings (comint-mode))
    1708           0 :           (compilation-shell-minor-mode))
    1709             :         ;; Remember the original dir, so we can use it when we recompile.
    1710             :         ;; default-directory' can't be used reliably for that because it may be
    1711             :         ;; affected by the special handling of "cd ...;".
    1712             :         ;; NB: must be done after (funcall mode) as that resets local variables
    1713           0 :         (set (make-local-variable 'compilation-directory) thisdir)
    1714           0 :         (set (make-local-variable 'compilation-environment) thisenv)
    1715           0 :         (if highlight-regexp
    1716           0 :             (set (make-local-variable 'compilation-highlight-regexp)
    1717           0 :                  highlight-regexp))
    1718           0 :         (if (or compilation-auto-jump-to-first-error
    1719           0 :                 (eq compilation-scroll-output 'first-error))
    1720           0 :             (set (make-local-variable 'compilation-auto-jump-to-next) t))
    1721             :         ;; Output a mode setter, for saving and later reloading this buffer.
    1722           0 :         (insert "-*- mode: " name-of-mode
    1723             :                 "; default-directory: "
    1724           0 :                 (prin1-to-string (abbreviate-file-name default-directory))
    1725             :                 " -*-\n"
    1726           0 :                 (format "%s started at %s\n\n"
    1727           0 :                         mode-name
    1728           0 :                         (substring (current-time-string) 0 19))
    1729           0 :                 command "\n")
    1730           0 :         (setq thisdir default-directory))
    1731           0 :       (set-buffer-modified-p nil))
    1732             :     ;; Pop up the compilation buffer.
    1733             :     ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
    1734           0 :     (setq outwin (display-buffer outbuf '(nil (allow-no-window . t))))
    1735           0 :     (with-current-buffer outbuf
    1736           0 :       (let ((process-environment
    1737           0 :              (append
    1738           0 :               compilation-environment
    1739           0 :               (if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
    1740           0 :                       system-uses-terminfo)
    1741           0 :                   (list "TERM=dumb" "TERMCAP="
    1742           0 :                         (format "COLUMNS=%d" (window-width)))
    1743           0 :                 (list "TERM=emacs"
    1744           0 :                       (format "TERMCAP=emacs:co#%d:tc=unknown:"
    1745           0 :                               (window-width))))
    1746           0 :               (list (format "INSIDE_EMACS=%s,compile" emacs-version))
    1747           0 :               (copy-sequence process-environment))))
    1748           0 :         (set (make-local-variable 'compilation-arguments)
    1749           0 :              (list command mode name-function highlight-regexp))
    1750           0 :         (set (make-local-variable 'revert-buffer-function)
    1751           0 :              'compilation-revert-buffer)
    1752           0 :         (and outwin
    1753             :              ;; Forcing the window-start overrides the usual redisplay
    1754             :              ;; feature of bringing point into view, so setting the
    1755             :              ;; window-start to top of the buffer risks losing the
    1756             :              ;; effect of moving point to EOB below, per
    1757             :              ;; compilation-scroll-output, if the command is long
    1758             :              ;; enough to push point outside of the window.  This
    1759             :              ;; could happen, e.g., in `rgrep'.
    1760           0 :              (not compilation-scroll-output)
    1761           0 :              (set-window-start outwin (point-min)))
    1762             : 
    1763             :         ;; Position point as the user will see it.
    1764           0 :         (let ((desired-visible-point
    1765             :                ;; Put it at the end if `compilation-scroll-output' is set.
    1766           0 :                (if compilation-scroll-output
    1767           0 :                    (point-max)
    1768             :                  ;; Normally put it at the top.
    1769           0 :                  (point-min))))
    1770           0 :           (goto-char desired-visible-point)
    1771           0 :           (when (and outwin (not (eq outwin (selected-window))))
    1772           0 :             (set-window-point outwin desired-visible-point)))
    1773             : 
    1774             :         ;; The setup function is called before compilation-set-window-height
    1775             :         ;; so it can set the compilation-window-height buffer locally.
    1776           0 :         (if compilation-process-setup-function
    1777           0 :             (funcall compilation-process-setup-function))
    1778           0 :         (and outwin (compilation-set-window-height outwin))
    1779             :         ;; Start the compilation.
    1780           0 :         (if (fboundp 'make-process)
    1781           0 :             (let ((proc
    1782           0 :                    (if (eq mode t)
    1783             :                        ;; comint uses `start-file-process'.
    1784           0 :                        (get-buffer-process
    1785           0 :                         (with-no-warnings
    1786           0 :                           (comint-exec
    1787           0 :                            outbuf (downcase mode-name)
    1788           0 :                            (if (file-remote-p default-directory)
    1789             :                                "/bin/sh"
    1790           0 :                              shell-file-name)
    1791           0 :                            nil `("-c" ,command))))
    1792           0 :                      (start-file-process-shell-command (downcase mode-name)
    1793           0 :                                                        outbuf command))))
    1794             :               ;; Make the buffer's mode line show process state.
    1795           0 :               (setq mode-line-process
    1796             :                     '((:propertize ":%s" face compilation-mode-line-run)
    1797           0 :                       compilation-mode-line-errors))
    1798             : 
    1799             :               ;; Set the process as killable without query by default.
    1800             :               ;; This allows us to start a new compilation without
    1801             :               ;; getting prompted.
    1802           0 :               (when compilation-always-kill
    1803           0 :                 (set-process-query-on-exit-flag proc nil))
    1804             : 
    1805           0 :               (set-process-sentinel proc 'compilation-sentinel)
    1806           0 :               (unless (eq mode t)
    1807             :                 ;; Keep the comint filter, since it's needed for proper
    1808             :                 ;; handling of the prompts.
    1809           0 :                 (set-process-filter proc 'compilation-filter))
    1810             :               ;; Use (point-max) here so that output comes in
    1811             :               ;; after the initial text,
    1812             :               ;; regardless of where the user sees point.
    1813           0 :               (set-marker (process-mark proc) (point-max) outbuf)
    1814           0 :               (when compilation-disable-input
    1815           0 :                 (condition-case nil
    1816           0 :                     (process-send-eof proc)
    1817             :                   ;; The process may have exited already.
    1818           0 :                   (error nil)))
    1819           0 :               (run-hook-with-args 'compilation-start-hook proc)
    1820           0 :               (setq compilation-in-progress
    1821           0 :                     (cons proc compilation-in-progress)))
    1822             :           ;; No asynchronous processes available.
    1823           0 :           (message "Executing `%s'..." command)
    1824             :           ;; Fake mode line display as if `start-process' were run.
    1825           0 :           (setq mode-line-process
    1826             :                 '((:propertize ":run" face compilation-mode-line-run)
    1827           0 :                   compilation-mode-line-errors))
    1828           0 :           (force-mode-line-update)
    1829           0 :           (sit-for 0)                   ; Force redisplay
    1830           0 :           (save-excursion
    1831             :             ;; Insert the output at the end, after the initial text,
    1832             :             ;; regardless of where the user sees point.
    1833           0 :             (goto-char (point-max))
    1834           0 :             (let* ((inhibit-read-only t) ; call-process needs to modify outbuf
    1835           0 :                    (compilation-filter-start (point))
    1836           0 :                    (status (call-process shell-file-name nil outbuf nil "-c"
    1837           0 :                                          command)))
    1838           0 :               (run-hooks 'compilation-filter-hook)
    1839           0 :               (cond ((numberp status)
    1840           0 :                      (compilation-handle-exit
    1841           0 :                       'exit status
    1842           0 :                       (if (zerop status)
    1843             :                           "finished\n"
    1844           0 :                         (format "exited abnormally with code %d\n" status))))
    1845           0 :                     ((stringp status)
    1846           0 :                      (compilation-handle-exit 'signal status
    1847           0 :                                               (concat status "\n")))
    1848             :                     (t
    1849           0 :                      (compilation-handle-exit 'bizarre status status)))))
    1850           0 :           (set-buffer-modified-p nil)
    1851           0 :           (message "Executing `%s'...done" command)))
    1852             :       ;; Now finally cd to where the shell started make/grep/...
    1853           0 :       (setq default-directory thisdir)
    1854             :       ;; The following form selected outwin ever since revision 1.183,
    1855             :       ;; so possibly messing up point in some other window (bug#1073).
    1856             :       ;; Moved into the scope of with-current-buffer, though still with
    1857             :       ;; complete disregard for the case when compilation-scroll-output
    1858             :       ;; equals 'first-error (martin 2008-10-04).
    1859           0 :       (when compilation-scroll-output
    1860           0 :         (goto-char (point-max))))
    1861             : 
    1862             :     ;; Make it so the next C-x ` will use this buffer.
    1863           0 :     (setq next-error-last-buffer outbuf)))
    1864             : 
    1865             : (defun compilation-set-window-height (window)
    1866             :   "Set the height of WINDOW according to `compilation-window-height'."
    1867           0 :   (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
    1868           0 :     (and height
    1869           0 :          (window-full-width-p window)
    1870             :          ;; If window is alone in its frame, aside from a minibuffer,
    1871             :          ;; don't change its height.
    1872           0 :          (not (eq window (frame-root-window (window-frame window))))
    1873             :          ;; Stef said that doing the saves in this order is safer:
    1874           0 :          (save-excursion
    1875           0 :            (save-selected-window
    1876           0 :              (select-window window)
    1877           0 :              (enlarge-window (- height (window-height))))))))
    1878             : 
    1879             : (defvar compilation-menu-map
    1880             :   (let ((map (make-sparse-keymap "Errors"))
    1881             :         (opt-map (make-sparse-keymap "Skip")))
    1882             :     (define-key map [stop-subjob]
    1883             :       '(menu-item "Stop Compilation" kill-compilation
    1884             :                   :help "Kill the process made by the M-x compile or M-x grep commands"))
    1885             :     (define-key map [compilation-mode-separator3]
    1886             :       '("----" . nil))
    1887             :     (define-key map [compilation-next-error-follow-minor-mode]
    1888             :       '(menu-item
    1889             :         "Auto Error Display" next-error-follow-minor-mode
    1890             :         :help "Display the error under cursor when moving the cursor"
    1891             :         :button (:toggle . next-error-follow-minor-mode)))
    1892             :     (define-key map [compilation-skip]
    1893             :       (cons "Skip Less Important Messages" opt-map))
    1894             :     (define-key opt-map [compilation-skip-none]
    1895             :       '(menu-item "Don't Skip Any Messages"
    1896             :                   (lambda ()
    1897             :                     (interactive)
    1898             :                     (customize-set-variable 'compilation-skip-threshold 0))
    1899             :                   :help "Do not skip any type of messages"
    1900             :                   :button (:radio . (eq compilation-skip-threshold 0))))
    1901             :     (define-key opt-map [compilation-skip-info]
    1902             :       '(menu-item "Skip Info"
    1903             :                   (lambda ()
    1904             :                     (interactive)
    1905             :                     (customize-set-variable 'compilation-skip-threshold 1))
    1906             :                   :help "Skip anything less than warning"
    1907             :                   :button (:radio . (eq compilation-skip-threshold 1))))
    1908             :     (define-key opt-map [compilation-skip-warning-and-info]
    1909             :       '(menu-item "Skip Warnings and Info"
    1910             :                   (lambda ()
    1911             :                     (interactive)
    1912             :                     (customize-set-variable 'compilation-skip-threshold 2))
    1913             :                   :help "Skip over Warnings and Info, stop for errors"
    1914             :                   :button (:radio . (eq compilation-skip-threshold 2))))
    1915             :     (define-key map [compilation-mode-separator2]
    1916             :       '("----" . nil))
    1917             :     (define-key map [compilation-first-error]
    1918             :       '(menu-item "First Error" first-error
    1919             :                   :help "Restart at the first error, visit corresponding source code"))
    1920             :     (define-key map [compilation-previous-error]
    1921             :       '(menu-item "Previous Error" previous-error
    1922             :                   :help "Visit previous `next-error' message and corresponding source code"))
    1923             :     (define-key map [compilation-next-error]
    1924             :       '(menu-item "Next Error" next-error
    1925             :                   :help "Visit next `next-error' message and corresponding source code"))
    1926             :     map))
    1927             : 
    1928             : (defvar compilation-minor-mode-map
    1929             :   (let ((map (make-sparse-keymap)))
    1930             :     (set-keymap-parent map special-mode-map)
    1931             :     (define-key map [mouse-2] 'compile-goto-error)
    1932             :     (define-key map [follow-link] 'mouse-face)
    1933             :     (define-key map "\C-c\C-c" 'compile-goto-error)
    1934             :     (define-key map "\C-m" 'compile-goto-error)
    1935             :     (define-key map "\C-o" 'compilation-display-error)
    1936             :     (define-key map "\C-c\C-k" 'kill-compilation)
    1937             :     (define-key map "\M-n" 'compilation-next-error)
    1938             :     (define-key map "\M-p" 'compilation-previous-error)
    1939             :     (define-key map "\M-{" 'compilation-previous-file)
    1940             :     (define-key map "\M-}" 'compilation-next-file)
    1941             :     (define-key map "g" 'recompile) ; revert
    1942             :     ;; Set up the menu-bar
    1943             :     (define-key map [menu-bar compilation]
    1944             :       (cons "Errors" compilation-menu-map))
    1945             :     map)
    1946             :   "Keymap for `compilation-minor-mode'.")
    1947             : 
    1948             : (defvar compilation-shell-minor-mode-map
    1949             :   (let ((map (make-sparse-keymap)))
    1950             :     (define-key map "\M-\C-m" 'compile-goto-error)
    1951             :     (define-key map "\M-\C-n" 'compilation-next-error)
    1952             :     (define-key map "\M-\C-p" 'compilation-previous-error)
    1953             :     (define-key map "\M-{" 'compilation-previous-file)
    1954             :     (define-key map "\M-}" 'compilation-next-file)
    1955             :     ;; Set up the menu-bar
    1956             :     (define-key map [menu-bar compilation]
    1957             :       (cons "Errors" compilation-menu-map))
    1958             :     map)
    1959             :   "Keymap for `compilation-shell-minor-mode'.")
    1960             : 
    1961             : (defvar compilation-button-map
    1962             :   (let ((map (make-sparse-keymap)))
    1963             :     (define-key map [mouse-2] 'compile-goto-error)
    1964             :     (define-key map [follow-link] 'mouse-face)
    1965             :     (define-key map "\C-m" 'compile-goto-error)
    1966             :     map)
    1967             :   "Keymap for compilation-message buttons.")
    1968             : (fset 'compilation-button-map compilation-button-map)
    1969             : 
    1970             : (defvar compilation-mode-map
    1971             :   (let ((map (make-sparse-keymap)))
    1972             :     ;; Don't inherit from compilation-minor-mode-map,
    1973             :     ;; because that introduces a menu bar item we don't want.
    1974             :     ;; That confuses C-down-mouse-3.
    1975             :     (set-keymap-parent map special-mode-map)
    1976             :     (define-key map [mouse-2] 'compile-goto-error)
    1977             :     (define-key map [follow-link] 'mouse-face)
    1978             :     (define-key map "\C-c\C-c" 'compile-goto-error)
    1979             :     (define-key map "\C-m" 'compile-goto-error)
    1980             :     (define-key map "\C-o" 'compilation-display-error)
    1981             :     (define-key map "\C-c\C-k" 'kill-compilation)
    1982             :     (define-key map "\M-n" 'compilation-next-error)
    1983             :     (define-key map "\M-p" 'compilation-previous-error)
    1984             :     (define-key map "\M-{" 'compilation-previous-file)
    1985             :     (define-key map "\M-}" 'compilation-next-file)
    1986             :     (define-key map "\t" 'compilation-next-error)
    1987             :     (define-key map [backtab] 'compilation-previous-error)
    1988             :     (define-key map "g" 'recompile) ; revert
    1989             : 
    1990             :     (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
    1991             : 
    1992             :     ;; Set up the menu-bar
    1993             :     (let ((submap (make-sparse-keymap "Compile")))
    1994             :       (define-key map [menu-bar compilation]
    1995             :         (cons "Compile" submap))
    1996             :       (set-keymap-parent submap compilation-menu-map))
    1997             :     (define-key map [menu-bar compilation compilation-separator2]
    1998             :       '("----" . nil))
    1999             :     (define-key map [menu-bar compilation compilation-grep]
    2000             :       '(menu-item "Search Files (grep)..." grep
    2001             :                   :help "Run grep, with user-specified args, and collect output in a buffer"))
    2002             :     (define-key map [menu-bar compilation compilation-recompile]
    2003             :       '(menu-item "Recompile" recompile
    2004             :         :help "Re-compile the program including the current buffer"))
    2005             :     (define-key map [menu-bar compilation compilation-compile]
    2006             :       '(menu-item "Compile..." compile
    2007             :                   :help "Compile the program including the current buffer.  Default: run `make'"))
    2008             :     map)
    2009             :   "Keymap for compilation log buffers.
    2010             : `compilation-minor-mode-map' is a parent of this.")
    2011             : 
    2012             : (defvar compilation-mode-tool-bar-map
    2013             :   ;; When bootstrapping, tool-bar-map is not properly initialized yet,
    2014             :   ;; so don't do anything.
    2015             :   (when (keymapp tool-bar-map)
    2016             :     (let ((map (copy-keymap tool-bar-map)))
    2017             :       (define-key map [undo] nil)
    2018             :       (define-key map [separator-2] nil)
    2019             :       (define-key-after map [separator-compile] menu-bar-separator)
    2020             :       (tool-bar-local-item
    2021             :        "left-arrow" 'previous-error-no-select 'previous-error-no-select map
    2022             :        :rtl "right-arrow"
    2023             :        :help "Goto previous error")
    2024             :       (tool-bar-local-item
    2025             :        "right-arrow" 'next-error-no-select 'next-error-no-select map
    2026             :        :rtl "left-arrow"
    2027             :        :help "Goto next error")
    2028             :       (tool-bar-local-item
    2029             :        "cancel" 'kill-compilation 'kill-compilation map
    2030             :        :enable '(let ((buffer (compilation-find-buffer)))
    2031             :                   (get-buffer-process buffer))
    2032             :        :help "Stop compilation")
    2033             :       (tool-bar-local-item
    2034             :        "refresh" 'recompile 'recompile map
    2035             :        :help "Restart compilation")
    2036             :       map)))
    2037             : 
    2038             : (put 'compilation-mode 'mode-class 'special)
    2039             : 
    2040             : ;;;###autoload
    2041             : (defun compilation-mode (&optional name-of-mode)
    2042             :   "Major mode for compilation log buffers.
    2043             : \\<compilation-mode-map>To visit the source for a line-numbered error,
    2044             : move point to the error message line and type \\[compile-goto-error].
    2045             : To kill the compilation, type \\[kill-compilation].
    2046             : 
    2047             : Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
    2048             : 
    2049             : \\{compilation-mode-map}"
    2050             :   (interactive)
    2051           0 :   (kill-all-local-variables)
    2052           0 :   (use-local-map compilation-mode-map)
    2053             :   ;; Let windows scroll along with the output.
    2054           0 :   (set (make-local-variable 'window-point-insertion-type) t)
    2055           0 :   (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
    2056           0 :   (setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
    2057           0 :         mode-name (or name-of-mode "Compilation"))
    2058           0 :   (set (make-local-variable 'page-delimiter)
    2059           0 :        compilation-page-delimiter)
    2060             :   ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
    2061           0 :   (compilation-setup)
    2062             :   ;; Turn off deferred fontifications in the compilation buffer, if
    2063             :   ;; the user turned them on globally.  This is because idle timers
    2064             :   ;; aren't re-run after receiving input from a subprocess, so the
    2065             :   ;; buffer is left unfontified after the compilation exits, until
    2066             :   ;; some other input event happens.
    2067           0 :   (set (make-local-variable 'jit-lock-defer-time) nil)
    2068           0 :   (setq buffer-read-only t)
    2069           0 :   (run-mode-hooks 'compilation-mode-hook))
    2070             : 
    2071             : ;;;###autoload
    2072             : (put 'define-compilation-mode 'doc-string-elt 3)
    2073             : 
    2074             : (defmacro define-compilation-mode (mode name doc &rest body)
    2075             :   "This is like `define-derived-mode' without the PARENT argument.
    2076             : The parent is always `compilation-mode' and the customizable `compilation-...'
    2077             : variables are also set from the name of the mode you have chosen,
    2078             : by replacing the first word, e.g., `compilation-scroll-output' from
    2079             : `grep-scroll-output' if that variable exists."
    2080           0 :   (let ((mode-name (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
    2081           0 :     `(define-derived-mode ,mode compilation-mode ,name
    2082           0 :        ,doc
    2083           0 :        ,@(mapcar (lambda (v)
    2084           0 :                    (setq v (cons v
    2085           0 :                                  (intern-soft (replace-regexp-in-string
    2086           0 :                                                "^compilation" mode-name
    2087           0 :                                                (symbol-name v)))))
    2088           0 :                    (and (cdr v)
    2089           0 :                         (or (boundp (cdr v))
    2090             :                             ;; FIXME: This is hackish, using undocumented info.
    2091           0 :                             (if (boundp 'byte-compile-bound-variables)
    2092           0 :                                 (memq (cdr v) byte-compile-bound-variables)))
    2093           0 :                         `(set (make-local-variable ',(car v)) ,(cdr v))))
    2094             :                  '(compilation-buffer-name-function
    2095             :                    compilation-directory-matcher
    2096             :                    compilation-error
    2097             :                    compilation-error-regexp-alist
    2098             :                    compilation-error-regexp-alist-alist
    2099             :                    compilation-error-screen-columns
    2100             :                    compilation-finish-function
    2101             :                    compilation-finish-functions
    2102             :                    compilation-first-column
    2103             :                    compilation-mode-font-lock-keywords
    2104             :                    compilation-page-delimiter
    2105             :                    compilation-parse-errors-filename-function
    2106             :                    compilation-process-setup-function
    2107             :                    compilation-scroll-output
    2108             :                    compilation-search-path
    2109             :                    compilation-skip-threshold
    2110           0 :                    compilation-window-height))
    2111           0 :        ,@body)))
    2112             : 
    2113             : (defun compilation-revert-buffer (ignore-auto noconfirm)
    2114           0 :   (if buffer-file-name
    2115           0 :       (let (revert-buffer-function)
    2116           0 :         (revert-buffer ignore-auto noconfirm))
    2117           0 :     (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
    2118           0 :         (apply 'compilation-start compilation-arguments))))
    2119             : 
    2120             : (defvar compilation-current-error nil
    2121             :   "Marker to the location from where the next error will be found.
    2122             : The global commands next/previous/first-error/goto-error use this.")
    2123             : 
    2124             : (defvar compilation-messages-start nil
    2125             :   "Buffer position of the beginning of the compilation messages.
    2126             : If nil, use the beginning of buffer.")
    2127             : 
    2128             : (defun compilation-setup (&optional minor)
    2129             :   "Prepare the buffer for the compilation parsing commands to work.
    2130             : Optional argument MINOR indicates this is called from
    2131             : `compilation-minor-mode'."
    2132           0 :   (make-local-variable 'compilation-current-error)
    2133           0 :   (make-local-variable 'compilation-messages-start)
    2134           0 :   (make-local-variable 'compilation-error-screen-columns)
    2135           0 :   (make-local-variable 'overlay-arrow-position)
    2136           0 :   (setq-local compilation-num-errors-found 0)
    2137           0 :   (setq-local compilation-num-warnings-found 0)
    2138           0 :   (setq-local compilation-num-infos-found 0)
    2139           0 :   (set (make-local-variable 'overlay-arrow-string) "")
    2140           0 :   (setq next-error-overlay-arrow-position nil)
    2141           0 :   (add-hook 'kill-buffer-hook
    2142           0 :             (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
    2143             :   ;; Note that compilation-next-error-function is for interfacing
    2144             :   ;; with the next-error function in simple.el, and it's only
    2145             :   ;; coincidentally named similarly to compilation-next-error.
    2146           0 :   (setq next-error-function 'compilation-next-error-function)
    2147           0 :   (set (make-local-variable 'comint-file-name-prefix)
    2148           0 :        (or (file-remote-p default-directory) ""))
    2149           0 :   (set (make-local-variable 'compilation-locs)
    2150           0 :        (make-hash-table :test 'equal :weakness 'value))
    2151             :   ;; It's generally preferable to use after-change-functions since they
    2152             :   ;; can be subject to combine-after-change-calls, but if we do that, we risk
    2153             :   ;; running our hook after font-lock, resulting in incorrect refontification.
    2154           0 :   (add-hook 'before-change-functions 'compilation--flush-parse nil t)
    2155             :   ;; Also for minor mode, since it's not permanent-local.
    2156           0 :   (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t)
    2157           0 :   (if minor
    2158           0 :       (progn
    2159           0 :         (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
    2160           0 :         (font-lock-flush))
    2161           0 :     (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
    2162             : 
    2163             : (defun compilation--unsetup ()
    2164             :   ;; Only for minor mode.
    2165           0 :   (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
    2166           0 :   (remove-hook 'before-change-functions 'compilation--flush-parse t)
    2167           0 :   (kill-local-variable 'compilation--parsed)
    2168           0 :   (compilation--remove-properties)
    2169           0 :   (font-lock-flush))
    2170             : 
    2171             : ;;;###autoload
    2172             : (define-minor-mode compilation-shell-minor-mode
    2173             :   "Toggle Compilation Shell minor mode.
    2174             : With a prefix argument ARG, enable Compilation Shell minor mode
    2175             : if ARG is positive, and disable it otherwise.  If called from
    2176             : Lisp, enable the mode if ARG is omitted or nil.
    2177             : 
    2178             : When Compilation Shell minor mode is enabled, all the
    2179             : error-parsing commands of the Compilation major mode are
    2180             : available but bound to keys that don't collide with Shell mode.
    2181             : See `compilation-mode'."
    2182             :   nil " Shell-Compile"
    2183             :   :group 'compilation
    2184           0 :   (if compilation-shell-minor-mode
    2185           0 :       (compilation-setup t)
    2186           0 :     (compilation--unsetup)))
    2187             : 
    2188             : ;;;###autoload
    2189             : (define-minor-mode compilation-minor-mode
    2190             :   "Toggle Compilation minor mode.
    2191             : With a prefix argument ARG, enable Compilation minor mode if ARG
    2192             : is positive, and disable it otherwise.  If called from Lisp,
    2193             : enable the mode if ARG is omitted or nil.
    2194             : 
    2195             : When Compilation minor mode is enabled, all the error-parsing
    2196             : commands of Compilation major mode are available.  See
    2197             : `compilation-mode'."
    2198             :   nil " Compilation"
    2199             :   :group 'compilation
    2200           0 :   (if compilation-minor-mode
    2201           0 :       (compilation-setup t)
    2202           0 :     (compilation--unsetup)))
    2203             : 
    2204             : (defun compilation-handle-exit (process-status exit-status msg)
    2205             :   "Write MSG in the current buffer and hack its `mode-line-process'."
    2206           0 :   (let ((inhibit-read-only t)
    2207           0 :         (status (if compilation-exit-message-function
    2208           0 :                     (funcall compilation-exit-message-function
    2209           0 :                              process-status exit-status msg)
    2210           0 :                   (cons msg exit-status)))
    2211           0 :         (omax (point-max))
    2212           0 :         (opoint (point))
    2213           0 :         (cur-buffer (current-buffer)))
    2214             :     ;; Record where we put the message, so we can ignore it later on.
    2215           0 :     (goto-char omax)
    2216           0 :     (insert ?\n mode-name " " (car status))
    2217           0 :     (if (and (numberp compilation-window-height)
    2218           0 :              (zerop compilation-window-height))
    2219           0 :         (message "%s" (cdr status)))
    2220           0 :     (if (bolp)
    2221           0 :         (forward-char -1))
    2222           0 :     (insert " at " (substring (current-time-string) 0 19))
    2223           0 :     (goto-char (point-max))
    2224             :     ;; Prevent that message from being recognized as a compilation error.
    2225           0 :     (add-text-properties omax (point)
    2226           0 :                          (append '(compilation-handle-exit t) nil))
    2227           0 :     (setq mode-line-process
    2228           0 :           (list
    2229           0 :            (let ((out-string (format ":%s [%s]" process-status (cdr status)))
    2230           0 :                  (msg (format "%s %s" mode-name
    2231           0 :                               (replace-regexp-in-string "\n?$" ""
    2232           0 :                                                         (car status)))))
    2233           0 :              (message "%s" msg)
    2234           0 :              (propertize out-string
    2235           0 :                          'help-echo msg
    2236           0 :                          'face (if (> exit-status 0)
    2237             :                                    'compilation-mode-line-fail
    2238           0 :                                  'compilation-mode-line-exit)))
    2239           0 :            compilation-mode-line-errors))
    2240             :     ;; Force mode line redisplay soon.
    2241           0 :     (force-mode-line-update)
    2242           0 :     (if (and opoint (< opoint omax))
    2243           0 :         (goto-char opoint))
    2244           0 :     (with-no-warnings
    2245           0 :       (if compilation-finish-function
    2246           0 :           (funcall compilation-finish-function cur-buffer msg)))
    2247           0 :     (run-hook-with-args 'compilation-finish-functions cur-buffer msg)))
    2248             : 
    2249             : ;; Called when compilation process changes state.
    2250             : (defun compilation-sentinel (proc msg)
    2251             :   "Sentinel for compilation buffers."
    2252           0 :   (if (memq (process-status proc) '(exit signal))
    2253           0 :       (let ((buffer (process-buffer proc)))
    2254           0 :         (if (null (buffer-name buffer))
    2255             :             ;; buffer killed
    2256           0 :             (set-process-buffer proc nil)
    2257           0 :           (with-current-buffer buffer
    2258             :             ;; Write something in the compilation buffer
    2259             :             ;; and hack its mode line.
    2260           0 :             (compilation-handle-exit (process-status proc)
    2261           0 :                                      (process-exit-status proc)
    2262           0 :                                      msg)
    2263             :             ;; Since the buffer and mode line will show that the
    2264             :             ;; process is dead, we can delete it now.  Otherwise it
    2265             :             ;; will stay around until M-x list-processes.
    2266           0 :             (delete-process proc)))
    2267           0 :         (setq compilation-in-progress (delq proc compilation-in-progress)))))
    2268             : 
    2269             : (defun compilation-filter (proc string)
    2270             :   "Process filter for compilation buffers.
    2271             : Just inserts the text,
    2272             : handles carriage motion (see `comint-inhibit-carriage-motion'),
    2273             : and runs `compilation-filter-hook'."
    2274           0 :   (when (buffer-live-p (process-buffer proc))
    2275           0 :     (with-current-buffer (process-buffer proc)
    2276           0 :       (let ((inhibit-read-only t)
    2277             :             ;; `save-excursion' doesn't use the right insertion-type for us.
    2278           0 :             (pos (copy-marker (point) t))
    2279             :             ;; `save-restriction' doesn't use the right insertion type either:
    2280             :             ;; If we are inserting at the end of the accessible part of the
    2281             :             ;; buffer, keep the inserted text visible.
    2282           0 :             (min (point-min-marker))
    2283           0 :             (max (copy-marker (point-max) t))
    2284           0 :             (compilation-filter-start (marker-position (process-mark proc))))
    2285           0 :         (unwind-protect
    2286           0 :             (progn
    2287           0 :               (widen)
    2288           0 :               (goto-char compilation-filter-start)
    2289             :               ;; We used to use `insert-before-markers', so that windows with
    2290             :               ;; point at `process-mark' scroll along with the output, but we
    2291             :               ;; now use window-point-insertion-type instead.
    2292           0 :               (insert string)
    2293           0 :               (unless comint-inhibit-carriage-motion
    2294           0 :                 (comint-carriage-motion (process-mark proc) (point)))
    2295           0 :               (set-marker (process-mark proc) (point))
    2296             :               ;; (set (make-local-variable 'compilation-buffer-modtime)
    2297             :               ;;      (current-time))
    2298           0 :               (run-hooks 'compilation-filter-hook))
    2299           0 :           (goto-char pos)
    2300           0 :           (narrow-to-region min max)
    2301           0 :           (set-marker pos nil)
    2302           0 :           (set-marker min nil)
    2303           0 :           (set-marker max nil))))))
    2304             : 
    2305             : ;;; test if a buffer is a compilation buffer, assuming we're in the buffer
    2306             : (defsubst compilation-buffer-internal-p ()
    2307             :   "Test if inside a compilation buffer."
    2308           0 :   (local-variable-p 'compilation-locs))
    2309             : 
    2310             : ;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
    2311             : (defsubst compilation-buffer-p (buffer)
    2312             :   "Test if BUFFER is a compilation buffer."
    2313           0 :   (with-current-buffer buffer
    2314           0 :     (compilation-buffer-internal-p)))
    2315             : 
    2316             : (defmacro compilation-loop (< property-change 1+ error limit)
    2317           2 :   `(let (opt)
    2318           2 :      (while (,< n 0)
    2319             :        (setq opt pt)
    2320           2 :        (or (setq pt (,property-change pt 'compilation-message))
    2321             :            ;; Handle the case where where the first error message is
    2322             :            ;; at the start of the buffer, and n < 0.
    2323           2 :            (if (or (eq (get-text-property ,limit 'compilation-message)
    2324             :                        (get-text-property opt 'compilation-message))
    2325             :                    (eq pt opt))
    2326           2 :                (user-error ,error compilation-error)
    2327           2 :              (setq pt ,limit)))
    2328             :        ;; prop 'compilation-message usually has 2 changes, on and off, so
    2329             :        ;; re-search if off
    2330             :        (or (setq msg (get-text-property pt 'compilation-message))
    2331           2 :            (if (setq pt (,property-change pt 'compilation-message nil ,limit))
    2332             :                (setq msg (get-text-property pt 'compilation-message)))
    2333           2 :            (user-error ,error compilation-error))
    2334             :        (or (< (compilation--message->type msg) compilation-skip-threshold)
    2335             :            (if different-file
    2336             :                (eq (prog1 last
    2337             :                      (setq last (compilation--loc->file-struct
    2338             :                                  (compilation--message->loc msg))))
    2339             :                    last))
    2340             :            (if compilation-skip-visited
    2341             :                (compilation--loc->visited (compilation--message->loc msg)))
    2342             :            (if compilation-skip-to-next-location
    2343             :                (eq (compilation--message->loc msg) loc))
    2344             :            ;; count this message only if none of the above are true
    2345           2 :            (setq n (,1+ n))))))
    2346             : 
    2347             : (defun compilation-next-single-property-change (position prop
    2348             :                                                 &optional object limit)
    2349           0 :   (let (parsed res)
    2350           0 :     (while (progn
    2351             :              ;; We parse the buffer here "on-demand" by chunks of 500 chars.
    2352             :              ;; But we could also just parse the whole buffer.
    2353           0 :              (compilation--ensure-parse
    2354           0 :               (setq parsed (max compilation--parsed
    2355           0 :                                 (min (+ position 500)
    2356           0 :                                      (or limit (point-max))))))
    2357           0 :              (and (or (not (setq res (next-single-property-change
    2358           0 :                                       position prop object limit)))
    2359           0 :                       (eq res limit))
    2360           0 :                   (< position (or limit (point-max)))))
    2361           0 :       (setq position parsed))
    2362           0 :     res))
    2363             : 
    2364             : (defun compilation-next-error (n &optional different-file pt)
    2365             :   "Move point to the next error in the compilation buffer.
    2366             : This function does NOT find the source line like \\[next-error].
    2367             : Prefix arg N says how many error messages to move forwards (or
    2368             : backwards, if negative).
    2369             : Optional arg DIFFERENT-FILE, if non-nil, means find next error for a
    2370             : file that is different from the current one.
    2371             : Optional arg PT, if non-nil, specifies the value of point to start
    2372             : looking for the next message."
    2373             :   (interactive "p")
    2374           0 :   (or (compilation-buffer-p (current-buffer))
    2375           0 :       (error "Not in a compilation buffer"))
    2376           0 :   (or pt (setq pt (point)))
    2377           0 :   (compilation--ensure-parse pt)
    2378           0 :   (let* ((msg (get-text-property pt 'compilation-message))
    2379             :          ;; `loc', `msg', and `last' are used by the compilation-loop macro.
    2380           0 :          (loc (and msg (compilation--message->loc msg)))
    2381             :          last)
    2382           0 :     (if (zerop n)
    2383           0 :         (unless (or msg                 ; find message near here
    2384           0 :                     (setq msg (get-text-property (max (1- pt) (point-min))
    2385           0 :                                                  'compilation-message)))
    2386           0 :           (setq pt (previous-single-property-change pt 'compilation-message nil
    2387           0 :                                                     (line-beginning-position)))
    2388           0 :           (unless (setq msg (get-text-property (max (1- pt) (point-min))
    2389           0 :                                                'compilation-message))
    2390           0 :             (setq pt (compilation-next-single-property-change
    2391           0 :                       pt 'compilation-message nil
    2392           0 :                                                   (line-end-position)))
    2393           0 :             (or (setq msg (get-text-property pt 'compilation-message))
    2394           0 :                 (setq pt (point)))))
    2395           0 :       (setq last (compilation--loc->file-struct loc))
    2396           0 :       (if (>= n 0)
    2397           0 :           (compilation-loop > compilation-next-single-property-change 1-
    2398             :                             (if (get-buffer-process (current-buffer))
    2399             :                                 "No more %ss yet"
    2400             :                               "Moved past last %s")
    2401           0 :                             (point-max))
    2402             :         ;; Don't move "back" to message at or before point.
    2403             :         ;; Pass an explicit (point-min) to make sure pt is non-nil.
    2404           0 :         (setq pt (previous-single-property-change
    2405           0 :                   pt 'compilation-message nil (point-min)))
    2406           0 :         (compilation-loop < previous-single-property-change 1+
    2407           0 :                           "Moved back before first %s" (point-min))))
    2408           0 :     (goto-char pt)
    2409           0 :     (or msg
    2410           0 :         (error "No %s here" compilation-error))))
    2411             : 
    2412             : (defun compilation-previous-error (n)
    2413             :   "Move point to the previous error in the compilation buffer.
    2414             : Prefix arg N says how many error messages to move backwards (or
    2415             : forwards, if negative).
    2416             : Does NOT find the source line like \\[previous-error]."
    2417             :   (interactive "p")
    2418           0 :   (compilation-next-error (- n)))
    2419             : 
    2420             : (defun compilation-next-file (n)
    2421             :   "Move point to the next error for a different file than the current one.
    2422             : Prefix arg N says how many files to move forwards (or backwards, if negative)."
    2423             :   (interactive "p")
    2424           0 :   (compilation-next-error n t))
    2425             : 
    2426             : (defun compilation-previous-file (n)
    2427             :   "Move point to the previous error for a different file than the current one.
    2428             : Prefix arg N says how many files to move backwards (or forwards, if negative)."
    2429             :   (interactive "p")
    2430           0 :   (compilation-next-file (- n)))
    2431             : 
    2432             : (defun compilation-display-error ()
    2433             :   "Display the source for current error in another window."
    2434             :   (interactive)
    2435           0 :   (setq compilation-current-error (point))
    2436           0 :   (next-error-no-select 0))
    2437             : 
    2438             : (defun kill-compilation ()
    2439             :   "Kill the process made by the \\[compile] or \\[grep] commands."
    2440             :   (interactive)
    2441           0 :   (let ((buffer (compilation-find-buffer)))
    2442           0 :     (if (get-buffer-process buffer)
    2443           0 :         (interrupt-process (get-buffer-process buffer))
    2444           0 :       (error "The %s process is not running" (downcase mode-name)))))
    2445             : 
    2446             : (defalias 'compile-mouse-goto-error 'compile-goto-error)
    2447             : 
    2448             : (defun compile-goto-error (&optional event)
    2449             :   "Visit the source for the error message at point.
    2450             : Use this command in a compilation log buffer."
    2451           0 :   (interactive (list last-input-event))
    2452           0 :   (if event (posn-set-point (event-end event)))
    2453           0 :   (or (compilation-buffer-p (current-buffer))
    2454           0 :       (error "Not in a compilation buffer"))
    2455           0 :   (compilation--ensure-parse (point))
    2456           0 :   (if (get-text-property (point) 'compilation-directory)
    2457           0 :       (dired-other-window
    2458           0 :        (car (get-text-property (point) 'compilation-directory)))
    2459           0 :     (setq compilation-current-error (point))
    2460           0 :     (next-error-internal)))
    2461             : 
    2462             : ;; This is mostly unused, but we keep it for the sake of some external
    2463             : ;; packages which seem to make use of it.
    2464             : (defun compilation-find-buffer (&optional avoid-current)
    2465             :   "Return a compilation buffer.
    2466             : If AVOID-CURRENT is nil, and the current buffer is a compilation buffer,
    2467             : return it.  If AVOID-CURRENT is non-nil, return the current buffer only
    2468             : as a last resort."
    2469           0 :   (if (and (compilation-buffer-internal-p) (not avoid-current))
    2470           0 :       (current-buffer)
    2471           0 :     (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)))
    2472             : 
    2473             : ;;;###autoload
    2474             : (defun compilation-next-error-function (n &optional reset)
    2475             :   "Advance to the next error message and visit the file where the error was.
    2476             : This is the value of `next-error-function' in Compilation buffers."
    2477             :   (interactive "p")
    2478           0 :   (when reset
    2479           0 :     (setq compilation-current-error nil))
    2480           0 :   (let* ((screen-columns compilation-error-screen-columns)
    2481           0 :          (first-column compilation-first-column)
    2482             :          (last 1)
    2483           0 :          (msg (compilation-next-error (or n 1) nil
    2484           0 :                                       (or compilation-current-error
    2485           0 :                                           compilation-messages-start
    2486           0 :                                           (point-min))))
    2487           0 :          (loc (compilation--message->loc msg))
    2488           0 :          (end-loc (compilation--message->end-loc msg))
    2489           0 :          (marker (point-marker)))
    2490           0 :     (setq compilation-current-error (point-marker)
    2491             :           overlay-arrow-position
    2492           0 :             (if (bolp)
    2493           0 :                 compilation-current-error
    2494           0 :               (copy-marker (line-beginning-position))))
    2495             :     ;; If loc contains no marker, no error in that file has been visited.
    2496             :     ;; If the marker is invalid the buffer has been killed.
    2497             :     ;; So, recalculate all markers for that file.
    2498           0 :     (unless (and (compilation--loc->marker loc)
    2499           0 :                  (marker-buffer (compilation--loc->marker loc))
    2500             :                  ;; FIXME-omake: For "omake -P", which automatically recompiles
    2501             :                  ;; when the file is modified, the line numbers of new output
    2502             :                  ;; may not be related to line numbers from earlier output
    2503             :                  ;; (earlier markers), so we used to try to detect it here and
    2504             :                  ;; force a reparse.  But that caused more problems elsewhere,
    2505             :                  ;; so instead we now flush the file-structure when we see
    2506             :                  ;; omake's message telling it's about to recompile a file.
    2507             :                  ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc
    2508             :                  ;;     (equal (compilation--loc->timestamp loc)
    2509             :                  ;;            (setq timestamp compilation-buffer-modtime)))
    2510           0 :                  )
    2511           0 :       (with-current-buffer
    2512           0 :           (apply #'compilation-find-file
    2513           0 :                  marker
    2514           0 :                  (caar (compilation--loc->file-struct loc))
    2515           0 :                  (cadr (car (compilation--loc->file-struct loc)))
    2516           0 :                  (compilation--file-struct->formats
    2517           0 :                   (compilation--loc->file-struct loc)))
    2518           0 :         (let ((screen-columns
    2519             :                ;; Obey the compilation-error-screen-columns of the target
    2520             :                ;; buffer if its major mode set it buffer-locally.
    2521           0 :                (if (local-variable-p 'compilation-error-screen-columns)
    2522           0 :                    compilation-error-screen-columns screen-columns))
    2523             :               (compilation-first-column
    2524           0 :                (if (local-variable-p 'compilation-first-column)
    2525           0 :                    compilation-first-column first-column)))
    2526           0 :           (save-restriction
    2527           0 :             (widen)
    2528           0 :             (goto-char (point-min))
    2529             :             ;; Treat file's found lines in forward order, 1 by 1.
    2530           0 :             (dolist (line (reverse (cddr (compilation--loc->file-struct loc))))
    2531           0 :               (when (car line)          ; else this is a filename w/o a line#
    2532           0 :                 (compilation-beginning-of-line (- (car line) last -1))
    2533           0 :                 (setq last (car line)))
    2534             :               ;; Treat line's found columns and store/update a marker for each.
    2535           0 :               (dolist (col (cdr line))
    2536           0 :                 (if (compilation--loc->col col)
    2537           0 :                     (if (eq (compilation--loc->col col) -1)
    2538             :                         ;; Special case for range end.
    2539           0 :                         (end-of-line)
    2540           0 :                       (compilation-move-to-column (compilation--loc->col col)
    2541           0 :                                                   screen-columns))
    2542           0 :                   (beginning-of-line)
    2543           0 :                   (skip-chars-forward " \t"))
    2544           0 :                 (if (compilation--loc->marker col)
    2545           0 :                     (set-marker (compilation--loc->marker col) (point))
    2546           0 :                   (setf (compilation--loc->marker col) (point-marker)))
    2547             :                 ;; (setf (compilation--loc->timestamp col) timestamp)
    2548           0 :                 ))))))
    2549           0 :     (compilation-goto-locus marker (compilation--loc->marker loc)
    2550           0 :                             (compilation--loc->marker end-loc))
    2551           0 :     (setf (compilation--loc->visited loc) t)))
    2552             : 
    2553             : (defvar compilation-gcpro nil
    2554             :   "Internal variable used to keep some values from being GC'd.")
    2555             : (make-variable-buffer-local 'compilation-gcpro)
    2556             : 
    2557             : (defun compilation-fake-loc (marker file &optional line col)
    2558             :   "Preassociate MARKER with FILE.
    2559             : FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
    2560             : This is useful when you compile temporary files, but want
    2561             : automatic translation of the messages to the real buffer from
    2562             : which the temporary file came.  This may also affect previous messages
    2563             : about FILE.
    2564             : 
    2565             : Optional args LINE and COL default to 1 and beginning of
    2566             : indentation respectively.  The marker is expected to reflect
    2567             : this.  In the simplest case the marker points to the first line
    2568             : of the region that was saved to the temp file.
    2569             : 
    2570             : If you concatenate several regions into the temp file (e.g. a
    2571             : header with variable assignments and a code region), you must
    2572             : call this several times, once each for the last line of one
    2573             : region and the first line of the next region."
    2574           0 :   (or (consp file) (setq file (list file)))
    2575           0 :   (compilation--flush-file-structure file)
    2576           0 :   (let ((fs (compilation-get-file-structure file)))
    2577             :     ;; Between the current call to compilation-fake-loc and the first
    2578             :     ;; occurrence of an error message referring to `file', the data is
    2579             :     ;; only kept in the weak hash-table compilation-locs, so we need
    2580             :     ;; to prevent this entry in compilation-locs from being GC'd
    2581             :     ;; away.  --Stef
    2582           0 :     (push fs compilation-gcpro)
    2583           0 :     (let ((loc (compilation-assq (or line 1) (cdr fs))))
    2584           0 :       (setq loc (compilation-assq col loc))
    2585           0 :       (cl-assert (null (cdr loc)))
    2586           0 :       (setcdr loc (compilation--make-cdrloc line fs marker))
    2587           0 :       loc)))
    2588             : 
    2589             : (defcustom compilation-context-lines nil
    2590             :   "Display this many lines of leading context before the current message.
    2591             : If nil and the left fringe is displayed, don't scroll the
    2592             : compilation output window; an arrow in the left fringe points to
    2593             : the current message.  If nil and there is no left fringe, the message
    2594             : displays at the top of the window; there is no arrow."
    2595             :   :type '(choice integer (const :tag "No window scrolling" nil))
    2596             :   :group 'compilation
    2597             :   :version "22.1")
    2598             : 
    2599             : (defsubst compilation-set-window (w mk)
    2600             :   "Align the compilation output window W with marker MK near top."
    2601           0 :   (if (integerp compilation-context-lines)
    2602           0 :       (set-window-start w (save-excursion
    2603           0 :                             (goto-char mk)
    2604           0 :                             (compilation-beginning-of-line
    2605           0 :                              (- 1 compilation-context-lines))
    2606           0 :                             (point)))
    2607             :     ;; If there is no left fringe.
    2608           0 :     (when (equal (car (window-fringes w)) 0)
    2609           0 :       (set-window-start w (save-excursion
    2610           0 :                             (goto-char mk)
    2611           0 :                             (beginning-of-line 1)
    2612           0 :                             (point)))))
    2613           0 :     (set-window-point w mk))
    2614             : 
    2615             : (defvar next-error-highlight-timer)
    2616             : 
    2617             : (defun compilation-goto-locus (msg mk end-mk)
    2618             :   "Jump to an error corresponding to MSG at MK.
    2619             : All arguments are markers.  If END-MK is non-nil, mark is set there
    2620             : and overlay is highlighted between MK and END-MK."
    2621             :   ;; Show compilation buffer in other window, scrolled to this error.
    2622           0 :   (let* ((from-compilation-buffer (eq (window-buffer)
    2623           0 :                                       (marker-buffer msg)))
    2624             :          ;; Use an existing window if it is in a visible frame.
    2625           0 :          (pre-existing (get-buffer-window (marker-buffer msg) 0))
    2626           0 :          (w (if (and from-compilation-buffer pre-existing)
    2627             :                 ;; Calling display-buffer here may end up (partly) hiding
    2628             :                 ;; the error location if the two buffers are in two
    2629             :                 ;; different frames.  So don't do it if it's not necessary.
    2630           0 :                 pre-existing
    2631           0 :               (display-buffer (marker-buffer msg) '(nil (allow-no-window . t)))))
    2632           0 :          (highlight-regexp (with-current-buffer (marker-buffer msg)
    2633             :                              ;; also do this while we change buffer
    2634           0 :                              (goto-char (marker-position msg))
    2635           0 :                              (and w (compilation-set-window w msg))
    2636           0 :                              compilation-highlight-regexp)))
    2637             :     ;; Ideally, the window-size should be passed to `display-buffer'
    2638             :     ;; so it's only used when creating a new window.
    2639           0 :     (when (and (not pre-existing) w)
    2640           0 :       (compilation-set-window-height w))
    2641             : 
    2642           0 :     (if from-compilation-buffer
    2643             :         ;; If the compilation buffer window was selected,
    2644             :         ;; keep the compilation buffer in this window;
    2645             :         ;; display the source in another window.
    2646           0 :         (let ((pop-up-windows t))
    2647           0 :           (pop-to-buffer (marker-buffer mk) 'other-window))
    2648           0 :       (switch-to-buffer (marker-buffer mk)))
    2649           0 :     (unless (eq (goto-char mk) (point))
    2650             :       ;; If narrowing gets in the way of going to the right place, widen.
    2651           0 :       (widen)
    2652           0 :       (if next-error-move-function
    2653           0 :           (funcall next-error-move-function msg mk)
    2654           0 :         (goto-char mk)))
    2655           0 :     (if end-mk
    2656           0 :         (push-mark end-mk t)
    2657           0 :       (if mark-active (setq mark-active nil)))
    2658             :     ;; If hideshow got in the way of
    2659             :     ;; seeing the right place, open permanently.
    2660           0 :     (dolist (ov (overlays-at (point)))
    2661           0 :       (when (eq 'hs (overlay-get ov 'invisible))
    2662           0 :         (delete-overlay ov)
    2663           0 :         (goto-char mk)))
    2664             : 
    2665           0 :     (when highlight-regexp
    2666           0 :       (if (timerp next-error-highlight-timer)
    2667           0 :           (cancel-timer next-error-highlight-timer))
    2668           0 :       (unless compilation-highlight-overlay
    2669           0 :         (setq compilation-highlight-overlay
    2670           0 :               (make-overlay (point-min) (point-min)))
    2671           0 :         (overlay-put compilation-highlight-overlay 'face 'next-error))
    2672           0 :       (with-current-buffer (marker-buffer mk)
    2673           0 :         (save-excursion
    2674           0 :           (if end-mk (goto-char end-mk) (end-of-line))
    2675           0 :           (let ((end (point)))
    2676           0 :             (if mk (goto-char mk) (beginning-of-line))
    2677           0 :             (if (and (stringp highlight-regexp)
    2678           0 :                      (re-search-forward highlight-regexp end t))
    2679           0 :                 (progn
    2680           0 :                   (goto-char (match-beginning 0))
    2681           0 :                   (move-overlay compilation-highlight-overlay
    2682           0 :                                 (match-beginning 0) (match-end 0)
    2683           0 :                                 (current-buffer)))
    2684           0 :               (move-overlay compilation-highlight-overlay
    2685           0 :                             (point) end (current-buffer)))
    2686           0 :             (if (or (eq next-error-highlight t)
    2687           0 :                     (numberp next-error-highlight))
    2688             :                 ;; We want highlighting: delete overlay on next input.
    2689           0 :                 (add-hook 'pre-command-hook
    2690           0 :                           'compilation-goto-locus-delete-o)
    2691             :               ;; We don't want highlighting: delete overlay now.
    2692           0 :               (delete-overlay compilation-highlight-overlay))
    2693             :             ;; We want highlighting for a limited time:
    2694             :             ;; set up a timer to delete it.
    2695           0 :             (when (numberp next-error-highlight)
    2696           0 :               (setq next-error-highlight-timer
    2697           0 :                     (run-at-time next-error-highlight nil
    2698           0 :                                  'compilation-goto-locus-delete-o)))))))
    2699           0 :     (when (and (eq next-error-highlight 'fringe-arrow))
    2700             :       ;; We want a fringe arrow (instead of highlighting).
    2701           0 :       (setq next-error-overlay-arrow-position
    2702           0 :             (copy-marker (line-beginning-position))))))
    2703             : 
    2704             : (defun compilation-goto-locus-delete-o ()
    2705           0 :   (delete-overlay compilation-highlight-overlay)
    2706             :   ;; Get rid of timer and hook that would try to do this again.
    2707           0 :   (if (timerp next-error-highlight-timer)
    2708           0 :       (cancel-timer next-error-highlight-timer))
    2709           0 :   (remove-hook 'pre-command-hook
    2710           0 :                'compilation-goto-locus-delete-o))
    2711             : 
    2712             : (defun compilation-find-file (marker filename directory &rest formats)
    2713             :   "Find a buffer for file FILENAME.
    2714             : If FILENAME is not found at all, ask the user where to find it.
    2715             : Pop up the buffer containing MARKER and scroll to MARKER if we ask
    2716             : the user where to find the file.
    2717             : Search the directories in `compilation-search-path'.
    2718             : A nil in `compilation-search-path' means to try the
    2719             : \"current\" directory, which is passed in DIRECTORY.
    2720             : If DIRECTORY is relative, it is combined with `default-directory'.
    2721             : If DIRECTORY is nil, that means use `default-directory'.
    2722             : FORMATS, if given, is a list of formats to reformat FILENAME when
    2723             : looking for it: for each element FMT in FORMATS, this function
    2724             : attempts to find a file whose name is produced by (format FMT FILENAME)."
    2725           0 :   (or formats (setq formats '("%s")))
    2726           0 :   (let ((dirs compilation-search-path)
    2727           0 :         (spec-dir (if directory
    2728           0 :                       (expand-file-name directory)
    2729           0 :                     default-directory))
    2730             :         buffer thisdir fmts name)
    2731           0 :     (if (file-name-absolute-p filename)
    2732             :         ;; The file name is absolute.  Use its explicit directory as
    2733             :         ;; the first in the search path, and strip it from FILENAME.
    2734           0 :         (setq filename (abbreviate-file-name (expand-file-name filename))
    2735           0 :               dirs (cons (file-name-directory filename) dirs)
    2736           0 :               filename (file-name-nondirectory filename)))
    2737             :     ;; Now search the path.
    2738           0 :     (while (and dirs (null buffer))
    2739           0 :       (setq thisdir (or (car dirs) spec-dir)
    2740           0 :             fmts formats)
    2741             :       ;; For each directory, try each format string.
    2742           0 :       (while (and fmts (null buffer))
    2743           0 :         (setq name (expand-file-name (format (car fmts) filename) thisdir)
    2744           0 :               buffer (and (file-exists-p name)
    2745           0 :                           (find-file-noselect name))
    2746           0 :               fmts (cdr fmts)))
    2747           0 :       (setq dirs (cdr dirs)))
    2748           0 :     (while (null buffer)    ;Repeat until the user selects an existing file.
    2749             :       ;; The file doesn't exist.  Ask the user where to find it.
    2750           0 :       (save-excursion            ;This save-excursion is probably not right.
    2751           0 :         (let ((w (let ((pop-up-windows t))
    2752           0 :                    (display-buffer (marker-buffer marker)
    2753           0 :                                    '(nil (allow-no-window . t))))))
    2754           0 :           (with-current-buffer (marker-buffer marker)
    2755           0 :             (goto-char marker)
    2756           0 :             (and w (compilation-set-window w marker)))
    2757           0 :           (let* ((name (read-file-name
    2758           0 :                         (format "Find this %s in (default %s): "
    2759           0 :                                 compilation-error filename)
    2760           0 :                         spec-dir filename t nil
    2761             :                         ;; The predicate below is fine when called from
    2762             :                         ;; minibuffer-complete-and-exit, but it's too
    2763             :                         ;; restrictive otherwise, since it also prevents the
    2764             :                         ;; user from completing "fo" to "foo/" when she
    2765             :                         ;; wants to enter "foo/bar".
    2766             :                         ;;
    2767             :                         ;; Try to make sure the user can only select
    2768             :                         ;; a valid answer.  This predicate may be ignored,
    2769             :                         ;; tho, so we still have to double-check afterwards.
    2770             :                         ;; TODO: We should probably fix read-file-name so
    2771             :                         ;; that it never ignores this predicate, even when
    2772             :                         ;; using popup dialog boxes.
    2773             :                         ;; (lambda (name)
    2774             :                         ;;   (if (file-directory-p name)
    2775             :                         ;;       (setq name (expand-file-name filename name)))
    2776             :                         ;;   (file-exists-p name))
    2777           0 :                         ))
    2778           0 :                  (origname name))
    2779           0 :             (cond
    2780           0 :              ((not (file-exists-p name))
    2781           0 :               (message "Cannot find file `%s'" name)
    2782           0 :               (ding) (sit-for 2))
    2783           0 :              ((and (file-directory-p name)
    2784           0 :                    (not (file-exists-p
    2785           0 :                          (setq name (expand-file-name filename name)))))
    2786           0 :               (message "No `%s' in directory %s" filename origname)
    2787           0 :               (ding) (sit-for 2))
    2788             :              (t
    2789           0 :               (setq buffer (find-file-noselect name))))))))
    2790             :     ;; Make intangible overlays tangible.
    2791             :     ;; This is weird: it's not even clear which is the current buffer,
    2792             :     ;; so the code below can't be expected to DTRT here.  -- Stef
    2793           0 :     (dolist (ov (overlays-in (point-min) (point-max)))
    2794           0 :       (when (overlay-get ov 'intangible)
    2795           0 :         (overlay-put ov 'intangible nil)))
    2796           0 :     buffer))
    2797             : 
    2798             : (defun compilation-get-file-structure (file &optional fmt)
    2799             :   "Retrieve FILE's file-structure or create a new one.
    2800             : FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
    2801             : In the former case, FILENAME may be relative or absolute.
    2802             : 
    2803             : The file-structure looks like this:
    2804             :   ((FILENAME [TRUE-DIRNAME]) FMT ...)
    2805             : 
    2806             : TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
    2807           0 :   (or (gethash file compilation-locs)
    2808             :       ;; File was not previously encountered, at least not in the form passed.
    2809             :       ;; Let's normalize it and look again.
    2810           0 :       (let ((filename (car file))
    2811             :             ;; Get the specified directory from FILE.
    2812           0 :             (spec-directory (if (cdr file)
    2813           0 :                                 (file-truename (cdr file)))))
    2814             : 
    2815             :         ;; Check for a comint-file-name-prefix and prepend it if appropriate.
    2816             :         ;; (This is very useful for compilation-minor-mode in an rlogin-mode
    2817             :         ;; buffer.)
    2818           0 :         (when (and (boundp 'comint-file-name-prefix)
    2819           0 :                    (not (equal comint-file-name-prefix "")))
    2820           0 :           (if (file-name-absolute-p filename)
    2821           0 :               (setq filename
    2822           0 :                     (concat comint-file-name-prefix filename))
    2823           0 :             (if spec-directory
    2824           0 :                 (setq spec-directory
    2825           0 :                       (file-truename
    2826           0 :                        (concat comint-file-name-prefix spec-directory))))))
    2827             : 
    2828             :         ;; If compilation-parse-errors-filename-function is
    2829             :         ;; defined, use it to process the filename.
    2830           0 :         (when compilation-parse-errors-filename-function
    2831           0 :           (setq filename
    2832           0 :                 (funcall compilation-parse-errors-filename-function
    2833           0 :                          filename)))
    2834             : 
    2835             :         ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
    2836             :         ;; file names like "./bar//foo.c" for file "bar/foo.c";
    2837             :         ;; expand-file-name will collapse these into "/foo.c" and fail to find
    2838             :         ;; the appropriate file.  So we look for doubled slashes in the file
    2839             :         ;; name and fix them.
    2840           0 :         (setq filename (command-line-normalize-file-name filename))
    2841             : 
    2842             :         ;; Store it for the possibly unnormalized name
    2843           0 :         (puthash file
    2844             :                  ;; Retrieve or create file-structure for normalized name
    2845             :                  ;; The gethash used to not use spec-directory, but
    2846             :                  ;; this leads to errors when files in different
    2847             :                  ;; directories have the same name:
    2848             :                  ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
    2849           0 :                  (or (gethash (cons filename spec-directory) compilation-locs)
    2850           0 :                      (puthash (cons filename spec-directory)
    2851           0 :                               (compilation--make-file-struct
    2852           0 :                                (list filename spec-directory) fmt)
    2853           0 :                               compilation-locs))
    2854           0 :                  compilation-locs))))
    2855             : 
    2856             : (defun compilation--flush-file-structure (file)
    2857           0 :   (or (consp file) (setq file (list file)))
    2858           0 :   (let ((fs (compilation-get-file-structure file)))
    2859           0 :     (cl-assert (eq fs (gethash file compilation-locs)))
    2860           0 :     (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
    2861           0 :                                compilation-locs)))
    2862           0 :     (maphash (lambda (k v)
    2863           0 :                (if (eq v fs) (remhash k compilation-locs)))
    2864           0 :              compilation-locs)))
    2865             : 
    2866             : ;;; Compatibility with the old compile.el.
    2867             : 
    2868             : (defvaralias 'compilation-last-buffer 'next-error-last-buffer)
    2869             : (defvar compilation-parsing-end (make-marker))
    2870             : (defvar compilation-error-list nil)
    2871             : (defvar compilation-old-error-list nil)
    2872             : 
    2873             : (defun compilation--compat-error-properties (err)
    2874             :   "Map old-style error ERR to new-style message."
    2875             :   ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
    2876             :   ;; (MARKER . MARKER).
    2877           0 :   (let ((dst (cdr err)))
    2878           0 :     (if (markerp dst)
    2879           0 :         `(compilation-message ,(compilation--make-message
    2880           0 :                                 (cons nil (compilation--make-cdrloc
    2881           0 :                                            nil nil dst))
    2882           0 :                                 2 nil)
    2883             :           help-echo "mouse-2: visit the source location"
    2884             :           keymap compilation-button-map
    2885           0 :           mouse-face highlight)
    2886             :       ;; Too difficult to do it by hand: dispatch to the normal code.
    2887           0 :       (let* ((file (pop dst))
    2888           0 :              (line (pop dst))
    2889           0 :              (col (pop dst))
    2890           0 :              (filename (pop file))
    2891           0 :              (dirname (pop file))
    2892           0 :              (fmt (pop file)))
    2893           0 :         (compilation-internal-error-properties
    2894           0 :          (cons filename dirname) line nil col nil 2 fmt)))))
    2895             : 
    2896             : (defun compilation--compat-parse-errors (limit)
    2897           0 :   (when compilation-parse-errors-function
    2898             :     ;; FIXME: We should remove the rest of the compilation keywords
    2899             :     ;; but we can't do that from here because font-lock is using
    2900             :     ;; the value right now.  --Stef
    2901           0 :     (save-excursion
    2902           0 :       (setq compilation-error-list nil)
    2903             :       ;; Reset compilation-parsing-end each time because font-lock
    2904             :       ;; might force us the re-parse many times (typically because
    2905             :       ;; some code adds some text-property to the output that we
    2906             :       ;; already parsed).  You might say "why reparse", well:
    2907             :       ;; because font-lock has just removed the `compilation-message' property
    2908             :       ;; so have to do it all over again.
    2909           0 :       (if compilation-parsing-end
    2910           0 :           (set-marker compilation-parsing-end (point))
    2911           0 :         (setq compilation-parsing-end (point-marker)))
    2912           0 :       (condition-case nil
    2913             :           ;; Ignore any error: we're calling this function earlier than
    2914             :           ;; in the old compile.el so things might not all be setup yet.
    2915           0 :           (funcall compilation-parse-errors-function limit nil)
    2916           0 :         (error nil))
    2917           0 :       (dolist (err (if (listp compilation-error-list) compilation-error-list))
    2918           0 :         (let* ((src (car err))
    2919           0 :                (dst (cdr err))
    2920           0 :                (loc (cond ((markerp dst)
    2921           0 :                            (cons nil
    2922           0 :                                  (compilation--make-cdrloc nil nil dst)))
    2923           0 :                           ((consp dst)
    2924           0 :                            (cons (nth 2 dst)
    2925           0 :                                  (compilation--make-cdrloc
    2926             :                                   (nth 1 dst)
    2927             :                                   (cons (cdar dst) (caar dst))
    2928           0 :                                   nil))))))
    2929           0 :           (when loc
    2930           0 :             (goto-char src)
    2931             :             ;; (put-text-property src (line-end-position)
    2932             :             ;;                    'font-lock-face 'font-lock-warning-face)
    2933           0 :             (put-text-property src (line-end-position)
    2934             :                                'compilation-message
    2935           0 :                                (compilation--make-message loc 2 nil)))))))
    2936           0 :   (goto-char limit)
    2937             :   nil)
    2938             : 
    2939             : ;; Beware! this is not only compatibility code.  New code also uses it.  --Stef
    2940             : (defun compilation-forget-errors ()
    2941             :   ;; In case we hit the same file/line specs, we want to recompute a new
    2942             :   ;; marker for them, so flush our cache.
    2943           0 :   (clrhash compilation-locs)
    2944           0 :   (setq compilation-gcpro nil)
    2945             :   ;; FIXME: the old code reset the directory-stack, so maybe we should
    2946             :   ;; put a `directory change' marker of some sort, but where?  -stef
    2947             :   ;;
    2948             :   ;; FIXME: The old code moved compilation-current-error (which was
    2949             :   ;; virtually represented by a mix of compilation-parsing-end and
    2950             :   ;; compilation-error-list) to point-min, but that was only meaningful for
    2951             :   ;; the internal uses of compilation-forget-errors: all calls from external
    2952             :   ;; packages seem to be followed by a move of compilation-parsing-end to
    2953             :   ;; something equivalent to point-max.  So we heuristically move
    2954             :   ;; compilation-current-error to point-max (since the external package
    2955             :   ;; won't know that it should do it).  --Stef
    2956           0 :   (setq compilation-current-error nil)
    2957           0 :   (let* ((proc (get-buffer-process (current-buffer)))
    2958           0 :          (mark (if proc (process-mark proc)))
    2959           0 :          (pos (or mark (point-max))))
    2960           0 :     (setq compilation-messages-start
    2961             :           ;; In the future, ignore the text already present in the buffer.
    2962             :           ;; Since many process filter functions insert before markers,
    2963             :           ;; we need to put ours just before the insertion point rather
    2964             :           ;; than at the insertion point.  If that's not possible, then
    2965             :           ;; don't use a marker.  --Stef
    2966           0 :           (if (> pos (point-min)) (copy-marker (1- pos)) pos)))
    2967             :   ;; Again, since this command is used in buffers that contain several
    2968             :   ;; compilations, to set the beginning of "this compilation", it's a good
    2969             :   ;; place to reset compilation-auto-jump-to-next.
    2970           0 :   (set (make-local-variable 'compilation-auto-jump-to-next)
    2971           0 :        (or compilation-auto-jump-to-first-error
    2972           0 :            (eq compilation-scroll-output 'first-error))))
    2973             : 
    2974             : (provide 'compile)
    2975             : 
    2976             : ;;; compile.el ends here

Generated by: LCOV version 1.12