- beirc-cvs@common-lisp.net - mailman3.common-lisp.net

[beirc-cvs] CVS update: beirc/application.lisp beirc/presentations.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 27 Sep '05

27 Sep '05

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)

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/message-display.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv22379 Modified Files: application.lisp message-display.lisp receivers.lisp Log Message: add handling for the "no such nick or channel" message. Date: Mon Sep 26 12:52:05 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.12 beirc/application.lisp:1.13 --- beirc/application.lisp:1.12 Mon Sep 26 11:46:25 2005 +++ beirc/application.lisp Mon Sep 26 12:52:05 2005 @@ -269,6 +269,8 @@ (raise-receiver receiver)) (define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) + (when (eql receiver (server-receiver *application-frame*)) + (error "Can't close the server tab for this application!")) (let* ((connection (current-connection *application-frame*)) (channel (irc:find-channel connection (title receiver)))) (when channel Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.19 beirc/message-display.lisp:1.20 --- beirc/message-display.lisp:1.19 Mon Sep 26 11:46:25 2005 +++ beirc/message-display.lisp Mon Sep 26 12:52:05 2005 @@ -244,10 +244,23 @@ ;;; channel management messages +(defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) + (let* ((target (second (irc:arguments message))) + (close-p (string= (title receiver) + (irc:normalize-nickname (current-connection *application-frame*) + target)))) + (format-message* (format nil "No such nick or channel \"~A\". ~@[To close this tab, click ~]" + target close-p)) + (when close-p + (present `(com-close ,receiver) 'command))))))) + (defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) (format-message* (format nil "Not permitted: ~A" (irc:trailing-argument message))))))) (defun print-topic (receiver message sender channel topic) @@ -267,6 +280,16 @@ (defmethod print-message ((message irc:irc-rpl_topic-message) receiver) (print-topic receiver message nil (second (irc:arguments message)) (irc:trailing-argument message))) + +(defmethod print-message ((message irc:irc-rpl_topicwhotime-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (destructuring-bind (me channel who time) (irc:arguments message) + (declare (ignore me + time ; TODO: no date display for now. + )) + (format-message* (format nil "~A topic set by ~A" channel who))))))) (defmethod print-message ((message irc:irc-rpl_namreply-message) receiver) (formatting-message (t message receiver) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.5 beirc/receivers.lisp:1.6 --- beirc/receivers.lisp:1.5 Mon Sep 26 11:46:25 2005 +++ beirc/receivers.lisp Mon Sep 26 12:52:05 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-rpl_topicwhotime-message irc:irc-err_chanoprivsneeded-message irc:irc-err_nosuchnick-message) + (1 irc:irc-rpl_topic-message irc:irc-rpl_topicwhotime-message irc:irc-err_chanoprivsneeded-message) (2 irc:irc-rpl_namreply-message) (nil irc:irc-join-message))) @@ -169,7 +169,8 @@ (define-current-receiver-message-types irc:irc-rpl_whoisuser-message irc:irc-rpl_whoischannels-message - irc:irc-rpl_whoisserver-message)) + irc:irc-rpl_whoisserver-message + irc:irc-err_nosuchnick-message)) (macrolet ((define-ignore-message-types (&rest mtypes) `(progn

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/message-display.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 26 Sep '05

26 Sep '05

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

1 0

[beirc-cvs] CVS update: beirc/message-display.lisp
by afuchs＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv14580 Modified Files: message-display.lisp Log Message: present the sender nickname in ctcp-action messages as unhighlighted-nickname. Date: Mon Sep 26 11:02:41 2005 Author: afuchs Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.17 beirc/message-display.lisp:1.18 --- beirc/message-display.lisp:1.17 Sun Sep 25 20:19:28 2005 +++ beirc/message-display.lisp Mon Sep 26 11:02:41 2005 @@ -149,7 +149,7 @@ (matter (trailing-argument* message))) (formatting-message (t message receiver) ((format t "*")) - ((present source 'nickname) + ((present source 'unhighlighted-nickname) (format t " ") (format-message* matter :start-length (+ 2 (length source)))))))

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv11537 Modified Files: application.lisp Log Message: replace (read-line ...) with (accept 'mumble ...) in read-frame-command. this makes RET in the middle of the line work! Date: Mon Sep 26 10:28:10 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.10 beirc/application.lisp:1.11 --- beirc/application.lisp:1.10 Sun Sep 25 20:57:25 2005 +++ beirc/application.lisp Mon Sep 26 10:28:10 2005 @@ -524,7 +524,7 @@ (clim:accept 'clim:command :stream stream :prompt nil)) (t - (list 'com-say (read-line stream)))))) + (list 'com-say (accept 'mumble :prompt nil :stream stream)))))) (window-clear stream))) (defmethod read-frame-command :around ((frame beirc)

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/variables.lisp
by mretzlaff＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv20162 Modified Files: application.lisp variables.lisp Log Message: Adds the new variable *default-nick* with the default value "brucio-X" (where X is a random number below 100). The second parameter NICK of COM-CONNECT is now a &KEY parameter, the default being *default-nick*. Date: Sun Sep 25 20:57:25 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.9 beirc/application.lisp:1.10 --- beirc/application.lisp:1.9 Sun Sep 25 20:21:08 2005 +++ beirc/application.lisp Sun Sep 25 20:57:25 2005 @@ -479,7 +479,9 @@ (irc:join (current-connection *application-frame*) channel)) (define-beirc-command (com-connect :name t) - ((server 'string :prompt "Server") (nick 'string :prompt "Nick name")) + ((server 'string :prompt "Server") + &key + (nick 'string :prompt "Nick name" :default *default-nick*)) (cond ((current-connection *application-frame*) (format *query-io* "You are already connected.~%")) (t Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.2 beirc/variables.lisp:1.3 --- beirc/variables.lisp:1.2 Sun Sep 25 14:55:10 2005 +++ beirc/variables.lisp Sun Sep 25 20:57:25 2005 @@ -1,8 +1,9 @@ (in-package :beirc) -(defparameter *hyperspec-base-url* "file://localhost/Users/dmurray/lisp/HyperSpec/") -(defparameter *default-fill-column* 80) -(defparameter *timestamp-column-orientation* :right) +(defvar *hyperspec-base-url* "file://localhost/Users/dmurray/lisp/HyperSpec/") +(defvar *default-fill-column* 80) +(defvar *timestamp-column-orientation* :right) +(defvar *default-nick* (format nil "Brucio-~d" (random 100))) (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") (user-homedir-pathname)))

1 0

[beirc-cvs] CVS update: beirc/receivers.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv20130 Modified Files: receivers.lisp Log Message: fix receiver lookup in the presence of global notices and Chanserv on channels. Date: Sun Sep 25 20:53:54 2005 Author: afuchs Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.3 beirc/receivers.lisp:1.4 --- beirc/receivers.lisp:1.3 Sun Sep 25 20:19:28 2005 +++ beirc/receivers.lisp Sun Sep 25 20:53:53 2005 @@ -70,7 +70,7 @@ (lambda (frame pane) (beirc-app-display frame pane receiver)) :display-time nil - :width 400 :height 600 + :width 600 :height 800 :incremental-redisplay t))) (setf (gethash normalized-name (receivers frame)) receiver) receiver))))) @@ -85,26 +85,30 @@ unless the user has opened a query window to the source already.") -(defun network-service-p (source frame) +(defun from-network-service-p (source frame) (member source *network-service-sources* :test (lambda (source1 source2) (string= (irc:normalize-nickname (current-connection frame) source1) (irc:normalize-nickname (current-connection frame) source2))))) +(defun global-notice-p (message target) + (and (typep message 'irc:irc-notice-message) (string= target "$*"))) + (macrolet ((define-privmsg-receiver-lookup (message-type) `(defmethod receiver-for-message ((message ,message-type) frame) - (if (or - (find-receiver (irc:source message) frame) - (not (network-service-p (irc:source message) frame))) - (let* ((mynick (irc:normalize-nickname (current-connection frame) + (let* ((mynick (irc:normalize-nickname (current-connection frame) (slot-value frame 'nick))) (nominal-target (irc:normalize-channel-name (slot-value frame 'connection) (first (irc:arguments message)))) (target (if (equal nominal-target mynick) (irc:source message) nominal-target))) - (intern-receiver target frame :channel target)) - (server-receiver frame))))) + (if (or (find-receiver (irc:source message) frame) + (not (from-network-service-p (irc:source message) frame)) + (and (string= nominal-target target) + (not (global-notice-p message nominal-target)))) + (intern-receiver target frame :channel target) + (server-receiver frame)))))) (define-privmsg-receiver-lookup irc:irc-privmsg-message) (define-privmsg-receiver-lookup irc:ctcp-action-message) (define-privmsg-receiver-lookup irc:irc-notice-message))

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv17956 Modified Files: application.lisp Log Message: add "unfocus" translator by mgr. Date: Sun Sep 25 20:21:08 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.8 beirc/application.lisp:1.9 --- beirc/application.lisp:1.8 Sun Sep 25 19:58:14 2005 +++ beirc/application.lisp Sun Sep 25 20:21:08 2005 @@ -407,6 +407,15 @@ (object) (list object)) +(define-presentation-to-command-translator nickname-to-unfocus-translator + (nickname com-unfocus beirc + :gesture :menu + :menu t + :documentation "Unfocus this user" + :pointer-documentation "Unfocus this user") + (object) + (list object)) + (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :gesture :menu

1 0

[beirc-cvs] CVS update: beirc/message-display.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv17917 Modified Files: message-display.lisp receivers.lisp Log Message: * handle "you need channel operator status" message right. * fix intern-receiver: should always use the normalized-name Date: Sun Sep 25 20:19:28 2005 Author: afuchs Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.16 beirc/message-display.lisp:1.17 --- beirc/message-display.lisp:1.16 Sun Sep 25 19:55:26 2005 +++ beirc/message-display.lisp Sun Sep 25 20:19:28 2005 @@ -190,6 +190,12 @@ ;;; channel management messages +(defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format-message* (format nil "Not permitted: ~A" (irc:trailing-argument message))))))) + (defun print-topic (receiver message sender channel topic) (formatting-message (t message receiver) ((format t " ")) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.2 beirc/receivers.lisp:1.3 --- beirc/receivers.lisp:1.2 Sun Sep 25 19:51:34 2005 +++ beirc/receivers.lisp Sun Sep 25 20:19:28 2005 @@ -72,7 +72,7 @@ :display-time nil :width 400 :height 600 :incremental-redisplay t))) - (setf (gethash name (receivers frame)) receiver) + (setf (gethash normalized-name (receivers frame)) receiver) receiver))))) (defun remove-receiver (receiver frame) @@ -138,7 +138,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) + (1 irc:irc-rpl_topic-message irc:irc-err_chanoprivsneeded-message) (2 irc:irc-rpl_namreply-message) (nil irc:irc-join-message))) @@ -181,7 +181,11 @@ cl-irc:irc-rpl_endofexceptlist-message cl-irc:irc-ping-message)) + +;;; default receiver. (defmethod receiver-for-message ((message irc:irc-message) frame) + #+or ; comment out to debug on uncaught messages. + (break) (server-receiver frame)) ;; TODO: more receiver-for-message methods.

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv15876 Modified Files: application.lisp Log Message: don't do anything on /say <nothing>. Date: Sun Sep 25 19:58:14 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.7 beirc/application.lisp:1.8 --- beirc/application.lisp:1.7 Sun Sep 25 19:55:26 2005 +++ beirc/application.lisp Sun Sep 25 19:58:14 2005 @@ -367,13 +367,13 @@ (current-channel))) (define-beirc-command (com-say :name t) ((what 'mumble)) - ;; make a fake IRC-PRIV-MESSAGE object - (post-message *application-frame* - (make-fake-irc-message 'irc:irc-privmsg-message - :trailing-argument what - :arguments (list (target)) - :command "PRIVMSG")) - (irc:privmsg (current-connection *application-frame*) (target) what)) + (unless (string= what "") + (post-message *application-frame* + (make-fake-irc-message 'irc:irc-privmsg-message + :trailing-argument what + :arguments (list (target)) + :command "PRIVMSG")) + (irc:privmsg (current-connection *application-frame*) (target) what))) (define-beirc-command (com-nick :name t) ((new-nick 'string :prompt "new nick")) (setf (slot-value *application-frame* 'nick) new-nick) ;This is _not_ the way to do it.

1 0