From: ueno <ueno>
Date: Thu, 26 Feb 2004 22:33:44 +0000 (+0000)
Subject: * riece-display.el: Introduce Qt like "signal-slot" abstraction
X-Git-Tag: signal-slot-mergepoint~21
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5a4acaa81c4285b90166faf733b3239563efbf49;p=elisp%2Friece.git

* 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
--- 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
--- 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)