Use a vector to dispatch input keys
Speed up wait-for-input
This commit is contained in:
mainzelm
parent
9c494558af
commit
c82a228790
|
|
@ -457,15 +457,18 @@
|
|||
(define (process-group-leader?)
|
||||
(= (process-group) (pid)))
|
||||
|
||||
(read-config-file!)
|
||||
|
||||
;; handle input
|
||||
(define (run)
|
||||
(ignore-signal signal/ttou)
|
||||
(install-signal-handlers)
|
||||
(save-initial-tty-info! (current-input-port))
|
||||
|
||||
(init-screen)
|
||||
(init-windows!)
|
||||
(read-config-file!)
|
||||
(noecho)
|
||||
(keypad (app-window-curses-win (bar-1)) #t)
|
||||
|
||||
(set! *command-buffer-mode* (config 'main 'initial-command-mode))
|
||||
|
||||
(init-evaluation-environment! 'nuit-eval)
|
||||
|
|
@ -494,149 +497,151 @@
|
|||
(release-lock paint-lock)
|
||||
(lp (cml-receive statistics-channel))))))
|
||||
(paint)
|
||||
(dispatch-input))
|
||||
|
||||
(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))
|
||||
|
||||
;; 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?)
|
||||
(define (dispatch-input)
|
||||
(let loop ((ch (wait-for-input))
|
||||
(i 0))
|
||||
; (if (= 0 (remainder i 4))
|
||||
; (repaint-command-winow!))
|
||||
(cond
|
||||
(maybe-modal-window
|
||||
(if (maybe-modal-window ch)
|
||||
(begin
|
||||
(close-modal-window!)
|
||||
(paint)
|
||||
(when (current-history-item)
|
||||
(update-current-viewer!
|
||||
(send (current-viewer)
|
||||
'key-press ch c-x-pressed?))
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window
|
||||
(entry-data (current-history-item)))
|
||||
(refresh-result-window)
|
||||
(if focus-on-command-buffer?
|
||||
(refresh-command-window)))))
|
||||
(loop (wait-for-input) (+ i 1)))
|
||||
(else
|
||||
((vector-ref *key-map* ch) ch)
|
||||
(loop (wait-for-input) (+ i 1))))))
|
||||
|
||||
(define (result-buffer-handle-key ch)
|
||||
(when (current-history-item)
|
||||
(update-current-viewer!
|
||||
(send (current-viewer)
|
||||
'key-press ch #f))
|
||||
(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)))
|
||||
|
||||
(define (default-key-handler ch)
|
||||
(cond
|
||||
((focus-on-result-buffer?)
|
||||
(result-buffer-handle-key ch))
|
||||
(else
|
||||
(input (command-buffer) ch)
|
||||
(repaint-command-winow!))))
|
||||
|
||||
(define (repaint-command-winow!)
|
||||
(obtain-lock paint-lock)
|
||||
(werase (app-window-curses-win (command-window)))
|
||||
(print-command-buffer (command-buffer))
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock))
|
||||
|
||||
(define *key-map* (make-vector 777 default-key-handler))
|
||||
|
||||
(define (define-key! key handler)
|
||||
(vector-set! *key-map* key handler))
|
||||
|
||||
(define-key! key-end ;; TODO does not work?!?
|
||||
(lambda (ch) (show-shell-screen) (paint)))
|
||||
|
||||
(define-key! key-f2 (lambda (ch) (paint)))
|
||||
|
||||
(define-key! key-npage
|
||||
(lambda (ch)
|
||||
(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)))
|
||||
|
||||
(define-key! key-ppage
|
||||
(lambda (ch)
|
||||
;; back in result history
|
||||
(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)))
|
||||
|
||||
(define (dispatch-ctrl-x ch)
|
||||
(let ((ch (wait-for-input)))
|
||||
(cond
|
||||
;; C-x o --- toggle buffer focus
|
||||
((= ch key-o)
|
||||
(toggle-buffer-focus))
|
||||
|
||||
;; C-x p --- insert selection
|
||||
((and (current-history-item)
|
||||
(= ch 112))
|
||||
(paste-selection/refresh (current-viewer)))
|
||||
|
||||
;; C-x P --- insert focus object(s)
|
||||
((and (current-history-item)
|
||||
(= ch 80))
|
||||
(paste-focus-object/refresh (current-viewer)))
|
||||
|
||||
((and (focus-on-command-buffer?)
|
||||
(command-buffer-in-command-mode?)
|
||||
(= ch (config 'main 'switch-command-buffer-mode-key)))
|
||||
(toggle-command/scheme-mode-with-conversion))
|
||||
|
||||
((focus-on-result-buffer?)
|
||||
(update-current-viewer!
|
||||
(send (current-viewer)
|
||||
'key-press ch key-control-x)))
|
||||
|
||||
;; C-x r --- redo
|
||||
((and focus-on-command-buffer?
|
||||
(= ch 114))
|
||||
(debug-message "Eric should re-implement redo...")
|
||||
)
|
||||
(else
|
||||
(debug-message "Unknown key after C-x") ))))
|
||||
|
||||
(define-key! key-control-x dispatch-ctrl-x)
|
||||
|
||||
(define-key! (config 'main 'switch-command-buffer-mode-key)
|
||||
(lambda (ch)
|
||||
(debug-message "switching command mode")
|
||||
(toggle-command/scheme-mode)))
|
||||
|
||||
(define-key! 10
|
||||
(lambda (ch)
|
||||
(if (focus-on-command-buffer?)
|
||||
(begin
|
||||
(handle-return-key)
|
||||
(repaint-command-winow!)))))
|
||||
|
||||
(define-key! key-tab
|
||||
(lambda (ch)
|
||||
(if (and (focus-on-command-buffer?)
|
||||
(command-buffer-in-command-mode?))
|
||||
(offer-completions (buffer-text (command-buffer))))))
|
||||
|
||||
(define (paint-bar-1)
|
||||
(mvwaddstr (app-window-curses-win (bar-1)) 0 1 "Commander S")
|
||||
|
|
@ -735,11 +740,8 @@
|
|||
(refresh-result-window))))
|
||||
|
||||
(define (wait-for-input)
|
||||
(noecho)
|
||||
(keypad (app-window-curses-win (bar-1)) #t)
|
||||
(set! active-keyboard-interrupt #f)
|
||||
(let ((ch (wgetch (app-window-curses-win (bar-1)))))
|
||||
(echo)
|
||||
ch))
|
||||
|
||||
(define (find/init-plugin-for-result result)
|
||||
|
|
|
|||
Loading…
Reference in New Issue