X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fassistant.el;h=93d72193f4199efe7ddefc0e43acb6838ca013d1;hp=176d29db1114a43d68e6c7f36851cf25d693ef66;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=4ed551816b5b47d86b5704f90536a49901d00a37 diff --git a/lisp/assistant.el b/lisp/assistant.el index 176d29db1..93d72193f 100644 --- a/lisp/assistant.el +++ b/lisp/assistant.el @@ -1,5 +1,5 @@ ;;; 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 ;; Keywords: util @@ -8,7 +8,7 @@ ;; 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, @@ -17,9 +17,7 @@ ;; 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 . ;;; Commentary: @@ -31,6 +29,11 @@ (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) @@ -38,15 +41,17 @@ ("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 () @@ -70,7 +75,7 @@ (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)) @@ -159,8 +164,8 @@ (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) @@ -170,11 +175,15 @@ (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")) @@ -186,7 +195,7 @@ (setcar (nthcdr 3 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) @@ -194,9 +203,12 @@ (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) @@ -204,55 +216,110 @@ (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)) @@ -276,7 +343,10 @@ :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) @@ -290,7 +360,7 @@ (setq variable (cadr variable)) (let ((type (nth 1 variable)) (value (nth 3 variable))) - (when + (when (cond ((eq type :number) (string-match "[^0-9]" value)) @@ -317,15 +387,34 @@ (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)) - (setq next (cadr elem)))) - next)) + 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)) @@ -334,14 +423,17 @@ (append (assistant-get-list node "variable") variables))) variables)) - + (defun assistant-eval (form) (let ((bindings nil)) (dolist (variable (assistant-get-all-variables)) (setq variable (cadr variable)) - (push (list (car variable) (if (eq (nth 3 variable) 'default) - nil - (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 @@ -382,7 +474,9 @@ "login" "password")))) +(defun assistant-password-required-p () + nil) + (provide 'assistant) -;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b ;;; assistant.el ends here