1 ;;; elmo-mark.el -- Global mark folder for ELMO.
3 ;; Copyright (C) 1998,1999,2000 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.
34 (defcustom elmo-mark-default-mark "$"
35 "*Default global-mark for mark-folder."
41 (luna-define-class elmo-mark-folder (elmo-map-folder) (mark))
42 (luna-define-internal-accessors 'elmo-mark-folder))
44 (luna-define-method elmo-folder-initialize ((folder
47 (elmo-mark-folder-set-mark-internal
49 elmo-mark-default-mark)
52 (luna-define-method elmo-folder-expand-msgdb-path ((folder
54 (expand-file-name "mark"
55 (expand-file-name "internal"
58 (luna-define-method elmo-map-folder-list-message-locations
59 ((folder elmo-mark-folder))
60 (elmo-mark-folder-list-message-locations folder))
62 (defun elmo-mark-folder-list-message-locations (folder)
64 (dolist (pair (or elmo-msgdb-global-mark-alist
65 (setq elmo-msgdb-global-mark-alist
68 elmo-msgdb-global-mark-filename
70 (if (string= (elmo-mark-folder-mark-internal folder)
72 (setq result (cons (car pair) result))))
75 (luna-define-method elmo-folder-message-file-p ((folder elmo-mark-folder))
78 (luna-define-method elmo-message-file-name ((folder elmo-mark-folder)
80 (elmo-file-cache-get-path
81 (elmo-map-message-location folder number)))
83 (luna-define-method elmo-folder-msgdb-create ((folder elmo-mark-folder)
85 already-mark seen-mark
88 (elmo-mark-folder-msgdb-create folder numbers new-mark already-mark
89 seen-mark important-mark))
91 (defun elmo-mark-folder-msgdb-create (folder numbers new-mark already-mark
92 seen-mark important-mark)
94 (len (length numbers))
95 overview number-alist mark-alist entity message-id
97 (message "Creating msgdb...")
100 (elmo-msgdb-create-overview-entity-from-file
101 (car numbers) (elmo-message-file-name folder (car numbers))))
104 (setq num (elmo-msgdb-overview-entity-get-number entity))
106 (elmo-msgdb-append-element
108 (setq message-id (elmo-msgdb-overview-entity-get-id entity))
110 (elmo-msgdb-number-add number-alist
114 (elmo-msgdb-mark-append
116 num (elmo-mark-folder-mark-internal folder))))
117 (when (> len elmo-display-progress-threshold)
119 (elmo-display-progress
120 'elmo-mark-folder-msgdb-create "Creating msgdb..."
122 (setq numbers (cdr numbers)))
123 (message "Creating msgdb...done")
124 (list overview number-alist mark-alist)))
126 (luna-define-method elmo-folder-append-buffer ((folder elmo-mark-folder)
127 unread &optional number)
128 (let* ((msgid (elmo-field-body "message-id"))
129 (path (elmo-file-cache-get-path msgid))
132 (setq dir (directory-file-name (file-name-directory path)))
133 (if (not (file-exists-p dir))
134 (elmo-make-directory dir))
135 (as-binary-output-file (write-region (point-min) (point-max)
137 (elmo-msgdb-global-mark-set msgid
138 (elmo-mark-folder-mark-internal folder))))
140 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-mark-folder)
142 (dolist (location locations)
143 (elmo-msgdb-global-mark-delete location)))
145 (luna-define-method elmo-map-message-fetch ((folder elmo-mark-folder)
146 location strategy &optional
147 section outbuf unseen)
148 (elmo-mark-folder-map-message-fetch folder location strategy
149 section outbuf unseen))
151 (defun elmo-mark-folder-map-message-fetch (folder location strategy
152 section outbuf unseen)
153 (let ((file (elmo-file-cache-get-path location)))
154 (when (file-exists-p file)
156 (with-current-buffer outbuf
158 (insert-file-contents-as-binary file)
159 (elmo-delete-cr-buffer)
162 (insert-file-contents-as-binary file)
163 (elmo-delete-cr-buffer)
166 (luna-define-method elmo-folder-exists-p ((folder elmo-mark-folder))
169 (luna-define-method elmo-folder-search ((folder elmo-mark-folder)
170 condition &optional from-msgs)
171 (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
178 (setq num (length msgs))
180 (if (and (setq file (elmo-message-file-name folder (car msgs)))
182 (elmo-file-field-condition-match file
186 (setq matched (nconc matched (list (car msgs)))))
187 (elmo-display-progress
188 'elmo-internal-folder-search "Searching..."
189 (/ (* (setq i (1+ i)) 100) num))
190 (setq msgs (cdr msgs)))
193 ;;; To override elmo-map-folder methods.
194 (luna-define-method elmo-folder-list-unreads-internal
195 ((folder elmo-mark-folder) unread-marks)
198 (luna-define-method elmo-folder-list-importants-internal
199 ((folder elmo-mark-folder) important-mark)
202 (luna-define-method elmo-folder-unmark-important ((folder elmo-mark-folder)
206 (luna-define-method elmo-folder-mark-as-important ((folder elmo-mark-folder)
210 (luna-define-method elmo-folder-unmark-read ((folder elmo-mark-folder) numbers)
213 (luna-define-method elmo-folder-mark-as-read ((folder elmo-mark-folder) numbers)
217 (product-provide (provide 'elmo-mark) (require 'elmo-version))
219 ;;; elmo-mark.el ends here