🚀 go-pugleaf

I've made some enhancements to compile.el to overcome some of its limitations.

 - Added (previous-error)
 - Added (rename-compilation-buffer) and made most variables buffer-local
   (to the *compilation* buffer) so that you can have multiple compilation
   processes active simultaneously.
 - "No more errors yet" also moves window-start to EOF (so that it becomes
   easier to see that new output is available).
 - (grep) remembers its last command, just like (compile) always did.

Bug fixes:
 - Won't try to read a file named "" (the null string).
 - Gracefully handles the situation where a buffer that had markers in
   it has been deleted.

Michael.

#!/bin/sh
# to extract, remove the header and type "sh filename"
if `test ! -s ./compile.el`
then
echo "writing ./compile.el"
cat > ./compile.el << '\End\Of\Shar\'
;; Run compiler as inferior of Emacs, and parse its error messages.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; 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.

;;
;; mcook@merlin.dev.mot.com
;; January 22, 1993
;;
;; Enhancements:
;; - Added (previous-error)
;; - Added (rename-compilation-buffer) and made most variables buffer-local
;;   (to the *compilation* buffer) so that you can have multiple compilation
;;   processes active simultaneously.
;; - "No more errors yet" also moves window-start to EOF (so that it becomes
;;   easier to see that new output is available).
;; - (grep) remembers its last command, just like (compile) always did.
;;
;; Bug fixes:
;; - Won't try to read a file named "" (the null string).
;; - Gracefully handles the situation where a buffer that had markers in
;;   it has been deleted.
;;

