[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Thu Mar 2 21:46:49 UTC 2006
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
More information about the Beirc-cvs
mailing list