X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fassistant.el;h=364c556ecf5d0537ee216aef2d727c6e32f449cf;hp=1bdb7483dd1211ef47de9d2f7d6e420d20a82216;hb=d84b26f66f1975b52a15ca2caf5f10da5103e42e;hpb=1350df131b329af70fa5af898af627b6470d40f8 diff --git a/lisp/assistant.el b/lisp/assistant.el index 1bdb7483d..364c556ec 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, @@ -18,8 +18,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -31,6 +31,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 +43,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 +77,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 +166,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 +177,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")) @@ -184,9 +195,9 @@ (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) @@ -194,9 +205,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 +218,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 +345,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 +362,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)) @@ -312,26 +384,58 @@ 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 @@ -344,7 +448,7 @@ (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)))) @@ -364,7 +468,17 @@ nil) error))) +(defun assistant-authinfo-data (server port type) + (when (file-exists-p "~/.authinfo") + (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