* riece-display.el: Introduce Qt like "signal-slot" abstraction

for routing display events.
(riece-signal-slot-obarray): New variable.
(riece-make-slot): New function.
(riece-slot-function): New function.
(riece-slot-filter): New function.
(riece-slot-handback): New function.
(riece-make-signal): New function.
(riece-signal-name): New function.
(riece-signal-args): New function.
(riece-connect-signal): New function.
(riece-emit-signal): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 43dd8f7..d7cb0c7 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2004-02-26  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-display.el: Introduce Qt like "signal-slot" abstraction
+       for routing display events.
+       (riece-signal-slot-obarray): New variable.
+       (riece-make-slot): New function.
+       (riece-slot-function): New function.
+       (riece-slot-filter): New function.
+       (riece-slot-handback): New function.
+       (riece-make-signal): New function.
+       (riece-signal-name): New function.
+       (riece-signal-args): New function.
+       (riece-connect-signal): New function.
+       (riece-emit-signal): New function.
+
 2004-02-19  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-300.el (riece-handle-353-message): Add 'riece-identity

diff --git a/lisp/riece-display.el b/lisp/riece-display.el
index f675e99..c137681 100644 (file)
--- a/lisp/riece-display.el
+++ b/lisp/riece-display.el
@@ -45,6 +45,67 @@ Local to the buffer in `riece-buffer-list'.")
     riece-update-channel-list-indicator)
   "Functions to update modeline indicators.")
 
+;;; Qt like "signal-slot" abstraction for routing display events.
+(defvar riece-signal-slot-obarray
+  (make-vector 31 0))
+
+(defun riece-make-slot (function &optional filter handback)
+  "Make an instance of slot object.
+Arguments are corresponding to callback function, filter function, and
+a handback object, respectively."
+  (vector function filter handback))
+
+(defun riece-slot-function (slot)
+  "Return the callback function of SLOT."
+  (aref slot 0))
+
+(defun riece-slot-filter (slot)
+  "Return the filter function of SLOT."
+  (aref slot 1))
+
+(defun riece-slot-handback (slot)
+  "Return the handback object of SLOT."
+  (aref slot 2))
+
+(defun riece-make-signal (name &rest args)
+  "Make an instance of signal object.
+The 1st arguments is the name of the signal and the rest of arguments
+are the data of the signal."
+  (vector name args))
+
+(defun riece-signal-name (signal)
+  "Return the name of SIGNAL."
+  (aref signal 0))
+
+(defun riece-signal-args (signal)
+  "Return the data of SIGNAL."
+  (aref signal 1))
+
+(defun riece-connect-signal (signal-name slot)
+  "Add SLOT as a listener of a signal identified by SIGNAL-NAME."
+  (let ((symbol (intern (symbol-name signal-name) riece-signal-slot-obarray)))
+    (set symbol (cons slot (if (boundp symbol)
+                              (symbol-value symbol))))))
+
+(defun riece-emit-signal (signal)
+  "Emit SIGNAL."
+  (let ((symbol (intern-soft (symbol-name (riece-signal-name signal))
+                            riece-signal-slot-obarray))
+       slots)
+    (when symbol
+      (setq slots (symbol-value symbol))
+      (while slots
+       (condition-case error
+           (if (or (null (riece-slot-filter (car slots)))
+                   (funcall (riece-slot-filter (car slots)) signal))
+               (funcall (riece-slot-function (car slots))
+                        signal (riece-slot-handback (car slots))))
+         (error
+          (if riece-debug
+              (message "Error occurred in slot function for signal \"%S\": %S"
+                       (riece-signal-name signal) error))))
+       (setq slots (cdr slots))))))
+
 (defun riece-update-user-list-buffer ()
   (save-excursion
     (set-buffer riece-user-list-buffer)