← Back to branch summary

~reddyuday/vm/virtual

« back to all changes in this revision

Viewing changes to lisp/vm-folder.el

  • 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.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/vm-folder.el
4903
4903
          (cons 'vm-after-revert-buffer-hook after-revert-hook))
4904
4904
  (setq after-revert-hook (list 'vm-after-revert-buffer-hook)))
4905
4905
 
 
4906
;;;###autoload
 
4907
(defun vm-load-message (&optional count)
 
4908
  "Load the message by retrieving its body from its
 
4909
permanent location.  Currently this facility is only available for IMAP
 
4910
folders.
 
4911
 
 
4912
With a prefix argument COUNT, the current message and the next 
 
4913
COUNT - 1 messages are loaded.  A negative argument means
 
4914
the current message and the previous |COUNT| - 1 messages are
 
4915
loaded.
 
4916
 
 
4917
When invoked on marked messages (via `vm-next-command-uses-marks'),
 
4918
only marked messages are loaded, other messages are ignored.  If
 
4919
applied to collapsed threads in summary and thread operations are
 
4920
enabled via `vm-enable-thread-operations' then all messages in the
 
4921
thread are loaded."
 
4922
  (interactive "p")
 
4923
  (if (interactive-p)
 
4924
      (vm-follow-summary-cursor))
 
4925
  (vm-select-folder-buffer-and-validate 1 (interactive-p))
 
4926
  (vm-error-if-folder-read-only)
 
4927
  (when (null count) (setq count 1))
 
4928
  (let ((mlist (vm-select-operable-messages count "Load"))
 
4929
        (errors 0)
 
4930
        (n 0)
 
4931
        fetch-method
 
4932
        m mm)
 
4933
    (save-excursion
 
4934
      ;; (message "Retrieving message body...")
 
4935
      (while mlist
 
4936
        (setq m (car mlist))
 
4937
        (setq mm (vm-real-message-of m))
 
4938
        (set-buffer (vm-buffer-of mm))
 
4939
        (if (vm-body-retrieved-of mm)
 
4940
            (if (vm-body-to-be-discarded-of mm)
 
4941
                (vm-unregister-fetched-message mm))
 
4942
          ;; else retrieve the body
 
4943
          (setq n (1+ n))
 
4944
          (message "Retrieving message body... %s" n)
 
4945
          (vm-retrieve-real-message-body mm)
 
4946
          )
 
4947
        (setq mlist (cdr mlist)))
 
4948
      (when (> n 0)
 
4949
        (message "Retrieving message body... done")))
 
4950
    (intern (buffer-name) vm-buffers-needing-display-update)
 
4951
    ;; FIXME - is this needed?  Is it correct?
 
4952
    (vm-display nil nil '(vm-load-message vm-refresh-message)
 
4953
                (list this-command))    
 
4954
    (vm-update-summary-and-mode-line)
 
4955
    ))
 
4956
 
 
4957
;;;###autoload
 
4958
(defun vm-retrieve-operable-messages (&optional count mlist)
 
4959
  "Retrieve the message from from its permanent location for
 
4960
temporary use.  Currently this facility is only available for
 
4961
IMAP folders.
 
4962
 
 
4963
With a prefix argument COUNT, the current message and the next 
 
4964
COUNT - 1 messages are retrieved.  A negative argument means
 
4965
the current message and the previous |COUNT| - 1 messages are
 
4966
retrieved.
 
4967
 
 
4968
When invoked on marked messages (via `vm-next-command-uses-marks'),
 
4969
only marked messages are retrieved, other messages are ignored.  If
 
4970
applied to collapsed threads in summary and thread operations are
 
4971
enabled via `vm-enable-thread-operations' then all messages in the
 
4972
thread are retrieved."
 
4973
  (vm-select-folder-buffer-and-validate 1 (interactive-p))
 
4974
  (when (null count) (setq count 1))
 
4975
  (let ((used-marks (eq last-command 'vm-next-command-uses-marks))
 
4976
        (vm-fetched-message-limit nil)
 
4977
        (errors 0)
 
4978
        (n 0)
 
4979
        fetch-method
 
4980
        m mm)
 
4981
;;     (if (not used-marks) 
 
4982
;;      (setq mlist (list (car vm-message-pointer))))
 
4983
    (unless mlist
 
4984
      (setq mlist (vm-select-operable-messages count "Retrieve")))
 
4985
    (save-excursion
 
4986
      (while mlist
 
4987
        (setq m (car mlist))
 
4988
        (setq mm (vm-real-message-of m))
 
4989
        (set-buffer (vm-buffer-of mm))
 
4990
        (when (vm-body-to-be-retrieved-of mm)
 
4991
          (setq n (1+ n))
 
4992
          (message "Retrieving message body... %s" n)
 
4993
          (vm-retrieve-real-message-body mm)
 
4994
          (vm-register-fetched-message mm))
 
4995
        (setq mlist (cdr mlist)))
 
4996
      (when (> n 0)
 
4997
        (message "Retrieving message body... done")))
 
4998
    (intern (buffer-name) vm-buffers-needing-display-update)
 
4999
    (vm-update-summary-and-mode-line)
 
5000
    ))
 
5001
 
 
5002
(defun vm-retrieve-real-message-body (mm &optional fetch)
 
5003
  "Retrieve the body of a real message MM from its external
 
5004
source and insert it into the Folder buffer.  If the optional argument
 
5005
FETCH is t, then the retrieval is for a temporary message fetch."
 
5006
  (when (not (eq (vm-message-access-method-of mm) 'imap))
 
5007
    (error "This is currently available only for imap folders."))
 
5008
  (save-excursion
 
5009
    (set-buffer (vm-buffer-of mm))
 
5010
    (vm-save-restriction
 
5011
     (widen)
 
5012
     (narrow-to-region (marker-position (vm-headers-of mm)) 
 
5013
                       (marker-position (vm-text-end-of mm)))
 
5014
     (let ((fetch-method (vm-message-access-method-of mm))
 
5015
           (vm-folder-read-only (and vm-folder-read-only (not fetch)))
 
5016
           (inhibit-read-only t)
 
5017
           ;; (buffer-read-only nil)    ; seems redundant
 
5018
           (buffer-undo-list t)         ; why this?  USR, 2010-06-11
 
5019
           (modified (buffer-modified-p))
 
5020
           (testing 0))
 
5021
       (goto-char (vm-text-of mm))
 
5022
       ;; Check to see that we are at the right place
 
5023
       (vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
 
5024
       (vm-increment testing)
 
5025
 
 
5026
       (delete-region (point) (point-max))
 
5027
       ;; Remember that this does I/O and accept-process-output,
 
5028
       ;; allowing concurrent threads to run!!!  USR, 2010-07-11
 
5029
       (condition-case err
 
5030
           (apply (intern (format "vm-fetch-%s-message" fetch-method))
 
5031
                  mm nil)
 
5032
         (error 
 
5033
          (error "Unable to load message; %s" (error-message-string err))))
 
5034
       (vm-assert (eq (point) (marker-position (vm-text-of mm))))
 
5035
       (vm-increment testing)
 
5036
       ;; delete the new headers
 
5037
       (delete-region (vm-text-of mm)
 
5038
                      (or (re-search-forward "\n\n" (point-max) t) (point-max)))
 
5039
       (vm-assert (eq (point) (marker-position (vm-text-of mm))))
 
5040
       (vm-increment testing)
 
5041
       ;; fix markers now
 
5042
       (set-marker (vm-text-end-of mm) (point-max))
 
5043
       (vm-assert (eq (point) (marker-position (vm-text-of mm))))
 
5044
       (vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
 
5045
       (vm-increment testing)
 
5046
       ;; now care for the layout of the message
 
5047
       (vm-set-mime-layout-of mm (vm-mime-parse-entity-safe mm))
 
5048
       ;; update the message data
 
5049
       (vm-set-body-to-be-retrieved-flag mm nil)
 
5050
       (vm-set-body-to-be-discarded-flag mm nil)
 
5051
       (vm-set-line-count-of mm nil)
 
5052
       (vm-set-byte-count-of mm nil)
 
5053
       ;; update the virtual messages
 
5054
       (vm-update-virtual-messages mm)
 
5055
       (set-buffer-modified-p modified)
 
5056
 
 
5057
       (vm-assert (eq (point) (marker-position (vm-text-of mm))))
 
5058
       (vm-assert (save-excursion (forward-line -1) (looking-at "\n")))
 
5059
       (vm-increment testing)))))
 
5060
 
 
5061
;;;###autoload
 
5062
(defun vm-refresh-message ()
 
5063
  "Reload the message body from its permanent location.  Currently
 
5064
this facilty is only available for IMAP folders."
 
5065
  (interactive)
 
5066
  (vm-unload-message 1 t)
 
5067
  (vm-load-message))
 
5068
 
 
5069
;;;###autoload
 
5070
(defun vm-unload-message (&optional count physical)
 
5071
  "Unload the message body, i.e., delete it from the folder
 
5072
buffer.  It can be retrieved again in future from its permanent
 
5073
external location.  Currently this facility is only available for
 
5074
IMAP folders.
 
5075
 
 
5076
With a prefix argument COUNT, the current message and the next 
 
5077
COUNT - 1 messages are unloaded.  A negative argument means
 
5078
the current message and the previous |COUNT| - 1 messages are
 
5079
unloaded.
 
5080
 
 
5081
When invoked on marked messages (via `vm-next-command-uses-marks'), only 
 
5082
marked messages are unloaded, other messages are ignored.  If
 
5083
applied to collapsed threads in summary and thread operations are
 
5084
enabled via `vm-enable-thread-operations' then all messages in
 
5085
the thread are unloaded.
 
5086
 
 
5087
If the optional argument PHYSICAL is non-nil, then the message is
 
5088
physically discarded.  Otherwise, the discarding may be delayed until
 
5089
the folder is saved."
 
5090
  (interactive "p")
 
5091
  (if (interactive-p)
 
5092
      (vm-follow-summary-cursor))
 
5093
  (vm-select-folder-buffer-and-validate 1 (interactive-p))
 
5094
  (vm-error-if-folder-read-only)
 
5095
  (when (null count) 
 
5096
    (setq count 1))
 
5097
  (let ((mlist (vm-select-operable-messages count "Unload"))
 
5098
        (buffer-undo-list t)
 
5099
        (errors 0)
 
5100
        m mm)
 
5101
    (save-excursion
 
5102
      (setq count 0)
 
5103
      (while mlist
 
5104
        (setq m (car mlist))
 
5105
        (setq mm (vm-real-message-of m))
 
5106
        (set-buffer (vm-buffer-of mm))
 
5107
        (when (and (vm-body-retrieved-of mm)
 
5108
                   (null (vm-body-to-be-discarded-of mm)))
 
5109
          (if (and (= count 0) (not physical))
 
5110
              ;; Register the message as fetched instead of actually
 
5111
              ;; discarding the message
 
5112
              (vm-register-fetched-message mm)
 
5113
            (vm-discard-real-message-body mm)))
 
5114
        (setq mlist (cdr mlist))
 
5115
        (setq count (1+ count))))
 
5116
    (if (= count 1) 
 
5117
        (message "Message body discarded")
 
5118
      (message "%d message bodies discarded" count))
 
5119
    (vm-update-summary-and-mode-line)
 
5120
    ))
 
5121
 
 
5122
(defun vm-discard-real-message-body (mm)
 
5123
  "Discard the real message body of MM from its Folder buffer."
 
5124
  (when (not (eq (vm-message-access-method-of mm) 'imap))
 
5125
    (error "This is currently available only for imap folders."))
 
5126
  (save-excursion
 
5127
    (set-buffer (vm-buffer-of mm))
 
5128
    (vm-save-restriction
 
5129
     (widen)
 
5130
     (let ((inhibit-read-only t)
 
5131
           ;; (buffer-read-only nil)     ; seems redundant
 
5132
           (modified (buffer-modified-p)))
 
5133
       (goto-char (vm-text-of mm))
 
5134
       ;; Check to see that we are at the right place
 
5135
       (if (or (bobp)
 
5136
               (save-excursion (forward-line -1) (looking-at "\n")))
 
5137
           (progn
 
5138
             (delete-region (point) (vm-text-end-of mm))
 
5139
             (vm-set-buffer-modified-p t)
 
5140
             (vm-set-mime-layout-of mm nil)
 
5141
             (vm-set-body-to-be-retrieved-flag mm t)
 
5142
             (vm-set-body-to-be-discarded-flag mm nil)
 
5143
             (vm-set-line-count-of mm nil)
 
5144
             (vm-update-virtual-messages mm)
 
5145
             (set-buffer-modified-p modified))
 
5146
         (if (y-or-n-p
 
5147
              (concat "VM internal error: "
 
5148
                       "headers of a message have been corrupted. "
 
5149
                       "Continue? "))
 
5150
             (progn
 
5151
               (message (concat "The damaged message, with UID %s, "
 
5152
                                "is left in the folder")
 
5153
                        (vm-imap-uid-of mm))
 
5154
               (sit-for 5)
 
5155
               (vm-set-body-to-be-discarded-flag mm nil))
 
5156
           (error "Aborted operation")))
 
5157
       ))))
 
5158
 
 
5159
 
4906
5160
;;; vm-folder.el ends here