« back to all changes in this revision
Viewing changes to lisp/vm-imap.el
- browse files at revision 996
- compare with another revision
- download diff
- download tarball
- view history from revision 996
- Committer: udr
- Date: 2010-12-22 20:16:48 UTC
- Revision ID: udr@maruti-20101222201648-p4bh5zoba7h7uplv
Fixed most undefined function errors using the Emacs 23 byte compiler.
- files modified:
- lisp/vm-avirtual.el
added
removed
lisp/vm-imap.el
39
39
(require 'vm-delete)
40
40
(require 'vm-crypto)
41
41
(require 'vm-mime)
42
(require 'vm-reply)
42
43
)
43
44
44
45
(declare-function vm-session-initialization
3223
3224
)))
3224
3225
3225
3226
3226
;; The following three functions should go into vm-folder.el or vm.el
3227
;; or some such place.
3228
3229
;;;###autoload
3230
(defun vm-load-message (&optional count)
3231
"Load the message by retrieving its body from its
3232
permanent location. Currently this facility is only available for IMAP
3233
folders.
3234
3235
With a prefix argument COUNT, the current message and the next
3236
COUNT - 1 messages are loaded. A negative argument means
3237
the current message and the previous |COUNT| - 1 messages are
3238
loaded.
3239
3240
When invoked on marked messages (via `vm-next-command-uses-marks'),
3241
only marked messages are loaded, other messages are ignored. If
3242
applied to collapsed threads in summary and thread operations are
3243
enabled via `vm-enable-thread-operations' then all messages in the
3244
thread are loaded."
3245
(interactive "p")
3246
(if (interactive-p)
3247
(vm-follow-summary-cursor))
3248
(vm-select-folder-buffer-and-validate 1 (interactive-p))
3249
(vm-error-if-folder-read-only)
3250
(when (null count) (setq count 1))
3251
(let ((mlist (vm-select-operable-messages count "Load"))
3252
(errors 0)
3253
(n 0)
3254
fetch-method
3255
m mm)
3256
(save-excursion
3257
;; (message "Retrieving message body...")
3258
(while mlist
3259
(setq m (car mlist))
3260
(setq mm (vm-real-message-of m))
3261
(set-buffer (vm-buffer-of mm))
3262
(if (vm-body-retrieved-of mm)
3263
(if (vm-body-to-be-discarded-of mm)
3264
(vm-unregister-fetched-message mm))
3265
;; else retrieve the body
3266
(setq n (1+ n))
3267
(message "Retrieving message body... %s" n)
3268
(vm-retrieve-real-message-body mm)
3269
)
3270
(setq mlist (cdr mlist)))
3271
(when (> n 0)
3272
(message "Retrieving message body... done")))
3273
(intern (buffer-name) vm-buffers-needing-display-update)
3274
;; FIXME - is this needed? Is it correct?
3275
(vm-display nil nil '(vm-load-message vm-refresh-message)
3276
(list this-command))
3277
(vm-update-summary-and-mode-line)
3278
))
3279
3280
;;;###autoload
3281
(defun vm-retrieve-operable-messages (&optional count mlist)
3282
"Retrieve the message from from its permanent location for
3283
temporary use. Currently this facility is only available for
3284
IMAP folders.
3285
3286
With a prefix argument COUNT, the current message and the next
3287
COUNT - 1 messages are retrieved. A negative argument means
3288
the current message and the previous |COUNT| - 1 messages are
3289
retrieved.
3290
3291
When invoked on marked messages (via `vm-next-command-uses-marks'),
3292
only marked messages are retrieved, other messages are ignored. If
3293
applied to collapsed threads in summary and thread operations are
3294
enabled via `vm-enable-thread-operations' then all messages in the
3295
thread are retrieved."
3296
(vm-select-folder-buffer-and-validate 1 (interactive-p))
3297
(when (null count) (setq count 1))
3298
(let ((used-marks (eq last-command 'vm-next-command-uses-marks))
3299
(vm-fetched-message-limit nil)
3300
(errors 0)
3301
(n 0)
3302
fetch-method
3303
m mm)
3304
;; (if (not used-marks)
3305
;; (setq mlist (list (car vm-message-pointer))))
3306
(unless mlist
3307
(setq mlist (vm-select-operable-messages count "Retrieve")))
3308
(save-excursion
3309
(while mlist
3310
(setq m (car mlist))
3311
(setq mm (vm-real-message-of m))
3312
(set-buffer (vm-buffer-of mm))
3313
(when (vm-body-to-be-retrieved-of mm)
3314
(setq n (1+ n))
3315
(message "Retrieving message body... %s" n)
3316
(vm-retrieve-real-message-body mm)
3317
(vm-register-fetched-message mm))
3318
(setq mlist (cdr mlist)))
3319
(when (> n 0)
3320
(message "Retrieving message body... done")))
3321
(intern (buffer-name) vm-buffers-needing-display-update)
3322
(vm-update-summary-and-mode-line)
3323
))
3324
3325
(defun vm-retrieve-real-message-body (mm &optional fetch)
3326
"Retrieve the body of a real message MM from its external
3327
source and insert it into the Folder buffer. If the optional argument
3328
FETCH is t, then the retrieval is for a temporary message fetch."
3329
(when (not (eq (vm-message-access-method-of mm) 'imap))
3330
(error "This is currently available only for imap folders."))
3331
(save-excursion
3332
(set-buffer (vm-buffer-of mm))
3333
(vm-save-restriction
3334
(widen)
3335
(narrow-to-region (marker-position (vm-headers-of mm))
3336
(marker-position (vm-text-end-of mm)))
3337
(let ((fetch-method (vm-message-access-method-of mm))
3338
(vm-folder-read-only (and vm-folder-read-only (not fetch)))
3339
(inhibit-read-only t)
3340
;; (buffer-read-only nil) ; seems redundant
3341
(buffer-undo-list t) ; why this? USR, 2010-06-11
3342
(modified (buffer-modified-p))
3343
(testing 0))
3344
(goto-char (vm-text-of mm))
3345
;; Check to see that we are at the right place
3346
(vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
3347
(vm-increment testing)
3348
3349
(delete-region (point) (point-max))
3350
;; Remember that this does I/O and accept-process-output,
3351
;; allowing concurrent threads to run!!! USR, 2010-07-11
3352
(condition-case err
3353
(apply (intern (format "vm-fetch-%s-message" fetch-method))
3354
mm nil)
3355
(error
3356
(error "Unable to load message; %s" (error-message-string err))))
3357
(vm-assert (eq (point) (marker-position (vm-text-of mm))))
3358
(vm-increment testing)
3359
;; delete the new headers
3360
(delete-region (vm-text-of mm)
3361
(or (re-search-forward "\n\n" (point-max) t) (point-max)))
3362
(vm-assert (eq (point) (marker-position (vm-text-of mm))))
3363
(vm-increment testing)
3364
;; fix markers now
3365
(set-marker (vm-text-end-of mm) (point-max))
3366
(vm-assert (eq (point) (marker-position (vm-text-of mm))))
3367
(vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
3368
(vm-increment testing)
3369
;; now care for the layout of the message
3370
(vm-set-mime-layout-of mm (vm-mime-parse-entity-safe mm))
3371
;; update the message data
3372
(vm-set-body-to-be-retrieved-flag mm nil)
3373
(vm-set-body-to-be-discarded-flag mm nil)
3374
(vm-set-line-count-of mm nil)
3375
(vm-set-byte-count-of mm nil)
3376
;; update the virtual messages
3377
(vm-update-virtual-messages mm)
3378
(set-buffer-modified-p modified)
3379
3380
(vm-assert (eq (point) (marker-position (vm-text-of mm))))
3381
(vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
3382
(vm-increment testing)))))
3383
3384
;;;###autoload
3385
(defun vm-refresh-message ()
3386
"Reload the message body from its permanent location. Currently
3387
this facilty is only available for IMAP folders."
3388
(interactive)
3389
(vm-unload-message 1 t)
3390
(vm-load-message))
3391
3392
;;;###autoload
3393
(defun vm-unload-message (&optional count physical)
3394
"Unload the message body, i.e., delete it from the folder
3395
buffer. It can be retrieved again in future from its permanent
3396
external location. Currently this facility is only available for
3397
IMAP folders.
3398
3399
With a prefix argument COUNT, the current message and the next
3400
COUNT - 1 messages are unloaded. A negative argument means
3401
the current message and the previous |COUNT| - 1 messages are
3402
unloaded.
3403
3404
When invoked on marked messages (via `vm-next-command-uses-marks'), only
3405
marked messages are unloaded, other messages are ignored. If
3406
applied to collapsed threads in summary and thread operations are
3407
enabled via `vm-enable-thread-operations' then all messages in
3408
the thread are unloaded.
3409
3410
If the optional argument PHYSICAL is non-nil, then the message is
3411
physically discarded. Otherwise, the discarding may be delayed until
3412
the folder is saved."
3413
(interactive "p")
3414
(if (interactive-p)
3415
(vm-follow-summary-cursor))
3416
(vm-select-folder-buffer-and-validate 1 (interactive-p))
3417
(vm-error-if-folder-read-only)
3418
(when (null count)
3419
(setq count 1))
3420
(let ((mlist (vm-select-operable-messages count "Unload"))
3421
(buffer-undo-list t)
3422
(errors 0)
3423
m mm)
3424
(save-excursion
3425
(setq count 0)
3426
(while mlist
3427
(setq m (car mlist))
3428
(setq mm (vm-real-message-of m))
3429
(set-buffer (vm-buffer-of mm))
3430
(when (and (vm-body-retrieved-of mm)
3431
(null (vm-body-to-be-discarded-of mm)))
3432
(if (and (= count 0) (not physical))
3433
;; Register the message as fetched instead of actually
3434
;; discarding the message
3435
(vm-register-fetched-message mm)
3436
(vm-discard-real-message-body mm)))
3437
(setq mlist (cdr mlist))
3438
(setq count (1+ count))))
3439
(if (= count 1)
3440
(message "Message body discarded")
3441
(message "%d message bodies discarded" count))
3442
(vm-update-summary-and-mode-line)
3443
))
3444
3445
(defun vm-discard-real-message-body (mm)
3446
"Discard the real message body of MM from its Folder buffer."
3447
(when (not (eq (vm-message-access-method-of mm) 'imap))
3448
(error "This is currently available only for imap folders."))
3449
(save-excursion
3450
(set-buffer (vm-buffer-of mm))
3451
(vm-save-restriction
3452
(widen)
3453
(let ((inhibit-read-only t)
3454
;; (buffer-read-only nil) ; seems redundant
3455
(modified (buffer-modified-p)))
3456
(goto-char (vm-text-of mm))
3457
;; Check to see that we are at the right place
3458
(if (or (bobp)
3459
(save-excursion (forward-line -1) (looking-at "\n")))
3460
(progn
3461
(delete-region (point) (vm-text-end-of mm))
3462
(vm-set-buffer-modified-p t)
3463
(vm-set-mime-layout-of mm nil)
3464
(vm-set-body-to-be-retrieved-flag mm t)
3465
(vm-set-body-to-be-discarded-flag mm nil)
3466
(vm-set-line-count-of mm nil)
3467
(vm-update-virtual-messages mm)
3468
(set-buffer-modified-p modified))
3469
(if (y-or-n-p
3470
(concat "VM internal error: "
3471
"headers of a message have been corrupted. "
3472
"Continue? "))
3473
(progn
3474
(message (concat "The damaged message, with UID %s, "
3475
"is left in the folder")
3476
(vm-imap-uid-of mm))
3477
(sit-for 5)
3478
(vm-set-body-to-be-discarded-flag mm nil))
3479
(error "Aborted operation")))
3480
))))
3481
3482
3483
3227
(defun vm-imap-save-attributes (&optional interactive all-flags)
3484
3228
"* Save the attributes of changed messages to the IMAP folder.
3485
3229
INTERACTIVE, true if the function was invoked interactively, e.g., as
Loggerhead is a web-based interface for Breezy
Version: 2.0.1