← Back to branch summary

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

« back to all changes in this revision

Viewing changes to elmo/elmo-shimbun.el

  • Committer: Bazaar Package Importer
  • Author(s): Tatsuya Kinoshita
  • Date: 2007-01-02 21:08:54 UTC
  • mfrom: (3.1.3 edgy)
  • Revision ID: james.westby@ubuntu.com-20070102210854-nw929130dlxgi6q3
Tags: 2.14.0-4
http://bugs.debian.org/405284
elmo/elmo-imap4.el: Fix "IMAP error: No `OK' response from server",
patch from upstream CVS version. (closes: #405284)

Show diffs side-by-side

added added

removed removed

Lines of Context:
elmo/elmo-shimbun.el
33
33
(require 'elmo-dop)
34
34
(require 'shimbun)
35
35
 
 
36
(eval-when-compile
 
37
  (require 'cl)
 
38
  (defun-maybe shimbun-servers-list ()))
 
39
 
36
40
(defcustom elmo-shimbun-check-interval 60
37
41
  "*Check interval for shimbun."
38
42
  :type 'integer
61
65
                               (integer :tag "number"))))
62
66
  :group 'elmo)
63
67
 
64
 
(defcustom elmo-shimbun-update-overview-folder-list nil
 
68
(defcustom elmo-shimbun-update-overview-folder-list 'all
65
69
  "*List of FOLDER-REGEXP.
66
70
FOLDER-REGEXP is the regexp of shimbun folder name which should be
67
 
update overview when message is fetched."
68
 
  :type '(repeat (regexp :tag "Folder Regexp"))
 
71
update overview when message is fetched.
 
72
If it is the symbol `all', update overview for all shimbun folders."
 
73
  :type '(choice (const :tag "All shimbun folders" all)
 
74
                 (repeat (regexp :tag "Folder Regexp")))
69
75
  :group 'elmo)
70
76
 
71
77
;; Shimbun header.
89
95
  (luna-define-internal-accessors 'shimbun-elmo-mua))
90
96
 
91
97
(luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id)
92
 
  (elmo-msgdb-overview-get-entity id
93
 
                                  (elmo-folder-msgdb
94
 
                                   (shimbun-elmo-mua-folder-internal mua))))
 
98
  (elmo-message-entity (shimbun-elmo-mua-folder-internal mua) id))
95
99
 
96
100
(eval-and-compile
97
101
  (luna-define-class elmo-shimbun-folder
102
106
 
103
107
(defun elmo-shimbun-folder-entity-hash (folder)
104
108
  (or (elmo-shimbun-folder-entity-hash-internal folder)
105
 
      (let ((overviews (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
 
109
      (let ((overviews (elmo-folder-list-message-entities folder))
106
110
            hash id)
107
111
        (when overviews
108
112
          (setq hash (elmo-make-hash (length overviews)))
109
113
          (dolist (entity overviews)
110
 
            (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
 
114
            (elmo-set-hash-val (elmo-message-entity-field entity 'message-id)
111
115
                               entity hash)
112
 
            (when (setq id (elmo-msgdb-overview-entity-get-extra-field
113
 
                            entity "x-original-id"))
 
116
            (when (setq id (elmo-message-entity-field entity 'x-original-id))
114
117
              (elmo-set-hash-val id entity hash)))
115
118
          (elmo-shimbun-folder-set-entity-hash-internal folder hash)))))
116
119
 
117
120
(defsubst elmo-shimbun-folder-shimbun-header (folder location)
118
121
  (let ((hash (elmo-shimbun-folder-header-hash-internal folder)))
119
122
    (or (and hash (elmo-get-hash-val location hash))
120
 
        (let ((entity (elmo-msgdb-overview-get-entity
121
 
                       location
122
 
                       (elmo-folder-msgdb folder)))
 
123
        (let ((entity (elmo-message-entity folder location))
123
124
              (elmo-hash-minimum-size 63)
124
125
              header)
125
126
          (when entity
128
129
              (elmo-shimbun-folder-set-header-hash-internal
129
130
               folder
130
131
               (setq hash (elmo-make-hash))))
131
 
            (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
 
132
            (elmo-set-hash-val (elmo-message-entity-field entity
 
133
                                                          'message-id)
132
134
                               header
133
135
                               hash)
134
136
            header)))))
155
157
 
156
158
(defun elmo-shimbun-entity-to-header (entity)
157
159
  (let (message-id shimbun-id)
158
 
    (if (setq message-id (elmo-msgdb-overview-entity-get-extra-field
159
 
                          entity "x-original-id"))
160
 
        (setq shimbun-id (elmo-msgdb-overview-entity-get-id entity))
161
 
      (setq message-id (elmo-msgdb-overview-entity-get-id entity)
 
160
    (if (setq message-id (elmo-message-entity-field
 
161
                          entity 'x-original-id))
 
162
        (setq shimbun-id (elmo-message-entity-field entity 'message-id))
 
163
      (setq message-id (elmo-message-entity-field entity 'message-id)
162
164
            shimbun-id nil))
163
 
    (elmo-set-work-buf
164
 
     (set-buffer-multibyte t)
165
 
     (shimbun-make-header
166
 
      (elmo-msgdb-overview-entity-get-number entity)
167
 
      (shimbun-mime-encode-string
168
 
       (decode-mime-charset-string
169
 
        (elmo-msgdb-overview-entity-get-subject-no-decode entity)
170
 
        elmo-mime-charset))
171
 
      (shimbun-mime-encode-string
172
 
       (decode-mime-charset-string
173
 
        (elmo-msgdb-overview-entity-get-from-no-decode entity)
174
 
        elmo-mime-charset))
175
 
      (elmo-msgdb-overview-entity-get-date entity)
176
 
      message-id
177
 
      (elmo-msgdb-overview-entity-get-references entity)
178
 
      0
179
 
      0
180
 
      (elmo-msgdb-overview-entity-get-extra-field entity "xref")
181
 
      (and shimbun-id
182
 
           (list (cons "x-shimbun-id" shimbun-id)))))))
 
165
    (elmo-with-enable-multibyte
 
166
      (shimbun-make-header
 
167
       (elmo-message-entity-number entity)
 
168
       (shimbun-mime-encode-string
 
169
        (elmo-message-entity-field entity 'subject 'decode))
 
170
       (shimbun-mime-encode-string
 
171
        (elmo-message-entity-field entity 'from 'decode))
 
172
       (elmo-message-entity-field entity 'date)
 
173
       message-id
 
174
       (elmo-message-entity-field entity 'references)
 
175
       0
 
176
       0
 
177
       (elmo-message-entity-field entity 'xref)
 
178
       (and shimbun-id
 
179
            (list (cons "x-shimbun-id" shimbun-id)))))))
183
180
 
184
181
(defsubst elmo-shimbun-folder-header-hash-setup (folder headers)
185
182
  (let ((hash (or (elmo-shimbun-folder-header-hash-internal folder)
190
187
 
191
188
(defun elmo-shimbun-get-headers (folder)
192
189
  (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder))
193
 
         (key (concat (shimbun-server-internal shimbun)
194
 
                      "." (shimbun-current-group-internal shimbun)))
 
190
         (key (concat (shimbun-server shimbun)
 
191
                      "." (shimbun-current-group shimbun)))
195
192
         (elmo-hash-minimum-size 63)
196
193
         headers)
197
194
    ;; new headers.
199
196
          (delq nil
200
197
                (mapcar
201
198
                 (lambda (x)
202
 
                   (unless (elmo-msgdb-overview-get-entity
203
 
                            (shimbun-header-id x)
204
 
                            (elmo-folder-msgdb folder))
 
199
                   (unless (elmo-message-entity folder (shimbun-header-id x))
205
200
                     x))
206
201
                 ;; This takes much time.
207
202
                 (shimbun-headers
215
210
(luna-define-method elmo-folder-initialize ((folder
216
211
                                             elmo-shimbun-folder)
217
212
                                            name)
218
 
  (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
219
 
                          (list (elmo-match-string 1 name)
220
 
                                (substring name (match-end 0)))
221
 
                        (list name))))
222
 
    (when (nth 0 server-group) ; server
223
 
      (elmo-shimbun-folder-set-shimbun-internal
224
 
       folder
225
 
       (shimbun-open (nth 0 server-group)
226
 
                     (luna-make-entity 'shimbun-elmo-mua :folder folder))))
227
 
    (when (nth 1 server-group)
228
 
      (elmo-shimbun-folder-set-group-internal
229
 
       folder
230
 
       (nth 1 server-group)))
231
 
    (elmo-shimbun-folder-set-range-internal
232
 
     folder
233
 
     (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder)
234
 
                                         elmo-shimbun-index-range-alist))
235
 
         elmo-shimbun-default-index-range))
236
 
    folder))
 
213
  (if (string= name "")
 
214
      folder
 
215
    (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
 
216
                            (list (elmo-match-string 1 name)
 
217
                                  (substring name (match-end 0)))
 
218
                          (list name))))
 
219
      (when (nth 0 server-group) ; server
 
220
        (elmo-shimbun-folder-set-shimbun-internal
 
221
         folder
 
222
         (condition-case nil
 
223
             (shimbun-open (nth 0 server-group)
 
224
                           (luna-make-entity 'shimbun-elmo-mua :folder folder))
 
225
           (file-error
 
226
            (luna-make-entity 'shimbun :server (nth 0 server-group))))))
 
227
      (when (nth 1 server-group)
 
228
        (elmo-shimbun-folder-set-group-internal
 
229
         folder
 
230
         (nth 1 server-group)))
 
231
      (elmo-shimbun-folder-set-range-internal
 
232
       folder
 
233
       (or (cdr (elmo-string-matched-assoc (elmo-folder-name-internal folder)
 
234
                                           elmo-shimbun-index-range-alist))
 
235
           elmo-shimbun-default-index-range))
 
236
      folder)))
237
237
 
238
238
(luna-define-method elmo-folder-open-internal ((folder elmo-shimbun-folder))
239
 
  (shimbun-open-group
240
 
   (elmo-shimbun-folder-shimbun-internal folder)
241
 
   (elmo-shimbun-folder-group-internal folder))
242
 
  (let ((inhibit-quit t))
243
 
    (unless (elmo-map-folder-location-alist-internal folder)
244
 
      (elmo-map-folder-location-setup
245
 
       folder
246
 
       (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))
247
 
    (when (and (elmo-folder-plugged-p folder)
248
 
               (elmo-shimbun-headers-check-p folder))
249
 
      (elmo-shimbun-get-headers folder)
250
 
      (elmo-map-folder-update-locations
251
 
       folder
252
 
       (elmo-map-folder-list-message-locations folder)))))
 
239
  (when (elmo-shimbun-folder-shimbun-internal folder)
 
240
    (shimbun-open-group
 
241
     (elmo-shimbun-folder-shimbun-internal folder)
 
242
     (elmo-shimbun-folder-group-internal folder))
 
243
    (let ((inhibit-quit t))
 
244
      (unless (elmo-map-folder-location-alist-internal folder)
 
245
        (elmo-map-folder-location-setup
 
246
         folder
 
247
         (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))
 
248
      (when (and (elmo-folder-plugged-p folder)
 
249
                 (elmo-shimbun-headers-check-p folder))
 
250
        (elmo-shimbun-get-headers folder)
 
251
        (elmo-map-folder-update-locations
 
252
         folder
 
253
         (elmo-map-folder-list-message-locations folder))))))
253
254
 
254
255
(luna-define-method elmo-folder-reserve-status-p ((folder elmo-shimbun-folder))
255
256
  t)
275
276
   folder nil))
276
277
 
277
278
(luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
278
 
  (elmo-plugged-p
279
 
   "shimbun"
280
 
   (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))
281
 
   nil nil
282
 
   (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))
 
279
  (if (elmo-shimbun-folder-shimbun-internal folder)
 
280
      (elmo-plugged-p
 
281
       "shimbun"
 
282
       (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))
 
283
       nil nil
 
284
       (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))
 
285
    t))
283
286
 
284
287
(luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
285
288
                                             plugged &optional add)
286
289
  (elmo-set-plugged plugged
287
290
                    "shimbun"
288
 
                    (shimbun-server-internal
 
291
                    (shimbun-server
289
292
                     (elmo-shimbun-folder-shimbun-internal folder))
290
293
                    nil nil nil
291
 
                    (shimbun-server-internal
 
294
                    (shimbun-server
292
295
                     (elmo-shimbun-folder-shimbun-internal folder))
293
296
                    add))
294
297
 
295
298
(luna-define-method elmo-net-port-info ((folder elmo-shimbun-folder))
296
299
  (list "shimbun"
297
 
        (shimbun-server-internal
 
300
        (shimbun-server
298
301
         (elmo-shimbun-folder-shimbun-internal folder))
299
302
        nil))
300
303
 
301
304
(luna-define-method elmo-folder-check :around ((folder elmo-shimbun-folder))
302
 
  (when (shimbun-current-group-internal
 
305
  (when (shimbun-current-group
303
306
         (elmo-shimbun-folder-shimbun-internal folder))
304
307
    (when (and (elmo-folder-plugged-p folder)
305
308
               (elmo-shimbun-headers-check-p folder))
317
320
(luna-define-method elmo-folder-expand-msgdb-path ((folder
318
321
                                                    elmo-shimbun-folder))
319
322
  (expand-file-name
320
 
   (concat (shimbun-server-internal
 
323
   (concat (shimbun-server
321
324
            (elmo-shimbun-folder-shimbun-internal folder))
322
325
           "/"
323
326
           (elmo-shimbun-folder-group-internal folder))
333
336
        (shimbun-header-insert
334
337
         (elmo-shimbun-folder-shimbun-internal folder)
335
338
         header)
336
 
        (setq ov (elmo-msgdb-create-overview-from-buffer number))
337
 
        (elmo-msgdb-overview-entity-set-extra
 
339
        (setq ov (elmo-msgdb-create-message-entity-from-buffer
 
340
                  (elmo-msgdb-message-entity-handler
 
341
                   (elmo-folder-msgdb-internal folder)) number))
 
342
        (elmo-message-entity-set-field
338
343
         ov
339
 
         (nconc
340
 
          (elmo-msgdb-overview-entity-get-extra ov)
341
 
          (list (cons "xref" (shimbun-header-xref header)))))))))
 
344
         'xref (shimbun-header-xref header)))
 
345
      ov)))
342
346
 
343
347
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
344
 
                                              numlist new-mark
345
 
                                              already-mark seen-mark
346
 
                                              important-mark
347
 
                                              seen-list)
348
 
  (let* (overview number-alist mark-alist entity
349
 
                  i percent number length pair msgid gmark seen)
 
348
                                              numlist flag-table)
 
349
  (let ((new-msgdb (elmo-make-msgdb))
 
350
        entity i percent length msgid flags)
350
351
    (setq length (length numlist))
351
352
    (setq i 0)
352
353
    (message "Creating msgdb...")
355
356
            (elmo-shimbun-msgdb-create-entity
356
357
             folder (car numlist)))
357
358
      (when entity
358
 
        (setq overview
359
 
              (elmo-msgdb-append-element
360
 
               overview entity))
361
 
        (setq number (elmo-msgdb-overview-entity-get-number entity))
362
 
        (setq msgid (elmo-msgdb-overview-entity-get-id entity))
363
 
        (setq number-alist
364
 
              (elmo-msgdb-number-add number-alist
365
 
                                     number msgid))
366
 
        (setq seen (member msgid seen-list))
367
 
        (if (setq gmark (or (elmo-msgdb-global-mark-get msgid)
368
 
                            (if (elmo-file-cache-status
369
 
                                 (elmo-file-cache-get msgid))
370
 
                                (if seen nil already-mark)
371
 
                              (if seen
372
 
                                  (if elmo-shimbun-use-cache
373
 
                                      seen-mark)
374
 
                                new-mark))))
375
 
            (setq mark-alist
376
 
                  (elmo-msgdb-mark-append mark-alist
377
 
                                          number gmark))))
 
359
        (setq msgid (elmo-message-entity-field entity 'message-id)
 
360
              flags (elmo-flag-table-get flag-table msgid))
 
361
        (elmo-global-flags-set flags folder (car numlist) msgid)
 
362
        (elmo-msgdb-append-entity new-msgdb entity flags))
378
363
      (when (> length elmo-display-progress-threshold)
379
364
        (setq i (1+ i))
380
365
        (setq percent (/ (* i 100) length))
383
368
         percent))
384
369
      (setq numlist (cdr numlist)))
385
370
    (message "Creating msgdb...done")
386
 
    (elmo-msgdb-sort-by-date
387
 
     (list overview number-alist mark-alist))))
 
371
    (elmo-msgdb-sort-by-date new-msgdb)))
388
372
 
389
373
(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
390
374
  nil)
391
375
 
392
376
(defsubst elmo-shimbun-update-overview (folder shimbun-id header)
393
 
  (let ((entity (elmo-msgdb-overview-get-entity shimbun-id
394
 
                                                (elmo-folder-msgdb folder)))
 
377
  (let ((entity (elmo-message-entity folder shimbun-id))
395
378
        (message-id (shimbun-header-id header))
396
379
        references)
397
 
    (unless (string= shimbun-id message-id)
398
 
      (elmo-msgdb-overview-entity-set-extra-field
399
 
       entity "x-original-id" message-id)
400
 
      (elmo-shimbun-header-set-extra-field
401
 
       header "x-shimbun-id" shimbun-id)
402
 
      (elmo-set-hash-val message-id
403
 
                         entity
404
 
                         (elmo-shimbun-folder-entity-hash folder))
405
 
      (elmo-set-hash-val shimbun-id
406
 
                         entity
407
 
                         (elmo-shimbun-folder-entity-hash folder)))
408
 
    (elmo-msgdb-overview-entity-set-from
409
 
     entity
410
 
     (elmo-mime-string (shimbun-header-from header)))
411
 
    (elmo-msgdb-overview-entity-set-subject
412
 
     entity
413
 
     (elmo-mime-string (shimbun-header-subject header)))
414
 
    (elmo-msgdb-overview-entity-set-date
415
 
     entity (shimbun-header-date header))
416
 
    (when (setq references
417
 
                (or (elmo-msgdb-get-last-message-id
418
 
                     (elmo-field-body "in-reply-to"))
419
 
                    (elmo-msgdb-get-last-message-id
420
 
                     (elmo-field-body "references"))))
421
 
      (elmo-msgdb-overview-entity-set-references
422
 
       entity
423
 
       (or (elmo-msgdb-overview-entity-get-id
424
 
            (elmo-get-hash-val
425
 
             references
426
 
             (elmo-shimbun-folder-entity-hash folder)))
427
 
           references)))))
 
380
    (when (elmo-msgdb-update-entity
 
381
           (elmo-folder-msgdb folder)
 
382
           entity
 
383
           (nconc
 
384
            (unless (string= shimbun-id message-id)
 
385
              (elmo-shimbun-header-set-extra-field
 
386
               header "x-shimbun-id" shimbun-id)
 
387
              (elmo-set-hash-val message-id
 
388
                                 entity
 
389
                                 (elmo-shimbun-folder-entity-hash folder))
 
390
              (elmo-set-hash-val shimbun-id
 
391
                                 entity
 
392
                                 (elmo-shimbun-folder-entity-hash folder))
 
393
              (list (cons 'x-original-id message-id)))
 
394
            (list
 
395
             (cons 'from
 
396
                   (elmo-mime-string (shimbun-header-from header)))
 
397
             (cons 'subject
 
398
                   (elmo-mime-string (shimbun-header-subject header)))
 
399
             (cons 'date
 
400
                   (shimbun-header-date header))
 
401
             (cons 'references
 
402
                   (or (elmo-msgdb-get-last-message-id
 
403
                        (elmo-field-body "in-reply-to"))
 
404
                       (elmo-msgdb-get-last-message-id
 
405
                        (elmo-field-body "references")))))))
 
406
      (elmo-emit-signal 'update-overview folder
 
407
                        (elmo-message-entity-number entity)))))
428
408
 
429
409
(luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
430
410
                                            location strategy
436
416
            shimbun-id)
437
417
        (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
438
418
                         header)
439
 
        (when (elmo-string-match-member
440
 
               (elmo-folder-name-internal folder)
441
 
               elmo-shimbun-update-overview-folder-list)
 
419
        (when (or (eq elmo-shimbun-update-overview-folder-list 'all)
 
420
                  (elmo-string-match-member
 
421
                   (elmo-folder-name-internal folder)
 
422
                   elmo-shimbun-update-overview-folder-list))
442
423
          (elmo-shimbun-update-overview folder location header))
443
424
        (when (setq shimbun-id
444
425
                    (elmo-shimbun-header-extra-field header "x-shimbun-id"))
471
452
      (delq nil
472
453
            (mapcar
473
454
             (lambda (ov)
474
 
               (when (and (elmo-msgdb-overview-entity-get-extra-field
475
 
                           ov "xref")
 
455
               (when (and (elmo-message-entity-field ov 'xref)
476
456
                          (if expire-days
477
457
                              (< (elmo-shimbun-lapse-seconds
478
458
                                  (elmo-shimbun-parse-time-string
479
 
                                   (elmo-msgdb-overview-entity-get-date ov)))
 
459
                                   (elmo-message-entity-field ov 'date)))
480
460
                                 (* expire-days 86400 ; seconds per day
481
461
                                    ))
482
462
                            t))
483
 
                 (elmo-msgdb-overview-entity-get-id ov)))
484
 
             (elmo-msgdb-get-overview (elmo-folder-msgdb folder))))
 
463
                 (elmo-message-entity-field ov 'message-id)))
 
464
             (elmo-folder-list-message-entities folder)))
485
465
      (mapcar
486
466
       (lambda (header)
487
467
         (or (elmo-shimbun-header-extra-field header "x-shimbun-id")
490
470
 
491
471
(luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
492
472
                                                 &optional one-level)
493
 
  (unless (elmo-shimbun-folder-group-internal folder)
494
 
    (mapcar
495
 
     (lambda (x)
496
 
       (concat (elmo-folder-prefix-internal folder)
497
 
               (shimbun-server-internal
498
 
                (elmo-shimbun-folder-shimbun-internal folder))
499
 
               "."
500
 
               x))
501
 
     (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder)))))
 
473
  (let ((prefix (elmo-folder-prefix-internal folder)))
 
474
    (cond ((elmo-shimbun-folder-shimbun-internal folder)
 
475
           (unless (elmo-shimbun-folder-group-internal folder)
 
476
             (mapcar
 
477
              (lambda (fld)
 
478
                (concat prefix
 
479
                        (shimbun-server
 
480
                         (elmo-shimbun-folder-shimbun-internal folder))
 
481
                        "." fld))
 
482
              (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder)))))
 
483
          ;; the rest are for "@/" group
 
484
          (one-level
 
485
           (mapcar
 
486
            (lambda (server) (list (concat prefix server)))
 
487
            (shimbun-servers-list)))
 
488
          (t
 
489
           (let (folders)
 
490
             (dolist (server (shimbun-servers-list))
 
491
               (setq folders
 
492
                     (append folders
 
493
                             (mapcar
 
494
                              (lambda (fld) (concat prefix server "." fld))
 
495
                              (shimbun-groups
 
496
                               (shimbun-open server
 
497
                                             (let ((fld
 
498
                                                    (elmo-make-folder
 
499
                                                     (concat prefix server))))
 
500
                                               (luna-make-entity
 
501
                                                'shimbun-elmo-mua
 
502
                                                :folder fld))))))))
 
503
             folders)))))
502
504
 
503
505
(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
504
506
  (if (elmo-shimbun-folder-group-internal folder)
505
 
      (progn
 
507
      (if (fboundp 'shimbun-group-p)
 
508
          (shimbun-group-p (elmo-shimbun-folder-shimbun-internal folder)
 
509
                           (elmo-shimbun-folder-group-internal folder))
506
510
        (member
507
511
         (elmo-shimbun-folder-group-internal folder)
508
 
         (shimbun-groups (elmo-shimbun-folder-shimbun-internal
509
 
                          folder))))
 
512
         (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))
510
513
    t))
511
514
 
512
 
;;; To override elmo-map-folder methods.
513
 
(luna-define-method elmo-folder-list-unreads-internal
514
 
  ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
515
 
  t)
516
 
 
517
 
(luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
518
 
                                                  numbers)
519
 
  t)
520
 
 
521
 
(luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
522
 
                                                   numbers)
523
 
  t)
524
 
 
525
 
(luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
526
 
                                             numbers)
527
 
  t)
528
 
 
529
 
(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
530
 
                                              numbers)
531
 
  t)
 
515
(luna-define-method elmo-folder-delete-messages ((folder elmo-shimbun-folder)
 
516
                                                 numbers)
 
517
  (elmo-folder-kill-messages folder numbers)
 
518
  t)
 
519
 
 
520
(luna-define-method elmo-message-entity-parent ((folder elmo-shimbun-folder)
 
521
                                                entity)
 
522
  (let ((references (elmo-message-entity-field entity 'references)))
 
523
    (and references
 
524
         (elmo-get-hash-val references
 
525
                            (elmo-shimbun-folder-entity-hash folder)))))
532
526
 
533
527
(require 'product)
534
528
(product-provide (provide 'elmo-shimbun) (require 'elmo-version))