1 ;;; elmo-signal.el --- "signal-slot" abstraction for routing events
3 ;; Copyright (C) 1998-2003 Daiki Ueno <ueno@unixuser.org>
5 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
7 ;; Keywords: mail, net news
9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
29 ;;; This module implements Qt like "signal-slot" abstraction for
32 ;;; Based on riece-signal.el.
36 (eval-when-compile (require 'cl))
38 (defvar elmo-signal-slot-obarray
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))
48 (defun elmo-slot-source (slot)
49 "Return the source of SLOT.
50 This function is for internal use only."
53 (defun elmo-slot-listener (slot)
54 "Return the listener of SLOT.
55 This function is for internal use only."
58 (defun elmo-slot-function (slot)
59 "Return the callback function of SLOT.
60 This function is for internal use only."
63 (defun elmo-slot-filter (slot)
64 "Return the filter function of SLOT.
65 This function is for internal use only."
68 (defun elmo-slot-handback (slot)
69 "Return the handback object of SLOT.
70 This function is for internal use only."
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)))
78 (defun elmo-signal-name (signal)
79 "Return the name of SIGNAL."
82 (defun elmo-signal-args (signal)
83 "Return the argument list of SIGNAL."
84 (get signal 'elmo-signal-args))
86 (defun elmo-signal-docstring (signal)
87 "Return the docment string of SIGNAL."
88 (get signal 'elmo-signal-docstring))
90 (defun elmo-signal-bindings (source listener args handback 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))))
104 (setq arg-list (cdr arg-list)))
105 (setq bindings (nconc bindings
106 (list (list (car arg-list) handback)))))
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)
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]])
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)
131 (put 'elmo-define-signal-filter 'lisp-indent-function 'defun)
132 (def-edebug-spec elmo-define-signal-filter
133 (&define (arg [&rest arg])
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)
146 (symbol-value symbol))))))
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)))
154 (when (and (eq (elmo-slot-listener (car slots)) listener)
156 (eq (elmo-slot-function (car slots)) function)))
157 (set symbol (delq (car slots) (symbol-value symbol))))
158 (setq slots (cdr slots)))))
160 (defun elmo-clear-signal-slots ()
161 "Remove all functions from listeners list."
162 (fillarray elmo-signal-slot-obarray 0))
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))
170 (dolist (slot (symbol-value symbol))
172 (when (and (or (null (elmo-slot-source slot))
173 (eq (elmo-slot-source slot) source))
174 (or (null (elmo-slot-filter slot))
176 (funcall (elmo-slot-filter slot)
177 (elmo-slot-listener slot)
180 (funcall (elmo-slot-function slot)
181 (elmo-slot-listener slot)
184 (elmo-slot-handback slot))))))))
187 (product-provide (provide 'elmo-signal) (require 'elmo-version))
189 ;;; elmo-signal.el ends here