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)