elmo/elmo-signal.el

   1 ;;; elmo-signal.el --- "signal-slot" abstraction for routing events
   2
   3 ;; Copyright (C) 1998-2003 Daiki Ueno <ueno@unixuser.org>
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;;      Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28
  29 ;;; This module implements Qt like "signal-slot" abstraction for
  30 ;;; routing events.
  31
  32 ;;; Based on riece-signal.el.
  33
  34 ;;; Code:
  35
  36 (eval-when-compile (require 'cl))
  37
  38 (defvar elmo-signal-slot-obarray
  39   (make-vector 31 0))
  40
  41 (defun elmo-make-slot (source listener function &optional filter handback)
  42   "Make an instance of slot object.
  43 Arguments are corresponding to callback function, filter function, and
  44 a handback object, respectively.
  45 This function is for internal use only."
  46   (vector source listener function filter handback))
  47
  48 (defun elmo-slot-source (slot)
  49   "Return the source of SLOT.
  50 This function is for internal use only."
  51   (aref slot 0))
  52
  53 (defun elmo-slot-listener (slot)
  54   "Return the listener of SLOT.
  55 This function is for internal use only."
  56   (aref slot 1))
  57
  58 (defun elmo-slot-function (slot)
  59   "Return the callback function of SLOT.
  60 This function is for internal use only."
  61   (aref slot 2))
  62
  63 (defun elmo-slot-filter (slot)
  64   "Return the filter function of SLOT.
  65 This function is for internal use only."
  66   (aref slot 3))
  67
  68 (defun elmo-slot-handback (slot)
  69   "Return the handback object of SLOT.
  70 This function is for internal use only."
  71   (aref slot 4))
  72
  73 (put 'elmo-define-signal 'lisp-indent-function 'defun)
  74 (defmacro elmo-define-signal (name args &optional doc)
  75   `(setplist ',name (list 'elmo-signal-args ',args
  76                           'elmo-signal-docstring ,doc)))
  77
  78 (defun elmo-signal-name (signal)
  79   "Return the name of SIGNAL."
  80   signal)
  81
  82 (defun elmo-signal-args (signal)
  83   "Return the argument list of SIGNAL."
  84   (get signal 'elmo-signal-args))
  85
  86 (defun elmo-signal-docstring (signal)
  87   "Return the docment string of SIGNAL."
  88   (get signal 'elmo-signal-docstring))
  89
  90 (defun elmo-signal-bindings (source listener args handback arg-list)
  91   (let ((i 0)
  92         bindings)
  93     (when (car arg-list)
  94       (setq bindings (cons (list (car arg-list) listener) bindings)))
  95     (when (setq arg-list (cdr arg-list))
  96       (setq bindings (cons (list (car arg-list) source) bindings)))
  97     (while (and (setq arg-list (cdr arg-list))
  98                 (not (eq (car arg-list) '&optional)))
  99       (setq bindings (cons (list (car arg-list) (list 'nth i args)) bindings)
 100             i (1+ i)))
 101     (when (and handback
 102                (setq arg-list (cdr arg-list)))
 103       (setq bindings (cons (list (car arg-list) handback) bindings)))
 104     bindings))
 105
 106 (defmacro elmo-define-signal-handler (args &rest body)
 107   "Define a signal handler.
 108 ARGS is a symbol list as (LISTENER SOURCE ARG... &optional HANDBACK)."
 109   (let ((source   (make-symbol "--source--"))
 110         (listener (make-symbol "--listener--"))
 111         (argument (make-symbol "--argument--"))
 112         (handback (make-symbol "--handback--")))
 113     `(lambda (,listener ,source ,argument ,handback)
 114        (let ,(elmo-signal-bindings source listener argument handback args)
 115          ,@body))))
 116
 117 (put 'elmo-define-signal-handler 'lisp-indent-function 'defun)
 118 (def-edebug-spec elmo-define-signal-handler
 119   (&define (arg [&rest arg] [&optional ["&optional" arg &rest arg]])
 120            def-body))
 121
 122 (defmacro elmo-define-signal-filter (args &rest body)
 123   "Define a signal filter.
 124 ARGS is a symbol list as (LISTENER SOURCE ARG...)."
 125   (let ((source   (make-symbol "--source--"))
 126         (listener (make-symbol "--listener--"))
 127         (argument (make-symbol "--argument--")))
 128     `(lambda (,listener ,source ,argument)
 129        (let ,(elmo-signal-bindings source listener argument nil args)
 130          ,@body))))
 131
 132 (put 'elmo-define-signal-filter 'lisp-indent-function 'defun)
 133 (def-edebug-spec elmo-define-signal-filter
 134   (&define (arg [&rest arg])
 135            def-body))
 136
 137 (defun elmo-connect-signal (source signal-name listener handler
 138                                    &optional filter handback)
 139   "Add HANDLER as a callback function for signal identified by SIGNAL-NAME.
 140 If SOURCE has non-nil value, HANDLER will be invoked only if SOURCE is same as
 141 source argument of `elmo-emit-signal'. Comparison is done with `eq'. If SOURCE
 142 is nil, react on signals from any sources.
 143 You can specify further filter function by FILTER."
 144   (let ((symbol (intern (symbol-name signal-name) elmo-signal-slot-obarray)))
 145     (set symbol (cons (elmo-make-slot source listener handler filter handback)
 146                       (if (boundp symbol)
 147                           (symbol-value symbol))))))
 148
 149 (defun elmo-disconnect-signal (signal-name listener &optional function)
 150   "Remove FUNCTION from the listener of the signal identified by SIGNAL-NAME."
 151   (let* ((symbol (intern-soft (symbol-name signal-name)
 152                              elmo-signal-slot-obarray))
 153          (slots (symbol-value symbol)))
 154     (while slots
 155       (when (and (eq (elmo-slot-listener (car slots)) listener)
 156                  (or (null function)
 157                      (eq (elmo-slot-function (car slots)) function)))
 158         (set symbol (delq (car slots) (symbol-value symbol))))
 159       (setq slots (cdr slots)))))
 160
 161 (defun elmo-clear-signal-slots ()
 162   "Remove all functions from listeners list."
 163   (fillarray elmo-signal-slot-obarray 0))
 164
 165 (defun elmo-emit-signal (signal-name source &rest args)
 166   "Emit signal with SIGNAL-NAME."
 167   (let ((symbol (intern-soft (symbol-name signal-name)
 168                              elmo-signal-slot-obarray))
 169         signal)
 170     (when symbol
 171       (dolist (slot (symbol-value symbol))
 172         (ignore-errors
 173           (when (and (or (null (elmo-slot-source slot))
 174                          (eq (elmo-slot-source slot) source))
 175                      (or (null (elmo-slot-filter slot))
 176                          (ignore-errors
 177                           (funcall (elmo-slot-filter slot)
 178                                    (elmo-slot-listener slot)
 179                                    source
 180                                    args))))
 181             (funcall (elmo-slot-function slot)
 182                      (elmo-slot-listener slot)
 183                      source
 184                      args
 185                      (elmo-slot-handback slot))))))))
 186
 187 (require 'product)
 188 (product-provide (provide 'elmo-signal) (require 'elmo-version))
 189
 190 ;;; elmo-signal.el ends here