elmo/sb-mhonarc.el

   1 ;;; sb-mhonarc.el --- shimbun backend class for mhonarc
   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 (luna-define-class shimbun-mhonarc (shimbun) ())
  35
  36 (luna-define-method shimbun-make-contents ((shimbun shimbun-mhonarc)
  37                                            header)
  38   (if (search-forward "<!--X-Head-End-->" nil t)
  39       (progn
  40         (forward-line 0)
  41         ;; Processing headers.
  42         (save-restriction
  43           (narrow-to-region (point-min) (point))
  44           (shimbun-decode-entities)
  45           (goto-char (point-min))
  46           (while (search-forward "\n<!--X-" nil t)
  47             (replace-match "\n"))
  48           (goto-char (point-min))
  49           (while (search-forward " -->\n" nil t)
  50             (replace-match "\n"))
  51           (goto-char (point-min))
  52           (while (search-forward "\t" nil t)
  53             (replace-match " "))
  54           (goto-char (point-min))
  55           (let (buf refs)
  56             (while (not (eobp))
  57               (cond
  58                ((looking-at "<!--")
  59                 (delete-region (point) (progn (forward-line 1) (point))))
  60                ((looking-at "Subject: +")
  61                 (shimbun-header-set-subject header
  62                                             (shimbun-header-field-value))
  63                 (delete-region (point) (progn (forward-line 1) (point))))
  64                ((looking-at "From: +")
  65                 (shimbun-header-set-from header (shimbun-header-field-value))
  66                 (delete-region (point) (progn (forward-line 1) (point))))
  67                ((looking-at "Date: +")
  68                 (shimbun-header-set-date header (shimbun-header-field-value))
  69                 (delete-region (point) (progn (forward-line 1) (point))))
  70                ((looking-at "Message-Id: +")
  71                 (shimbun-header-set-id header
  72                  (concat "<" (shimbun-header-field-value) ">"))
  73                 (delete-region (point) (progn (forward-line 1) (point))))
  74                ((looking-at "Reference: +")
  75                 (push (concat "<" (shimbun-header-field-value) ">") refs)
  76                 (delete-region (point) (progn (forward-line 1) (point))))
  77                ((looking-at "Content-Type: ")
  78                 (unless (search-forward "charset" (point-at-eol) t)
  79                   (end-of-line)
  80                   (insert "; charset=ISO-2022-JP"))
  81                 (forward-line 1))
  82                (t (forward-line 1))))
  83             (insert "MIME-Version: 1.0\n")
  84             (if refs
  85                 (shimbun-header-set-references header
  86                                                (mapconcat 'identity refs " ")))
  87             (insert "\n")
  88             (goto-char (point-min))
  89             (shimbun-header-insert header))
  90           (goto-char (point-max)))
  91         ;; Processing body.
  92         (save-restriction
  93           (narrow-to-region (point) (point-max))
  94           (delete-region
  95            (point)
  96            (progn
  97              (search-forward "\n<!--X-Body-of-Message-->\n" nil t)
  98              (point)))
  99           (when (search-forward "\n<!--X-Body-of-Message-End-->\n" nil t)
 100             (forward-line -1)
 101             (delete-region (point) (point-max)))
 102           (shimbun-remove-markup)
 103           (shimbun-decode-entities)))
 104     (goto-char (point-min))
 105     (shimbun-header-insert header)
 106     (insert
 107      "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n"))
 108   (encode-coding-string (buffer-string)
 109                         (mime-charset-to-coding-system "ISO-2022-JP")))
 110
 111 (provide 'sb-mhonarc)
 112
 113 ;;; sb-mhonarc.el ends here