X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-signal.el;h=522e5a42c2610e9844727ebd20c00e2494053af5;hp=7fedd2f755395975bad593d568ea71a0d1ea3bdd;hb=9813a6f38fd73e13df920134f25109940917d27c;hpb=a90da5167ee52cbf7b1320a4c6a4465b8b10075d

diff --git a/lisp/riece-signal.el b/lisp/riece-signal.el
index 7fedd2f..522e5a4 100644
--- a/lisp/riece-signal.el
+++ b/lisp/riece-signal.el
@@ -29,6 +29,9 @@
 
 ;;; Code:
 
+(require 'riece-options)
+(require 'riece-debug)
+
 (defvar riece-signal-slot-obarray
   (make-vector 31 0))
 
@@ -70,12 +73,27 @@ This function is for internal use only."
   (aref signal 1))
 
 (defun riece-connect-signal (signal-name function &optional filter handback)
-  "Add SLOT as a listener of a signal identified by SIGNAL-NAME."
+  "Add FUNCTION as a listener of a signal identified by SIGNAL-NAME."
   (let ((symbol (intern (symbol-name signal-name) riece-signal-slot-obarray)))
     (set symbol (cons (riece-make-slot function filter handback)
 		      (if (boundp symbol)
 			  (symbol-value symbol))))))
 
+(defun riece-disconnect-signal (signal-name function)
+  "Remove FUNCTION from the listener of the signal identified by SIGNAL-NAME."
+  (let* ((symbol (intern-soft (symbol-name signal-name)
+			     riece-signal-slot-obarray))
+	 (slots (symbol-value symbol)))
+    (while slots
+      (if (eq (riece-slot-function (car slots))
+	      function)
+	  (set symbol (delq (car slots) (symbol-value symbol))))
+      (setq slots (cdr slots)))))
+
+(defun riece-clear-signal-slots ()
+  "Remove all functions from listeners list."
+  (fillarray riece-signal-slot-obarray 0))
+
 (defun riece-emit-signal (signal-name &rest args)
   "Emit SIGNAL."
   (let ((symbol (intern-soft (symbol-name signal-name)
@@ -86,22 +104,14 @@ This function is for internal use only."
       (setq signal (riece-make-signal signal-name args)
 	    slots (symbol-value symbol))
       (while slots
-	(condition-case error
-	    (if (or (null (riece-slot-filter (car slots)))
-		    (condition-case error
-			(funcall (riece-slot-filter (car slots)) signal)
-		      (error
-		       (if riece-debug
-			   (message
-			    "Error occurred in signal filter for \"%S\": %S"
-			    signal-name error)))
-		      nil))
-		(funcall (riece-slot-function (car slots))
-			 signal (riece-slot-handback (car slots))))
-	  (error
-	   (if riece-debug
-	       (message "Error occurred in slot function for \"%S\": %S"
-			signal-name error))))
+	(riece-ignore-errors (format "slot function for \"%S\""
+				     signal-name)
+	  (if (or (null (riece-slot-filter (car slots)))
+		  (riece-ignore-errors (format "signal filter for \"%S\""
+					       symbol-name)
+		    (funcall (riece-slot-filter (car slots)) signal)))
+	      (funcall (riece-slot-function (car slots))
+		       signal (riece-slot-handback (car slots)))))
 	(setq slots (cdr slots))))))
 
 (provide 'riece-signal)