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

[beirc-cvs] CVS update: beirc/receivers.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv17920 Modified Files: receivers.lisp Log Message: Modifies the switch-to-pane :AFTER method of beirc so that it doesn't make the tab-layout unusable for other programs in the same image. It tests first whether the tab-layout-pane is actually the pane of the current beirc *application-frame*. It's a bit unpleasant that this method will be called for *all* tab-layout-panes in the same image, perhaps there will be a way to hook such things into the tab-layout-pane by means of the WITH-TAB-LAYOUT form. (This patch is actually 8 days old, see http://paste.lisp.org/display/11924 .) Date: Sun Oct 2 06:18:25 2005 Author: mretzlaff Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.9 beirc/receivers.lisp:1.10 --- beirc/receivers.lisp:1.9 Fri Sep 30 15:46:18 2005 +++ beirc/receivers.lisp Sun Oct 2 06:18:24 2005 @@ -239,12 +239,16 @@ (t +black+))))) (defmethod switch-to-pane :after ((pane sheet) (parent (eql 'tab-layout-pane))) - (let ((receiver (receiver-from-tab-pane - (find-in-tab-panes-list pane 'tab-layout-pane)))) - (unless (null receiver) - (setf (unseen-messages receiver) 0) - (setf (messages-directed-to-me receiver) 0) - (update-drawing-options receiver)))) + (let ((my-tab-layout-pane (find-pane-named *application-frame* 'query))) + (when (eq (sheet-parent (sheet-parent pane)) ;; Is this the desired tab-layout? + my-tab-layout-pane) + + (let ((receiver (receiver-from-tab-pane + (find-in-tab-panes-list pane my-tab-layout-pane)))) + (unless (null receiver) + (setf (unseen-messages receiver) 0) + (setf (messages-directed-to-me receiver) 0) + (update-drawing-options receiver)))))) (defun raise-receiver (receiver) (setf (unseen-messages receiver) 0)

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv16500 Modified Files: application.lisp Log Message: Adds a receiver-pane-to-channel-translator presentation translator. (Useful for rejoining channels for which tab-panes are already existing.) Date: Sun Oct 2 06:01:32 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.18 beirc/application.lisp:1.19 --- beirc/application.lisp:1.18 Fri Sep 30 15:30:34 2005 +++ beirc/application.lisp Sun Oct 2 06:01:25 2005 @@ -497,6 +497,16 @@ (receiver-from-tab-pane (find-in-tab-panes-list object 'tab-layout-pane))) +(define-presentation-translator receiver-pane-to-channel-translator + (receiver-pane channel beirc + :documentation ((object stream) + (format stream "Channel: ~A" + (channel (receiver-from-tab-pane + (find-in-tab-panes-list object 'tab-layout-pane)))))) + (object) + (channel (receiver-from-tab-pane + (find-in-tab-panes-list object 'tab-layout-pane)))) + (define-presentation-translator nickname-to-hostmask-translator (nickname hostmask beirc :tester ((object context-type)

1 0

[beirc-cvs] CVS update: beirc/presentations.lisp
by afuchs＠common-lisp.net 01 Oct '05

01 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv9128 Modified Files: presentations.lisp Log Message: add a few more checks for channel-name-ness, inspired by rfcs 2811 and 2813 Date: Sat Oct 1 20:18:50 2005 Author: afuchs Index: beirc/presentations.lisp diff -u beirc/presentations.lisp:1.6 beirc/presentations.lisp:1.7 --- beirc/presentations.lisp:1.6 Fri Sep 30 15:30:36 2005 +++ beirc/presentations.lisp Sat Oct 1 20:18:50 2005 @@ -116,7 +116,18 @@ (defun channelp (channel) (and (stringp channel) (> (length channel) 2) - (not (null (member (char channel 0) '(#\# #\+ #\! #\&)))))) + (< (length channel) 50) + (member (char channel 0) '(#\# #\+ #\! #\&)) + (not (find-if (lambda (c) + (member c `(#\Space + #\, ,(code-char 7) + ;; XXX: #\: is used to separate the + ;; channel name from the channel + ;; mask, and so isn't a part of the + ;; channel name. see rfc2811 for + ;; details. + #\:))) + channel)))) (define-presentation-method accept ((type channel) *standard-input* (view textual-view) &key) (let ((channel (accept 'string :view view :prompt nil)))

1 0