![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to compile.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to compile.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Run compiler as inferior of Emacs, and parse its error messages. ! 2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: (provide 'compile) ! 21: ! 22: (defvar compilation-process nil ! 23: "Process created by compile command, or nil if none exists now. ! 24: Note that the process may have been \"deleted\" and still ! 25: be the value of this variable.") ! 26: ! 27: (defvar compilation-error-list nil ! 28: "List of error message descriptors for visiting erring functions. ! 29: Each error descriptor is a list of length two. ! 30: Its car is a marker pointing to an error message. ! 31: Its cadr is a marker pointing to the text of the line the message is about, ! 32: or nil if that is not interesting. ! 33: The value may be t instead of a list; ! 34: this means that the buffer of error messages should be reparsed ! 35: the next time the list of errors is wanted.") ! 36: ! 37: (defvar compilation-parsing-end nil ! 38: "Position of end of buffer when last error messages parsed.") ! 39: ! 40: (defvar compilation-error-message nil ! 41: "Message to print when no more matches for compilation-error-regexp are found") ! 42: ! 43: ;; The filename excludes colons to avoid confusion when error message ! 44: ;; starts with digits. ! 45: (defvar compilation-error-regexp ! 46: "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)" ! 47: "Regular expression for filename/linenumber in error in compilation log.") ! 48: ! 49: (defun compile (command) ! 50: "Compile the program including the current buffer. Default: run `make'. ! 51: Runs COMMAND, a shell command, in a separate process asynchronously ! 52: with output going to the buffer *compilation*. ! 53: You can then use the command \\[next-error] to find the next error message ! 54: and move to the source code that caused it." ! 55: (interactive (list (read-string "Compile command: " compile-command))) ! 56: (setq compile-command command) ! 57: (compile1 compile-command "No more errors")) ! 58: ! 59: (defun grep (command) ! 60: "Run grep, with user-specified args, and collect output in a buffer. ! 61: While grep runs asynchronously, you can use the \\[next-error] command ! 62: to find the text that grep hits refer to." ! 63: (interactive "sRun grep (with args): ") ! 64: (compile1 (concat "grep -n " command " /dev/null") ! 65: "No more grep hits" "grep")) ! 66: ! 67: (defun compile1 (command error-message &optional name-of-mode) ! 68: (save-some-buffers) ! 69: (if compilation-process ! 70: (if (or (not (eq (process-status compilation-process) 'run)) ! 71: (yes-or-no-p "A compilation process is running; kill it? ")) ! 72: (condition-case () ! 73: (if compilation-process ! 74: (let ((comp-proc compilation-process)) ! 75: (interrupt-process comp-proc) ! 76: (sit-for 1) ! 77: (delete-process comp-proc))) ! 78: (error nil)) ! 79: (error "Cannot have two compilation processes"))) ! 80: (setq compilation-process nil) ! 81: (compilation-forget-errors) ! 82: (setq compilation-error-list t) ! 83: (setq compilation-error-message error-message) ! 84: (setq compilation-process ! 85: (start-process "compilation" "*compilation*" ! 86: shell-file-name ! 87: "-c" (concat "exec " command))) ! 88: (with-output-to-temp-buffer "*compilation*" ! 89: (princ "cd ") ! 90: (princ default-directory) ! 91: (terpri) ! 92: (princ command) ! 93: (terpri)) ! 94: (set-process-sentinel compilation-process 'compilation-sentinel) ! 95: (let* ((thisdir default-directory) ! 96: (outbuf (process-buffer compilation-process)) ! 97: (outwin (get-buffer-window outbuf)) ! 98: (regexp compilation-error-regexp)) ! 99: (if (eq outbuf (current-buffer)) ! 100: (goto-char (point-max))) ! 101: (save-excursion ! 102: (set-buffer outbuf) ! 103: (buffer-flush-undo outbuf) ! 104: (let ((start (save-excursion (set-buffer outbuf) (point-min)))) ! 105: (set-window-start outwin start) ! 106: (or (eq outwin (selected-window)) ! 107: (set-window-point outwin start))) ! 108: (setq default-directory thisdir) ! 109: (fundamental-mode) ! 110: (make-local-variable 'compilation-error-regexp) ! 111: (setq compilation-error-regexp regexp) ! 112: (setq mode-name (or name-of-mode "Compilation")) ! 113: ;; Make log buffer's mode line show process state ! 114: (setq mode-line-process '(": %s"))))) ! 115: ! 116: ;; Called when compilation process changes state. ! 117: ! 118: (defun compilation-sentinel (proc msg) ! 119: (cond ((null (buffer-name (process-buffer proc))) ! 120: ;; buffer killed ! 121: (set-process-buffer proc nil)) ! 122: ((memq (process-status proc) '(signal exit)) ! 123: (let* ((obuf (current-buffer)) ! 124: omax opoint) ! 125: ;; save-excursion isn't the right thing if ! 126: ;; process-buffer is current-buffer ! 127: (unwind-protect ! 128: (progn ! 129: ;; Write something in *compilation* and hack its mode line, ! 130: (set-buffer (process-buffer proc)) ! 131: (setq omax (point-max) opoint (point)) ! 132: (goto-char (point-max)) ! 133: (insert ?\n mode-name " " msg) ! 134: (forward-char -1) ! 135: (insert " at " ! 136: (substring (current-time-string) 0 -5)) ! 137: (forward-char 1) ! 138: (setq mode-line-process ! 139: (concat ": " ! 140: (symbol-name (process-status proc)))) ! 141: ;; If buffer and mode line will show that the process ! 142: ;; is dead, we can delete it now. Otherwise it ! 143: ;; will stay around until M-x list-processes. ! 144: (delete-process proc)) ! 145: (setq compilation-process nil) ! 146: ;; Force mode line redisplay soon ! 147: (set-buffer-modified-p (buffer-modified-p))) ! 148: (if (and opoint (< opoint omax)) ! 149: (goto-char opoint)) ! 150: (set-buffer obuf))))) ! 151: ! 152: (defun kill-compilation () ! 153: "Kill the process made by the \\[compile] command." ! 154: (interactive) ! 155: (if compilation-process ! 156: (interrupt-process compilation-process))) ! 157: ! 158: (defun kill-grep () ! 159: "Kill the process made by the \\[grep] command." ! 160: (interactive) ! 161: (if compilation-process ! 162: (interrupt-process compilation-process))) ! 163: ! 164: (defun next-error (&optional argp) ! 165: "Visit next compilation error message and corresponding source code. ! 166: This operates on the output from the \\[compile] command. ! 167: If all preparsed error messages have been processed, ! 168: the error message buffer is checked for new ones. ! 169: A non-nil argument (prefix arg, if interactive) ! 170: means reparse the error message buffer and start at the first error." ! 171: (interactive "P") ! 172: (if (or (eq compilation-error-list t) ! 173: argp) ! 174: (progn (compilation-forget-errors) ! 175: (setq compilation-parsing-end 1))) ! 176: (if compilation-error-list ! 177: nil ! 178: (save-excursion ! 179: (set-buffer "*compilation*") ! 180: (set-buffer-modified-p nil) ! 181: (compilation-parse-errors))) ! 182: (let ((next-error (car compilation-error-list))) ! 183: (if (null next-error) ! 184: (error (concat compilation-error-message ! 185: (if (and compilation-process ! 186: (eq (process-status compilation-process) ! 187: 'run)) ! 188: " yet" "")))) ! 189: (setq compilation-error-list (cdr compilation-error-list)) ! 190: (if (null (car (cdr next-error))) ! 191: nil ! 192: (switch-to-buffer (marker-buffer (car (cdr next-error)))) ! 193: (goto-char (car (cdr next-error))) ! 194: (set-marker (car (cdr next-error)) nil)) ! 195: (let* ((pop-up-windows t) ! 196: (w (display-buffer (marker-buffer (car next-error))))) ! 197: (set-window-point w (car next-error)) ! 198: (set-window-start w (car next-error))) ! 199: (set-marker (car next-error) nil))) ! 200: ! 201: ;; Set compilation-error-list to nil, and ! 202: ;; unchain the markers that point to the error messages and their text, ! 203: ;; so that they no longer slow down gap motion. ! 204: ;; This would happen anyway at the next garbage collection, ! 205: ;; but it is better to do it right away. ! 206: (defun compilation-forget-errors () ! 207: (if (eq compilation-error-list t) ! 208: (setq compilation-error-list nil)) ! 209: (while compilation-error-list ! 210: (let ((next-error (car compilation-error-list))) ! 211: (set-marker (car next-error) nil) ! 212: (if (car (cdr next-error)) ! 213: (set-marker (car (cdr next-error)) nil))) ! 214: (setq compilation-error-list (cdr compilation-error-list)))) ! 215: ! 216: (defun compilation-parse-errors () ! 217: "Parse the current buffer as error messages. ! 218: This makes a list of error descriptors, compilation-error-list. ! 219: For each source-file, line-number pair in the buffer, ! 220: the source file is read in, and the text location is saved in compilation-error-list. ! 221: The function next-error, assigned to \\[next-error], takes the next error off the list ! 222: and visits its location." ! 223: (setq compilation-error-list nil) ! 224: (message "Parsing error messages...") ! 225: (let (text-buffer ! 226: last-filename last-linenum) ! 227: ;; Don't reparse messages already seen at last parse. ! 228: (goto-char compilation-parsing-end) ! 229: ;; Don't parse the first two lines as error messages. ! 230: ;; This matters for grep. ! 231: (if (bobp) ! 232: (forward-line 2)) ! 233: (while (re-search-forward compilation-error-regexp nil t) ! 234: (let (linenum filename ! 235: error-marker text-marker) ! 236: ;; Extract file name and line number from error message. ! 237: (save-restriction ! 238: (narrow-to-region (match-beginning 0) (match-end 0)) ! 239: (goto-char (point-max)) ! 240: (skip-chars-backward "[0-9]") ! 241: ;; If it's a lint message, use the last file(linenum) on the line. ! 242: ;; Normally we use the first on the line. ! 243: (if (= (preceding-char) ?\() ! 244: (progn ! 245: (narrow-to-region (point-min) (1+ (buffer-size))) ! 246: (end-of-line) ! 247: (re-search-backward compilation-error-regexp) ! 248: (skip-chars-backward "^ \t\n") ! 249: (narrow-to-region (point) (match-end 0)) ! 250: (goto-char (point-max)) ! 251: (skip-chars-backward "[0-9]"))) ! 252: ;; Are we looking at a "filename-first" or "line-number-first" form? ! 253: (if (looking-at "[0-9]") ! 254: (progn ! 255: (setq linenum (read (current-buffer))) ! 256: (goto-char (point-min))) ! 257: ;; Line number at start, file name at end. ! 258: (progn ! 259: (goto-char (point-min)) ! 260: (setq linenum (read (current-buffer))) ! 261: (goto-char (point-max)) ! 262: (skip-chars-backward "^ \t\n"))) ! 263: (setq filename (compilation-grab-filename))) ! 264: ;; Locate the erring file and line. ! 265: (if (and (equal filename last-filename) ! 266: (= linenum last-linenum)) ! 267: nil ! 268: (beginning-of-line 1) ! 269: (setq error-marker (point-marker)) ! 270: ;; text-buffer gets the buffer containing this error's file. ! 271: (if (not (equal filename last-filename)) ! 272: (setq text-buffer ! 273: (and (file-exists-p (setq last-filename filename)) ! 274: (find-file-noselect filename)) ! 275: last-linenum 0)) ! 276: (if text-buffer ! 277: ;; Go to that buffer and find the erring line. ! 278: (save-excursion ! 279: (set-buffer text-buffer) ! 280: (if (zerop last-linenum) ! 281: (progn ! 282: (goto-char 1) ! 283: (setq last-linenum 1))) ! 284: ;; Move the right number of lines from the old position. ! 285: ;; If we can't move that many, put 0 in last-linenum ! 286: ;; so the next error message will be handled starting from ! 287: ;; scratch. ! 288: (if (eq selective-display t) ! 289: (or (re-search-forward "[\n\C-m]" nil 'end ! 290: (- linenum last-linenum)) ! 291: (setq last-linenum 0)) ! 292: (or (= 0 (forward-line (- linenum last-linenum))) ! 293: (setq last-linenum 0))) ! 294: (setq last-linenum linenum) ! 295: (setq text-marker (point-marker)) ! 296: (setq compilation-error-list ! 297: (cons (list error-marker text-marker) ! 298: compilation-error-list))))) ! 299: (forward-line 1))) ! 300: (setq compilation-parsing-end (point-max))) ! 301: (message "Parsing error messages...done") ! 302: (setq compilation-error-list (nreverse compilation-error-list))) ! 303: ! 304: (defun compilation-grab-filename () ! 305: "Return a string which is a filename, starting at point. ! 306: Ignore quotes and parentheses around it, as well as trailing colons." ! 307: (if (eq (following-char) ?\") ! 308: (save-restriction ! 309: (narrow-to-region (point) ! 310: (progn (forward-sexp 1) (point))) ! 311: (goto-char (point-min)) ! 312: (read (current-buffer))) ! 313: (buffer-substring (point) ! 314: (progn ! 315: (skip-chars-forward "^ :,\n\t(") ! 316: (point))))) ! 317: ! 318: (define-key ctl-x-map "`" 'next-error)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.