/[emacs]/emacs/lisp/mail/unrmail.el
ViewVC logotype

Diff of /emacs/lisp/mail/unrmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13.6.1 by handa, Fri Apr 16 12:50:31 2004 UTC revision 1.13.6.2 by miles, Mon Jun 28 07:29:48 2004 UTC
# Line 51  For example, invoke `emacs -batch -f bat Line 51  For example, invoke `emacs -batch -f bat
51  (defun unrmail (file to-file)  (defun unrmail (file to-file)
52    "Convert Rmail file FILE to system inbox format file TO-FILE."    "Convert Rmail file FILE to system inbox format file TO-FILE."
53    (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")    (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
54    (let ((message-count 1)    (with-temp-buffer
55          ;; Prevent rmail from making, or switching to, a summary buffer.      ;; Read in the old Rmail file with no decoding.
56          (rmail-display-summary nil)      (let ((coding-system-for-read 'raw-text))
57          (rmail-delete-after-output nil)        (insert-file-contents file))
58          (temp-buffer (get-buffer-create " unrmail")))      ;; But make it multibyte.
59      (rmail file)      (set-buffer-multibyte t)
60    
61        (if (not (looking-at "BABYL OPTIONS"))
62            (error "This file is not in Babyl format"))
63    
64        ;; Decode the file contents just as Rmail did.
65        (let ((modifiedp (buffer-modified-p))
66              (coding-system rmail-file-coding-system)
67              from to)
68          (goto-char (point-min))
69          (search-forward "\n\^_" nil t)    ; Skip BABYL header.
70          (setq from (point))
71          (goto-char (point-max))
72          (search-backward "\n\^_" from 'mv)
73          (setq to (point))
74          (unless (and coding-system
75                       (coding-system-p coding-system))
76            (setq coding-system
77                  ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
78                  ;; earlier versions did that with the current buffer's encoding.
79                  ;; So we want to favor detection of emacs-mule (whose normal
80                  ;; priority is quite low), but still allow detection of other
81                  ;; encodings if emacs-mule won't fit.  The call to
82                  ;; detect-coding-with-priority below achieves that.
83                  (car (detect-coding-with-priority
84                        from to
85                        '((coding-category-emacs-mule . emacs-mule))))))
86          (unless (memq coding-system
87                        '(undecided undecided-unix))
88            (set-buffer-modified-p t)       ; avoid locking when decoding
89            (let ((buffer-undo-list t))
90              (decode-coding-region from to coding-system))
91            (setq coding-system last-coding-system-used))
92    
93          (setq buffer-file-coding-system nil)
94    
95          ;; We currently don't use this value, but maybe we should.
96          (setq save-buffer-coding-system
97                (or coding-system 'undecided)))
98    
99      ;; Default the directory of TO-FILE based on where FILE is.      ;; Default the directory of TO-FILE based on where FILE is.
100      (setq to-file (expand-file-name to-file default-directory))      (setq to-file (expand-file-name to-file default-directory))
101      (condition-case ()      (condition-case ()
102          (delete-file to-file)          (delete-file to-file)
103        (file-error nil))        (file-error nil))
104      (message "Writing messages to %s..." to-file)      (message "Writing messages to %s..." to-file)
105      (save-restriction      (goto-char (point-min))
106        (widen)  
107        (while (<= message-count rmail-total-messages)      (let ((temp-buffer (get-buffer-create " unrmail"))
108          (let ((beg (rmail-msgbeg message-count))            (from-buffer (current-buffer)))
109                (end (rmail-msgbeg (1+ message-count)))  
110                (from-buffer (current-buffer))        ;; Process the messages one by one.
111                (coding (or rmail-file-coding-system 'raw-text))        (while (search-forward "\^_\^l" nil t)
112            (let ((beg (point))
113                  (end (save-excursion
114                         (if (search-forward "\^_" nil t)
115                             (1- (point)) (point-max))))
116                  (coding 'raw-text)
117                label-line attrs keywords                label-line attrs keywords
118                header-beginning mail-from)                mail-from reformatted)
           (save-excursion  
             (goto-char (rmail-msgbeg message-count))  
             (setq header-beginning (point))  
             (search-forward "\n*** EOOH ***\n")  
             (forward-line -1)  
             (search-forward "\n\n")  
             (save-restriction  
               (narrow-to-region header-beginning (point))  
               (setq mail-from  
                     (or (mail-fetch-field "Mail-From")  
                         (concat "From "  
                                 (mail-strip-quoted-names (or (mail-fetch-field "from")  
                                                              (mail-fetch-field "really-from")  
                                                              (mail-fetch-field "sender")  
                                                              "unknown"))  
                                 " " (current-time-string))))))  
119            (with-current-buffer temp-buffer            (with-current-buffer temp-buffer
120              (setq buffer-undo-list t)              (setq buffer-undo-list t)
121              (erase-buffer)              (erase-buffer)
# Line 95  For example, invoke `emacs -batch -f bat Line 123  For example, invoke `emacs -batch -f bat
123              (insert-buffer-substring from-buffer beg end)              (insert-buffer-substring from-buffer beg end)
124              (goto-char (point-min))              (goto-char (point-min))
125              (forward-line 1)              (forward-line 1)
126                ;; Record whether the header is reformatted.
127                (setq reformatted (= (following-char) ?1))
128    
129                ;; Collect the label line, then get the attributes
130                ;; and the keywords from it.
131              (setq label-line              (setq label-line
132                    (buffer-substring (point)                    (buffer-substring (point)
133                                      (progn (forward-line 1)                                      (save-excursion (forward-line 1)
134                                             (point))))                                                      (point))))
             (forward-line -1)  
135              (search-forward ",,")              (search-forward ",,")
136              (unless (eolp)              (unless (eolp)
137                (setq keywords                (setq keywords
# Line 118  For example, invoke `emacs -batch -f bat Line 150  For example, invoke `emacs -batch -f bat
150                     (if (string-match ", resent," label-line) ?R ?-)                     (if (string-match ", resent," label-line) ?R ?-)
151                     (if (string-match ", unseen," label-line) ?\  ?-)                     (if (string-match ", unseen," label-line) ?\  ?-)
152                     (if (string-match ", stored," label-line) ?S ?-)))                     (if (string-match ", stored," label-line) ?S ?-)))
153              (unrmail-unprune)  
154                ;; Delete the special Babyl lines at the start,
155                ;; and the ***EOOH*** line, and the reformatted header if any.
156                (goto-char (point-min))
157                (if reformatted
158                    (progn
159                      (forward-line 2)
160                      ;; Delete Summary-Line headers.
161                      (let ((case-fold-search t))
162                        (while (looking-at "Summary-Line:")
163                          (forward-line 1)))
164                      (delete-region (point-min) (point))
165                      ;; Delete the old reformatted header.
166                      (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
167                      (forward-line -1)
168                      (let ((start (point)))
169                        (search-forward "\n\n")
170                        (delete-region start (point))))
171                  ;; Not reformatted.  Delete the special
172                  ;; lines before the real header.
173                  (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
174                  (delete-region (point-min) (point)))
175    
176                ;; Some operations on the message header itself.
177                (goto-char (point-min))
178                (save-restriction
179                  (narrow-to-region
180                   (point-min)
181                   (save-excursion (search-forward "\n\n" nil 'move) (point)))
182    
183                  ;; Fetch or construct what we should use in the `From ' line.
184                  (setq mail-from
185                        (or (mail-fetch-field "Mail-From")
186                            (concat "From "
187                                    (mail-strip-quoted-names (or (mail-fetch-field "from")
188                                                                 (mail-fetch-field "really-from")
189                                                                 (mail-fetch-field "sender")
190                                                                 "unknown"))
191                                    " " (current-time-string))))
192    
193                  ;; If the message specifies a coding system, use it.
194                  (let ((maybe-coding (mail-fetch-field "X-Coding-System")))
195                    (if maybe-coding
196                        (setq coding (intern maybe-coding))))
197    
198                  ;; Delete the Mail-From: header field if any.
199                  (when (re-search-forward "^Mail-from:" nil t)
200                    (beginning-of-line)
201                    (delete-region (point)
202                                   (progn (forward-line 1) (point)))))
203    
204              (goto-char (point-min))              (goto-char (point-min))
205                ;; Insert the `From ' line.
206              (insert mail-from "\n")              (insert mail-from "\n")
207                ;; Record the keywords and attributes in our special way.
208              (insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n")              (insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n")
209              (when keywords              (when keywords
210                (insert "X-BABYL-V6-KEYWORDS: " keywords "\n"))                (insert "X-BABYL-V6-KEYWORDS: " keywords "\n"))
# Line 132  For example, invoke `emacs -batch -f bat Line 216  For example, invoke `emacs -batch -f bat
216                (while (search-forward "\nFrom " nil t)                (while (search-forward "\nFrom " nil t)
217                  (forward-char -5)                  (forward-char -5)
218                  (insert ?>)))                  (insert ?>)))
219                ;; Write it to the output file.
220              (write-region (point-min) (point-max) to-file t              (write-region (point-min) (point-max) to-file t
221                            'nomsg)))                            'nomsg))))
222          (setq message-count (1+ message-count))))        (kill-buffer temp-buffer))
223      (message "Writing messages to %s...done" to-file)))      (message "Writing messages to %s...done" to-file)))
224    
 (defun unrmail-unprune ()  
   (let* ((pruned  
           (save-excursion  
             (goto-char (point-min))  
             (forward-line 1)  
             (= (following-char) ?1))))  
     (if pruned  
         (progn  
           (goto-char (point-min))  
           (forward-line 2)  
           ;; Delete Summary-Line headers.  
           (let ((case-fold-search t))  
             (while (looking-at "Summary-Line:")  
               (forward-line 1)))  
           (delete-region (point-min) (point))  
           ;; Delete the old reformatted header.  
           (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")  
           (forward-line -1)  
           (let ((start (point)))  
             (search-forward "\n\n")  
             (delete-region start (point))))  
       ;; Delete everything up to the real header.  
       (goto-char (point-min))  
       (re-search-forward "^[*][*][*] EOOH [*][*][*]\n")  
       (delete-region (point-min) (point)))  
     (goto-char (point-min))  
     (when (re-search-forward "^Mail-from:")  
       (beginning-of-line)  
       (delete-region (point)  
                      (progn (forward-line 1) (point))))))  
   
   
225  (provide 'unrmail)  (provide 'unrmail)
226    
227  ;;; unrmail.el ends here  ;;; unrmail.el ends here

Legend:
Removed from v.1.13.6.1  
changed lines
  Added in v.1.13.6.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26