Commit fd5e58d7 authored by Roland McGrath's avatar Roland McGrath
Browse files

(compilation-handle-exit): New function, broken out of compilation-sentinel.

(compilation-sentinel, compile-internal): Use it.
(compilation-exit-message-function): Doc fix for protocol change: take
process status and exit-code args instead of process object.
(grep): Use new protocol for compilation-exit-message-function.
parent 0f09bac6
;;; compile.el --- run compiler as inferior of Emacs, parse error messages. ;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
;; Copyright (C) 1985, 86, 87, 93, 94, 1995 Free Software Foundation, Inc. ;; Copyright (C) 1985, 86, 87, 93, 94, 1995, 1996 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@prep.ai.mit.edu> ;; Author: Roland McGrath <roland@prep.ai.mit.edu>
;; Maintainer: FSF ;; Maintainer: FSF
...@@ -259,9 +259,9 @@ The head element is the directory the compilation was started in.") ...@@ -259,9 +259,9 @@ The head element is the directory the compilation was started in.")
(defvar compilation-exit-message-function nil "\ (defvar compilation-exit-message-function nil "\
If non-nil, called when a compilation process dies to return a status message. If non-nil, called when a compilation process dies to return a status message.
This should be a function a two arguments as passed to a process sentinel This should be a function of three arguments: process status, exit status,
\(see `set-process-sentinel\); it returns a cons (MESSAGE . MODELINE) of the and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
strings to write into the compilation buffer, and to put in its mode line.") write into the compilation buffer, and to put in its mode line.")
;; History of compile commands. ;; History of compile commands.
(defvar compile-history nil) (defvar compile-history nil)
...@@ -331,16 +331,15 @@ easily repeat a grep command." ...@@ -331,16 +331,15 @@ easily repeat a grep command."
(save-excursion (save-excursion
(set-buffer buf) (set-buffer buf)
(set (make-local-variable 'compilation-exit-message-function) (set (make-local-variable 'compilation-exit-message-function)
(lambda (proc msg) (lambda (status code msg)
(let ((code (process-exit-status proc))) (if (eq status 'exit)
(if (eq (process-status proc) 'exit) (cond ((zerop code)
(cond ((zerop code) '("finished (matches found)\n" . "matched"))
'("finished (matches found)\n" . "matched")) ((= code 1)
((= code 1) '("finished with no matches found\n" . "no match"))
'("finished with no matches found\n" . "no match")) (t
(t (cons msg code)))
(cons msg code))) (cons msg code)))))))
(cons msg code))))))))
(defun compile-internal (command error-message (defun compile-internal (command error-message
&optional name-of-mode parser regexp-alist &optional name-of-mode parser regexp-alist
...@@ -434,36 +433,27 @@ Returns the compilation buffer created." ...@@ -434,36 +433,27 @@ Returns the compilation buffer created."
(set-marker (process-mark proc) (point) outbuf) (set-marker (process-mark proc) (point) outbuf)
(setq compilation-in-progress (setq compilation-in-progress
(cons proc compilation-in-progress))) (cons proc compilation-in-progress)))
;; No asynchronous processes available ;; No asynchronous processes available.
(message (format "Executing `%s'..." command)) (message "Executing `%s'..." command)
;; Fake modeline display as if `start-process' were run. ;; Fake modeline display as if `start-process' were run.
(setq mode-line-process ":run") (setq mode-line-process ":run")
(sit-for 0) ;; Force redisplay (force-mode-line-update)
(sit-for 0) ; Force redisplay
(let ((status (call-process shell-file-name nil outbuf nil "-c" (let ((status (call-process shell-file-name nil outbuf nil "-c"
command)) command)))
finish-msg) (cond ((numberp status)
;; Fake modeline after exit. (compilation-handle-exit 'exit status
(setq mode-line-process (if (zerop status)
(cond ((numberp status) (format ":exit[%d]" status)) "finished\n"
((stringp status) (format ":exit[-1: %s]" status)) (format "\
(t ":exit[???]"))) exited abnormally with code %d\n"
;; Call `compilation-finish-function' as `compilation-sentinel' status))))
;; would, and finish up the compilation buffer with the same ((stringp status)
;; message we would get from `start-process'. (compilation-handle-exit 'signal status
(setq finish-msg (concat status "\n")))
(if (numberp status) (t
(if (zerop status) (compilation-handle-exit 'bizarre status status))))
"finished\n" (message "Executing `%s'...done" command))))
(format "exited abnormally with code %d\n" status))
"exited abnormally with code -1\n"))
(goto-char (point-max))
(insert "\nCompilation " finish-msg)
(forward-char -1)
(insert " at " (substring (current-time-string) 0 19)) ; no year
(forward-char 1)
(if compilation-finish-function
(funcall compilation-finish-function outbuf finish-msg)))
(message (format "Executing `%s'...done" command)))))
;; Make it so the next C-x ` will use this buffer. ;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf))) (setq compilation-last-buffer outbuf)))
...@@ -581,6 +571,32 @@ See `compilation-mode'." ...@@ -581,6 +571,32 @@ See `compilation-mode'."
(> (prefix-numeric-value arg) 0))) (> (prefix-numeric-value arg) 0)))
(compilation-setup))) (compilation-setup)))
;; Write msg in the current buffer and hack its mode-line-process.
(defun compilation-handle-exit (process-status exit-status msg)
(let ((buffer-read-only nil)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
process-status exit-status msg)
(cons msg exit-status)))
(omax (point-max))
(opoint (point)))
;; Record where we put the message, so we can ignore it
;; later on.
(goto-char omax)
(insert ?\n mode-name " " (car status))
(forward-char -1)
(insert " at " (substring (current-time-string) 0 19))
(forward-char 1)
(setq mode-line-process
(format ":%s [%s]"
(process-status proc) (cdr status)))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
(goto-char opoint))
(if compilation-finish-function
(funcall compilation-finish-function buffer msg))))
;; Called when compilation process changes state. ;; Called when compilation process changes state.
(defun compilation-sentinel (proc msg) (defun compilation-sentinel (proc msg)
"Sentinel for compilation buffers." "Sentinel for compilation buffers."
...@@ -590,8 +606,7 @@ See `compilation-mode'." ...@@ -590,8 +606,7 @@ See `compilation-mode'."
(if (null (buffer-name buffer)) (if (null (buffer-name buffer))
;; buffer killed ;; buffer killed
(set-process-buffer proc nil) (set-process-buffer proc nil)
(let ((obuf (current-buffer)) (let ((obuf (current-buffer)))
omax opoint)
;; save-excursion isn't the right thing if ;; save-excursion isn't the right thing if
;; process-buffer is current-buffer ;; process-buffer is current-buffer
(unwind-protect (unwind-protect
...@@ -599,33 +614,13 @@ See `compilation-mode'." ...@@ -599,33 +614,13 @@ See `compilation-mode'."
;; Write something in the compilation buffer ;; Write something in the compilation buffer
;; and hack its mode line. ;; and hack its mode line.
(set-buffer buffer) (set-buffer buffer)
(let ((buffer-read-only nil) (compilation-handle-exit (process-status proc)
(status (if compilation-exit-message-function (process-exit-status proc)
(funcall compilation-exit-message-function msg)
proc msg) ;; Since the buffer and mode line will show that the
(cons msg (process-exit-status proc))))) ;; process is dead, we can delete it now. Otherwise it
(setq omax (point-max) ;; will stay around until M-x list-processes.
opoint (point)) (delete-process proc))
(goto-char omax)
;; Record where we put the message, so we can ignore it
;; later on.
(insert ?\n mode-name " " (car status))
(forward-char -1)
(insert " at " (substring (current-time-string) 0 19))
(forward-char 1)
(setq mode-line-process
(format ":%s [%s]"
(process-status proc) (cdr status)))
;; Since the 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)
;; Force mode line redisplay soon.
(force-mode-line-update))
(if (and opoint (< opoint omax))
(goto-char opoint))
(if compilation-finish-function
(funcall compilation-finish-function buffer msg)))
(set-buffer obuf)))) (set-buffer obuf))))
(setq compilation-in-progress (delq proc compilation-in-progress)) (setq compilation-in-progress (delq proc compilation-in-progress))
)))) ))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment