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

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

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

revision 1.66 by pot, Tue Feb 4 10:58:53 2003 UTC revision 1.66.2.1 by pmr, Sat Feb 15 15:38:18 2003 UTC
# Line 1  Line 1 
1  ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file  ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
2    
3  ;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
4    
# Line 26  Line 26 
26    
27  ;;; Code:  ;;; Code:
28    
 (require 'rmail)  
29  (provide 'rmailout)  (provide 'rmailout)
30    
31    (eval-when-compile
32      (require 'rmail)
33      (require 'rmaildesc))
34    
35    
36  ;;;###autoload  ;;;###autoload
37  (defcustom rmail-output-file-alist nil  (defcustom rmail-output-file-alist nil
38    "*Alist matching regexps to suggested output Rmail files.    "*Alist matching regexps to suggested output Rmail files.
# Line 62  Set `rmail-default-rmail-file' to this n Line 66  Set `rmail-default-rmail-file' to this n
66      (let ((read-file      (let ((read-file
67             (expand-file-name             (expand-file-name
68              (read-file-name              (read-file-name
69               (concat "Output message to Rmail file: (default "               (concat "Output message to Rmail (mbox) file: (default "
70                       (file-name-nondirectory default-file)                       (file-name-nondirectory default-file)
71                       ") ")                       ") ")
72               (file-name-directory default-file)               (file-name-directory default-file)
# Line 76  Set `rmail-default-rmail-file' to this n Line 80  Set `rmail-default-rmail-file' to this n
80                                    read-file)                                    read-file)
81                read-file)))))                read-file)))))
82    
83    ;;; mbox: deprecated
84  (defun rmail-output-read-file-name ()  (defun rmail-output-read-file-name ()
85    "Read the file name to use for `rmail-output'.    "Read the file name to use for `rmail-output'.
86  Set `rmail-default-file' to this name as well as returning it."  Set `rmail-default-file' to this name as well as returning it."
# Line 108  Set `rmail-default-file' to this name as Line 113  Set `rmail-default-file' to this name as
113                 (or read-file (file-name-nondirectory default-file))                 (or read-file (file-name-nondirectory default-file))
114                 (file-name-directory default-file)))))))                 (file-name-directory default-file)))))))
115    
116    ;;; mbox: ready
117  ;;; There are functions elsewhere in Emacs that use this function;  ;;; There are functions elsewhere in Emacs that use this function;
118  ;;; look at them before you change the calling method.  ;;; look at them before you change the calling method.
119  ;;;###autoload  ;;;###autoload
120  (defun rmail-output-to-rmail-file (file-name &optional count stay)  (defun rmail-output-to-rmail-file (file-name &optional count stay)
121    "Append the current message to an Rmail file named FILE-NAME.    "Append the current message to an Rmail (mbox) file named FILE-NAME.
122  If the file does not exist, ask if it should be created.  If the file does not exist, ask if it should be created.
123  If file is being visited, the message is appended to the Emacs  If file is being visited, the message is appended to the Emacs
124  buffer visiting that file.  buffer visiting that file.
# Line 130  mesasge up instead of moving forward to Line 136  mesasge up instead of moving forward to
136    (interactive    (interactive
137     (list (rmail-output-read-rmail-file-name)     (list (rmail-output-read-rmail-file-name)
138           (prefix-numeric-value current-prefix-arg)))           (prefix-numeric-value current-prefix-arg)))
139    (or count (setq count 1))    
140    (setq file-name    ;; Use the 'rmail-output function to perform the output.
141          (expand-file-name file-name    (rmail-output file-name count nil nil)
142                            (file-name-directory rmail-default-rmail-file)))  
143    (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))    ;; Deal with the next message
144        (rmail-output file-name count)    (if rmail-delete-after-output
145      (rmail-maybe-set-message-counters)        (unless
146      (setq file-name (abbreviate-file-name file-name))            (if (and (= count 0) stay)
147      (or (find-buffer-visiting file-name)                (rmail-delete-message)
148          (file-exists-p file-name)              (rmail-delete-forward))
149          (if (yes-or-no-p          (setq count 0))
150               (concat "\"" file-name "\" does not exist, create it? "))      (if (> count 0)
151              (let ((file-buffer (create-file-buffer file-name)))          (unless
152                (save-excursion              (if (not stay) (rmail-next-undeleted-message 1))
153                  (set-buffer file-buffer)            (setq count 0)))))
                 (rmail-insert-rmail-file-header)  
                 (let ((require-final-newline nil)  
                       (coding-system-for-write  
                        (or rmail-file-coding-system  
                            'emacs-mule-unix)))  
                   (write-region (point-min) (point-max) file-name t 1)))  
               (kill-buffer file-buffer))  
           (error "Output file does not exist")))  
     (while (> count 0)  
       (let (redelete)  
         (unwind-protect  
             (progn  
               (set-buffer rmail-buffer)  
               ;; Temporarily turn off Deleted attribute.  
               ;; Do this outside the save-restriction, since it would  
               ;; shift the place in the buffer where the visible text starts.  
               (if (rmail-message-deleted-p rmail-current-message)  
                   (progn (setq redelete t)  
                          (rmail-set-attribute "deleted" nil)))  
               (save-restriction  
                 (widen)  
                 ;; Decide whether to append to a file or to an Emacs buffer.  
                 (save-excursion  
                   (let ((buf (find-buffer-visiting file-name))  
                         (cur (current-buffer))  
                         (beg (1+ (rmail-msgbeg rmail-current-message)))  
                         (end (1+ (rmail-msgend rmail-current-message)))  
                         (coding-system-for-write  
                          (or rmail-file-coding-system  
                              'emacs-mule-unix)))  
                     (if (not buf)  
                         ;; Output to a file.  
                         (if rmail-fields-not-to-output  
                             ;; Delete some fields while we output.  
                             (let ((obuf (current-buffer)))  
                               (set-buffer (get-buffer-create " rmail-out-temp"))  
                               (insert-buffer-substring obuf beg end)  
                               (rmail-delete-unwanted-fields)  
                               (append-to-file (point-min) (point-max) file-name)  
                               (set-buffer obuf)  
                               (kill-buffer (get-buffer " rmail-out-temp")))  
                           (append-to-file beg end file-name))  
                       (if (eq buf (current-buffer))  
                           (error "Can't output message to same file it's already in"))  
                       ;; File has been visited, in buffer BUF.  
                       (set-buffer buf)  
                       (let ((buffer-read-only nil)  
                             (msg (and (boundp 'rmail-current-message)  
                                       rmail-current-message)))  
                         ;; If MSG is non-nil, buffer is in RMAIL mode.  
                         (if msg  
                             (progn  
                               ;; Turn on auto save mode, if it's off in this  
                               ;; buffer but enabled by default.  
                               (and (not buffer-auto-save-file-name)  
                                    auto-save-default  
                                    (auto-save-mode t))  
                               (rmail-maybe-set-message-counters)  
                               (widen)  
                               (narrow-to-region (point-max) (point-max))  
                               (insert-buffer-substring cur beg end)  
                               (goto-char (point-min))  
                               (widen)  
                               (search-backward "\n\^_")  
                               (narrow-to-region (point) (point-max))  
                               (rmail-delete-unwanted-fields)  
                               (rmail-count-new-messages t)  
                               (if (rmail-summary-exists)  
                                   (rmail-select-summary  
                                     (rmail-update-summary)))  
                               (rmail-show-message msg))  
                           ;; Output file not in rmail mode => just insert at the end.  
                           (narrow-to-region (point-min) (1+ (buffer-size)))  
                           (goto-char (point-max))  
                           (insert-buffer-substring cur beg end)  
                           (rmail-delete-unwanted-fields)))))))  
               (rmail-set-attribute "filed" t))  
           (if redelete (rmail-set-attribute "deleted" t))))  
       (setq count (1- count))  
       (if rmail-delete-after-output  
           (unless  
               (if (and (= count 0) stay)  
                   (rmail-delete-message)  
                 (rmail-delete-forward))  
             (setq count 0))  
         (if (> count 0)  
             (unless  
                 (if (not stay) (rmail-next-undeleted-message 1))  
               (setq count 0)))))))  
154    
155    ;;; mbox: deprecated
156  ;;;###autoload  ;;;###autoload
157  (defcustom rmail-fields-not-to-output nil  (defcustom rmail-fields-not-to-output nil
158    "*Regexp describing fields to exclude when outputting a message to a file."    "*Regexp describing fields to exclude when outputting a message to a file."
# Line 242  mesasge up instead of moving forward to Line 160  mesasge up instead of moving forward to
160                   regexp)                   regexp)
161    :group 'rmail-output)    :group 'rmail-output)
162    
163    ;;; mbox: deprecated
164  ;; Delete from the buffer header fields we don't want output.  ;; Delete from the buffer header fields we don't want output.
165  ;; NOT-RMAIL if t means this buffer does not have the full header  ;; NOT-RMAIL if t means this buffer does not have the full header
166  ;; and *** EOOH *** that a message in an Rmail file has.  ;; and *** EOOH *** that a message in an Rmail file has.
# Line 259  mesasge up instead of moving forward to Line 178  mesasge up instead of moving forward to
178                  (delete-region (point)                  (delete-region (point)
179                                 (progn (forward-line 1) (point)))))))))                                 (progn (forward-line 1) (point)))))))))
180    
181    ;;; mbox: ready
182  ;;; There are functions elsewhere in Emacs that use this function;  ;;; There are functions elsewhere in Emacs that use this function;
183  ;;; look at them before you change the calling method.  ;;; look at them before you change the calling method.
184  ;;;###autoload  ;;;###autoload
185  (defun rmail-output (file-name &optional count noattribute from-gnus)  (defun rmail-output (file-name &optional count noattribute ext)
186    "Append this message to system-inbox-format mail file named FILE-NAME.    "Append an mbox formatted message to the mbox formatted file named
187  A prefix argument N says to output N consecutive messages  FILE-NAME.  A prefix argument COUNT says to output COUNT consecutive
188  starting with the current one.  Deleted messages are skipped and don't count.  messages starting with the current one.  Deleted messages are skipped
189  When called from lisp code, N may be omitted.  and don't count.  When called from lisp code, COUNT may be omitted.
   
 If the pruned message header is shown on the current message, then  
 messages will be appended with pruned headers; otherwise, messages  
 will be appended with their original headers.  
190    
191  The default file name comes from `rmail-default-file',  The default file name comes from `rmail-default-file',
192  which is updated to the name you use in this command.  which is updated to the name you use in this command.
# Line 278  which is updated to the name you use in Line 194  which is updated to the name you use in
194  The optional third argument NOATTRIBUTE, if non-nil, says not  The optional third argument NOATTRIBUTE, if non-nil, says not
195  to set the `filed' attribute, and not to display a message.  to set the `filed' attribute, and not to display a message.
196    
197  The optional fourth argument FROM-GNUS is set when called from GNUS."  The optional fourth argument EXT is set when called from outside of an
198    Rmail function, for example by GNUS or Sendmail."
199    (interactive    (interactive
200     (list (rmail-output-read-file-name)     (list (rmail-output-read-file-name)
201           (prefix-numeric-value current-prefix-arg)))           (prefix-numeric-value current-prefix-arg)))
# Line 287  The optional fourth argument FROM-GNUS i Line 204  The optional fourth argument FROM-GNUS i
204          (expand-file-name file-name          (expand-file-name file-name
205                            (and rmail-default-file                            (and rmail-default-file
206                                 (file-name-directory rmail-default-file))))                                 (file-name-directory rmail-default-file))))
   (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))  
       (rmail-output-to-rmail-file file-name count)  
     (set-buffer rmail-buffer)  
     (let ((orig-count count)  
           (rmailbuf (current-buffer))  
           (case-fold-search t)  
           (tembuf (get-buffer-create " rmail-output"))  
           (original-headers-p  
            (and (not from-gnus)  
                 (save-excursion  
                   (save-restriction  
                     (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))  
                     (goto-char (point-min))  
                     (forward-line 1)  
                     (= (following-char) ?0)))))  
           header-beginning  
           mail-from mime-version content-type)  
       (while (> count 0)  
         ;; Preserve the Mail-From and MIME-Version fields  
         ;; even if they have been pruned.  
         (or from-gnus  
             (save-excursion  
               (save-restriction  
                 (widen)  
                 (goto-char (rmail-msgbeg rmail-current-message))  
                 (setq header-beginning (point))  
                 (search-forward "\n*** EOOH ***\n")  
                 (narrow-to-region header-beginning (point))  
                 (setq mail-from (mail-fetch-field "Mail-From"))  
                 (unless rmail-enable-mime  
                   (setq mime-version (mail-fetch-field "MIME-Version")  
                         content-type (mail-fetch-field "Content-type"))))))  
         (save-excursion  
           (set-buffer tembuf)  
           (erase-buffer)  
           (insert-buffer-substring rmailbuf)  
           (when rmail-enable-mime  
             (if original-headers-p  
                 (delete-region (goto-char (point-min))  
                                (if (search-forward "\n*** EOOH ***\n")  
                                    (match-end 0)))  
               (goto-char (point-min))  
               (forward-line 2)  
               (delete-region (point-min)(point))  
               (search-forward "\n*** EOOH ***\n")  
               (delete-region (match-beginning 0)  
                              (if (search-forward "\n\n")  
                                  (1- (match-end 0)))))  
             (setq buffer-file-coding-system (or rmail-file-coding-system  
                                                 'raw-text)))  
           (rmail-delete-unwanted-fields t)  
           (or (bolp) (insert "\n"))  
           (goto-char (point-min))  
           (if mail-from  
               (insert mail-from "\n")  
             (insert "From "  
                     (mail-strip-quoted-names (or (mail-fetch-field "from")  
                                                  (mail-fetch-field "really-from")  
                                                  (mail-fetch-field "sender")  
                                                  "unknown"))  
                     " " (current-time-string) "\n"))  
           (if mime-version  
               (insert "MIME-Version: " mime-version  
                       "\nContent-type: " content-type "\n"))  
           ;; ``Quote'' "\nFrom " as "\n>From "  
           ;;  (note that this isn't really quoting, as there is no requirement  
           ;;   that "\n[>]+From " be quoted in the same transparent way.)  
           (let ((case-fold-search nil))  
             (while (search-forward "\nFrom " nil t)  
               (forward-char -5)  
               (insert ?>)))  
           (write-region (point-min) (point-max) file-name t  
                         (if noattribute 'nomsg)))  
         (or noattribute  
             (if (equal major-mode 'rmail-mode)  
                 (rmail-set-attribute "filed" t)))  
         (setq count (1- count))  
         (or from-gnus  
             (let ((next-message-p  
                    (if rmail-delete-after-output  
                        (rmail-delete-forward)  
                      (if (> count 0)  
                          (rmail-next-undeleted-message 1))))  
                   (num-appended (- orig-count count)))  
               (if (and next-message-p original-headers-p)  
                   (rmail-toggle-header))  
               (if (and (> count 0) (not next-message-p))  
                   (progn  
                     (error  
                      (save-excursion  
                        (set-buffer rmailbuf)  
                        (format "Only %d message%s appended" num-appended  
                                (if (= num-appended 1) "" "s"))))  
                     (setq count 0))))))  
       (kill-buffer tembuf))))  
207    
208      ;; Use the Rmail buffer, likely narrowed, as the message source
209      ;; unless being called from an external party, such as GNUS or
210      ;; Sendmail.
211      (unless ext
212        (set-buffer rmail-buffer))
213    
214      (let ((orig-count count)
215            (src-buf (current-buffer))
216            (dst-buf (find-buffer-visiting file-name))
217            (current-message rmail-current-message)
218            (tembuf (get-buffer-create " rmail-output"))
219            (original-headers-p
220             (and (not ext) (not (rmail-msg-is-pruned)))))
221    
222        ;; Output each message to the destination file.
223        (while (> count 0)
224          (save-excursion
225    
226            ;; Copy the message, including all headers, to the temporary
227            ;; buffer.
228            (set-buffer tembuf)
229            (erase-buffer)
230            (insert-buffer-substring src-buf)
231            
232            ;; Deal with MIME --- tbd.
233            ;;(when rmail-enable-mime ...
234    
235            ;; Determine whether a buffer is already visiting the output
236            ;; file.
237            (if dst-buf
238    
239                ;; The destination file is being visited.  Update it.
240                (progn
241                  (set-buffer dst-buf)
242    
243                  ;; Determine if the destination file is an Rmail file.
244                  (let ((buffer-read-only nil)
245                        (dst-current-message (and (boundp 'rmail-current-message)
246                                                  rmail-current-message)))
247                    (if dst-current-message
248    
249                        ;; The buffer is an Rmail buffer.  Append the message.
250                        (progn
251                          (widen)
252                          (narrow-to-region (point-max) (point-max))
253                          (insert-buffer-substring src-buf)
254                          (insert "\n")
255                          (rmail-process-new-messages)
256                          (rmail-show-message dst-current-message))
257    
258                      ;; The destination file is not an Rmail file, just
259                      ;; insert at the end.
260                      (goto-char (point-max))
261                      (insert-buffer-substring src-buf))))
262    
263              ;; The destination file is not being visited, just write out
264              ;; the processed message.
265              (write-region (point-min) (point-max) file-name t
266                            (if noattribute 'nomsg))))
267    
268          ;; Do housekeeping, such as setting the "Filed" attribute, if
269          ;; necessary and moving to the next message.
270          (or noattribute
271              (if (equal major-mode 'rmail-mode)
272                  (progn
273                    (rmail-set-attribute "filed" t current-message)
274                    (setq current-message (1+ current-message)))))
275    
276          ;; Determine if Rmail post output operations need to be handled.
277          (or ext
278    
279              ;; They do.  Move to the next non-deleted message.
280              (let ((next-message-p
281                     (if rmail-delete-after-output
282                         (rmail-delete-forward)
283                       (if (> count 1)
284                           (rmail-next-undeleted-message 1))))
285                    (num-appended (- orig-count count)))
286                (if (and (> count 1) (not next-message-p))
287                    (progn
288                      (error
289                       (save-excursion
290                         (set-buffer src-buf)
291                         (format "Only %d message%s appended" num-appended
292                                 (if (= num-appended 1) "" "s"))))
293                      (setq count 0)))))
294    
295          ;; Decrement the count for the next iteration.  If an error has
296          ;; occurred, then count will be -1, which is every bit as good
297          ;; as 0.
298          (setq count (1- count)))
299        (kill-buffer tembuf)))
300    
301    ;;; mbox: ready
302  ;;;###autoload  ;;;###autoload
303  (defun rmail-output-body-to-file (file-name)  (defun rmail-output-body-to-file (file-name)
304    "Write this message body to the file FILE-NAME.    "Write this message body to the file FILE-NAME.
# Line 409  FILE-NAME defaults, interactively, from Line 325  FILE-NAME defaults, interactively, from
325           (error "Operation aborted"))           (error "Operation aborted"))
326      (write-region (point) (point-max) file-name)      (write-region (point) (point-max) file-name)
327      (if (equal major-mode 'rmail-mode)      (if (equal major-mode 'rmail-mode)
328          (rmail-set-attribute "stored" t)))          (rmail-desc-set-attribute rmail-desc-stored-index t rmail-current-message)))
329    (if rmail-delete-after-output    (if rmail-delete-after-output
330        (rmail-delete-forward)))        (rmail-delete-forward)))
331    

Legend:
Removed from v.1.66  
changed lines
  Added in v.1.66.2.1

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