~ubuntu-branches/ubuntu/saucy/wl/saucy-proposed

« back to all changes in this revision

Viewing changes to elmo/elmo-mark.el

  • Committer: Bazaar Package Importer
  • Author(s): Takuo KITAME
  • Date: 2002-02-20 21:51:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020220215116-htmbfdwsdr25nnhm
Tags: upstream-2.8.1
ImportĀ upstreamĀ versionĀ 2.8.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;; elmo-mark.el --- Global mark folder for ELMO.
 
2
 
 
3
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
4
 
 
5
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 
6
;; Keywords: mail, net news
 
7
 
 
8
;; This file is part of ELMO (Elisp Library for Message Orchestration).
 
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 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.
 
24
;;
 
25
 
 
26
;;; Commentary:
 
27
;;
 
28
 
 
29
;;; Code:
 
30
;;
 
31
(require 'elmo)
 
32
(require 'elmo-map)
 
33
 
 
34
(defcustom elmo-mark-default-mark "$"
 
35
  "*Default global-mark for mark-folder."
 
36
  :type 'string
 
37
  :group 'elmo)
 
38
 
 
39
;;; ELMO mark folder
 
40
(eval-and-compile
 
41
  (luna-define-class elmo-mark-folder (elmo-map-folder) (mark))
 
42
  (luna-define-internal-accessors 'elmo-mark-folder))
 
43
 
 
44
(luna-define-method elmo-folder-initialize ((folder
 
45
                                             elmo-mark-folder)
 
46
                                            name)
 
47
  (elmo-mark-folder-set-mark-internal
 
48
   folder
 
49
   elmo-mark-default-mark)
 
50
  folder)
 
51
 
 
52
(luna-define-method elmo-folder-have-subfolder-p ((folder elmo-mark-folder))
 
53
  nil)
 
54
 
 
55
(luna-define-method elmo-folder-expand-msgdb-path ((folder
 
56
                                                    elmo-mark-folder))
 
57
  (expand-file-name "mark"
 
58
                    (expand-file-name "internal"
 
59
                                      elmo-msgdb-directory)))
 
60
 
 
61
(luna-define-method elmo-map-folder-list-message-locations
 
62
  ((folder elmo-mark-folder))
 
63
  (elmo-mark-folder-list-message-locations folder))
 
64
 
 
65
(defun elmo-mark-folder-list-message-locations (folder)
 
66
  (let (result)
 
67
    (dolist (pair (or elmo-msgdb-global-mark-alist
 
68
                      (setq elmo-msgdb-global-mark-alist
 
69
                            (elmo-object-load
 
70
                             (expand-file-name
 
71
                              elmo-msgdb-global-mark-filename
 
72
                              elmo-msgdb-directory)))))
 
73
      (if (string= (elmo-mark-folder-mark-internal folder)
 
74
                   (cdr pair))
 
75
          (setq result (cons (car pair) result))))
 
76
    (nreverse result)))
 
77
 
 
78
(luna-define-method elmo-folder-message-file-p ((folder elmo-mark-folder))
 
79
  t)
 
80
 
 
81
(luna-define-method elmo-message-file-name ((folder elmo-mark-folder)
 
82
                                            number)
 
83
  (elmo-file-cache-get-path
 
84
   (elmo-map-message-location folder number)))
 
85
 
 
86
(luna-define-method elmo-folder-msgdb-create ((folder elmo-mark-folder)
 
87
                                              numbers new-mark
 
88
                                              already-mark seen-mark
 
89
                                              important-mark
 
90
                                              seen-list)
 
91
  (elmo-mark-folder-msgdb-create folder numbers new-mark already-mark
 
92
                                 seen-mark important-mark))
 
93
 
 
94
(defun elmo-mark-folder-msgdb-create (folder numbers new-mark already-mark
 
95
                                             seen-mark important-mark)
 
96
  (let ((i 0)
 
97
        (len (length numbers))
 
98
        overview number-alist mark-alist entity message-id
 
99
        num)
 
100
    (message "Creating msgdb...")
 
101
    (while numbers
 
102
      (setq entity
 
103
            (elmo-msgdb-create-overview-entity-from-file
 
104
             (car numbers) (elmo-message-file-name folder (car numbers))))
 
105
      (if (null entity)
 
106
          ()
 
107
        (setq num (elmo-msgdb-overview-entity-get-number entity))
 
108
        (setq overview
 
109
              (elmo-msgdb-append-element
 
110
               overview entity))
 
111
        (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 
112
        (setq number-alist
 
113
              (elmo-msgdb-number-add number-alist
 
114
                                     num
 
115
                                     message-id))
 
116
        (setq mark-alist
 
117
              (elmo-msgdb-mark-append
 
118
               mark-alist
 
119
               num (elmo-mark-folder-mark-internal folder))))
 
120
      (when (> len elmo-display-progress-threshold)
 
121
        (setq i (1+ i))
 
122
        (elmo-display-progress
 
123
         'elmo-mark-folder-msgdb-create "Creating msgdb..."
 
124
         (/ (* i 100) len)))
 
125
      (setq numbers (cdr numbers)))
 
126
    (message "Creating msgdb...done")
 
127
    (list overview number-alist mark-alist)))
 
128
 
 
129
(luna-define-method elmo-folder-append-buffer ((folder elmo-mark-folder)
 
130
                                               unread &optional number)
 
131
  (let* ((msgid (elmo-field-body "message-id"))
 
132
         (path (elmo-file-cache-get-path msgid))
 
133
         dir)
 
134
    (when path
 
135
      (setq dir (directory-file-name (file-name-directory path)))
 
136
      (unless (file-exists-p dir)
 
137
        (elmo-make-directory dir))
 
138
      (when (file-writable-p path)
 
139
        (write-region-as-binary (point-min) (point-max)
 
140
                                path nil 'no-msg)))
 
141
    (elmo-msgdb-global-mark-set msgid
 
142
                                (elmo-mark-folder-mark-internal folder))))
 
143
 
 
144
(luna-define-method elmo-map-folder-delete-messages ((folder elmo-mark-folder)
 
145
                                                     locations)
 
146
  (dolist (location locations)
 
147
    (elmo-msgdb-global-mark-delete location)))
 
148
 
 
149
(luna-define-method elmo-message-fetch-with-cache-process
 
150
  ((folder elmo-mark-folder) number strategy &optional section unseen)
 
151
  ;; disbable cache process
 
152
  (elmo-message-fetch-internal folder number strategy section unseen))
 
153
 
 
154
(luna-define-method elmo-map-message-fetch ((folder elmo-mark-folder)
 
155
                                            location strategy
 
156
                                            &optional section unseen)
 
157
  (let ((file (elmo-file-cache-get-path location)))
 
158
    (when (file-exists-p file)
 
159
      (insert-file-contents-as-binary file))))
 
160
 
 
161
(luna-define-method elmo-folder-exists-p ((folder elmo-mark-folder))
 
162
  t)
 
163
 
 
164
(luna-define-method elmo-folder-writable-p ((folder elmo-mark-folder))
 
165
  t)
 
166
 
 
167
(luna-define-method elmo-folder-search ((folder elmo-mark-folder)
 
168
                                        condition &optional from-msgs)
 
169
  (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
 
170
         (number-list msgs)
 
171
         (i 0)
 
172
         (num (length msgs))
 
173
         file
 
174
         matched
 
175
         case-fold-search)
 
176
    (while msgs
 
177
      (if (and (setq file (elmo-message-file-name folder (car msgs)))
 
178
               (file-exists-p file)
 
179
               (elmo-file-field-condition-match file
 
180
                                                condition
 
181
                                                (car msgs)
 
182
                                                number-list))
 
183
          (setq matched (nconc matched (list (car msgs)))))
 
184
      (elmo-display-progress
 
185
       'elmo-internal-folder-search "Searching..."
 
186
       (/ (* (setq i (1+ i)) 100) num))
 
187
      (setq msgs (cdr msgs)))
 
188
    matched))
 
189
 
 
190
;;; To override elmo-map-folder methods.
 
191
(luna-define-method elmo-folder-list-unreads-internal
 
192
  ((folder elmo-mark-folder) unread-marks &optional mark-alist)
 
193
  t)
 
194
 
 
195
(luna-define-method elmo-folder-unmark-important ((folder elmo-mark-folder)
 
196
                                                  numbers)
 
197
  t)
 
198
 
 
199
(luna-define-method elmo-folder-mark-as-important ((folder elmo-mark-folder)
 
200
                                                   numbers)
 
201
  t)
 
202
 
 
203
(luna-define-method elmo-folder-unmark-read ((folder elmo-mark-folder) numbers)
 
204
  t)
 
205
 
 
206
(luna-define-method elmo-folder-mark-as-read ((folder elmo-mark-folder) numbers)
 
207
  t)
 
208
 
 
209
(require 'product)
 
210
(product-provide (provide 'elmo-mark) (require 'elmo-version))
 
211
 
 
212
;;; elmo-mark.el ends here