elmo/sb-xemacs.el

   1 ;;; sb-xemacs.el --- shimbun backend for xemacs.org
   2
   3 ;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
   4 ;;         Akihiro Arisawa    <ari@atesoft.advantest.co.jp>
   5 ;;         Yuuichi Teranishi <teranisi@gohome.org>
   6
   7 ;; Keywords: news
   8
   9 ;;; Copyright:
  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 ;; Original code was nnshimbun.el written by
  29 ;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
  30
  31 ;;; Code:
  32
  33 (require 'shimbun)
  34 (require 'sb-mhonarc)
  35
  36 (luna-define-class shimbun-xemacs (shimbun-mhonarc) ())
  37
  38 (defvar shimbun-xemacs-url "http://list-archives.xemacs.org/")
  39 (defvar shimbun-xemacs-groups '("xemacs-announce"
  40                                 "xemacs-beta-ja" "xemacs-beta"
  41                                 "xemacs-build-reports" "xemacs-cvs"
  42                                 "xemacs-mule" "xemacs-nt" "xemacs-patches"
  43                                 "xemacs-users-ja" "xemacs"))
  44 (defvar shimbun-xemacs-coding-system (static-if (boundp 'MULE)
  45                                          '*euc-japan* 'euc-jp))
  46
  47 (defmacro shimbun-xemacs-concat-url (shimbun url)
  48   (` (concat (shimbun-url-internal shimbun)
  49              (shimbun-current-group-internal shimbun) "/" (, url))))
  50
  51 (luna-define-method shimbun-index-url ((shimbun shimbun-xemacs))
  52   (shimbun-xemacs-concat-url shimbun nil))
  53
  54 (luna-define-method shimbun-get-headers ((shimbun shimbun-xemacs))
  55   (let ((case-fold-search t)
  56         headers auxs aux)
  57     (catch 'stop
  58       ;; Only latest month.
  59       (if (re-search-forward
  60            (concat "<A HREF=\"/" (shimbun-current-group-internal shimbun)
  61                    "/\\([12][0-9][0-9][0-9][0-1][0-9]\\)/\">\\[Index\\]")
  62            nil t)
  63           (setq auxs (append auxs (list (match-string 1)))))
  64       (while auxs
  65         (erase-buffer)
  66         (shimbun-retrieve-url
  67          shimbun
  68          (shimbun-xemacs-concat-url shimbun
  69                                     (concat (setq aux (car auxs)) "/")))
  70         (let ((case-fold-search t)
  71               id url subject)
  72           (goto-char (point-max))
  73           (while (re-search-backward
  74                   "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<"
  75                   nil t)
  76             (setq url (shimbun-xemacs-concat-url
  77                        shimbun
  78                        (concat aux "/" (match-string 1)))
  79                   id (format "<%s%05d%%%s>"
  80                              aux
  81                              (string-to-number (match-string 2))
  82                              (shimbun-current-group-internal shimbun))
  83                   subject (match-string 3))
  84             (forward-line 1)
  85             (push (shimbun-make-header
  86                    0
  87                    (shimbun-mime-encode-string subject)
  88                    (if (looking-at "<td><em>\\([^<]+\\)<")
  89                        (match-string 1)
  90                      "")
  91                    "" id "" 0 0 url)
  92                   headers)
  93             ;; (message "%s" id)
  94             (forward-line -2)))
  95         (setq auxs (cdr auxs))))
  96     headers))
  97
  98 (provide 'sb-xemacs)
  99
 100 ;;; sb-xemacs.el ends here