← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/vm/oneiric

« back to all changes in this revision

Viewing changes to lisp/vm-save.el

  • Committer: Bazaar Package Importer
  • Author(s): Manoj Srivastava
  • Date: 2010-03-28 08:03:45 UTC
  • mfrom: (1.1.7 upstream)
  • Revision ID: james.westby@ubuntu.com-20100328080345-3hzv1o8df9vpmyym
Tags: 8.1.0-1
http://bugs.debian.org/550859
http://bugs.debian.org/434565
http://bugs.debian.org/553402
* New upstream version
* [20fe869]: Merge branch 'upstream' into topic--debian
* Bug fix: "sc-cite-original citation hook fails for mime encoded
  messages", thanks to Klaus Reichl              (Closes: #550859).
* Bug fix: "8bit characters are not escapes in In-reply-to field",
  thanks to Neil Brown                           (Closes: #434565).
* Bug fix: "vm-mime-encode-headers may mess up recipient addresses",
  thanks to Francois Fleuret                     (Closes: #553402).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/vm-save.el
180
180
Which is done is controlled by the type of the current vm-folder
181
181
buffer and the variable `vm-imap-save-to-server'."
182
182
  (interactive
183
 
   (if (and vm-imap-save-to-server
184
 
            (vm-imap-folder-p))
 
183
   (if (and vm-imap-save-to-server (vm-imap-folder-p))
185
184
       ;; IMAP saving --- argument parsing taken from
186
185
       ;; vm-save-message-to-imap-folder
187
 
       (save-excursion
188
 
         (vm-session-initialization)
189
 
         (vm-check-for-killed-folder)
190
 
         (vm-select-folder-buffer-if-possible)
191
 
         (let ((this-command this-command)
192
 
               (last-command last-command))
193
 
           (list (vm-read-imap-folder-name "Save to IMAP folder: "
194
 
                                           vm-imap-server-list t)
 
186
       (let ((this-command this-command)
 
187
             (last-command last-command))
 
188
         (vm-follow-summary-cursor)
 
189
         (save-excursion
 
190
           (vm-session-initialization)
 
191
           (vm-select-folder-buffer)
 
192
           (vm-check-for-killed-summary)
 
193
           (vm-error-if-folder-empty)
 
194
           (list (vm-read-imap-folder-name "Save to IMAP folder: " t)
195
195
                 (prefix-numeric-value current-prefix-arg))))
196
196
       ;; saving to local filesystem.  argument parsing taken from old
197
 
       ;; vm-save-message now vm-save-message-to-local-folder
 
197
       ;; vm-save-message (now vm-save-message-to-local-folder)
198
198
       (list
199
199
        ;; protect value of last-command
200
200
        (let ((last-command last-command)
201
201
              (this-command this-command))
202
202
          (vm-follow-summary-cursor)
203
 
          (let ((default (save-excursion
204
 
                           (vm-select-folder-buffer)
205
 
                           (vm-check-for-killed-summary)
206
 
                           (vm-error-if-folder-empty)
207
 
                           (or (vm-auto-select-folder vm-message-pointer
208
 
                                                      vm-auto-folder-alist)
209
 
                               vm-last-save-folder)))
 
203
          (let ((default 
 
204
                  (save-excursion
 
205
                    (vm-select-folder-buffer)
 
206
                    (vm-check-for-killed-summary)
 
207
                    (vm-error-if-folder-empty)
 
208
                    (or (vm-auto-select-folder 
 
209
                         vm-message-pointer vm-auto-folder-alist)
 
210
                        vm-last-save-folder)))
210
211
                (dir (or vm-folder-directory default-directory)))
211
212
            (cond ((and default
212
213
                        (let ((default-directory dir))
219
220
                  (t
220
221
                   (vm-read-file-name "Save in folder: " dir nil)))))
221
222
        (prefix-numeric-value current-prefix-arg))))
222
 
  (if (and vm-imap-save-to-server
223
 
           (vm-imap-folder-p))
 
223
  (if (and vm-imap-save-to-server (vm-imap-folder-p))
224
224
      (vm-save-message-to-imap-folder folder count)
225
 
      (vm-save-message-to-local-folder folder count)))
 
225
    (vm-save-message-to-local-folder folder count)))
226
226
   
227
227
;;;###autoload
228
228
(defun vm-save-message-to-local-folder (folder &optional count)
330
330
            (while mlist
331
331
              (setq m (vm-real-message-of (car mlist)))
332
332
              (set-buffer (vm-buffer-of m))
 
333
              ;; FIXME try to load the body before saving
 
334
              (if (vm-body-to-be-retrieved-of m)
 
335
                  (error "Message %s body has not been retrieved"
 
336
                         (vm-number-of (car mlist))))
333
337
              (vm-save-restriction
334
338
               (widen)
335
339
               ;; have to stuff the attributes in all cases because
508
512
          (while mlist
509
513
            (setq m (vm-real-message-of (car mlist)))
510
514
            (set-buffer (vm-buffer-of m))
 
515
            ;; FIXME try to load the body before saving
 
516
            (if (vm-body-to-be-retrieved-of m)
 
517
                (error "Message %s body has not been retrieved"
 
518
                       (vm-number-of (car mlist))))
511
519
            (vm-save-restriction
512
520
             (widen)
513
521
             (if (null file-buffer)
563
571
;;;###autoload
564
572
(defun vm-pipe-message-to-command (command &optional prefix-arg discard-output)
565
573
  "Runs a shell command with contents from the current message as input.
566
 
By default, the entire message is used.
 
574
By default, the entire message is used.  Message separators are
 
575
included if `vm-message-includes-separators' is non-Nil.
 
576
 
567
577
With one \\[universal-argument] the text portion of the message is used.
568
578
With two \\[universal-argument]'s the header portion of the message is used.
569
579
With three \\[universal-argument]'s the visible header portion of the message
600
610
    (while mlist
601
611
      (setq m (vm-real-message-of (car mlist)))
602
612
      (set-buffer (vm-buffer-of m))
 
613
      ;; FIXME try to load the body before saving
 
614
      (if (vm-body-to-be-retrieved-of m)
 
615
          (error "Message %s body has not been retrieved"
 
616
                 (vm-number-of (car mlist))))
603
617
      (save-restriction
604
618
        (widen)
605
619
        (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))
639
653
           current-prefix-arg)))
