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

[Andreas Fuchs]

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

Modified Files:
	application.lisp presentations.lisp 
Log Message:
Query for a sarcastic kick message on /kick. Also, fix  completion of incomplete nicknames

Date: Fri Sep 30 15:30:56 2005
Author: afuchs

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.17 beirc/application.lisp:1.18
--- beirc/application.lisp:1.17	Thu Sep 29 16:51:25 2005
+++ beirc/application.lisp	Fri Sep 30 15:30:34 2005
@@ -346,8 +346,8 @@
 (define-beirc-command (com-ban-hostmask :name t) ((who 'hostmask :prompt "hostmask"))
   (irc:ban (current-connection *application-frame*) (target) who))
 
-(define-beirc-command (com-kick :name t) ((who 'nickname :prompt "who"))
-  (irc:kick (current-connection *application-frame*) (target) who))
+(define-beirc-command (com-kick :name t) ((who 'nickname :prompt "who") (reason 'mumble :prompt "reason"))
+  (irc:kick (current-connection *application-frame*) (target) who reason))
 
 (define-beirc-command (com-names :name t) ()
   (irc:names (current-connection *application-frame*) (target)))
@@ -440,7 +440,11 @@
               :documentation "Kick this user"
               :pointer-documentation "Kick this user")
     (object)
-  (list object))
+  (list object
+        ;; XXX: not the best way to do it. McCLIM should recognize
+        ;; that this is a partial command and query for the rest of
+        ;; the args itself.
+        (accept 'mumble :prompt " Reason")))
 
 (define-presentation-to-command-translator nickname-to-ban-nick-translator
     (nickname com-ban-nick beirc


Index: beirc/presentations.lisp
diff -u beirc/presentations.lisp:1.5 beirc/presentations.lisp:1.6
--- beirc/presentations.lisp:1.5	Wed Sep 28 21:33:28 2005
+++ beirc/presentations.lisp	Fri Sep 30 15:30:36 2005
@@ -27,10 +27,11 @@
 
 (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 " "))))
+    (labels ((prefixify (word &optional (success t))
+               (concatenate 'string prefix word
+                            (cond ((not success) "")
+                                  ((zerop (length prefix)) ": ")
+                                  (t " ")))))
       (multiple-value-bind (string success object nmatches possibilities)
           (complete-from-possibilities word
                                        (let ((channel (and
@@ -38,15 +39,16 @@
                                                        (irc:find-channel
                                                         (current-connection *application-frame*)
                                                         (current-channel)))))
-                                        (if (not (null channel))
-                                            (hash-alist (irc:users channel))
-                                            nil))
+                                         (if (not (null channel))
+                                             (hash-alist (irc:users channel))
+                                             nil))
                                        '()
                                        :action mode
                                        :value-key #'cdr)
-        (values (prefixify (if (null object)
+        (values (prefixify (if (not success)
                                string
-                               (irc:nickname object)))
+                               (irc:nickname object))
+                           success)
                 success object nmatches (mapcar (lambda (possibility)
                                                   (cons (prefixify (car possibility))
                                                         (cdr possibility)))