⟦b1c5fc7b0⟧

TextFile

;; Run compiler as inferior of Emacs, and parse its error messages.
;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
;; Last Modified By: Lynn Slater
;; Last Modified On: Fri Oct  7 09:28:19 1988
;; Update Count    : 12

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(provide 'compile)

(defvar compilation-process nil
  "Process created by compile command, or nil if none exists now.
Note that the process may have been \"deleted\" and still
be the value of this variable.")

(defvar compilation-error-list nil
  "List of error message descriptors for visiting erring functions.
Each error descriptor is a list of length two.
Its car is a marker pointing to an error message.
Its cadr is a marker pointing to the text of the line the message is about,
  or nil if that is not interesting.
The value may be t instead of a list;
this means that the buffer of error messages should be reparsed
the next time the list of errors is wanted.")

(defvar compilation-old-error-list nil
  "Value of `compilation-error-list' after errors were parsed.")

(defvar compilation-last-error nil
  "List describing the error found by last call to \\[next-error].
A list of two markers (ERROR-POS CODE-POS),
pointing to the error message and the erroneous code, respectively.
Sometimes CODE-POS is nil.")

(defvar compilation-parse-errors-hook 'compilation-parse-errors
   "Function to call (no args) to parse error messages from a compilation.
Global value is used if no other parser is explicitly given to compile1.

Parsers must make a list of error descriptors in compilation-error-list.
For each significant source-file, line-number pair in the buffer, the
source file should be read in, and the text location saved as a marker in
the car of an entry in compilation-error-list.  Nil or a marker to the
location of line number itself must be saved in the cadr of an entry in
compilation-error-list.

The function next-error, assigned to \\[next-error], takes the next error
off the list and visits its location.")

;; Bug: next-error if there never was a compile

(defvar compilation-parsing-end nil ;; should be made local -- lrs
  "Position of end of buffer when last error messages parsed.")

(defvar compilation-error-message nil
  "Message to print when no more matches are found by the compilation error
   parser in 'compilation-parse-errors-hook")

;; The filename excludes colons to avoid confusion when error message
;; starts with digits.
(defvar compilation-error-regexp
  "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  "Default regular expression for filename/linenumber in error in compilation log.
    Is used if no other regular expression is explicitly given to compile1.

   Is expected to handle lint, c compiler, and grep messages.")

(defvar compile-command "make -k"
  "Last shell command used to do a compilation; default for next compilation.")

(defun compile (command)
  "Compile the program including the current buffer.  Default: run `make'.
Runs COMMAND, a shell command, in a separate process asynchronously
with output going to the buffer *compilation*.
You can then use the command \\[next-error] to find the next error message
and move to the source code that caused it.

Uses \<compilation-parse-errors-hook> and compilation-error-regexp to
decide what each error message references."
  (interactive (list (read-string "Compile command: " compile-command)))
  (setq compile-command command)
  (save-some-buffers)
  (compile1 compile-command "No more errors"))

(defvar grep-command "grep -n")

(defun grep (command-args)
  "Run grep, with user-specified args, and collect output in a buffer.
While grep runs asynchronously, you can use the \\[next-error] command
to find the text that grep hits refer to."
  (interactive
   (list (read-string (concat "Run "
			      (substring grep-command
					 0 (string-match " " grep-command))
			      " (with args): "))))
  (save-some-buffers)
  (compile1 (concat grep-command " " command-args " /dev/null")
	    "No more grep hits" "grep"))

(defun compile1 (command error-message &optional name-of-mode parser regexp)
  "Run compilation command COMMAND (low level interface).
ERROR-MESSAGE is a string to print if the user asks to see another error
and there are no more errors.  Third argument NAME-OF-MODE is the name
to display as the major mode in the `*compilation*' buffer.
Fourth arg PARSER is the error parser function (nil means the default in 
compilation-parse-errors-hook). Fifth arg REGEXP is the error message regexp
to use (nil means the default in compilation-error-regexp)."
  (if compilation-process
      (if (or (not (eq (process-status compilation-process) 'run))
	      (yes-or-no-p "A compilation process is running; kill it? "))
	  (condition-case ()
	      (let ((comp-proc compilation-process))
		(interrupt-process comp-proc)
		(sit-for 1)
		(delete-process comp-proc))
	    (error nil))
	(error "Cannot have two compilation processes")))
  (setq compilation-process nil)
  (compilation-forget-errors)
  (setq compilation-error-list t)
  (setq compilation-error-message error-message)
  (setq compilation-process
	(start-process-shell-command "compilation" "*compilation*" command))
  (with-output-to-temp-buffer "*compilation*"
    (princ "cd ")
    (princ default-directory)
    (terpri)
    (princ command)
    (terpri))
  (let ((regexp (or regexp compilation-error-regexp))
	(parser (or parser compilation-parse-errors-hook)))
    (set-process-sentinel compilation-process 'compilation-sentinel)
    (let* ((thisdir default-directory)
	   (outbuf (process-buffer compilation-process))
	   (outwin (get-buffer-window outbuf)))
      (if (eq outbuf (current-buffer))
	  (goto-char (point-max)))
      (save-excursion
	(set-buffer outbuf)
	(buffer-flush-undo outbuf)
	(let ((start (save-excursion (set-buffer outbuf) (point-min))))
	  (set-window-start outwin start)
	  (or (eq outwin (selected-window))
	      (set-window-point outwin start)))
	(setq default-directory thisdir)
	(fundamental-mode)
	;; The call to fundemental mode kills all local variables
	;; we must set the local variables after the above call.
        (make-local-variable 'compilation-parse-errors-hook)
        (setq compilation-parse-errors-hook parser)
        (make-local-variable 'compilation-error-regexp)
        (setq compilation-error-regexp regexp)
	(setq mode-name (or name-of-mode "Compilation"))
	;; Make log buffer's mode line show process state
	(setq mode-line-process '(": %s"))))))

;; Called when compilation process changes state.

(defun compilation-sentinel (proc msg)
  (cond ((null (buffer-name (process-buffer proc)))
	 ;; buffer killed
	 (set-process-buffer proc nil))
	((memq (process-status proc) '(signal exit))
	 (let* ((obuf (current-buffer))
		(omax (point-max))
		(opoint (point)))
	   ;; save-excursion isn't the right thing if
	   ;;  process-buffer is current-buffer
	   (unwind-protect
	       (progn
		 ;; Write something in *compilation* and hack its mode line,
		 (set-buffer (process-buffer proc))
		 (goto-char (point-max))
		 (insert ?\n mode-name " " msg)
		 (forward-char -1)
		 (insert " at "
			 (substring (current-time-string) 0 -5))
		 (forward-char 1)
		 (setq mode-line-process
		       (concat ": "
			       (symbol-name (process-status proc))))
		 ;; If buffer and mode line will show that the process
		 ;; is dead, we can delete it now.  Otherwise it
		 ;; will stay around until M-x list-processes.
		 (delete-process proc))
	     (setq compilation-process nil)
	     ;; Force mode line redisplay soon
	     (set-buffer-modified-p (buffer-modified-p)))
	   (if (< opoint omax)
	       (goto-char opoint))
	   (set-buffer obuf)))))

(defun kill-compilation ()
  "Kill the process made by the \\[compile] command."
  (interactive)
  (if compilation-process
      (interrupt-process compilation-process)))

(defun kill-grep ()
  "Kill the process made by the \\[grep] command."
  (interactive)
  (if compilation-process
      (interrupt-process compilation-process)))

(defun next-error (&optional argp)
  "Visit next compilation error message and corresponding source code.
This operates on the output from the \\[compile] command.
If all preparsed error messages have been processed,
the error message buffer is checked for new ones.
A non-nil argument (prefix arg, if interactive)
means reparse the error message buffer and start at the first error.

See variables `compilation-parse-errors-hook' and `compilation-error-regexp'
for customization ideas.  When we return, `compilation-last-error'
points to the error message and the erroneous code."
  (interactive "P")
  (if (or (eq compilation-error-list t)
	  argp)
      (progn (compilation-forget-errors)
	     (setq compilation-parsing-end 1)))
  (if compilation-error-list
      nil
    (save-excursion
      (switch-to-buffer "*compilation*")
      (set-buffer-modified-p nil)
      (funcall compilation-parse-errors-hook)
      ;; Remember the entire list for compilation-forget-errors.
      (setq compilation-old-error-list compilation-error-list)))
  (let ((next-error (car compilation-error-list)))
    (if (null next-error)
	(progn (compilation-forget-errors)
	       (error (concat compilation-error-message
			      (if (and compilation-process
				       (eq (process-status compilation-process)
					   'run))
				  " yet" "")))))
    (setq compilation-error-list (cdr compilation-error-list))
    (if (null (car (cdr next-error)))
	nil
      (switch-to-buffer (marker-buffer (car (cdr next-error))))
      (goto-char (car (cdr next-error))))
    (let* ((pop-up-windows t)
	   (w (display-buffer (marker-buffer (car next-error)))))
      (set-window-point w (car next-error))
      (set-window-start w (car next-error)))
    (setq compilation-last-error next-error)))

;; Set compilation-error-list to nil, and
;; unchain the markers that point to the error messages and their text,
;; so that they no longer slow down gap motion.
;; This would happen anyway at the next garbage collection,
;; but it is better to do it right away.
(defun compilation-forget-errors ()
  (while compilation-old-error-list
    (let ((next-error (car compilation-old-error-list)))
      (set-marker (car next-error) nil)
      (if (car (cdr next-error))
	  (set-marker (car (cdr next-error)) nil)))
    (setq compilation-old-error-list (cdr compilation-old-error-list)))
  (setq compilation-error-list nil))

(defun compilation-parse-errors ()
  "Parse the current buffer as grep, lint, or c compiler error messages.
   See compilation-parse-errors-hook"
  (setq compilation-error-list nil)
  (message "Parsing error messages...")
  (let (text-buffer
	last-filename last-linenum)
    ;; Don't reparse messages already seen at last parse.
    (goto-char compilation-parsing-end)
    ;; Don't parse the first two lines as error messages.
    ;; This matters for grep.
    (if (bobp)
	(forward-line 2))
    (while (re-search-forward compilation-error-regexp nil t)
      (let (linenum filename
	    error-marker text-marker)
	;; Extract file name and line number from error message.
	(save-restriction
	  (narrow-to-region (match-beginning 0) (match-end 0))
	  (goto-char (point-max))
	  (skip-chars-backward "[0-9]")
	  ;; If it's a lint message, use the last file(linenum) on the line.
	  ;; Normally we use the first on the line.
	  (if (= (preceding-char) ?\()
	      (progn
		(narrow-to-region (point-min) (1+ (buffer-size)))
		(end-of-line)
		(re-search-backward compilation-error-regexp)
		(skip-chars-backward "^ \t\n")
		(narrow-to-region (point) (match-end 0))
		(goto-char (point-max))
		(skip-chars-backward "[0-9]")))
	  ;; Are we looking at a "filename-first" or "line-number-first" form?
	  (if (looking-at "[0-9]")
	      (progn
		(setq linenum (read (current-buffer)))
		(goto-char (point-min)))
	    ;; Line number at start, file name at end.
	    (progn
	      (goto-char (point-min))
	      (setq linenum (read (current-buffer)))
	      (goto-char (point-max))
	      (skip-chars-backward "^ \t\n")))
	  (setq filename (compilation-grab-filename)))
	;; Locate the erring file and line.
	(if (and (equal filename last-filename)
		 (= linenum last-linenum))
	    nil
	  (beginning-of-line 1)
	  (setq error-marker (point-marker))
	  ;; text-buffer gets the buffer containing this error's file.
	  (if (not (equal filename last-filename))
	      (setq text-buffer
		    (and (file-exists-p (setq last-filename filename))
			 (find-file-noselect filename))
		    last-linenum 0))
	  (if text-buffer
	      ;; Go to that buffer and find the erring line.
	      (save-excursion
		(set-buffer text-buffer)
		(if (zerop last-linenum)
		    (progn
		      (goto-char 1)
		      (setq last-linenum 1)))
		(forward-line (- linenum last-linenum))
		(setq last-linenum linenum)
		(setq text-marker (point-marker))
		(setq compilation-error-list
		      (cons (list error-marker text-marker)
			    compilation-error-list)))))
	(forward-line 1)))
    (setq compilation-parsing-end (point-max)))
  (message "Parsing error messages...done")
  (setq compilation-error-list (nreverse compilation-error-list)))

(defun compilation-grab-filename ()
  "Return a string which is a filename, starting at point.
Ignore quotes and parentheses around it, as well as trailing colons."
  (if (eq (following-char) ?\")
      (save-restriction
	(narrow-to-region (point)
			  (progn (forward-sexp 1) (point)))
	(goto-char (point-min))
	(read (current-buffer)))
    (buffer-substring (point)
		      (progn
			(skip-chars-forward "^ :,\n\t(")
			(point)))))

(define-key ctl-x-map "`" 'next-error)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Recieved from rms two days later
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun start-process-shell-command (name buffer &rest args)
  "Start a program in a subprocess.  Return the process object for it.
Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
NAME is name for process.  It is modified if necessary to make it unique.
BUFFER is the buffer or (buffer-name) to associate with the process.
 Process output goes at end of that buffer, unless you specify
 an output stream or filter function to handle the output.
 BUFFER may be also nil, meaning that this process is not associated
 with any buffer
Third arg is command name, the name of a shell command.
Remaining arguments are the arguments for the command.
Wildcards and redirection are handle as usual in the shell."
  (if (eq system-type 'vax-vms)
      (apply 'start-process name buffer args)
    (start-process name buffer shell-file-name "-c"
		   (concat "exec " (mapconcat 'identity args " ")))))
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦b1c5fc7b0⟧ TextFile

Derivation

TextFile
