;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(require 'riece-options)
+(require 'riece-debug)
+
(defvar riece-signal-slot-obarray
(make-vector 31 0))
(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)
(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))))
+ (if (or (null (riece-slot-filter (car slots)))
+ (riece-funcall-ignore-errors (format "signal filter for \"%S\""
+ signal-name)
+ (riece-slot-filter (car slots))
+ signal))
+ (riece-funcall-ignore-errors (format "slot function for \"%S\""
+ signal-name)
+ (riece-slot-function (car slots))
+ signal
+ (riece-slot-handback (car slots))))
(setq slots (cdr slots))))))
(provide 'riece-signal)