← Back to branch summary

~ubuntu-branches/ubuntu/saucy/wl/saucy-proposed

« back to all changes in this revision

Viewing changes to elmo/elmo-signal.el

  • Committer: Bazaar Package Importer
  • Author(s): Tatsuya Kinoshita
  • Date: 2007-01-02 21:08:54 UTC
  • mfrom: (3.1.3 edgy)
  • Revision ID: james.westby@ubuntu.com-20070102210854-nw929130dlxgi6q3
Tags: 2.14.0-4
http://bugs.debian.org/405284
elmo/elmo-imap4.el: Fix "IMAP error: No `OK' response from server",
patch from upstream CVS version. (closes: #405284)

Show diffs side-by-side

added added

removed removed

Lines of Context:
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 handler
 
137
                                   &optional filter handback)
 
138
  "Add HANDLER as a callback function for signal identified by SIGNAL-NAME.
 
139
If SOURCE has non-nil value, HANDLER 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 handler 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