From 49e8aa338fad7eefdc9750a6e96bf9ee89d60790 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 23 May 2004 01:06:52 +0000 Subject: [PATCH] Synch to No Gnus 200405230007. --- ChangeLog | 4 + etc/gnus/news-server.ast | 14 ++ lisp/ChangeLog | 31 ++++ lisp/assistant.el | 370 ++++++++++++++++++++++++++++++++++++++++++++++ lisp/dns.el | 23 ++- lisp/gnus-registry.el | 2 +- lisp/gnus-start.el | 6 +- lisp/gnus-sum.el | 2 +- lisp/gnus-topic.el | 8 +- lisp/gnus-util.el | 4 + lisp/gnus-uu.el | 2 +- 11 files changed, 456 insertions(+), 10 deletions(-) create mode 100644 etc/gnus/news-server.ast create mode 100644 lisp/assistant.el diff --git a/ChangeLog b/ChangeLog index befa62e..80e8bc7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2004-05-23 Lars Magne Ingebrigtsen + + * etc/gnus/news-server.ast: Use library validation. + 2004-05-21 Katsumi Yamaoka * lisp/nnheader.el (mm-disable-multibyte): New function. diff --git a/etc/gnus/news-server.ast b/etc/gnus/news-server.ast new file mode 100644 index 0000000..b62d134 --- /dev/null +++ b/etc/gnus/news-server.ast @@ -0,0 +1,14 @@ +@title Configuring Gnus for reading news +@node Setting up the news server name and port number +@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) +@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. + +As a guess, the name of the server might be news.yourisp.com. + +The server name is @variable{server}; port number @variable{port}. +@end text diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 99df78f..1a055d7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2004-05-23 Lars Magne Ingebrigtsen + + * assistant.el (wid-edit): Fix compilation. + + * gnus-util.el (gnus-set-file-modes): Just ignore errors. + +2004-05-23 Paul Stodghill + + * gnus-util.el (gnus-set-file-modes): New function. (small + patch). + +2004-05-23 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-jump-to-topic): Goto missing topic. + + * assistant.el (assistant-render-node): Fix up rendering and + read-only text. + (assistant-render-node): Reset. + (assistant-make-read-only): Not sticky. + +2004-05-20 Danny Siu + + * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto + centered even when gnus-auto-center-summary is t + +2004-05-22 Lars Magne Ingebrigtsen + + * dns.el (dns-get-txt-answer): New function. + (dns-read-txt): Ditto. + (query-dns): Use it. + 2004-05-21 Katsumi Yamaoka * gnus-start.el (gnus-get-unread-articles): Don't invalidate diff --git a/lisp/assistant.el b/lisp/assistant.el new file mode 100644 index 0000000..92882bc --- /dev/null +++ b/lisp/assistant.el @@ -0,0 +1,370 @@ +;;; assistant.el --- guiding users through Emacs setup +;; Copyright (C) 2004 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 2, 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'widget) +(require 'wid-edit) + +(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-face '((t (:bold t))) + "Face used for editable fields." + :group 'gnus-article-emphasis) + +;;; Internal variables + +(defvar assistant-data nil) +(defvar assistant-current-node nil) +(defvar assistant-previous-node 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) (line-end-position)) + (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) first-node) + (set (make-local-variable 'assistant-previous-node) 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-previous-node-text (node) + (format "[ << Go back to %s ] " node)) + +(defun assistant-next-node-text (node) + (if node + (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) + (eval (nth 2 variable)))))) + +(defun assistant-get-variable (node variable) + (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)) + (setq result (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) + (dolist (elem text) + (if (stringp elem) + (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)))))) + +(defun assistant-render-node (node-name) + (let ((node (assistant-find-node node-name)) + (inhibit-read-only t) + (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))) + +(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))) + (when (eq type 'next) + (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 node)) + (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)) + (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) + (let ((bindings nil)) + (dolist (variable (assistant-get-list node "variable")) + (setq variable (cadr variable)) + (push (list (car 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) node)) + 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))) + +(provide 'assistant) + +;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b +;;; assistant.el ends here diff --git a/lisp/dns.el b/lisp/dns.el index 900faa1..bddfe02 100644 --- a/lisp/dns.el +++ b/lisp/dns.el @@ -306,6 +306,25 @@ If TCP-P, the first two bytes of the package with be the length field." (push (match-string 1) dns-servers)) (setq dns-servers (nreverse dns-servers))))) +(defun dns-read-txt (string) + (if (> (length string) 1) + (substring string 1) + string)) + +(defun dns-get-txt-answer (answers) + (let ((result "") + (do-next nil)) + (dolist (answer answers) + (dolist (elem answer) + (when (consp elem) + (cond + ((eq (car elem) 'type) + (setq do-next (eq (cadr elem) 'TXT))) + ((eq (car elem) 'data) + (when do-next + (setq result (concat result (dns-read-txt (cadr elem)))))))))) + result)) + ;;; Interface functions. (defmacro dns-make-network-process (server) (if (featurep 'xemacs) @@ -375,7 +394,9 @@ If FULLP, return the entire record returned." result (let ((answer (car (dns-get 'answers result)))) (when (eq type (dns-get 'type answer)) - (dns-get 'data answer))))))))))) + (if (eq type 'TXT) + (dns-get-txt-answer (dns-get 'answers result)) + (dns-get 'data answer)))))))))))) (provide 'dns) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index a84ea83..5e8415f 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -202,7 +202,7 @@ way." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index d4795dc..ef80dd6 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -897,7 +897,7 @@ prompt the user for the name of an NNTP server to use." (when (and (file-exists-p gnus-current-startup-file) (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) + (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) (setq purpose t)) @@ -2859,7 +2859,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -3089,7 +3089,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system slave-name) (when modes - (set-file-modes slave-name modes))))) + (gnus-set-file-modes slave-name modes))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 4d6c0b1..aa174eb 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -6307,7 +6307,7 @@ displayed, no centering will be performed." ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) gnus-auto-center-summary - 2)))) + (/ (1- (window-height)) 2))))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index f16d899..f0d040f 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -166,9 +166,11 @@ See Info node `(gnus)Formatting Variables'." (list (completing-read "Go to topic: " (mapcar 'list (gnus-topic-list)) nil t))) - (dolist (topic (gnus-current-topics topic)) - (gnus-topic-goto-topic topic) - (gnus-topic-fold t)) + (let ((buffer-read-only nil)) + (dolist (topic (gnus-current-topics topic)) + (unless (gnus-topic-goto-topic topic) + (gnus-topic-goto-missing-topic topic) + (gnus-topic-display-missing-topic topic)))) (gnus-topic-goto-topic topic)) (defun gnus-current-topic () diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index b77af79..f3ff20d 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1497,6 +1497,10 @@ empty directories from OLD-PATH." (file-truename (concat old-dir ".."))))))))) +(defun gnus-set-file-modes (filename mode) + "Wrapper for set-file-modes." + (ignore-errors + (set-file-modes filename mode))) (provide 'gnus-util) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 9b9f87e..82e1381 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1730,7 +1730,7 @@ Gnus might fail to display all of it.") (setq gnus-uu-work-dir (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) - (set-file-modes gnus-uu-work-dir 448) + (gnus-set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) gnus-uu-tmp-alist)))) -- 1.7.10.4