Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
2a12d736
Commit
2a12d736
authored
Oct 09, 2008
by
Eli Zaretskii
Browse files
(compilation-start): Resurrect the version for systems that don't support
asynchronous subprocesses.
parent
ea217c11
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
68 additions
and
31 deletions
+68
-31
lisp/ChangeLog
lisp/ChangeLog
+5
-0
lisp/progmodes/compile.el
lisp/progmodes/compile.el
+63
-31
No files found.
lisp/ChangeLog
View file @
2a12d736
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>
* window.el (pop-up-frames): Add choice graphic-only.
...
...
lisp/progmodes/compile.el
View file @
2a12d736
...
...
@@ -1246,38 +1246,70 @@ Returns the compilation buffer created."
(
funcall
compilation-process-setup-function
))
(
compilation-set-window-height
outwin
)
;; Start the compilation.
(
let
((
proc
(
if
(
eq
mode
t
)
;; comint uses `start-file-process'.
(
get-buffer-process
(
with-no-warnings
(
comint-exec
outbuf
(
downcase
mode-name
)
(
if
(
file-remote-p
default-directory
)
"/bin/sh"
shell-file-name
)
nil
`
(
"-c"
,
command
))))
(
start-file-process-shell-command
(
downcase
mode-name
)
outbuf
command
))))
;; Make the buffer's mode line show process state.
(
if
(
fboundp
'start-process
)
(
let
((
proc
(
if
(
eq
mode
t
)
;; comint uses `start-file-process'.
(
get-buffer-process
(
with-no-warnings
(
comint-exec
outbuf
(
downcase
mode-name
)
(
if
(
file-remote-p
default-directory
)
"/bin/sh"
shell-file-name
)
nil
`
(
"-c"
,
command
))))
(
start-file-process-shell-command
(
downcase
mode-name
)
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
(
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
))))
(
list
(
propertize
":run"
'face
'compilation-warning
)))
(
force-mode-line-update
)
(
sit-for
0
)
; Force redisplay
(
save-excursion
;; Insert the output at the end, after the initial text,
;; regardless of where the user sees point.
(
goto-char
(
point-max
))
(
let*
((
buffer-read-only
nil
)
; call-process needs to modify outbuf
(
status
(
call-process
shell-file-name
nil
outbuf
nil
"-c"
command
)))
(
cond
((
numberp
status
)
(
compilation-handle-exit
'exit
status
(
if
(
zerop
status
)
"finished\n"
(
format
"exited abnormally with code %d\n"
status
))))
((
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/...
(
setq
default-directory
thisdir
)
;; The following form selected outwin ever since revision 1.183,
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment