[beirc-cvs] CVS beirc

afuchs afuchs at common-lisp.net
Fri Jan 27 17:18:04 UTC 2006


Update of /project/beirc/cvsroot/beirc
In directory common-lisp:/tmp/cvs-serv10831

Modified Files:
	presentations.lisp 
Log Message:
Finally! RET no longer tries to complete the line!

(Careful reading of the clim spec really paid off (-:)


--- /project/beirc/cvsroot/beirc/presentations.lisp	2005/10/01 18:18:50	1.7
+++ /project/beirc/cvsroot/beirc/presentations.lisp	2006/01/27 17:18:04	1.8
@@ -32,27 +32,29 @@
                             (cond ((not success) "")
                                   ((zerop (length prefix)) ": ")
                                   (t " ")))))
-      (multiple-value-bind (string success object nmatches possibilities)
-          (complete-from-possibilities word
-                                       (let ((channel (and
-                                                       (current-channel)
-                                                       (irc:find-channel
-                                                        (current-connection *application-frame*)
-                                                        (current-channel)))))
-                                         (if (not (null channel))
-                                             (hash-alist (irc:users channel))
-                                             nil))
-                                       '()
-                                       :action mode
-                                       :value-key #'cdr)
-        (values (prefixify (if (not success)
-                               string
-                               (irc:nickname object))
-                           success)
-                success object nmatches (mapcar (lambda (possibility)
-                                                  (cons (prefixify (car possibility))
-                                                        (cdr possibility)))
-                                                possibilities))))))
+      (if (eql mode :complete) ; the user entered an activation gesture. don't complete.
+          (values so-far nil nil 0 nil)
+          (multiple-value-bind (string success object nmatches possibilities)
+              (complete-from-possibilities word
+                                           (let ((channel (and
+                                                           (current-channel)
+                                                           (irc:find-channel
+                                                            (current-connection *application-frame*)
+                                                            (current-channel)))))
+                                             (if (not (null channel))
+                                                 (hash-alist (irc:users channel))
+                                                 nil))
+                                           '()
+                                           :action mode
+                                           :value-key #'cdr)
+            (values (prefixify (if (not success)
+                                   string
+                                   (irc:nickname object))
+                               success)
+                    success object nmatches (mapcar (lambda (possibility)
+                                                      (cons (prefixify (car possibility))
+                                                            (cdr possibility)))
+                                                    possibilities)))))))
 
 ;; FIXME/FIXMCCLIM: :possibility-printer is ignored in current
 ;; McCLIM's COMPLETE-INPUT implementation.
@@ -64,11 +66,11 @@
 (define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key)
   (with-delimiter-gestures (nil :override t)
     (let ((*completion-gestures* '(#\Tab)))
-      (nth-value 2
-                 (complete-input *standard-input* 'nickname-completer
-                                 #+(or):possibility-printer #+(or) 'nickname-competion-printer
-                                 :allow-any-input t
-                                 :partial-completers '())))))
+        (nth-value 2
+                   (complete-input *standard-input* 'nickname-completer
+                                   #+(or):possibility-printer #+(or) 'nickname-competion-printer
+                                   :allow-any-input t
+                                   :partial-completers '())))))
 
 ;;; nicknames
 




More information about the Beirc-cvs mailing list