[beirc-cvs] CVS beirc
rgoldman
rgoldman at common-lisp.net
Wed Apr 19 02:53:49 UTC 2006
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*
More information about the Beirc-cvs
mailing list