;;; assistant.el --- guiding users through Emacs setup
-;; Copyright (C) 2004 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: util
;; GNU Emacs 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'widget)
(require 'wid-edit)
+(autoload 'gnus-error "gnus-util")
+(autoload 'netrc-get "netrc")
+(autoload 'netrc-machine "netrc")
+(autoload 'netrc-parse "netrc")
+
(defvar assistant-readers
'(("variable" assistant-variable-reader)
("validate" assistant-sexp-reader)
("next" assistant-list-reader)
("text" assistant-text-reader)))
-(defface assistant-field-face '((t (:bold t)))
+(defface assistant-field '((t (:bold t)))
"Face used for editable fields."
:group 'gnus-article-emphasis)
+;; backward-compatibility alias
+(put 'assistant-field-face 'face-alias 'assistant-field)
;;; Internal variables
(defvar assistant-data nil)
(defvar assistant-current-node nil)
-(defvar assistant-previous-node nil)
+(defvar assistant-previous-nodes nil)
(defvar assistant-widgets nil)
(defun assistant-parse-buffer ()
(forward-line 1)))
(skip-chars-forward " \t")
(prog1
- (buffer-substring (point) (line-end-position))
+ (buffer-substring (point) (point-at-eol))
(forward-line 1))))
(push (list command (assistant-reader command value))
results))
(defun assistant-render (ast)
(let ((first-node (assistant-get (nth 1 ast) "node")))
(set (make-local-variable 'assistant-data) ast)
- (set (make-local-variable 'assistant-current-node) first-node)
- (set (make-local-variable 'assistant-previous-node) nil)
+ (set (make-local-variable 'assistant-current-node) nil)
+ (set (make-local-variable 'assistant-previous-nodes) nil)
(assistant-render-node first-node)))
(defun assistant-find-node (node-name)
(pop ast))
(car ast)))
+(defun assistant-node-name (node)
+ (assistant-get node "node"))
+
(defun assistant-previous-node-text (node)
- (format "[ << Go back to %s ] " node))
+ (format "<< Go back to %s" node))
(defun assistant-next-node-text (node)
- (if node
+ (if (and node
+ (not (eq node 'finish)))
(format "Proceed to %s >>" node)
"Finish"))
(when (or (eq (nth 3 variable) 'default)
forcep)
(setcar (nthcdr 3 variable)
- (eval (nth 2 variable))))))
+ (assistant-eval (nth 2 variable))))))
-(defun assistant-get-variable (node variable)
+(defun assistant-get-variable (node variable &optional type raw)
(let ((variables (assistant-get-list node "variable"))
(result nil)
elem)
(not result))
(setq elem (cadr elem))
(when (eq (intern variable) (car elem))
- (setq result (format "%s" (nth 3 elem)))))
+ (if type
+ (setq result (nth 1 elem))
+ (setq result (if raw (nth 3 elem)
+ (format "%s" (nth 3 elem)))))))
result))
-
+
(defun assistant-set-variable (node variable value)
(let ((variables (assistant-get-list node "variable"))
elem)
(setq elem (cadr elem))
(when (eq (intern variable) (car elem))
(setcar (nthcdr 3 elem) value)))))
-
+
(defun assistant-render-text (text node)
+ (unless (and text node)
+ (gnus-error
+ 5
+ "The assistant was asked to render invalid text or node data"))
(dolist (elem text)
(if (stringp elem)
+ ;; Ordinary text
(insert elem)
- (let ((start (point)))
- (push
- (widget-create
- 'editable-field
- :value-face 'assistant-field-face
- :assistant-variable (cadr elem)
- (assistant-get-variable node (cadr elem)))
- assistant-widgets)
- ;; The editable-field widget apparently inserts a newline;
- ;; remove it.
- (delete-char -1)
- (add-text-properties start (point)
- (list
- 'bold t
- 'face 'assistant-field-face
- 'not-read-only t))))))
+ ;; A variable to be inserted as a widget.
+ (let* ((start (point))
+ (variable (cadr elem))
+ (type (assistant-get-variable node variable 'type)))
+ (cond
+ ((eq (car-safe type) :radio)
+ (push
+ (apply
+ #'widget-create
+ 'radio-button-choice
+ :assistant-variable variable
+ :assistant-node node
+ :value (assistant-get-variable node variable)
+ :notify (lambda (widget &rest ignore)
+ (assistant-set-variable
+ (widget-get widget :assistant-node)
+ (widget-get widget :assistant-variable)
+ (widget-value widget))
+ (assistant-render-node
+ (assistant-get
+ (widget-get widget :assistant-node)
+ "node")))
+ (cadr type))
+ assistant-widgets))
+ ((eq (car-safe type) :set)
+ (push
+ (apply
+ #'widget-create
+ 'set
+ :assistant-variable variable
+ :assistant-node node
+ :value (assistant-get-variable node variable nil t)
+ :notify (lambda (widget &rest ignore)
+ (assistant-set-variable
+ (widget-get widget :assistant-node)
+ (widget-get widget :assistant-variable)
+ (widget-value widget))
+ (assistant-render-node
+ (assistant-get
+ (widget-get widget :assistant-node)
+ "node")))
+ (cadr type))
+ assistant-widgets))
+ (t
+ (push
+ (widget-create
+ 'editable-field
+ :value-face 'assistant-field
+ :assistant-variable variable
+ (assistant-get-variable node variable))
+ assistant-widgets)
+ (add-text-properties start (point)
+ (list
+ 'bold t
+ 'face 'assistant-field
+ 'not-read-only t)))))))
+ (widget-setup))
(defun assistant-render-node (node-name)
(let ((node (assistant-find-node node-name))
(inhibit-read-only t)
+ (previous assistant-current-node)
(buffer-read-only nil))
+ (unless node
+ (gnus-error 5 "The node for %s could not be found" node-name))
(set (make-local-variable 'assistant-widgets) nil)
(assistant-set-defaults node)
- (setq assistant-current-node node-name)
- (erase-buffer)
- (insert (cadar assistant-data) "\n\n")
- (insert node-name "\n\n")
- (assistant-render-text (assistant-get node "text") node)
- (insert "\n\n")
- (when assistant-previous-node
- (assistant-node-button 'previous assistant-previous-node))
- (widget-create
- 'push-button
- :assistant-node node-name
- :notify (lambda (widget &rest ignore)
- (let* ((node (widget-get widget :assistant-node)))
- (assistant-set-defaults (assistant-find-node node) 'force)
- (assistant-render-node node)))
- "Reset")
- (insert " ")
- (assistant-node-button 'next (assistant-find-next-node))
- (insert "\n")
- (goto-char (point-min))
- (assistant-make-read-only)))
+ (if (equal (assistant-get node "type") "interstitial")
+ (assistant-render-node (nth 0 (assistant-find-next-nodes node-name)))
+ (setq assistant-current-node node-name)
+ (when previous
+ (push previous assistant-previous-nodes))
+ (erase-buffer)
+ (insert (cadar assistant-data) "\n\n")
+ (insert node-name "\n\n")
+ (assistant-render-text (assistant-get node "text") node)
+ (insert "\n\n")
+ (when assistant-previous-nodes
+ (assistant-node-button 'previous (car assistant-previous-nodes)))
+ (widget-create
+ 'push-button
+ :assistant-node node-name
+ :notify (lambda (widget &rest ignore)
+ (let* ((node (widget-get widget :assistant-node)))
+ (assistant-set-defaults (assistant-find-node node) 'force)
+ (assistant-render-node node)))
+ "Reset")
+ (insert "\n")
+ (dolist (nnode (assistant-find-next-nodes))
+ (assistant-node-button 'next nnode)
+ (insert "\n"))
+
+ (goto-char (point-min))
+ (assistant-make-read-only))))
(defun assistant-make-read-only ()
(let ((start (point-min))
:notify (lambda (widget &rest ignore)
(let* ((node (widget-get widget :assistant-node))
(type (widget-get widget :assistant-type)))
- (when (eq type 'next)
+ (if (eq type 'previous)
+ (progn
+ (setq assistant-current-node nil)
+ (pop assistant-previous-nodes))
(assistant-get-widget-values)
(assistant-validate))
(if (null node)
(setq variable (cadr variable))
(let ((type (nth 1 variable))
(value (nth 3 variable)))
- (when
+ (when
(cond
((eq type :number)
(string-match "[^0-9]" value))
result)
(assistant-validate-types node)
(when validation
- (when (setq result (assistant-eval validation node))
+ (when (setq result (assistant-eval validation))
(unless (y-or-n-p (format "Error: %s. Continue? " result))
(error "%s" result))))
(assistant-set node "save" t)))
-(defun assistant-find-next-node ()
- (let* ((node (assistant-find-node assistant-current-node))
+;; (defun assistant-find-next-node (&optional node)
+;; (let* ((node (assistant-find-node (or node assistant-current-node)))
+;; (node-name (assistant-node-name node))
+;; (nexts (assistant-get-list node "next"))
+;; next elem applicable)
+
+;; (while (setq elem (pop nexts))
+;; (when (assistant-eval (car (cadr elem)))
+;; (setq applicable (cons elem applicable))))
+
+;; ;; return the first thing we can
+;; (cadr (cadr (pop applicable)))))
+
+(defun assistant-find-next-nodes (&optional node)
+ (let* ((node (assistant-find-node (or node assistant-current-node)))
(nexts (assistant-get-list node "next"))
- next elem)
- (while (and (setq elem (cadr (pop nexts)))
- (not next))
- (when (assistant-eval (car elem) node)
- (setq next (cadr elem))))
- next))
-
-(defun assistant-eval (form node)
+ next elem applicable return)
+
+ (while (setq elem (pop nexts))
+ (when (assistant-eval (car (cadr elem)))
+ (setq applicable (cons elem applicable))))
+
+ ;; return the first thing we can
+
+ (while (setq elem (pop applicable))
+ (push (cadr (cadr elem)) return))
+
+ return))
+
+(defun assistant-get-all-variables ()
+ (let ((variables nil))
+ (dolist (node (cdr assistant-data))
+ (setq variables
+ (append (assistant-get-list node "variable")
+ variables)))
+ variables))
+
+(defun assistant-eval (form)
(let ((bindings nil))
- (dolist (variable (assistant-get-list node "variable"))
+ (dolist (variable (assistant-get-all-variables))
(setq variable (cadr variable))
- (push (list (car variable) (nth 3 variable))
+ (push (list (car variable)
+ (if (eq (nth 3 variable) 'default)
+ nil
+ (if (listp (nth 3 variable))
+ `(list ,@(nth 3 variable))
+ (nth 3 variable))))
bindings))
(eval
`(let ,bindings
(when (assistant-get node "save")
(setq result (assistant-get node "result"))
(push (list (car result)
- (assistant-eval (cadr result) node))
+ (assistant-eval (cadr result)))
results)))
(message "Results: %s"
(nreverse results))))
(defun assistant-authinfo-data (server port type)
(when (file-exists-p "~/.authinfo")
- (let ((data
- (netrc-machine (netrc-parse "~/.authinfo")
- server port)))
+ (netrc-get (netrc-machine (netrc-parse "~/.authinfo")
+ server port)
+ (if (eq type 'user)
+ "login"
+ "password"))))
+
+(defun assistant-password-required-p ()
+ nil)
(provide 'assistant)
-;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b
;;; assistant.el ends here
projects / gnus / blobdiff