Present completions in modal window
part of darcs patch Fri Sep 23 12:32:41 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel
parent
c9bd3f8209
commit
de78de0050
|
|
@ -412,7 +412,8 @@
|
|||
(cond
|
||||
(maybe-modal-window
|
||||
(if (maybe-modal-window ch)
|
||||
(begin
|
||||
(begin
|
||||
(close-modal-window!)
|
||||
(paint)
|
||||
(when (current-history-item)
|
||||
(paint-result-window (entry-data (current-history-item)))
|
||||
|
|
@ -422,10 +423,6 @@
|
|||
((= ch key-control-x)
|
||||
(loop (wait-for-input) #t completion-selector))
|
||||
|
||||
((and (focus-on-result-buffer?) completion-selector)
|
||||
(let ((new-selector (completion-selector ch)))
|
||||
(loop (wait-for-input) c-x-pressed? new-selector)))
|
||||
|
||||
;; tab pressed twice, select completion using select-list
|
||||
((and (focus-on-command-buffer?)
|
||||
completion-selector
|
||||
|
|
@ -437,9 +434,8 @@
|
|||
((and (focus-on-command-buffer?)
|
||||
(command-buffer-in-command-mode?)
|
||||
(= ch key-tab))
|
||||
(let ((maybe-selector
|
||||
(offer-completions (last (buffer-text (command-buffer))))))
|
||||
(loop (wait-for-input) #f maybe-selector)))
|
||||
(offer-completions (last (buffer-text (command-buffer))))
|
||||
(loop (wait-for-input) #f #f))
|
||||
|
||||
((and (focus-on-command-buffer?)
|
||||
(command-buffer-in-command-mode?)
|
||||
|
|
@ -803,17 +799,15 @@
|
|||
(move-cursor (command-buffer) (result-buffer))
|
||||
(refresh-command-window))
|
||||
|
||||
(define (paint-completion-select-list select-list command)
|
||||
(let ((win (app-window-curses-win (result-window))))
|
||||
(wclear win)
|
||||
(wattron win (A-BOLD))
|
||||
(mvwaddstr win 0 0
|
||||
(string-append "Possible completions for " command))
|
||||
(wattrset win (A-NORMAL))
|
||||
(paint-selection-list-at select-list 0 2
|
||||
win (result-buffer-num-cols (result-buffer))
|
||||
(focus-on-result-buffer?))
|
||||
(refresh-result-window)))
|
||||
(define (paint-completion-select-list win width select-list command)
|
||||
(wclear win)
|
||||
(wattron win (A-BOLD))
|
||||
(mvwaddstr win 0 0
|
||||
(string-append "Possible completions for " command))
|
||||
(wattrset win (A-NORMAL))
|
||||
(paint-selection-list-at select-list 0 2
|
||||
win width #t)
|
||||
(wrefresh win))
|
||||
|
||||
(define (current-cursor-index)
|
||||
;; #### No, I will not comment on this.
|
||||
|
|
@ -838,48 +832,66 @@
|
|||
((null? completions)
|
||||
#f)
|
||||
((list? completions)
|
||||
(let* ((select-list
|
||||
(completions->select-list
|
||||
completions
|
||||
(- (result-buffer-num-lines (result-buffer)) 3)))
|
||||
(selector
|
||||
(make-completion-selector select-list completions
|
||||
cmdln to-complete)))
|
||||
(paint-completion-select-list select-list command)
|
||||
(move-cursor (command-buffer) (result-buffer))
|
||||
(refresh-command-window)
|
||||
selector))
|
||||
(set-modal-window!
|
||||
(make-completions-window command completions cmdln to-complete)))
|
||||
(else
|
||||
(error "COMPLETE returned an unexpected value"
|
||||
completions)))))))
|
||||
|
||||
(define (make-completion-selector select-list completions
|
||||
cmdln to-complete)
|
||||
(lambda (key)
|
||||
(cond
|
||||
((= key 10)
|
||||
(let ((completion
|
||||
(select-list-selected-entry select-list)))
|
||||
(focus-command-buffer!)
|
||||
;; #### No, I will not comment on this.
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(unparse-command-line cmdln
|
||||
(lambda (to-complete)
|
||||
(display completion))))
|
||||
(lambda (completed-line new-cursor-pos)
|
||||
(display-completed-line completed-line
|
||||
(+ 2 new-cursor-pos))))
|
||||
#f))
|
||||
((select-list-key? key)
|
||||
(let ((new-select-list
|
||||
(select-list-handle-key-press select-list key)))
|
||||
(paint-completion-select-list
|
||||
new-select-list (last (buffer-text (command-buffer))))
|
||||
(make-completion-selector
|
||||
new-select-list completions cmdln to-complete)))
|
||||
(else
|
||||
;; #### FIXME we loose a character this way
|
||||
(focus-command-buffer!)
|
||||
#f))))
|
||||
(define (make-completions-window command completions
|
||||
cmdln to-complete)
|
||||
(define header-line "Select completion")
|
||||
(define header-length (string-length header-line))
|
||||
|
||||
(let* ((lines 10)
|
||||
(inner-width
|
||||
(min (apply max header-length
|
||||
(map string-length completions))
|
||||
(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
|
||||
(completions->select-list
|
||||
completions
|
||||
(- 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-completion-select-list dialog-win inner-width select-list command)
|
||||
(wrefresh dialog-win))
|
||||
(paint)
|
||||
(lambda (key)
|
||||
(cond
|
||||
((= key 10)
|
||||
(let ((completion
|
||||
(select-list-selected-entry select-list)))
|
||||
;; #### No, I will not comment on this.
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(unparse-command-line cmdln
|
||||
(lambda (to-complete)
|
||||
(display completion))))
|
||||
(lambda (completed-line new-cursor-pos)
|
||||
(display-completed-line completed-line
|
||||
(+ 2 new-cursor-pos))))
|
||||
(delete-app-window! dialog)
|
||||
#t))
|
||||
((select-list-key? key)
|
||||
(set! select-list
|
||||
(select-list-handle-key-press select-list key))
|
||||
(paint)
|
||||
#f)
|
||||
(else
|
||||
#f))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -112,7 +112,6 @@
|
|||
val)) entries)))
|
||||
(send list-viewer 'set-entries! new-entries))
|
||||
(delete-app-window! dialog)
|
||||
(close-modal-window!)
|
||||
#t)
|
||||
(else #f))))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue