From 143d6bbccba76832a877989473bdf4dfcd8986c6 Mon Sep 17 00:00:00 2001 From: eknauel Date: Sat, 4 Jun 2005 09:43:22 +0000 Subject: [PATCH] Fix asynchronous job status updates --- scheme/nuit-engine.scm | 56 +++++++++++++++++++++++++++------------- scheme/nuit-packages.scm | 1 + 2 files changed, 39 insertions(+), 18 deletions(-) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 288ffb7..16ea7c0 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -7,11 +7,14 @@ (begin ?do-this ... (values)) (values))))) -(define (with-lock lock thunk) - (obtain-lock lock) - (let ((val (thunk))) - (release-lock lock) - val)) +(define-syntax with-lock + (syntax-rules () + ((_ lock exp ...) + (begin + (obtain-lock lock) + (let ((val (begin exp ...))) + (release-lock lock) + 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) - (paint-command-frame-window) - (paint-job-status-list stats) - (paint-command-window-contents) - (refresh-command-window) + (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")))))) + (set! executable-completions + (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)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 4aae8ed..8c59eec 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -251,6 +251,7 @@ let-opt srfi-1 + jobs focus-table fs-object pps)