From 7681c1ccce5fa59971d6c4d3943b0d34da39b3c8 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 9 Mar 2001 03:11:06 +0000 Subject: [PATCH] Synch with Oort Gnus. --- contrib/xml.el | 516 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ChangeLog | 4 + lisp/dgnushack.el | 2 +- lisp/gnus.el | 1 + lisp/nnrss.el | 395 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 917 insertions(+), 1 deletion(-) create mode 100644 contrib/xml.el create mode 100644 lisp/nnrss.el diff --git a/contrib/xml.el b/contrib/xml.el new file mode 100644 index 0000000..25851e2 --- /dev/null +++ b/contrib/xml.el @@ -0,0 +1,516 @@ +;; @(#) xml.el --- XML parser + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Emmanuel Briot +;; Maintainer: Emmanuel Briot +;; Keywords: xml + +;; 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: + +;; This file contains a full XML parser. It parses a file, and returns a list +;; that can be used internally by any other lisp file. +;; See some example in todo.el + +;;; FILE FORMAT + +;; It does not parse the DTD, if present in the XML file, but knows how to +;; ignore it. The XML file is assumed to be well-formed. In case of error, the +;; parsing stops and the XML file is shown where the parsing stopped. +;; +;; It also knows how to ignore comments, as well as the special ?xml? tag +;; in the XML file. +;; +;; The XML file should have the following format: +;; value +;; value2 +;; value3 +;; +;; Of course, the name of the nodes and attributes can be anything. There can +;; be any number of attributes (or none), as well as any number of children +;; below the nodes. +;; +;; There can be only top level node, but with any number of children below. + +;;; LIST FORMAT + +;; The functions `xml-parse-file' and `xml-parse-tag' return a list with +;; the following format: +;; +;; xml-list ::= (node node ...) +;; node ::= (tag_name attribute-list . child_node_list) +;; child_node_list ::= child_node child_node ... +;; child_node ::= node | string +;; tag_name ::= string +;; attribute_list ::= (("attribute" . "value") ("attribute" . "value") ...) +;; | nil +;; string ::= "..." +;; +;; Some macros are provided to ease the parsing of this list + +;;; Code: + +;;******************************************************************* +;;** +;;** Macros to parse the list +;;** +;;******************************************************************* + +(defmacro xml-node-name (node) + "Return the tag associated with NODE. +The tag is a lower-case symbol." + (list 'car node)) + +(defmacro xml-node-attributes (node) + "Return the list of attributes of NODE. +The list can be nil." + (list 'nth 1 node)) + +(defmacro xml-node-children (node) + "Return the list of children of NODE. +This is a list of nodes, and it can be nil." + (list 'cddr node)) + +(defun xml-get-children (node child-name) + "Return the children of NODE whose tag is CHILD-NAME. +CHILD-NAME should be a lower case symbol." + (let ((children (xml-node-children node)) + match) + (while children + (if (car children) + (if (equal (xml-node-name (car children)) child-name) + (set 'match (append match (list (car children)))))) + (set 'children (cdr children))) + match)) + +(defun xml-get-attribute (node attribute) + "Get from NODE the value of ATTRIBUTE. +An empty string is returned if the attribute was not found." + (if (xml-node-attributes node) + (let ((value (assoc attribute (xml-node-attributes node)))) + (if value + (cdr value) + "")) + "")) + +;;******************************************************************* +;;** +;;** Creating the list +;;** +;;******************************************************************* + +(defun xml-parse-file (file &optional parse-dtd) + "Parse the well-formed XML FILE. +If FILE is already edited, this will keep the buffer alive. +Returns the top node with all its children. +If PARSE-DTD is non-nil, the DTD is parsed rather than skipped." + (let ((keep)) + (if (get-file-buffer file) + (progn + (set-buffer (get-file-buffer file)) + (setq keep (point))) + (find-file file)) + + (let ((xml (xml-parse-region (point-min) + (point-max) + (current-buffer) + parse-dtd))) + (if keep + (goto-char keep) + (kill-buffer (current-buffer))) + xml))) + +(defun xml-parse-region (beg end &optional buffer parse-dtd) + "Parse the region from BEG to END in BUFFER. +If BUFFER is nil, it defaults to the current buffer. +Returns the XML list for the region, or raises an error if the region +is not a well-formed XML file. +If PARSE-DTD is non-nil, the DTD is parsed rather than skipped, +and returned as the first element of the list" + (let (xml result dtd) + (save-excursion + (if buffer + (set-buffer buffer)) + (goto-char beg) + (while (< (point) end) + (if (search-forward "<" end t) + (progn + (forward-char -1) + (if (null xml) + (progn + (set 'result (xml-parse-tag end parse-dtd)) + (cond + ((listp (car result)) + (set 'dtd (car result)) + (add-to-list 'xml (cdr result))) + (t + (add-to-list 'xml result)))) + + ;; translation of rule [1] of XML specifications + (error "XML files can have only one toplevel tag."))) + (goto-char end))) + (if parse-dtd + (cons dtd (reverse xml)) + (reverse xml))))) + + +(defun xml-parse-tag (end &optional parse-dtd) + "Parse the tag that is just in front of point. +The end tag must be found before the position END in the current buffer. +If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and +returned as the first element in the list. +Returns one of: + - a list : the matching node + - nil : the point is not looking at a tag. + - a cons cell: the first element is the DTD, the second is the node" + (cond + ;; Processing instructions (like the tag at the + ;; beginning of a document) + ((looking-at "<\\?") + (search-forward "?>" end) + (skip-chars-forward " \t\n") + (xml-parse-tag end)) + ;; Character data (CDATA) sections, in which no tag should be interpreted + ((looking-at "" end t) + (error "CDATA section does not end anywhere in the document")) + (buffer-substring-no-properties pos (match-beginning 0)))) + ;; DTD for the document + ((looking-at "" end) + (skip-chars-forward " \t\n") + (xml-parse-tag end)) + ;; end tag + ((looking-at " \t\n]+\\)") + (let* ((node-name (match-string 1)) + (children (list (intern node-name))) + (case-fold-search nil) ;; XML is case-sensitive + pos) + (goto-char (match-end 1)) + + ;; parses the attribute list + (set 'children (append children (list (xml-parse-attlist end)))) + + ;; is this an empty element ? + (if (looking-at "/>") + (progn + (forward-char 2) + (skip-chars-forward " \t\n") + (append children '(""))) + + ;; is this a valid start tag ? + (if (= (char-after) ?>) + (progn + (forward-char 1) + (skip-chars-forward " \t\n") + ;; Now check that we have the right end-tag. Note that this one might + ;; contain spaces after the tag name + (while (not (looking-at (concat ""))) + (cond + ((looking-at " (point) end) + (error "XML: End tag for %s not found before end of region." + node-name)) + children + ) + + ;; This was an invalid start tag + (error "XML: Invalid attribute list") + )))) + )) + +(defun xml-parse-attlist (end) + "Return the attribute-list that point is looking at. +The search for attributes end at the position END in the current buffer. +Leaves the point on the first non-blank character after the tag." + (let ((attlist '()) + name) + (skip-chars-forward " \t\n") + (while (looking-at "\\([a-zA-Z_:][-a-zA-Z0-9._:]*\\)[ \t\n]*=[ \t\n]*") + (set 'name (intern (match-string 1))) + (goto-char (match-end 0)) + + ;; Do we have a string between quotes (or double-quotes), + ;; or a simple word ? + (unless (looking-at "\"\\([^\"]+\\)\"") + (unless (looking-at "'\\([^\"]+\\)'") + (error "XML: Attribute values must be given between quotes."))) + + ;; Each attribute must be unique within a given element + (if (assoc name attlist) + (error "XML: each attribute must be unique within an element.")) + + (set 'attlist (append attlist + (list (cons name (match-string-no-properties 1))))) + (goto-char (match-end 0)) + (skip-chars-forward " \t\n") + (if (> (point) end) + (error "XML: end of attribute list not found before end of region.")) + ) + attlist + )) + +;;******************************************************************* +;;** +;;** The DTD (document type declaration) +;;** The following functions know how to skip or parse the DTD of +;;** a document +;;** +;;******************************************************************* + +(defun xml-skip-dtd (end) + "Skip the DTD that point is looking at. +The DTD must end before the position END in the current buffer. +The point must be just before the starting tag of the DTD. +This follows the rule [28] in the XML specifications." + (forward-char (length "") + (error "XML: invalid DTD (excepting name of the document)")) + (condition-case nil + (progn + (forward-word 1) ;; name of the document + (skip-chars-forward " \t\n") + (if (looking-at "\\[") + (re-search-forward "\\][ \t\n]*>" end) + (search-forward ">" end))) + (error (error "XML: No end to the DTD")))) + +(defun xml-parse-dtd (end) + "Parse the DTD that point is looking at. +The DTD must end before the position END in the current buffer." + (let (dtd type element end-pos) + (forward-char (length "") + (error "XML: invalid DTD (excepting name of the document)")) + + ;; Get the name of the document + (looking-at "\\sw+") + (set 'dtd (list 'dtd (match-string-no-properties 0))) + (goto-char (match-end 0)) + + (skip-chars-forward " \t\n") + + ;; External DTDs => don't know how to handle them yet + (if (looking-at "SYSTEM") + (error "XML: Don't know how to handle external DTDs.")) + + (if (not (= (char-after) ?\[)) + (error "XML: Unknown declaration in the DTD.")) + + ;; Parse the rest of the DTD + (forward-char 1) + (while (and (not (looking-at "[ \t\n]*\\]")) + (<= (point) end)) + (cond + + ;; Translation of rule [45] of XML specifications + ((looking-at + "[\t \n]*]+\\)>") + + (setq element (intern (match-string-no-properties 1)) + type (match-string-no-properties 2)) + (set 'end-pos (match-end 0)) + + ;; Translation of rule [46] of XML specifications + (cond + ((string-match "^EMPTY[ \t\n]*$" type) ;; empty declaration + (set 'type 'empty)) + ((string-match "^ANY[ \t\n]*$" type) ;; any type of contents + (set 'type 'any)) + ((string-match "^(\\(.*\\))[ \t\n]*$" type) ;; children ([47]) + (set 'type (xml-parse-elem-type (match-string-no-properties 1 type)))) + ((string-match "^%[^;]+;[ \t\n]*$" type) ;; substitution + nil) + (t + (error "XML: Invalid element type in the DTD"))) + + ;; rule [45]: the element declaration must be unique + (if (assoc element dtd) + (error "XML: elements declaration must be unique in a DTD (<%s>)." + (symbol-name element))) + + ;; Store the element in the DTD + (set 'dtd (append dtd (list (list element type)))) + (goto-char end-pos) + ) + + + (t + (error "XML: Invalid DTD item")) + ) + ) + + ;; Skip the end of the DTD + (search-forward ">" end) + dtd + )) + + +(defun xml-parse-elem-type (string) + "Convert a STRING for an element type into an elisp structure." + + (let (elem modifier) + (if (string-match "(\\([^)]+\\))\\([+*?]?\\)" string) + (progn + (setq elem (match-string 1 string) + modifier (match-string 2 string)) + (if (string-match "|" elem) + (set 'elem (append '(choice) + (mapcar 'xml-parse-elem-type + (split-string elem "|")))) + (if (string-match "," elem) + (set 'elem (append '(seq) + (mapcar 'xml-parse-elem-type + (split-string elem ",")))) + ))) + (if (string-match "[ \t\n]*\\([^+*?]+\\)\\([+*?]?\\)" string) + (setq elem (match-string 1 string) + modifier (match-string 2 string)))) + + (if (and (stringp elem) + (string= elem "#PCDATA")) + (set 'elem 'pcdata)) + + (cond + ((string= modifier "+") + (list '+ elem)) + ((string= modifier "*") + (list '* elem)) + ((string= modifier "?") + (list '? elem)) + (t + elem)))) + + +;;******************************************************************* +;;** +;;** Substituting special XML sequences +;;** +;;******************************************************************* + +(defun xml-substitute-special (string) + "Return STRING, after subsituting special XML sequences." + (while (string-match "&" string) + (set 'string (replace-match "&" t nil string))) + (while (string-match "<" string) + (set 'string (replace-match "<" t nil string))) + (while (string-match ">" string) + (set 'string (replace-match ">" t nil string))) + (while (string-match "'" string) + (set 'string (replace-match "'" t nil string))) + (while (string-match """ string) + (set 'string (replace-match "\"" t nil string))) + string) + +;;******************************************************************* +;;** +;;** Printing a tree. +;;** This function is intended mainly for debugging purposes. +;;** +;;******************************************************************* + +(defun xml-debug-print (xml) + (while xml + (xml-debug-print-internal (car xml) "") + (set 'xml (cdr xml))) + ) + +(defun xml-debug-print-internal (xml &optional indent-string) + "Outputs the XML tree in the current buffer. +The first line indented with INDENT-STRING." + (let ((tree xml) + attlist) + (unless indent-string + (set 'indent-string "")) + + (insert indent-string "<" (symbol-name (xml-node-name tree))) + + ;; output the attribute list + (set 'attlist (xml-node-attributes tree)) + (while attlist + (insert " ") + (insert (symbol-name (caar attlist)) "=\"" (cdar attlist) "\"") + (set 'attlist (cdr attlist))) + + (insert ">") + + (set 'tree (xml-node-children tree)) + + ;; output the children + (while tree + (cond + ((listp (car tree)) + (insert "\n") + (xml-debug-print-internal (car tree) (concat indent-string " ")) + ) + ((stringp (car tree)) + (insert (car tree)) + ) + (t + (error "Invalid XML tree"))) + (set 'tree (cdr tree)) + ) + + (insert "\n" indent-string + "") + )) + +(provide 'xml) + +;;; xml.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2824676..2a12fe4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2001-03-08 20:00:00 ShengHuo ZHU + + * nnrss.el: New file. + 2001-03-08 02:41:36 Katsumi Yamaoka Committed by ShengHuo ZHU diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 53e4230..7afd1d3 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -289,7 +289,7 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. nil))) '("nnweb.el" "nnlistserv.el" "nnultimate.el" "nnslashdot.el" "nnwarchive.el" "webmail.el" - "nnwfm.el")) + "nnwfm.el" "nnrss.el")) (condition-case nil (progn (require 'bbdb) nil) (error '("gnus-bbdb.el"))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 77d9b14..2970c51 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1428,6 +1428,7 @@ slower, and `std11-extract-address-components'." ("nnweb" none) ("nnslashdot" post) ("nnultimate" none) + ("nnrss" none) ("nnwfm" none) ("nnwarchive" none) ("nnlistserv" none) diff --git a/lisp/nnrss.el b/lisp/nnrss.el new file mode 100644 index 0000000..ee5df1e --- /dev/null +++ b/lisp/nnrss.el @@ -0,0 +1,395 @@ +;;; nnrss.el --- interfacing with RSS +;; Copyright (C) 2001 ShengHuo Zhu + +;; Author: Shenghuo Zhu +;; Keywords: RSS + +;; 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 'nnoo) +(require 'nnmail) +(require 'message) +(require 'mm-util) +(require 'gnus-util) +(require 'time-date) +(eval-when-compile + (ignore-errors + (require 'xml) + (require 'w3) + (require 'w3-forms) + (require 'nnweb))) +;; Report failure to find w3 at load time if appropriate. +(eval '(progn + (require 'xml) + (require 'w3) + (require 'w3-forms) + (require 'nnweb))) + +(nnoo-declare nnrss) + +(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") + "Where nnrss will save its files.") + +;; (group max rss-url) +(defvoo nnrss-server-data nil) + +;; (num timestamp url subject author date extra) +(defvoo nnrss-group-data nil) +(defvoo nnrss-group-max 0) +(defvoo nnrss-group-min 1) +(defvoo nnrss-group nil) +(defvoo nnrss-group-hashtb nil) +(defvoo nnrss-status-string "") + +(defconst nnrss-version "nnrss 1.0") + +(defvar nnrss-group-alist + '(("MacWeek" + "http://macweek.zdnet.com/macweek.xml") + ("Linux.Weekly.News" + "http://lwn.net/headlines/rss") + ("Motley.Fool" + "http://www.fool.com/About/headlines/rss_headlines.asp") + ("NewsForge.rdf" + "http://www.newsforge.com/newsforge.rdf") + ("Slashdot" + "http://www.slashdot.com/slashdot.rdf") + ("CNN" + "http://www.cnn.com/cnn.rss") + ("FreshMeat" + "http://freshmeat.net/backend/fm.rdf") + ("The.Guardian.newspaper" + "http://www.guardianunlimited.co.uk/rss/1,,,00.xml") + ("MonkeyFist.rdf" + "http://monkeyfist.com/rdf.php3") + ("NewsForge" + "http://www.newsforge.com/newsforge.rss") + ("Reuters.Health" + "http://www.reutershealth.com/eline.rss") + ("Salon" + "http://www.salon.com/feed/RDF/salon_use.rdf") + ("Wired" + "http://www.wired.com/news_drop/netcenter/netcenter.rdf") + ("ITN" + "http://www.itn.co.uk/itn.rdf") + ("Meerkat" + "http://www.oreillynet.com/meerkat/?_fl=rss10") + ("MonkeyFist" + "http://monkeyfist.com/rss1.php3") + ("Reuters.Health.rdf" + "http://www.reutershealth.com/eline.rdf"))) + +(defvar nnrss-use-local nil) + +(nnoo-define-basics nnrss) + +;;; Interface functions + +(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) + (nnrss-possibly-change-group group server) + (let (e) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (article articles) + (if (setq e (assq article nnrss-group-data)) + (insert (number-to-string (car e)) "\t" ;; number + (if (nth 3 e) + (nnrss-string-as-multibyte (nth 3 e)) "") + "\t" ;; subject + (if (nth 4 e) + (nnrss-string-as-multibyte (nth 4 e)) "") + "\t" ;;from + (or (nth 5 e) "") + "\t" ;; date + (format "<%d@%s.nnrss>" (car e) group) + "\t" ;; id + "\t" ;; refs + "0" "\t" ;; chars + "0" "\t" ;; lines + "\n"))))) + 'nov) + +(deffoo nnrss-request-group (group &optional server dont-check) + (nnrss-possibly-change-group group server) + (if dont-check + t + (nnrss-check-group group server) + (nnheader-report 'nnrss "Opened group %s" group) + (nnheader-insert + "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max + (prin1-to-string group) + t))) + +(deffoo nnrss-close-group (group &optional server) + t) + +(deffoo nnrss-request-article (article &optional group server buffer) + (nnrss-possibly-change-group group server) + (let ((e (assq article nnrss-group-data)) + (nntp-server-buffer (or buffer nntp-server-buffer)) + post err) + (when e + (catch 'error + (with-current-buffer nntp-server-buffer + (erase-buffer) + (goto-char (point-min)) + (if (nth 3 e) + (insert "Subject: " (nnrss-string-as-multibyte (nth 3 e)) "\n")) + (if (nth 4 e) + (insert "From: " (nnrss-string-as-multibyte (nth 4 e)) "\n")) + (if (nth 5 e) + (insert "Date: " (nnrss-string-as-multibyte (nth 5 e)) "\n")) + (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n") + (insert "\n") + (if (nth 6 e) + (let ((point (point))) + (insert (nnrss-string-as-multibyte (nth 6 e)) "\n\n") + (fill-region point (point)))) + (if (nth 2 e) + (insert (nth 2 e) "\n"))))) + (cond + (err + (nnheader-report 'nnrss err)) + ((not e) + (nnheader-report 'nnrss "No such id: %d" article)) + (t + (nnheader-report 'nnrss "Article %s retrieved" (car e)) + ;; We return the article number. + (cons nnrss-group (car e)))))) + +(deffoo nnrss-request-list (&optional server) + (nnrss-possibly-change-group nil server) + (nnrss-generate-active) + t) + +(deffoo nnrss-open-server (server &optional defs connectionless) + (nnoo-change-server 'nnrss server defs) + t) + +(deffoo nnrss-request-expire-articles + (articles group &optional server force) + (nnrss-possibly-change-group group server) + (let (e changed days) + (dolist (art articles) + (when (setq e (assq art nnrss-group-data)) + (if (nnmail-expired-article-p + group + (if (listp (setq days (nth 1 e))) days (days-to-time days)) + force) + (setq nnrss-group-data (delq e nnrss-group-data) + changed t)))) + (if changed + (nnrss-save-group-data group server)))) + +(deffoo nnrss-request-delete-group (group &optional force server) + (nnrss-possibly-change-group group server) + (setq nnrss-server-data + (delq (assoc group nnrss-server-data) nnrss-server-data)) + (nnrss-save-server-data server) + (let ((file (expand-file-name (concat group ".el") nnrss-directory))) + (delete-file file)) + t) + +(nnoo-define-skeleton nnrss) + +;;; Internal functions + +(defun nnrss-possibly-change-group (&optional group server) + (when (and server + (not (nnrss-server-opened server))) + (nnrss-read-server-data server) + (nnrss-open-server server)) + (when (and group (not (equal group nnrss-group))) + (nnrss-read-group-data group server) + (setq nnrss-group group))) + +(defun nnrss-generate-active () + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (elem nnrss-group-alist) + (insert (prin1-to-string (car elem)) " 0 1 y\n")) + (dolist (elem nnrss-server-data) + (unless (assoc (car elem) nnrss-group-alist) + (insert (prin1-to-string (car elem)) " 0 1 y\n"))))) + +;;; Data functions + +(defun nnrss-read-server-data (server) + (setq nnrss-server-data nil) + (let ((file (expand-file-name (concat "nnrss" (and server + (not (equal server "")) + "-") + server + ".el") + nnrss-directory))) + (when (file-exists-p file) + (with-temp-buffer + (let ((coding-system-for-read 'binary)) + (insert-file-contents file)) + (goto-char (point-min)) + (eval-buffer))))) + +(defun nnrss-save-server-data (server) + (gnus-make-directory nnrss-directory) + (let ((file (expand-file-name (concat "nnrss" (and server + (not (equal server "")) + "-") + server ".el") + nnrss-directory))) + (let ((coding-system-for-write 'binary)) + (with-temp-file file + (insert "(setq nnrss-server-data '" + (prin1-to-string nnrss-server-data) + ")\n"))))) + +(defun nnrss-read-group-data (group server) + (setq nnrss-group-data nil) + (setq nnrss-group-hashtb (gnus-make-hashtable)) + (let ((pair (assoc group nnrss-server-data))) + (setq nnrss-group-max (or (cadr pair) 0)) + (setq nnrss-group-min (+ nnrss-group-max 1))) + (let ((file (expand-file-name (concat group (and server + (not (equal server "")) + "-") + server ".el") + nnrss-directory))) + (when (file-exists-p file) + (with-temp-buffer + (let ((coding-system-for-read 'binary)) + (insert-file-contents file)) + (goto-char (point-min)) + (eval-buffer)) + (dolist (e nnrss-group-data) + (gnus-sethash (nth 2 e) e nnrss-group-hashtb) + (if (and (car e) (> nnrss-group-min (car e))) + (setq nnrss-group-min (car e))) + (if (and (car e) (< nnrss-group-max (car e))) + (setq nnrss-group-max (car e))))))) + +(defun nnrss-save-group-data (group server) + (gnus-make-directory nnrss-directory) + (let ((file (expand-file-name (concat group (and server + (not (equal server "")) + "-") + server ".el") + nnrss-directory))) + (let ((coding-system-for-write 'binary)) + (with-temp-file file + (insert "(setq nnrss-group-data '" + (prin1-to-string nnrss-group-data) + ")\n"))))) + +;;; URL interface + +(defun nnrss-no-cache (url) + "") + +(defun nnrss-insert-w3 (url) + (require 'url) + (require 'url-cache) + (let ((url-cache-creation-function 'nnrss-no-cache)) + (mm-with-unibyte-current-buffer + (nnweb-insert url)))) + +(defun nnrss-decode-entities-unibyte-string (string) + (mm-with-unibyte-buffer + (insert string) + (nnweb-decode-entities) + (buffer-substring (point-min) (point-max)))) + +(defalias 'nnrss-insert 'nnrss-insert-w3) + +(if (featurep 'xemacs) + (defalias 'nnrss-string-as-multibyte 'identity) + (defalias 'nnrss-string-as-multibyte 'string-as-multibyte)) + +;;; Snarf functions + +(defun nnrss-check-group (group server) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)) + file xml subject url extra changed author date) + (mm-with-unibyte-buffer + (if (and nnrss-use-local + (file-exists-p (setq file (expand-file-name + (concat group ".xml") + nnrss-directory)))) + (insert-file-contents file) + (setq url (or (nth 2 (assoc group nnrss-server-data)) + (second (assoc group nnrss-group-alist)))) + (unless url + (setq url + (read-string (format "RSS url of %s: " group "http://"))) + (let ((pair (assoc group nnrss-server-data))) + (if pair + (setcdr (cdr pair) (list url)) + (push (list group nnrss-group-max url) nnrss-server-data))) + (setq changed t)) + (nnrss-insert url)) + (goto-char (point-min)) + (while (re-search-forward "\r\n?" nil t) + (replace-match "\n")) + (goto-char (point-min)) + (if (re-search-forward "