X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnshimbun.el;h=e961d7801c19a1a89f9029b723c523297f6d9947;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=12f0fae74924d10bfc6841cb4dc2bce4d9f951fe;hpb=3b8833a07c1159aefdde93cd92ee3396abb120e7;p=elisp%2Fgnus.git- diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el index 12f0fae..e961d78 100644 --- a/lisp/nnshimbun.el +++ b/lisp/nnshimbun.el @@ -1,4 +1,6 @@ -;;; nnshimbun.el --- interfacing with web newspapers -*- coding: junet; -*- +;;; nnshimbun.el --- interfacing with web newspapers + +;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi ;; Authors: TSUCHIYA Masatoshi , ;; Akihiro Arisawa , @@ -6,8 +8,6 @@ ;; Yuuichi Teranishi ;; Keywords: news -;;; Copyright: - ;; This file is a part of Semi-Gnus. ;; This program is free software; you can redistribute it and/or modify @@ -31,7 +31,7 @@ ;; This module requires the Emacs-W3M and the external command W3M. ;; Visit the following pages for more information. ;; -;; http://namazu.org/~tsuchiya/emacs-w3m/ +;; http://emacs-w3m.namazu.org/ ;; http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/ ;; If you would like to use this module in Gnus (not T-gnus), put this @@ -47,6 +47,7 @@ (require 'nnheader) (require 'nnmail) (require 'nnoo) +(require 'gnus) (require 'gnus-bcklg) (require 'shimbun) (require 'message) @@ -57,13 +58,120 @@ "Reading Web Newspapers with Gnus." :group 'gnus) +(defvar nnshimbun-group-parameters-custom + '(list :format "%v" + (checklist :inline t + (list :inline t :format "%v" + (const :format "" index-range) + (choice :tag "Index range" + :value all + (const all) + (const last) + (integer :tag "days"))) + (list :inline t :format "%v" + (const :format "" prefetch-articles) + (choice :tag "Prefetch articles" + :value off + (const on) + (const off))) + (list :inline t :format "%v" + (const :format "" encapsulate-images) + (choice :tag "Encapsulate article" + :value on + (const on) + (const off))) + (list :inline t :format "%v" + (const :format "" expiry-wait) + (choice :tag "Expire wait" + :value never + (const never) + (const immediate) + (number :tag "days")))) + (repeat :inline t :tag "Others" + (list :inline t :format "%v" + (symbol :tag "Keyword") + (sexp :tag "Value")))) + "A type definition for customizing the nnshimbun group parameters.") + +;; The following definition provides the group parameter +;; `nnshimbun-group-parameters', the user option +;; `nnshimbun-group-parameters-alist' and the function +;; `nnshimbun-find-group-parameters'. +;; The group parameter `nnshimbun-group-parameters' will have a +;; property list like the following: +;; +;; '(index-range all prefetch-articles off encapsulate-images on +;; expiry-wait 6) + +(unless (fboundp 'gnus-define-group-parameter) + (defmacro gnus-define-group-parameter (&rest args) nil) + (defun nnshimbun-find-group-parameters (name) + "Return a nnshimbun GROUP's group parameters." + (when name + (or (gnus-group-find-parameter name 'nnshimbun-group-parameters t) + (assoc-default name + (and (boundp 'nnshimbun-group-parameters-alist) + (symbol-value 'nnshimbun-group-parameters-alist)) + (function string-match)))))) + +(gnus-define-group-parameter + nnshimbun-group-parameters + :type list + :function nnshimbun-find-group-parameters + :function-document "\ +Return a nnshimbun GROUP's group parameters." + :variable nnshimbun-group-parameters-alist + :variable-default nil + :variable-document "\ +Alist of nnshimbun group parameters. Each element should be a cons of +a group name regexp and a plist which consists of a keyword and a value +pairs like the following: + +'(\"^nnshimbun\\\\+asahi:\" index-range all prefetch-articles off + encapsulate-images on expiry-wait 6) + +`index-range' specifies a range of header indices as described below: + all: Retrieve all header indices. + last: Retrieve the last header index. +integer N: Retrieve N pages of header indices. + +`prefetch-articles' specifies whether to pre-fetch the unread articles +when scanning the group. + +`encapsulate-images' specifies whether inline images in the shimbun +article are encapsulated. + +`expiry-wait' is similar to the generic group parameter `expiry-wait', +but it has a preference." + :variable-group nnshimbun + :variable-type `(repeat (cons :format "%v" (regexp :tag "Group name regexp" + :value "^nnshimbun\\+") + ,nnshimbun-group-parameters-custom)) + :parameter-type nnshimbun-group-parameters-custom + :parameter-document "\ +Group parameters for the nnshimbun group. + +`Index range' specifies a range of header indices as described below: + all: Retrieve all header indices. + last: Retrieve the last header index. +integer N: Retrieve N pages of header indices. + +`Prefetch articles' specifies whether to pre-fetch the unread articles +when scanning the group. + +`Encapsulate article' specifies whether inline images in the shimbun +article are encapsulated. + +`Expire wait' is similar to the generic group parameter `expiry-wait', +but it has a preference.") + (defcustom nnshimbun-keep-unparsable-dated-articles t "*If non-nil, nnshimbun will never delete articles whose NOV date is unparsable." :group 'nnshimbun :type 'boolean) -;; Define baekend +;; Define backend (gnus-declare-backend "nnshimbun" 'address) (nnoo-declare nnshimbun) @@ -75,11 +183,22 @@ (defvoo nnshimbun-nov-file-name ".overview") -(defvoo nnshimbun-pre-fetch-article nil - "*Non nil means that nnshimbun fetch unread articles when scanning groups.") +(defvoo nnshimbun-pre-fetch-article 'off + "*If it is neither `off' nor nil, nnshimbun fetch unread articles when +scanning groups. Note that this variable has just a default value for +all the nnshimbun groups. You can specify the nnshimbun group +parameter `prefecth-articles' for each nnshimbun group.") + +(defvoo nnshimbun-encapsulate-images shimbun-encapsulate-images + "*If it is neither `off' nor nil, inline images will be encapsulated in +the articles. Note that this variable has just a default value for +all the nnshimbun groups. You can specify the nnshimbun group +parameter `encapsulate-images' for each nnshimbun group.") (defvoo nnshimbun-index-range nil - "*Range of indecis to detect new pages.") + "*Range of indices to detect new pages. Note that this variable has +just a default value for all the nnshimbun groups. You can specify +the nnshimbun group parameter `index-range' for each nnshimbun group.") ;; set by nnshimbun-possibly-change-group (defvoo nnshimbun-buffer nil) @@ -114,6 +233,46 @@ (put 'nnshimbun-backlog 'edebug-form-spec '(form body)) +;;; Group parameter +(defmacro nnshimbun-find-parameter (group symbol &optional full-name-p) + "Return the value of a nnshimbun group parameter for GROUP which is +associated with SYMBOL. If FULL-NAME-P is non-nil, it treats that +GROUP has a full name." + (let ((name (if full-name-p + group + `(concat "nnshimbun+" (nnoo-current-server 'nnshimbun) + ":" ,group)))) + (cond ((eq 'index-range (eval symbol)) + `(or (plist-get (nnshimbun-find-group-parameters ,name) + 'index-range) + nnshimbun-index-range)) + ((eq 'prefetch-articles (eval symbol)) + `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name) + 'prefetch-articles) + nnshimbun-pre-fetch-article))) + (if (eq 'off val) + nil + val))) + ((eq 'encapsulate-images (eval symbol)) + `(let ((val (or (plist-get (nnshimbun-find-group-parameters ,name) + 'encapsulate-images) + nnshimbun-encapsulate-images))) + (if (eq 'off val) + nil + val))) + ((eq 'expiry-wait (eval symbol)) + (if full-name-p + `(or (plist-get (nnshimbun-find-group-parameters ,group) + 'expiry-wait) + (gnus-group-find-parameter ,group 'expiry-wait)) + `(let ((name ,name)) + (or (plist-get (nnshimbun-find-group-parameters name) + 'expiry-wait) + (gnus-group-find-parameter name 'expiry-wait))))) + (t + `(plist-get (nnshimbun-find-group-parameters ,name) ,symbol))))) + + ;;; Interface Functions (nnoo-define-basics nnshimbun) @@ -173,12 +332,12 @@ (eval-and-compile (let ((Gnus-p (eval-when-compile - (let ((gnus (locate-library "gnus")) - ;; Gnus has mailcap.el in the same directory of gnus.el. - (mailcap (locate-library "mailcap"))) - (and gnus mailcap - (string-equal (file-name-directory gnus) - (file-name-directory mailcap))))))) + (let ((gnus (locate-library "gnus"))) + (and gnus + ;; Gnus has mailcap.el in the same directory of gnus.el. + (file-exists-p (expand-file-name + "mailcap.el" + (file-name-directory gnus)))))))) (if Gnus-p (progn (defmacro nnshimbun-mail-header-subject (header) @@ -222,7 +381,9 @@ (when header (with-current-buffer (or to-buffer nntp-server-buffer) (delete-region (point-min) (point-max)) - (shimbun-article nnshimbun-shimbun header) + (let ((shimbun-encapsulate-images + (nnshimbun-find-parameter group 'encapsulate-images))) + (shimbun-article nnshimbun-shimbun header)) (when (> (buffer-size) 0) ;; Kludge! replace a date string in `gnus-newsgroup-data' ;; based on the newly retrieved article. @@ -239,7 +400,14 @@ (deffoo nnshimbun-request-article (article &optional group server to-buffer) (when (nnshimbun-possibly-change-group group server) (when (stringp article) - (setq article (nnshimbun-search-id group article))) + (let ((num (when (or group (setq group nnshimbun-current-group)) + (nnshimbun-search-id group article)))) + (unless num + (let ((groups (shimbun-groups (shimbun-open server)))) + (while (and (not num) groups) + (setq group (pop groups) + num (nnshimbun-search-id group article))))) + (setq article num))) (if (integerp article) (nnshimbun-request-article-1 article group server to-buffer) (nnheader-report 'nnshimbun "Couldn't retrieve article: %s" @@ -335,7 +503,7 @@ (nnheader-nov-delete-outside-range (if fetch-old (max 1 (- (car articles) fetch-old)) (car articles)) - (and articles (nth (1- (length articles)) articles))) + (nth (1- (length articles)) articles)) t)))))) @@ -414,21 +582,20 @@ also be nil." (with-current-buffer (nnshimbun-open-nov group) (goto-char (point-max)) (forward-line -1) - (let ((i (or (ignore-errors (read (current-buffer))) 0))) - (dolist (header (shimbun-headers - nnshimbun-shimbun - (or (gnus-group-find-parameter - (concat "nnshimbun+" - (nnoo-current-server 'nnshimbun) - ":" group) - 'nnshimbun-index-range) - nnshimbun-index-range))) + (let* ((i (or (ignore-errors (read (current-buffer))) 0)) + (name (concat "nnshimbun+" (nnoo-current-server 'nnshimbun) + ":" group)) + (pre-fetch (nnshimbun-find-parameter name 'prefetch-articles t))) + (dolist (header + (shimbun-headers + nnshimbun-shimbun + (nnshimbun-find-parameter name 'index-range t))) (unless (nnshimbun-search-id group (shimbun-header-id header)) (goto-char (point-max)) (nnshimbun-insert-nov (setq i (1+ i)) header) - (when nnshimbun-pre-fetch-article + (when pre-fetch (nnshimbun-request-article-1 i group nil nnshimbun-buffer))))) - (nnshimbun-write-nov group))) + (nnshimbun-write-nov group))) (defun nnshimbun-replace-nov-entry (group article header &optional id) (with-current-buffer (nnshimbun-open-nov group) @@ -488,19 +655,20 @@ also be nil." (when (buffer-live-p buffer) (save-excursion (set-buffer buffer) - (buffer-modified-p) - (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name - nil 'nomesg))))) + (and (> (buffer-size) 0) + (buffer-modified-p) + (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name + nil 'nomesg)))))) (defun nnshimbun-save-nov () (save-excursion (while nnshimbun-nov-buffer-alist (when (buffer-name (cdar nnshimbun-nov-buffer-alist)) (set-buffer (cdar nnshimbun-nov-buffer-alist)) - (when (buffer-modified-p) - (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name - nil 'nomesg)) - (set-buffer-modified-p nil) + (and (> (buffer-size) 0) + (buffer-modified-p) + (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name + nil 'nomesg)) (kill-buffer (current-buffer))) (setq nnshimbun-nov-buffer-alist (cdr nnshimbun-nov-buffer-alist))))) @@ -519,16 +687,20 @@ and the NOV is open. The optional fourth argument FORCE is ignored." (let* ((expirable (copy-sequence articles)) (name (concat "nnshimbun+" server ":" group)) ;; If the group's parameter `expiry-wait' is non-nil, - ;; `nnmail-expiry-wait' is bound to that value, and - ;; `nnmail-expiry-wait-function' is bound to nil. - ;; See the source code of `gnus-summary-expire-articles'. - ;; Prefer the shimbun's default to `nnmail-expiry-wait' - ;; only when the group's parameter is nil. - (nnmail-expiry-wait - (if (gnus-group-find-parameter name 'expiry-wait) - nnmail-expiry-wait - (or (shimbun-article-expiration-days nnshimbun-shimbun) - nnmail-expiry-wait))) + ;; the value of the option `nnmail-expiry-wait' will be + ;; bound to that value, and the value of the option + ;; `nnmail-expiry-wait-function' will be bound to nil. + ;; See the source code of `gnus-summary-expire-articles' + ;; how does it work. If the group's parameter is not + ;; specified by user, the shimbun's default value will + ;; be used. + (expiry-wait + (or (nnshimbun-find-parameter name 'expiry-wait t) + (shimbun-article-expiration-days nnshimbun-shimbun))) + (nnmail-expiry-wait (or expiry-wait nnmail-expiry-wait)) + (nnmail-expiry-wait-function (if expiry-wait + nil + nnmail-expiry-wait-function)) article end time) (save-excursion (set-buffer buffer) @@ -636,21 +808,20 @@ and the NOV is open. The optional fourth argument FORCE is ignored." (directory-files d))))) load-path))) (server (completing-read - "Shimbun address: " + "Shimbun address: " alist nil t (or (car nnshimbun-server-history) (caar alist)) 'nnshimbun-server-history)) (groups) (nnshimbun-pre-fetch-article)) - (require (intern (concat "sb-" server))) - (when (setq groups (intern-soft (concat "shimbun-" server "-groups"))) - (gnus-group-make-group - (completing-read "Group name: " - (mapcar 'list (symbol-value groups)) - nil t nil) - (list 'nnshimbun server))))) + (if (setq groups (shimbun-groups (shimbun-open server))) + (gnus-group-make-group + (completing-read "Group name: " (mapcar 'list groups) nil t nil) + (list 'nnshimbun server)) + (error "%s" "Can't find group")))) (provide 'nnshimbun) -;;; nnshimbun.el ends here. + +;;; nnshimbun.el ends here