;;; rudel-interactive.el --- User interaction functions for Rudel.
;;
;; Copyright (C) 2008, 2009 Jan Moringen
;;
;; Author: Jan Moringen <scymtym@users.sourceforge.net>
;; Keywords: Rudel, user, interface, interaction
;; 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:
;;
;; Functions for user interactions commonly used in Rudel components.
;;; History:
;;
;; 0.1 - Initial revision.
;;; Code:
;;
(require 'rudel-compat) ;; for `read-color' replacement
;;; Function for reading Rudel objects from the user.
;;
(defun rudel-read-backend (backends &optional prompt return)
"Read a backend name from BACKENDS and return that name or the actual backend depending on RETURN.
If RETURN is 'object, return the backend object which is of the
form (NAME . CLASS-OR-OBJECT); Otherwise return the name as
string."
(unless prompt
(setq prompt "Backend: "))
(let* ((backend-names (mapcar (lambda (cell)
(symbol-name (car cell)))
backends))
(backend-name (completing-read prompt backend-names nil t)))
(cond
((eq return 'object)
(assoc (intern backend-name) backends))
(t backend-name)))
)
(defun rudel-read-session (sessions &optional prompt return)
"Read a session name from SESSIONS and return that name or the session info depending on RETURN.
If PROMPT is non-nil use as prompt string.
If RETURN is 'object, return the session object; Otherwise return
the name as string."
(unless prompt
(setq prompt "Session: "))
;; For presentation and identification of sessions, use the :name
;; property.
(flet ((to-string (session)
(if (rudel-backend-cons-p session)
(symbol-name (car session))
(plist-get session :name))))
;; Read a session by name, then return that name or the
;; corresponding session info.
(let ((session-name (completing-read prompt
(mapcar #'to-string sessions)
nil t)))
(cond
((eq return 'object)
(find session-name sessions
:key #'to-string :test #'string=))
(t session-name))))
)
(defun rudel-read-user-name ()
"Read a username.
The default is taken from `rudel-default-username'."
(read-string "Username: " rudel-default-username))
(defun rudel-read-user-color ()
"Read a color."
(read-color "Color: " t))
(defun rudel-read-user (&optional users prompt return)
"Read a user name from USERS and return that name or the actual user depending on RETURN.
If USERS is nil, use the user list of `rudel-current-session'.
If RETURN. is 'object, return the user object; Otherwise return
the name as string."
;; If no user list is provided, the user list of the current session
;; is used.
(unless users
(if rudel-current-session
(setq users (oref rudel-current-session :users))
(error "No user list and no active Rudel session")))
(unless prompt
(setq prompt "User: "))
;; Construct a list of user name, read a name with completion and
;; return a user name of object.
(let* ((user-names (mapcar 'object-name-string users))
(user-name (completing-read prompt user-names nil t)))
(cond
((eq return 'object)
(find user-name users
:test 'string= :key 'object-name-string))
(t user-name)))
)
(defun rudel-read-document (&optional documents prompt return)
"Read a document name from DOCUMENTS and return that name or the actual document depending on RETURN.
If RETURN. is 'object, return the backend object; Otherwise
return the name as string."
(unless documents
(if rudel-current-session
(setq documents (oref rudel-current-session :documents))
(error "No document list and no active Rudel session")))
(unless documents
(error "No documents")) ; TODO error is a bit harsh
(unless prompt
(setq prompt "Document: "))
;; Construct list of names, read one name and return that name or
;; the named object.
(let* ((document-names (mapcar #'rudel-unique-name documents))
(document-name (completing-read prompt document-names nil t)))
(cond
((eq return 'object)
(find document-name documents
:test #'string= :key #'rudel-unique-name))
(t document-name)))
)
;;; Buffer allocation functions
;;
(defun rudel-allocate-buffer-clear-existing (name)
"When the requested buffer NAME exists, clear its contents and use it."
(let ((buffer (get-buffer name)))
(if buffer
(progn
;; Ask the user whether it is OK to erase the contents of
;; the buffer.
(unless (yes-or-no-p (format
"Buffer `%s' already exists; Erase contents? "
name))
(error "Buffer `%s' already exists" name)) ;; TODO throw or signal; not error
;; When the buffer is attached to a different document, ask
;; whether it is OK to detach the buffer.
(let ((document (rudel-buffer-document buffer)))
(unless (or (not document)
(yes-or-no-p (format
"Buffer `%s' is attached to the document `%s'; Detach? "
name
(rudel-unique-name document))))
(error "Buffer `%s' already attached to a document" name)))
;; Delete buffer contents; maybe detach buffer first.
(when (rudel-buffer-has-document-p buffer)
(rudel-unpublish-buffer buffer))
(with-current-buffer buffer
(erase-buffer)))
(setq buffer (get-buffer-create name)))
buffer)
)
(defun rudel-allocate-buffer-make-unique (name)
"When the requested buffer NAME exists, create another buffer."
(get-buffer-create (generate-new-buffer-name name)))
(provide 'rudel-interactive)
;;; rudel-interactive.el ends here