640
654
  (vm-pipe-message-to-command command prefix-arg t))
641
655
 
642
 
(defun vm-pipe-command-exit-handler (process discard-output 
 
656
(defun vm-pipe-command-exit-handler (process command discard-output 
643
657
                                             &optional exit-handler)
644
 
  "Switch to output buffer of PROCESS if DISCARD-OUTPUT non-nil.
 
658
"Switch to output buffer of PROCESS that ran COMMAND, if
 
659
DISCARD-OUTPUT non-nil.  
645
660
If non-nil call EXIT-HANDLER with the two arguments COMMAND and OUTPUT-BUFFER." 
646
661
  (let ((exit-code (process-exit-status process))
647
662
        (buffer (process-buffer process))
648
 
        (command (process-command process)))
 
663
        (process-command (process-command process)))
649
664
  (if (not (zerop exit-code))
650
665
      (message "Command '%s' exit code is %d." command exit-code))
651
666
  (vm-display nil nil '(vm-pipe-message-to-command)
652
667
              '(vm-pipe-message-to-command))
653
668
  (vm-switch-to-command-output-buffer command buffer discard-output)
654
669
  (if exit-handler
655
 
      (funcall exit-handler command buffer))))
656
 
 
657
 
(defvar vm-pipe-messages-to-command-start ""
658
 
  "*Inserted by `vm-pipe-messages-to-command' before a message.")
659
 
 
660
 
(defvar vm-pipe-messages-to-command-end "\n"
661
 
  "*Inserted by `vm-pipe-messages-to-command' after a message.")
 
670
      (funcall exit-handler process-command buffer))))
 
671
 
 
672
(defvar vm-pipe-messages-to-command-start t
 
673
  "*The string to be used as the leading message separator by
 
674
`vm-pipe-messages-to-command' at the beginning of each message.
 
675
If set to 't', then use the leading message separator stored in the VM
 
676
folder.  If set to nil, then no leading separator is included.")
 
677
 
 
678
(defvar vm-pipe-messages-to-command-end t
 
679
  "*The string to be used as the trailing message separator by
 
680
`vm-pipe-messages-to-command' at the end of each message.
 
681
If set to 't', then use the trailing message separator stored in the VM
 
682
folder.  If set to nil, no trailing separator is included.")
662
683
 
663
684
;;;###autoload
664
685
(defun vm-pipe-messages-to-command (command &optional prefix-arg 
670
691
is much faster than calling the command on each message.  This is
671
692
more like saving to a pipe.
672
693
 
673
 
Before a message it will insert `vm-pipe-messages-to-command-start'
674
 
and after a message `vm-pipe-messages-to-command-end'.
 
694
With one \\[universal-argument] the text portion of the messages is used.
 
695
With two \\[universal-argument]'s the header portion of the messages is used.
 
696
With three \\[universal-argument]'s the visible header portion of the messages
 
697
plus the text portion is used.
 
698
 
 
699
Leading and trailing separators are included with each message
 
700
depending on the settings of `vm-pipe-messages-to-command-start'
 
701
and `vm-pipe-messages-to-command-end'.
675
702
 
676
703
Output, if any, is displayed unless DISCARD-OUTPUT is t.
677
704
 
713
740
                (vm-pipe-command-exit-handler 
714
741
                 process ,command ,discard-output 
715
742
                 (if (and ,no-wait (functionp ,no-wait))
716
 
                     no-wait)))
 
743
                     ,no-wait)))
