[beirc-cvs] CVS beirc

[afuchs]

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

Modified Files:
	application.lisp 
Log Message:
Add an /Everywhere command, that allows performing another command on every server connection.


--- /project/beirc/cvsroot/beirc/application.lisp	2006/03/16 21:01:21	1.64
+++ /project/beirc/cvsroot/beirc/application.lisp	2006/03/17 17:44:22	1.65
@@ -122,8 +122,17 @@
 (defun receiver-from-tab-pane (tab-pane &optional (frame *application-frame*))
   (gethash tab-pane (tab-panes-to-receivers frame)))
 
+(defvar *current-receiver-override*)
+
+(defmacro with-current-receiver ((var receiver) &body body)
+  `(let* ((*current-receiver-override* ,receiver)
+          (,var *current-receiver-override*))
+     , at body))
+
 (defmethod current-receiver ((frame beirc))
-  (let ((receiver (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame)))
+  (let ((receiver  (if (boundp '*current-receiver-override*)
+                       *current-receiver-override*
+                       (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame))))
     (if (typep receiver 'receiver)
         receiver
         nil)))
@@ -515,6 +524,12 @@
               (make-pathname :type nil :defaults pathname)
               pathname))))
 
+(define-beirc-command (com-everywhere :name t) ((command 'command :prompt "command"))
+  (mapc (lambda (server-receiver)
+          (with-current-receiver (receiver (cdr server-receiver))
+            (execute-frame-command *application-frame* command)))
+        (server-receivers *application-frame*)))
+
 (defun make-fake-irc-message (message-type &key command arguments
                               (source (current-nickname))
                               trailing-argument)