Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv21025

Modified Files: message-display.lisp message-processing.lisp receivers.lisp Log Message: Smarter handling of open queries for nick and quit messages.

* Quit and Nick messages are now posted to queries with the quitting/nick-changing person, if they are open. * Offer to close a query tab if the user quit. * Also, rename open query tabs when a nick message is received.

--- /project/beirc/cvsroot/beirc/message-display.lisp 2006/02/26 18:41:21 1.37 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/02 21:46:49 1.38 @@ -234,14 +234,17 @@

(defmethod print-message ((message irc:irc-quit-message) receiver) (irc:destructuring-arguments (&optional body) message - (formatting-message (t message receiver) - ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (format t "Quit: ") - (present (irc:source message) 'nickname) - (unless (null body) - (format t ": ") - (format-message* body :start-length (+ 8 (length (irc:source message)))))))))) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format t "Quit: ") + (present (irc:source message) 'nickname) + (unless (null body) + (format t ": ") + (format-message* body :start-length (+ 8 (length (irc:source message)))) + (when (string= (title receiver) + (irc:normalize-nickname (connection receiver) (irc:source message))) + (offer-close receiver))))))))

(defun present-as-hostmask (user host) (write-char #() @@ -313,19 +316,21 @@

;;; channel management messages

+(defun offer-close (receiver) + (format-message* (format nil "To close this tab, click ")) + (present `(com-close ,receiver) 'command)) + (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) (irc:destructuring-arguments (me target &rest rest) message (declare (ignore me rest)) - (let* ((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)))))))) + (format-message* (format nil "No such nick or channel "~A". " + target)) + (when (string= (title receiver) + (irc:normalize-nickname (connection receiver) target)) + (offer-close receiver)))))))

(defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) (irc:destructuring-arguments (&last body) message --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/02/26 18:42:43 1.2 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/02 21:46:49 1.3 @@ -30,15 +30,25 @@ ;;; Message preprocessing

(defmethod preprocess-message ((connection beirc-connection) (message irc:irc-nick-message)) - "Change the connection's local user's nickname if it is the -local user that changed its nickname." - (when (string= (irc:normalize-nickname connection (current-nickname)) - (irc:normalize-nickname connection (irc:source message))) - (setf (irc:nickname (irc:user (irc:connection message))) - (car (last (irc:arguments message))) + "Handle various Nickname-change message cases: + + * change the connection's local user's nickname if it is the + local user that changed its nickname. + * rename queries that are open so that the nickname message gets + posted there, too." + (let ((receiver (find-receiver (irc:normalize-nickname connection (irc:source message)) + connection *application-frame*))) + (cond + ;; we changed our nick + ((string= (irc:normalize-nickname connection (current-nickname)) + (irc:normalize-nickname connection (irc:source message))) + (setf (irc:nickname (irc:user (irc:connection message))) + (car (last (irc:arguments message)))

- (irc:normalized-nickname (irc:user (irc:connection message))) - (irc:normalize-nickname connection (car (last (irc:arguments message))))))) + (irc:normalized-nickname (irc:user (irc:connection message))) + (irc:normalize-nickname connection (car (last (irc:arguments message)))))) + (receiver + (rename-query-receiver receiver (car (last (irc:arguments message))))))))

(defmethod preprocess-message (connection message) nil) --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/02/25 23:28:11 1.19 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/03/02 21:46:49 1.20 @@ -60,6 +60,19 @@ (change-space-requirements pane))) (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver))

+(defun rename-query-receiver (receiver new-name) + (let ((old-title (irc:normalize-nickname (connection receiver) + (title receiver))) + (normalized-name (irc:normalize-nickname (connection receiver) + new-name))) + (with-slots (title query) receiver + (setf title new-name + query new-name + (tab-layout::tab-pane-title (tab-pane receiver)) new-name) + (remhash (list (connection receiver) old-title) (receivers *application-frame*)) + (setf (gethash (list (connection receiver) normalized-name) (receivers *application-frame*)) + receiver)))) + (defun find-receiver (name connection frame) (gethash (list connection (irc:normalize-channel-name connection name)) (receivers frame))) @@ -138,13 +151,20 @@ `(defmethod receiver-for-message ((message ,message-type) frame) (remove nil (mapcar (lambda (channel) - (find-receiver (irc:name channel) (irc:connection message) frame)) - (let ((user (irc:find-user (current-connection frame) + (find-receiver channel (irc:connection message) frame)) + (let ((user (irc:find-user (irc:connection message) (irc:source message)))) (when user - (irc:channels user)))))))) - (define-global-message-receiver-lookup irc:irc-quit-message) - (define-global-message-receiver-lookup irc:irc-nick-message)) + `(,@(mapcar (lambda (chan) + (irc:normalize-channel-name (irc:connection message) + (irc:name chan))) + (irc:channels user)) + ,(irc:normalize-nickname (irc:connection message) + (if (typep message 'irc:irc-quit-message) + (irc:source message) + (car (last (irc:arguments message))))))))))))) + (define-global-message-receiver-lookup irc:irc-quit-message) + (define-global-message-receiver-lookup irc:irc-nick-message))

(macrolet ((define-nth-arg-message-receiver-lookup (&rest clauses) "Defines receiver-for-message methods that return