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.
36 (luna-define-class elmo-shimbun-folder
37 (elmo-map-folder) (shimbun headers header-hash group))
38 (luna-define-internal-accessors 'elmo-shimbun-folder))
40 (luna-define-method elmo-folder-initialize ((folder
43 (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
44 (list (elmo-match-string 1 name)
45 (substring name (match-end 0)))
47 (if (nth 0 server-group) ; server
48 (elmo-shimbun-folder-set-shimbun-internal
50 (shimbun-open (nth 0 server-group))))
51 (if (nth 1 server-group)
52 (elmo-shimbun-folder-set-group-internal
54 (nth 1 server-group)))
57 (luna-define-method elmo-folder-open-internal :before ((folder
59 (when (elmo-folder-plugged-p folder)
61 (elmo-shimbun-folder-shimbun-internal folder)
62 (elmo-shimbun-folder-group-internal folder))
63 (elmo-shimbun-folder-set-headers-internal
64 folder (shimbun-headers
65 (elmo-shimbun-folder-shimbun-internal folder)))
66 (elmo-shimbun-folder-set-header-hash-internal
68 (elmo-make-hash (length (elmo-shimbun-folder-headers-internal folder))))
69 ;; Set up header hash.
70 (dolist (header (elmo-shimbun-folder-headers-internal folder))
72 (shimbun-header-id header) header
73 (elmo-shimbun-folder-header-hash-internal folder)))))
75 (luna-define-method elmo-folder-close-internal :after ((folder
78 (elmo-shimbun-folder-shimbun-internal folder))
79 (elmo-shimbun-folder-set-headers-internal
81 (elmo-shimbun-folder-set-header-hash-internal
84 (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
87 (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))
89 (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))
91 (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
92 plugged &optional add)
93 (elmo-set-plugged plugged
95 (shimbun-server-internal
96 (elmo-shimbun-folder-shimbun-internal folder))
98 (shimbun-server-internal
99 (elmo-shimbun-folder-shimbun-internal folder))
102 (luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
103 (when (shimbun-current-group-internal
104 (elmo-shimbun-folder-shimbun-internal folder))
105 ;; Discard current headers information.
106 (elmo-folder-close-internal folder)
107 (elmo-folder-open-internal folder)))
109 (luna-define-method elmo-folder-expand-msgdb-path ((folder
110 elmo-shimbun-folder))
112 (concat (shimbun-server-internal
113 (elmo-shimbun-folder-shimbun-internal folder))
115 (elmo-shimbun-folder-group-internal folder))
116 (expand-file-name "shimbun" elmo-msgdb-dir)))
118 (defun elmo-shimbun-msgdb-create-entity (folder number)
119 (let ((header (elmo-get-hash-val
120 (elmo-map-message-location folder number)
121 (elmo-shimbun-folder-header-hash-internal folder))))
124 (shimbun-header-insert
125 (elmo-shimbun-folder-shimbun-internal folder)
127 (elmo-msgdb-create-overview-from-buffer number)))))
129 (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
131 already-mark seen-mark
134 (let* (overview number-alist mark-alist entity
136 (setq num (length numlist))
138 (message "Creating msgdb...")
141 (elmo-shimbun-msgdb-create-entity
142 folder (car numlist)))
145 (elmo-msgdb-append-element
148 (elmo-msgdb-number-add number-alist
149 (elmo-msgdb-overview-entity-get-number
151 (elmo-msgdb-overview-entity-get-id
154 (elmo-msgdb-mark-append
156 (elmo-msgdb-overview-entity-get-number
158 (or (elmo-msgdb-global-mark-get
159 (elmo-msgdb-overview-entity-get-id
162 (when (> num elmo-display-progress-threshold)
164 (setq percent (/ (* i 100) num))
165 (elmo-display-progress
166 'elmo-folder-msgdb-create "Creating msgdb..."
168 (setq numlist (cdr numlist)))
169 (message "Creating msgdb...done.")
170 (elmo-msgdb-sort-by-date
171 (list overview number-alist mark-alist))))
173 (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
176 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
177 location strategy &optional
178 section outbuf unseen)
180 (with-current-buffer outbuf
182 (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
185 (elmo-shimbun-folder-header-hash-internal folder)))
188 (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
191 (elmo-shimbun-folder-header-hash-internal folder)))
194 (luna-define-method elmo-folder-list-messages-internal :around
195 ((folder elmo-shimbun-folder) &optional nohide)
196 (if (elmo-folder-plugged-p folder)
197 (luna-call-next-method)
200 (luna-define-method elmo-map-folder-list-message-locations
201 ((folder elmo-shimbun-folder))
203 (function shimbun-header-id)
204 (elmo-shimbun-folder-headers-internal folder)))
206 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
208 (unless (elmo-shimbun-folder-group-internal folder)
211 (concat (elmo-folder-prefix-internal folder)
212 (shimbun-server-internal
213 (elmo-shimbun-folder-shimbun-internal folder))
216 (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal folder)))))
218 (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
219 (if (elmo-shimbun-folder-group-internal folder)
222 (elmo-shimbun-folder-group-internal folder)
223 (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal
227 (luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
228 condition &optional from-msgs)
231 ;;; To override elmo-map-folder methods.
232 (luna-define-method elmo-folder-list-unreads-internal
233 ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
236 (luna-define-method elmo-folder-list-importants-internal
237 ((folder elmo-shimbun-folder) important-mark)
240 (luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
244 (luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
248 (luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
252 (luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
257 (product-provide (provide 'elmo-shimbun) (require 'elmo-version))
259 ;;; elmo-shimbun.el ends here