+2001-04-04 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * shimbun.el, sb-airs.el, sb-asahi.el, sb-bbdb-ml.el, sb-cnet.el,
+ sb-fml.el, sb-lump.el, sb-mew.el, sb-mhonarc.el,
+ sb-netbsd.el, sb-sponichi.el, sb-text.el, sb-wired.el,
+ sb-xemacs.el, sb-yomiuri.el, sb-zdnet.el, sb-tcup.el: Removed.
+
+ * elmo-util.el (elmo-resque-obsolete-variable): Fix.
+
2001-04-03 Yuuichi Teranishi <teranisi@gohome.org>
* sb-airs.el: Added footer.
(when (boundp obsolete)
(static-if (and (fboundp 'defvaralias)
(subrp (symbol-function 'defvaralias)))
- (defvaralias obsolete var)
+ (defvaralias var obsolete)
(set var (symbol-value obsolete)))
(if elmo-obsolete-variable-show-warnings
(elmo-warning (format "%s is obsolete. Use %s instead."
+++ /dev/null
-;;; sb-airs.el --- shimbun backend for lists.airs.net
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original was nnshimbun-airs.el on http://homepage2.nifty.com/strlcat/
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-mhonarc)
-
-(luna-define-class shimbun-airs (shimbun-mhonarc) ())
-
-(defconst shimbun-airs-group-path-alist
- '(("semi-gnus-ja" . "semi-gnus/archive")
- ("wl" . "wl/archive")))
-
-(defvar shimbun-airs-url "http://lists.airs.net/")
-(defvar shimbun-airs-groups (mapcar 'car shimbun-airs-group-path-alist))
-(defvar shimbun-airs-coding-system (static-if (boundp 'MULE)
- '*euc-japan* 'euc-jp))
-
-(defmacro shimbun-airs-concat-url (shimbun url)
- (` (concat (shimbun-url-internal (, shimbun))
- (cdr (assoc (shimbun-current-group-internal (, shimbun))
- shimbun-airs-group-path-alist))
- "/"
- (, url))))
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-airs))
- (shimbun-airs-concat-url shimbun "index.html"))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-airs))
- (let ((case-fold-search t) headers months)
- (goto-char (point-min))
- ;; Only first month...
- (if (re-search-forward "<A HREF=\"\\([0-9]+\\)/\">" nil t)
- (push (match-string 1) months))
- (setq months (nreverse months))
- (dolist (month months)
- (erase-buffer)
- (shimbun-retrieve-url
- shimbun
- (shimbun-airs-concat-url shimbun (concat month "/index.html"))
- t)
- (let (id url subject)
- (goto-char (point-max))
- (while (re-search-backward
- "<A[^>]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)</A>"
- nil t)
- (setq url (shimbun-airs-concat-url
- shimbun
- (concat month "/" (match-string 1)))
- id (format "<%s%05d%%%s>"
- month
- (string-to-number (match-string 2))
- (shimbun-current-group-internal shimbun))
- subject (match-string 3))
- (save-excursion
- (goto-char (match-end 0))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (if (looking-at "</STRONG> *<EM>\\([^<]+\\)<")
- (shimbun-mime-encode-string (match-string 1))
- "")
- "" id "" 0 0 url)
- headers)))))
- headers))
-
-(provide 'sb-airs)
-
-;;; sb-airs.el ends here
+++ /dev/null
-;;; sb-asahi.el --- shimbun backend for asahi.com
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-text)
-(luna-define-class shimbun-asahi (shimbun shimbun-text) ())
-
-(defvar shimbun-asahi-url "http://spin.asahi.com/")
-(defvar shimbun-asahi-groups '("national" "business" "politics"
- "international" "sports"))
-(defvar shimbun-asahi-coding-system (static-if (boundp 'MULE) '*sjis*
- 'shift_jis))
-(defvar shimbun-asahi-from-address "webmaster@www.asahi.com")
-
-(defvar shimbun-asahi-content-start "\n<!-- Start of kiji -->\n")
-(defvar shimbun-asahi-content-end "\n<!-- End of kiji -->\n")
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-asahi))
- (format "%s%s/update/list.html"
- (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun)))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-asahi))
- (when (search-forward "\n<!-- Start of past -->\n" nil t)
- (delete-region (point-min) (point))
- (when (search-forward "\n<!-- End of past -->\n" nil t)
- (forward-line -1)
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (let ((case-fold-search t)
- headers)
- (while (re-search-forward
- "<a href=\"\\(\\([0-9][0-9][0-9][0-9]\\)/\\([0-9]+\\)\\.html\\)\"> *"
- nil t)
- (let ((id (format "<%s%s%%%s>"
- (match-string 2)
- (match-string 3)
- (shimbun-current-group-internal shimbun)))
- (url (match-string 1)))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "\\(<[^>]+>\\|\r\\)")
- ""))
- (shimbun-from-address-internal shimbun)
- "" id "" 0 0 (format "%s%s/update/%s"
- (shimbun-url-internal shimbun)
- (shimbun-current-group-internal
- shimbun)
- url))
- headers)))
- (setq headers (nreverse headers))
- (let ((i 0))
- (while (and (nth i headers)
- (re-search-forward
- "^(\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\))"
- nil t))
- (let ((month (string-to-number (match-string 1)))
- (date (decode-time (current-time))))
- (shimbun-header-set-date
- (nth i headers)
- (shimbun-make-date-string
- (if (and (eq 12 month) (eq 1 (nth 4 date)))
- (1- (nth 5 date))
- (nth 5 date))
- month
- (string-to-number (match-string 2))
- (match-string 3))))
- (setq i (1+ i))))
- (nreverse headers)))))
-
-(provide 'sb-asahi)
-
-;;; sb-asahi.el ends here
+++ /dev/null
-;;; sb-bbdb-ml.el --- shimbun backend for bbdb-ml
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-fml)
-
-(luna-define-class shimbun-bbdb-ml (shimbun-fml) ())
-
-(defvar shimbun-bbdb-ml-url "http://www.rc.tutrp.tut.ac.jp/bbdb-ml/")
-(defvar shimbun-bbdb-ml-groups '("bbdb-ml"))
-(defvar shimbun-bbdb-ml-coding-system (static-if (boundp 'MULE)
- '*iso-2022-jp* 'iso-2022-jp))
-
-(provide 'sb-bbdb-ml)
-
-;;; sb-bbdb-ml.el ends here
+++ /dev/null
-;;; sb-cnet.el --- shimbun backend for cnet
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-
-(luna-define-class shimbun-cnet (shimbun) ())
-
-(defvar shimbun-cnet-url "http://cnet.sphere.ne.jp/")
-(defvar shimbun-cnet-groups '("comp"))
-(defvar shimbun-cnet-coding-system (static-if (boundp 'MULE)
- '*sjis* 'shift_jis))
-(defvar shimbun-cnet-from-address "cnet@sphere.ad.jp")
-(defvar shimbun-cnet-content-start "\n<!--KIJI-->\n")
-(defvar shimbun-cnet-content-end "\n<!--/KIJI-->\n")
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-cnet))
- (format "%s/News/Oneweek/" (shimbun-url-internal shimbun)))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-cnet))
- (let ((case-fold-search t) headers)
- (while (search-forward "\n<!--*****\e$B8+=P$7\e(B*****-->\n" nil t)
- (let ((subject (buffer-substring (point) (point-at-eol)))
- (point (point)))
- (forward-line -2)
- (when (looking-at "<a href=\"/\\(News/\\([0-9][0-9][0-9][0-9]\\)/Item/\\([0-9][0-9]\\([0-9][0-9]\\)\\([0-9][0-9]\\)-[0-9]+\\).html\\)\">")
- (let ((url (match-string 1))
- (id (format "<%s%s%%%s>"
- (match-string 2)
- (match-string 3)
- (shimbun-current-group-internal shimbun)))
- (date (shimbun-make-date-string
- (string-to-number (match-string 2))
- (string-to-number (match-string 4))
- (string-to-number (match-string 5)))))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (shimbun-from-address-internal shimbun)
- date id "" 0 0 (concat (shimbun-url-internal shimbun) url))
- headers)))
- (goto-char point)))
- headers))
-
-(provide 'sb-cnet)
-
-;;; sb-cnet.el ends here
+++ /dev/null
-;;; sb-fml.el --- shimbun backend class for fml archiver.
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-
-(luna-define-class shimbun-fml (shimbun) ())
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-fml))
- (let ((case-fold-search t)
- headers auxs aux)
- (catch 'stop
- ;; Only latest month.
- (if (re-search-forward "<a href=\"\\([0-9]+\\(\\.week\\|\\.month\\)?\\)/index.html\">" nil t)
- (setq auxs (append auxs (list (match-string 1)))))
- (while auxs
- (with-temp-buffer
- (shimbun-retrieve-url
- shimbun
- (concat (shimbun-url-internal shimbun) (setq aux (car auxs)) "/"))
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (let ((case-fold-search t)
- id url date subject from)
- (goto-char (point-min))
- (while (re-search-forward
- "<LI><A HREF=\"\\([0-9]+\\.html\\)\">Article .*</A> <DIV><SPAN CLASS=article>Article <SPAN CLASS=article-value>\\([0-9]+\\)</SPAN></SPAN> at <SPAN CLASS=Date-value>\\([^<]*\\)</SPAN> <SPAN CLASS=Subject>Subject: <SPAN CLASS=Subject-value>\\([^<]*\\)</SPAN></SPAN></DIV><DIV><SPAN CLASS=From>From: <SPAN CLASS=From-value>\\([^<]*\\)</SPAN></SPAN></DIV>"
- nil t)
- (setq url (concat (shimbun-url-internal shimbun)
- aux "/" (match-string 1))
- id (format "<%s%05d%%%s>"
- aux
- (string-to-number (match-string 2))
- (shimbun-current-group-internal shimbun))
- date (match-string 3)
- subject (match-string 4)
- from (match-string 5))
- (forward-line 1)
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- from date id "" 0 0 url)
- headers)))
- (setq auxs (cdr auxs))))
- headers)))
-
-(luna-define-method shimbun-make-contents ((shimbun shimbun-fml) header)
- (catch 'stop
- (if (search-forward "<SPAN CLASS=mailheaders>" nil t)
- (delete-region (point-min) (point))
- (throw 'stop nil))
- (if (search-forward "</PRE>")
- (progn
- (beginning-of-line)
- (delete-region (point) (point-max)))
- (throw 'stop nil))
- (if (search-backward "</SPAN>")
- (progn
- (beginning-of-line)
- (kill-line))
- (throw 'stop nil))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (shimbun-decode-entities)
- (goto-char (point-min))
- (let ((header (shimbun-make-header))
- field value start value-beg end)
- (while (and (setq start (point))
- (re-search-forward "<SPAN CLASS=\\(.*\\)>\\(.*\\)</SPAN>:"
- nil t)
- (setq field (match-string 2))
- (re-search-forward
- (concat "<SPAN CLASS=" (match-string 1) "-value>") nil t)
- (setq value-beg (point))
- (search-forward "</SPAN>" nil t)
- (setq end (point)))
- (setq value (buffer-substring value-beg
- (progn (search-backward "</SPAN>")
- (point))))
- (delete-region start end)
- (cond ((string= field "Date")
- (shimbun-header-set-date header value))
- ((string= field "From")
- (shimbun-header-set-from header value))
- ((string= field "Subject")
- (shimbun-header-set-subject header value))
- ((string= field "Message-Id")
- (shimbun-header-set-id header value))
- ((string= field "References")
- (shimbun-header-set-references header value))
- (t
- (insert (concat field ": " value "\n")))))
- (goto-char (point-min))
- (shimbun-header-insert header))
- (goto-char (point-max)))
- ;; Processing body.
- (save-restriction
- (narrow-to-region (point) (point-max))
- (shimbun-remove-markup)
- (shimbun-decode-entities)))
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP")))
-
-(provide 'sb-fml)
-
-;;; sb-fml.el ends here
+++ /dev/null
-;;; sb-lump.el --- shimbun backend class to check all groups at once
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(defvar shimbun-lump-check-interval 300)
-
-(eval-and-compile
- (luna-define-class shimbun-lump (shimbun) (group-header-alist last-check))
- (luna-define-internal-accessors 'shimbun-lump))
-
-(defun shimbun-lump-lapse-seconds (time)
- (let ((now (current-time)))
- (+ (* (- (car now) (car time)) 65536)
- (- (nth 1 now) (nth 1 time)))))
-
-(defun shimbun-lump-check-p (shimbun)
- (or (null (shimbun-lump-last-check-internal shimbun))
- (and (shimbun-lump-last-check-internal shimbun)
- (< (shimbun-lump-lapse-seconds
- (shimbun-lump-last-check-internal shimbun))
- shimbun-lump-check-interval))))
-
-(defun shimbun-lump-checked (shimbun)
- (shimbun-lump-set-last-check-internal shimbun (current-time)))
-
-(luna-define-generic shimbun-get-group-header-alist (shimbun)
- "Return an alist of group and header list.")
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-lump))
- (when (shimbun-lump-check-p shimbun)
- (shimbun-lump-set-group-header-alist-internal
- shimbun (shimbun-get-group-header-alist shimbun))
- (shimbun-lump-checked shimbun))
- (cdr (assoc (shimbun-current-group-internal shimbun)
- (shimbun-lump-group-header-alist-internal shimbun))))
-
-(luna-define-method shimbun-close :after ((shimbun shimbun-lump))
- (shimbun-lump-set-group-header-alist-internal shimbun nil)
- (shimbun-lump-set-last-check-internal shimbun nil))
-
-(provide 'sb-lump)
-
-;;; sb-lump.el ends here
+++ /dev/null
-;;; sb-mew.el --- shimbun backend for mew.org
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-mhonarc)
-(luna-define-class shimbun-mew (shimbun-mhonarc) ())
-
-(defconst shimbun-mew-groups
- '(("meadow-develop" "meadow-develop" nil t)
- ("meadow-users-jp" "meadow-users-jp")
- ("mule-win32" "mule-win32")
- ("mew-win32" "mew-win32")
- ("mew-dist" "mew-dist/3300" t)
- ("mgp-users-jp" "mgp-users-jp/A" t t)))
-
-(luna-define-method initialize-instance :after ((shimbun shimbun-mew)
- &rest init-args)
- (shimbun-set-url-internal shimbun "http://www.mew.org/archive/")
- (shimbun-set-groups-internal shimbun
- (mapcar 'car shimbun-mew-groups))
- (shimbun-set-coding-system-internal shimbun
- (static-if (boundp 'MULE)
- '*iso-2022-jp* 'iso-2022-jp))
- shimbun)
-
-(defmacro shimbun-mew-concat-url (shimbun url)
- (` (concat (shimbun-url-internal (, shimbun))
- (nth 1 (assoc
- (shimbun-current-group-internal (, shimbun))
- shimbun-mew-groups))
- "/"
- (, url))))
-
-(defmacro shimbun-mew-reverse-order-p (shimbun)
- (` (nth 2 (assoc (shimbun-current-group-internal (, shimbun))
- shimbun-mew-groups))))
-
-(defmacro shimbun-mew-spew-p (shimbun)
- (` (nth 3 (assoc (shimbun-current-group-internal (, shimbun))
- shimbun-mew-groups))))
-
-(defsubst shimbun-mew-retrieve-xover (shimbun aux)
- (erase-buffer)
- (shimbun-retrieve-url
- shimbun
- (shimbun-mew-concat-url
- shimbun
- (if (= aux 1) "index.html" (format "mail%d.html" aux)))
- t))
-
-(defconst shimbun-mew-regexp "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<")
-
-(defsubst shimbun-mew-extract-header-values (shimbun)
- (let (url id subject)
- (setq url (shimbun-mew-concat-url shimbun (match-string 1))
- id (format "<%05d%%%s>"
- (1- (string-to-number (match-string 2)))
- (shimbun-current-group-internal shimbun))
- subject (match-string 3))
- (forward-line 1)
- (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (if (looking-at "<EM>\\([^<]+\\)<")
- (shimbun-mime-encode-string (match-string 1))
- "")
- "" id "" 0 0 url)))
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-mew))
- (shimbun-mew-concat-url shimbun "index.html"))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-mew))
- (shimbun-mew-get-headers shimbun))
-
-(defun shimbun-mew-get-headers (shimbun)
- (let ((case-fold-search t)
- headers)
- (goto-char (point-min))
- (when (re-search-forward
- "<A[^>]*href=\"mail\\([0-9]+\\)\\.html\">\\[?Last Page\\]?</A>"
- nil t)
- (let ((limit 1));(string-to-number (match-string 1))))
- (catch 'stop
- (if (shimbun-mew-reverse-order-p shimbun)
- (let ((aux 1))
- (while (let (id url subject)
- (while (re-search-forward shimbun-mew-regexp nil t)
- (push (shimbun-mew-extract-header-values shimbun)
- headers))
- (< aux limit))
- (shimbun-mew-retrieve-xover shimbun (setq aux (1+ aux)))))
- (while (> limit 0)
- (shimbun-mew-retrieve-xover shimbun limit)
- (setq limit (1- limit))
- (let (id url subject)
- (goto-char (point-max))
- (while (re-search-backward shimbun-mew-regexp nil t)
- (push (shimbun-mew-extract-header-values shimbun)
- headers)
- (forward-line -2)))))
- headers)))))
-
-(provide 'sb-mew)
-
-;;; sb-mew.el ends here
+++ /dev/null
-;;; sb-mhonarc.el --- shimbun backend class for mhonarc
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(luna-define-class shimbun-mhonarc (shimbun) ())
-
-(luna-define-method shimbun-make-contents ((shimbun shimbun-mhonarc)
- header)
- (if (search-forward "<!--X-Head-End-->" nil t)
- (progn
- (forward-line 0)
- ;; Processing headers.
- (save-restriction
- (narrow-to-region (point-min) (point))
- (shimbun-decode-entities)
- (goto-char (point-min))
- (while (search-forward "\n<!--X-" nil t)
- (replace-match "\n"))
- (goto-char (point-min))
- (while (search-forward " -->\n" nil t)
- (replace-match "\n"))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (let (buf refs)
- (while (not (eobp))
- (cond
- ((looking-at "<!--")
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Subject: +")
- (shimbun-header-set-subject header
- (shimbun-header-field-value))
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "From: +")
- (shimbun-header-set-from header (shimbun-header-field-value))
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Date: +")
- (shimbun-header-set-date header (shimbun-header-field-value))
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Message-Id: +")
- (shimbun-header-set-id header
- (concat "<" (shimbun-header-field-value) ">"))
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Reference: +")
- (push (concat "<" (shimbun-header-field-value) ">") refs)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Content-Type: ")
- (unless (search-forward "charset" (point-at-eol) t)
- (end-of-line)
- (insert "; charset=ISO-2022-JP"))
- (forward-line 1))
- (t (forward-line 1))))
- (insert "MIME-Version: 1.0\n")
- (if refs
- (shimbun-header-set-references header
- (mapconcat 'identity refs " ")))
- (insert "\n")
- (goto-char (point-min))
- (shimbun-header-insert header))
- (goto-char (point-max)))
- ;; Processing body.
- (save-restriction
- (narrow-to-region (point) (point-max))
- (delete-region
- (point)
- (progn
- (search-forward "\n<!--X-Body-of-Message-->\n" nil t)
- (point)))
- (when (search-forward "\n<!--X-Body-of-Message-End-->\n" nil t)
- (forward-line -1)
- (delete-region (point) (point-max)))
- (shimbun-remove-markup)
- (shimbun-decode-entities)))
- (goto-char (point-min))
- (shimbun-header-insert header)
- (insert
- "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n"))
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP")))
-
-(provide 'sb-mhonarc)
-
-;;; sb-mhonarc.el ends here
+++ /dev/null
-;;; sb-netbsd.el --- shimbun backend for netbsd.org
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-mhonarc)
-
-(luna-define-class shimbun-netbsd (shimbun-mhonarc) ())
-
-(defvar shimbun-netbsd-url "http://www.jp.netbsd.org/ja/JP/ml/")
-(defvar shimbun-netbsd-groups '("announce-ja" "junk-ja" "tech-misc-ja"
- "tech-pkg-ja" "port-arm32-ja" "port-hpcmips-ja"
- "port-mac68k-ja" "port-mips-ja"
- "port-powerpc-ja" "hpcmips-changes-ja"
- "members-ja" "admin-ja" "www-changes-ja"))
-(defvar shimbun-netbsd-coding-system (static-if (boundp 'MULE)
- '*iso-2022-jp* 'iso-2022-jp))
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-netbsd))
- (format "%s%s/index.html" (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun)))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-netbsd))
- (let ((case-fold-search t) headers months)
- (goto-char (point-min))
- ;; Only latest month
- (if (re-search-forward
- "<A HREF=\"\\([0-9]+\\)/\\(threads.html\\)?\">" nil t)
- (push (match-string 1) months))
- (setq months (nreverse months))
- (dolist (month months)
- (erase-buffer)
- (shimbun-retrieve-url
- shimbun
- (format "%s%s/%s/maillist.html"
- (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun) month)
- t)
- (let (id url subject)
- (while (re-search-forward
- "<A[^>]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)</A>"
- nil t)
- (setq url (format "%s%s/%s/%s"
- (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun)
- month
- (match-string 1))
- id (format "<%s%05d%%%s>"
- month
- (string-to-number (match-string 2))
- (shimbun-current-group-internal shimbun))
- subject (match-string 3))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (if (looking-at "</STRONG> *<EM>\\([^<]+\\)<")
- (shimbun-mime-encode-string (match-string 1))
- "")
- "" id "" 0 0 url)
- headers))))
- headers))
-
-(provide 'sb-netbsd)
-
-;;; sb-netbsd.el ends here
+++ /dev/null
-;;; sb-sponichi.el --- shimbun backend for www.sponichi.co.jp
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-text)
-
-(luna-define-class shimbun-sponichi (shimbun shimbun-text) ())
-
-(defvar shimbun-sponichi-url "http://www.sponichi.co.jp/")
-(defvar shimbun-sponichi-groups '("baseball" "soccer" "usa" "others"
- "society" "entertainment" "horseracing"))
-(defvar shimbun-sponichi-coding-system (static-if (boundp 'MULE)
- '*sjis* 'shift_jis))
-(defvar shimbun-sponichi-from-address "webmaster@www.sponichi.co.jp")
-(defvar shimbun-sponichi-content-start "\n<span class=\"text\">\e$B!!\e(B")
-(defvar shimbun-sponichi-content-end "\n")
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-sponichi))
- (format "%s%s/index.html"
- (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun)))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-sponichi))
- (when (search-forward "\e$B%K%e!<%9%$%s%G%C%/%9\e(B" nil t)
- (delete-region (point-min) (point))
- (when (search-forward "\e$B%"%I%?%0\e(B" nil t)
- (forward-line 2)
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (let ((case-fold-search t)
- headers)
- (while (re-search-forward
- "^<a href=\"/\\(\\([A-z]*\\)/kiji/\\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)\\.html\\)\">"
- nil t)
- (let ((url (match-string 1))
- (id (format "<%s%s%s%s%%%s>"
- (match-string 3)
- (match-string 4)
- (match-string 5)
- (match-string 6)
- (shimbun-current-group-internal shimbun)))
- (date (shimbun-make-date-string
- (string-to-number (match-string 3))
- (string-to-number (match-string 4))
- (string-to-number (match-string 5)))))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "<[^>]+>")
- ""))
- (shimbun-from-address-internal shimbun)
- date id "" 0 0 (concat (shimbun-url-internal shimbun)
- url))
- headers)))
- headers))))
-
-(provide 'sb-sponichi)
-
-;;; sb-sponichi.el ends here
+++ /dev/null
-;;; sb-tcup.el --- shimbun backend for www.tcup.com.
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original was http://homepage2.nifty.com/strlcat/nnshimbun-tcup.el
-
-;;; Code:
-
-(require 'shimbun)
-
-(eval-and-compile
- (luna-define-class shimbun-tcup (shimbun) (content-hash))
- (luna-define-internal-accessors 'shimbun-tcup))
-
-(defconst shimbun-tcup-group-alist
- '(("yutopia" "http://www66.tcup.com/6629/yutopia.html")))
-
-(defvar shimbun-tcup-url "http://www.tcup.com/")
-(defvar shimbun-tcup-groups (mapcar 'car shimbun-tcup-group-alist))
-(defvar shimbun-tcup-coding-system (static-if (boundp 'MULE)
- '*sjis* 'shift_jis))
-(defvar shimbun-tcup-content-hash-length 31)
-
-(luna-define-method initialize-instance :after ((shimbun shimbun-tcup)
- &rest init-args)
- (shimbun-tcup-set-content-hash-internal
- shimbun
- (make-vector shimbun-tcup-content-hash-length 0))
- shimbun)
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-tcup))
- (cadr (assoc (shimbun-current-group-internal shimbun)
- shimbun-tcup-group-alist)))
-
-(defun shimbun-tcup-get-group-key (group)
- (let ((url (cadr (assoc group
- shimbun-tcup-group-alist)))
- (n 3)
- keys)
- (string-match "www\\([0-9]+\\)[^/]+/\\([0-9]+\\)/\\(.+\\)\\.html" url)
- (while (> n 0)
- (push (substring url (match-beginning n) (match-end n)) keys)
- (setq n (1- n)))
- keys))
-
-(defun shimbun-tcup-stime-to-time (stime)
- (let (a b c)
- (setq a (length stime))
- (setq b (- (string-to-number (substring stime 0 (- a 4))) 9))
- (setq c (+ (string-to-number (substring stime (- a 4) a))
- (* (% b 4096) 10000)
- (- 90000 (car (current-time-zone)))))
- (list (+ (* (/ b 4096) 625) (/ c 65536)) (% c 65536))))
-
-(defun shimbun-tcup-make-time ()
- (let (yr mon day hr min sec dow tm)
- (looking-at
- "\\([0-9]+\\)\e$B7n\e(B\\([0-9]+\\)\e$BF|\e(B(\\(.\\))\\([0-9]+\\)\e$B;~\e(B\\([0-9]+\\)\e$BJ,\e(B\\([0-9]+\\)\e$BIC\e(B")
- (setq mon (string-to-number (match-string 1))
- day (string-to-number (match-string 2))
- dow (match-string 3)
- hr (string-to-number (match-string 4))
- min (string-to-number (match-string 5))
- sec (string-to-number (match-string 6)))
- (setq dow (string-match dow "\e$BF|7n2P?eLZ6bEZ\e(B"))
- (setq yr (nth 5 (decode-time (current-time))))
- (setq tm (encode-time sec min hr day mon yr))
- (while (not (eq dow (nth 6 (decode-time tm))))
- (setq yr (1- yr))
- (setq tm (encode-time sec min hr day mon yr)))
- tm))
-
-(defun shimbun-tcup-make-id (stime group)
- (let ((keys (shimbun-tcup-get-group-key group)))
- (format "<%s.%s.%s@www%s.tcup.com>"
- stime (nth 2 keys) (nth 1 keys) (nth 0 keys))))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-tcup))
- (let ((case-fold-search t)
- headers from subject date id url stime st body)
- (decode-coding-region (point-min) (point-max)
- (shimbun-coding-system-internal shimbun))
- (goto-char (point-min))
- (while (re-search-forward "<b>\\([^<]+\\)</b></font>\e$B!!Ej9F<T!'\e(B" nil t)
- (setq subject (match-string 1))
- (setq from
- (cond
- ((looking-at "<b><a href=\"mailto:\\([^\"]+\\)\">\\([^<]+\\)<")
- (concat (match-string 2) " <" (match-string 1) ">"))
- ((looking-at "<[^>]+><b>\\([^<]+\\)<")
- (match-string 1))
- (t "(none)")))
- (re-search-forward "\e$BEj9FF|!'\e(B" nil t)
- (setq stime
- (cond
- ((looking-at "[^,]+, Time: \\([^ ]+\\) ")
- (shimbun-tcup-stime-to-time (match-string 1)))
- ((looking-at "\\([^ ]+\\) <")
- (shimbun-tcup-make-time))
- (t (current-time))))
- (setq date (format-time-string "%d %b %Y %T %z" stime))
- (setq stime (format "%05d%05d" (car stime) (cadr stime)))
- (setq id (shimbun-tcup-make-id
- stime
- (shimbun-current-group-internal shimbun)))
- (search-forward "<tt><font size=\"3\">")
- (setq st (match-end 0))
- (re-search-forward "\\(<!-- form[^>]+>\\)?</font></tt><p>")
- (setq body (buffer-substring st (match-beginning 0)))
- (forward-line 1)
- (setq url
- (if (looking-at "<a[^>]+>[^<]+</a>")
- (concat (match-string 0) "\n<p>\n")
- ""))
- (set (intern stime (shimbun-tcup-content-hash-internal shimbun))
- (concat body "<p>\n" url))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (shimbun-mime-encode-string from)
- date id "" 0 0 stime)
- headers))
- headers))
-
-(luna-define-method shimbun-article ((shimbun shimbun-tcup) id
- &optional outbuf)
- (when (shimbun-current-group-internal shimbun)
- (let* ((header (shimbun-header shimbun id))
- (xref (shimbun-header-xref header)))
- (with-current-buffer (or outbuf (current-buffer))
- (insert
- (with-temp-buffer
- (let ((sym (intern-soft (shimbun-header-xref header)
- (shimbun-tcup-content-hash-internal
- shimbun))))
- (if (boundp sym)
- (insert (symbol-value sym)))
- (goto-char (point-min))
- (shimbun-header-insert header)
- (insert "Content-Type: " "text/html"
- "; charset=ISO-2022-JP\n"
- "MIME-Version: 1.0\n")
- (insert "\n")
- (encode-coding-string
- (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP")))))))))
-
-(provide 'sb-tcup)
-
-;;; sb-tcup.el ends here
+++ /dev/null
-;;; sb-text.el --- shimbun backend class for text content.
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(luna-define-class shimbun-text (shimbun) ())
-
-(luna-define-method shimbun-make-contents ((shimbun shimbun-text)
- header)
- (let ((case-fold-search t) (html t) (start))
- (when (and (re-search-forward (shimbun-content-start-internal shimbun)
- nil t)
- (setq start (point))
- (re-search-forward (shimbun-content-end-internal shimbun)
- nil t))
- (delete-region (match-beginning 0) (point-max))
- (delete-region (point-min) start)
- (shimbun-shallow-rendering)
- (setq html nil))
- (goto-char (point-min))
- (shimbun-header-insert header)
- (insert "Content-Type: " (if html "text/html" "text/plain")
- "; charset=ISO-2022-JP\nMIME-Version: 1.0\n")
- (when (shimbun-x-face-internal shimbun)
- (insert (shimbun-x-face-internal shimbun))
- (unless (bolp)
- (insert "\n")))
- (insert "\n")
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP"))))
-
-(provide 'sb-text)
-
-;;; sb-text.el ends here
+++ /dev/null
-;;; sb-wired.el --- shimbun backend for Wired Japan
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-lump)
-
-(luna-define-class shimbun-wired (shimbun-lump) ())
-
-(defvar shimbun-wired-url "http://www.hotwired.co.jp/")
-(defvar shimbun-wired-groups '("business" "culture" "technology"))
-(defvar shimbun-wired-coding-system (static-if (boundp 'MULE)
- '*euc-japan* 'euc-jp))
-(defvar shimbun-wired-from-address "webmaster@www.hotwired.co.jp")
-(defvar shimbun-wired-content-start
- "<FONT color=\"#ff0000\" size=\"-1\">.*</FONT>\n")
-(defvar shimbun-wired-content-end "<DIV ALIGN=\"RIGHT\">\\[")
-
-(luna-define-method shimbun-get-group-header-alist ((shimbun shimbun-wired))
- (let ((group-header-alist (mapcar (lambda (g) (cons g nil))
- (shimbun-groups-internal shimbun)))
- (case-fold-search t)
- (regexp (format
- "<a href=\"\\(%s\\|/\\)\\(news/news/\\(%s\\)/story/\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[0-9]+\\)\\.html\\)[^>]*\">"
- (regexp-quote (shimbun-url-internal shimbun))
- (shimbun-regexp-opt (shimbun-groups-internal shimbun)))))
- (dolist (xover (list (concat (shimbun-url-internal shimbun)
- "news/news/index.html")
- (concat (shimbun-url-internal shimbun)
- "news/news/last_seven.html")))
- (erase-buffer)
- (shimbun-retrieve-url shimbun xover t)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let* ((url (concat (shimbun-url-internal shimbun)
- (match-string 2)))
- (group (downcase (match-string 3)))
- (id (format "<%s%%%s>" (match-string 4) group))
- (date (shimbun-make-date-string
- (string-to-number (match-string 5))
- (string-to-number (match-string 6))
- (string-to-number (match-string 7))))
- (header (shimbun-make-header
- 0
- (shimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "</b>" nil t) (point)))
- "<[^>]+>")
- ""))
- (shimbun-from-address-internal shimbun)
- date id "" 0 0 url))
- (x (assoc group group-header-alist)))
- (setcdr x (cons header (cdr x))))))
- group-header-alist))
-
-(provide 'sb-wired)
-
-;;; sb-wired.el ends here
+++ /dev/null
-;;; sb-xemacs.el --- shimbun backend for xemacs.org
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-mhonarc)
-
-(luna-define-class shimbun-xemacs (shimbun-mhonarc) ())
-
-(defvar shimbun-xemacs-url "http://list-archives.xemacs.org/")
-(defvar shimbun-xemacs-groups '("xemacs-announce"
- "xemacs-beta-ja" "xemacs-beta"
- "xemacs-build-reports" "xemacs-cvs"
- "xemacs-mule" "xemacs-nt" "xemacs-patches"
- "xemacs-users-ja" "xemacs"))
-(defvar shimbun-xemacs-coding-system (static-if (boundp 'MULE)
- '*euc-japan* 'euc-jp))
-
-(defmacro shimbun-xemacs-concat-url (shimbun url)
- (` (concat (shimbun-url-internal shimbun)
- (shimbun-current-group-internal shimbun) "/" (, url))))
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-xemacs))
- (shimbun-xemacs-concat-url shimbun nil))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-xemacs))
- (let ((case-fold-search t)
- headers auxs aux)
- (catch 'stop
- ;; Only latest month.
- (if (re-search-forward
- (concat "<A HREF=\"/" (shimbun-current-group-internal shimbun)
- "/\\([12][0-9][0-9][0-9][0-1][0-9]\\)/\">\\[Index\\]")
- nil t)
- (setq auxs (append auxs (list (match-string 1)))))
- (while auxs
- (erase-buffer)
- (shimbun-retrieve-url
- shimbun
- (shimbun-xemacs-concat-url shimbun
- (concat (setq aux (car auxs)) "/")))
- (let ((case-fold-search t)
- id url subject)
- (goto-char (point-max))
- (while (re-search-backward
- "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<"
- nil t)
- (setq url (shimbun-xemacs-concat-url
- shimbun
- (concat aux "/" (match-string 1)))
- id (format "<%s%05d%%%s>"
- aux
- (string-to-number (match-string 2))
- (shimbun-current-group-internal shimbun))
- subject (match-string 3))
- (forward-line 1)
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (if (looking-at "<td><em>\\([^<]+\\)<")
- (match-string 1)
- "")
- "" id "" 0 0 url)
- headers)
- ;; (message "%s" id)
- (forward-line -2)))
- (setq auxs (cdr auxs))))
- headers))
-
-(provide 'sb-xemacs)
-
-;;; sb-xemacs.el ends here
+++ /dev/null
-;;; sb-yomiuri.el --- shimbun backend for www.yomiuri.co.jp
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(require 'sb-text)
-
-(luna-define-class shimbun-yomiuri (shimbun shimbun-text) ())
-
-(defvar shimbun-yomiuri-url "http://www.yomiuri.co.jp/")
-(defvar shimbun-yomiuri-groups '("shakai" "sports" "seiji" "keizai"
- "kokusai" "fuho"))
-(defvar shimbun-yomiuri-coding-system (static-if (boundp 'MULE)
- '*sjis* 'shift_jis))
-(defvar shimbun-yomiuri-from-address "webmaster@www.yomiuri.co.jp")
-(defvar shimbun-yomiuri-content-start "\n<!-- honbun start -->\n")
-(defvar shimbun-yomiuri-content-end "\n<!-- honbun end -->\n")
-
-(defvar shimbun-yomiuri-group-path-alist
- '(("shakai" . "04")
- ("sports" . "06")
- ("seiji" . "01")
- ("keizai" . "02")
- ("kokusai" . "05")
- ("fuho" . "zz")))
-
-(luna-define-method shimbun-index-url ((shimbun shimbun-yomiuri))
- (concat (shimbun-url-internal shimbun)
- (cdr (assoc (shimbun-current-group-internal shimbun)
- shimbun-yomiuri-group-path-alist))
- "/index.htm"))
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-yomiuri))
- (let ((case-fold-search t)
- start headers)
- (goto-char (point-min))
- (when (and (search-forward
- (format "\n<!-- /news/list start -->\n"
- (shimbun-current-group-internal shimbun)) nil t)
- (setq start (point))
- (search-forward
- (format "\n<!-- /news/list end -->\n"
- (shimbun-current-group-internal shimbun)) nil t))
- (forward-line -1)
- (save-restriction
- (narrow-to-region start (point))
- (goto-char start)
- (while (re-search-forward
- "<a href=\"/\\([0-9]+\\)/\\(\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[A-z0-9]+\\)\\.htm\\)\"[^>]*>"
- nil t)
- (let ((url (concat (match-string 1) "/"
- (match-string 2)))
- (id (format "<%s%s%%%s>"
- (match-string 1)
- (match-string 3)
- (shimbun-current-group-internal shimbun)))
- (year (string-to-number (match-string 4)))
- (month (string-to-number (match-string 5)))
- (day (string-to-number (match-string 6)))
- (subject (mapconcat
- 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "<[^>]+>")
- ""))
- date)
- (when (string-match "^\e$B"!\e(B" subject)
- (setq subject (substring subject (match-end 0))))
- (if (string-match "(\\([0-9][0-9]:[0-9][0-9]\\))$" subject)
- (setq date (shimbun-make-date-string
- year month day (match-string 1 subject))
- subject (substring subject 0 (match-beginning 0)))
- (setq date (shimbun-make-date-string year month day)))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string subject)
- (shimbun-from-address-internal shimbun)
- date id "" 0 0 (concat
- (shimbun-url-internal shimbun)
- url))
- headers)))))
- headers))
-
-(provide 'sb-yomiuri)
-
-;;; sb-yomiuri.el ends here
+++ /dev/null
-;;; sb-zdnet.el --- shimbun backend for Zdnet Japan
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;;; Code:
-
-(require 'shimbun)
-(luna-define-class shimbun-zdnet (shimbun) ())
-
-(defvar shimbun-zdnet-url "http://www.zdnet.co.jp/news/")
-(defvar shimbun-zdnet-groups '("comp"))
-(defvar shimbun-zdnet-coding-system (static-if (boundp 'MULE)
- '*sjis* 'shift_jis))
-(defvar shimbun-zdnet-from-address "zdnn@softbank.co.jp")
-(defvar shimbun-zdnet-content-start "\\(<!--BODY-->\\|<!--DATE-->\\)")
-(defvar shimbun-zdnet-content-end "\\(<!--BODYEND-->\\|<!--BYLINEEND-->\\)")
-
-(luna-define-method shimbun-get-headers ((shimbun shimbun-zdnet))
- (let ((case-fold-search t) headers)
- (goto-char (point-min))
- (let (start)
- (while (and (search-forward "<!--" nil t)
- (setq start (- (point) 4))
- (search-forward "-->" nil t))
- (delete-region start (point))))
- (goto-char (point-min))
- (while (re-search-forward
- "<a href=\"\\(/news/\\)?\\(\\([0-9][0-9]\\)\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([^\\.]+\\).html\\)\"><font size=\"4\"><strong>"
- nil t)
- (let ((year (+ 2000 (string-to-number (match-string 3))))
- (month (string-to-number (match-string 4)))
- (day (string-to-number (match-string 5)))
- (id (format "<%s%s%s%s%%%s>"
- (match-string 3)
- (match-string 4)
- (match-string 5)
- (match-string 6)
- (shimbun-current-group-internal shimbun)))
- (url (match-string 2)))
- (push (shimbun-make-header
- 0
- (shimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "</a>" nil t) (point)))
- "<[^>]+>")
- ""))
- (shimbun-from-address-internal shimbun)
- (shimbun-make-date-string year month day)
- id "" 0 0 (concat (shimbun-url-internal shimbun) url))
- headers)))
- (nreverse headers)))
-
-(provide 'sb-zdnet)
-
-;;; sb-zdnet.el ends here
+++ /dev/null
-;;; shimbun.el --- interfacing with web newspapers -*- coding: junet; -*-
-
-;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Keywords: news
-
-;;; Copyright:
-
-;; This program 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.
-
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Original code was nnshimbun.el written by
-;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-;; Shimbun API:
-;;
-;; shimbun-open
-;; shimbun-groups
-;; shimbun-open-group
-;; shimbun-close-group
-;; shimbun-headers
-;; shimbun-header
-;; shimbun-article
-;; shimbun-close
-
-;; Shimbun Header API:
-;;
-;; shimbun-header-subject
-;; shimbun-header-set-subject
-;; shimbun-header-from
-;; shimbun-header-set-from
-;; shimbun-header-date
-;; shimbun-header-set-date
-;; shimbun-header-id
-;; shimbun-header-set-id
-;; shimbun-header-references
-;; shimbun-header-set-references
-;; shimbun-header-chars
-;; shimbun-header-set-chars
-;; shimbun-header-lines
-;; shimbun-header-set-lines
-;; shimbun-header-xref
-;; shimbun-header-set-xref
-;; shimbun-header-extra
-;; shimbun-header-set-extra
-;; shimbun-header-insert
-
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'static))
-
-(require 'mcharset)
-(require 'eword-encode)
-(require 'luna)
-(require 'std11)
-
-(eval-and-compile
- (luna-define-class shimbun ()
- (server current-group groups headers hash x-face
- url coding-system from-address
- content-start content-end))
- (luna-define-internal-accessors 'shimbun))
-
-(defvar shimbun-x-face-alist
- '(("asahi" .
- (("default" .
- "X-Face: +Oh!C!EFfmR$+Zw{dwWW]1e_>S0rnNCA*CX|bIy3rr^<Q#lf&~ADU:X!t5t>
- gW5)Q]N{MmnL]suPpL|gFjV{S|]a-:)\\FR7GRf9uL:ue5_=;h{V%@()={u
- Td@l?eXBppF%`6W%;h`#]2q+f*81n$Bh|t")))
- ("cnet" .
- (("default" .
- "X-Face: 0p7.+XId>z%:!$ahe?x%+AEm37Abvn]n*GGh+>v=;[3`a{1l
- qO[$,~3C3xU_ri>[JwJ!9l0~Y`b*eXAQ:*q=bBI_=ro*?]4:
- |n>]ZiLZ2LEo^2nr('C<+`lO~/!R[lH'N'4X&%\\I}8T!wt")))
- ("wired" .
- (("default" .
- "X-Face: \"yhMDxMBowCFKt;5Q$s_Wx)/'L][0@c\"#n2BwH{7mg]5^w1D]\"K^R
- ]&fZ5xtt1Ynu6V;Cv(@BcZUf9IV$($6TZ`L)$,cegh`b:Uwy`8}#D
- b-kyCsr_UMRz=,U|>-:&`05lXB4(;h{[&~={Imb-az7&U5?|&X_8c
- ;#'L|f.P,]|\\50pgSVw_}byL+%m{TrS[\"Ew;dbskaBL[ipk2m4V")))
- ("zdnet" .
- (("default" .
- "X-Face: 88Zbg!1nj{i#[*WdSZNrn1$Cdfat,zsG`P)OLo=U05q:RM#72\\p;3XZ
- ~j|7T)QC7\"(A;~HrfP.D}o>Z.]=f)rOBz:A^G*M3Ea5JCB$a>BL/y!")))
- ("default" .
- (("default" .
- "X-Face: Ygq$6P.,%Xt$U)DS)cRY@k$VkW!7(X'X'?U{{osjjFG\"E]hND;SPJ-J?O?R|a?L
- g2$0rVng=O3Lt}?~IId8Jj&vP^3*o=LKUyk(`t%0c!;t6REk=JbpsEn9MrN7gZ%"))))
- "Alist of server vs. alist of group vs. X-Face field. It looks like:
-
-\((\"asahi\" . ((\"national\" . \"X-face: ***\")
- (\"business\" . \"X-Face: ***\")
- ;;
- ;;
- (\"default\" . \"X-face: ***\")))
- (\"sponichi\" . ((\"baseball\" . \"X-face: ***\")
- (\"soccer\" . \"X-Face: ***\")
- ;;
- ;;
- (\"default\" . \"X-face: ***\")))
- ;;
- (\"default\" . ((\"default\" . \"X-face: ***\")))")
-
-(defconst shimbun-meta-content-type-charset-regexp
- (eval-when-compile
- (concat "<meta[ \t]+http-equiv=\"?Content-type\"?[ \t]+content=\"\\([^;]+\\)"
- ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
- ">"))
- "Regexp used in parsing `<META HTTP-EQUIV=\"Content-Type\" content=\"...;charset=...\">
-for a charset indication")
-
-(defconst shimbun-meta-charset-content-type-regexp
- (eval-when-compile
- (concat "<meta[ \t]+content=\"\\([^;]+\\)"
- ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
- "[ \t]+http-equiv=\"?Content-type\"?>"))
- "Regexp used in parsing `<META content=\"...;charset=...\" HTTP-EQUIV=\"Content-Type\">
-for a charset indication")
-
-(defvar shimbun-hash-length 997
- "Length of header hashtable.")
-
-(static-when (boundp 'MULE)
- (unless (coding-system-p 'euc-japan)
- (copy-coding-system '*euc-japan* 'euc-japan))
- (unless (coding-system-p 'shift_jis)
- (copy-coding-system '*sjis* 'shift_jis))
- (eval-and-compile
- (defalias-maybe 'coding-system-category 'get-code-mnemonic)))
-
-(static-if (and (ignore-errors (require 'w3m))
- (fboundp 'w3m-retrieve))
-(progn
-(require 'w3m)
-(defun shimbun-retrieve-url (shimbun url &optional no-cache)
- "Rertrieve URL contents and insert to current buffer."
- (when (w3m-retrieve url nil no-cache)
- (insert-buffer w3m-work-buffer-name))))
-;; Otherwise.
-(require 'url)
-(defun shimbun-retrieve-url (shimbun url &optional no-cache)
- "Rertrieve URL contents and insert to current buffer."
- (let ((buf (current-buffer))
- (url-working-buffer url-working-buffer))
- (let ((old-asynch (default-value 'url-be-asynchronous))
- (old-caching (default-value 'url-automatic-caching))
- (old-mode (default-value 'url-standalone-mode)))
- (setq-default url-be-asynchronous nil)
- (when no-cache
- (setq-default url-automatic-caching nil)
- (setq-default url-standalone-mode nil))
- (unwind-protect
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (input-coding-system 'binary)
- (output-coding-system 'binary)
- (default-enable-multibyte-characters nil))
- (set-buffer
- (setq url-working-buffer
- (cdr (url-retrieve url no-cache))))
- (url-uncompress))
- (setq-default url-be-asynchronous old-asynch)
- (setq-default url-automatic-caching old-caching)
- (setq-default url-standalone-mode old-mode)))
- (let ((charset
- (or (and (boundp 'url-current-mime-charset)
- (symbol-value 'url-current-mime-charset))
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (or (re-search-forward
- shimbun-meta-content-type-charset-regexp nil t)
- (re-search-forward
- shimbun-meta-charset-content-type-regexp nil t))
- (buffer-substring-no-properties (match-beginning 2)
- (match-end 2)))))))
- (decode-coding-region
- (point-min) (point-max)
- (if charset
- (let ((mime-charset-coding-system-alist
- (append '((euc-jp . euc-japan)
- (shift-jis . shift_jis)
- (shift_jis . shift_jis)
- (sjis . shift_jis)
- (x-euc-jp . euc-japan)
- (x-shift-jis . shift_jis)
- (x-shift_jis . shift_jis)
- (x-sjis . shift_jis))
- mime-charset-coding-system-alist)))
- (mime-charset-to-coding-system charset))
- (let ((default (condition-case nil
- (coding-system-category
- (shimbun-coding-system-internal shimbun))
- (error nil)))
- (candidate (detect-coding-region (point-min) (point-max))))
- (unless (listp candidate)
- (setq candidate (list candidate)))
- (catch 'coding
- (dolist (coding candidate)
- (if (eq default (coding-system-category coding))
- (throw 'coding coding)))
- (if (eq (coding-system-category 'binary)
- (coding-system-category (car candidate)))
- (shimbun-coding-system-internal shimbun)
- (car candidate)))))))
- (set-buffer-multibyte t)
- (set-buffer buf)
- (insert-buffer url-working-buffer)
- (kill-buffer url-working-buffer)))
-;; End of shimbun-retrieve-url definition
-)
-
-;;; Implementation of Header API.
-(defun shimbun-make-header (&optional number subject from date id
- references chars lines xref
- extra)
- (vector number subject from date id references chars lines xref extra))
-
-;;(defsubst shimbun-header-number (header)
-;; (aref header 0))
-
-(defsubst shimbun-header-field-value ()
- (let ((pt (point)))
- (prog1
- (buffer-substring (match-end 0) (std11-field-end))
- (goto-char pt))))
-
-(defsubst shimbun-header-subject (header)
- (aref header 1))
-
-(defsubst shimbun-header-set-subject (header subject)
- (aset header 1 subject))
-
-(defsubst shimbun-header-from (header)
- (aref header 2))
-
-(defsubst shimbun-header-set-from (header from)
- (aset header 2 from))
-
-(defsubst shimbun-header-date (header)
- (aref header 3))
-
-(defsubst shimbun-header-set-date (header date)
- (aset header 3 date))
-
-(defsubst shimbun-header-id (header)
- (aref header 4))
-
-(defsubst shimbun-header-set-id (header id)
- (aset header 4 id))
-
-(defsubst shimbun-header-references (header)
- (aref header 5))
-
-(defsubst shimbun-header-set-references (header references)
- (aset header 5 references))
-
-(defsubst shimbun-header-chars (header)
- (aref header 6))
-
-(defsubst shimbun-header-set-chars (header chars)
- (aset header 6 chars))
-
-(defsubst shimbun-header-lines (header)
- (aref header 7))
-
-(defsubst shimbun-header-set-lines (header lines)
- (aset header 7 lines))
-
-(defsubst shimbun-header-xref (header)
- (aref header 8))
-
-(defsubst shimbun-header-set-xref (header xref)
- (aset header 8 xref))
-
-(defsubst shimbun-header-extra (header)
- (aref header 9))
-
-(defsubst shimbun-header-set-extra (header extra)
- (aset header 9 extra))
-
-(defun shimbun-header-insert (header)
- (insert "Subject: " (or (shimbun-header-subject header) "(none)") "\n"
- "From: " (or (shimbun-header-from header) "(nobody)") "\n"
- "Date: " (or (shimbun-header-date header) "") "\n"
- "Message-ID: " (shimbun-header-id header) "\n")
- (let ((refs (shimbun-header-references header)))
- (and refs
- (string< "" refs)
- (insert "References: " refs "\n")))
- (insert "Lines: " (number-to-string (or (shimbun-header-lines header) 0))
- "\n"
- "Xref: " (or (shimbun-header-xref header) "") "\n"))
-
-;;; Implementation of Shimbun API.
-
-(defvar shimbun-attributes
- '(url groups coding-system from-address content-start content-end))
-
-(defun shimbun-open (server)
- "Open a shimbun for SERVER."
- (require (intern (concat "sb-" server)))
- (let (url groups coding-system from-address content-start content-end)
- (dolist (attr shimbun-attributes)
- (set attr
- (symbol-value (intern-soft
- (concat "shimbun-" server "-" (symbol-name attr))))))
- (luna-make-entity (intern (concat "shimbun-" server))
- :server server
- :url url
- :groups groups
- :coding-system coding-system
- :from-address from-address
- :content-start content-start
- :content-end content-end)))
-
-(defun shimbun-groups (shimbun)
- "Return a list of groups which are available in the SHIMBUN."
- (shimbun-groups-internal shimbun))
-
-(defun shimbun-open-group (shimbun group)
- "Open a SHIMBUN GROUP."
- (unless (shimbun-current-group-internal shimbun)
-; (condition-case nil
- (if (member group (shimbun-groups-internal shimbun))
- (progn
- (shimbun-set-current-group-internal shimbun group)
- (let ((x-faces (cdr (or (assoc (shimbun-server-internal shimbun)
- shimbun-x-face-alist)
- (assoc "default" shimbun-x-face-alist)))))
- (shimbun-set-x-face-internal shimbun
- (cdr (or (assoc group x-faces)
- (assoc "default" x-faces)))))
- (with-temp-buffer
- (shimbun-retrieve-url shimbun (shimbun-index-url shimbun))
- (shimbun-set-headers-internal shimbun
- (shimbun-get-headers shimbun)))
- (shimbun-set-hash-internal shimbun
- (make-vector shimbun-hash-length 0))
- (dolist (header (shimbun-headers-internal shimbun))
- (set (intern (shimbun-header-id header)
- (shimbun-hash-internal shimbun))
- header)))
- (error "Cannot open group %s" group))))
-; (error (shimbun-set-current-group-internal shimbun nil)))))
-
-(defun shimbun-close-group (shimbun)
- "Close opened group of SHIMBUN."
- (when (shimbun-current-group-internal shimbun)
- (shimbun-set-current-group-internal shimbun nil)
- (shimbun-set-headers-internal shimbun nil)
- (shimbun-set-hash-internal shimbun nil)))
-
-(defun shimbun-headers (shimbun)
- "Return a SHIMBUN header list."
- (shimbun-headers-internal shimbun))
-
-(defun shimbun-header (shimbun id)
- "Return a SHIMBUN header which corresponds to ID."
- (when (shimbun-current-group-internal shimbun)
- (let ((sym (intern-soft id (shimbun-hash-internal shimbun))))
- (if (boundp sym)
- (symbol-value sym)))))
-
-(luna-define-generic shimbun-article (shimbun id &optional outbuf)
- "Retrieve a SHIMBUN article which corresponds to ID to the OUTBUF.
-If OUTBUF is not specified, article is retrieved to the current buffer.")
-
-(luna-define-method shimbun-article ((shimbun shimbun) id &optional outbuf)
- (when (shimbun-current-group-internal shimbun)
- (let* ((header (shimbun-header shimbun id))
- (xref (shimbun-header-xref header)))
- (with-current-buffer (or outbuf (current-buffer))
- (insert
- (or (with-temp-buffer
- (shimbun-retrieve-url shimbun xref)
- (message "shimbun: Make contents...")
- (goto-char (point-min))
- (prog1 (shimbun-make-contents shimbun header)
- (message "shimbun: Make contents...done")))
- ""))))))
-
-(defsubst shimbun-make-html-contents (shimbun header)
- (let (start)
- (when (and (re-search-forward (shimbun-content-start-internal shimbun)
- nil t)
- (setq start (point))
- (re-search-forward (shimbun-content-end-internal shimbun)
- nil t))
- (delete-region (match-beginning 0) (point-max))
- (delete-region (point-min) start))
- (goto-char (point-min))
- (shimbun-header-insert header)
- (insert "Content-Type: text/html; charset=ISO-2022-JP\n"
- "MIME-Version: 1.0\n")
- (when (shimbun-x-face-internal shimbun)
- (insert (shimbun-x-face-internal shimbun))
- (unless (bolp)
- (insert "\n")))
- (insert "\n")
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP"))))
-
-(luna-define-generic shimbun-make-contents (shimbun header)
- "Return a content string of SHIMBUN article using current buffer content.
-HEADER is a header structure obtained via `shimbun-get-headers'.")
-
-(luna-define-method shimbun-make-contents ((shimbun shimbun) header)
- (shimbun-make-html-contents shimbun header))
-
-(luna-define-generic shimbun-index-url (shimbun)
- "Return a index URL of SHIMBUN.")
-
-;; Default is same as base url.
-(luna-define-method shimbun-index-url ((shimbun shimbun))
- (shimbun-url-internal shimbun))
-
-(luna-define-generic shimbun-get-headers (shimbun)
- "Return a shimbun header list of SHIMBUN.")
-
-(luna-define-generic shimbun-close (shimbun)
- "Close a SHIMBUN.")
-
-(luna-define-method shimbun-close ((shimbun shimbun))
- (shimbun-close-group shimbun))
-
-;;; Misc Functions
-(defun shimbun-mime-encode-string (string)
- (mapconcat
- #'identity
- (split-string (eword-encode-string
- (shimbun-decode-entities-string string)) "\n")
- ""))
-
-(defun shimbun-make-date-string (year month day &optional time)
- (format "%02d %s %04d %s +0900"
- day
- (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
- month)
- (cond ((< year 69)
- (+ year 2000))
- ((< year 100)
- (+ year 1900))
- ((< year 1000) ; possible 3-digit years.
- (+ year 1900))
- (t year))
- (or time "00:00")))
-
-(if (fboundp 'regexp-opt)
- (defalias 'shimbun-regexp-opt 'regexp-opt)
- (defun shimbun-regexp-opt (strings &optional paren)
- "Return a regexp to match a string in STRINGS.
-Each string should be unique in STRINGS and should not contain any regexps,
-quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
-is enclosed by at least one regexp grouping construct."
- (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" "")))
- (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren))))
-;; Fast fill-region function
-
-(defvar shimbun-fill-column (min 80 (- (frame-width) 4)))
-
-(defconst shimbun-kinsoku-bol-list
- (append "!)-_~}]:;',.?\e$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7\e(B\
-\e$B!8!9!:!;!<!=!>!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n$!$#$%$'$)\e(B\
-\e$B$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v\e(B" nil))
-
-(defconst shimbun-kinsoku-eol-list
- (append "({[`\e$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x\e(B" nil))
-
-(defun shimbun-fill-line ()
- (forward-line 0)
- (let ((top (point)) chr)
- (while (if (>= (move-to-column shimbun-fill-column)
- shimbun-fill-column)
- (not (progn
- (if (memq (preceding-char) shimbun-kinsoku-eol-list)
- (progn
- (backward-char)
- (while (memq (preceding-char) shimbun-kinsoku-eol-list)
- (backward-char))
- (insert "\n"))
- (while (memq (setq chr (following-char)) shimbun-kinsoku-bol-list)
- (forward-char))
- (if (looking-at "\\s-+")
- (or (eolp) (delete-region (point) (match-end 0)))
- (or (> (char-width chr) 1)
- (re-search-backward "\\<" top t)
- (end-of-line)))
- (or (eolp) (insert "\n"))))))
- (setq top (point))))
- (forward-line 1)
- (not (eobp)))
-
-(defsubst shimbun-shallow-rendering ()
- (goto-char (point-min))
- (while (search-forward "<p>" nil t)
- (insert "\n\n"))
- (goto-char (point-min))
- (while (search-forward "<br>" nil t)
- (insert "\n"))
- (shimbun-remove-markup)
- (shimbun-decode-entities)
- (goto-char (point-min))
- (while (shimbun-fill-line))
- (goto-char (point-min))
- (when (skip-chars-forward "\n")
- (delete-region (point-min) (point)))
- (while (search-forward "\n\n" nil t)
- (let ((p (point)))
- (when (skip-chars-forward "\n")
- (delete-region p (point)))))
- (goto-char (point-max))
- (when (skip-chars-backward "\n")
- (delete-region (point) (point-max)))
- (insert "\n"))
-
-;;; entity decoding (stolen from w3m.el)
-(eval-and-compile
- (defconst shimbun-entity-alist ; html character entities and values
- (eval-when-compile
- (let ((basic-entity-alist
- '(("nbsp" . " ")
- ("gt" . ">")
- ("lt" . "<")
- ("amp" . "&")
- ("quot" . "\"")
- ("apos" . "'")))
- (latin1-entity
- '( ;("nbsp" . 160)
- ("iexcl" . 161) ("cent" . 162) ("pound" . 163)
- ("curren" . 164) ("yen" . 165) ("brvbar" . 166) ("sect" . 167)
- ("uml" . 168) ("copy" . 169) ("ordf" . 170) ("laquo" . 171)
- ("not" . 172) ("shy" . 173) ("reg" . 174) ("macr" . 175)
- ("deg" . 176) ("plusmn" . 177) ("sup2" . 178) ("sup3" . 179)
- ("acute" . 180) ("micro" . 181) ("para" . 182) ("middot" . 183)
- ("cedil" . 184) ("sup1" . 185) ("ordm" . 186) ("raquo" . 187)
- ("frac14" . 188) ("frac12" . 189) ("frac34" . 190) ("iquest" . 191)
- ("Agrave" . 192) ("Aacute" . 193) ("Acirc" . 194) ("Atilde" . 195)
- ("Auml" . 196) ("Aring" . 197) ("AElig" . 198) ("Ccedil" . 199)
- ("Egrave" . 200) ("Eacute" . 201) ("Ecirc" . 202) ("Euml" . 203)
- ("Igrave" . 204) ("Iacute" . 205) ("Icirc" . 206) ("Iuml" . 207)
- ("ETH" . 208) ("Ntilde" . 209) ("Ograve" . 210) ("Oacute" . 211)
- ("Ocirc" . 212) ("Otilde" . 213) ("Ouml" . 214) ("times" . 215)
- ("Oslash" . 216) ("Ugrave" . 217) ("Uacute" . 218) ("Ucirc" . 219)
- ("Uuml" . 220) ("Yacute" . 221) ("THORN" . 222) ("szlig" . 223)
- ("agrave" . 224) ("aacute" . 225) ("acirc" . 226) ("atilde" . 227)
- ("auml" . 228) ("aring" . 229) ("aelig" . 230) ("ccedil" . 231)
- ("egrave" . 232) ("eacute" . 233) ("ecirc" . 234) ("euml" . 235)
- ("igrave" . 236) ("iacute" . 237) ("icirc" . 238) ("iuml" . 239)
- ("eth" . 240) ("ntilde" . 241) ("ograve" . 242) ("oacute" . 243)
- ("ocirc" . 244) ("otilde" . 245) ("ouml" . 246) ("divide" . 247)
- ("oslash" . 248) ("ugrave" . 249) ("uacute" . 250) ("ucirc" . 251)
- ("uuml" . 252) ("yacute" . 253) ("thorn" . 254) ("yuml" . 255))))
- (append basic-entity-alist
- (mapcar
- (function
- (lambda (entity)
- (cons (car entity)
- (char-to-string
- (make-char
- (static-if (boundp 'MULE) lc-ltn1 'latin-iso8859-1)
- (cdr entity))))))
- latin1-entity))))))
-
-(defconst shimbun-entity-regexp
- (eval-when-compile
- (format "&\\(%s\\|#[0-9]+\\);?"
- (if (fboundp 'regexp-opt)
- (let ((fn (function regexp-opt)))
- ;; Don't funcall directly for avoiding compile warning.
- (funcall fn (mapcar (function car)
- shimbun-entity-alist)))
- (mapconcat (lambda (s)
- (regexp-quote (car s)))
- shimbun-entity-alist
- "\\|")))))
-
-(defvar shimbun-entity-db nil) ; nil means un-initialized
-(defconst shimbun-entity-db-size 13) ; size of obarray
-
-(defun shimbun-entity-db-setup ()
- ;; initialise entity database (obarray)
- (setq shimbun-entity-db (make-vector shimbun-entity-db-size 0))
- (dolist (elem shimbun-entity-alist)
- (set (intern (car elem) shimbun-entity-db)
- (cdr elem))))
-
-(defsubst shimbun-entity-value (name)
- ;; initialise if need
- (if (null shimbun-entity-db)
- (shimbun-entity-db-setup))
- ;; return value of specified entity, or empty string for unknown entity.
- (or (symbol-value (intern-soft name shimbun-entity-db))
- (if (not (char-equal (string-to-char name) ?#))
- (concat "&" name) ; unknown entity
- ;; case of immediate character (accept only 0x20 .. 0x7e)
- (let ((char (string-to-int (substring name 1)))
- sym)
- ;; make character's representation with learning
- (set (setq sym (intern name shimbun-entity-db))
- (if (or (< char 32) (< 127 char))
- "~" ; un-supported character
- (char-to-string char)))))))
-
-(defun shimbun-decode-entities ()
- "Decode entities in the current buffer."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward shimbun-entity-regexp nil t)
- (replace-match (shimbun-entity-value (match-string 1)) nil t))))
-
-(defun shimbun-decode-entities-string (string)
- "Decode entities in the STRING."
- (with-temp-buffer
- (insert string)
- (shimbun-decode-entities)
- (buffer-string)))
-
-(defun shimbun-remove-markup ()
- "Remove all HTML markup, leaving just plain text."
- (save-excursion
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t))))
-
-(provide 'shimbun)
-;;; shimbun.el ends here.
projects / elisp / wanderlust.git / commitdiff