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?)
|
(define (process-group-leader?)
|
||||||
(= (process-group) (pid)))
|
(= (process-group) (pid)))
|
||||||
|
|
||||||
|
(read-config-file!)
|
||||||
|
|
||||||
;; handle input
|
;; handle input
|
||||||
(define (run)
|
(define (run)
|
||||||
(ignore-signal signal/ttou)
|
(ignore-signal signal/ttou)
|
||||||
(install-signal-handlers)
|
(install-signal-handlers)
|
||||||
(save-initial-tty-info! (current-input-port))
|
(save-initial-tty-info! (current-input-port))
|
||||||
|
|
||||||
(init-screen)
|
(init-screen)
|
||||||
(init-windows!)
|
(init-windows!)
|
||||||
(read-config-file!)
|
(noecho)
|
||||||
|
(keypad (app-window-curses-win (bar-1)) #t)
|
||||||
|
|
||||||
(set! *command-buffer-mode* (config 'main 'initial-command-mode))
|
(set! *command-buffer-mode* (config 'main 'initial-command-mode))
|
||||||
|
|
||||||
(init-evaluation-environment! 'nuit-eval)
|
(init-evaluation-environment! 'nuit-eval)
|
||||||
|
|
@ -494,149 +497,151 @@
|
||||||
(release-lock paint-lock)
|
(release-lock paint-lock)
|
||||||
(lp (cml-receive statistics-channel))))))
|
(lp (cml-receive statistics-channel))))))
|
||||||
(paint)
|
(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)
|
(define (dispatch-input)
|
||||||
(toggle-command/scheme-mode)
|
(let loop ((ch (wait-for-input))
|
||||||
(loop (wait-for-input) #f))
|
(i 0))
|
||||||
|
; (if (= 0 (remainder i 4))
|
||||||
((= ch key-end)
|
; (repaint-command-winow!))
|
||||||
(show-shell-screen)
|
(cond
|
||||||
(paint)
|
(maybe-modal-window
|
||||||
(loop (wait-for-input) #f))
|
(if (maybe-modal-window ch)
|
||||||
|
(begin
|
||||||
((= ch key-f1)
|
(close-modal-window!)
|
||||||
(endwin))
|
(paint)
|
||||||
|
|
||||||
((= 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)
|
||||||
(update-current-viewer!
|
(paint-result-window
|
||||||
(send (current-viewer)
|
(entry-data (current-history-item)))
|
||||||
'key-press ch c-x-pressed?))
|
(refresh-result-window)
|
||||||
(obtain-lock paint-lock)
|
(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
|
;;; 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))
|
|
||||||
(else
|
(define (default-key-handler ch)
|
||||||
(input (command-buffer) ch)
|
(cond
|
||||||
(obtain-lock paint-lock)
|
((focus-on-result-buffer?)
|
||||||
(werase (app-window-curses-win (command-window)))
|
(result-buffer-handle-key ch))
|
||||||
(print-command-buffer (command-buffer))
|
(else
|
||||||
(refresh-command-window)
|
(input (command-buffer) ch)
|
||||||
(release-lock paint-lock)
|
(repaint-command-winow!))))
|
||||||
(loop (wait-for-input) c-x-pressed?)))))))))
|
|
||||||
|
(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)
|
(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")
|
||||||
|
|
@ -735,11 +740,8 @@
|
||||||
(refresh-result-window))))
|
(refresh-result-window))))
|
||||||
|
|
||||||
(define (wait-for-input)
|
(define (wait-for-input)
|
||||||
(noecho)
|
|
||||||
(keypad (app-window-curses-win (bar-1)) #t)
|
|
||||||
(set! active-keyboard-interrupt #f)
|
(set! active-keyboard-interrupt #f)
|
||||||
(let ((ch (wgetch (app-window-curses-win (bar-1)))))
|
(let ((ch (wgetch (app-window-curses-win (bar-1)))))
|
||||||
(echo)
|
|
||||||
ch))
|
ch))
|
||||||
|
|
||||||
(define (find/init-plugin-for-result result)
|
(define (find/init-plugin-for-result result)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue