* elmo-signal.el (elmo-connect-signal): Document.
[elisp/wanderlust.git] / 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 (list (list (car arg-list) listener))))
95     (when (setq arg-list (cdr arg-list))
96       (setq bindings (nconc bindings
97                             (list (list (car arg-list) source)))))
98     (while (and (setq arg-list (cdr arg-list))
99                 (not (eq (car arg-list) '&optional)))
100       (setq bindings (nconc bindings
101                             (list (list (car arg-list) (list 'nth i args))))
102             i (1+ i)))
103     (when (and handback
104                (setq arg-list (cdr arg-list)))
105       (setq bindings (nconc bindings
106                             (list (list (car arg-list) handback)))))
107     bindings))
108
109 (defmacro elmo-define-signal-handler (args &rest body)
110   (let ((source   (make-symbol "--source--"))
111         (listener (make-symbol "--listener--"))
112         (argument (make-symbol "--argument--"))
113         (handback (make-symbol "--handback--")))
114     `(lambda (,listener ,source ,argument ,handback)
115        (let ,(elmo-signal-bindings source listener argument handback args)
116          ,@body))))
117
118 (put 'elmo-define-signal-handler 'lisp-indent-function 'defun)
119 (def-edebug-spec elmo-define-signal-handler
120   (&define (arg [&rest arg] [&optional ["&optional" arg &rest arg]])
121            def-body))
122
123 (defmacro elmo-define-signal-filter (args &rest body)
124   (let ((source   (make-symbol "--source--"))
125         (listener (make-symbol "--listener--"))
126         (argument (make-symbol "--argument--")))
127     `(lambda (,listener ,source ,argument)
128        (let ,(elmo-signal-bindings source listener argument nil args)
129          ,@body))))
130
131 (put 'elmo-define-signal-filter 'lisp-indent-function 'defun)
132 (def-edebug-spec elmo-define-signal-filter
133   (&define (arg [&rest arg])
134            def-body))
135
136 (defun elmo-connect-signal (source signal-name listener function
137                                    &optional filter handback)
138   "Add FUNCTION as a listener of a signal identified by SIGNAL-NAME.
139 If SOURCE has non-nil value, FUNCTION will be invoked only if SOURCE is same as
140 source argument of `elmo-emit-signal'. Comparison is done with `eq'. If SOURCE
141 is nil, react on signals from any sources.
142 You can specify further filter function by FILTER."
143   (let ((symbol (intern (symbol-name signal-name) elmo-signal-slot-obarray)))
144     (set symbol (cons (elmo-make-slot source listener function filter handback)
145                       (if (boundp symbol)
146                           (symbol-value symbol))))))
147
148 (defun elmo-disconnect-signal (signal-name listener &optional function)
149   "Remove FUNCTION from the listener of the signal identified by SIGNAL-NAME."
150   (let* ((symbol (intern-soft (symbol-name signal-name)
151                              elmo-signal-slot-obarray))
152          (slots (symbol-value symbol)))
153     (while slots
154       (when (and (eq (elmo-slot-listener (car slots)) listener)
155                  (or (null function)
156                      (eq (elmo-slot-function (car slots)) function)))
157         (set symbol (delq (car slots) (symbol-value symbol))))
158       (setq slots (cdr slots)))))
159
160 (defun elmo-clear-signal-slots ()
161   "Remove all functions from listeners list."
162   (fillarray elmo-signal-slot-obarray 0))
163
164 (defun elmo-emit-signal (signal-name source &rest args)
165   "Emit signal with SIGNAL-NAME."
166   (let ((symbol (intern-soft (symbol-name signal-name)
167                              elmo-signal-slot-obarray))
168         signal)
169     (when symbol
170       (dolist (slot (symbol-value symbol))
171         (ignore-errors
172           (when (and (or (null (elmo-slot-source slot))
173                          (eq (elmo-slot-source slot) source))
174                      (or (null (elmo-slot-filter slot))
175                          (ignore-errors
176                           (funcall (elmo-slot-filter slot)
177                                    (elmo-slot-listener slot)
178                                    source
179                                    args))))
180             (funcall (elmo-slot-function slot)
181                      (elmo-slot-listener slot)
182                      source
183                      args
184                      (elmo-slot-handback slot))))))))
185
186 (require 'product)
187 (product-provide (provide 'elmo-signal) (require 'elmo-version))
188
189 ;;; elmo-signal.el ends here