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

Modified Files: application.lisp message-display.lisp Log Message: Added command-enabled method for COM-AWAY and added MEME-URL presentation type.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/04/12 18:27:16 1.76 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/19 02:53:48 1.77 @@ -343,21 +343,24 @@ (unless (eql receiver (current-receiver frame)) (when interesting-message-p (incf (unseen-messages receiver))) + ;; why is this only done when the receiver is not the current + ;; one? [2006/04/17:rpg] (when message-to-me-p (incf (messages-directed-to-me receiver))) (incf (all-unseen-messages receiver))) (when (and (slot-boundp receiver 'pane) (pane receiver)) (let* ((pane (actual-application-pane (pane receiver))) (current-insert-position (bounding-rectangle-height pane))) - (when (and (not (eql current-insert-position - (first (positions-mentioning-user receiver)))) - message-to-me-p) + (when (and message-to-me-p + (not (eql current-insert-position + (first (positions-mentioning-user receiver))))) (push current-insert-position (positions-mentioning-user receiver))))) (run-post-message-hooks message frame receiver :message-directed-to-me message-to-me-p :message-interesting-p interesting-message-p) (queue-beirc-event frame (make-instance 'foo-event :sheet frame :receiver receiver)) + ;; is this effectively the same as (values)? [2006/04/17:rpg] nil))

(defun post-message (frame message) @@ -631,6 +634,10 @@ not away." (away-status frame (current-connection frame)))

+(defmethod command-enabled ((command-name (eql 'com-away)) frame) + "Turn off the away command when you are already away." + (not (away-status frame (current-connection frame)))) + (define-beirc-command (com-quit :name t) (&key (reason 'mumble :prompt "reason" :default "Client Quit")) (disconnect-all *application-frame* reason) (frame-exit *application-frame*)) @@ -826,8 +833,20 @@ (define-presentation-to-command-translator url-to-browse-url-translator (url com-browse-url beirc) (presentation) + (list (presentation-object presentation))) + +;;; this translator refines the previous one, just giving a more +;;; precise pointer documentation. If I were smarter about +;;; presentation types, I bet I could fold this into the previous +;;; translator. [2006/04/18:rpg] +(define-presentation-to-command-translator meme-url-to-browse-url-translator + (meme-url com-browse-url beirc :pointer-documentation "Browse meme log" + ;; override url-to-browse-url-translator + :priority 1) + (presentation) (list (presentation-object presentation)))

+ (define-presentation-translator receiver-pane-to-receiver-translator (receiver-pane receiver beirc :documentation ((object stream) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/12 18:27:16 1.46 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/19 02:53:48 1.47 @@ -33,6 +33,10 @@ (define-presentation-type url () :inherit-from 'string)

+(define-presentation-type meme-url () + :inherit-from 'url) + + (defun present-url (url) (let* ((clhs-base "http://www.lispworks.com/reference/HyperSpec/") (start (search clhs-base url))) @@ -91,7 +95,7 @@ (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) + (with-output-as-presentation (stream* (make-meme-url message) 'meme-url) (format-timestamp message)) (format-timestamp message))))))) (updating-output (stream*