/[de-setf-amqp]/states.lisp
ViewVC logotype

Contents of /states.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Tue Feb 23 09:05:39 2010 UTC (4 years, 1 month ago) by janderson
File size: 3055 byte(s)
Merge commit 'remotes/github/master' into remotes/git-svn
1 ;;; -*- Package: de.setf.amqp.implementation; -*-
2
3 (in-package :de.setf.amqp.implementation)
4
5 (document :file
6 (description "This file defines the state model for AMQP classes for the 'de.setf.amqp' library.")
7 (copyright
8 "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
9 "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
10 of the GNU Affero General Public License as published by the Free Software Foundation.
11
12 'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
13 implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14 See the Affero General Public License for more details.
15
16 A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
17 If not, see the GNU [site](http://www.gnu.org/licenses/)."))
18
19
20 ;;;
21 ;;; states
22
23 (macrolet ((defstate (name supers slots &rest options)
24 (setf name (intern (string name) :de.setf.amqp-state))
25 (setf supers (or (mapcar #'(lambda (s) (intern (string s) :de.setf.amqp-state)) supers)
26 (unless (eq name 'amqp.s:state) '(de.setf.amqp-state:state))))
27 `(prog1 (defclass ,name ,supers ,slots ,@options)
28 (eval-when (:compile-toplevel :load-toplevel :execute)
29 (export ',name :de.setf.amqp-state))
30 (defparameter ,name (make-instance ',name))))
31 (defstates (&rest states)
32 `(progn ,@(loop for state in states
33 collect (etypecase state
34 (symbol
35 `(defstate ,state () ()))
36 (cons
37 (destructuring-bind (name supers &optional slots &rest options) state
38 `(defstate ,name ,supers ,slots ,@options ))))))))
39 (defstates
40 state
41 connection-state
42 channel-state
43 open
44 (open-connection (open connection-state))
45 (open-connection.start (open-connection))
46 (open-connection.secure (open-connection))
47 (open-connection.tune (open-connection))
48 (open-connection.host (open-connection))
49 (open-channel (open channel-state))
50 use
51 (use-connection (use connection-state))
52 (use-channel (use channel-state))
53 body
54 input
55 output
56 chunked
57 (use-channel.body (use-channel body))
58 (use-channel.body.input (use-channel.body input))
59 (use-channel.body.input.chunked (chunked use-channel.body.input))
60 (use-channel.body.output (use-channel.body output))
61 (use-channel.body.output.chunked (chunked use-channel.body.output))
62 method
63 (use-channel.method (use-channel method))
64 header
65 (use-channel.header (use-channel header))
66 heartbeat
67 (use-channel.heartbeat (use-channel heartbeat))
68 close
69 (close-connection (close connection-state))
70 (close-channel (close channel-state))))

  ViewVC Help
Powered by ViewVC 1.1.5