1e47c4b233e058f0fb6fd29bc74cadebc8e71463
[elisp/mixi.git] / sb-mixi.el
1 ;;; sb-mixi.el --- shimbun backend for mixi
2
3 ;; Copyright (C) 2006 OHASHI Akira
4
5 ;; Author: OHASHI Akira <bg66@koka-in.org>
6 ;; Keywords: news
7
8 ;; This file is *NOT* a part of shimbun.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; if not, you can either send email to this
22 ;; program's maintainer or write to: The Free Software Foundation,
23 ;; Inc.; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (require 'mixi)
30 (require 'shimbun)
31
32 (luna-define-class shimbun-mixi (shimbun) ())
33
34 (defcustom shimbun-mixi-group-alist '(("new-diaries" . mixi-get-new-diaries)
35                                       ("new-comments" . mixi-get-new-comments)
36                                       ("new-topics" . mixi-get-new-topics)
37                                       ("my-diaries" . "/home.pl"))
38   "*An alist of mixi shimbun group definition.
39 Each element looks like (NAME . URL) or (NAME . FUNCTION).
40 NAME is a shimbun group name.
41 URL is the URL for mixi access point of the group.  When URL is friend's, get
42 his/her diaries as article.  When community's, get its topics.  When diary's
43 or topic's, get its comments.
44 FUNCTION is the function for getting articles."
45   :group 'shimbun
46   :type '(repeat (cons :fromat "%v"
47                        (string :tag "Group name")
48                        (radio (string :tag "URL")
49                               (const :tag "New diaries" mixi-get-new-diaries)
50                               (const :tag "New comments" mixi-get-new-comments)
51                               (const :tag "New topics" mixi-get-new-topics)
52                               (function :tag "Other function")))))
53
54 (defcustom shimbun-mixi-page-articles 10
55   "*How many articles are there in one page."
56   :group 'shimbun
57   :type 'integer)
58
59 (luna-define-method shimbun-groups ((shimbun shimbun-mixi))
60   (mapcar 'car shimbun-mixi-group-alist))
61
62 (defun shimbun-mixi-make-subject (object)
63   (let ((class (mixi-object-class object)))
64     (if (eq class 'mixi-comment)
65         (concat "Re: " (mixi-object-title (mixi-comment-parent object)))
66       (mixi-object-title object))))
67
68 (defun shimbun-mixi-make-from (object)
69   (let ((owner (mixi-object-owner object)))
70     (mixi-friend-nick owner)))
71
72 (defun shimbun-mixi-make-date (object)
73   (let* ((time (mixi-object-time object))
74          (cts (current-time-string time))
75          (day-of-week (substring cts 0 3))
76          (month (substring cts 4 7)))
77     (concat day-of-week ", "
78             (format-time-string "%d" time) " "
79             month " "
80             (format-time-string "%Y %H:%M:%S %z" time))))
81
82 (defun shimbun-mixi-make-message-id (object)
83   (let ((class (mixi-object-class object)))
84     (concat "<"
85             (format-time-string "%Y%m%d%H%M" (mixi-object-time object)) "."
86             (if (eq class 'mixi-comment)
87                 (concat (mixi-friend-id (mixi-comment-owner object)) "@"
88                         (mixi-object-id (mixi-comment-parent object)) "."
89                         (mixi-friend-id (mixi-object-owner
90                                          (mixi-comment-parent object))) ".")
91               (concat (mixi-object-id object) "@"
92                       (mixi-object-id (mixi-object-owner object)) "."))
93             (mixi-object-name object) ".mixi.jp"
94             ">")))
95
96 (defun shimbun-mixi-make-xref (object)
97   (let ((class (mixi-object-class object)))
98     (cond ((eq class 'mixi-diary)
99            (mixi-expand-url (mixi-diary-page object)))
100           ((eq class 'mixi-topic)
101            (mixi-expand-url (mixi-topic-page object)))
102           ((eq class 'mixi-comment)
103            (concat (shimbun-mixi-make-xref (mixi-comment-parent object))
104                    "#comment")))))
105
106 (defun shimbun-mixi-get-headers (shimbun objects &optional range)
107   (when objects
108     (let (headers)
109       (catch 'stop
110         (mapc (lambda (object)
111                 (when (mixi-object-p object)
112                   (let ((class (mixi-object-class object))
113                         (id (shimbun-mixi-make-message-id object)))
114                     (when (and (eq class 'mixi-comment)
115                                (shimbun-search-id shimbun id))
116                       (throw 'stop nil))
117                     (push
118                      (shimbun-create-header
119                       0
120                       (shimbun-mixi-make-subject object)
121                       (shimbun-mixi-make-from object)
122                       (shimbun-mixi-make-date object)
123                       id
124                       (if (eq class 'mixi-comment)
125                           (shimbun-mixi-make-message-id
126                            (mixi-comment-parent object))
127                         "")
128                       0 0
129                       (shimbun-mixi-make-xref object))
130                      headers)
131                     (when (or (eq class 'mixi-diary)
132                               (eq class 'mixi-topic))
133                       (let ((comments (mixi-get-comments object range)))
134                         (mapc (lambda (header)
135                                 (push header headers))
136                               (shimbun-mixi-get-headers shimbun
137                                                         comments)))))))
138               objects))
139       headers)))
140
141 (luna-define-method shimbun-get-headers ((shimbun shimbun-mixi)
142                                          &optional range)
143   (let ((url-or-function (cdr (assoc (shimbun-current-group-internal shimbun)
144                                      shimbun-mixi-group-alist)))
145         (range (when (integerp range) (* range shimbun-mixi-page-articles)))
146         objects)
147     (if (stringp url-or-function)
148         (let* ((object (mixi-make-object-from-url url-or-function))
149                (class (mixi-object-class object)))
150           (cond ((eq class 'mixi-friend)
151                  (setq objects (mixi-get-diaries object range)))
152                 ((eq class 'mixi-community)
153                  (setq objects (mixi-get-topics object range)))
154                 ((or (eq class 'mixi-diary) (eq class 'mixi-topic))
155                  (setq objects (mixi-get-comments object range)))
156                 (t (error (concat (symbol-name class)
157                                   " is not supported yet.")))))
158       (when (fboundp url-or-function)
159         (setq objects (funcall url-or-function range))))
160     (shimbun-sort-headers (shimbun-mixi-get-headers shimbun objects range))))
161
162 (defun shimbun-comment-article (url header)
163   (let ((parent (mixi-make-object-from-url url))
164         (date (shimbun-header-date header))
165         (from (shimbun-header-from header)))
166     (catch 'found
167       (mapc (lambda (comment)
168               (let ((nick (mixi-friend-nick (mixi-comment-owner comment)))
169                     (time (shimbun-mixi-make-date comment))
170                     nick2)
171                 ;; FIXME: How tricky it is.
172                 (when (string-match "\\(.+\\)¤µ¤ó$" nick)
173                   (setq nick2 (match-string 1 nick)))
174                 (when (and
175                        (or (string= (shimbun-mime-encode-string nick) from)
176                            (string= (shimbun-mime-encode-string nick2) from))
177                        (string= time date))
178                   ;; FIXME: Concat parent's information?
179                   (throw 'found (mixi-comment-content comment)))))
180             ;; FIXME: Limit range?
181             (mixi-get-comments parent)))))
182
183 (luna-define-method shimbun-article ((shimbun shimbun-mixi)
184                                      header &optional outbuf)
185   (when (shimbun-current-group-internal shimbun)
186     (with-current-buffer (or outbuf (current-buffer))
187       (w3m-insert-string
188        (or (with-temp-buffer
189              (let* ((url (shimbun-article-url shimbun header))
190                     (article (if (string-match "#comment$" url)
191                                  (shimbun-comment-article url header)
192                                ;; FIXME: Concat community information?
193                                (mixi-object-content
194                                 (mixi-make-object-from-url url)))))
195                (when (stringp article)
196                  (insert article)))
197              (shimbun-message shimbun "shimbun: Make contents...")
198              (goto-char (point-min))
199              (prog1 (shimbun-make-contents shimbun header)
200                (shimbun-message shimbun "shimbun: Make contents...done")))
201            "")))))
202
203 (provide 'sb-mixi)
204
205 ;;; sb-mixi.el ends here