204 lines
7.6 KiB
EmacsLisp
204 lines
7.6 KiB
EmacsLisp
;;; sb-lotusex.el --- shimbun backend for http://tsuruo.dominohosting.biz -*- coding: iso-2022-7bit; -*-
|
||
|
||
;; Copyright (C) 2003, 2004 NAKAJIMA Mikio <minakaji@namazu.org>
|
||
|
||
;; Author: NAKAJIMA Mikio <minakaji@namazu.org>
|
||
;; Keywords: news
|
||
;; Created: May. 22, 2003
|
||
|
||
;; This file is a part of shimbun.
|
||
|
||
;; 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; see the file COPYING. If not, write to
|
||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||
;; Boston, MA 02110-1301, USA.
|
||
|
||
;;; Commentary:
|
||
|
||
;;; Code:
|
||
|
||
(require 'shimbun)
|
||
|
||
(luna-define-class shimbun-lotusex (shimbun) ())
|
||
|
||
(defconst shimbun-lotusex-url "http://tsuruo.dominohosting.biz/members/tsuruo/")
|
||
|
||
(defvar shimbun-lotusex-groups-alist
|
||
'(
|
||
("news" . "notes/nhome.nsf/PlainAllPage!OpenPage")
|
||
;;$B%N!<%D%G!<%?%Y!<%9DDNs<<(B
|
||
("library" . "notes/nhome.nsf/LiblaryPage!OpenPage")
|
||
;; $B%N!<%DA`:n<<(B
|
||
("operation" . "notes/nhome.nsf/OperatePage!OpenPage")
|
||
;; $B%N!<%D%G!<%?%Y!<%9:n@.D6F~Lg9V:B(B
|
||
("primer" . "notes/nhome.nsf/PrimerPage!OpenPage")
|
||
;; $B%N!<%D5;=Q<<(B
|
||
("tips" . "notes/nhome.nsf/TipsPage!OpenPage")
|
||
;; $B%N!<%D3hMQ8&5f<<(B
|
||
("practical" . "notes/nhome.nsf/PracticalPage!OpenPage")
|
||
;; $B%N!<%DDDNs4[<ALd<<(B
|
||
("qanda" . "notes/nhome.nsf/QuestionPage!OpenPage")
|
||
;; $B%N!<%DDDNs4[5Y7F<<(B
|
||
("lounge" . "notes/nhome.nsf/RestPage!OpenPage")
|
||
;; $B%N!<%DDDNs4[30JI!J%I%_%N(BWEB$BHG!K(B
|
||
("bbs")
|
||
))
|
||
|
||
(defvar shimbun-lotusex-groups
|
||
(mapcar 'car shimbun-lotusex-groups-alist))
|
||
(defvar shimbun-lotusex-from-address "webmaster@tsuruo.dominohosting.biz")
|
||
(defvar shimbun-lotusex-coding-system 'iso-2022-jp)
|
||
(defvar shimbun-lotusex-content-start "<table CELLPADDING=\"2\"[>]+>")
|
||
(defvar shimbun-lotusex-content-end "<table CELLPADDING=\"2\"[>]+>")
|
||
|
||
(defun shimbun-lotusex-make-date-string (date-string &optional time)
|
||
(when (string-match
|
||
"\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)"
|
||
date-string)
|
||
(shimbun-make-date-string
|
||
(string-to-number
|
||
(match-string-no-properties 1 date-string))
|
||
(string-to-number
|
||
(match-string-no-properties 2 date-string))
|
||
(string-to-number
|
||
(match-string-no-properties 3 date-string))
|
||
time)))
|
||
|
||
;;(luna-define-method shimbun-reply-to ((shimbun shimbun-lotusex))
|
||
;; (shimbun-from-address-internal shimbun))
|
||
|
||
(luna-define-method shimbun-index-url ((shimbun shimbun-lotusex))
|
||
(let ((group (shimbun-current-group-internal shimbun)))
|
||
(if (not (string= group "bbs"))
|
||
(concat shimbun-lotusex-url
|
||
(cdr (assoc group shimbun-lotusex-groups-alist)))
|
||
"http://d.dominodeveloper.net/members/tsuruo/bbs/NotesBBS.nsf/wMainViewPage!OpenPage")))
|
||
|
||
(luna-define-method shimbun-get-headers
|
||
((shimbun shimbun-lotusex) &optional outbuf)
|
||
(let ((group (shimbun-current-group-internal shimbun)))
|
||
(if (string= group "bbs")
|
||
(shimbun-lotusex-bbs-headers shimbun)
|
||
(shimbun-lotusex-headers shimbun group))))
|
||
|
||
(defun shimbun-lotusex-bbs-headers (shimbun)
|
||
(let (url from date subject end time ampm id headers
|
||
case-fold-search)
|
||
(subst-char-in-region (point-min) (point-max) ?\t ? t)
|
||
(goto-char (point-min))
|
||
(catch 'exit
|
||
(while (re-search-forward
|
||
"<SPAN STYLE=\"font-size: 12px\">\\([0-9][0-9][0-9][0-9]/[0-9][0-9]/[0-9][0-9]\\)(\\($B7n(B\\|$B2P(B\\|$B?e(B\\|$BLZ(B\\|$B6b(B\\|$BEZ(B\\|$BF|(B\\))</SPAN>"
|
||
nil t nil)
|
||
(setq date (match-string-no-properties 1))
|
||
(save-excursion
|
||
(setq end (or (re-search-forward
|
||
"<SPAN STYLE=\"font-size: 12px\">\\([0-9][0-9][0-9][0-9]/[0-9][0-9]/[0-9][0-9]\\)(\\($B7n(B\\|$B2P(B\\|$B?e(B\\|$BLZ(B\\|$B6b(B\\|$BEZ(B\\|$BF|(B\\))</SPAN>"
|
||
nil t nil)
|
||
(point-max))))
|
||
(while (re-search-forward
|
||
"<a href=\"\\(/members/tsuruo/bbs/NotesBBS\\.nsf/[/a-zA-Z0-9]+!OpenDocument\\)\".+> *\\[[0-9]+\\]\\(.+\\)\\[ +\\(.+\\) +,\\([0-9][0-9]:[0-9][0-9]\\) \\(AM\\|PM\\) ]</SPAN>"
|
||
end t nil)
|
||
(setq url (concat "http://d.dominodeveloper.net"
|
||
(match-string-no-properties 1))
|
||
subject (match-string-no-properties 2)
|
||
from (match-string-no-properties 3)
|
||
time (match-string-no-properties 4)
|
||
ampm (match-string-no-properties 5)
|
||
id (format "<%s%%%s%%%s@lotusex>"
|
||
date
|
||
(when (string-match "\\/\\([a-zA-Z0-9]+\\)\\!OpenDocument" url)
|
||
(match-string 1 url))
|
||
"bbs"))
|
||
(when (shimbun-search-id shimbun id)
|
||
(throw 'exit nil))
|
||
(when (and (string= ampm "PM")
|
||
(string-match ":" time))
|
||
(setq time (format
|
||
"%2d:%s"
|
||
(+ (string-to-number (substring time 0 (match-beginning 0)))
|
||
12)
|
||
(substring time (match-end 0)))))
|
||
(when (string-match "^ +\\(.+\\)" subject)
|
||
(setq subject (match-string 1 subject)))
|
||
(when (string-match "^\\(.+\\) +$" subject)
|
||
(setq subject (match-string 1 subject)))
|
||
(when (string-match "^ +\\(.+\\)" from)
|
||
(setq from (match-string 1 from)))
|
||
(when (string-match "^\\(.+\\) +$" from)
|
||
(setq from (match-string 1 from)))
|
||
(push (shimbun-make-header
|
||
0 (shimbun-mime-encode-string subject)
|
||
(shimbun-mime-encode-string from)
|
||
(shimbun-lotusex-make-date-string date time)
|
||
id "" 0 0 url)
|
||
headers))))
|
||
headers))
|
||
|
||
(defun shimbun-lotusex-headers (shimbun group)
|
||
(let (url from date subject id headers
|
||
case-fold-search)
|
||
(subst-char-in-region (point-min) (point-max) ?\t ? t)
|
||
(goto-char (point-min))
|
||
(catch 'exit
|
||
(while (re-search-forward
|
||
"<a href=\"/members/tsuruo/\\(notes/nhome\\.nsf/[/a-zA-Z0-9]+!OpenDocument\\)\".+>[0-9A-Z]+\\(.+\\)(\\([0-9]+/[0-9]+/[0-9]+\\)) *\\(- $B!Z(B.+$B![(B\\)?</SPAN>"
|
||
nil t nil)
|
||
(setq url (match-string-no-properties 1)
|
||
subject (match-string-no-properties 2)
|
||
from shimbun-lotusex-from-address
|
||
date (match-string-no-properties 3)
|
||
subject (concat subject (match-string-no-properties 4))
|
||
id (format "<%s%%%s%%%s@lotusex>"
|
||
date
|
||
(when (string-match "\\/\\([a-zA-Z0-9]+\\)\\!OpenDocument" url)
|
||
(match-string 1 url))
|
||
group))
|
||
(when (shimbun-search-id shimbun id)
|
||
(throw 'exit nil))
|
||
(setq date (shimbun-lotusex-make-date-string date)
|
||
url (concat shimbun-lotusex-url url))
|
||
(when (string-match "^ +\\(.+\\)" subject)
|
||
(setq subject (match-string 1 subject)))
|
||
(when (string-match "^\\(.+\\) +$" subject)
|
||
(setq subject (match-string 1 subject)))
|
||
(when (string-match "^ +\\(.+\\)" from)
|
||
(setq from (match-string 1 from)))
|
||
(when (string-match "^\\(.+\\) +$" from)
|
||
(setq from (match-string 1 from)))
|
||
(push (shimbun-make-header
|
||
0 (shimbun-mime-encode-string subject)
|
||
(shimbun-mime-encode-string from)
|
||
date id "" 0 0 url)
|
||
headers)))
|
||
headers))
|
||
|
||
(luna-define-method shimbun-make-contents :before
|
||
((shimbun shimbun-lotusex) header)
|
||
(shimbun-lotusex-make-contents shimbun header))
|
||
|
||
(defun shimbun-lotusex-make-contents (shimbun header)
|
||
(let ((group (shimbun-current-group-internal shimbun))
|
||
start)
|
||
(when (string= group "bbs")
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(when (and (re-search-forward "^<form action=\"\">" nil t)
|
||
(setq start (point))
|
||
(re-search-forward "^</form>$" nil t))
|
||
(delete-region (match-beginning 0) (point-max))
|
||
(delete-region (point-min) start))))))
|
||
|
||
(provide 'sb-lotusex)
|
||
;;; sb-lotusex.el ends here
|