[beirc-cvs] CVS beirc

[rgoldman]

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*