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

Modified Files: application.lisp beirc.asd variables.lisp Added Files: post-message-hooks.lisp Log Message: Added support for making noise on certain messages.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:50:21 1.68 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/24 21:19:43 1.69 @@ -309,25 +309,29 @@ (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message)))

(defun post-message-to-receiver (frame message receiver) - (setf (messages receiver) - (append (messages receiver) (list message))) - (unless (eql receiver (current-receiver frame)) - (when (interesting-message-p message) - (incf (unseen-messages receiver))) - (when (message-directed-to-me-p message) - (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-directed-to-me-p message)) - (push current-insert-position - (positions-mentioning-user receiver))))) - (queue-event (frame-top-level-sheet frame) - (make-instance 'foo-event :sheet frame :receiver receiver)) - nil) + (let ((message-to-me-p (message-directed-to-me-p message)) + (interesting-message-p (interesting-message-p message))) + (setf (messages receiver) + (append (messages receiver) (list message))) + (unless (eql receiver (current-receiver frame)) + (when interesting-message-p + (incf (unseen-messages receiver))) + (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) + (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-event (frame-top-level-sheet frame) + (make-instance 'foo-event :sheet frame :receiver receiver)) + nil))

(defun post-message (frame message) (let ((receiver (receiver-for-message message frame))) --- /project/beirc/cvsroot/beirc/beirc.asd 2006/03/12 09:48:57 1.7 +++ /project/beirc/cvsroot/beirc/beirc.asd 2006/03/24 21:19:43 1.8 @@ -14,4 +14,6 @@ (:file "presentations" :depends-on ("package" "variables" "receivers")) (:file "message-display" :depends-on ("package" "variables" "presentations")) (:file "application" :depends-on ("package" "variables" "presentations" "events" "receivers")) - (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")))) \ No newline at end of file + (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")) + (:file "post-message-hooks" :depends-on ("package")) + )) \ No newline at end of file --- /project/beirc/cvsroot/beirc/variables.lisp 2006/03/21 15:22:03 1.11 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/03/24 21:19:44 1.12 @@ -6,7 +6,15 @@ (defvar *default-nick* (format nil "Brucio-~d" (random 100))) (defvar *default-web-browser* #+darwin "/usr/bin/open" ;; assuming a debian system running X: - #+linux "/usr/bin/x-www-browser") + #+linux "/usr/bin/x-www-browser") +(defvar *default-sound-player* + (or nil + #+linux "/usr/bin/ogg123") + "An external program that can be used to produce sounds.") +(defvar *sound-for-my-nick* nil + "If the NOISEMAKER post-message-hook is enabled, and there +is a *default-sound-player* defined, this noise will be +played when your nick is mentioned.")

(defvar *auto-join-alist* '(("irc.freenode.net" . ("#beirc"))) "An alist mapping irc server name to a list of channels to

--- /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 NONE +++ /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 1.1 (in-package :beirc)

(defvar *post-message-hooks* (make-hash-table) "Table of hooks to be run when a message is posted to a receiver.")

(defun run-post-message-hooks (message frame receiver &rest args) (maphash #'(lambda (k v) (declare (ignore k)) (apply v message frame receiver args)) *post-message-hooks*) (values))

(defmacro define-post-message-hook (hook-name (message-var frame-var receiver-var &rest other-args) &body body) "Convenience macro for defining hooks that are run when a message is posted to a receiver." `(progn (defun ,hook-name (,message-var ,frame-var ,receiver-var ,@other-args &allow-other-keys) ,@body) (setf (gethash ',hook-name *post-message-hooks*) ',hook-name)))

;;;--------------------------------------------------------------------------- ;;; If you set *default-sound-player* and *sound-for-my-nick* this ;;; should work... It leaves a lot to be desired. This should ;;; probably turn into some kind of general noisemaking interface... ;;; But this should get us thinking. [2006/03/24:rpg] ;;;--------------------------------------------------------------------------- (define-post-message-hook noisemaker (msg frame receiver &key message-directed-to-me) (declare (ignore msg frame receiver)) (when (and message-directed-to-me *default-sound-player* *sound-for-my-nick*) #+allegro (excl:run-shell-command (format nil "~A ~A" *default-sound-player* *sound-for-my-nick*) :error-output "/dev/null" :if-error-output-exists :append :wait t)))