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

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

07 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv21581 Modified Files: application.lisp Log Message: Adds COM-LOAD to load lisp files from within beirc. For example to load a CL-IRC hook like http://bl0rg.net/~mgr/flux/bl0rg-hook.lisp (or slightly more useful things). Date: Fri Oct 7 02:59:58 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.33 beirc/application.lisp:1.34 --- beirc/application.lisp:1.33 Fri Oct 7 02:03:15 2005 +++ beirc/application.lisp Fri Oct 7 02:59:58 2005 @@ -371,6 +371,17 @@ (when (eql status :external) (apply symbol (current-connection *application-frame*) (coerce args 'list))))) +(define-beirc-command (com-load :name t) + ((pathname 'pathname :prompt "pathname") + &key + (remove-type-if-is-lisp-p 'boolean :default t)) + (when (probe-file pathname) + (load (if (and remove-type-if-is-lisp-p + (string-equal (pathname-type pathname) + "lisp")) + (make-pathname :type nil :defaults pathname) + pathname)))) + (defun make-fake-irc-message (message-type &key command arguments (source (slot-value *application-frame* 'nick)) trailing-argument)

1 0

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

07 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv18334 Modified Files: application.lisp Log Message: SEND-PRIVATE-MESSAGE is changed to do the same as the code in COM-SAY (that is, the test (unless (or (string= what "") (null target)) has been added). Therfore also: The whole body of COM-SAY is now (com-msg (target) what). The presentation-type of the parameter TARGET of COM-MSG has been changed from 'nickname to '(OR nickname channel). (Minor code reorganisation: SEND-PRIVATE-MESSAGE, COM-MSG, and COM-ME are moved from the end of the application.lisp to the place where COM-SAY is defined.) Date: Fri Oct 7 02:03:16 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.32 beirc/application.lisp:1.33 --- beirc/application.lisp:1.32 Wed Oct 5 15:21:36 2005 +++ beirc/application.lisp Fri Oct 7 02:03:15 2005 @@ -443,14 +443,35 @@ (or (current-query) (current-channel))) -(define-beirc-command (com-say :name t) ((what 'mumble)) - (unless (or (string= what "") (null (target))) +(defun send-private-message (target what) + (unless (or (string= what "") + (null target)) (post-message *application-frame* (make-fake-irc-message 'irc:irc-privmsg-message :trailing-argument what - :arguments (list (target)) + :arguments (list target) :command "PRIVMSG")) - (irc:privmsg (current-connection *application-frame*) (target) what))) + (irc:privmsg (current-connection *application-frame*) target what))) + +(define-beirc-command (com-msg :name t) + ((target '(OR nickname channel) :prompt "who") + (what 'mumble :prompt "what")) + (send-private-message target what)) + +(define-beirc-command (com-say :name t) + ((what 'mumble)) + (com-msg (target) what)) + +(define-beirc-command (com-me :name t) ((what 'mumble :prompt nil)) + (with-slots (connection) *application-frame* + (let ((m (make-fake-irc-message 'irc:ctcp-action-message + :trailing-argument + (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)) + :arguments (list (target)) + :command "PRIVMSG"))) ;### + (post-message *application-frame* m) + (irc:privmsg connection (target) + (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)))))) (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. @@ -774,30 +795,3 @@ (defmethod allocate-space :after ((pane climi::viewport-pane) w h) (let ((pane (first (sheet-children pane)))) (redisplay-frame-pane (pane-frame pane) pane))) - -;;;;;; - -(define-beirc-command (com-me :name t) ((what 'mumble :prompt nil)) - (with-slots (connection) *application-frame* - (let ((m (make-fake-irc-message 'irc:ctcp-action-message - :trailing-argument - (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)) - :arguments (list (target)) - :command "PRIVMSG"))) ;### - (post-message *application-frame* m) - (irc:privmsg connection (target) - (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)))))) - -(defun send-private-message (target 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-msg :name t) - ((target 'nickname :prompt "who") (what 'mumble :prompt "what")) - (warn "~S ~S" target what) - (send-private-message target what) ) -

1 0

[beirc-cvs] CVS update: beirc/message-display.lisp
by mretzlaff＠common-lisp.net 06 Oct '05

06 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv16261 Modified Files: message-display.lisp Log Message: The nickname in method print-message ((message irc:irc-part-message) receiver) will now be presented as such (by calling FORMAT-MESSAGE*). Date: Fri Oct 7 01:35:20 2005 Author: mretzlaff Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.25 beirc/message-display.lisp:1.26 --- beirc/message-display.lisp:1.25 Wed Oct 5 15:26:04 2005 +++ beirc/message-display.lisp Fri Oct 7 01:35:20 2005 @@ -175,7 +175,9 @@ (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) - (format t "~A ~A :~A" (irc:command message) (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 @@ -306,7 +308,7 @@ ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format-message* (format nil "~A Names: ~A" (third (irc:arguments message)) - (irc:trailing-argument message))))))) + (irc:trailing-argument message))))))) (defmethod print-message ((message irc:irc-part-message) receiver) (formatting-message (t message receiver) @@ -314,7 +316,8 @@ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Part: ") (present (irc:source message) 'nickname) - (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message)))))) + (format-message* (format nil " left ~A: ~A" (first (irc:arguments message)) + (irc:trailing-argument message))))))) (defmethod print-message ((message irc:irc-join-message) receiver) (formatting-message (t message receiver)

1 0

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

05 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv1717 Modified Files: message-display.lisp Log Message: Changes the :MIN-WIDTH of the nickname column from '(16 :character) to '(3 :character) in order to waste less space. Seems to work like a charm (though I haven't had a look at FORMATTING-CELL or FORMATTING-ROW)... Date: Wed Oct 5 15:26:04 2005 Author: mretzlaff Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.24 beirc/message-display.lisp:1.25 --- beirc/message-display.lisp:1.24 Mon Oct 3 01:52:32 2005 +++ beirc/message-display.lisp Wed Oct 5 15:26:04 2005 @@ -55,7 +55,7 @@ :cache-test #'equal) (formatting-row (stream*) (output-timestamp-column :left) - (formatting-cell (stream* :align-x :right :min-width '(16 :character)) + (formatting-cell (stream* :align-x :right :min-width '(3 :character)) (with-drawing-options (stream* :ink +dark-red+) (funcall preamble-writer))) (formatting-cell (stream* :align-x :left

1 0

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

05 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv1689 Modified Files: application.lisp Log Message: Beirc's prompt is now surrounded by a :DROP-SHADOW box (and the "text-modish" " => " will not be printed anymore). Date: Wed Oct 5 15:21:36 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.31 beirc/application.lisp:1.32 --- beirc/application.lisp:1.31 Wed Oct 5 05:39:14 2005 +++ beirc/application.lisp Wed Oct 5 15:21:36 2005 @@ -106,7 +106,8 @@ (vertically () (with-tab-layout ('receiver-pane :name 'query) ("*Server*" server 'receiver-pane)) - (68 io) + ;; (68 io) ;; no drop-shadow prompt + (72 io) (20 pointer-doc) (20 ;<-- Sigh! Bitrot! status-bar))))) @@ -136,13 +137,16 @@ (length (current-messages)))))) (defun beirc-prompt (*standard-output* *application-frame*) - (write-string "Beirc" *standard-output*) - (let ((receiver (current-receiver *application-frame*))) - (when receiver - (write-string " " *standard-output*) - (with-output-as-presentation (*standard-output* receiver 'receiver) - (write-string (title receiver) *standard-output*)))) - (write-string " => " *standard-output*)) + (stream-increment-cursor-position *standard-output* 3 4) + (surrounding-output-with-border (*standard-output* :shape :drop-shadow :move-cursor nil) + (write-string "Beirc" *standard-output*) + (let ((receiver (current-receiver *application-frame*))) + (when receiver + (write-string " " *standard-output*) + (with-output-as-presentation (*standard-output* receiver 'receiver) + (write-string (title receiver) *standard-output*))))) + (stream-increment-cursor-position *standard-output* 10 0) + #+nil (write-string " => " *standard-output*)) ;; (defun format-message (prefix mumble) ;; (write-line

