;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009 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 2, 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-when-compile (require 'cl))
(require 'gnus)
(require 'mml)
(eval-when-compile
(ignore-errors
- (require 'xml)))
+ (require 'xml)))
(eval '(require 'xml))
(nnoo-declare nnrss)
(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
"Where nnrss will save its files.")
+(defvoo nnrss-ignore-article-fields '(slash:comments)
+ "*List of fields that should be ignored when comparing RSS articles.
+Some RSS feeds update article fields during their lives, e.g. to
+indicate the number of comments or the number of times the
+articles have been seen. However, if there is a difference
+between the local article and the distant one, the latter is
+considered to be new. To avoid this and discard some fields, set
+this variable to the list of fields to be ignored.")
+
;; (group max rss-url)
(defvoo nnrss-server-data nil)
ARTICLE is the article number of the current headline.")
(defvar nnrss-file-coding-system mm-universal-coding-system
- "Coding system used when reading and writing files.")
+ "*Coding system used when reading and writing files.
+If you run Gnus with various versions of Emacsen, the value of this
+variable should be the coding system that all those Emacsen support.
+Note that you have to regenerate all the nnrss groups if you change
+the value. Moreover, you should be patient even if you are made to
+read the same articles twice, that arises for the difference of the
+versions of xml.el.")
+
+(defvar nnrss-compatible-encoding-alist
+ (delq nil (mapcar (lambda (elem)
+ (if (and (mm-coding-system-p (car elem))
+ (mm-coding-system-p (cdr elem)))
+ elem))
+ mm-charset-override-alist))
+ "Alist of encodings and those supersets.
+The cdr of each element is used to decode data if it is available when
+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)
(deffoo nnrss-request-group (group &optional server dont-check)
(setq group (nnrss-decode-group-name group))
+ (nnheader-message 6 "nnrss: Requesting %s..." group)
(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)))
+ (prog1
+ (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))
+ (nnheader-message 6 "nnrss: Requesting %s...done" group)))
(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)
(nntp-server-buffer (or buffer nntp-server-buffer))
post err)
(when e
- (catch 'error
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (if group
- (insert "Newsgroups: " group "\n"))
- (if (nth 3 e)
- (insert "Subject: " (nth 3 e) "\n"))
- (if (nth 4 e)
- (insert "From: " (nth 4 e) "\n"))
- (if (nth 5 e)
- (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
- (insert "\n")
- (let ((text (if (nth 6 e)
- (mapconcat 'identity
- (delete "" (split-string (nth 6 e) "\n+"))
- " ")))
- (link (nth 2 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)
- rfc2047-header-encoding-alist)
- rfc2047-header-encoding-alist))
- rfc2047-encode-encoded-words)
- (when (or text link)
- (insert "<#multipart type=alternative>\n"
- "<#part type=\"text/plain\">\n")
- (if text
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if group
+ (insert "Newsgroups: " group "\n"))
+ (if (nth 3 e)
+ (insert "Subject: " (nth 3 e) "\n"))
+ (if (nth 4 e)
+ (insert "From: " (nth 4 e) "\n"))
+ (if (nth 5 e)
+ (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
+ (let ((header (buffer-string))
+ (text (nth 6 e))
+ (link (nth 2 e))
+ (enclosure (nth 7 e))
+ (comments (nth 8 e))
+ (rfc2047-header-encoding-alist
+ (if (mm-coding-system-p 'utf-8)
+ (cons '("Newsgroups" . utf-8)
+ rfc2047-header-encoding-alist)
+ rfc2047-header-encoding-alist))
+ rfc2047-encode-encoded-words body fn)
+ (when (or text link enclosure comments)
+ (insert "\n")
+ (insert "<#multipart type=alternative>\n"
+ "<#part type=\"text/plain\">\n")
+ (setq body (point))
+ (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
- (insert text "\n")
- (when link
- (insert "\n" link "\n")))
- (when link
- (insert link "\n")))
- (insert "<#/part>\n"
- "<#part type=\"text/html\">\n"
- "<html><head></head><body>\n")
- (when text
- (insert text "\n"))
- (when link
- (insert "<p><a href=\"" link "\">link</a></p>\n"))
- (insert "</body></html>\n"
- "<#/part>\n"
- "<#/multipart>\n")
- (mml-to-mime)))
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-line -1)
- (insert (format "Message-ID: <%d@%s.nnrss>\n"
- (car e)
- (let ((rfc2047-encoding-type 'mime)
- rfc2047-encode-max-chars)
- (rfc2047-encode-string
- (gnus-replace-in-string group "[\t\n ]+" "_")))))
- (when nnrss-content-function
- (funcall nnrss-content-function e group article)))))
+ (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-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
+ (insert link "\n"))
+ (when enclosure
+ (insert (car enclosure) " "
+ (nth 2 enclosure) " "
+ (nth 3 enclosure) "\n"))
+ (when comments
+ (insert comments "\n"))
+ (setq body (buffer-substring body (point)))
+ (insert "<#/part>\n"
+ "<#part type=\"text/html\">\n"
+ "<html><head></head><body>\n")
+ (when text
+ (insert text "\n"))
+ (when link
+ (insert "<p><a href=\"" link "\">link</a></p>\n"))
+ (when enclosure
+ (insert "<p><a href=\"" (car enclosure) "\">"
+ (cadr enclosure) "</a> " (nth 2 enclosure)
+ " " (nth 3 enclosure) "</p>\n"))
+ (when comments
+ (insert "<p><a href=\"" comments "\">comments</a></p>\n"))
+ (insert "</body></html>\n"
+ "<#/part>\n"
+ "<#/multipart>\n"))
+ (condition-case nil
+ ;; 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
+ "Content-Type: text/plain; charset=gnus-decoded\n"
+ "Content-Transfer-Encoding: 8bit\n\n"
+ body)
+ (nnheader-message
+ 3 "Warning - there might be invalid characters"))))
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-line -1)
+ (insert (format "Message-ID: <%d@%s.nnrss>\n"
+ (car e)
+ (let ((rfc2047-encoding-type 'mime)
+ rfc2047-encode-max-chars)
+ (rfc2047-encode-string
+ (gnus-replace-in-string group "[\t\n ]+" "_")))))
+ (when nnrss-content-function
+ (funcall nnrss-content-function e group article))))
(cond
(err
(nnheader-report 'nnrss err))
(deffoo nnrss-request-delete-group (group &optional force server)
(setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server)
+ (let (elem)
+ ;; There may be two or more entries in `nnrss-group-alist' since
+ ;; this function didn't delete them formerly.
+ (while (setq elem (assoc group nnrss-group-alist))
+ (setq nnrss-group-alist (delq elem nnrss-group-alist))))
(setq nnrss-server-data
(delq (assoc group nnrss-server-data) nnrss-server-data))
(nnrss-save-server-data server)
(ignore-errors
- (delete-file (nnrss-make-filename group server)))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (delete-file (nnrss-make-filename group server))))
t)
(deffoo nnrss-request-list-newsgroups (&optional server)
(eval-when-compile (defun xml-rpc-method-call (&rest args)))
(defun nnrss-get-encoding ()
- "Return an encoding attribute specified in the current xml contents."
+ "Return an encoding attribute specified in the current xml contents.
+If `nnrss-compatible-encoding-alist' specifies the compatible encoding,
+it is used instead. If the xml contents doesn't specify the encoding,
+return `utf-8' which is the default encoding for xml if it is available,
+otherwise return nil."
(goto-char (point-min))
- (mm-coding-system-p
- (if (re-search-forward
- "<\\?[^>]*encoding=\\(?:\"\\([^>]+\\)\"\\|'\\([^>]+\\)'\\)"
- nil t)
- (intern-soft (downcase (or (match-string-no-properties 1)
- (match-string-no-properties 2))))
- ;; The default encoding for xml.
- 'utf-8)))
+ (if (re-search-forward
+ "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
+ nil t)
+ (let ((encoding (intern (downcase (or (match-string 1)
+ (match-string 2))))))
+ (or
+ (mm-coding-system-p (cdr (assq encoding
+ nnrss-compatible-encoding-alist)))
+ (mm-coding-system-p encoding)
+ (mm-coding-system-p (car (rassq encoding
+ nnrss-compatible-encoding-alist)))))
+ (mm-coding-system-p 'utf-8)))
+
+(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff))
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
projects / gnus / blobdiff