procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(compilation-start): Resurrect the version for systems that don't support

Browse source 
asynchronous subprocesses.
This commit is contained in:
Eli Zaretskii 2008-10-09 13:46:25 +00:00
parent ea217c11e5
commit 2a12d736c1
2 changed files with 68 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -1,3 +1,8 @@
2008-10-09 Eli Zaretskii <eliz@gnu.org>
* progmodes/compile.el (compilation-start): Resurrect the version
for systems that don't support asynchronous subprocesses.
2008-10-09 Martin Rudalics <rudalics@gmx.at> 2008-10-09 Martin Rudalics <rudalics@gmx.at>
* window.el (pop-up-frames): Add choice graphic-only. * window.el (pop-up-frames): Add choice graphic-only.

94
lisp/progmodes/compile.el
View file

@ -1246,38 +1246,70 @@ Returns the compilation buffer created."
(funcall compilation-process-setup-function)) (funcall compilation-process-setup-function))
(compilation-set-window-height outwin) (compilation-set-window-height outwin)
;; Start the compilation. ;; Start the compilation.
(let ((proc (if (fboundp 'start-process)
(if (eq mode t) (let ((proc
;; comint uses `start-file-process'. (if (eq mode t)
(get-buffer-process ;; comint uses `start-file-process'.
(with-no-warnings (get-buffer-process
(comint-exec (with-no-warnings
outbuf (downcase mode-name) (comint-exec
(if (file-remote-p default-directory) outbuf (downcase mode-name)
"/bin/sh" (if (file-remote-p default-directory)
shell-file-name) "/bin/sh"
nil `("-c" ,command)))) shell-file-name)
(start-file-process-shell-command (downcase mode-name) nil `("-c" ,command))))
outbuf command)))) (start-file-process-shell-command (downcase mode-name)
;; Make the buffer's mode line show process state. outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process
(list (propertize ":%s" 'face 'compilation-warning)))
(set-process-sentinel proc 'compilation-sentinel)
(unless (eq mode t)
;; Keep the comint filter, since it's needed for proper handling
;; of the prompts.
(set-process-filter proc 'compilation-filter))
;; Use (point-max) here so that output comes in
;; after the initial text,
;; regardless of where the user sees point.
(set-marker (process-mark proc) (point-max) outbuf)
(when compilation-disable-input
(condition-case nil
(process-send-eof proc)
;; The process may have exited already.
(error nil)))
(setq compilation-in-progress
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
;; Fake modeline display as if `start-process' were run.
(setq mode-line-process (setq mode-line-process
(list (propertize ":%s" 'face 'compilation-warning))) (list (propertize ":run" 'face 'compilation-warning)))
(set-process-sentinel proc 'compilation-sentinel) (force-mode-line-update)
(unless (eq mode t) (sit-for 0) ; Force redisplay
;; Keep the comint filter, since it's needed for proper handling (save-excursion
;; of the prompts. ;; Insert the output at the end, after the initial text,
(set-process-filter proc 'compilation-filter)) ;; regardless of where the user sees point.
;; Use (point-max) here so that output comes in (goto-char (point-max))
;; after the initial text, (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
;; regardless of where the user sees point. (status (call-process shell-file-name nil outbuf nil "-c"
(set-marker (process-mark proc) (point-max) outbuf) command)))
(when compilation-disable-input (cond ((numberp status)
(condition-case nil (compilation-handle-exit
(process-send-eof proc) 'exit status
;; The process may have exited already. (if (zerop status)
(error nil))) "finished\n"
(setq compilation-in-progress (format "exited abnormally with code %d\n" status))))
(cons proc compilation-in-progress)))) ((stringp status)
(compilation-handle-exit 'signal status
(concat status "\n")))
(t
(compilation-handle-exit 'bizarre status status)))))
;; Without async subprocesses, the buffer is not yet
;; fontified, so fontify it now.
(let ((font-lock-verbose nil)) ; shut up font-lock messages
(font-lock-fontify-buffer))
(set-buffer-modified-p nil)
(message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/... ;; Now finally cd to where the shell started make/grep/...
(setq default-directory thisdir) (setq default-directory thisdir)
;; The following form selected outwin ever since revision 1.183, ;; The following form selected outwin ever since revision 1.183,