Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv15257
Modified Files: application.lisp message-display.lisp message-processing.lisp variables.lisp Log Message: Fix ignore. Make timestamps mouse-sensitive. Fix updating-output.
* Ignore and unignore would remove the messages, but not set the scroll state. Make them use the new with-pane-kept-scrolled-to-bottom macro.
* Timestamps are now pointers to meme.b9.com on channels that have a user "cmeme" on them. The nickname of the log bot is configurable via *meme-log-bot-nick*.
* Updating-output's new SXHASH function would ignore the non-booleans on the list. Ugh.
--- /project/beirc/cvsroot/beirc/application.lisp 2006/03/24 21:19:43 1.69 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/27 13:46:47 1.70 @@ -254,21 +254,35 @@ (defmethod handle-event ((frame beirc) (event new-sheet-event)) (funcall (sheet-creation-closure event) frame))
+(defmacro with-pane-kept-scrolled-to-bottom ((pane-form) &body body) + "Ensure that the pane in PANE-FORM has the same scroll state +after BODY terminates as it had before: + +If the pane is scrolled to some position before the end, it is +kept there. If the pane is at the bottom of the pane, the +viewport is reset to the then-current bottom after BODY is +finished." + (let ((pane (gensym)) + (bottom-p (gensym))) + `(let* ((,pane ,pane-form) + (,bottom-p (pane-scrolled-to-bottom-p ,pane))) + (multiple-value-prog1 (progn ,@body) + (when ,bottom-p (scroll-pane-to-bottom ,pane)))))) + (defmethod handle-event ((frame beirc) (event foo-event)) ;; Hack: ;; Figure out if we are scrolled to the bottom. (let* ((receiver (receiver event)) (pane (actual-application-pane (pane receiver))) (next-event (event-peek (frame-top-level-sheet frame)))) - (let ((btmp (pane-scrolled-to-bottom-p pane))) + (with-pane-kept-scrolled-to-bottom (pane) (update-drawing-options receiver) ;; delay redisplay until this is the last event in the queue ;; (for this event's receiver). (unless (and (typep next-event 'foo-event) (eql (receiver next-event) receiver)) (setf (pane-needs-redisplay pane) t) - (redisplay-frame-panes frame)) - (when btmp (scroll-pane-to-bottom pane))) + (redisplay-frame-panes frame))) (medium-force-output (sheet-medium pane)) ;### ))
@@ -496,13 +510,17 @@ (redraw-receiver (current-receiver *application-frame*)))
(define-beirc-command (com-ignore :name t) ((who 'nickname :prompt "who")) - (pushnew who (slot-value *application-frame* 'ignored-nicks) :test #'string=) - (redraw-all-receivers)) + (with-pane-kept-scrolled-to-bottom ((actual-application-pane + (pane (current-receiver *application-frame*)))) + (pushnew who (slot-value *application-frame* 'ignored-nicks) :test #'string=) + (redraw-all-receivers)))
(define-beirc-command (com-unignore :name t) ((who 'ignored-nickname :prompt "who")) - (setf (slot-value *application-frame* 'ignored-nicks) - (remove who (slot-value *application-frame* 'ignored-nicks) :test #'string=)) - (redraw-all-receivers)) + (with-pane-kept-scrolled-to-bottom ((actual-application-pane + (pane (current-receiver *application-frame*)))) + (setf (slot-value *application-frame* 'ignored-nicks) + (remove who (slot-value *application-frame* 'ignored-nicks) :test #'string=)) + (redraw-all-receivers)))
(define-beirc-command (com-unfocus :name t) ((who 'nickname :prompt "who")) (setf (current-focused-nicks) @@ -950,7 +968,7 @@ x y) (declare (ignore object options)) (when (and ptype (presentation-subtypep ptype 'command) - (boundp '*current-input-stream*) *current-input-stream*) + (boundp 'climi::*current-input-stream*) climi::*current-input-stream*) (restart-case (signal 'invoked-command-by-clicking) (acknowledged ())))))))) (call-next-method)) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/24 21:07:20 1.40 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/27 13:46:47 1.41 @@ -38,28 +38,48 @@ (member (irc:source message) (slot-value *application-frame* 'ignored-nicks) :test #'string=))
+(defun +boolean (initial-value &rest booleans) + (loop for value = initial-value then (+ (ash value 1) + (if boolean 1 0)) + for boolean in booleans + finally (return value))) + (defun invoke-formatting-message (stream message receiver preamble-writer message-body-writer) (let* ((*current-message* message) (stream* (if (eql stream t) *standard-output* stream)) (width (- (floor (bounding-rectangle-width (sheet-parent stream*)) (clim:stream-string-width stream* "X")) 2))) - (labels ((output-timestamp-column (position) + (labels ((make-meme-url (message) + (format nil "http://meme.b9.com/cview.html?channel=~A&utime=~A#utime_requested" + (string-trim '(##) (channel receiver)) + (irc:received-time message))) + (format-timestamp (message) + (format stream* "[~2,'0D:~2,'0D]" + (nth-value 2 (decode-universal-time (irc:received-time message))) + (nth-value 1 (decode-universal-time (irc:received-time message))))) + (output-timestamp-column (position) (when (eql position *timestamp-column-orientation*) (formatting-cell (stream* :align-x :left) (with-drawing-options (stream* :ink +gray+) - (format stream* "[~2,'0D:~2,'0D]" - (nth-value 2 (decode-universal-time (irc:received-time message))) - (nth-value 1 (decode-universal-time (irc:received-time message))))))))) + (if (and *meme-log-bot-nick* + (irc:find-user (connection receiver) *meme-log-bot-nick*) + (member (title receiver) + (irc:channels (irc:find-user (connection receiver) *meme-log-bot-nick*)) + :test #'equal + :key #'irc:name)) + (with-output-as-presentation (stream* (make-meme-url message) 'url) + (format-timestamp message)) + (format-timestamp message))))))) (updating-output (stream* :cache-value - (sxhash (list message - (message-from-focused-nick-p message receiver) - (message-from-ignored-nick-p message receiver) - width - *max-preamble-length* - *timestamp-column-orientation* - *default-fill-column*)) + (+boolean (sxhash (list message + width + *max-preamble-length* + *default-fill-column*)) + (message-from-focused-nick-p message receiver) + (message-from-ignored-nick-p message receiver) + (eql *timestamp-column-orientation* :left)) :cache-test #'eql) (formatting-row (stream*) (output-timestamp-column :left) --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/16 20:32:05 1.5 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/27 13:46:47 1.6 @@ -69,8 +69,13 @@ (typep message 'irc:irc-rpl_noaway-message)))
(define-beirc-hook autojoin-hoook ((message cl-irc:irc-rpl_welcome-message)) - "When you establish a connection, check the list of channels for autojoin + "When a connection is established, check the list of channels for autojoin and set them up accordingly." (declare (ignore message)) (join-missing-channels *application-frame*))
+(define-beirc-hook meme-whois-hook ((message irc:irc-rpl_welcome-message)) + "When a connection is established, look up the channels on +which the meme log bot is listening." + (when (not (null *meme-log-bot-nick*)) + (irc:whois (irc:connection message) *meme-log-bot-nick*))) \ No newline at end of file --- /project/beirc/cvsroot/beirc/variables.lisp 2006/03/24 21:19:44 1.12 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/03/27 13:46:47 1.13 @@ -47,3 +47,6 @@ the command /Close Inactive Queries and the automatic query window closing mechanism (see *auto-close-inactive-query-windows-p*).") + +(defvar *meme-log-bot-nick* "cmeme" + "The name of the meme channel log bot") \ No newline at end of file