;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; 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 3, or (at your
-;; option) any later version.
+;; 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 of the License, 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.
+;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(defvar nnrss-group-alist '()
"List of RSS addresses.")
-(defvar nnrss-use-local nil)
+(defvar nnrss-use-local nil
+ "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
(defvar nnrss-description-field 'X-Gnus-Description
"Field name used for DESCRIPTION.
the car is what the data specify as the encoding. Or, the car is used
for decoding when the cdr that the data specify is not available.")
-(defvar nnrss-wash-html-in-text-plain-parts nil
- "*Non-nil means render text in text/plain parts as HTML.
-The function specified by the `mm-text-html-renderer' variable will be
-used to render text. If it is nil, text will simply be folded.")
-
(nnoo-define-basics nnrss)
;;; Interface functions
(setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server)
(let (e)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (article articles)
(if (setq e (assq article nnrss-group-data))
"\n")))))
'nov)
-(deffoo nnrss-request-group (group &optional server dont-check)
+(deffoo nnrss-request-group (group &optional server dont-check info)
(setq group (nnrss-decode-group-name group))
(nnheader-message 6 "nnrss: Requesting %s..." group)
(nnrss-possibly-change-group group server)
(deffoo nnrss-close-group (group &optional server)
t)
-(defvar mm-text-html-renderer)
-(defvar mm-text-html-washer-alist)
-
(deffoo nnrss-request-article (article &optional group server buffer)
(setq group (nnrss-decode-group-name group))
(when (stringp article)
(link (nth 2 e))
(enclosure (nth 7 e))
(comments (nth 8 e))
- ;; Enable encoding of Newsgroups header in XEmacs.
- (default-enable-multibyte-characters t)
(rfc2047-header-encoding-alist
(if (mm-coding-system-p 'utf-8)
(cons '("Newsgroups" . utf-8)
(when text
(insert text)
(goto-char body)
- (if (and nnrss-wash-html-in-text-plain-parts
- (progn
- (require 'mm-view)
- (setq fn (or (cdr (assq mm-text-html-renderer
- mm-text-html-washer-alist))
- mm-text-html-renderer))))
- (progn
- (narrow-to-region body (point-max))
- (if (functionp fn)
- (funcall fn)
- (apply (car fn) (cdr fn)))
- (widen)
- (goto-char body)
- (re-search-forward "[^\t\n ]" nil t)
- (beginning-of-line)
- (delete-region body (point))
- (goto-char (point-max))
- (skip-chars-backward "\t\n ")
- (end-of-line)
- (delete-region (point) (point-max))
- (insert "\n"))
- (while (re-search-forward "\n+" nil t)
- (replace-match " "))
- (goto-char body)
- ;; See `nnrss-check-group', which inserts "<br /><br />".
- (when (search-forward "<br /><br />" nil t)
- (if (eobp)
- (replace-match "\n")
- (replace-match "\n\n")))
- (unless (eobp)
- (let ((fill-column default-fill-column)
- (window (get-buffer-window nntp-server-buffer)))
- (when window
- (setq fill-column
- (max 1 (/ (* (window-width window) 7) 8))))
- (fill-region (point) (point-max))
- (goto-char (point-max))
- ;; XEmacs version of `fill-region' inserts newline.
- (unless (bolp)
- (insert "\n")))))
+ (while (re-search-forward "\n+" nil t)
+ (replace-match " "))
+ (goto-char body)
+ ;; See `nnrss-check-group', which inserts "<br /><br />".
+ (when (search-forward "<br /><br />" nil t)
+ (if (eobp)
+ (replace-match "\n")
+ (replace-match "\n\n")))
+ (unless (eobp)
+ (let ((fill-column (default-value 'fill-column))
+ (window (get-buffer-window nntp-server-buffer)))
+ (when window
+ (setq fill-column
+ (max 1 (/ (* (window-width window) 7) 8))))
+ (fill-region (point) (point-max))
+ (goto-char (point-max))
+ ;; XEmacs version of `fill-region' inserts newline.
+ (unless (bolp)
+ (insert "\n"))))
(when (or link enclosure)
(insert "\n")))
(when link
"<#/part>\n"
"<#/multipart>\n"))
(condition-case nil
- (mml-to-mime)
+ ;; Allow `mml-to-mime' to generate MIME article without
+ ;; making inquiry to a user for unknown encoding.
+ (let ((mml-confirmation-set
+ (cons 'unknown-encoding mml-confirmation-set)))
+ (mml-to-mime))
(error
(erase-buffer)
(insert header
;; 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)
(nnrss-read-server-data server)
(nnoo-change-server 'nnrss server defs)
(deffoo nnrss-request-list-newsgroups (&optional server)
(nnrss-possibly-change-group nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (elem nnrss-group-alist)
(if (third elem)
(insert (car elem) "\t" (third elem) "\n"))))
t)
+(deffoo nnrss-retrieve-groups (groups &optional server)
+ (dolist (group groups)
+ (setq group (nnrss-decode-group-name group))
+ (nnrss-possibly-change-group group server)
+ (nnrss-check-group group server))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (group groups)
+ (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data)))
+ (insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
+ 'active))
+
(nnoo-define-skeleton nnrss)
;;; Internal functions
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
(mm-with-unibyte-buffer
- ;;some CVS versions of url.el need this to close the connection quickly
+ ;;some versions of url.el need this to close the connection quickly
(let (cs xmlform htmlform)
;; bit o' work necessary for w3 pre-cvs and post-cvs
(if local
(nnrss-read-group-data group server)
(setq nnrss-group group)))
-(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
-
-(defun nnrss-generate-active ()
- (when (y-or-n-p "Fetch extra categories? ")
- (mapc 'funcall nnrss-extra-categories))
- (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")))))
-
-(eval-and-compile (autoload 'timezone-parse-date "timezone"))
+(autoload 'timezone-parse-date "timezone")
(defun nnrss-normalize-date (date)
"Return a date string of DATE in the RFC822 style.
This function handles the ISO 8601 date format described in
-<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style
+URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC822 style
which RSS 2.0 allows."
- (let (case-fold-search vector year month day time zone cts)
- (cond ((null date))
+ (let (case-fold-search vector year month day time zone cts given)
+ (cond ((null date)) ; do nothing for this case
+ ;; if the date is just digits (unix time stamp):
+ ((string-match "^[0-9]+$" date)
+ (setq given (seconds-to-time (string-to-number date))))
;; RFC822
((string-match " [0-9]+ " date)
(setq vector (timezone-parse-date date)
(if zone
(concat " " zone)
"")))
- (message-make-date))))
+ (message-make-date given))))
;;; data functions
(let ((file (nnrss-make-filename "nnrss" server))
(file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
- ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
- ;; file names. So, we use `insert-file-contents' instead.
- (mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system))
- (insert-file-contents file)
- (eval-region (point-min) (point-max)))))))
+ (load file nil t t))))
(defun nnrss-save-server-data (server)
(gnus-make-directory nnrss-directory)
(let ((file (nnrss-make-filename group server))
(file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
- ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
- ;; file names. So, we use `insert-file-contents' instead.
- (mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system))
- (insert-file-contents file)
- (eval-region (point-min) (point-max))))
+ (load file nil t t)
(dolist (e nnrss-group-data)
(puthash (nth 9 e) t nnrss-group-hashtb)
(when (and (car e) (> nnrss-group-min (car e)))
(rfc2047-encode-region (point-min) (point-max)))
(goto-char (point-min))
(while (search-forward "\n" nil t)
- (delete-backward-char 1))
+ (delete-char -1))
(buffer-string)))
;;; Snarf functions
-
(defun nnrss-make-hash-index (item)
+ (gnus-message 9 "nnrss: Making hash index of %s" (gnus-prin1-to-string item))
(setq item (gnus-remove-if
(lambda (field)
(when (listp field)
(push (list group nnrss-group-max url) nnrss-server-data)))
(setq changed t))
(setq xml (nnrss-fetch url)))
- ;; See
- ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html
- ;; for more RSS namespaces.
(setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")
rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
(append nnheader-file-name-translation-alist '((?' . ?_)))))
(nnheader-translate-file-chars name)))
-(defvar nnrss-moreover-url
- "http://w.moreover.com/categories/category_list_rss.html"
- "The url of moreover.com categories.")
-
-(defun nnrss-snarf-moreover-categories ()
- "Snarf RSS links from moreover.com."
- (interactive)
- (let (category name url changed)
- (with-temp-buffer
- (nnrss-insert nnrss-moreover-url)
- (goto-char (point-min))
- (while (re-search-forward
- "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
- (if (match-string 1)
- (setq category (match-string 1))
- (setq url (match-string 2)
- name (mm-url-decode-entities-string
- (rfc2231-decode-encoded-string
- (match-string 3))))
- (if category
- (setq name (concat category "." name)))
- (unless (assoc name nnrss-server-data)
- (setq changed t)
- (push (list name 0 url) nnrss-server-data)))))
- (if changed
- (nnrss-save-server-data ""))))
-
(defun nnrss-node-text (namespace local-name element)
(let* ((node (assq (intern (concat namespace (symbol-name local-name)))
element))
(defun nnrss-discover-feed (url)
"Given a page, find an RSS feed using Mark Pilgrim's
-`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)."
+`ultra-liberal rss locator'."
(let ((parsed-page (nnrss-fetch url)))
(cdr (assoc "feedid" listinfo)))))
feedinfo)))
(cdr (assoc
- (completing-read
- "Multiple feeds found. Select one: "
- selection nil t) urllist)))))))))
+ (gnus-completing-read
+ "Multiple feeds found. Select one"
+ selection t) urllist)))))))))
(defun nnrss-rss-p (data)
"Test if DATA is an RSS feed.
(provide 'nnrss)
-
;;; nnrss.el ends here
-
-;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267