X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fassistant.el;h=dd715974c4f659b327c11116f9b2dfee2ee531bf;hp=5b42c373942573b7f168afc87f4bcd570d76e7c1;hb=HEAD;hpb=b16d4702e29c76b8b885a7f6f420dfd67443eeba diff --git a/lisp/assistant.el b/lisp/assistant.el index 5b42c3739..dd715974c 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: @@ -28,6 +26,14 @@ (eval-when-compile (require 'cl)) +(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) @@ -35,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 () @@ -67,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)) @@ -142,6 +150,7 @@ (push elem result))) (nreverse result))) +;;;###autoload (defun assistant (file) "Assist setting up Emacs based on FILE." (interactive "fAssistant file name: ") @@ -155,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) @@ -166,64 +175,162 @@ (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 - (format "[ Proceed to %s >> ]" node) - "[ Finish ]")) + (if (and node + (not (eq node 'finish))) + (format "Proceed to %s >>" node) + "Finish")) -(defun assistant-set-defaults (node) +(defun assistant-set-defaults (node &optional forcep) (dolist (variable (assistant-get-list node "variable")) (setq variable (cadr variable)) - (when (eq (nth 3 variable) 'default) + (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)) + (result nil) + elem) (while (and (setq elem (pop variables)) (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"))) + (let ((variables (assistant-get-list node "variable")) + elem) (while (setq elem (pop variables)) (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) - (push - (widget-create - 'editable-field - :value-face 'assistant-field-face - :assistant-variable (cadr elem) - (assistant-get-variable node (cadr elem))) - assistant-widgets)))) + ;; 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))) + (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)) - (assistant-node-button 'next (assistant-find-next-node)) - (insert "\n"))) + (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)) + end) + (while (setq end (text-property-any start (point-max) 'not-read-only t)) + (put-text-property start end 'read-only t) + (put-text-property start end 'rear-nonsticky t) + (while (get-text-property end 'not-read-only) + (incf end)) + (setq start end)) + (put-text-property start (point-max) 'read-only t))) (defun assistant-node-button (type node) (let ((text (if (eq type 'next) @@ -236,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) @@ -250,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)) @@ -272,26 +382,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 (pop nexts)) - (not next)) - (when (assistant-eval (car elem) node) - (setq next (cadr elem)))) - next)) - -(defun assistant-eval (form node) + 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 @@ -304,11 +446,37 @@ (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)))) +;;; Validation functions. + +(defun assistant-validate-connect-to-server (server port) + (let* ((error nil) + (stream + (condition-case err + (open-network-stream "nntpd" nil server port) + (error (setq error err))))) + (if (and (processp stream) + (memq (process-status stream) '(open run))) + (progn + (delete-process stream) + 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) ;;; assistant.el ends here