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*)) + ,@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)