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