diff options
Diffstat (limited to '')
| -rw-r--r-- | emacs.d/lisp/rudel/rudel.el | 1012 |
1 files changed, 1012 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/rudel.el b/emacs.d/lisp/rudel/rudel.el new file mode 100644 index 0000000..88603fa --- /dev/null +++ b/emacs.d/lisp/rudel/rudel.el @@ -0,0 +1,1012 @@ +;;; rudel.el --- A collaborative editing framework for Emacs +;; +;; Copyright (C) 2008, 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: rudel, collaboration +;; URL: http://rudel.sourceforge.net/ +;; 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: +;; +;; Rudel is a framework for collaborative editing in Emacs. Its +;; architecture allows communication with arbitrary collaborative +;; editors. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(eval-when-compile + (require 'cl)) + +(require 'eieio) +(require 'eieio-base) + +(require 'eieio-speedbar) ;; TODO required for now + +(require 'rudel-util) +(require 'rudel-backend) +(require 'rudel-session-initiation) +(require 'rudel-operations) +(require 'rudel-operators) +(require 'rudel-overlay) +(require 'rudel-hooks) +(require 'rudel-interactive) ;; for `rudel-read-backend', + ;; `rudel-read-document', + ;; `rudel-read-session' +(require 'rudel-icons) +(require 'rudel-compat) ;; for `read-color' replacement + + +;;; Global variables +;; + +(defconst rudel-version '(0 3) + "Version of the Rudel framework.") + +(defvar rudel-current-session nil + "Global object representing the current Rudel session. +nil if there is no active session.") + +(defvar rudel-buffer-document nil + "Buffer-local variable which holds the Rudel document associated with the buffer.") +(make-variable-buffer-local 'rudel-buffer-document) +(put 'rudel-buffer-document 'permanent-local t) + +(defvar rudel-buffer-change-workaround-data nil + "Buffer-local variable which holds change data that could not be accessed otherwise. +It would be nice to find another way to do this.") +(make-variable-buffer-local 'rudel-buffer-change-workaround-data) +(put 'rudel-buffer-change-workaround-data 'permanent-local t) + + +;;; Customization +;; + +(defgroup rudel nil + "Rudel collaborative editing framework." + :group 'applications) + +(defcustom rudel-allocate-buffer-function + 'rudel-allocate-buffer-clear-existing + "A function used to find or create buffers to associate to documents. +The function is called with the document name as the sole +argument and has to return a buffer object which will be attached +to the document in question." + :group 'rudel + :type '(choice (const :tag "Clear content of existing buffer" + rudel-allocate-buffer-clear-existing ) + (const :tag "Create a new uniquely named buffer" + rudel-allocate-buffer-make-unique ) + (function :tag "Other function")) + :require 'rudel-interactive) + +(defcustom rudel-default-username (user-login-name) + "*" + :group 'rudel + :type '(string)) + + +;;; Class rudel-session +;; + +(defclass rudel-session (rudel-hook-object) + ((backend :initarg :backend + :type rudel-backend-child + :documentation + "The backend used by this session.") + (users :initarg :users + :type list + :initform nil + :documentation + "The list of users participating in this +session.") + (documents :initarg :documents + :type list + :initform nil + :documentation + "This list of documents available in +this session.") + ;; Hooks + (end-hook :initarg :end-hook + :type list + :initform nil + :documentation + "") + (add-user-hook :initarg :add-user-hook + :type list + :initform nil + :documentation + "This hook is run when a user gets added +to the session. +The arguments are the session and the user object.") + (remove-user-hook :initarg :remove-user-hook + :type list + :initform nil + :documentation + "This hook is run when a user gets +removed from the session. +The arguments are the session and the user object.") + (add-document-hook :initarg :add-document-hook + :type list + :initform nil + :documentation + "This hook is run when a document gets +added to the session. +The arguments are the session and the document object.") + (remove-document-hook :initarg :remove-document-hook + :type list + :initform nil + :documentation + "This hook is run when a document gets +removed from the session. +The arguments are the session and the document object.")) + "This class serves as a base class for rudel-client-session and +rudel-server-session. Consequently, it consists of slots common +to client and server sessions." + :abstract t) + +(defmethod rudel-end ((this rudel-session)) + "Terminate THIS session performing all necessary cleanup." + ;; Run the hook. + (object-run-hook-with-args this 'end-hook)) + +(defmethod rudel-add-user ((this rudel-session) user) + "Add USER to the user list of THIS session. + +Runs object hook (see `rudel-hook-object') `add-user-hook' with +arguments THIS and USER." + ;; Add USER to list. + (object-add-to-list this :users user) + + ;; Run the hook. + (object-run-hook-with-args this 'add-user-hook user)) + +(defmethod rudel-remove-user ((this rudel-session) user) + "Remove USER from the user list of THIS session. + +Runs object hook (see `rudel-hook-object') `remove-user-hook' +with arguments THIS and USER." + ;; Remove USER from list. + (object-remove-from-list this :users user) + + ;; Run the hook. + (object-run-hook-with-args this 'remove-user-hook user)) + +(defmethod rudel-find-user ((this rudel-session) + which &optional test key) + "Find user WHICH in the user list. +WHICH is compared to the result of KEY using TEST." + (unless test + (setq test #'string=)) + (unless key + (setq key #'object-name-string)) + (with-slots (users) this + (find which users :key key :test test)) + ) + +(defmethod rudel-add-document ((this rudel-session) document) + "" + (unless (slot-boundp document :session) + (oset document :session this)) + + ;; Add DOCUMENT to the list of documents in THIS session. + (object-add-to-list this :documents document) + + ;; Run the hook. + (object-run-hook-with-args this 'add-document-hook document)) + +(defmethod rudel-remove-document ((this rudel-session) document) + "Remove DOCUMENT from THIS session, detaching it if necessary." + ;; Detach document from its buffer when necessary. + (when (rudel-attached-p document) + (rudel-detach-from-buffer document)) + + ;; Remove DOCUMENT from the list of documents in THIS session. + (object-remove-from-list this :documents document) + + ;; Run the hook. + (object-run-hook-with-args this 'remove-document-hook document)) + +(defmethod rudel-find-document ((this rudel-session) + which &optional test key) + "Find document WHICH in the document list. +WHICH is compared to the result of KEY using TEST." + (unless test + (setq test #'string=)) + (unless key + (setq key #'object-name-string)) + (with-slots (documents) this + (find which documents :key key :test test)) + ) + +(defmethod rudel-unsubscribed-documents ((this rudel-session)) + "" + (unless (slot-boundp this :self) + (error "Cannot find unsubscribed documents unless slot self is bound")) + (with-slots (documents self) this + (remove-if + (lambda (document) + (with-slots (subscribed) document + (memq self subscribed))) + documents)) + ) + + +;;; Class rudel-client-session +;; +(defclass rudel-client-session (rudel-session) + ((connection :initarg :connection + :type (or null rudel-connection-child) + :initform nil + :documentation + "The connection used for communication by this +session.") + (self :initarg :self + :type rudel-user-child + :documentation + "Points into USERS to the user object representing +the local user")) + "Objects represent a collaborative editing session from a +client perspective.") + +(defmethod rudel-end ((this rudel-client-session)) + ;; Clean everything up + (with-slots (connection users documents) this + ;; Detach all documents from their buffers + (mapc #'rudel-detach-from-buffer documents) + + ;; Terminate the connection + (when connection + (condition-case nil + (rudel-disconnect connection) + (error nil)))) + + ;; + (when (next-method-p) + (call-next-method)) + ) + + +;;; Class rudel-server-session +;; + +(defclass rudel-server-session (rudel-session) + () + "Class rudel-server-session " + :abstract t) + + +;;; Class rudel-connection +;; + +(defclass rudel-connection () + ((session :initarg :session + :type rudel-session-child + :documentation + "")) + "This abstract class defines the interface implementations of +client protocols have to obey." + :abstract t) + +(defgeneric rudel-disconnect ((this rudel-connection)) + "Close the connection.") + +(defgeneric rudel-change-color- ((this rudel-connection) color) ;; TODO name + "") + +(defgeneric rudel-publish ((this rudel-connection) document) + "") + +(defgeneric rudel-subscribe-to ((this rudel-connection) document) + "") + +(defgeneric rudel-unsubscribe-from ((this rudel-connection) document) ; TODO name should be rudel-unsubscribe + "") + +(defgeneric rudel-local-insert ((this rudel-connection)) + "") + +(defgeneric rudel-local-delete ((this rudel-connection)) + "") + +(defgeneric rudel-remote-insert ((this rudel-connection)) + "") + +(defgeneric rudel-remote-delete ((this rudel-connection)) + "") + + +;;; Class rudel-user +;; + +(defclass rudel-user (eieio-named + eieio-speedbar-file-button + rudel-hook-object) + ((color :initarg :color + :accessor rudel-color + :documentation + "Color used to indicate ownership or authorship +by the user. Examples includes text written by the user or the +user name itself.") + (change-hook :initarg :change-hook + :type list + :initform nil + :documentation + "This hook is run when this user object +changes.")) + "Objects of this class represent users participating in +collaborative editing session. Note that a participating user +does not have to be connected to the session at any given time." + :abstract t) + +(defmethod rudel-display-string ((this rudel-user) + &optional use-images align) + "Return a textual representation of THIS for user interface stuff." + (with-slots ((name :object-name) color) this + (propertize + (concat + (when use-images + (propertize "*" 'display rudel-icon-person)) + name) + 'face (list :background color))) + ) + + +;;; Class rudel-document +;; + +(defclass rudel-document (eieio-named + eieio-speedbar-file-button + rudel-hook-object) + ((session :initarg :session + :type rudel-session + :documentation + "") + (buffer :initarg :buffer + :type (or null buffer) + :initform nil + :documentation + "") + (subscribed :initarg :subscribed + :type list + :initform nil + :documentation + "") + ;; Hooks + (subscribe-hook :initarg :subscribe-hook + :type list + :initform nil + :documentation + "This hook is run when a user subscribes to +this document object.") + (unsubscribe-hook :initarg :unsubscribe-hook + :type list + :initform nil + :documentation + "This hook is run when a user unsubscribes +from this document object.") + (attach-hook :initarg :attach-hook + :type list + :initform nil + :documentation + "This hook is run when a buffer is attached +to this document object.") + (detach-hook :initarg :detach-hook + :type list + :initform nil + :documentation + "This hook is run when the attached buffer +is detached from this document object.")) + "This class represents a document, which participants of a +collaborative editing session can subscribe to." + :abstract t) + +(defmethod rudel-unique-name ((this rudel-document)) + "Returns a suggested name for the buffer attached to THIS document." + (object-name-string this)) + +(defmethod rudel-suggested-buffer-name ((this rudel-document)) + "Returns a suggested name for the buffer attached to THIS document." + (rudel-unique-name this)) + +(defmethod rudel-attached-p ((this rudel-document)) + (with-slots (buffer) this + buffer)) + +(defmethod rudel-attach-to-buffer ((this rudel-document) buffer) + "Attach THIS document to BUFFER" + (with-slots ((doc-buffer :buffer)) this + ;; Set buffer slot of THIS to BUFFER and associated THIS with + ;; BUFFER. + (setq doc-buffer buffer) + (rudel-set-buffer-document this buffer) + + (with-current-buffer doc-buffer + ;; Add the handler function for buffer changes to the buffer's + ;; change hook. + (add-hook 'after-change-functions + #'rudel-handle-buffer-change + nil t) + + ;; Store change data before the change a done. This is necessary + ;; because the number of bytes (not characters) cannot otherwise + ;; be recovered after a deletion. + (add-hook 'before-change-functions + #'rudel-buffer-change-workaround + nil t) + + ;; Add a handler to the kill-buffer hook to unsubscribe from the + ;; document when the buffer gets killed. + (add-hook 'kill-buffer-hook + #'rudel-unpublish-buffer + nil t) + + ;; + (add-hook 'change-major-mode-hook + #'rudel-handle-major-mode-change + nil t)) + + ;; Run the hook. + (object-run-hook-with-args this 'attach-hook doc-buffer)) + ) + +(defmethod rudel-detach-from-buffer ((this rudel-document)) + "Detach document THIS from its buffer. +Do nothing, if THIS is not attached to any buffer." + (with-slots (buffer) this + (let ((buffer-save buffer)) + + ;; Only try to detach from BUFFER, if it is non-nil. BUFFER can + ;; be nil, if the user did not subscribe to the document, or + ;; unsubscribed after subscribing. + (when buffer + + (with-current-buffer buffer + ;; Remove our handler function from the kill-buffer hook. + (remove-hook 'kill-buffer-hook + #'rudel-unpublish-buffer + t) + + ;; Remove our handler function from the after-change hook. + (remove-hook 'after-change-functions + #'rudel-handle-buffer-change + t) + + ;; Remove our handler function from the before-change hook. + (remove-hook 'before-change-functions + #'rudel-buffer-change-workaround + t) + + ;; Remove all overlays. + (rudel-overlays-remove-all) + + ;; Remove the major mode change handler. + (remove-hook 'change-major-mode-hook + #'rudel-handle-major-mode-change + t)) + + ;; Unset buffer slot of THIS and delete association of THIS with + ;; BUFFER. + (rudel-set-buffer-document nil buffer) + (setq buffer nil)) + + ;; Run the hook. + (object-run-hook-with-args this 'detach-hook buffer-save))) + ) + +(defmethod rudel-add-user ((this rudel-document) user) + "Add USER to the list of subscribed users of THIS. + +Runs object hook (see `rudel-hook-object') `subscribe-hook' with +arguments THIS and USER." + ;; Add USER to list. + (object-add-to-list this :subscribed user) + + ;; Run the hook. + (object-run-hook-with-args this 'subscribe-hook user)) + +(defmethod rudel-remove-user ((this rudel-document) user) + "Remove USER from the list of subscribed users of THIS. + +Runs object hook (see `rudel-hook-object') `unsubscribe-hook' +with arguments THIS and USER." + ;; Remove USER from list. + (object-remove-from-list document :subscribed user) + + ;; Run the hook. + (object-run-hook-with-args this 'unsubscribe-hook user)) + +(defmethod rudel-insert ((this rudel-document) position data) + "Insert DATA at POSITION into the buffer attached to THIS. +When POSITION is nil `point-max' is used to determine the +insertion position. +Modification hooks are disabled during the insertion." + (with-slots (buffer) this + (save-excursion + (set-buffer buffer) + + (unless position + (setq position (- (point-max) 1))) + + (let ((inhibit-modification-hooks t)) + (goto-char (+ position 1)) + (insert data)))) + ) + +(defmethod rudel-delete ((this rudel-document) position length) + "Delete a region of LENGTH character at POSITION from the buffer attached to THIS. +Modification hooks are disabled during the insertion." + (with-slots (buffer) this + (save-excursion + (set-buffer buffer) + + (let ((inhibit-modification-hooks t)) + (delete-region (+ position 1) (+ position length 1))))) + ) + +(defmethod rudel-local-operation ((this rudel-document) operation) + "Apply the local operation OPERATION to THIS." + (with-slots (session buffer) this + (with-slots (connection (user :self)) session + (dolist (operators (list + + ;; Update overlays + (rudel-overlay-operators + "overlay-operators" + :document this + :user user) + + ;; Notify connection + (rudel-connection-operators + "connection-operators" + :connection connection + :document this))) + + ;; Apply the operation using each set of operators + (rudel-apply operation operators)))) + ) + +(defmethod rudel-remote-operation ((this rudel-document) user operation) + "Apply the remote operation OPERATION performed by USER to THIS." + (dolist (operators (append + + ;; Update buffer contents + (list (rudel-document-operators + "document-operators" + :document this)) + + ;; Update overlays + (when user + (list (rudel-overlay-operators + "overlay-operators" + :document this + :user user))))) + + ;; Apply the operation using each set of operators + (rudel-apply operation operators)) + ) + +(defmethod rudel-chunks ((this rudel-document)) + "Return a list of text chunks of the associated buffer. +Each element in the chunk is a list structured like this (START +END AUTHOR). START and END are numbers, AUTHOR is of type (or +null rudel-user-child)." + (with-slots (buffer) this + ;; Extract buffer string and a list of chunks partitioning the + ;; string according to the respective author (or nil). + (with-current-buffer buffer + (let ((string (buffer-string)) ;; TODO no-properties? + (overlay-chunks (mapcar + (lambda (overlay) + (list (- (overlay-start overlay) 1) + (- (overlay-end overlay) 1) + (rudel-overlay-user overlay))) + (sort* (rudel-author-overlays) + '< :key 'overlay-start))) + (last) + (augmented-chunks)) + + ;; Iterate through the list of chunks to find gaps between + ;; chunks (also before the first) and insert entries with + ;; author nil accordingly. + (dolist (chunk overlay-chunks) + (when (or (and (not last) + (> (nth 0 chunk) 0)) + (and last + (/= (nth 1 last) + (nth 0 chunk)))) + (push (list (if last (nth 1 last) 0) + (nth 0 chunk) + nil) + augmented-chunks)) + (push chunk augmented-chunks) + (setq last chunk)) + + ;; If there is text after the last chunk, create another one + ;; with author nil. If there were no chunks at all, this chunk + ;; can also cover the whole buffer string. + (when (or (and (not last) + (/= (length string) 0)) + (and last + (/= (nth 1 last) (length string)))) + (push (list (if last (nth 1 last) 0) + (length string) + nil) + augmented-chunks)) + + ;; Sort chunks according to the start position. + (sort* augmented-chunks '< :key 'car)))) + ) + + +;;; Buffer-related functions +;; + +(defun rudel-buffer-has-document-p (&optional buffer) + "Return non-nil if a document object is attached to BUFFER. +If BUFFER is nil, use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + + (buffer-local-value 'rudel-buffer-document buffer)) + +(defun rudel-buffer-document (&optional buffer) + "Return the document object attached to BUFFER. +If BUFFER is nil, use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + + (buffer-local-value 'rudel-buffer-document buffer)) + +(defun rudel-set-buffer-document (document &optional buffer) + "Associate BUFFER to DOCUMENT. +If DOCUMENT is nil, make it not associated to any buffer. +If BUFFER is nil, use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + + (with-current-buffer buffer + (setq rudel-buffer-document document))) + +(defun rudel-handle-buffer-change (from to length) + "Handle buffer change at range FROM to TO with length LENGTH by relaying them to the document object of the buffer. +See after-change-functions for more information." + (when (rudel-buffer-has-document-p) + (let ((document (rudel-buffer-document)) + (text)) ; TODO with-rudel-buffer-document? + (cond + ;; The change was an insert + ((and (/= from to) + (zerop length)) + (with-slots (buffer) document + (with-current-buffer buffer + (setq text (buffer-substring-no-properties from to))) + (rudel-local-operation document + (rudel-insert-op + "insert" + :from (- from 1) + :data text)))) + + ;; The change was a delete + ((and (= from to) + (not (zerop length))) + (rudel-local-operation document + (rudel-delete-op + "delete" + :from (- from 1) + :length length))) + + ;; The operation was neither an insert nor a delete. This seems + ;; to mean that the region has changed arbitrarily. The only + ;; option we have is sending a delete and corresponding insert + ;; message that emulate the change. + (t + (with-slots (buffer) document + (with-current-buffer buffer + (setq text (buffer-substring-no-properties from to))) + (rudel-local-operation document + (rudel-delete-op + "delete" + :from (- from 1) + :length length)) + (rudel-local-operation document + (rudel-insert-op + "insert" + :from (- from 1) + :data text))))))) + ) + +(defun rudel-buffer-change-workaround (from to) + (when (/= from to) + (setq rudel-buffer-change-workaround-data + (list from to + (buffer-substring-no-properties from to))))) + + +;;; Protection against major mode changes +;; + +(defvar rudel-mode-changed-buffers nil + "List of buffers that may need to be repaired after a major + mode change.") + +(defun rudel-handle-major-mode-change () + "Store the current buffer to repair damage done by major mode change. + +Note: The way this works is inspired by mode-local.el by David +Ponce and Eric M. Ludlam." + ;; Store the buffer for later repair. + (add-to-list 'rudel-mode-changed-buffers (current-buffer)) + + ;; Schedule `rudel-after-major-mode-change' to run after the + ;; command, that caused the major mode change. + (add-hook 'post-command-hook + #'rudel-after-major-mode-change) + ) + +(defun rudel-after-major-mode-change () + "Repair damage done by major mode changes. +As a function in `post-command-hook', this is run after there was +a `major-mode' change. + +Note: The way this works is inspired by mode-local.el by David +Ponce and Eric M. Ludlam." + ;; Remove this function from `post-command-hook'. + (remove-hook 'post-command-hook + #'rudel-after-major-mode-change) + + ;; Repair all buffers affected by the major mode change. + (dolist (buffer rudel-mode-changed-buffers) + (let ((document (buffer-local-value 'rudel-buffer-document + buffer))) + (rudel-attach-to-buffer document buffer))) + ) + + +;;; Interactive functions +;; + +;;;###autoload +(defun rudel-join-session (info) + "Join the collaborative editing session described by INFO. +INFO is a property list that describes the collaborative editing +session in terms of properties like :host, :port +and :encryption. The particular properties and their respective +meanings depend on the used backend. + +When called interactively, all data required to join a session +will be prompted for." + (interactive + ;; Try the discover method of session initiation backends to find + ;; available sessions. + (list + (let ((info) + (session-initiation-backend)) + (while (not info) + (message "Discovering Sessions ...") + (let* ((sessions (rudel-session-initiation-discover + session-initiation-backend)) + (maybe-info (if (= (length sessions) 1) + (car sessions) + (rudel-read-session + sessions "Choose Session: " 'object)))) + (if (rudel-backend-cons-p maybe-info) + (setq session-initiation-backend (car maybe-info)) + (setq info maybe-info)))) + info))) + + ;; First, create the session object. + (let* ((backend (cdr (plist-get info :backend))) + (session (rudel-client-session + (plist-get info :name) + :backend backend)) + (connection)) + ;; Give the backend a chance to collect remaining connect + ;; info. For session initiation methods like Zeroconf, we have the + ;; _connection_ info, but are still missing the username and + ;; stuff. + (setq info (rudel-ask-connect-info backend info)) + + ;; Add the session object to the connect information. + (plist-put info :session session) + + ;; Ask BACKEND to connect using INFO. Do not catch errors since + ;; the error messages are probably the best feedback we can give. + (setq connection (rudel-connect backend info)) + + ;; Set the connection slot of the session object and store it + ;; globally. + (oset session :connection connection) + (setq rudel-current-session session) + + ;; Reset the global session variable when the session ends. + (object-add-hook session 'end-hook + (lambda (session) + (setq rudel-current-session nil))) + + ;; Run the hook. + (run-hook-with-args 'rudel-session-start-hook session)) + ) + +;;;###autoload +(defun rudel-host-session () + "Host a collaborative editing session. +All data required to host a session will be prompted for +interactively." + (interactive) + ;; If necessary, ask the user for the backend we should use. + (let* ((backend (cdr (rudel-backend-choose + 'protocol + (lambda (backend) + (rudel-capable-of-p backend 'host))))) + (info (rudel-ask-host-info backend)) + (server)) + + ;; Try to create the server + (condition-case error-data + (setq server (rudel-host backend info)) + ('error + (error "Could not host session using backend `%s' with %s: %s" + (object-name-string backend) + info + (car error-data)))) + server)) + +;;;###autoload +(defun rudel-end-session () + "End the current collaborative editing session." + (interactive) + (unless rudel-current-session + (error "No active Rudel session")) + + ;; Actually end the session. + (rudel-end rudel-current-session) + ) + +;;;###autoload +(defun rudel-change-color () + "Change the color associated with the local user. +Not all backends support this operation." + (interactive) + ;; Make sure we have a session. + (unless rudel-current-session + (error "No active Rudel session")) + + (with-slots (backend connection self) rudel-current-session + ;; Make sure the backend can change colors. + (unless (rudel-capable-of-p backend 'change-color) + (error "Backend `%s' cannot change colors" + (object-name-string backend))) + + (with-slots ((name :object-name) color) self + ;; Ask the user for a new color. + (setq color (read-color "New Color: " t)) + + ;; Tell the connection to announce the change and change it in + ;; our user object. + (rudel-change-color- connection color) + + ;; Run the change hook. + (object-run-hook-with-args self 'change-hook) + + ;; Update overlay color. + (rudel-overlay-set-face-attributes + (rudel-overlay-make-face-symbol 'author name) + color))) + ) + +;;;###autoload +(defun rudel-subscribe (document) + "Subscribe to DOCUMENT offered by a peer in a collaborative editing session. +When called interactively, DOCUMENT is prompted for interactively." + (interactive + (list (progn + ;; We have to retrieve the document list from an active + ;; session. + (unless rudel-current-session + (error "No active Rudel session")) + ;; Select unsubscribed documents. + (let ((documents (rudel-unsubscribed-documents + rudel-current-session))) + ;; Already subscribed to all documents. This is an error. + (when (null documents) + (error "No unsubscribed documents")) + ;; Read an unsubscribed document. + (rudel-read-document documents nil 'object))))) + + ;; Make sure we have a session. + (unless rudel-current-session + (error "No active Rudel session")) + + ;; Create a new buffer and attach the document to it. + (let* ((name (rudel-suggested-buffer-name document)) + (buffer (funcall rudel-allocate-buffer-function name))) + (rudel-attach-to-buffer document buffer) + + (let ((connection (oref (oref document :session) :connection))) + (rudel-subscribe-to connection document)) + + ;; Show the new buffer. + (set-window-buffer nil buffer)) + ) + +;;;###autoload +(defun rudel-publish-buffer (&optional buffer) + "Make the BUFFER available for subscription to peers in a collaborative editing session. +If BUFFER is nil, the current buffer is used." + (interactive (list nil)) + + ;; Make sure we have a session. + (unless rudel-current-session + (error "No active Rudel session")) + + (unless buffer + (setq buffer (current-buffer))) + + (with-current-buffer buffer + (when (rudel-buffer-has-document-p) + (error "Buffer already published or subscribed"))) ; TODO keep this? + + ;; + (with-slots (backend connection self) rudel-current-session + (let ((document (rudel-make-document backend + (buffer-name buffer) + rudel-current-session))) + (rudel-add-document rudel-current-session document) + + (rudel-attach-to-buffer document buffer) + (object-add-to-list document :subscribed self) + + (rudel-publish connection document))) + ) + +;;;###autoload +(defun rudel-unpublish-buffer (&optional buffer) + "Deny peers access to BUFFER in a collaborative editing session. +If BUFFER is nil, the current is used." + (interactive) + + ;; Make sure we have a session. + (unless rudel-current-session + (error "No active Rudel session")) + + (unless buffer + (setq buffer (current-buffer))) + + (with-current-buffer buffer + (unless (rudel-buffer-has-document-p) + (error "Buffer is not published"))) + + ;; + (with-slots (connection) rudel-current-session + (let ((document (rudel-buffer-document buffer))) + (rudel-detach-from-buffer document) + + (rudel-unsubscribe-from connection document))) + ) + +(provide 'rudel) +;;; rudel.el ends here |