717
744
          (message "Command '%s' changed state to %s."
718
745
                   ,command status))))
719
746
    (while mlist
720
747
      (setq m (vm-real-message-of (car mlist)))
721
748
      (set-buffer (vm-buffer-of m))
722
 
      (process-send-string process vm-pipe-messages-to-command-start)
723
 
      (save-restriction
 
749
      ;; FIXME try to load the body before saving
 
750
      (if (vm-body-to-be-retrieved-of m)
 
751
          (error "Message %s body has not been retrieved"
 
752
                 (vm-number-of (car mlist))))
 
753
     (save-restriction
724
754
        (widen)
 
755
        (cond ((eq vm-pipe-messages-to-command-start t)
 
756
               (process-send-region process 
 
757
                                    (vm-start-of m) (vm-headers-of m)))
 
758
              (vm-pipe-messages-to-command-start
 
759
               (process-send-string process vm-pipe-messages-to-command-start)))
725
760
        (let ((region (vm-pipe-message-part m prefix-arg)))
726
 
          (process-send-region process (nth 0 region) (nth 1 region))))
727
 
      (process-send-string process vm-pipe-messages-to-command-end)
728
 
      (setq mlist (cdr mlist)))
 
761
          (process-send-region process (nth 0 region) (nth 1 region)))
 
762
        (cond ((eq vm-pipe-messages-to-command-end t)
 
763
               (process-send-region process 
 
764
                                    (vm-text-end-of m) (vm-end-of m)))
 
765
              (vm-pipe-messages-to-command-end
 
766
               (process-send-string process vm-pipe-messages-to-command-end)))
 
767
        (setq mlist (cdr mlist))))
729
768
 
730
769
    (process-send-eof process)
731
770
 
