scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ help window for process viewer 

+ slightly speed up key dispatcher
This commit is contained in:
mainzelm 2006-04-05 13:16:38 +00:00
parent bd45459034
commit f1111f3dfa
4 changed files with 212 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
scheme/filter-window.scm
View File

@ -80,12 +80,13 @@
(let* ((dialog-win (app-window-curses-win dialog)) (let* ((dialog-win (app-window-curses-win dialog))
(select-list (select-list
(make-select-list (make-select-list
(map (lambda (elem elem-str) (map
(if (member elem current) (lambda (elem elem-str)
(make-marked-text-element (if (member elem current)
elem #t elem-str) (make-marked-text-element
(make-unmarked-text-element elem #t elem-str)
elem #t elem-str))) (make-unmarked-text-element
elem #t elem-str)))
set set-strings) set set-strings)
(- lines 3)))) (- lines 3))))
@ -118,4 +119,59 @@
#t)) #t))
(else #f)))))) (else #f))))))
(define (make-help-window module . keys)
(define header-line "Key bindings")
(define header-length (string-length header-line))
(define help-strings
(map (lambda (key)
(string-append
(symbol->string key)
" -> "
(make-string 1 (ascii->char (config module key)))))
keys))
(let* ((lines 10)
(inner-width
(min (apply max header-length
(map string-length help-strings))
(COLS)))
(dialog (make-app-window (- (quotient (COLS) 2)
(quotient inner-width 2))
5
(+ 4 inner-width)
lines)))
(app-window-init-curses-win! dialog)
(let* ((dialog-win (app-window-curses-win dialog))
(select-list
(make-select-list
(map (lambda (str)
(make-unmarked-text-element
str #f str))
help-strings)
(- lines 3))))
(define (paint)
(werase dialog-win)
(box dialog-win
(ascii->char 0) (ascii->char 0))
(mvwaddstr dialog-win
0
(+ 1 (quotient (- inner-width header-length) 2))
header-line)
(paint-selection-list-at select-list 2 1 dialog-win inner-width #t)
(wrefresh dialog-win))
(paint)
(lambda (key)
(cond ((= key (config 'main 'quit-help-key))
(delete-app-window! dialog)
(close-modal-window!)
#t)
((select-list-key? key)
(set! select-list
(select-list-handle-key-press select-list key))
(paint)
#f)
(else #f))))))

279
scheme/nuit-engine.scm
View File

@ -17,6 +17,8 @@
;; configurable options ;; configurable options
(define-option 'main 'switch-command-buffer-mode-key key-f7) (define-option 'main 'switch-command-buffer-mode-key key-f7)
(define-option 'main 'help-key (char->ascii #\?))
(define-option 'main 'quit-help-key (char->ascii #\q))
;; mode of the command buffer ;; mode of the command buffer
(define-option 'main 'initial-command-mode 'command) (define-option 'main 'initial-command-mode 'command)
@ -492,147 +494,149 @@
(release-lock paint-lock) (release-lock paint-lock)
(lp (cml-receive statistics-channel)))))) (lp (cml-receive statistics-channel))))))
(paint) (paint)
(let loop ((ch (wait-for-input))
(c-x-pressed? #f)) (let ((switch-command-buffer-mode-key (config 'main 'switch-command-buffer-mode-key)))
(let loop ((ch (wait-for-input))
(c-x-pressed? #f))
(let ((focus-on-command-buffer? (focus-on-command-buffer?)))
(cond
(maybe-modal-window
(if (maybe-modal-window ch)
(begin
(close-modal-window!)
(paint)
(when (current-history-item)
(paint-result-window
(entry-data (current-history-item)))
(refresh-result-window)
(if focus-on-command-buffer?
(refresh-command-window)))))
(loop (wait-for-input) c-x-pressed?))
;; Ctrl-x -> wait for next input
((= ch key-control-x)
(loop (wait-for-input) #t))
(cond ;; tab is pressed, offer completions
(maybe-modal-window ((and focus-on-command-buffer?
(if (maybe-modal-window ch) (command-buffer-in-command-mode?)
(begin (= ch key-tab))
(close-modal-window!) (offer-completions (buffer-text (command-buffer)))
(paint) (loop (wait-for-input) #f))
((= ch switch-command-buffer-mode-key)
(toggle-command/scheme-mode)
(loop (wait-for-input) #f))
((= ch key-end)
(show-shell-screen)
(paint)
(loop (wait-for-input) #f))
((= ch key-f1)
(endwin))
((= ch key-f2)
(paint)
(loop (wait-for-input) c-x-pressed?))
;; forward in result history
((= ch key-npage)
(history-forward!)
(obtain-lock paint-lock)
(when (current-history-item)
(signal-result-buffer-object-change)
(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?))
;; back in result history
((= ch key-ppage)
(history-back!)
(obtain-lock paint-lock)
(when (current-history-item)
(signal-result-buffer-object-change)
(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?))
((and focus-on-command-buffer? (= ch 10))
(handle-return-key)
;(input (command-buffer) ch)
(obtain-lock paint-lock)
(werase (app-window-curses-win (command-window)))
(print-command-buffer (command-buffer))
(refresh-command-window)
(release-lock paint-lock)
(loop (wait-for-input) c-x-pressed?))
(c-x-pressed?
(cond
;; C-x o --- toggle buffer focus
((= ch key-o)
(toggle-buffer-focus)
(loop (wait-for-input) #f))
;; C-x p --- insert selection
((and (current-history-item)
(= ch 112))
(paste-selection/refresh (current-viewer))
(loop (wait-for-input) #f))
;; C-x P --- insert focus object(s)
((and (current-history-item)
(= ch 80))
(paste-focus-object/refresh (current-viewer))
(loop (wait-for-input) #f))
((and focus-on-result-buffer?)
(update-current-viewer!
(send (current-viewer)
'key-press ch key-control-x))
(loop (wait-for-input) #f))
;; C-x r --- redo
((and focus-on-command-buffer?
(= ch 114))
(debug-message "Eric should re-implement redo...")
(loop (wait-for-input) #f))
(else
(debug-message "Unknown key after C-x")
(loop (wait-for-input) #f))))
(else
(cond
((focus-on-result-buffer?)
(when (current-history-item) (when (current-history-item)
(paint-result-window (update-current-viewer!
(entry-data (current-history-item))) (send (current-viewer)
(refresh-result-window) 'key-press ch c-x-pressed?))
(if (focus-on-command-buffer?) (obtain-lock paint-lock)
(refresh-command-window)))))
(loop (wait-for-input) c-x-pressed?))
;; Ctrl-x -> wait for next input
((= ch key-control-x)
(loop (wait-for-input) #t))
;; tab is pressed, offer completions
((and (focus-on-command-buffer?)
(command-buffer-in-command-mode?)
(= ch key-tab))
(offer-completions (buffer-text (command-buffer)))
(loop (wait-for-input) #f))
((and (focus-on-command-buffer?)
(command-buffer-in-command-mode?)
c-x-pressed?
(= ch (config 'main 'switch-command-buffer-mode-key)))
(toggle-command/scheme-mode-with-conversion)
(loop (wait-for-input) #f))
((= ch (config 'main 'switch-command-buffer-mode-key))
(toggle-command/scheme-mode)
(loop (wait-for-input) #f))
((= ch key-end)
(show-shell-screen)
(paint)
(loop (wait-for-input) #f))
;; C-x o --- toggle buffer focus
((and c-x-pressed? (= ch key-o))
(toggle-buffer-focus)
(loop (wait-for-input) #f))
;; C-x p --- insert selection
((and c-x-pressed? (current-history-item)
(= ch 112))
(paste-selection/refresh (current-viewer))
(loop (wait-for-input) #f))
;; C-x P --- insert focus object(s)
((and c-x-pressed? (current-history-item)
(= ch 80))
(paste-focus-object/refresh (current-viewer))
(loop (wait-for-input) #f))
((and c-x-pressed? (focus-on-result-buffer?))
(update-current-viewer!
(send (current-viewer)
'key-press ch key-control-x))
(loop (wait-for-input) #f))
;; C-x r --- redo
((and c-x-pressed? (focus-on-command-buffer?)
(= ch 114))
(debug-message "Eric should re-implement redo...")
(loop (wait-for-input) #f))
((= ch key-f1)
(endwin))
((= ch key-f2)
(paint)
(loop (wait-for-input) c-x-pressed?))
;; forward in result history
((= ch key-npage)
(history-forward!)
(obtain-lock paint-lock)
(when (current-history-item)
(signal-result-buffer-object-change)
(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?))
;; back in result history
((= ch key-ppage)
(history-back!)
(obtain-lock paint-lock)
(when (current-history-item)
(signal-result-buffer-object-change)
(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?))
((and (focus-on-command-buffer?) (= ch 10))
(handle-return-key)
;(input (command-buffer) ch)
(obtain-lock paint-lock)
(werase (app-window-curses-win (command-window)))
(print-command-buffer (command-buffer))
(refresh-command-window)
(release-lock paint-lock)
(loop (wait-for-input) c-x-pressed?))
(else
(cond
((focus-on-result-buffer?)
(when (current-history-item)
(update-current-viewer!
(send (current-viewer)
'key-press ch c-x-pressed?))
(obtain-lock paint-lock)
;;; only necessary when continueing a background job in fg ;;; only necessary when continueing a background job in fg
(if (redisplay-everything?) (if (redisplay-everything?)
(begin (begin
(paint-result-frame-window) (paint-result-frame-window)
(paint-active-command-window) (paint-active-command-window)
(unset-redisplay-everything))) (unset-redisplay-everything)))
(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)) (release-lock paint-lock))
(loop (wait-for-input) #f)) (loop (wait-for-input) #f))
(else (else
(input (command-buffer) ch) (input (command-buffer) ch)
(obtain-lock paint-lock) (obtain-lock paint-lock)
(werase (app-window-curses-win (command-window))) (werase (app-window-curses-win (command-window)))
(print-command-buffer (command-buffer)) (print-command-buffer (command-buffer))
(refresh-command-window) (refresh-command-window)
(release-lock paint-lock) (release-lock paint-lock)
(loop (wait-for-input) c-x-pressed?))))))) (loop (wait-for-input) c-x-pressed?)))))))))
(define (paint-bar-1) (define (paint-bar-1)
(mvwaddstr (app-window-curses-win (bar-1)) 0 1 "Commander S") (mvwaddstr (app-window-curses-win (bar-1)) 0 1 "Commander S")
@ -873,7 +877,8 @@
(define header-line "Select completion") (define header-line "Select completion")
(define header-length (string-length header-line)) (define header-length (string-length header-line))
(let* ((lines 10) (let* ((lines (min (- (LINES) 5)
(length completions)))
(inner-width (inner-width
(min (apply max header-length (min (apply max header-length
(map string-length completions)) (map string-length completions))

4
scheme/nuit-packages.scm
View File

@ -446,7 +446,8 @@
(define-interface filter-window-interface (define-interface filter-window-interface
(export (export
make-filter-window make-filter-window
make-subset-window)) make-subset-window
make-help-window))
(define-structure filter-window filter-window-interface (define-structure filter-window filter-window-interface
(open scheme (open scheme
@ -454,6 +455,7 @@
ascii ascii
utils utils
configuration
app-windows app-windows
modal-window modal-window
objects objects

5
scheme/process.scm
View File

@ -181,6 +181,11 @@
((= key (config 'ps 'refresh-key)) ((= key (config 'ps 'refresh-key))
(send self 'set-processes! (pps)) (send self 'set-processes! (pps))
self) self)
((= key (config 'main 'help-key))
(set-modal-window!
(make-help-window 'ps 'sort-up-key 'sort-down-key 'filter-key 'columns-key
'kill-key 'refresh-key))
self)
((select-list-key? key) ((select-list-key? key)
(set! select-list (set! select-list
(select-list-handle-key-press select-list key)) (select-list-handle-key-press select-list key))