diff options
Diffstat (limited to 'emacs.d/lisp/rudel/rudel-session-initiation.el')
-rw-r--r-- | emacs.d/lisp/rudel/rudel-session-initiation.el | 352 |
1 files changed, 352 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/rudel-session-initiation.el b/emacs.d/lisp/rudel/rudel-session-initiation.el new file mode 100644 index 0000000..395ab07 --- /dev/null +++ b/emacs.d/lisp/rudel/rudel-session-initiation.el @@ -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 |