;;; sb-ibm-dev.el --- shimbun backend for www-6.ibm.com/ja/developerworks -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2001, 2003 NAKAJIMA Mikio ;; Author: NAKAJIMA Mikio ;; Keywords: news ;; 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; 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: ;;; Code: (require 'shimbun) (luna-define-class shimbun-ibm-dev (shimbun) ()) (defvar shimbun-ibm-dev-url "http://www-6.ibm.com/jp/developerworks/") (defvar shimbun-ibm-dev-groups '("autonomic" "java" "linux" "opensource" "webservices" "xml")) (defvar shimbun-ibm-dev-from-address "webmaster@www-6.ibm.com") (defvar shimbun-ibm-dev-coding-system 'japanese-shift-jis-unix) (defvar shimbun-ibm-dev-content-start "") (defvar shimbun-ibm-dev-content-end "") (luna-define-method shimbun-get-headers ((shimbun shimbun-ibm-dev) &optional range) (with-temp-buffer (let* ((case-fold-search t) (from (shimbun-from-address shimbun)) (pages (shimbun-header-index-pages range)) (group (shimbun-current-group-internal shimbun)) (baseurl (concat (shimbun-url-internal shimbun) group "/")) (count 0) aux headers id url subject date datelist indexes index) (setq index (shimbun-expand-url "library.html" baseurl)) (shimbun-retrieve-url index 'reload) (subst-char-in-region (point-min) (point-max) ?\t ?\ t) (goto-char (point-min)) (push index indexes) ;; push latest ;; check old lib (while (re-search-forward "]+\\)?>\\(.*\\) (\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)) *
" nil t) (setq url (match-string 1) subject (match-string 3) datelist (list (string-to-number (match-string 4)) (string-to-number (match-string 5)) (string-to-number (match-string 6))) date (apply 'shimbun-make-date-string datelist)) ;; remove ...(bold tag) if exist in subject (when (string-match "<[bB] *>\\([^<]*\\)" subject) (setq subject (match-string 1 subject))) ;; adjusting URL (setq url (shimbun-expand-url url baseurl)) ;; building ID (setq aux (if (string-match "\\([^/]+\\)\\.html" url) (match-string 1 url) url)) (setq id (format "<%s%%%02d%02d%02d%%%s@www-6.ibm.com>" aux (car datelist) (car (cdr datelist)) (car (cdr (cdr datelist))) group)) (when (shimbun-search-id shimbun id) (throw 'stop nil)) (push (shimbun-make-header 0 (shimbun-mime-encode-string subject) from date id "" 0 0 url) headers) (forward-line 1)))) headers))) (luna-define-method shimbun-article ((shimbun shimbun-ibm-dev) header &optional outbuf) (when (shimbun-current-group-internal shimbun) (with-current-buffer (or outbuf (current-buffer)) (insert (or (with-temp-buffer (shimbun-retrieve-url (shimbun-article-url shimbun header)) (message "shimbun: Make contents...") (goto-char (point-min)) (if (re-search-forward "" nil t) (let ((url (match-string 1))) (message "shimbun: Redirecting...") ;;(shimbun-set-url-internal shimbun url) (erase-buffer) (shimbun-retrieve-url url 'no-cache) (message "shimbun: Redirecting...done") (message "shimbun: Make contents..."))) (goto-char (point-min)) (prog1 (shimbun-make-contents shimbun header) (message "shimbun: Make contents...done"))) ""))))) (luna-define-method shimbun-make-contents :before ((shimbun shimbun-ibm-dev) header) (save-excursion (let ((case-fold-search t)) (subst-char-in-region (point-min) (point-max) ?\t ?\ t) (goto-char (point-min)) ;; Remove sidebar if exist ;; PDF mail and Black line (when (re-search-forward "" nil t) ;; match title tail (let (beg end) (setq beg (match-beginning 0)) (when (re-search-forward "" nil t) (setq end (match-end 0))) (when (or (re-search-forward "

" nil t) ;; match subtitle (re-search-forward "

[  ]*レベル" nil t)) ;; match body pre-fixed form (setq end (match-beginning 0))) ;; cut #Title# >...< #Body Form# (when end (delete-region beg end))))) (goto-char (point-min)))) (provide 'sb-ibm-dev) ;;; sb-ibm-dev.el ends here