cgit.sxemacs.org Git - riece/blob - lisp/riece-signal.el

   1 ;;; riece-signal.el --- "signal-slot" abstraction for routing display events
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; This module implements Qt like "signal-slot" abstraction for
  28 ;;; routing display events.
  29
  30 ;;; Code:
  31
  32 (require 'riece-options)
  33 (require 'riece-debug)
  34
  35 (defvar riece-signal-slot-obarray
  36   (make-vector 31 0))
  37
  38 (defun riece-make-slot (function &optional filter handback)
  39   "Make an instance of slot object.
  40 Arguments are corresponding to callback function, filter function, and
  41 a handback object, respectively.
  42 This function is for internal use only."
  43   (vector function filter handback))
  44
  45 (defun riece-slot-function (slot)
  46   "Return the callback function of SLOT.
  47 This function is for internal use only."
  48   (aref slot 0))
  49
  50 (defun riece-slot-filter (slot)
  51   "Return the filter function of SLOT.
  52 This function is for internal use only."
  53   (aref slot 1))
  54
  55 (defun riece-slot-handback (slot)
  56   "Return the handback object of SLOT.
  57 This function is for internal use only."
  58   (aref slot 2))
  59
  60 (defun riece-make-signal (name args)
  61   "Make an instance of signal object.
  62 The 1st arguments is the name of the signal and the rest of arguments
  63 are the data of the signal.
  64 This function is for internal use only."
  65   (vector name args))
  66
  67 (defun riece-signal-name (signal)
  68   "Return the name of SIGNAL."
  69   (aref signal 0))
  70
  71 (defun riece-signal-args (signal)
  72   "Return the data of SIGNAL."
  73   (aref signal 1))
  74
  75 (defun riece-connect-signal (signal-name function &optional filter handback)
  76   "Add FUNCTION as a listener of a signal identified by SIGNAL-NAME."
  77   (let ((symbol (intern (symbol-name signal-name) riece-signal-slot-obarray)))
  78     (set symbol (cons (riece-make-slot function filter handback)
  79                       (if (boundp symbol)
  80                           (symbol-value symbol))))))
  81
  82 (defun riece-disconnect-signal (signal-name function)
  83   "Remove FUNCTION from the listener of the signal identified by SIGNAL-NAME."
  84   (let* ((symbol (intern-soft (symbol-name signal-name)
  85                              riece-signal-slot-obarray))
  86          (slots (symbol-value symbol)))
  87     (while slots
  88       (if (eq (riece-slot-function (car slots))
  89               function)
  90           (set symbol (delq (car slots) (symbol-value symbol))))
  91       (setq slots (cdr slots)))))
  92
  93 (defun riece-clear-signal-slots ()
  94   "Remove all functions from listeners list."
  95   (fillarray riece-signal-slot-obarray 0))
  96
  97 (defun riece-emit-signal (signal-name &rest args)
  98   "Emit SIGNAL."
  99   (let ((symbol (intern-soft (symbol-name signal-name)
 100                              riece-signal-slot-obarray))
 101         signal
 102         slots)
 103     (when symbol
 104       (setq signal (riece-make-signal signal-name args)
 105             slots (symbol-value symbol))
 106       (while slots
 107         (if (or (null (riece-slot-filter (car slots)))
 108                 (riece-funcall-ignore-errors (format "signal filter for \"%S\""
 109                                                      signal-name)
 110                                              (riece-slot-filter (car slots))
 111                                              signal))
 112             (riece-funcall-ignore-errors (format "slot function for \"%S\""
 113                                                  signal-name)
 114                                          (riece-slot-function (car slots))
 115                                          signal
 116                                          (riece-slot-handback (car slots))))
 117         (setq slots (cdr slots))))))
 118
 119 (provide 'riece-signal)
 120
 121 ;;; riece-signal.el ends here