aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/gnus/ChangeLog4
-rw-r--r--lisp/gnus/assistant.el487
2 files changed, 4 insertions, 487 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ab60b4e3a4..9b9f026f27 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
+2007-11-17 Richard Stallman <[email protected]>
+
+ * assistant.el: Remove file.
+
2007-11-16 Dan Nicolaescu <[email protected]>
* smime.el (from):
diff --git a/lisp/gnus/assistant.el b/lisp/gnus/assistant.el
deleted file mode 100644
index 25ff1732f8..0000000000
--- a/lisp/gnus/assistant.el
+++ /dev/null
@@ -1,487 +0,0 @@
-;;; assistant.el --- guiding users through Emacs setup
-;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: util
-
-;; This file is part of GNU Emacs.
-
-;; 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 3, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(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)
- ("result" assistant-list-reader)
- ("next" assistant-list-reader)
- ("text" assistant-text-reader)))
-
-(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-nodes nil)
-(defvar assistant-widgets nil)
-
-(defun assistant-parse-buffer ()
- (let (results command value)
- (goto-char (point-min))
- (while (search-forward "@" nil t)
- (if (not (looking-at "[^ \t\n]+"))
- (error "Dangling @")
- (setq command (downcase (match-string 0)))
- (goto-char (match-end 0)))
- (setq value
- (if (looking-at "[ \t]*\n")
- (let (start)
- (forward-line 1)
- (setq start (point))
- (unless (re-search-forward (concat "^@end " command) nil t)
- (error "No @end %s found" command))
- (beginning-of-line)
- (prog1
- (buffer-substring start (point))
- (forward-line 1)))
- (skip-chars-forward " \t")
- (prog1
- (buffer-substring (point) (point-at-eol))
- (forward-line 1))))
- (push (list command (assistant-reader command value))
- results))
- (assistant-segment (nreverse results))))
-
-(defun assistant-text-reader (text)
- (with-temp-buffer
- (insert text)
- (goto-char (point-min))
- (let ((start (point))
- (sections nil))
- (while (re-search-forward "@\\([^{]+\\){\\([^}]+\\)}" nil t)
- (push (buffer-substring start (match-beginning 0))
- sections)
- (push (list (match-string 1) (match-string 2))
- sections)
- (setq start (point)))
- (push (buffer-substring start (point-max))
- sections)
- (nreverse sections))))
-
-;; Segment the raw assistant data into a list of nodes.
-(defun assistant-segment (list)
- (let ((ast nil)
- (node nil)
- (title (pop list)))
- (dolist (elem list)
- (when (and (equal (car elem) "node")
- node)
- (push (list "save" nil) node)
- (push (nreverse node) ast)
- (setq node nil))
- (push elem node))
- (when node
- (push (list "save" nil) node)
- (push (nreverse node) ast))
- (cons title (nreverse ast))))
-
-(defun assistant-reader (command value)
- (let ((formatter (cadr (assoc command assistant-readers))))
- (if (not formatter)
- value
- (funcall formatter value))))
-
-(defun assistant-list-reader (value)
- (car (read-from-string (concat "(" value ")"))))
-
-(defun assistant-variable-reader (value)
- (let ((section (car (read-from-string (concat "(" value ")")))))
- (append section (list 'default))))
-
-(defun assistant-sexp-reader (value)
- (if (zerop (length value))
- nil
- (car (read-from-string value))))
-
-(defun assistant-buffer-name (title)
- (format "*Assistant %s*" title))
-
-(defun assistant-get (ast command)
- (cadr (assoc command ast)))
-
-(defun assistant-set (ast command value)
- (let ((elem (assoc command ast)))
- (when elem
- (setcar (cdr elem) value))))
-
-(defun assistant-get-list (ast command)
- (let ((result nil))
- (dolist (elem ast)
- (when (equal (car elem) command)
- (push elem result)))
- (nreverse result)))
-
-;;;###autoload
-(defun assistant (file)
- "Assist setting up Emacs based on FILE."
- (interactive "fAssistant file name: ")
- (let ((ast
- (with-temp-buffer
- (insert-file-contents file)
- (assistant-parse-buffer))))
- (pop-to-buffer (assistant-buffer-name (assistant-get ast "title")))
- (assistant-render ast)))
-
-(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) nil)
- (set (make-local-variable 'assistant-previous-nodes) nil)
- (assistant-render-node first-node)))
-
-(defun assistant-find-node (node-name)
- (let ((ast (cdr assistant-data)))
- (while (and ast
- (not (string= node-name (assistant-get (car ast) "node"))))
- (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))
-
-(defun assistant-next-node-text (node)
- (if (and node
- (not (eq node 'finish)))
- (format "Proceed to %s >>" node)
- "Finish"))
-
-(defun assistant-set-defaults (node &optional forcep)
- (dolist (variable (assistant-get-list node "variable"))
- (setq variable (cadr variable))
- (when (or (eq (nth 3 variable) 'default)
- forcep)
- (setcar (nthcdr 3 variable)
- (assistant-eval (nth 2 variable))))))
-
-(defun assistant-get-variable (node variable &optional type raw)
- (let ((variables (assistant-get-list node "variable"))
- (result nil)
- elem)
- (while (and (setq elem (pop variables))
- (not result))
- (setq elem (cadr elem))
- (when (eq (intern variable) (car 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)
- (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)
- ;; 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)
- ;; The editable-field widget apparently inserts a newline;
- ;; remove it.
- (delete-char -1)
- (add-text-properties start (point)
- (list
- 'bold t
- 'face 'assistant-field
- '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))
- (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 (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)
- (assistant-next-node-text node)
- (assistant-previous-node-text node))))
- (widget-create
- 'push-button
- :assistant-node node
- :assistant-type type
- :notify (lambda (widget &rest ignore)
- (let* ((node (widget-get widget :assistant-node))
- (type (widget-get widget :assistant-type)))
- (if (eq type 'previous)
- (progn
- (setq assistant-current-node nil)
- (pop assistant-previous-nodes))
- (assistant-get-widget-values)
- (assistant-validate))
- (if (null node)
- (assistant-finish)
- (assistant-render-node node))))
- text)
- (use-local-map widget-keymap)))
-
-(defun assistant-validate-types (node)
- (dolist (variable (assistant-get-list node "variable"))
- (setq variable (cadr variable))
- (let ((type (nth 1 variable))
- (value (nth 3 variable)))
- (when
- (cond
- ((eq type :number)
- (string-match "[^0-9]" value))
- (t
- nil))
- (error "%s is not of type %s: %s"
- (car variable) type value)))))
-
-(defun assistant-get-widget-values ()
- (let ((node (assistant-find-node assistant-current-node)))
- (dolist (widget assistant-widgets)
- (assistant-set-variable
- node (widget-get widget :assistant-variable)
- (widget-value widget)))))
-
-(defun assistant-validate ()
- (let* ((node (assistant-find-node assistant-current-node))
- (validation (assistant-get node "validate"))
- result)
- (assistant-validate-types node)
- (when validation
- (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 (&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 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-all-variables))
- (setq variable (cadr 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
- ,form))))
-
-(defun assistant-finish ()
- (let ((results nil)
- result)
- (dolist (node (cdr assistant-data))
- (when (assistant-get node "save")
- (setq result (assistant-get node "result"))
- (push (list (car result)
- (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)
-
-;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b
-;;; assistant.el ends here