;;; rudel-infinote-group.el --- Common aspects of infinote communication groups -*- lexical-binding:t -*-
;;
;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scymtym@users.sourceforge.net>
;; Keywords: rudel, infinote, group, communication
;; X-RCS: $Id:$
;;
;; This file is part of Rudel.
;;
;; Rudel is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Rudel is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Rudel. If not, see <http://www.gnu.org/licenses>.
;;; Commentary:
;;
;; This file contains the following super class classes for
;; implementing infinote communication groups:
;;
;; + `rudel-infinote-group'
;; + `rudel-infinote-sequence-number-group'
;;
;; Communication groups are modeled as named state machines. States
;; have to be implemented in sub classes.
;;
;; For implementing infinote group state, the super class
;; `rudel-infinote-group-state' which mixes in impersonation (via
;; `rudel-impersonator') and delegation (via `rudel-delegator') to the
;; containing group is provided.
;;; History:
;;
;; 0.2 - Automatic sequence number injection
;;
;; 0.1 - Initial version
;;; Code:
;;
(eval-when-compile (require 'cl-lib))
(require 'warnings)
(require 'eieio)
(require 'eieio-base) ;; for `eieio-named'
(require 'rudel-util) ;; for `rudel-impersonator', `rudel-delegator'
(require 'rudel-state-machine)
(require 'rudel-infinote-state)
;;; Class rudel-infinote-group-state
;;
(defclass rudel-infinote-group-state (rudel-infinote-state
rudel-impersonator
rudel-delegator)
((impersonation-target-slot :initform 'group)
(delegation-target-slot :initform 'group)
(group :initarg :group
:type rudel-infinote-group-child
:documentation
""))
""
:abstract t)
(cl-defmethod rudel-accept ((this rudel-infinote-group-state) xml)
"Dispatch XML to appropriate handler method based on content."
(let ((type (xml-node-name xml)))
(pcase type
;; Handle request-failed messages.
(`request-failed
;; TODO handle the problem
;; TODO there can be a description:
;; <request-failed><text>Bla</text></request-failed>
(with-tag-attrs (domain
(code code number)
(sequence-number seq number)) xml
(display-warning
'(rudel infinote)
(format "request failed; sequence number: `%s', \
domain: `%s', code: `%s'"
sequence-number domain code)
:warning))
'idle)
;; Dispatch all normal message to appropriate methods
;; automatically.
(_
(let ((name (symbol-name type)))
(condition-case error
;; Try to dispatch on the message type.
(rudel-dispatch this
"rudel-infinote/" name
(list xml))
;; Warn if we failed to locate or execute the method. Return
;; nil in this case, so we remain in the current state.
(rudel-dispatch-error
(progn
(display-warning
'(rudel infinote)
(format "%s: no method (%s: %s): `%s/%s'; arguments: %s"
(cl-prin1-to-string this) (car error) (cdr error)
"rudel-infinote" name arguments)
:warning)
nil)))))))
)
;;; Class rudel-infinote-group-state-closed
;;
(defclass rudel-infinote-group-state-closed (rudel-infinote-group-state)
()
"Groups enter this state when receiving a <session-close/>
message.")
;; TODO can all groups receive <session-close/> or just document groups?
(cl-defmethod rudel-accept ((_this rudel-infinote-group-state-closed) _xml)
"Simply ignore all further messages."
nil)
;;; Class rudel-infinote-group
;;
(defclass rudel-infinote-group (eieio-named
rudel-state-machine)
((connection :initarg :connection
;:type rudel-infinote-connection ;; TODO
:documentation
"The connection used by this group object to do
its communication.")
(publisher :initarg :publisher
:type string
:documentation
"")
(method :initarg :method
:type symbol
:documentation
"")
(members :initarg :members ;; TODO currently unused
:type list
:initform nil
:documentation
""))
"Super class for all communication groups used in infinote
sessions. Groups are basically modeled as named state
machines. Subclasses have to provide their own states."
:abstract t)
(cl-defmethod rudel-register-state ((this rudel-infinote-group) _symbol state)
"Set the :group slot of STATE to THIS."
;; Associate THIS connection to STATE.
(oset state :group this)
;;
(cl-call-next-method))
(cl-defmethod rudel-send ((this rudel-infinote-group) data)
"Send DATA through the connection associated to THIS."
(with-slots (connection) this
(rudel-send connection
(rudel-infinote-embed-in-group this data))))
;;; Class rudel-infinote-sequence-number-group
;;
(defclass rudel-infinote-sequence-number-group (rudel-infinote-group)
((next-sequence-number :initarg :next-sequence-number
:type (integer 0)
:initform 0
:documentation
"Sequence number used when sending
requests.")
(remote-id :initarg :remote-id
:type (integer 0)
:documentation
"Id assigned to us by the remote
side. This is used to identify messages directed at us."))
"Objects of this class inject sequence number into messages
sent via `rudel-send'.")
(cl-defmethod rudel-send ((this rudel-infinote-sequence-number-group)
data &optional no-sequence-number)
"Add a sequence number to DATA and send it.
After sending, increment the sequence number counter.
If NO-SEQUENCE-NUMBER is non-nil, do not add a sequence number
and do not increment the sequence number counter."
(if no-sequence-number
(cl-call-next-method this data)
(with-slots ((seq-num :next-sequence-number)) this
(let ((data (xml-node-name data))
(attributes (xml-node-attributes data))
(children (xml-node-children data)))
(cl-call-next-method
this
(append
(list
data
(cons `(seq . ,(number-to-string seq-num))
attributes))
children)))
(cl-incf seq-num)))
)
;;; Miscellaneous functions
;;
(defmacro rudel-infinote-embed-in-group (group &rest forms) ;; TODO bad name
"Construct a message out of FORMS by adding data from GROUP.
The returned message consists of an outer <group> element with
GROUP's properties in its attributes and FORMS as children."
(declare (indent 1)
(debug (form &rest form)))
(let ((group-var (make-symbol "group"))
(name (make-symbol "name"))
(publisher (make-symbol "publisher")))
`(let* ((,group-var ,group)
(,name (object-name-string ,group-var))
(,publisher (oref ,group-var :publisher)))
`(group
((name . ,,name)
(publisher . ,,publisher))
,,@forms)))
)
(provide 'rudel-infinote-group)
;;; rudel-infinote-group.el ends here