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

58
scheme/filter-window.scm
View File

@ -80,7 +80,8 @@
(let* ((dialog-win (app-window-curses-win dialog))
(select-list
(make-select-list
(map (lambda (elem elem-str)
(map
(lambda (elem elem-str)
(if (member elem current)
(make-marked-text-element
elem #t elem-str)
@ -118,4 +119,59 @@
#t))
(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))))))

89
scheme/nuit-engine.scm
View File

@ -17,6 +17,8 @@
;; configurable options
(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
(define-option 'main 'initial-command-mode 'command)
@ -492,9 +494,13 @@
(release-lock paint-lock)
(lp (cml-receive statistics-channel))))))
(paint)
(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)
@ -505,7 +511,7 @@
(paint-result-window
(entry-data (current-history-item)))
(refresh-result-window)
(if (focus-on-command-buffer?)
(if focus-on-command-buffer?
(refresh-command-window)))))
(loop (wait-for-input) c-x-pressed?))
;; Ctrl-x -> wait for next input
@ -513,20 +519,13 @@
(loop (wait-for-input) #t))
;; tab is pressed, offer completions
((and (focus-on-command-buffer?)
((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))
((= ch switch-command-buffer-mode-key)
(toggle-command/scheme-mode)
(loop (wait-for-input) #f))
@ -535,35 +534,6 @@
(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))
@ -595,7 +565,7 @@
(release-lock paint-lock)
(loop (wait-for-input) c-x-pressed?))
((and (focus-on-command-buffer?) (= ch 10))
((and focus-on-command-buffer? (= ch 10))
(handle-return-key)
;(input (command-buffer) ch)
(obtain-lock paint-lock)
@ -605,6 +575,40 @@
(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?)
@ -632,7 +636,7 @@
(print-command-buffer (command-buffer))
(refresh-command-window)
(release-lock paint-lock)
(loop (wait-for-input) c-x-pressed?)))))))
(loop (wait-for-input) c-x-pressed?)))))))))
(define (paint-bar-1)
(mvwaddstr (app-window-curses-win (bar-1)) 0 1 "Commander S")
@ -873,7 +877,8 @@
(define header-line "Select completion")
(define header-length (string-length header-line))
(let* ((lines 10)
(let* ((lines (min (- (LINES) 5)
(length completions)))
(inner-width
(min (apply max header-length
(map string-length completions))

4
scheme/nuit-packages.scm
View File

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

5
scheme/process.scm
View File

@ -181,6 +181,11 @@
((= key (config 'ps 'refresh-key))
(send self 'set-processes! (pps))
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)
(set! select-list
(select-list-handle-key-press select-list key))