From: yamaoka <yamaoka>
Date: Sun, 23 May 2004 22:47:45 +0000 (+0000)
Subject: Synch to No Gnus 200405232218.
X-Git-Tag: t-gnus-6_17_4-quimby-~903
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f292345837f5ec1a8bbc18900eaa052b24acd3e4;p=elisp%2Fgnus.git-

Synch to No Gnus 200405232218.
---

diff --git a/etc/gnus/news-server.ast b/etc/gnus/news-server.ast
index dd98c12..d607be5 100644
--- a/etc/gnus/news-server.ast
+++ b/etc/gnus/news-server.ast
@@ -5,7 +5,7 @@
 @variable server :string (gnus-getenv-nntpserver)
 @variable port :number 119
 @validate (assistant-validate-connect-to-server server port)
-@result gnus-select-method (list server port)
+@result gnus-select-method (list 'nntp server (list 'nntp-server port))
 @text
 Usenet news is usually read from your Internet service prodider's news
 server.  If you don't know the name of this server, contact your ISP.
@@ -17,21 +17,42 @@ Port number: @variable{port}
 @end text
 @next t "User name and password"
 
+
 @node User name and password
+@type interstitial
+@next 
+(if (assistant-password-required-p)
+    "Enter user name and password"
+  "Want user name and password?")
+@end next
+
+
+@node Want user name and password?
+@variable passwordp (:radio ((item "Yes") (item "No"))) "No"
+@text
+Some news servers require that you enter a user name and a password.
+It doesn't look like your news server is one of them.
+
+Do you want to enter user name and password anyway?
+
+@variable{passwordp}
+
+@end text
+
+@next (equal passwordp "No") finish
+@next (not (equal passwordp "No")) "Enter user name and password"
+
+
+@node Enter user name and password
 @variable user-name :string (user-login-name)
 @variable password :password (or (assistant-authinfo-data server port 'password) "")
-@validate "... lots of code ..."
-@result ... er... put stuff in .authinfo, I guess
 @text
-Some news servers require that you enter a user name and
-a password.
 
-@if (password-required-p)
-It looks like your news server is one of those.
-@else
-It doesn't look like your news server requires passwords.
-@endif
+It looks like your news server requires you to enter a user name
+and a password:
 
 User name: @variable{user-name}
-Password: @variable{password}
+Password: @variable{user-name}
+
 @end text
+
diff --git a/lisp/assistant.el b/lisp/assistant.el
index 176d29d..e31a139 100644
--- a/lisp/assistant.el
+++ b/lisp/assistant.el
@@ -46,7 +46,7 @@
 
 (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 ()
@@ -159,8 +159,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)
@@ -171,10 +171,11 @@
     (car ast)))
 
 (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 +187,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,7 +195,10 @@
 		(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)
@@ -208,51 +212,82 @@
 (defun assistant-render-text (text node)
   (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
+	 ((and (consp type)
+	       (eq (car 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))
+	 (t
+	  (push 
+	   (widget-create
+	    'editable-field
+	    :value-face 'assistant-field-face
+	    :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))))))))
 
 (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))
     (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 (assistant-find-next-node 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 " ")
+      (assistant-node-button 'next (assistant-find-next-node))
+      (insert "\n")
+      (goto-char (point-min))
+      (assistant-make-read-only))))
 
 (defun assistant-make-read-only ()
   (let ((start (point-min))
@@ -276,7 +311,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)
@@ -317,14 +355,14 @@
 	  (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)))
 	 (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))))
+      (when (setq next (assistant-eval (car elem)))
+	(setq next (or (cadr elem) next))))
     next))
 
 (defun assistant-get-all-variables ()
@@ -382,6 +420,9 @@
 		   "login"
 		 "password"))))
 
+(defun assistant-password-required-p ()
+  nil)
+
 (provide 'assistant)
 
 ;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b