+ help window for process viewer
+ slightly speed up key dispatcher
This commit is contained in:
mainzelm
parent
bd45459034
commit
f1111f3dfa
|
|
@ -80,12 +80,13 @@
|
|||
(let* ((dialog-win (app-window-curses-win dialog))
|
||||
(select-list
|
||||
(make-select-list
|
||||
(map (lambda (elem elem-str)
|
||||
(if (member elem current)
|
||||
(make-marked-text-element
|
||||
elem #t elem-str)
|
||||
(make-unmarked-text-element
|
||||
elem #t elem-str)))
|
||||
(map
|
||||
(lambda (elem elem-str)
|
||||
(if (member elem current)
|
||||
(make-marked-text-element
|
||||
elem #t elem-str)
|
||||
(make-unmarked-text-element
|
||||
elem #t elem-str)))
|
||||
set set-strings)
|
||||
(- lines 3))))
|
||||
|
||||
|
|
@ -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))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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,147 +494,149 @@
|
|||
(release-lock paint-lock)
|
||||
(lp (cml-receive statistics-channel))))))
|
||||
(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
|
||||
(maybe-modal-window
|
||||
(if (maybe-modal-window ch)
|
||||
(begin
|
||||
(close-modal-window!)
|
||||
(paint)
|
||||
;; 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))
|
||||
|
||||
((= 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)
|
||||
(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))
|
||||
|
||||
;; 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)
|
||||
(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
|
||||
(if (redisplay-everything?)
|
||||
(begin
|
||||
(paint-result-frame-window)
|
||||
(paint-active-command-window)
|
||||
(unset-redisplay-everything)))
|
||||
(if (redisplay-everything?)
|
||||
(begin
|
||||
(paint-result-frame-window)
|
||||
(paint-active-command-window)
|
||||
(unset-redisplay-everything)))
|
||||
|
||||
(paint-result-window (entry-data (current-history-item)))
|
||||
(refresh-result-window)
|
||||
(release-lock paint-lock))
|
||||
(loop (wait-for-input) #f))
|
||||
(else
|
||||
(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?)))))))
|
||||
(paint-result-window (entry-data (current-history-item)))
|
||||
(refresh-result-window)
|
||||
(release-lock paint-lock))
|
||||
(loop (wait-for-input) #f))
|
||||
(else
|
||||
(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?)))))))))
|
||||
|
||||
(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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue