--- /dev/null
+;;; riece-signal.el --- "signal-slot" abstraction for routing display events -*- lexical-binding: t -*-
+;; Copyright (C) 1998-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1998-09-28
+;; Keywords: IRC, riece
+
+;; This file is part of Riece.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; This module implements Qt like "signal-slot" abstraction for
+;;; routing display events.
+
+;;; Code:
+
+(require 'riece-options)
+(require 'riece-debug)
+
+(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.
+This function is for internal use only."
+ (vector function filter handback))
+
+(defun riece-slot-function (slot)
+ "Return the callback function of SLOT.
+This function is for internal use only."
+ (aref slot 0))
+
+(defun riece-slot-filter (slot)
+ "Return the filter function of SLOT.
+This function is for internal use only."
+ (aref slot 1))
+
+(defun riece-slot-handback (slot)
+ "Return the handback object of SLOT.
+This function is for internal use only."
+ (aref slot 2))
+
+(defun riece-make-signal (name 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.
+This function is for internal use only."
+ (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 function &optional filter handback)
+ "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)
+ riece-signal-slot-obarray))
+ signal
+ slots)
+ (when symbol
+ (setq signal (riece-make-signal signal-name args)
+ slots (symbol-value symbol))
+ (while slots
+ (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)
+
+;;; riece-signal.el ends here
projects / packages / blobdiff