git.chise.org Git - elisp/gnus.git-/blob - lisp/nnshimbun.el

   1 ;;; -*- mode: Emacs-Lisp; coding: euc-japan; -*-
   2 ;;; $Id: nnshimbun.el,v 1.1.4.1 2000-05-21 22:48:55 yamaoka Exp $
   3
   4 ;;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
   5 ;;; Keywords: news
   6
   7 ;;; Copyright:
   8
   9 ;; This file is a part of Semi-Gnus.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; if not, you can either send email to this
  23 ;; program's maintainer or write to: The Free Software Foundation,
  24 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Gnus backend to read newspapers on WEB.
  29
  30
  31 ;;; Defintinos:
  32
  33 (gnus-declare-backend "nnshimbun" 'address)
  34
  35 (eval-when-compile (require 'cl))
  36
  37 (require 'timezone)
  38 (require 'nnheader)
  39 (require 'nnmail)
  40 (require 'nnoo)
  41 (require 'gnus-bcklg)
  42 (eval-when-compile
  43   (ignore-errors
  44     (require 'nnweb)))
  45 ;; Report failure to find w3 at load time if appropriate.
  46 (eval '(require 'nnweb))
  47
  48
  49 (nnoo-declare nnshimbun)
  50
  51 (defvar nnshimbun-default-type 'asahi)
  52
  53 (defvar nnshimbun-type-definition
  54   `((asahi
  55      (url . "http://spin.asahi.com/")
  56      (groups "national" "business" "politics" "international" "sports" "personal" "feneral")
  57      (coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
  58      (generate-nov  . nnshimbun-asahi-generate-nov-database)
  59      (make-contents . nnshimbun-asahi-make-contents))))
  60
  61 (defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/")
  62   "Where nnshimbun will save its files.")
  63
  64 (defvoo nnshimbun-nov-is-evil nil
  65   "*Non-nil means that nnshimbun will never retrieve NOV headers.")
  66
  67 (defvoo nnshimbun-nov-file-name ".overview")
  68
  69 ;; set by nnshimbun-possibly-change-server
  70 (defvoo nnshimbun-current-directory nil)
  71 (defvoo nnshimbun-current-group nil)
  72
  73 ;; set by nnoo-change-server
  74 (defvoo nnshimbun-address nil)
  75 (defvoo nnshimbun-type nil)
  76
  77 ;; set by nnshimbun-possibly-change-server
  78 (defvoo nnshimbun-server-directory nil)
  79 (defvoo nnshimbun-buffer nil)
  80
  81 ;; set by nnshimbun-open-server
  82 (defvoo nnshimbun-url nil)
  83 (defvoo nnshimbun-coding-system nil)
  84 (defvoo nnshimbun-groups nil)
  85 (defvoo nnshimbun-generate-nov nil)
  86 (defvoo nnshimbun-make-contents nil)
  87
  88 (defvoo nnshimbun-status-string "")
  89 (defvoo nnshimbun-nov-buffer-alist nil)
  90 (defvoo nnshimbun-nov-buffer-file-name nil)
  91
  92 (defvoo nnshimbun-keep-backlog 300)
  93 (defvoo nnshimbun-backlog-articles nil)
  94 (defvoo nnshimbun-backlog-hashtb nil)
  95
  96
  97
  98 ;;; backlog
  99 (defmacro nnshimbun-backlog (&rest form)
 100   `(let ((gnus-keep-backlog nnshimbun-keep-backlog)
 101          (gnus-backlog-buffer (format " *nnshimbun backlog %s*" nnshimbun-address))
 102          (gnus-backlog-articles nnshimbun-backlog-articles)
 103          (gnus-backlog-hashtb nnshimbun-backlog-hashtb))
 104      (unwind-protect
 105          (progn ,@form)
 106        (setq nnshimbun-backlog-articles gnus-backlog-articles
 107              nnshimbun-backlog-hashtb gnus-backlog-hashtb))))
 108 (put 'nnshimbun-backlog 'lisp-indent-function 0)
 109 (put 'nnshimbun-backlog 'edebug-form-spec '(form body))
 110
 111
 112
 113 ;;; Interface Functions
 114 (nnoo-define-basics nnshimbun)
 115
 116 (deffoo nnshimbun-open-server (server &optional defs)
 117   (let* ((type (or (car (cdr (assq 'nnshimbun-type defs)))
 118                    (if (not (equal server "")) (intern server))
 119                    nnshimbun-default-type))
 120          (defaults (cdr (assq type nnshimbun-type-definition))))
 121     (if (not defaults)
 122         (nnheader-report 'nnshimbun "Unknown server type: %s" type)
 123       (unless (assq 'nnshimbun-type defs)
 124         (setq defs (append defs (list (list 'nnshimbun-type type)))))
 125       (unless (assq 'nnshimbun-address defs)
 126         (setq defs (append defs (list (list 'nnshimbun-address
 127                                             (if (equal server "")
 128                                                 (symbol-name type)
 129                                               server))))))
 130       (nnoo-change-server 'nnshimbun server defs)
 131       ;; Set default vaules for defined server.
 132       (dolist (default defaults)
 133         (let ((symbol (intern (concat "nnshimbun-" (symbol-name (car default))))))
 134           (unless (assq symbol defs)
 135             (set symbol (cdr default)))))
 136       (nnshimbun-possibly-change-server nil server)
 137       (when (not (file-exists-p nnshimbun-directory))
 138         (ignore-errors (make-directory nnshimbun-directory t)))
 139       (cond
 140        ((not (file-exists-p nnshimbun-directory))
 141         (nnshimbun-close-server)
 142         (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-directory))
 143        ((not (file-directory-p (file-truename nnshimbun-directory)))
 144         (nnshimbun-close-server)
 145         (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-directory))
 146        (t
 147         (when (not (file-exists-p nnshimbun-server-directory))
 148           (ignore-errors (make-directory nnshimbun-server-directory t)))
 149         (cond
 150          ((not (file-exists-p nnshimbun-server-directory))
 151           (nnshimbun-close-server)
 152           (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-server-directory))
 153          ((not (file-directory-p (file-truename nnshimbun-server-directory)))
 154           (nnshimbun-close-server)
 155           (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-server-directory))
 156          (t
 157           (nnheader-report 'nnshimbun "Opened server %s using directory %s"
 158                            server nnshimbun-server-directory)
 159           t)))))))
 160
 161 (deffoo nnshimbun-close-server (&optional server)
 162   (when (and (nnshimbun-server-opened server)
 163              (gnus-buffer-live-p nnshimbun-buffer))
 164     (save-excursion
 165       (set-buffer nnshimbun-buffer)
 166       (kill-buffer nnshimbun-buffer)))
 167   (nnshimbun-backlog
 168     (gnus-backlog-shutdown))
 169   (nnshimbun-save-nov)
 170   (nnoo-close-server 'nnshimbun server)
 171   t)
 172
 173 (defun nnshimbun-get-url (url)
 174   (let ((coding-system-for-read 'binary)
 175         (coding-system-for-write 'binary))
 176     (set-buffer-multibyte nil)
 177     (nnweb-insert url)
 178     (decode-coding-region (point-min) (point-max) nnshimbun-coding-system)
 179     (set-buffer-multibyte t)))
 180
 181 (deffoo nnshimbun-request-article (article &optional group server to-buffer)
 182   (when (nnshimbun-possibly-change-server group server)
 183     (if (stringp article)
 184         (setq article (nnshimbun-search-id group article)))
 185     (if (integerp article)
 186         (if (nnshimbun-backlog
 187               (gnus-backlog-request-article group article
 188                                             (or to-buffer nntp-server-buffer)))
 189             (cons group article)
 190           (let (header contents)
 191             (when (setq header (save-excursion
 192                                  (set-buffer (nnshimbun-open-nov group))
 193                                  (and (nnheader-find-nov-line article)
 194                                       (nnheader-parse-nov))))
 195               (let ((xref (substring (mail-header-xref header) 6)))
 196                 (save-excursion
 197                   (set-buffer nnshimbun-buffer)
 198                   (erase-buffer)
 199                   (nnshimbun-get-url xref)
 200                   (nnheader-message 6 "nnshimbun: Make contents...")
 201                   (setq contents (funcall nnshimbun-make-contents header))
 202                   (nnheader-message 6 "nnshimbun: Make contents...done"))))
 203             (when contents
 204               (save-excursion
 205                 (set-buffer (or to-buffer nntp-server-buffer))
 206                 (erase-buffer)
 207                 (insert contents)
 208                 (nnshimbun-backlog
 209                   (gnus-backlog-enter-article group article (current-buffer)))
 210                 (nnheader-report 'nnshimbun "Article %s retrieved" (mail-header-id header))
 211                 (cons group (mail-header-number header))))))
 212       (nnheader-report 'nnml "Couldn't retrieve article: %s" (prin1-to-string article))
 213       nil)))
 214
 215 (deffoo nnshimbun-request-group (group &optional server dont-check)
 216   (let ((pathname-coding-system 'binary))
 217     (cond
 218      ((not (nnshimbun-possibly-change-server group server))
 219       (nnheader-report 'nnshimbun "Invalid group (no such directory)"))
 220      ((not (file-exists-p nnshimbun-current-directory))
 221       (nnheader-report 'nnshimbun "Directory %s does not exist"
 222                        nnshimbun-current-directory))
 223      ((not (file-directory-p nnshimbun-current-directory))
 224       (nnheader-report 'nnshimbun "%s is not a directory" nnshimbun-current-directory))
 225      (dont-check
 226       (nnheader-report 'nnshimbun "Group %s selected" group)
 227       t)
 228      (t
 229       (let (beg end lines)
 230         (save-excursion
 231           (set-buffer (nnshimbun-open-nov group))
 232           (goto-char (point-min))
 233           (setq beg (ignore-errors (read (current-buffer))))
 234           (goto-char (point-max))
 235           (forward-line -1)
 236           (setq end (ignore-errors (read (current-buffer)))
 237                 lines (count-lines (point-min) (point-max))))
 238         (nnheader-report 'nnshimbunw "Selected group %s" group)
 239         (nnheader-insert "211 %d %d %d %s\n"
 240                          lines (or beg 0) (or end 0) group))))))
 241
 242 (deffoo nnshimbun-request-scan (&optional group server)
 243   (nnshimbun-possibly-change-server group server)
 244   (nnshimbun-generate-nov-database group))
 245
 246 (deffoo nnshimbun-close-group (group &optional server)
 247   t)
 248
 249 (deffoo nnshimbun-request-list (&optional server)
 250   (save-excursion
 251     (set-buffer nntp-server-buffer)
 252     (erase-buffer)
 253     (dolist (group nnshimbun-groups)
 254       (when (nnshimbun-possibly-change-server group server)
 255         (let (beg end)
 256           (save-excursion
 257             (set-buffer (nnshimbun-open-nov group))
 258             (goto-char (point-min))
 259             (setq beg (ignore-errors (read (current-buffer))))
 260             (goto-char (point-max))
 261             (forward-line -1)
 262             (setq end (ignore-errors (read (current-buffer)))))
 263           (insert (format "%s %d %d n\n" group (or end 0) (or beg 0)))))))
 264   t) ; return value
 265
 266 (eval-and-compile
 267   (if (fboundp 'mime-entity-fetch-field)
 268       ;; For Semi-Gnus.
 269       (defun nnshimbun-insert-header (header)
 270         (insert "Subject: " (or (mime-entity-fetch-field header 'Subject) "(none)") "\n"
 271                 "From: " (or (mime-entity-fetch-field header 'From) "(nobody)") "\n"
 272                 "Date: " (or (mail-header-date header) "") "\n"
 273                 "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
 274                 "References: " (or (mail-header-references header) "") "\n"
 275                 "Lines: ")
 276         (princ (or (mail-header-lines header) 0) (current-buffer))
 277         (insert "\n"))
 278     ;; For pure Gnus.
 279     (defun nnshimbun-insert-header (header)
 280       (nnheader-insert-header header)
 281       (delete-char -1))))
 282
 283 (deffoo nnshimbun-retrieve-headers (articles &optional group server fetch-old)
 284   (when (nnshimbun-possibly-change-server group server)
 285     (if (nnshimbun-retrieve-headers-with-nov articles fetch-old)
 286         'nov
 287       (save-excursion
 288         (set-buffer nntp-server-buffer)
 289         (erase-buffer)
 290         (let (header)
 291           (dolist (art articles)
 292             (if (stringp art)
 293                 (setq art (nnshimbun-search-id group art)))
 294             (if (integerp art)
 295                 (when (setq header
 296                             (save-excursion
 297                               (set-buffer (nnshimbun-open-nov group))
 298                               (and (nnheader-find-nov-line art)
 299                                    (nnheader-parse-nov))))
 300                   (insert (format "220 %d Article retrieved.\n" art))
 301                   (nnshimbun-insert-header header)
 302                   (insert ".\n")
 303                   (delete-region (point) (point-max))))))
 304         'header))))
 305
 306 (defun nnshimbun-retrieve-headers-with-nov (articles &optional fetch-old)
 307   (if (or gnus-nov-is-evil nnshimbun-nov-is-evil)
 308       nil
 309     (let ((nov (expand-file-name nnshimbun-nov-file-name nnshimbun-current-directory)))
 310       (when (file-exists-p nov)
 311         (save-excursion
 312           (set-buffer nntp-server-buffer)
 313           (erase-buffer)
 314           (nnheader-insert-file-contents nov)
 315           (if (and fetch-old
 316                    (not (numberp fetch-old)))
 317               t                         ; Don't remove anything.
 318             (nnheader-nov-delete-outside-range
 319              (if fetch-old (max 1 (- (car articles) fetch-old))
 320                (car articles))
 321              (car (last articles)))
 322             t))))))
 323
 324
 325
 326 ;;; Nov Database Operations
 327
 328 (defun nnshimbun-generate-nov-database (group)
 329   (prog1 (funcall nnshimbun-generate-nov group)
 330     (save-excursion
 331       (set-buffer (nnshimbun-open-nov group))
 332       (when (buffer-modified-p)
 333         (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
 334                              nil 'nomesg)))))
 335
 336 (defun nnshimbun-search-id (group id)
 337   (save-excursion
 338     (set-buffer (nnshimbun-open-nov group))
 339     (goto-char (point-min))
 340     (let (number found)
 341       (while (and (not found)
 342                   (search-forward id nil t)) ; We find the ID.
 343         ;; And the id is in the fourth field.
 344         (if (not (and (search-backward "\t" nil t 4)
 345                       (not (search-backward "\t" (gnus-point-at-bol) t))))
 346             (forward-line 1)
 347           (beginning-of-line)
 348           (setq found t)
 349           ;; We return the article number.
 350           (setq number (ignore-errors (read (current-buffer))))))
 351       number)))
 352
 353 (defun nnshimbun-open-nov (group)
 354   (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist))))
 355     (if (buffer-live-p buffer)
 356         buffer
 357       (setq buffer (gnus-get-buffer-create
 358                     (format " *nnshimbun overview %s %s*"
 359                             nnshimbun-address group)))
 360       (save-excursion
 361         (set-buffer buffer)
 362         (set (make-local-variable 'nnshimbun-nov-buffer-file-name)
 363              (expand-file-name
 364               nnshimbun-nov-file-name
 365               (nnmail-group-pathname group nnshimbun-server-directory)))
 366         (erase-buffer)
 367         (when (file-exists-p nnshimbun-nov-buffer-file-name)
 368           (nnheader-insert-file-contents nnshimbun-nov-buffer-file-name))
 369         (set-buffer-modified-p nil))
 370       (push (cons group buffer) nnshimbun-nov-buffer-alist)
 371       buffer)))
 372
 373 (defun nnshimbun-save-nov ()
 374   (save-excursion
 375     (while nnshimbun-nov-buffer-alist
 376       (when (buffer-name (cdar nnshimbun-nov-buffer-alist))
 377         (set-buffer (cdar nnshimbun-nov-buffer-alist))
 378         (when (buffer-modified-p)
 379           (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
 380                                nil 'nomesg))
 381         (set-buffer-modified-p nil)
 382         (kill-buffer (current-buffer)))
 383       (setq nnshimbun-nov-buffer-alist (cdr nnshimbun-nov-buffer-alist)))))
 384
 385
 386
 387 ;;; Server Initialize
 388 (defun nnshimbun-possibly-change-server (group &optional server)
 389   (when server
 390     (unless (nnshimbun-server-opened server)
 391       (nnshimbun-open-server server)))
 392   (setq nnshimbun-server-directory
 393         (nnheader-concat nnshimbun-directory (concat nnshimbun-address "/")))
 394   (unless (gnus-buffer-live-p nnshimbun-buffer)
 395     (setq nnshimbun-buffer
 396           (save-excursion
 397             (nnheader-set-temp-buffer
 398              (format " *nnshimbun %s %s*" nnshimbun-type server)))))
 399   (if (not group)
 400       t
 401     (let ((pathname (nnmail-group-pathname group nnshimbun-server-directory))
 402           (pathname-coding-system 'binary))
 403       (when (not (equal pathname nnshimbun-current-directory))
 404         (setq nnshimbun-current-directory pathname
 405               nnshimbun-current-group group))
 406       (when (not (file-exists-p nnshimbun-current-directory))
 407         (ignore-errors (make-directory nnshimbun-current-directory t)))
 408       (cond
 409        ((not (file-exists-p nnshimbun-current-directory))
 410         (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-current-directory))
 411        ((not (file-directory-p (file-truename nnshimbun-current-directory)))
 412         (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-current-directory))
 413        (t t)))))
 414
 415
 416
 417 ;;; Misc Functions
 418
 419 (eval-and-compile
 420   (if (fboundp 'eword-encode-string)
 421       ;; For Semi-Gnus.
 422       (defun nnshimbun-mime-encode-string (string)
 423         (mapconcat
 424          #'identity
 425          (split-string (eword-encode-string (nnweb-decode-entities-string string)) "\n")
 426          ""))
 427     ;; For pure Gnus.
 428     (defun nnshimbun-mime-encode-string (string)
 429       (mapconcat
 430        #'identity
 431        (split-string
 432         (with-temp-buffer
 433           (insert (nnweb-decode-entities-string string))
 434           (rfc2047-encode-region (point-min) (point-max))
 435           (buffer-substring (point-min) (point-max)))
 436         "\n"))
 437       "")))
 438
 439 (defun nnshimbun-lapse-seconds (time)
 440   (let ((now (current-time)))
 441     (+ (* (- (car now) (car time)) 65536)
 442        (- (nth 1 now) (nth 1 time)))))
 443
 444
 445 ;; Fast fill-region function
 446
 447 (defvar nnshimbun-fill-column (min 80 (- (frame-width) 4)))
 448
 449 (defconst nnshimbun-kinsoku-bol-list
 450   (funcall
 451    (if (fboundp 'string-to-char-list)
 452        'string-to-char-list
 453      'string-to-list) "\
 454 !)-_~}]:;',.?¡¢¡£¡¤¡¥¡¦¡§¡¨¡©¡ª¡«¡¬¡¡®¡¯¡°¡±¡²¡³¡´¡µ¡¶¡·¡¸¡¹¡º¡»¡¼¡½¡¾¡¿¡À¡Á\
 455 ¡Â¡Ã¡Ä¡Å¡Ç¡É¡Ë¡Í¡Ï¡Ñ¡Ó¡Õ¡×¡Ù¡Û¡ë¡ì¡í¡î¤¡¤£¤¥¤§¤©¤Ã¤ã¤å¤ç¤î¥¡¥£¥¥¥§¥©¥Ã¥ã¥å¥ç¥î¥õ¥ö"))
 456
 457 (defconst nnshimbun-kinsoku-eol-list
 458   (funcall
 459    (if (fboundp 'string-to-char-list)
 460        'string-to-char-list
 461      'string-to-list)
 462    "({[`¡Æ¡È¡Ê¡Ì¡Î¡Ð¡Ò¡Ô¡Ö¡Ø¡Ú¡ë¡ì¡í¡ø"))
 463
 464 (defun nnshimbun-fill-line ()
 465   (forward-line 0)
 466   (let ((top (point)) chr)
 467     (while (if (>= (move-to-column fill-column) fill-column)
 468                (not (progn
 469                       (if (memq (preceding-char) nnshimbun-kinsoku-eol-list)
 470                           (progn
 471                             (backward-char)
 472                             (while (memq (preceding-char) nnshimbun-kinsoku-eol-list)
 473                               (backward-char))
 474                             (insert "\n"))
 475                         (while (memq (setq chr (following-char)) nnshimbun-kinsoku-bol-list)
 476                           (forward-char))
 477                         (if (looking-at "\\s-+")
 478                             (or (eolp) (delete-region (point) (match-end 0)))
 479                           (or (> (char-width chr) 1)
 480                               (re-search-backward "\\<" top t)
 481                               (end-of-line)))
 482                         (or (eolp) (insert "\n"))))))
 483       (setq top (point))))
 484   (forward-char)
 485   (not (eobp)))
 486
 487
 488
 489 ;;; www.asahi.com
 490
 491 (defun nnshimbun-asahi-get-headers (group)
 492   (save-excursion
 493     (set-buffer nnshimbun-buffer)
 494     (erase-buffer)
 495     (nnshimbun-get-url (format "%sp%s.html" nnshimbun-url group))
 496     (goto-char (point-min))
 497     (when (search-forward "\n<!-- Start of past -->\n" nil t)
 498       (delete-region (point-min) (point))
 499       (when (search-forward "\n<!-- End of past -->\n" nil t)
 500         (forward-line -1)
 501         (delete-region (point) (point-max))
 502         (goto-char (point-min))
 503         (let (headers)
 504           (while (re-search-forward
 505                   "^¢£<a href=\"\\(\\([0-9][0-9][0-9][0-9]\\)/past/\\([A-z]*[0-9]*\\)\\.html\\)\"> *"
 506                   nil t)
 507             (let ((id (format "<%s%s%%%s>" (match-string 2) (match-string 3) group))
 508                   (url (match-string 1)))
 509               (push (make-full-mail-header
 510                      0
 511                      (nnshimbun-mime-encode-string
 512                       (mapconcat 'identity
 513                                  (split-string
 514                                   (buffer-substring
 515                                    (match-end 0)
 516                                    (progn (search-forward "<br>" nil t) (point)))
 517                                   "<[^>]+>")
 518                                  ""))
 519                      "webmaster@www.asahi.com"
 520                      "" id "" 0 0 (concat nnshimbun-url url))
 521                     headers)))
 522           (setq headers (nreverse headers))
 523           (let ((i 0))
 524             (while (and (nth i headers)
 525                         (re-search-forward
 526                          "^\\[\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\]"
 527                          nil t))
 528               (let ((month (string-to-number (match-string 1)))
 529                     (day (string-to-number (match-string 2)))
 530                     (time (match-string 3))
 531                     (date (decode-time (current-time))))
 532                 (mail-header-set-date
 533                  (nth i headers)
 534                  (timezone-make-arpa-date (if (and (= 12 month) (= 1 (nth 4 date)))
 535                                               (1- (nth 5 date))
 536                                             (nth 5 date))
 537                                           month
 538                                           day
 539                                           time
 540                                           '(32400))))
 541               (setq i (1+ i))))
 542           (nreverse headers))))))
 543
 544 (defun nnshimbun-asahi-generate-nov-database (group)
 545   (save-excursion
 546     (set-buffer (nnshimbun-open-nov group))
 547     (let (i)
 548       (goto-char (point-max))
 549       (forward-line -1)
 550       (setq i (or (ignore-errors (read (current-buffer))) 0))
 551       (goto-char (point-max))
 552       (dolist (header (nnshimbun-asahi-get-headers group))
 553         (unless (nnshimbun-search-id group (mail-header-id header))
 554           (mail-header-set-number header (setq i (1+ i)))
 555           (nnheader-insert-nov header))))))
 556
 557 (defun nnshimbun-asahi-make-contents (header)
 558   (goto-char (point-min))
 559   (let (start (html t))
 560     (when (and (search-forward "\n<!-- Start of kiji -->\n" nil t)
 561                (setq start (point))
 562                (search-forward "\n<!-- End of kiji -->\n" nil t))
 563       (delete-region (point-min) start)
 564       (forward-line -1)
 565       (delete-region (point) (point-max))
 566       (goto-char (point-min))
 567       (while (search-forward "<p>" nil t)
 568         (insert "\n"))
 569       (nnweb-remove-markup)
 570       (nnweb-decode-entities)
 571       (goto-char (point-min))
 572       (while (not (eobp))
 573         ;(fill-region (point) (gnus-point-at-eol))
 574         (nnshimbun-fill-line)
 575         (forward-line 1))
 576       (setq html nil))
 577     (goto-char (point-min))
 578     (nnshimbun-insert-header header)
 579     (insert "Content-Type: " (if html "text/html" "text/plain")
 580             "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
 581     (encode-coding-string (buffer-string)
 582                           (if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))))
 583
 584
 585
 586 (provide 'nnshimbun)
 587 ;;; nnshimbun.el ends here.