1 ;;; elmo-shimbun.el --- Shimbun interface for ELMO.
3 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
37 (defun-maybe shimbun-servers-list ()))
39 (defcustom elmo-shimbun-check-interval 60
40 "*Check interval for shimbun."
44 (defcustom elmo-shimbun-default-index-range 2
45 "*Default value for the range of header indices."
46 :type '(choice (const :tag "all" all)
47 (const :tag "last" last)
48 (integer :tag "number"))
51 (defcustom elmo-shimbun-use-cache t
52 "*If non-nil, use cache for each article."
56 (defcustom elmo-shimbun-index-range-alist nil
57 "*Alist of FOLDER-REGEXP and RANGE.
58 FOLDER-REGEXP is the regexp for shimbun folder name.
59 RANGE is the range of the header indices .
60 See `shimbun-headers' for more detail about RANGE."
61 :type '(repeat (cons (regexp :tag "Folder Regexp")
62 (choice (const :tag "all" all)
63 (const :tag "last" last)
64 (integer :tag "number"))))
67 (defcustom elmo-shimbun-update-overview-folder-list nil
68 "*List of FOLDER-REGEXP.
69 FOLDER-REGEXP is the regexp of shimbun folder name which should be
70 update overview when message is fetched."
71 :type '(repeat (regexp :tag "Folder Regexp"))
75 (defsubst elmo-shimbun-header-extra-field (header field-name)
76 (let ((extra (and header (shimbun-header-extra header))))
78 (cdr (assoc field-name extra)))))
80 (defsubst elmo-shimbun-header-set-extra-field (header field-name value)
81 (let ((extras (and header (shimbun-header-extra header)))
83 (if (setq extra (assoc field-name extras))
85 (shimbun-header-set-extra
87 (cons (cons field-name value) extras)))))
91 (luna-define-class shimbun-elmo-mua (shimbun-mua) (folder))
92 (luna-define-internal-accessors 'shimbun-elmo-mua))
94 (luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id)
95 (elmo-msgdb-overview-get-entity id
97 (shimbun-elmo-mua-folder-internal mua))))
100 (luna-define-class elmo-shimbun-folder
101 (elmo-map-folder) (shimbun headers header-hash
103 group range last-check))
104 (luna-define-internal-accessors 'elmo-shimbun-folder))
106 (defun elmo-shimbun-folder-entity-hash (folder)
107 (or (elmo-shimbun-folder-entity-hash-internal folder)
108 (let ((overviews (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
111 (setq hash (elmo-make-hash (length overviews)))
112 (dolist (entity overviews)
113 (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
115 (when (setq id (elmo-msgdb-overview-entity-get-extra-field
116 entity "x-original-id"))
117 (elmo-set-hash-val id entity hash)))
118 (elmo-shimbun-folder-set-entity-hash-internal folder hash)))))
120 (defsubst elmo-shimbun-folder-shimbun-header (folder location)
121 (let ((hash (elmo-shimbun-folder-header-hash-internal folder)))
122 (or (and hash (elmo-get-hash-val location hash))
123 (let ((entity (elmo-msgdb-overview-get-entity
125 (elmo-folder-msgdb folder)))
126 (elmo-hash-minimum-size 63)
129 (setq header (elmo-shimbun-entity-to-header entity))
131 (elmo-shimbun-folder-set-header-hash-internal
133 (setq hash (elmo-make-hash))))
134 (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
139 (defsubst elmo-shimbun-lapse-seconds (time)
140 (let ((now (current-time)))
141 (+ (* (- (car now) (car time)) 65536)
142 (- (nth 1 now) (nth 1 time)))))
144 (defun elmo-shimbun-parse-time-string (string)
145 "Parse the time-string STRING and return its time as Emacs style."
147 (let ((x (timezone-fix-time string nil nil)))
148 (encode-time (aref x 5) (aref x 4) (aref x 3)
149 (aref x 2) (aref x 1) (aref x 0)
152 (defsubst elmo-shimbun-headers-check-p (folder)
153 (or (null (elmo-shimbun-folder-last-check-internal folder))
154 (and (elmo-shimbun-folder-last-check-internal folder)
155 (> (elmo-shimbun-lapse-seconds
156 (elmo-shimbun-folder-last-check-internal folder))
157 elmo-shimbun-check-interval))))
159 (defun elmo-shimbun-entity-to-header (entity)
160 (let (message-id shimbun-id)
161 (if (setq message-id (elmo-msgdb-overview-entity-get-extra-field
162 entity "x-original-id"))
163 (setq shimbun-id (elmo-msgdb-overview-entity-get-id entity))
164 (setq message-id (elmo-msgdb-overview-entity-get-id entity)
167 (set-buffer-multibyte t)
169 (elmo-msgdb-overview-entity-get-number entity)
170 (shimbun-mime-encode-string
171 (decode-mime-charset-string
172 (elmo-msgdb-overview-entity-get-subject-no-decode entity)
174 (shimbun-mime-encode-string
175 (decode-mime-charset-string
176 (elmo-msgdb-overview-entity-get-from-no-decode entity)
178 (elmo-msgdb-overview-entity-get-date entity)
180 (elmo-msgdb-overview-entity-get-references entity)
183 (elmo-msgdb-overview-entity-get-extra-field entity "xref")
185 (list (cons "x-shimbun-id" shimbun-id)))))))
187 (defsubst elmo-shimbun-folder-header-hash-setup (folder headers)
188 (let ((hash (or (elmo-shimbun-folder-header-hash-internal folder)
189 (elmo-make-hash (length headers)))))
190 (dolist (header headers)
191 (elmo-set-hash-val (shimbun-header-id header) header hash))
192 (elmo-shimbun-folder-set-header-hash-internal folder hash)))
194 (defun elmo-shimbun-get-headers (folder)
195 (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder))
196 (key (concat (shimbun-server shimbun)
197 "." (shimbun-current-group shimbun)))
198 (elmo-hash-minimum-size 63)
205 (unless (elmo-msgdb-overview-get-entity
206 (shimbun-header-id x)
207 (elmo-folder-msgdb folder))
209 ;; This takes much time.
211 (elmo-shimbun-folder-shimbun-internal folder)
212 (elmo-shimbun-folder-range-internal folder)))))
213 (elmo-shimbun-folder-set-headers-internal folder headers)
215 (elmo-shimbun-folder-header-hash-setup folder headers))
216 (elmo-shimbun-folder-set-last-check-internal folder (current-time))))
218 (luna-define-method elmo-folder-initialize ((folder
221 (if (string= name "")
223 (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
224 (list (elmo-match-string 1 name)
225 (substring name (match-end 0)))
227 (when (nth 0 server-group) ; server
228 (elmo-shimbun-folder-set-shimbun-internal
230 (shimbun-open (nth 0 server-group)
231 (luna-make-entity 'shimbun-elmo-mua :folder folder))))
232 (when (nth 1 server-group)
233 (elmo-shimbun-folder-set-group-internal
235 (nth 1 server-group)))
236 (elmo-shimbun-folder-set-range-internal
238 (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder)
239 elmo-shimbun-index-range-alist))
240 elmo-shimbun-default-index-range))
243 (luna-define-method elmo-folder-open-internal ((folder elmo-shimbun-folder))
244 (when (elmo-shimbun-folder-shimbun-internal folder)
246 (elmo-shimbun-folder-shimbun-internal folder)
247 (elmo-shimbun-folder-group-internal folder))
248 (let ((inhibit-quit t))
249 (unless (elmo-map-folder-location-alist-internal folder)
250 (elmo-map-folder-location-setup
252 (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))
253 (when (and (elmo-folder-plugged-p folder)
254 (elmo-shimbun-headers-check-p folder))
255 (elmo-shimbun-get-headers folder)
256 (elmo-map-folder-update-locations
258 (elmo-map-folder-list-message-locations folder))))))
260 (luna-define-method elmo-folder-reserve-status-p ((folder elmo-shimbun-folder))
263 (luna-define-method elmo-folder-local-p ((folder elmo-shimbun-folder))
266 (luna-define-method elmo-message-use-cache-p ((folder elmo-shimbun-folder)
268 elmo-shimbun-use-cache)
270 (luna-define-method elmo-folder-close-internal :after ((folder
271 elmo-shimbun-folder))
273 (elmo-shimbun-folder-shimbun-internal folder))
274 (elmo-shimbun-folder-set-headers-internal
276 (elmo-shimbun-folder-set-header-hash-internal
278 (elmo-shimbun-folder-set-entity-hash-internal
280 (elmo-shimbun-folder-set-last-check-internal
283 (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
286 (and (elmo-shimbun-folder-shimbun-internal folder)
287 (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))
289 (and (elmo-shimbun-folder-shimbun-internal folder)
290 (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))))
292 (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
293 plugged &optional add)
294 (elmo-set-plugged plugged
297 (elmo-shimbun-folder-shimbun-internal folder))
300 (elmo-shimbun-folder-shimbun-internal folder))
303 (luna-define-method elmo-net-port-info ((folder elmo-shimbun-folder))
306 (elmo-shimbun-folder-shimbun-internal folder))
309 (luna-define-method elmo-folder-check :around ((folder elmo-shimbun-folder))
310 (when (shimbun-current-group
311 (elmo-shimbun-folder-shimbun-internal folder))
312 (when (and (elmo-folder-plugged-p folder)
313 (elmo-shimbun-headers-check-p folder))
314 (elmo-shimbun-get-headers folder)
315 (luna-call-next-method))))
317 (luna-define-method elmo-folder-clear :around ((folder elmo-shimbun-folder)
318 &optional keep-killed)
319 (elmo-shimbun-folder-set-headers-internal folder nil)
320 (elmo-shimbun-folder-set-header-hash-internal folder nil)
321 (elmo-shimbun-folder-set-entity-hash-internal folder nil)
322 (elmo-shimbun-folder-set-last-check-internal folder nil)
323 (luna-call-next-method))
325 (luna-define-method elmo-folder-expand-msgdb-path ((folder
326 elmo-shimbun-folder))
328 (concat (shimbun-server
329 (elmo-shimbun-folder-shimbun-internal folder))
331 (elmo-shimbun-folder-group-internal folder))
332 (expand-file-name "shimbun" elmo-msgdb-directory)))
334 (defun elmo-shimbun-msgdb-create-entity (folder number)
335 (let ((header (elmo-shimbun-folder-shimbun-header
337 (elmo-map-message-location folder number)))
341 (shimbun-header-insert
342 (elmo-shimbun-folder-shimbun-internal folder)
344 (setq ov (elmo-msgdb-create-overview-from-buffer number))
345 (elmo-msgdb-overview-entity-set-extra
348 (elmo-msgdb-overview-entity-get-extra ov)
349 (list (cons "xref" (shimbun-header-xref header)))))))))
351 (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
353 (let ((new-msgdb (elmo-make-msgdb))
354 entity i percent length msgid gmark)
355 (setq length (length numlist))
357 (message "Creating msgdb...")
360 (elmo-shimbun-msgdb-create-entity
361 folder (car numlist)))
363 (setq msgid (elmo-msgdb-overview-entity-get-id entity))
364 (setq gmark (or (elmo-msgdb-global-mark-get msgid)
366 (elmo-flag-table-get flag-table msgid)
367 (elmo-file-cache-status
368 (elmo-file-cache-get msgid))
370 (elmo-msgdb-append-entity new-msgdb entity gmark))
371 (when (> length elmo-display-progress-threshold)
373 (setq percent (/ (* i 100) length))
374 (elmo-display-progress
375 'elmo-folder-msgdb-create "Creating msgdb..."
377 (setq numlist (cdr numlist)))
378 (message "Creating msgdb...done")
379 (elmo-msgdb-sort-by-date new-msgdb)))
381 (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
384 (defsubst elmo-shimbun-update-overview (folder shimbun-id header)
385 (let ((entity (elmo-msgdb-overview-get-entity shimbun-id
386 (elmo-folder-msgdb folder)))
387 (message-id (shimbun-header-id header))
389 (unless (string= shimbun-id message-id)
390 (elmo-msgdb-overview-entity-set-extra-field
391 entity "x-original-id" message-id)
392 (elmo-shimbun-header-set-extra-field
393 header "x-shimbun-id" shimbun-id)
394 (elmo-set-hash-val message-id
396 (elmo-shimbun-folder-entity-hash folder))
397 (elmo-set-hash-val shimbun-id
399 (elmo-shimbun-folder-entity-hash folder)))
400 (elmo-msgdb-overview-entity-set-from
402 (elmo-mime-string (shimbun-header-from header)))
403 (elmo-msgdb-overview-entity-set-subject
405 (elmo-mime-string (shimbun-header-subject header)))
406 (elmo-msgdb-overview-entity-set-date
407 entity (shimbun-header-date header))
408 (when (setq references
409 (or (elmo-msgdb-get-last-message-id
410 (elmo-field-body "in-reply-to"))
411 (elmo-msgdb-get-last-message-id
412 (elmo-field-body "references"))))
413 (elmo-msgdb-overview-entity-set-references
415 (or (elmo-msgdb-overview-entity-get-id
418 (elmo-shimbun-folder-entity-hash folder)))
421 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
423 &optional section unseen)
424 (if (elmo-folder-plugged-p folder)
425 (let ((header (elmo-shimbun-folder-shimbun-header
429 (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
431 (when (elmo-string-match-member
432 (elmo-folder-name-internal folder)
433 elmo-shimbun-update-overview-folder-list)
434 (elmo-shimbun-update-overview folder location header))
435 (when (setq shimbun-id
436 (elmo-shimbun-header-extra-field header "x-shimbun-id"))
437 (goto-char (point-min))
438 (insert (format "X-Shimbun-Id: %s\n" shimbun-id)))
440 (error "Unplugged")))
442 (luna-define-method elmo-message-encache :around ((folder
444 number &optional read)
445 (if (elmo-folder-plugged-p folder)
446 (luna-call-next-method)
447 (if elmo-enable-disconnected-operation
448 (elmo-message-encache-dop folder number read)
449 (error "Unplugged"))))
451 (luna-define-method elmo-folder-list-messages-internal :around
452 ((folder elmo-shimbun-folder) &optional nohide)
453 (if (elmo-folder-plugged-p folder)
454 (luna-call-next-method)
457 (luna-define-method elmo-map-folder-list-message-locations
458 ((folder elmo-shimbun-folder))
459 (let ((expire-days (shimbun-article-expiration-days
460 (elmo-shimbun-folder-shimbun-internal folder))))
466 (when (and (elmo-msgdb-overview-entity-get-extra-field
469 (< (elmo-shimbun-lapse-seconds
470 (elmo-shimbun-parse-time-string
471 (elmo-msgdb-overview-entity-get-date ov)))
472 (* expire-days 86400 ; seconds per day
475 (elmo-msgdb-overview-entity-get-id ov)))
476 (elmo-msgdb-get-overview (elmo-folder-msgdb folder))))
479 (or (elmo-shimbun-header-extra-field header "x-shimbun-id")
480 (shimbun-header-id header)))
481 (elmo-shimbun-folder-headers-internal folder))))))
483 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
485 (let ((prefix (elmo-folder-prefix-internal folder)))
486 (cond ((elmo-shimbun-folder-shimbun-internal folder)
487 (unless (elmo-shimbun-folder-group-internal folder)
492 (elmo-shimbun-folder-shimbun-internal folder))
494 (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder)))))
495 ;; the rest are for "@/" group
498 (lambda (server) (list (concat prefix server)))
499 (shimbun-servers-list)))
502 (dolist (server (shimbun-servers-list))
506 (lambda (fld) (concat prefix server "." fld))
511 (concat prefix server))))
517 (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
518 (if (elmo-shimbun-folder-group-internal folder)
521 (elmo-shimbun-folder-group-internal folder)
522 (shimbun-groups (elmo-shimbun-folder-shimbun-internal
527 (product-provide (provide 'elmo-shimbun) (require 'elmo-version))
529 ;;; elmo-shimbun.el ends here