X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fassistant.el;h=93d72193f4199efe7ddefc0e43acb6838ca013d1;hp=68c6baf02167113b1de1fc6e1cdfd86f33952999;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=6d3f1e4e283dfdb7897dee910eeae749ff2dd816 diff --git a/lisp/assistant.el b/lisp/assistant.el index 68c6baf02..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,9 +41,11 @@ ("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 @@ -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)) @@ -170,6 +175,9 @@ (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)) @@ -200,7 +208,7 @@ (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) @@ -208,8 +216,12 @@ (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 @@ -258,31 +270,31 @@ (cadr type)) assistant-widgets)) (t - (push + (push (widget-create 'editable-field - :value-face 'assistant-field-face + :value-face 'assistant-field :assistant-variable variable (assistant-get-variable node variable)) 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)))))))) + (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) (if (equal (assistant-get node "type") "interstitial") - (assistant-render-node (assistant-find-next-node node-name)) + (assistant-render-node (nth 0 (assistant-find-next-nodes node-name))) (setq assistant-current-node node-name) (when previous (push previous assistant-previous-nodes)) @@ -301,9 +313,11 @@ (assistant-set-defaults (assistant-find-node node) 'force) (assistant-render-node node))) "Reset") - (insert " ") - (assistant-node-button 'next (assistant-find-next-node)) (insert "\n") + (dolist (nnode (assistant-find-next-nodes)) + (assistant-node-button 'next nnode) + (insert "\n")) + (goto-char (point-min)) (assistant-make-read-only)))) @@ -346,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)) @@ -373,15 +387,34 @@ (error "%s" result)))) (assistant-set node "save" t))) -(defun assistant-find-next-node (&optional 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 (setq next (assistant-eval (car elem))) - (setq next (or (cadr elem) next)))) - 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)) @@ -390,12 +423,12 @@ (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) + (push (list (car variable) (if (eq (nth 3 variable) 'default) nil (if (listp (nth 3 variable)) @@ -446,5 +479,4 @@ (provide 'assistant) -;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b ;;; assistant.el ends here