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

Modified Files: application.lisp message-display.lisp receivers.lisp Log Message: add a /whois command, nick translator, display methods, and a channel->join translator.

Date: Mon Sep 26 11:46:25 2005 Author: afuchs

Index: beirc/application.lisp diff -u beirc/application.lisp:1.11 beirc/application.lisp:1.12 --- beirc/application.lisp:1.11 Mon Sep 26 10:28:10 2005 +++ beirc/application.lisp Mon Sep 26 11:46:25 2005 @@ -297,6 +297,9 @@ (remove who (current-focused-nicks) :test #'string=)) (redraw-receiver (current-receiver *application-frame*)))

+(define-beirc-command (com-whois :name t) ((who 'nickname :prompt "who")) + (irc:whois (current-connection *application-frame*) who)) + (define-beirc-command (com-eval :name t) ((command 'string :prompt "command") (args '(sequence string) :prompt "arguments")) (multiple-value-bind (symbol status) (find-symbol (string-upcase command) :irc) @@ -449,6 +452,24 @@ :menu t :documentation "Ban this user's hostmask" :pointer-documentation "Ban this user's hostmask") + (object) + (list object)) + +(define-presentation-to-command-translator nickname-to-whois-translator + (nickname com-whois beirc + :gesture :select + :menu t + :documentation "Perform WHOIS query on user" + :pointer-documentation "Perform WHOIS query on user") + (object) + (list object)) + +(define-presentation-to-command-translator channel-to-join-translator + (channel com-join beirc + :gesture :describe + :menu t + :documentation "Join this channel" + :pointer-documentation "Join this channel") (object) (list object))

Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.18 beirc/message-display.lisp:1.19 --- beirc/message-display.lisp:1.18 Mon Sep 26 11:02:41 2005 +++ beirc/message-display.lisp Mon Sep 26 11:46:25 2005 @@ -112,6 +112,7 @@ (and (current-connection *application-frame*) (irc:find-user (current-connection *application-frame*) word%))) (present word% 'nickname)) + ((channelp word%) (present word% 'channel)) (t (write-string word%))) (write-string stripped-punctuation))) ;; TODO: more highlighting @@ -153,6 +154,15 @@ (format t " ") (format-message* matter :start-length (+ 2 (length source)))))))

+(defmethod print-message ((message irc:ctcp-version-message) receiver) + (let ((source (cl-irc:source message))) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present source 'unhighlighted-nickname) + (format t " ") + (format-message* "asked for your IRC client version" :start-length (+ 2 (length source)))))))) + ;;; server messages

(defmethod print-message ((message irc:irc-rpl_motd-message) receiver) @@ -165,7 +175,7 @@ (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) - (format t "args: ~A :~A" (irc:arguments message) (irc:trailing-argument message)))))) + (format t "~A ~A :~A" (irc:command message) (irc:arguments message) (irc:trailing-argument message))))))

;;; user-related messages

@@ -187,6 +197,50 @@ (present (irc:source message) 'nickname) (format t " (~A@~A) is now known as " (irc:user message) (irc:host message)) (present (irc:trailing-argument message) 'nickname))))) + +(defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (destructuring-bind (me nickname user host &rest args) (irc:arguments message) + (declare (ignore me args)) + (present nickname 'nickname) + (format t " is (~A@~A) (~A)" user host (irc:trailing-argument message))))))) + +(defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (second (irc:arguments message)) 'nickname) + (format-message* (format nil " is in ~A" (irc:trailing-argument message)) + :start-length (length (second (irc:arguments message)))))))) + +(defmethod print-message ((message irc:irc-rpl_whoisserver-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (second (irc:arguments message)) 'nickname) + (format-message* (format nil " is on ~A: ~A" + (third (irc:arguments message)) + (irc:trailing-argument message)) + :start-length (length (second (irc:arguments message)))))))) + +(defmethod print-message ((message irc:irc-rpl_away-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (second (irc:arguments message)) 'nickname) + (format-message* (format nil "is away: ~A" (irc:trailing-argument message)) + :start-length (length (second (irc:arguments message)))))))) + +(defmethod print-message ((message irc:irc-rpl_whoisidentified-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (second (irc:arguments message)) 'nickname) + (write-char #\Space) + (format-message* (irc:trailing-argument message) + :start-length (length (second (irc:arguments message))))))))

;;; channel management messages

Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.4 beirc/receivers.lisp:1.5 --- beirc/receivers.lisp:1.4 Sun Sep 25 20:53:53 2005 +++ beirc/receivers.lisp Mon Sep 26 11:46:25 2005 @@ -142,7 +142,7 @@ (intern-receiver target frame :channel target)))))))) (define-nth-arg-message-receiver-lookup (0 irc:irc-topic-message irc:irc-kick-message) - (1 irc:irc-rpl_topic-message irc:irc-err_chanoprivsneeded-message) + (1 irc:irc-rpl_topic-message irc:irc-rpl_topicwhotime-message irc:irc-err_chanoprivsneeded-message irc:irc-err_nosuchnick-message) (2 irc:irc-rpl_namreply-message) (nil irc:irc-join-message)))

@@ -160,6 +160,16 @@ (3 (destructuring-bind (channel modes args) (irc:arguments message) (declare (ignore modes args)) (intern-receiver channel frame :channel channel))))) + +(macrolet ((define-current-receiver-message-types (&rest mtypes) + `(progn + ,@(loop for mtype in mtypes + collect `(defmethod receiver-for-message ((message ,mtype) frame) + (current-receiver frame)))))) + (define-current-receiver-message-types + irc:irc-rpl_whoisuser-message + irc:irc-rpl_whoischannels-message + irc:irc-rpl_whoisserver-message))

(macrolet ((define-ignore-message-types (&rest mtypes) `(progn