806
845
    (while mlist
807
846
      (setq m (vm-real-message-of (car mlist)))
808
847
      (set-buffer (vm-buffer-of m))
809
 
      (if (and vm-display-using-mime (vectorp (vm-mm-layout m)))
 
848
      ;; FIXME try to load the body before saving
 
849
      (if (vm-body-to-be-retrieved-of m)
 
850
          (error "Message %s body has not been retrieved"
 
851
                 (vm-number-of (car mlist))))
 
852
     (if (and vm-display-using-mime (vectorp (vm-mm-layout m)))
810
853
          (let ((work-buffer nil))
811
854
            (unwind-protect
812
855
                (progn
859
902
    (vm-switch-to-command-output-buffer command buffer nil)))
860
903
 
861
904
;;;###autoload
862
 
(defun vm-save-message-to-imap-folder (folder &optional count)
 
905
(defun vm-save-message-to-imap-folder (target-folder &optional count)
863
906
  "Save the current message to an IMAP folder.
864
907
Prefix arg COUNT means save this message and the next COUNT-1
865
908
messages.  A negative COUNT means save this message and the
871
914
 
872
915
The saved messages are flagged as `filed'."
873
916
  (interactive
874
 
   (save-excursion
875
 
     (vm-session-initialization)
876
 
     (vm-check-for-killed-folder)
877
 
     (vm-select-folder-buffer-if-possible)
878
 
     (let ((this-command this-command)
879
 
           (last-command last-command))
880
 
       (list (vm-read-imap-folder-name "Save to IMAP folder: "
881
 
                                       vm-imap-server-list t)
 
917
   (let ((this-command this-command)
 
918
         (last-command last-command))
 
919
     (vm-follow-summary-cursor)
 
920
     (save-excursion
 
921
       (vm-session-initialization)
 
922
       (vm-select-folder-buffer)
 
923
       (vm-check-for-killed-summary)
 
924
       (vm-error-if-folder-empty)
 
925
       (list (vm-read-imap-folder-name 
 
926
              "Save to IMAP folder: " t nil
 
927
              (or vm-last-save-imap-folder vm-last-visit-imap-folder))
882
928
             (prefix-numeric-value current-prefix-arg)))))
883
929
  (vm-select-folder-buffer)
884
930
  (vm-check-for-killed-summary)
886
932
  (vm-display nil nil '(vm-save-message-to-imap-folder)
887
933
              '(vm-save-message-to-imap-folder))
888
934
  (or count (setq count 1))
889
 
  (let ((mlist (vm-select-marked-or-prefixed-messages count))
890
 
        process m 
891
 
        (mailbox (nth 3 (vm-imap-parse-spec-to-list folder)))
892
 
        (count 0))
 
935
  (let (source-spec-list
 
936
        (target-spec-list (vm-imap-parse-spec-to-list target-folder))
 
937
        (mlist (vm-select-marked-or-prefixed-messages count))
 
938
        (count 0)
 
939
        server-to-server-p mailbox m
 
940
        process
 
941
        )
 
942
    (setq mailbox (nth 3 target-spec-list))
893
943
    (unwind-protect
894
944
        (save-excursion
895
 
          (setq process (vm-imap-make-session folder))
896
 
          (set-buffer (process-buffer process))
 
945
          (message "Saving messages...")
897
946
          (while mlist
898
 
            (setq m (car mlist))
899
 
            (vm-imap-save-message process m mailbox)
900
 
            (when (null (vm-filed-flag m))
901
 
                (vm-set-filed-flag m t))
 
947
            (setq m (vm-real-message-of (car mlist)))
 
948
            (set-buffer (vm-buffer-of m))
 
949
            (setq source-spec-list 
 
950
                  (and (vm-imap-folder-p)
 
951
                       (vm-imap-parse-spec-to-list 
 
952
                        (vm-folder-imap-maildrop-spec))))
 
953
            (setq server-to-server-p    ; copy on the same imap server
 
954
                  (and (equal (nth 1 source-spec-list) 
 
955
                              (nth 1 target-spec-list))
 
956
                       (equal (nth 5 source-spec-list) 
 
957
                              (nth 5 target-spec-list))))
 
958
            ;; FIXME try to load the body before saving
 
959
            (if (and (not server-to-server-p)
 
960
                     (vm-body-to-be-retrieved-of m))
 
961
                (error "Message %s body has not been retrieved"
 
962
                       (vm-number-of (car mlist))))
 
963
            ;; Kyle Jones says:
 
964
            ;; have to stuff the attributes in all cases because
 
965
            ;; the deleted attribute may have been stuffed
 
966
            ;; previously and we don't want to save that attribute.
 
967
            ;; FIXME But stuffing attributes into the IMAP buffer is
 
968
            ;; not easy.  USR, 2010-03-08
 
969
            ;; (vm-stuff-attributes m t)
 
970
            (if server-to-server-p      ; economise on upstream data traffic
 
971
                (let ((process (vm-re-establish-folder-imap-session)))
 
972
                  (vm-imap-copy-message process m mailbox))
 
973
              (unless process
 
974
                (setq process (vm-imap-make-session target-folder)))
 
975
              (vm-imap-save-message process m mailbox))
 
976
            (unless (vm-filed-flag m)
 
977
              (vm-set-filed-flag m t))
 
978
            ;; we set the deleted flag so that the user is not
 
979
            ;; confused if the save doesn't go through fully.
 
980
            (when (and vm-delete-after-saving (not (vm-deleted-flag m)))
 
981
              (vm-set-deleted-flag m t))
902
982
            (vm-increment count)
903
 
            (vm-modify-folder-totals folder 'saved 1 m)
 
983
            (message "Saving messages... %s" count)
 
984
            (vm-modify-folder-totals target-folder 'saved 1 m)
904
985
            (setq mlist (cdr mlist))))
905
 
      (and process (vm-imap-end-session process)))
 
986
      (when process (vm-imap-end-session process)))
906
987
    (vm-update-summary-and-mode-line)
 
988
    (setq vm-last-save-imap-folder target-folder)
 
989
    (if (and vm-delete-after-saving (not vm-folder-read-only))
 
990
        (vm-delete-message count))
907
991
    (message "%d message%s saved to %s"
908
992
             count (if (/= 1 count) "s" "")
909
 
             (vm-safe-imapdrop-string folder))
910
 
    (when (and vm-delete-after-saving (not vm-folder-read-only))
911
 
        (vm-delete-message count))
912
 
    folder ))
 
993
             (vm-safe-imapdrop-string target-folder))
 
994
    target-folder ))
913
995
 
914
996
(provide 'vm-save)
915
997