X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=32b4f4f116f9c75228f19c61350ca9dda1664eee;hb=3d47861947bb1ad56ad5ae23124725049bdbff8b;hp=5241f9d80e6407cb9f3d9170e680feb27659b66b;hpb=cbca57528e310378efda872d3c80c8137d9e600c;p=gnus diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 5241f9d80..32b4f4f11 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -1,32 +1,34 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; 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 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 . ;;; 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) @@ -75,7 +77,8 @@ this variable to the list of fields to be ignored.") (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. @@ -132,8 +135,7 @@ used to render text. If it is nil, text will simply be folded.") (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)) @@ -177,7 +179,7 @@ used to render text. If it is nil, text will simply be folded.") "\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) @@ -195,9 +197,8 @@ used to render text. If it is nil, text will simply be folded.") (deffoo nnrss-close-group (group &optional server) t) -(eval-when-compile - (defvar mm-text-html-renderer) - (defvar mm-text-html-washer-alist)) +(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)) @@ -225,8 +226,6 @@ used to render text. If it is nil, text will simply be folded.") (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) @@ -271,7 +270,7 @@ used to render text. If it is nil, text will simply be folded.") (replace-match "\n") (replace-match "\n\n"))) (unless (eobp) - (let ((fill-column default-fill-column) + (let ((fill-column (default-value 'fill-column)) (window (get-buffer-window nntp-server-buffer))) (when window (setq fill-column @@ -309,7 +308,11 @@ used to render text. If it is nil, text will simply be folded.") "<#/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 @@ -339,11 +342,6 @@ used to render text. If it is nil, text will simply be folded.") ;; 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) @@ -386,14 +384,24 @@ used to render text. If it is nil, text will simply be folded.") (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) + (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 group nnrss-server-data))) + (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) + 'active)) + (nnoo-define-skeleton nnrss) ;;; Internal functions @@ -419,10 +427,12 @@ otherwise return nil." 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." (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 @@ -474,29 +484,18 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" (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 -, 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) @@ -554,7 +553,7 @@ which RSS 2.0 allows." (if zone (concat " " zone) ""))) - (message-make-date)))) + (message-make-date given)))) ;;; data functions @@ -563,12 +562,7 @@ which RSS 2.0 allows." (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) @@ -592,12 +586,7 @@ which RSS 2.0 allows." (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))) @@ -674,12 +663,12 @@ which RSS 2.0 allows." (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) @@ -785,6 +774,8 @@ which RSS 2.0 allows." (push (list group nnrss-group-max) nnrss-server-data))) (nnrss-save-server-data server)))) +(declare-function gnus-group-make-rss-group "gnus-group" (&optional url)) + (defun nnrss-opml-import (opml-file) "OPML subscriptions import. Read the file and attempt to subscribe to each Feed in the file." @@ -858,33 +849,6 @@ It is useful when `(setq nnrss-use-local t)'." (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 - "\\|