X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnshimbun.el;h=e961d7801c19a1a89f9029b723c523297f6d9947;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=000d06758464a300d87811356b541685a6afec72;hpb=9df859e6dfd7bd8f9e5dca378cd3099b77b561fd;p=elisp%2Fgnus.git- diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el index 000d067..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,35 +31,148 @@ ;; 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 -;; file into the lisp/ directory in the Gnus source tree and run -;; `make install'. And then, copy the function definition of -;; `gnus-group-make-shimbun-group' from the file gnus-group.el of -;; T-gnus to somewhere else, for example .gnus file as follows: +;; file into the lisp/ directory in the Gnus source tree and run `make +;; install'. And then, put the following expression into your ~/.gnus. ;; -;;(eval-after-load "gnus-group" -;; '(if (not (fboundp 'gnus-group-make-shimbun-group)) -;; (defun gnus-group-make-shimbun-group () -;; "Create a nnshimbun group." -;; [...a function definition...]))) +;; (autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t) -;;; Definitions: -(gnus-declare-backend "nnshimbun" 'address) +;;; Definitions: (eval-when-compile (require 'cl)) - (require 'nnheader) (require 'nnmail) (require 'nnoo) +(require 'gnus) (require 'gnus-bcklg) (require 'shimbun) (require 'message) +;; Customize variables +(defgroup nnshimbun nil + "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 backend +(gnus-declare-backend "nnshimbun" 'address) (nnoo-declare nnshimbun) (defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/") @@ -70,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) @@ -109,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) @@ -168,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) @@ -217,13 +381,15 @@ (when header (with-current-buffer (or to-buffer nntp-server-buffer) (delete-region (point-min) (point-max)) - (shimbun-article nnshimbun-shimbun header) - ;; Kludge! replace a date string in `gnus-newsgroup-data' - ;; based on the newly retrieved article. - (let ((x (gnus-summary-article-header article))) - (when x - (mail-header-set-date x (shimbun-header-date 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. + (let ((x (gnus-summary-article-header article))) + (when x + (mail-header-set-date x (shimbun-header-date header)))) (nnshimbun-replace-nov-entry group article header original-id) (nnshimbun-backlog (gnus-backlog-enter-article group article (current-buffer))) @@ -234,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" @@ -265,7 +438,7 @@ (forward-line -1) (setq end (ignore-errors (read (current-buffer))) lines (count-lines (point-min) (point-max)))) - (nnheader-report 'nnshimbunw "Selected group %s" group) + (nnheader-report 'nnshimbun "Selected group %s" group) (nnheader-insert "211 %d %d %d %s\n" lines (or beg 0) (or end 0) group)))))) @@ -330,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)))))) @@ -394,11 +567,11 @@ also be nil." (insert "Xref: " xref "\t") (when id (insert "X-Nnshimbun-Id: " id "\t"))) - (if id - (insert "\tX-Nnshimbun-Id: " id "\t"))) + (when id + (insert "\tX-Nnshimbun-Id: " id "\t"))) ;; Replace newlines with spaces in the current NOV line. (while (progn - (beginning-of-line) + (forward-line 0) (> (point) start)) (backward-delete-char 1) (insert " ")) @@ -409,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) @@ -452,11 +624,11 @@ also be nil." (forward-line 1) (forward-line 0) (setq found t)))) - (if found - (if nov - (nnheader-parse-nov) - ;; We return the article number. - (ignore-errors (read (current-buffer)))))))) + (when found + (if nov + (nnheader-parse-nov) + ;; We return the article number. + (ignore-errors (read (current-buffer)))))))) (defun nnshimbun-open-nov (group) (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist)))) @@ -483,31 +655,23 @@ 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))))) -(defvar nnshimbun-keep-last-article t - "*If non-nil, nnshimbun will never delete a group's last article. It -can be marked expirable, so it will be deleted when it is no longer -last.") - -(defvar nnshimbun-keep-unparsable-dated-articles t - "*If non-nil, nnshimbun will never delete articles whose NOV date is -unparsable.") - (deffoo nnshimbun-request-expire-articles (articles group &optional server force) "Do expiration for the specified ARTICLES in the nnshimbun GROUP. @@ -523,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) @@ -540,8 +708,7 @@ and the NOV is open. The optional fourth argument FORCE is ignored." (setq article (pop expirable)) (when (and (nnheader-find-nov-line article) (setq end (line-end-position)) - (not (and nnshimbun-keep-last-article - (= (point-max) (1+ end))))) + (not (= (point-max) (1+ end)))) (setq time (and (search-forward "\t" end t) (search-forward "\t" end t) (search-forward "\t" end t) @@ -551,13 +718,14 @@ and the NOV is open. The optional fourth argument FORCE is ignored." (if (search-forward "\t" end t) (1- (point)) end))))) - (when (and (or (setq time (condition-case nil - (apply 'encode-time time) - (error nil))) - ;; Inhibit expiration if there's no parsable - ;; date and the following option is non-nil. - (not nnshimbun-keep-unparsable-dated-articles)) - (nnmail-expired-article-p name time nil)) + (when (cond ((setq time (condition-case nil + (apply 'encode-time time) + (error nil))) + (nnmail-expired-article-p name time nil)) + (t + ;; Inhibit expiration if there's no parsable + ;; date and the following option is non-nil. + (not nnshimbun-keep-unparsable-dated-articles))) (beginning-of-line) (delete-region (point) (1+ end)) (setq articles (delq article articles))))) @@ -615,5 +783,45 @@ and the NOV is open. The optional fourth argument FORCE is ignored." id)) + +;;; Command to create nnshimbun group + +(defvar nnshimbun-server-history nil) + +;;;###autoload +(defun gnus-group-make-shimbun-group () + "Create a nnshimbun group." + (interactive) + (let* ((minibuffer-setup-hook + (append minibuffer-setup-hook '(beginning-of-line))) + (alist + (apply 'nconc + (mapcar + (lambda (d) + (and (stringp d) + (file-directory-p d) + (delq nil + (mapcar + (lambda (f) + (and (string-match "^sb-\\(.*\\)\\.el$" f) + (list (match-string 1 f)))) + (directory-files d))))) + load-path))) + (server (completing-read + "Shimbun address: " + alist nil t + (or (car nnshimbun-server-history) + (caar alist)) + 'nnshimbun-server-history)) + (groups) + (nnshimbun-pre-fetch-article)) + (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