242 lines
8.8 KiB
EmacsLisp
242 lines
8.8 KiB
EmacsLisp
;;; sb-tech-on.el --- shimbun backend for Tech-On! -*- coding: iso-2022-7bit -*-
|
||
|
||
;; Copyright (C) 2007, 2009 Katsumi Yamaoka
|
||
|
||
;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
|
||
;; Keywords: news
|
||
|
||
;; 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:
|
||
|
||
(eval-when-compile (require 'static))
|
||
(require 'sb-rss)
|
||
(require 'sb-multi)
|
||
|
||
(luna-define-class shimbun-tech-on (shimbun-multi shimbun-rss) ())
|
||
|
||
(defvar shimbun-tech-on-user-name 'none
|
||
"*User name to log in on Tech-On! with.
|
||
If it is nil, you will be prompted for a user name when logging in on
|
||
Tech-On! with. If it is a string, it will be used as a user name and
|
||
you will never be prompted. If it is neither nil nor a string, you
|
||
will never log in. See also `shimbun-tech-on-password'.")
|
||
|
||
(defvar shimbun-tech-on-password 'none
|
||
"*Password to use to log in on Tech-On! with.
|
||
If it is nil, you will be prompted for a password when logging in on
|
||
Tech-On! with. If it is a string, it will be used as a password and
|
||
you will never be prompted. If it is neither nil nor a string, you
|
||
will never log in. See also `shimbun-tech-on-user-name'.")
|
||
|
||
(defvar shimbun-tech-on-url "http://techon.nikkeibp.co.jp/")
|
||
|
||
(defvar shimbun-tech-on-group-table
|
||
'(("latestnews" "Tech-On$B!*(B" "/rss/index.rdf")
|
||
("mobile" "$B%b%P%$%k(B" "/mobile/index.rdf")
|
||
("bbint" "$BDL?.(B" "/bbint/index.rdf")
|
||
("d-ce" "$B%G%8%?%k2HEE(B" "/d-ce/index.rdf")
|
||
("AT" "Automotive Technology" "/AT/index.rdf")
|
||
("edaonline" "EDA Online" "/edaonline/index.rdf")
|
||
("device" "$BEE;RItIJ%F%/%N%m%8(B" "/device/index.rdf")
|
||
("lsi" "LSI$B>pJs6I(B" "/lsi/index.rdf")
|
||
("silicon" "Silicon Online" "/silicon/index.rdf")
|
||
("observer" "$B;:6HF08~%*%V%6!<%P(B" "/observer/index.rdf")
|
||
("fpd" "FPD International" "/fpd/index.rdf")
|
||
("mono" "$B$b$N$E$/$j$H(BIT" "/mono/index.rdf")
|
||
("embedded" "$BAH$_9~$_3+H/(B" "/embedded/index.rdf")
|
||
("mecha" "$B5!3#!&%a%+%H%m%K%/%9(B" "/mecha/index.rdf")
|
||
("MEMS" "MEMS International" "/MEMS/index.rdf")
|
||
("nano" "$B%J%N%F%/(I%$B?7AG:`(B" "/nano/index.rdf")
|
||
("carele" "$B%+!<%(%l%/%H%m%K%/%9(B" "/carele/index.rdf")
|
||
("board" "$BF|7P%\!<%I>pJs(B" "/board/index.rdf")
|
||
("mcu" "$B%^%$%3%s(B" "/mcu/index.rdf")
|
||
("PLM" "PLM" "/PLM/index.rdf")
|
||
("memory" "$B%a%b%j(B" "/memory/index.rdf")
|
||
("measurement" "$B7WB,(B" "/measurement/index.rdf")
|
||
("column.mot" "$B5;=Q7P1D@oN,9M(B" "/column/mot/index.rdf")))
|
||
|
||
(defvar shimbun-tech-on-server-name "Tech-On!")
|
||
|
||
(defvar shimbun-tech-on-x-face-alist
|
||
'(("default" . "\
|
||
Face: iVBORw0KGgoAAAANSUhEUgAAACAAAAAgAgMAAAAOFJJnAAAADFBMVEUAAAB/gP+ttr7///8
|
||
c6BRHAAAAnUlEQVQY02XNPQpCMQwA4NBs9jDvCJ5CXEVv4dJQLyKuHbyCl3i4Cl3EsSA8+l6NoU0
|
||
HMVk+8gsEa2b2DP94rs7DYyCExZIlJCMw6NF7AaI5VZgOQMOtEhQYTOjDXuH7FrU7ZG9W8LlOkuE
|
||
FrPGD0TFnQdlsmSfB240KyYo7F9dxtIrdRbAAln1SHJK2GmQ9ptwOxsTtRawteTrn6QtRz6k/Cwl
|
||
XeQAAAABJRU5ErkJggg==")))
|
||
|
||
(defvar shimbun-tech-on-expiration-days 7)
|
||
|
||
(luna-define-method shimbun-groups ((shimbun shimbun-tech-on))
|
||
(mapcar 'car shimbun-tech-on-group-table))
|
||
|
||
(luna-define-method shimbun-current-group-name ((shimbun shimbun-tech-on))
|
||
(nth 1 (assoc (shimbun-current-group-internal shimbun)
|
||
shimbun-tech-on-group-table)))
|
||
|
||
(luna-define-method shimbun-from-address ((shimbun shimbun-tech-on))
|
||
(concat shimbun-tech-on-server-name
|
||
" (" (shimbun-current-group-name shimbun) ")"))
|
||
|
||
(luna-define-method shimbun-index-url ((shimbun shimbun-tech-on))
|
||
(shimbun-expand-url (nth 2 (assoc (shimbun-current-group-internal shimbun)
|
||
shimbun-tech-on-group-table))
|
||
shimbun-tech-on-url))
|
||
|
||
(luna-define-method shimbun-rss-build-message-id ((shimbun shimbun-tech-on)
|
||
url date)
|
||
(let ((start 0)
|
||
rest)
|
||
(while (string-match "[0-9]+" url start)
|
||
(push (match-string 0 url) rest)
|
||
(setq start (match-end 0)))
|
||
(if rest
|
||
(concat "<" (mapconcat 'identity (nreverse rest) ".")
|
||
"." (shimbun-current-group-internal shimbun)
|
||
"%techon.nikkeibp.co.jp>")
|
||
(error "Cannot find message-id base"))))
|
||
|
||
(defvar shimbun-tech-on-logged-in nil)
|
||
|
||
(defun shimbun-tech-on-login ()
|
||
"Log in on Tech-On! with."
|
||
(interactive)
|
||
(when (or (interactive-p)
|
||
(not shimbun-tech-on-logged-in))
|
||
(let ((user (cond ((stringp shimbun-tech-on-user-name)
|
||
shimbun-tech-on-user-name)
|
||
(shimbun-tech-on-user-name
|
||
nil)
|
||
(t
|
||
(condition-case nil
|
||
(let (inhibit-quit)
|
||
(read-string "[Tech-On!] User name: "))
|
||
(quit nil)))))
|
||
pass)
|
||
(when (and user
|
||
(not (string-match "\\`[\t ]*\\'" user))
|
||
(setq pass (cond ((stringp shimbun-tech-on-password)
|
||
shimbun-tech-on-password)
|
||
(shimbun-tech-on-password
|
||
nil)
|
||
(t
|
||
(condition-case nil
|
||
(let (inhibit-quit)
|
||
(read-passwd "[Tech-On!] Password: "))
|
||
(quit nil)))))
|
||
(not (string-match "\\`[\t ]*\\'" pass)))
|
||
(with-temp-buffer
|
||
(static-unless (featurep 'xemacs)
|
||
(set-buffer-multibyte t))
|
||
(shimbun-retrieve-url
|
||
(concat "https://techon.nikkeibp.co.jp/login/login.jsp"
|
||
"?MODE=LOGIN_EXEC"
|
||
"&USERID=" user
|
||
"&PASSWORD=" pass)
|
||
t)
|
||
(goto-char (point-min))
|
||
(setq shimbun-tech-on-logged-in
|
||
(not (re-search-forward "\
|
||
\\(?:$B%f!<%6!<L>(B\\|$B%Q%9%o!<%I(B\\).*$B$K8m$j$,$"$j$^$9!#(B\
|
||
\\|$B2q0wEPO?$,9T$o$l$F$$$^$;$s!#(B\
|
||
\\|ACTION=\"/login/login\\.jsp\\?MODE=LOGIN_EXEC\""
|
||
nil t))))
|
||
(if shimbun-tech-on-logged-in
|
||
(when (interactive-p)
|
||
(message "[Tech-On!] Logged in"))
|
||
(when (prog2
|
||
(message nil)
|
||
(y-or-n-p "[Tech-On!] Login failed; retry? ")
|
||
(message nil))
|
||
(setq shimbun-tech-on-user-name nil
|
||
shimbun-tech-on-password nil)
|
||
(shimbun-tech-on-login)))))))
|
||
|
||
(luna-define-method shimbun-multi-next-url ((shimbun shimbun-tech-on)
|
||
header url)
|
||
(goto-char (point-min))
|
||
(when (re-search-forward "[\t\n ]*\\(?:$B!J(B[\t\n ]*\\)*<a[\t\n ]+\
|
||
\\(?:[^\t\n >]+[\t\n ]+\\)*href=\"\\([^\"]+\\)\"\
|
||
\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]*>[\t\n ]*$B<!$N(B?$B%Z!<%8$X(B[^<]*</a>"
|
||
nil t)
|
||
(shimbun-expand-url (match-string 1) url)))
|
||
|
||
(luna-define-method shimbun-multi-clear-contents :around ((shimbun
|
||
shimbun-tech-on)
|
||
header
|
||
has-previous-page
|
||
has-next-page)
|
||
(when (luna-call-next-method)
|
||
;; Insert page delimiter.
|
||
(when has-previous-page
|
||
(goto-char (point-min))
|
||
(insert "\n")
|
||
;; Remove tags that likely cause a newline preceding a page.
|
||
(when (and (looking-at "[\t\n ]*<\\(h[0-9]+\\|p\\)[\t\n >]")
|
||
(shimbun-end-of-tag (match-string 1) t))
|
||
(replace-match "\n\\3\n")))
|
||
t))
|
||
|
||
(luna-define-method shimbun-clear-contents :around ((shimbun shimbun-tech-on)
|
||
header)
|
||
(let ((author (when (and (re-search-forward "\
|
||
<div[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*class=\"author\"" nil t)
|
||
(shimbun-end-of-tag "div" t))
|
||
(match-string 2))))
|
||
(goto-char (point-min))
|
||
(when (and (re-search-forward "\
|
||
<div[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*id=\"kiji\"" nil t)
|
||
(shimbun-end-of-tag "div" t))
|
||
(delete-region (match-end 1) (point-max))
|
||
(insert "\n")
|
||
(delete-region (point-min) (match-beginning 1))
|
||
;; Remove repeated <p>s.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "<p>\\([\t\n ]*<p>\\)+" nil t)
|
||
(delete-region (match-beginning 1) (match-end 0)))
|
||
;; Remove useless tags.
|
||
(goto-char (point-min))
|
||
(while (and (re-search-forward "\
|
||
<div[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*class=\"bpimage_click\"" nil t)
|
||
(shimbun-end-of-tag "div" t))
|
||
(replace-match "\n"))
|
||
(when author
|
||
(goto-char (point-min))
|
||
(insert "<p>" author "</p>\n"))
|
||
t)))
|
||
|
||
(luna-define-method shimbun-footer :around ((shimbun shimbun-tech-on)
|
||
header &optional html)
|
||
(concat "<div align=\"left\">\n-- <br>\n\
|
||
$B$3$N5-;v$NCx:n8"$OF|7P(BBP$B<R!"$^$?$O$=$N>pJsDs6!<T$K5"B0$7$^$9!#(B\
|
||
$B86J*$O(B<a href=\""
|
||
(shimbun-article-base-url shimbun header)
|
||
"\"><u>$B$3$3(B</u></a>$B$G8x3+$5$l$F$$$^$9!#(B\n</div>\n"))
|
||
|
||
(luna-define-method shimbun-article :before ((shimbun shimbun-tech-on)
|
||
&rest args)
|
||
(shimbun-tech-on-login))
|
||
|
||
(luna-define-method shimbun-close :after ((shimbun shimbun-tech-on))
|
||
(setq shimbun-tech-on-logged-in nil))
|
||
|
||
(provide 'sb-tech-on)
|
||
|
||
;;; sb-tech-on.el ends here
|