(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.")
(make-variable-buffer-local 'compilation-process)

(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.")
(make-variable-buffer-local 'compilation-error-list)

(defvar compilation-error-index nil
  "Index into compilation-error-list of the current error.")
(make-variable-buffer-local 'compilation-error-index)

(defvar compilation-parsing-end nil
  "Position of end of buffer when last error messages parsed.")
(make-variable-buffer-local 'compilation-parsing-end)

(defvar compilation-error-message nil
  "Message to print when no more matches for compilation-error-regexp are found")
(make-variable-buffer-local 'compilation-error-message)

(defvar compilation-error-regexp
  "\\([^ \n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  "Regular expression for filename/linenumber in error in compilation log.")

(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."
  (interactive (list (read-string "Compile command: " compile-command)))
  (setq compile-command command)
  (compile1 compile-command "errors"))

(defvar grep-command "grep -n "
  "*Last shell command used to do a grep class command;
default for next grep class command.")

(defun grep (command)
  "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 "Run grep (with args) " grep-command)))
  (setq grep-command command)
  (require 'compile)
  (compile1 (concat command " /dev/null") "grep hits" "grep"))

(defun compile1 (command error-message &optional name-of-mode)
  (save-some-buffers)
  (let ((obuf (current-buffer))
	(this-dir default-directory)
	(cbuf (get-buffer-create "*compilation*")))
    (unwind-protect
	(progn
	  (set-buffer cbuf)

	  (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)

	  ;;
	  ;; Setup the *compilation* buffer.
	  ;;
	  (buffer-flush-undo cbuf)
	  (compilation-forget-errors)
	  (setq compilation-error-list t)
	  (setq compilation-error-index nil)
	  (setq compilation-error-message error-message)
	  (setq mode-name (or name-of-mode "Compilation"))
	  (setq default-directory this-dir)
	  (with-output-to-temp-buffer "*compilation*"
	    (princ "cd ")
	    (princ this-dir)
	    (terpri)
	    (princ command)
	    (terpri))
	  ;;
	  ;; For all windows displaying the *compilation* buffer, set the
	  ;; window-start and window-point attributes.
	  ;;
	  (let* ((orig-win (selected-window))
		 (this-win orig-win)
		 (pmin (point-min))
		 (pmax (point-max)))
	    (while (progn
		     (if (eq (window-buffer this-win) cbuf)
			 (progn
			   (set-window-point this-win pmax)
			   (set-window-start this-win pmin)))
		     (setq this-win (next-window this-win t))
		     (not (eq this-win orig-win)))))

	  ;;
	  ;; Start the process.
	  ;;
	  (setq compilation-process
		(start-process "compilation" cbuf
			       shell-file-name
			       "-c" (concat "exec " command)))
	  (set-process-sentinel compilation-process 'compilation-sentinel)

	  ;; Make log buffer's mode line show process state
	  (setq mode-line-process '(": %s")))
      (set-buffer obuf))))

(defun compilation-sentinel (proc msg)
  ;;
  ;; Called when compilation process changes state.
  ;;
  (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)))
	   (unwind-protect
	       (progn
		 ;;
		 ;; Write something in *compilation* and hack its mode line,
		 ;;
		 (set-buffer (process-buffer proc))
		 (setq compilation-process nil)
		 (goto-char (point-max))
		 (insert ?\n mode-name " " msg)
		 (forward-char -1)
		 (insert " at "
			 (substring (current-time-string) 0 -5))
		 (forward-char 1)
		 (if (< opoint omax)
		     (goto-char opoint))
		 (setq mode-line-process
		       (concat ": "
			       (symbol-name (process-status proc))))
		 ;; Force mode line redisplay soon
		 (set-buffer-modified-p (buffer-modified-p))
		 ;;
		 ;; 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))
	     (set-buffer obuf))))))

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

(defun kill-grep ()
  "Kill the process made by the \\[grep] command."
  (interactive)
  (save-excursion
    (set-buffer "*compilation*")
    (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."
  (interactive "P")
  (compilation-next-error argp 1))

(defun previous-error (&optional argp)
  "See \\[next-error]."
  (interactive "P")
  (compilation-next-error argp -1))

(defun compilation-next-error (restart direction)
  "See \\[next-error]."
  (let ((obuf (current-buffer)))
    (unwind-protect
      (progn
	(set-buffer "*compilation*")
	(if (or (eq compilation-error-list t)
		restart)
	    (compilation-forget-errors))
	(let ((i compilation-error-index))
	  (while (progn
		   (setq i (if i (+ i direction) 0))
		   (if (< i 0)
		       (error (concat "No previous "
				      compilation-error-message)))
		   (let ((n (length compilation-error-list)))
		     (if (< i n)
			 nil
		       (set-buffer-modified-p nil)
		       (compilation-parse-errors)
		       (or (> (length compilation-error-list) n)
			   (error (concat
				   "No more "
				   compilation-error-message
				   (if (and compilation-process
					    (eq (process-status
						 compilation-process) 'run))
				       (let ((w (get-buffer-window
						 (current-buffer))))
					 (if (not w)
					     nil
					   (set-window-point w (point-max))
					   (set-window-start w (point-max)))
					 " yet")))))))
		   (not (marker-buffer
			 (nth 1 (nth i compilation-error-list))))))
	  (setq compilation-error-index i))
	(let ((e (nth compilation-error-index compilation-error-list)))
	  (if (car (cdr e))
	      (progn
		(setq obuf (marker-buffer (car (cdr e))))
		(switch-to-buffer obuf)
		(goto-char (car (cdr e)))))
	  (let* ((pop-up-windows t)
		 (w (display-buffer (marker-buffer (car e)))))
	    (set-window-point w (car e))
	    (set-window-start w (car e)))))
      (set-buffer obuf))))

;;
;; 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 ()
  (if (eq compilation-error-list t)
      (setq compilation-error-list nil))
  (while compilation-error-list
    (let ((e (car compilation-error-list)))
      (set-marker (car e) nil)
      (if (car (cdr e))
	  (set-marker (car (cdr e)) nil)))
    (setq compilation-error-list (cdr compilation-error-list)))
  (setq compilation-error-index nil)
  (setq compilation-parsing-end 1))

(defun compilation-parse-errors ()
  "Parse the current buffer as error messages.  This makes a list of error
descriptors, compilation-error-list.  For each source-file, line-number pair
in the buffer, the source file is read in, and the text location is saved in
compilation-error-list.  The function next-error, assigned to
\\[next-error], takes the next error off the list and visits its location."
  (message "Parsing error messages...")
  (let (text-buffer last-filename last-linenum error-list)
    ;;
    ;; 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)
	;;
	;; 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.
	    ;;
	    (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 (or (and (equal filename last-filename)
		     (= linenum last-linenum))
		(zerop (length filename)))
	    nil
	  (beginning-of-line 1)
	  (setq error-marker (point-marker))
	  ;; text-buffer gets the buffer containing this error's file.
	  (if (equal filename last-filename)
	      nil
	    (setq last-filename filename
		  last-linenum 0)
	    (setq text-buffer
		  (and (file-exists-p filename)
		       (find-file-noselect filename))))
	  (if (not text-buffer)
	      nil
	    ;; Go to that buffer and find the erring line.
	    (setq error-list
		  (cons (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)
			  (list error-marker (point-marker)))
			error-list))
	    (message "Parsing error messages...%d" (length error-list))))
	(forward-line 1)))
    (setq compilation-parsing-end (point-max))
    (setq compilation-error-list
	  (nconc compilation-error-list (nreverse error-list))))
  (message "Parsing error messages...done"))

(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)))))

(defun rename-compilation-buffer (arg)
  "Rename the *compilation* buffer (e.g. to *compilation-1*) so that
a second compilation process may be started.  If ARG is non-nil,
rename the current buffer to *compilation*."
  (interactive "P")
  (let ((buf (get-buffer "*compilation*")))
    (if buf
	(let ((i 1) new-name)
	  (while (get-buffer (setq new-name (concat "*compilation-" i "*")))
	    (setq i (1+ i)))
	  (save-excursion
	    (set-buffer buf)
	    (rename-buffer new-name))
	  (message "Buffer *compilation* has been renamed %s" new-name))
      (or arg
	  (error "There is no *compilation* buffer."))))
  (if (not arg)
      nil
    (or (not buffer-file-name)
	(y-or-n-p (format
		   "Buffer \"%s\" is attached to a file; rename anyhow? "
		   (buffer-name)))
	(error "Buffer \"%s\" is attached to a file." (buffer-name)))
    (rename-buffer "*compilation*"))
  (set-buffer-modified-p (buffer-modified-p))) ;force modeline update

(define-key ctl-x-map "`" 'next-error)
\End\Of\Shar\
else
  echo "will not over write ./compile.el"
fi
echo "Finished archive 1 of 1"
exit