1 0

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

05 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv635 Modified Files: receivers.lisp Log Message: The method PRINT-OBJECT ((receiver receiver) stream) is changed: As we have the needed accept-methods for the presentation-type RECEIVER, we can just write the receiver's title (if it is available). Date: Wed Oct 5 15:08:30 2005 Author: mretzlaff Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.11 beirc/receivers.lisp:1.12 --- beirc/receivers.lisp:1.11 Mon Oct 3 01:47:51 2005 +++ beirc/receivers.lisp Wed Oct 5 15:08:29 2005 @@ -16,10 +16,14 @@ (slot-value object slot) something)) +;;; (defmethod print-object ((receiver receiver) stream) +;;; (print-unreadable-object (receiver stream :type t) +;;; (write-string (slot-value-or-something receiver :slot 'title :something "without title") +;;; stream))) +;;; We have the needed accept-methods for the presentation-type receiver, so we can just write: (defmethod print-object ((receiver receiver) stream) - (print-unreadable-object (receiver stream :type t) - (write-string (slot-value-or-something receiver :slot 'title :something "without title") - stream))) + (write-string (slot-value-or-something receiver :slot 'title :something "#<RECEIVER without title>") + stream)) (define-presentation-type receiver-pane ())

1 0

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

05 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv24914 Modified Files: application.lisp Log Message: Beirc's prompt is changed: After the the word "Beirc" now the current receiver's title is shown, and it will be presented as the current receiver (with the presentation-type RECEIVER). The presentation-translator RECEIVER-TO-CHANNEL-TRANSLATOR is added (with :tester and :documentation). A :tester is added to RECEIVER-PANE-TO-CHANNEL-TRANSLATOR. (Sadly, CLIM's presentation-translators seem not to be transitive, otherwise we could get rid of this presentation-translator.) Date: Wed Oct 5 05:39:14 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.30 beirc/application.lisp:1.31 --- beirc/application.lisp:1.30 Mon Oct 3 01:47:51 2005 +++ beirc/application.lisp Wed Oct 5 05:39:14 2005 @@ -136,9 +136,13 @@ (length (current-messages)))))) (defun beirc-prompt (*standard-output* *application-frame*) - (format *standard-output* "Beirc ~A => " - (or (current-query) - (current-channel)))) + (write-string "Beirc" *standard-output*) + (let ((receiver (current-receiver *application-frame*))) + (when receiver + (write-string " " *standard-output*) + (with-output-as-presentation (*standard-output* receiver 'receiver) + (write-string (title receiver) *standard-output*)))) + (write-string " => " *standard-output*)) ;; (defun format-message (prefix mumble) ;; (write-line @@ -599,10 +603,23 @@ :documentation ((object stream) (format stream "Channel: ~A" (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane)))))) + (find-in-tab-panes-list object 'tab-layout-pane))))) + :tester ((object) + (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 receiver-to-channel-translator + (receiver channel beirc + :documentation ((object stream) + (format stream "Channel: ~A" + (channel object))) + :tester ((object) + (channel object))) + (object) + (channel object)) (define-presentation-translator nickname-to-hostmask-translator (nickname hostmask beirc

1 0

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

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv3034 Modified Files: message-display.lisp Log Message: while I'm at it, refactor hostmask presenting into present-as-hostmask. Date: Mon Oct 3 01:52:32 2005 Author: afuchs Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.23 beirc/message-display.lisp:1.24 --- beirc/message-display.lisp:1.23 Mon Oct 3 01:48:45 2005 +++ beirc/message-display.lisp Mon Oct 3 01:52:32 2005 @@ -189,16 +189,21 @@ (format-message* (irc:trailing-argument message) :start-length (+ 8 (length (irc:source message)))))))) +(defun present-as-hostmask (user host) + (write-char #\() + (with-output-as-presentation (t (format nil "*!*@~A" host) 'hostmask) + (format t "~A@~A" user host)) + (write-char #\))) + (defmethod print-message ((message irc:irc-nick-message) receiver) (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Nick change: ") (present (irc:source message) 'nickname) - (write-string " (") - (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) 'hostmask) - (format t "~A@~A" (irc:user message) (irc:host message))) - (write-string ") is now known as ") + (write-string " ") + (present-as-hostmask (irc:user message) (irc:host message)) + (write-string " is now known as ") (present (irc:trailing-argument message) 'nickname))))) (defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver) @@ -208,10 +213,9 @@ (destructuring-bind (me nickname user host &rest args) (irc:arguments message) (declare (ignore me args)) (present nickname 'nickname) - (format t " is (") - (with-output-as-presentation (t (format nil "*!*@~A" host) 'hostmask) - (format t "~A@~A" user host)) - (format t ") (~A)" (irc:trailing-argument message))))))) + (format t " is ") + (present-as-hostmask user host) + (format t " (~A)" (irc:trailing-argument message))))))) (defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) (formatting-message (t message receiver) @@ -319,9 +323,7 @@ (format t "Join: ") (present (irc:source message) 'nickname) (write-char #\Space) - (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) - 'hostmask) - (format t "(~A@~A)" (irc:user message) (irc:host message))))))) + (present-as-hostmask (irc:user message) (irc:host message)))))) (defmethod print-message ((message irc:irc-kick-message) receiver) (formatting-message (t message receiver)

1 0

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

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv3010 Modified Files: message-display.lisp Log Message: add a missing closing paren in a string. it's late (-: Date: Mon Oct 3 01:48:45 2005 Author: afuchs Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.22 beirc/message-display.lisp:1.23 --- beirc/message-display.lisp:1.22 Mon Oct 3 01:47:51 2005 +++ beirc/message-display.lisp Mon Oct 3 01:48:45 2005 @@ -198,7 +198,7 @@ (write-string " (") (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) 'hostmask) (format t "~A@~A" (irc:user message) (irc:host message))) - (write-string " is now known as ") + (write-string ") is now known as ") (present (irc:trailing-argument message) 'nickname))))) (defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver)

1 0

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

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv2022 Modified Files: application.lisp message-display.lisp receivers.lisp variables.lisp Log Message: Add various hostmask and mode change related features: * every display method that shows a user@host combination now presents them as 'hostmask, with associated object *!*@<host> * add a mode message destructuring mechanism that knows about hostmasks, numbers and nicknames and presents them nicely. * add an unban hostmask command & hostmask-to-*-translator. Date: Mon Oct 3 01:47:51 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.29 beirc/application.lisp:1.30 --- beirc/application.lisp:1.29 Mon Oct 3 00:40:54 2005 +++ beirc/application.lisp Mon Oct 3 01:47:51 2005 @@ -401,6 +401,12 @@ (define-beirc-command (com-ban-hostmask :name t) ((who 'hostmask :prompt "hostmask")) (irc:ban (current-connection *application-frame*) (target) who)) +(define-beirc-command (com-unban-hostmask :name t) ((who 'hostmask :prompt "hostmask")) + (irc:unban (current-connection *application-frame*) (target) who)) + +(define-beirc-command (com-unban-nick :name t) ((who 'nickname :prompt "who")) + (irc:unban (current-connection *application-frame*) (target) (format nil "~A!*@*" who))) + (define-beirc-command (com-kick :name t) ((who 'nickname :prompt "who") (reason 'mumble :prompt "reason")) (irc:kick (current-connection *application-frame*) (target) who reason)) @@ -525,6 +531,24 @@ :menu t :documentation "Ban this user's nickname" :pointer-documentation "Ban this user's nickname") + (object) + (list object)) + +(define-presentation-to-command-translator hostmask-to-ban-translator + (hostmask com-ban-hostmask beirc + :gesture :menu + :menu t + :documentation "Ban this hostmask" + :pointer-documentation "Ban this hostmask") + (object) + (list object)) + +(define-presentation-to-command-translator hostmask-to-unban-translator + (hostmask com-unban-hostmask beirc + :gesture :menu + :menu t + :documentation "Unban this hostmask" + :pointer-documentation "Unban this hostmask") (object) (list object)) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.21 beirc/message-display.lisp:1.22 --- beirc/message-display.lisp:1.21 Wed Sep 28 21:33:28 2005 +++ beirc/message-display.lisp Mon Oct 3 01:47:51 2005 @@ -195,7 +195,10 @@ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Nick change: ") (present (irc:source message) 'nickname) - (format t " (~A@~A) is now known as " (irc:user message) (irc:host message)) + (write-string " (") + (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) 'hostmask) + (format t "~A@~A" (irc:user message) (irc:host message))) + (write-string " is now known as ") (present (irc:trailing-argument message) 'nickname))))) (defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver) @@ -205,7 +208,10 @@ (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))))))) + (format t " is (") + (with-output-as-presentation (t (format nil "*!*@~A" host) 'hostmask) + (format t "~A@~A" user host)) + (format t ") (~A)" (irc:trailing-argument message))))))) (defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) (formatting-message (t message receiver) @@ -312,7 +318,10 @@ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Join: ") (present (irc:source message) 'nickname) - (format t " (~A@~A)" (irc:user message) (irc:host message)))))) + (write-char #\Space) + (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) + 'hostmask) + (format t "(~A@~A)" (irc:user message) (irc:host message))))))) (defmethod print-message ((message irc:irc-kick-message) receiver) (formatting-message (t message receiver) @@ -325,21 +334,59 @@ :start-length (+ 9 (length (second (irc:arguments message))) (length (irc:source message)))))))) +;;; XXX: uses unexported symbols from cl-irc, but I think their +;;; unexportedness is accidental. +(defun mode-symbol-to-char (target mode) + (irc::mode-desc-char + (irc::mode-description (current-connection *application-frame*) + target mode))) + +(defmethod print-mode-change (target op mode (user irc:user)) + (format t "~A~A:" op (mode-symbol-to-char target mode)) + (present (irc:nickname user) 'nickname)) + +(defmethod print-mode-change (target op (mode (eql :limit)) arg) + (format t "~A~A" op (mode-symbol-to-char target mode)) + (when (not (null arg)) + (write-char #\:) + (present arg 'number))) + +(macrolet ((define-mode-change-with-hostmask-printer (&rest modes) + `(progn + ,@(loop for mode in modes + collect `(defmethod print-mode-change (target op (mode (eql ,mode)) mask) + (format t "~A~A:" op (mode-symbol-to-char target mode)) + (present mask 'hostmask)))))) + (define-mode-change-with-hostmask-printer :ban :invite :except)) + +(defmethod print-mode-change (target op mode (arg (eql nil))) + (format t "~A~A" op (mode-symbol-to-char target mode))) + (defmethod print-message ((message irc:irc-mode-message) receiver) (case (length (irc:arguments message)) (1 (formatting-message (t message receiver) - ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (format-message* (format nil "~A set mode ~A ~A" (irc:source message) - (irc:trailing-argument message) - (first (irc:arguments message)))))))) - (3 (destructuring-bind (target modes args) (irc:arguments message) - (declare (ignore target)) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format-message* (format nil "~A set mode ~A ~A" (irc:source message) + (irc:trailing-argument message) + (first (irc:arguments message)))))))) + (t + (destructuring-bind (target &rest args) (irc:arguments message) + (let* ((connection (current-connection *application-frame*)) + (target (or (irc:find-user connection target) + (irc:find-channel connection target))) + (mode-changes (irc:parse-mode-arguments connection target args + :server-p (irc:user connection)))) (formatting-message (t message receiver) - ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (present (irc:source message) 'nickname) - (format-message* (format nil " set mode ~A ~A" modes args))))))))) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (irc:source message) 'nickname) + (write-string " changes channel mode: ") + (loop for (change . rest) on mode-changes + do (destructuring-bind (op mode &optional arg) change + (print-mode-change target op mode arg)) + if (not (null rest)) + do (write-string ", ")))))))))) ;;; the display function (& utilities) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.10 beirc/receivers.lisp:1.11 --- beirc/receivers.lisp:1.10 Sun Oct 2 06:18:24 2005 +++ beirc/receivers.lisp Mon Oct 3 01:47:51 2005 @@ -168,7 +168,7 @@ (defmethod receiver-for-message ((message irc:irc-mode-message) frame) (case (length (irc:arguments message)) (1 (server-receiver frame)) - (3 (destructuring-bind (channel modes args) (irc:arguments message) + (t (destructuring-bind (channel modes &rest args) (irc:arguments message) (declare (ignore modes args)) (intern-receiver channel frame :channel channel))))) Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.7 beirc/variables.lisp:1.8 --- beirc/variables.lisp:1.7 Sun Oct 2 11:30:19 2005 +++ beirc/variables.lisp Mon Oct 3 01:47:51 2005 @@ -7,9 +7,12 @@ (defvar *default-web-browser* #+darwin "/usr/bin/open" ;; assuming a debian system running X: #+linux "/usr/bin/x-www-browser") + (defvar *auto-join-alist* '(("irc.freenode.net" . ("#beirc"))) "An alist mapping irc server name to a list of channels to - automatically join on connect.") + automatically join on connect. Each element should have this + format: + (\"server-name\" . (\"#channel-name\" \"#channel2\" \"#channel3\"))") (defvar *nickserv-password-alist* '() "Default password to send to the NickServ authentication bot")

1 0