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

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

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

revision 1.368.2.5 by pmr, Sun Feb 23 00:33:25 2003 UTC revision 1.368.2.6 by rms, Mon Sep 20 16:33:36 2004 UTC
# Line 691  If `rmail-display-summary' is non-nil, m Line 691  If `rmail-display-summary' is non-nil, m
691                     (setq run-mail-hook t)))                     (setq run-mail-hook t)))
692        (setq run-mail-hook t)        (setq run-mail-hook t)
693        (rmail-mode-2)        (rmail-mode-2)
694        ;; Convert all or part to Babyl file if possible.        (goto-char (point-min))
695  ;;;      (rmail-convert-file)        ;; If file starts like a Babyl file, reject it.
696          (if (looking-at "BABYL OPTIONS:")
697              (error "This is a BABYL file; use M-x unrmail to convert it")))
698        (goto-char (point-max)))        (goto-char (point-max)))
699      ;; As we have read a file by raw-text, the buffer is set to      ;; As we have read a file by raw-text, the buffer is set to
700      ;; unibyte.  We must make it multibyte if necessary.      ;; unibyte.  We must make it multibyte if necessary.
# Line 735  If `rmail-display-summary' is non-nil, m Line 737  If `rmail-display-summary' is non-nil, m
737  ;                        list))))  ;                        list))))
738  ;     list))  ;     list))
739    
 ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line  
 ; will not cause emacs 18.55 problems.  
   
 ;; This calls rmail-decode-babyl-format if the file is already Babyl.  
   
 ;;; mbox: DEPECATED  
 (defun rmail-convert-file ()  
   (let (convert)  
     (widen)  
     (goto-char (point-min))  
     ;; If file doesn't start like a Babyl file,  
     ;; convert it to one, by adding a header and converting each message.  
     (cond ((looking-at "BABYL OPTIONS:"))  
           ((looking-at "Version: 5\n")  
            ;; Losing babyl file made by old version of Rmail.  
            ;; Just fix the babyl file header; don't make a new one,  
            ;; so we don't lose the Labels: file attribute, etc.  
            (let ((buffer-read-only nil))  
              (insert "BABYL OPTIONS: -*- rmail -*-\n")))  
           ((equal (point-min) (point-max))  
            ;; Empty RMAIL file.  Just insert the header.  
            (rmail-insert-rmail-file-header))  
           (t  
            ;; Non-empty file in non-RMAIL format.  Add header and convert.  
            (setq convert t)  
            (rmail-insert-rmail-file-header)))  
     ;; If file was not a Babyl file or if there are  
     ;; Unix format messages added at the end,  
     ;; convert file as necessary.  
     (if (or convert  
             (save-excursion  
               (goto-char (point-max))  
               (search-backward "\n\^_")  
               (forward-char 2)  
               (looking-at "\n*From ")))  
         (let ((buffer-read-only nil))  
           (message "Converting to Babyl format...")  
           ;; If file needs conversion, convert it all,  
           ;; except for the BABYL header.  
           ;; (rmail-convert-to-babyl-format would delete the header.)  
           (goto-char (point-min))  
           (search-forward "\n\^_" nil t)  
           (narrow-to-region (point) (point-max))  
           (rmail-convert-to-babyl-format)  
           (message "Converting to Babyl format...done"))  
       (if (and (not rmail-enable-mime)  
                rmail-enable-multibyte)  
           ;; We still have to decode BABYL part.  
           (rmail-decode-babyl-format)))))  
   
 ;;;###deprecated  
 (defun rmail-insert-rmail-file-header ()  
   (let ((buffer-read-only nil)  
         (header-line "X-BABYL: -*-rmail-*-"))  
     ;; Determine if the header has already been inserted.  
     (goto-char (point-min))  
     (if (not (looking-at "X-BABYL: "))  
         ;; The header has not been inserted.  Insert -*-rmail-*- here  
         ;; so that visiting the file normally recognizes it as an  
         ;; Rmail file.  
         (insert (concat header-line "\nX-BABYL-Version: 6  
 Version: 6  
 Labels:  
 Note:   This is the header of an rmail file.  
 Note:   If you are seeing it in rmail,  
 Note:    it means the file has no messages in it.")))))  
   
740  (defun rmail-initialize-messages ()  (defun rmail-initialize-messages ()
741    "Initialize message state and process the messages in the buffer to    "Initialize message state and process the messages in the buffer to
742    update message state."    update message state."
# Line 1096  Instead, these commands are available: Line 1031  Instead, these commands are available:
1031                 default-enable-multibyte-characters)                 default-enable-multibyte-characters)
1032        (let ((rmail-enable-multibyte t))        (let ((rmail-enable-multibyte t))
1033          (rmail-require-mime-maybe)          (rmail-require-mime-maybe)
         (rmail-convert-file)  
1034          (goto-char (point-max))          (goto-char (point-max))
1035          (set-buffer-multibyte t)))          (set-buffer-multibyte t)))
1036      (rmail-set-message-counters)      (rmail-set-message-counters)
# Line 1675  It returns t if it got any new messages. Line 1609  It returns t if it got any new messages.
1609        (setq coding 'undecided))        (setq coding 'undecided))
1610    (decode-coding-region from to coding))    (decode-coding-region from to coding))
1611    
 ;; the  rmail-break-forwarded-messages  feature is not implemented  
 ;;; NOT DONE  but not called any more  
 (defun rmail-convert-to-babyl-format ()  
   (let ((count 0) start  
         (case-fold-search nil)  
         (invalid-input-resync  
          (function (lambda ()  
                      (message "Invalid Babyl format in inbox!")  
                      (sit-for 3)  
                      ;; Try to get back in sync with a real message.  
                      (if (re-search-forward  
                           (concat rmail-mmdf-delim1 "\\|^From") nil t)  
                          (beginning-of-line)  
                        (goto-char (point-max)))))))  
     (goto-char (point-min))  
     (save-restriction  
       (while (not (eobp))  
         (setq start (point))  
         (cond ((looking-at "BABYL OPTIONS:");Babyl header  
                (if (search-forward "\n\^_" nil t)  
                    ;; If we find the proper terminator, delete through there.  
                    (delete-region (point-min) (point))  
                  (funcall invalid-input-resync)  
                  (delete-region (point-min) (point))))  
               ;; Babyl format message  
               ((looking-at "\^L")  
                (or (search-forward "\n\^_" nil t)  
                    (funcall invalid-input-resync))  
                (setq count (1+ count))  
                ;; Make sure there is no extra white space after the ^_  
                ;; at the end of the message.  
                ;; Narrowing will make sure that whatever follows the junk  
                ;; will be treated properly.  
                (delete-region (point)  
                               (save-excursion  
                                 (skip-chars-forward " \t\n")  
                                 (point)))  
                (setq last-coding-system-used nil)  
                (or rmail-enable-mime  
                    (not rmail-enable-multibyte)  
                    (decode-coding-region start (point)  
                                          (or rmail-file-coding-system  
                                              'undecided)))  
                ;; Add an X-Coding-System: header if we don't have one.  
                (save-excursion  
                  (goto-char start)  
                  (forward-line 1)  
                  (if (looking-at "0")  
                      (forward-line 1)  
                    (forward-line 2))  
                  (or (save-restriction  
                        (narrow-to-region (point) (point-max))  
                        (rfc822-goto-eoh)  
                        (goto-char (point-min))  
                        (re-search-forward "^X-Coding-System:" nil t))  
                      (insert "X-Coding-System: "  
                              (symbol-name last-coding-system-used)  
                              "\n")))  
                (narrow-to-region (point) (point-max)))  
               ;;*** MMDF format  
               ((let ((case-fold-search t))  
                  (looking-at rmail-mmdf-delim1))  
                (let ((case-fold-search t))  
                  (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")  
                  (re-search-forward rmail-mmdf-delim2 nil t)  
                  (replace-match "\^_"))  
                (save-excursion  
                  (save-restriction  
                    (narrow-to-region start (1- (point)))  
                    (goto-char (point-min))  
                    (while (search-forward "\n\^_" nil t); single char "\^_"  
                      (replace-match "\n^_")))); 2 chars: "^" and "_"  
                (setq last-coding-system-used nil)  
                (or rmail-enable-mime  
                    (not rmail-enable-multibyte)  
                    (decode-coding-region start (point) 'undecided))  
                (save-excursion  
                  (goto-char start)  
                  (forward-line 3)  
                  (insert "X-Coding-System: "  
                          (symbol-name last-coding-system-used)  
                          "\n"))  
                (narrow-to-region (point) (point-max))  
                (setq count (1+ count)))  
               ;;*** Mail format  
               ((looking-at "^From ")  
                (insert "\^L\n0, unseen,,\n*** EOOH ***\n")  
                (rmail-nuke-pinhead-header)  
                ;; If this message has a Content-Length field,  
                ;; skip to the end of the contents.  
                (let* ((header-end (save-excursion  
                                     (and (re-search-forward "\n\n" nil t)  
                                          (1- (point)))))  
                       (case-fold-search t)  
                       (quoted-printable-header-field-end  
                        (save-excursion  
                          (re-search-forward  
                           "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"  
                           header-end t)))  
                       (size  
                        ;; Get the numeric value from the Content-Length field.  
                        (save-excursion  
                          ;; Back up to end of prev line,  
                          ;; in case the Content-Length field comes first.  
                          (forward-char -1)  
                          (and (search-forward "\ncontent-length: "  
                                               header-end t)  
                               (let ((beg (point))  
                                     (eol (progn (end-of-line) (point))))  
                                 (string-to-int (buffer-substring beg eol)))))))  
                  (and size  
                       (if (and (natnump size)  
                                (<= (+ header-end size) (point-max))  
                                ;; Make sure this would put us at a position  
                                ;; that we could continue from.  
                                (save-excursion  
                                  (goto-char (+ header-end size))  
                                  (skip-chars-forward "\n")  
                                  (or (eobp)  
                                      (and (looking-at "BABYL OPTIONS:")  
                                           (search-forward "\n\^_" nil t))  
                                      (and (looking-at "\^L")  
                                           (search-forward "\n\^_" nil t))  
                                      (let ((case-fold-search t))  
                                        (looking-at rmail-mmdf-delim1))  
                                      (looking-at "From "))))  
                           (goto-char (+ header-end size))  
                         (message "Ignoring invalid Content-Length field")  
                         (sit-for 1 0 t)))  
                  (if (let ((case-fold-search nil))  
                        (re-search-forward  
                         (concat "^[\^_]?\\("  
                                 rmail-unix-mail-delimiter  
                                 "\\|"  
                                 rmail-mmdf-delim1 "\\|"  
                                 "^BABYL OPTIONS:\\|"  
                                 "\^L\n[01],\\)") nil t))  
                      (goto-char (match-beginning 1))  
                    (goto-char (point-max)))  
                  (setq count (1+ count))  
                  (if quoted-printable-header-field-end  
                      (save-excursion  
                        (rmail-decode-quoted-printable header-end (point))  
                        ;; Change "quoted-printable" to "8bit",  
                        ;; to reflect the decoding we just did.  
                        (goto-char quoted-printable-header-field-end)  
                        (delete-region (point) (search-backward ":"))  
                        (insert ": 8bit"))))  
   
                (save-excursion  
                  (save-restriction  
                    (narrow-to-region start (point))  
                    (goto-char (point-min))  
                    (while (search-forward "\n\^_" nil t); single char  
                      (replace-match "\n^_")))); 2 chars: "^" and "_"  
                (insert ?\^_)  
                (setq last-coding-system-used nil)  
                (or rmail-enable-mime  
                    (not rmail-enable-multibyte)  
                    (let ((mime-charset  
                           (if (and rmail-decode-mime-charset  
                                    (save-excursion  
                                      (goto-char start)  
                                      (search-forward "\n\n" nil t)  
                                      (let ((case-fold-search t))  
                                        (re-search-backward  
                                         rmail-mime-charset-pattern  
                                         start t))))  
                               (intern (downcase (match-string 1))))))  
                      (rmail-decode-region start (point) mime-charset)))  
                (save-excursion  
                  (goto-char start)  
                  (forward-line 3)  
                  (insert "X-Coding-System: "  
                          (symbol-name last-coding-system-used)  
                          "\n"))  
                (narrow-to-region (point) (point-max)))  
               ;;  
               ;; This kludge is because some versions of sendmail.el  
               ;; insert an extra newline at the beginning that shouldn't  
               ;; be there.  sendmail.el has been fixed, but old versions  
               ;; may still be in use.  -- rms, 7 May 1993.  
               ((eolp) (delete-char 1))  
               (t (error "Cannot convert to babyl format")))))  
     count))  
   
1612  (defun rmail-hex-char-to-integer (character)  (defun rmail-hex-char-to-integer (character)
1613    "Return CHARACTER's value interpreted as a hex digit."    "Return CHARACTER's value interpreted as a hex digit."
1614    (if (and (>= character ?0) (<= character ?9))    (if (and (>= character ?0) (<= character ?9))
# Line 2201  change the invisible header text." Line 1949  change the invisible header text."
1949                          (rmail-desc-get-end rmail-current-message)))))                          (rmail-desc-get-end rmail-current-message)))))
1950    
1951  (defun rmail-process-new-messages (&optional nomsg)  (defun rmail-process-new-messages (&optional nomsg)
1952    "Process the new messages in the buffer.  The buffer has been    "Process the new messages in the buffer.
1953  narrowed to expose only the new messages.  For each new message append  The buffer has been narrowed to expose only the new messages.
1954  an entry to the message vector and, if necessary, add a header that  For each new message append an entry to the message vector and,
1955  will capture the salient BABYL information.  Return the number of new  if necessary, add a header that will capture the salient BABYL
1956  messages.  If NOMSG is non-nil then do not show any progress  information.  Return the number of new messages.  If NOMSG is
1957  messages."  non-nil then do not show any progress messages."
1958    (let ((inhibit-read-only t)    (let ((inhibit-read-only t)
1959          (case-fold-search nil)          (case-fold-search nil)
1960          (new-message-counter 0)          (new-message-counter 0)
# Line 2533  If NO-SUMMARY is non-nil, then do not up Line 2281  If NO-SUMMARY is non-nil, then do not up
2281          ;; Deal with the message headers and URLs..          ;; Deal with the message headers and URLs..
2282          (rmail-header-hide-headers)          (rmail-header-hide-headers)
2283          (rmail-highlight-headers)          (rmail-highlight-headers)
2284          (rmail-activate-urls)          (rmail-activate-urls)
2285    
2286          ;; ?          ;; ?
2287          (if transient-mark-mode (deactivate-mark))          (if transient-mark-mode (deactivate-mark))
# Line 3162  Normally include CC: to all other recipi Line 2910  Normally include CC: to all other recipi
2910  prefix argument means ignore them.  While composing the reply,  prefix argument means ignore them.  While composing the reply,
2911  use \\[mail-yank-original] to yank the original message into it."  use \\[mail-yank-original] to yank the original message into it."
2912    (interactive "P")    (interactive "P")
2913      (if (= rmail-total-messages 0)
2914          (error "No messages in this file"))
2915    (save-excursion    (save-excursion
2916      (save-restriction      (save-restriction
2917        (let ((msgnum rmail-current-message)        (let ((msgnum rmail-current-message)
# Line 3232  use \\[mail-yank-original] to yank the o Line 2982  use \\[mail-yank-original] to yank the o
2982                                            " " message-id))))))))                                            " " message-id))))))))
2983    
2984  (defun rmail-reply-callback (buffer attr state n)  (defun rmail-reply-callback (buffer attr state n)
2985    "Mail reply callback function. Sets ATTR (a string) if STATE is    "Mail reply callback function.
2986    non-nil, otherwise clears it.  N is the message number.  BUFFER,  Sets ATTR (a string) if STATE is
2987    possibly narrowed, contains an mbox mail message."  non-nil, otherwise clears it.  N is the message number.
2988    BUFFER, possibly narrowed, contains an mbox mail message."
2989    (save-excursion    (save-excursion
2990      (set-buffer buffer)      (set-buffer buffer)
2991      (rmail-set-attribute attr state n)))      (rmail-set-attribute attr state n)))
2992    
2993  (defun rmail-mark-message (msgnum-list attr-index)  (defun rmail-mark-message (msgnum-list attr-index)
2994    "Set the attribute denoted by ATTRIBUTE-INDEX in the message denoted    "Set attribute ATTRIBUTE-INDEX in the message of the car of MSGNUM-LIST.
2995  by the car of MSGNUM-LIST.  This is used in the send-actions for  This is used in the send-actions for
2996  message buffers.  MSGNUM-LIST is a list of the form (MSGNUM)."  message buffers.  MSGNUM-LIST is a list of the form (MSGNUM)."
2997    (save-excursion    (save-excursion
2998      (let ((n (car msgnum-list)))      (let ((n (car msgnum-list)))
# Line 3250  message buffers.  MSGNUM-LIST is a list Line 3001  message buffers.  MSGNUM-LIST is a list
3001        (rmail-desc-set-attribute attr-index t n))))        (rmail-desc-set-attribute attr-index t n))))
3002    
3003  (defun rmail-narrow-to-message (n)  (defun rmail-narrow-to-message (n)
3004    "Set the narrowing restriction in the current (rmail) buffer to    "Narrow the current (rmail) buffer to bracket message N."
   bracket message N."  
3005    (widen)    (widen)
3006    (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)))    (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)))
3007    
# Line 3320  message buffers.  MSGNUM-LIST is a list Line 3070  message buffers.  MSGNUM-LIST is a list
3070  With prefix argument, \"resend\" the message instead of forwarding it;  With prefix argument, \"resend\" the message instead of forwarding it;
3071  see the documentation of `rmail-resend'."  see the documentation of `rmail-resend'."
3072    (interactive "P")    (interactive "P")
3073      (if (= rmail-total-messages 0)
3074          (error "No messages in this file"))
3075    (if resend    (if resend
3076        (call-interactively 'rmail-resend)        (call-interactively 'rmail-resend)
3077      (let ((forward-buffer rmail-buffer)      (let ((forward-buffer rmail-buffer)
# Line 3382  Optional COMMENT is a string to insert a Line 3134  Optional COMMENT is a string to insert a
3134  Optional ALIAS-FILE is alternate aliases file to be used by sendmail,  Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
3135  typically for purposes of moderating a list."  typically for purposes of moderating a list."
3136    (interactive "sResend to: ")    (interactive "sResend to: ")
3137      (if (= rmail-total-messages 0)
3138          (error "No messages in this file"))
3139    (require 'sendmail)    (require 'sendmail)
3140    (require 'mailalias)    (require 'mailalias)
3141    (unless (or (eq rmail-view-buffer (current-buffer))    (unless (or (eq rmail-view-buffer (current-buffer))
# Line 3491  delimits the returned original message. Line 3245  delimits the returned original message.
3245  The variable `rmail-retry-ignored-headers' is a regular expression  The variable `rmail-retry-ignored-headers' is a regular expression
3246  specifying headers which should not be copied into the new message."  specifying headers which should not be copied into the new message."
3247    (interactive)    (interactive)
3248      (if (= rmail-total-messages 0)
3249          (error "No messages in this file"))
3250    (require 'mail-utils)    (require 'mail-utils)
3251    (let ((rmail-this-buffer (current-buffer))    (let ((rmail-this-buffer (current-buffer))
3252          (msgnum rmail-current-message)          (msgnum rmail-current-message)
# Line 3878  encoded string (and the same mask) will Line 3634  encoded string (and the same mask) will
3634  (defun rmail-browse-body ()  (defun rmail-browse-body ()
3635    "Send the message body to a browser to be rendered."    "Send the message body to a browser to be rendered."
3636    (interactive)    (interactive)
3637      (if (= rmail-total-messages 0)
3638          (error "No messages in this file"))
3639    (save-excursion    (save-excursion
3640      (save-restriction      (save-restriction
3641        (goto-char (point-min))        (goto-char (point-min))

Legend:
Removed from v.1.368.2.5  
changed lines
  Added in v.1.368.2.6

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