Fix asynchronous job status updates
This commit is contained in:
parent
b9d54a24ae
commit
143d6bbccb
|
@ -7,11 +7,14 @@
|
|||
(begin ?do-this ... (values))
|
||||
(values)))))
|
||||
|
||||
(define (with-lock lock thunk)
|
||||
(define-syntax with-lock
|
||||
(syntax-rules ()
|
||||
((_ lock exp ...)
|
||||
(begin
|
||||
(obtain-lock lock)
|
||||
(let ((val (thunk)))
|
||||
(let ((val (begin exp ...)))
|
||||
(release-lock lock)
|
||||
val))
|
||||
val)))))
|
||||
|
||||
;;This is the "heart" of NUIT.
|
||||
;;In a central loop the program waits for input (with wgetch).
|
||||
|
@ -51,6 +54,8 @@
|
|||
(define executable-completions-lock (make-lock))
|
||||
(define executable-completions #f)
|
||||
|
||||
(define paint-lock (make-lock))
|
||||
|
||||
(define key-control-x 24)
|
||||
(define key-o 111)
|
||||
(define key-tab 9)
|
||||
|
@ -257,10 +262,12 @@
|
|||
(make-history-entry command args viewer)))
|
||||
;; FIXME, use insert here
|
||||
(append-to-history! new-entry)
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window new-entry)
|
||||
(refresh-result-window)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)))
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock)))
|
||||
|
||||
(define (eval-command-in-scheme-mode command-line)
|
||||
(let ((viewer
|
||||
|
@ -273,10 +280,12 @@
|
|||
(make-history-entry command args viewer)))
|
||||
;; #### shouldn't we use some kind of insertion here?
|
||||
(append-to-history! new-entry)
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window new-entry)
|
||||
(refresh-result-window)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window))))
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock))))
|
||||
|
||||
;; #### crufty
|
||||
(define split-command-line string-tokenize)
|
||||
|
@ -311,10 +320,14 @@
|
|||
(lambda ()
|
||||
(let lp ((stats (cml-receive statistics-channel)))
|
||||
(debug-message "statistics update " stats)
|
||||
(obtain-lock paint-lock)
|
||||
(paint-command-frame-window)
|
||||
(paint-job-status-list stats)
|
||||
(paint-command-window-contents)
|
||||
(wrefresh (app-window-curses-win command-frame-window))
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock)
|
||||
(lp (cml-receive statistics-channel))))))
|
||||
|
||||
(set-process-group (pid) (pid))
|
||||
|
@ -401,28 +414,34 @@
|
|||
;; forward in result history
|
||||
((= ch key-npage)
|
||||
(history-forward!)
|
||||
(obtain-lock paint-lock)
|
||||
(when (current-history-item)
|
||||
(paint-active-command-window)
|
||||
(paint-result-window (entry-data (current-history-item))))
|
||||
(refresh-result-window)
|
||||
(release-lock paint-lock)
|
||||
(loop (wait-for-input) c-x-pressed? #f))
|
||||
|
||||
;; back in result history
|
||||
((= ch key-ppage)
|
||||
(history-back!)
|
||||
(obtain-lock paint-lock)
|
||||
(when (current-history-item)
|
||||
(paint-active-command-window)
|
||||
(paint-result-window (entry-data (current-history-item))))
|
||||
(refresh-result-window)
|
||||
(release-lock paint-lock)
|
||||
(loop (wait-for-input) c-x-pressed? #f))
|
||||
|
||||
((and (focus-on-command-buffer?) (= ch 10))
|
||||
(input command-buffer ch)
|
||||
(obtain-lock paint-lock)
|
||||
(werase (app-window-curses-win command-window))
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock)
|
||||
(handle-return-key)
|
||||
(loop (wait-for-input) c-x-pressed? #f))
|
||||
|
||||
|
@ -433,17 +452,21 @@
|
|||
(update-current-viewer!
|
||||
(send (current-viewer)
|
||||
'key-press ch c-x-pressed?))
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window (entry-data (current-history-item)))
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-result-window))
|
||||
(refresh-result-window)
|
||||
(release-lock paint-lock))
|
||||
(loop (wait-for-input) #f #f))
|
||||
(else
|
||||
(input command-buffer ch)
|
||||
(obtain-lock paint-lock)
|
||||
(werase (app-window-curses-win command-window))
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock)
|
||||
(loop (wait-for-input) c-x-pressed? #f)))))))
|
||||
|
||||
(define (window-init-curses-win! window)
|
||||
|
@ -516,10 +539,8 @@
|
|||
(spawn
|
||||
(lambda ()
|
||||
(with-lock executable-completions-lock
|
||||
(lambda()
|
||||
(set! executable-completions
|
||||
(make-completion-set-for-executables (get-path-list)))
|
||||
(debug-message "finished scanning executable-completions-set"))))))
|
||||
(make-completion-set-for-executables (get-path-list)))))))
|
||||
|
||||
(define (paint-bar-1)
|
||||
(mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
|
||||
|
@ -815,8 +836,7 @@
|
|||
(append
|
||||
(completions-for (command-completions) prefix)
|
||||
(with-lock executable-completions-lock
|
||||
(lambda ()
|
||||
(completions-for-executables executable-completions prefix)))))))
|
||||
(completions-for-executables executable-completions prefix))))))
|
||||
|
||||
(define (file-completer command prefix args args-pos)
|
||||
(if (zero? (string-length prefix))
|
||||
|
|
|
@ -251,6 +251,7 @@
|
|||
let-opt
|
||||
srfi-1
|
||||
|
||||
jobs
|
||||
focus-table
|
||||
fs-object
|
||||
pps)
|
||||
|
|
Loading…
Reference in New Issue