Present completions in modal window

part of darcs patch Fri Sep 23 12:32:41 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/nuit-engine.scm

@@ -413,6 +413,7 @@
      (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)))
@@ -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))))
+(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 (result-buffer-num-cols (result-buffer))
-     (focus-on-result-buffer?))
-    (refresh-result-window)))
+                           win width #t)
+  (wrefresh win))
 
 (define (current-cursor-index)
   ;; #### No, I will not comment on this.
@@ -838,29 +832,50 @@
           ((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 
+(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)))
-	(focus-command-buffer!)
             ;; #### No, I will not comment on this.
             (call-with-values
                 (lambda ()
@@ -870,16 +885,13 @@
               (lambda (completed-line new-cursor-pos)
                 (display-completed-line completed-line 
                                         (+ 2 new-cursor-pos))))
-	#f))
+            (delete-app-window! dialog)
+            #t))
          ((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)))
+          (set! select-list
+                (select-list-handle-key-press select-list key))
+          (paint)
+          #f)
          (else
-      ;; #### FIXME we loose a character this way
-      (focus-command-buffer!)
-      #f))))
+          #f))))))
 

scheme/process.scm

@@ -112,7 +112,6 @@
                                               val)) entries)))
                  (send list-viewer 'set-entries! new-entries))
                (delete-app-window! dialog)
-               (close-modal-window!)
                #t)
               (else #f))))))