[beirc-cvs] CVS update: beirc/application.lisp beirc/presentations.lisp beirc/receivers.lisp

[Andreas Fuchs]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv2856

Modified Files:
	application.lisp presentations.lisp receivers.lisp 
Log Message:
Add nickname tab completion using complete-input and a custom
completion function.

Date: Tue Sep 27 22:53:41 2005
Author: afuchs

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.13 beirc/application.lisp:1.14
--- beirc/application.lisp:1.13	Mon Sep 26 12:52:05 2005
+++ beirc/application.lisp	Tue Sep 27 22:53:41 2005
@@ -352,6 +352,9 @@
 (define-beirc-command (com-names :name t) ()
   (irc:names (current-connection *application-frame*) (target)))
 
+(define-beirc-command (com-away :name t) ((reason 'mumble :prompt "reason"))
+  (irc:away (current-connection *application-frame*) reason))
+
 (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason"))
   (when (current-connection *application-frame*)
     (disconnect *application-frame* reason))


Index: beirc/presentations.lisp
diff -u beirc/presentations.lisp:1.2 beirc/presentations.lisp:1.3
--- beirc/presentations.lisp:1.2	Sun Sep 25 17:48:32 2005
+++ beirc/presentations.lisp	Tue Sep 27 22:53:41 2005
@@ -14,14 +14,54 @@
 
 ;;; mumble
 
+(defun split-input-line (so-far)
+  (multiple-value-bind (word subseq-index)
+      (split-sequence:split-sequence #\Space so-far
+                                     :from-end t
+                                     :remove-empty-subseqs nil
+                                     :count 1)
+    (values (first word)
+            (if (= 0 subseq-index)
+                ""
+                (concatenate 'string (subseq so-far 0 subseq-index) " ")))))
+
+(defun nickname-completer (so-far mode)
+  (multiple-value-bind (word prefix) (split-input-line so-far)
+    (labels ((prefixify (word)
+               (if (zerop (length prefix))
+                   (concatenate 'string word ": ")
+                   (concatenate 'string prefix word " "))))
+      (multiple-value-bind (string success object nmatches possibilities)
+          (complete-from-possibilities word
+                                       (if (not (null (current-channel)))
+                                           (hash-alist
+                                            (irc:users
+                                             (irc:find-channel
+                                              (current-connection *application-frame*)
+                                              (current-channel))))
+                                           nil)
+                                       '()
+                                       :action mode
+                                       :value-key #'cdr)
+        (values (prefixify string)
+                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.
+#+(or)
+(defun nickname-completion-printer (string object stream)
+  (declare (ignore string))
+  (present (irc:name object) 'nickname :stream stream))
+
 (define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key)
-  (with-output-to-string (bag)
-    (loop
-        (let ((c (peek-char nil)))
-          (cond ((char= c #\newline)
-                 (return))
-                (t
-                 (write-char (read-char) bag)))))))
+  (let ((*completion-gestures* '(#\Tab)))
+      (nth-value 2
+                 (complete-input *standard-input* 'nickname-completer
+                                 #+(or):possibility-printer #+(or) 'nickname-competion-printer
+                                 :allow-any-input t))))
 
 ;;; nicknames
 


Index: beirc/receivers.lisp
diff -u beirc/receivers.lisp:1.6 beirc/receivers.lisp:1.7
--- beirc/receivers.lisp:1.6	Mon Sep 26 12:52:05 2005
+++ beirc/receivers.lisp	Tue Sep 27 22:53:41 2005
@@ -170,6 +170,7 @@
       irc:irc-rpl_whoisuser-message
       irc:irc-rpl_whoischannels-message
       irc:irc-rpl_whoisserver-message
+      irc:irc-rpl_whoisidentified-message
       irc:irc-err_nosuchnick-message))
 
 (macrolet ((define-ignore-message-types (&rest mtypes)