1 files changed, 352 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/.svn/text-base/rudel-session-initiation.el.svn-base b/emacs.d/lisp/rudel/.svn/text-base/rudel-session-initiation.el.svn-base
new file mode 100644
index 0000000..395ab07
--- /dev/null
+++ b/emacs.d/lisp/rudel/.svn/text-base/rudel-session-initiation.el.svn-base
@@ -0,0 +1,352 @@
+;;; rudel-session-initiation.el --- Session discovery and advertising functions
+;;
+;; Copyright (C) 2009 Jan Moringen
+;;
+;; Author: Jan Moringen <scymtym@users.sourceforge.net>
+;; Keywords: Rudel, session, initiation, service, discovery, advertising
+;; 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:
+;;
+;; Interfaces for session initiation and discovery.
+;;
+;; The central interface is
+;; `rudel-session-initiation-backend'. Backends implementing this
+;; interface can provide methods to discover sessions, to advertise
+;; sessions, or both.
+;;
+;; The client programming interface consists of a priority which is
+;; one of:
+;;
+;; + `primary'
+;; + `fallback'
+;;
+;; and the following functions:
+;;
+;; + `rudel-session-initiation-discover'
+;; + `rudel-session-initiation-advertise'
+;; + `rudel-session-initiation-withdraw'
+
+
+;;; History:
+;;
+;; 0.1 - Initial revision
+
+
+;;; Code:
+;;
+
+(eval-when-compile
+  (require 'cl))
+
+(require 'eieio)
+
+(require 'rudel-backend)
+
+
+;;; Customization options
+;;
+
+(defcustom rudel-configured-sessions nil
+  "List of configured sessions.
+
+Each session is described as a plist (a list of keys and values
+see Info node `(elisp)Property Lists'). Keys are specified using
+keywords and look like this: :host, :username, :color. Values are
+mostly strings, but symbols and numbers are possible as well.
+
+The following keys are required for any session:
+
+* :name    (string)
+* :backend (string or symbol)
+
+Other keys are optional and depend on the selected
+backend. Required keys for which no value is specified will be
+prompted for when selecting the session. The values of the :name
+properties have to be distinct for all configured sessions.
+
+Additional keys required by most backends:
+
+* :host     (string)
+* :port     (number)
+* :username (string)
+* :color    (string)
+
+Here is a complete example of customized values for the obby
+backend:
+
+* :name            \"sonian\"
+* :backend         obby
+* :host            \"sobby\"
+* :port            6522
+* :encryption      t
+* :username        \"phil\"
+* :color           \"white\"
+* :global-password \"\"             (this means \"no password\")
+* :user-password   \"\"
+
+The programmatic equivalent looks like this:
+
+(add-to-list 
+ 'rudel-configured-sessions
+ (list :name            \"myserver\"
+       :backend         'obby
+       :host            \"my.sobby-server.net\"
+       :username        user-login-name
+       ;; Use M-x list-colors-display to see color choices.
+       :color           \"white\"
+       :encryption      t 
+       :port            6522
+       ;; empty string means no password
+       :global-password \"\"
+       :user-password   \"\"))"
+  :group 'rudel
+  :type  '(repeat :tag "Connections"
+		  (plist :tag "Connection"
+			 :options ((:name     string)
+				   (:backend  symbol)
+				   (:username string)
+				   (:color    color))))
+  )
+
+
+;;; Variables and constants
+;;
+
+(defvar rudel-session-discovered-hook nil
+  "This hook is run when collaboration sessions are discovered.")
+
+(defvar rudel-session-vanished-hook nil
+  "This hook is run when previously discovered collaboration
+session disappear.")
+
+
+;;; Class rudel-session-initiation-backend
+;;
+
+(defclass rudel-session-initiation-backend (rudel-backend)
+  ((priority :initarg  :priority
+	     :type     symbol
+	     :accessor rudel-priority
+	     :documentation
+	     "Priority of the session initiation method
+implemented by this backend. Has to be either 'primary or
+'fallback"))
+  "Interface implemented by session initiation backends."
+  :abstract t)
+
+(defgeneric rudel-discover ((this rudel-session-initiation-backend))
+  "Return a list of discovered sessions.
+Each list element is a connect info property list. See
+`rudel-join-session' for a description of the format of this
+list.
+
+The presence of an implementation of this generic function should
+be indicated by the presence of the 'discover' capability.")
+
+(defgeneric rudel-advertise ((this rudel-session-initiation-backend) info)
+  "Advertise session described by INFO.
+INFO is a connect info property list. See `rudel-host-session'
+for a description of the format of this list.
+
+The presence of an implementation of this generic function should
+be indicated by the presence of the 'advertise' capability.")
+
+
+;;; Client programming interface functions.
+;;
+
+(defun rudel-session-initiation-suitable-backends (capability)
+  "Return primary and fallback backends that have CAPABILITY.
+The returned list is of the form (PRIMARY FALLBACK), where
+PRIMARY and FALLBACK are lists of backends of the respective
+priority."
+  (let* (;; Select all backends, which can discover sessions
+	 (suitable-backends (rudel-backend-suitable-backends
+			     'session-initiation
+			     (lambda (backend)
+			       (rudel-capable-of-p backend capability))))
+	 ;; Select primary backends
+	 (primary-backends  (remove*
+			     'fallback suitable-backends
+			     :key (lambda (backend)
+				    (rudel-priority (cdr backend)))))
+	 ;; Select fallback backends
+	 (fallback-backends (remove*
+			     'primary suitable-backends
+			     :key (lambda (backend)
+				    (rudel-priority (cdr backend))))))
+    (list primary-backends fallback-backends))
+  )
+
+(defun rudel-session-initiation-discover (&optional backend-name)
+  "Return a list of session using BACKEND-NAME when non-nil.
+BACKEND-NAME is a symbol. When it is non-nil, only the specified
+backend is used to discover session.
+
+The returned list is of the form (INFO-1 ... INFO-N FALLBACK-1
+... FALLBACK-M) where INFO-I are connect info property lists (see
+`rudel-join-session') and FALLBACK-I are conses of the form (NAME
+. CLASS-OR-OBJECT) that specify fallback backends."
+  (multiple-value-bind (primary-backends fallback-backends)
+      (rudel-session-initiation-suitable-backends 'discover)
+    ;; Retrieve session list from primary backend and fall back to
+    ;; fallback backends if the list is empty.
+    (if backend-name
+	(let ((backend (find backend-name fallback-backends :key #'car)))
+	  (rudel-discover (cdr backend)))
+      (let ((primary-results
+	     (remove-if #'null
+			(apply #'append
+			       (mapcar #'rudel-discover
+				       (mapcar #'cdr primary-backends))))))
+	(append primary-results fallback-backends))))
+  )
+
+(defun rudel-session-initiation-advertise (info)
+  "Advertise the session described by INFO.
+INFO is a connect info property list. See `rudel-host-session'
+for a description of the format of this list.
+
+Primary backends are tried first. If none succeeds, fallback
+backends are tried.
+
+The result is non-nil if at least one backend was able to
+advertise the session."
+  (multiple-value-bind (primary-backends fallback-backends)
+      (rudel-session-initiation-suitable-backends 'advertise)
+    (or ;; Try to advertise the session using primary backends.
+        (some (mapcar (lambda (backend)
+			(rudel-advertise backend info))
+		      (mapcar #'cdr primary-backends)))
+	;; When the primary backends fail, try to advertise the
+	;; session using fallback backends
+	(some (mapcar (lambda (backend)
+			(rudel-advertise backend info))
+		      (mapcar #'cdr fallback-backends)))))
+  )
+
+
+;;; Class rudel-ask-protocol-backend
+;;
+
+(defconst rudel-ask-protocol-version '(0 1)
+  "Version of the ask-protocol backend for Rudel.")
+
+;;;###autoload
+(defclass rudel-ask-protocol-backend (rudel-session-initiation-backend)
+  ((capabilities :initform (discover))
+   (priority     :initform fallback))
+  "This fallback backend can \"discover\" sessions by letting the
+user select a suitable backend and asking for connect information
+required by the chosen backend.")
+
+(defmethod initialize-instance ((this rudel-ask-protocol-backend)
+				&rest slots)
+  "Set backend version."
+  (when (next-method-p)
+    (call-next-method))
+
+  (oset this :version rudel-ask-protocol-version))
+
+(defmethod rudel-discover ((this rudel-ask-protocol-backend))
+  "\"Discover\" sessions by asking the user about the backend to use and the connect info."
+  (let ((backend (rudel-backend-choose
+		  'protocol
+		  (lambda (backend)
+		    (rudel-capable-of-p backend 'join)))))
+    (list (append (list :name    "asked"
+			:backend backend)
+		  (rudel-ask-connect-info (cdr backend)))))
+  )
+
+;;;###autoload
+(rudel-add-backend (rudel-backend-get-factory 'session-initiation)
+		   'ask-protocol 'rudel-ask-protocol-backend)
+
+
+;;; Class rudel-configured-sessions-backend
+;;
+
+(defconst rudel-configured-sessions-version '(0 1)
+  "Version of the configured-sessions backend for Rudel.")
+
+;;;###autoload
+(defclass rudel-configured-sessions-backend
+  (rudel-session-initiation-backend)
+  ((capabilities :initform (discover))
+   (priority     :initform primary))
+  "This fallback backend can \"discover\" sessions the user has
+configured using customization.")
+
+(defmethod initialize-instance ((this rudel-configured-sessions-backend)
+				&rest slots)
+  "Set backend version."
+  (when (next-method-p)
+    (call-next-method))
+
+  (oset this :version rudel-configured-sessions-version))
+
+(defmethod rudel-discover ((this rudel-configured-sessions-backend))
+  "\"Discover\" sessions the has configured."
+  ;; Iterate over all configured sessions in order to make
+  ;; adjustments.
+  (mapcar #'rudel-session-initiation-adjust-info
+	  rudel-configured-sessions))
+
+;;;###autoload
+(rudel-add-backend (rudel-backend-get-factory 'session-initiation)
+		   'configured-sessions 'rudel-configured-sessions-backend)
+
+
+;;; Miscellaneous functions
+;;
+
+(defun rudel-session-initiation-adjust-info (info)
+  "Resolve arguments that need resolving in INFO."
+  ;; Start with a new, empty property list.
+  (let ((adjusted-info)
+	(key   (car  info))
+	(value (cadr info))
+	(rest  info))
+    ;; Iterate over all properties in INFO.
+    (while rest
+      (setq rest (cddr rest))
+      (cond
+       ;; Resolve backend arguments.
+       ((eq key :backend)
+	(let ((backend (rudel-backend-get 'protocol
+					  (if (stringp value)
+					      (intern value)
+					    value))))
+	  (push backend adjusted-info)
+	  (push key     adjusted-info)))
+       ;; Keep other arguments unmodified.
+       (t
+	(push value adjusted-info)
+	(push key   adjusted-info)))
+      ;; Advance to next key value pair.
+      (setq key   (car  rest)
+	    value (cadr rest)))
+    ;; Return the transformed session information.
+    adjusted-info)
+  )
+
+(provide 'rudel-session-initiation)
+;;; rudel-session-initiation.el ends here