/[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 by jpw, Mon Jan 6 16:02:29 2003 UTC revision 1.368.2.1 by pmr, Sat Feb 15 13:36:53 2003 UTC
# Line 38  Line 38 
38  ;;   buffers, summary by topic or by regular expression, rmail-reply-prefix  ;;   buffers, summary by topic or by regular expression, rmail-reply-prefix
39  ;;   variable, and a bury rmail buffer (wipe) command.  ;;   variable, and a bury rmail buffer (wipe) command.
40  ;;  ;;
41    (provide 'rmail)
42    
43  (require 'mail-utils)  (eval-when-compile
44  (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority    (require 'font-lock)
45      (require 'mailabbrev)
46      (require 'mule-util)                ; for detect-coding-with-priority
47      (require 'rmailout)
48      (require 'rmailsum))
49    
50    (eval-and-compile
51      (require 'browse-url)
52      (require 'rmaildesc)
53      (require 'rmailhdr))
54    
55  ; These variables now declared in paths.el.  ; These variables now declared in paths.el.
56  ;(defvar rmail-spool-directory "/usr/spool/mail/"  ;(defvar rmail-spool-directory "/usr/spool/mail/"
# Line 91  Line 101 
101    :prefix "rmail-edit-"    :prefix "rmail-edit-"
102    :group 'rmail)    :group 'rmail)
103    
   
104  (defcustom rmail-movemail-program nil  (defcustom rmail-movemail-program nil
105    "If non-nil, name of program for fetching new mail."    "If non-nil, name of program for fetching new mail."
106    :group 'rmail-retrieve    :group 'rmail-retrieve
# Line 148  It is useful to set this variable in the Line 157  It is useful to set this variable in the
157    
158  ;;;###autoload  ;;;###autoload
159  (defcustom rmail-ignored-headers  (defcustom rmail-ignored-headers
160    (concat "^via:\\|^mail-from:\\|^origin:\\|^references:"    (concat "^via:\\|^from \\|^origin:\\|^references:"
161            "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"            "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
162            "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"            "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
163            "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"            "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
# Line 161  It is useful to set this variable in the Line 170  It is useful to set this variable in the
170            "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"            "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
171            "\\|^content-type:\\|^content-length:"            "\\|^content-type:\\|^content-length:"
172            "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:"            "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:"
173            "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent"            "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:"
174            "\\|^importance:\\|^envelope-to:\\|^delivery-date"            "\\|^x-importance:\\|^envelope-to:\\|^delivery-date:"
175            "\\|^x.*-priority:\\|^x-mimeole:")            "\\|^x-importance:\\|^envelope-to:\\|^delivery-date:"
176              "\\|^x-*-priority:\\|x-mimeole:"
177              "\\|^x-babyl-v6-attributes:\\|x-babyl-v6-keywords:")
178    "*Regexp to match header fields that Rmail should normally hide.    "*Regexp to match header fields that Rmail should normally hide.
179  This variable is used for reformatting the message header,  This variable is used for reformatting the message header,
180  which normally happens once for each message,  which normally happens once for each message,
# Line 175  go to that message and type \\[rmail-tog Line 186  go to that message and type \\[rmail-tog
186    :group 'rmail-headers)    :group 'rmail-headers)
187    
188  ;;;###autoload  ;;;###autoload
189  (defcustom rmail-displayed-headers nil  (defcustom rmail-displayed-headers "\
190    ^\\(to\\|from\\|sender\\|cc\\|date\\|subject\\|reply-to\\):[ \t]+"
191    "*Regexp to match Header fields that Rmail should display.    "*Regexp to match Header fields that Rmail should display.
192  If nil, display all header fields except those matched by  If nil, display all header fields except those matched by
193  `rmail-ignored-headers'."  `rmail-ignored-headers'."
# Line 298  Each element of the list is of the form: Line 310  Each element of the list is of the form:
310    
311    (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )    (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
312    
313  Where FOLDERNAME is the name of a BABYL format folder to put the  Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox
314  message.  If any of the field regexp's are nil, then it is ignored.  or Unix inbox format) folder to put the message.  If any of the field
315    regexp's are nil, then it is ignored.
316    
317  If FOLDERNAME is \"/dev/null\", it is deleted.  If FOLDERNAME is \"/dev/null\", it is deleted.
318  If FOLDERNAME is nil then it is deleted, and skipped.  If FOLDERNAME is nil then it is deleted, and skipped.
# Line 351  In a summary buffer, this holds the RMAI Line 364  In a summary buffer, this holds the RMAI
364  (defvar rmail-total-messages nil)  (defvar rmail-total-messages nil)
365  (put 'rmail-total-messages 'permanent-local t)  (put 'rmail-total-messages 'permanent-local t)
366    
367    ;;; mbox: deprecated. -pmr
368  (defvar rmail-message-vector nil)  (defvar rmail-message-vector nil)
369  (put 'rmail-message-vector 'permanent-local t)  (put 'rmail-message-vector 'permanent-local t)
370    
371    ;;; mbox: deprecated. -pmr
372  (defvar rmail-deleted-vector nil)  (defvar rmail-deleted-vector nil)
373  (put 'rmail-deleted-vector 'permanent-local t)  (put 'rmail-deleted-vector 'permanent-local t)
374    
375    ;; mbox: deprecated. -pmr
376  (defvar rmail-msgref-vector nil  (defvar rmail-msgref-vector nil
377    "In an Rmail buffer, a vector whose Nth element is a list (N).    "In an Rmail buffer, a vector whose Nth element is a list (N).
378  When expunging renumbers messages, these lists are modified  When expunging renumbers messages, these lists are modified
# Line 393  by substituting the new message number i Line 409  by substituting the new message number i
409    "*Default file name for \\[rmail-output]."    "*Default file name for \\[rmail-output]."
410    :type 'file    :type 'file
411    :group 'rmail-files)    :group 'rmail-files)
412    
413  (defcustom rmail-default-rmail-file "~/XMAIL"  (defcustom rmail-default-rmail-file "~/XMAIL"
414    "*Default file name for \\[rmail-output-to-rmail-file]."    "*Default file name for \\[rmail-output-to-rmail-file]."
415    :type 'file    :type 'file
416    :group 'rmail-files)    :group 'rmail-files)
417    
418  (defcustom rmail-default-body-file "~/mailout"  (defcustom rmail-default-body-file "~/mailout"
419    "*Default file name for \\[rmail-output-body-to-file]."    "*Default file name for \\[rmail-output-body-to-file]."
420    :type 'file    :type 'file
# Line 488  The first parenthesized expression shoul Line 506  The first parenthesized expression shoul
506    
507    
508  ;;; Regexp matching the delimiter of messages in UNIX mail format  ;;; Regexp matching the delimiter of messages in UNIX mail format
509  ;;; (UNIX From lines), minus the initial ^.  Note that if you change  ;;; (UNIX From lines), with an initial ^.  Used in rmail-decode-from-line,
510  ;;; this expression, you must change the code in rmail-nuke-pinhead-header  ;;; which knows the exact ordering of the \\(...\\) subexpressions.
 ;;; that knows the exact ordering of the \\( \\) subexpressions.  
511  (defvar rmail-unix-mail-delimiter  (defvar rmail-unix-mail-delimiter
512    (let ((time-zone-regexp    (let ((time-zone-regexp
513           (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"           (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
# Line 498  The first parenthesized expression shoul Line 515  The first parenthesized expression shoul
515                   "\\|"                   "\\|"
516                   "\\) *")))                   "\\) *")))
517      (concat      (concat
518       "From "       "^From "
519    
520       ;; Many things can happen to an RFC 822 mailbox before it is put into       ;; Many things can happen to an RFC 822 mailbox before it is put into
521       ;; a `From' line.  The leading phrase can be stripped, e.g.       ;; a `From' line.  The leading phrase can be stripped, e.g.
# Line 549  The first parenthesized expression shoul Line 566  The first parenthesized expression shoul
566      (let* ((cite-chars "[>|}]")      (let* ((cite-chars "[>|}]")
567             (cite-prefix "a-z")             (cite-prefix "a-z")
568             (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))             (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
569        (list '("^\\(From\\|Sender\\|Resent-From\\):"        (list '("^\\(From\\|Sender\\|Resent-[Ff]rom\\):"
570                . font-lock-function-name-face)                . font-lock-function-name-face)
571              '("^Reply-To:.*$" . font-lock-function-name-face)              '("^Reply-To:.*$" . font-lock-function-name-face)
572              '("^Subject:" . font-lock-comment-face)              '("^Subject:" . font-lock-comment-face)
573              '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"              '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
# Line 564  The first parenthesized expression shoul Line 581  The first parenthesized expression shoul
581                 (beginning-of-line) (end-of-line)                 (beginning-of-line) (end-of-line)
582                 (2 font-lock-constant-face nil t)                 (2 font-lock-constant-face nil t)
583                 (4 font-lock-comment-face nil t)))                 (4 font-lock-comment-face nil t)))
584              '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"              '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
585                . font-lock-string-face))))                . font-lock-string-face))))
586    "Additional expressions to highlight in Rmail mode.")    "Additional expressions to highlight in Rmail mode.")
587    
# Line 598  The first parenthesized expression shoul Line 615  The first parenthesized expression shoul
615    
616  (defvar rmail-enable-multibyte nil)  (defvar rmail-enable-multibyte nil)
617    
618    ;;; mbox don't care
619  (defun rmail-require-mime-maybe ()  (defun rmail-require-mime-maybe ()
620    "Require `rmail-mime-feature' if that is non-nil.    "Require `rmail-mime-feature' if that is non-nil.
621  Signal an error and set `rmail-mime-feature' to nil if the feature  Signal an error and set `rmail-mime-feature' to nil if the feature
# Line 612  isn't provided." Line 629  isn't provided."
629         (setq rmail-enable-mime nil)))))         (setq rmail-enable-mime nil)))))
630    
631    
632    ;;; mbox ready
633  ;;;###autoload  ;;;###autoload
634  (defun rmail (&optional file-name-arg)  (defun rmail (&optional file-name-arg)
635    "Read and edit incoming mail.    "Read and edit incoming mail.
# Line 674  If `rmail-display-summary' is non-nil, m Line 692  If `rmail-display-summary' is non-nil, m
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.        ;; Convert all or part to Babyl file if possible.
695        (rmail-convert-file)  ;;;      (rmail-convert-file)
696        (goto-char (point-max)))        (goto-char (point-max)))
697      ;; 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
698      ;; unibyte.  We must make it multibyte if necessary.      ;; unibyte.  We must make it multibyte if necessary.
699      (if (and rmail-enable-multibyte      (if (and rmail-enable-multibyte
700               (not enable-multibyte-characters))               (not enable-multibyte-characters))
701          (set-buffer-multibyte t))          (set-buffer-multibyte t))
702      ;; If necessary, scan to find all the messages.  
703      (rmail-maybe-set-message-counters)      ;; Initialize the Rmail state and process any messages in the buffer.
704      (unwind-protect      (rmail-initialize-messages)
705          (unless (and (not file-name-arg)  
706                       (rmail-get-new-mail))      ;; Get new mail only if there is no explicit file argument.
707            (rmail-show-message (rmail-first-unseen-message)))      (and (not file-name-arg) (rmail-get-new-mail))
708        (progn  
709          (if rmail-display-summary (rmail-summary))      ;; Deal with the summary display.
710          (rmail-construct-io-menu)      (if rmail-display-summary (rmail-summary))
711          (if run-mail-hook  
712              (run-hooks 'rmail-mode-hook))))))      ;; Show the first unseen message or, if all messages have been
713        ;; seen, the last message.
714        (rmail-show-message (or (rmail-first-unseen-message)
715                                rmail-total-messages))
716    
717        ;; Not sure what this is all about.
718        (rmail-construct-io-menu)
719    
720        ;; Run any User callbacks.
721        (if run-mail-hook
722            (run-hooks 'rmail-mode-hook))))
723    
724  ;; Given the value of MAILPATH, return a list of inbox file names.  ;; Given the value of MAILPATH, return a list of inbox file names.
725  ;; This is turned off because it is not clear that the user wants  ;; This is turned off because it is not clear that the user wants
# Line 712  If `rmail-display-summary' is non-nil, m Line 740  If `rmail-display-summary' is non-nil, m
740    
741  ;; This calls rmail-decode-babyl-format if the file is already Babyl.  ;; This calls rmail-decode-babyl-format if the file is already Babyl.
742    
743    ;;; mbox: DEPECATED
744  (defun rmail-convert-file ()  (defun rmail-convert-file ()
745    (let (convert)    (let (convert)
746      (widen)      (widen)
# Line 756  If `rmail-display-summary' is non-nil, m Line 785  If `rmail-display-summary' is non-nil, m
785            ;; We still have to decode BABYL part.            ;; We still have to decode BABYL part.
786            (rmail-decode-babyl-format)))))            (rmail-decode-babyl-format)))))
787    
788    ;;;###deprecated
789  (defun rmail-insert-rmail-file-header ()  (defun rmail-insert-rmail-file-header ()
790    (let ((buffer-read-only nil))    (let ((buffer-read-only nil)
791      ;; -*-rmail-*- is here so that visiting the file normally          (header-line "X-BABYL: -*-rmail-*-"))
792      ;; recognizes it as an Rmail file.      ;; Determine if the header has already been inserted.
793      (insert "BABYL OPTIONS: -*- rmail -*-      (goto-char (point-min))
794  Version: 5      (if (not (looking-at "X-BABYL: "))
795            ;; The header has not been inserted.  Insert -*-rmail-*- here
796            ;; so that visiting the file normally recognizes it as an
797            ;; Rmail file.
798            (insert (concat header-line "\nX-BABYL-Version: 6
799    Version: 6
800  Labels:  Labels:
801  Note:   This is the header of an rmail file.  Note:   This is the header of an rmail file.
802  Note:   If you are seeing it in rmail,  Note:   If you are seeing it in rmail,
803  Note:    it means the file has no messages in it.\n\^_")))  Note:    it means the file has no messages in it.")))))
804    
805    (defun rmail-initialize-messages ()
806      "Initialize message state and process the messages in the buffer to
807      update message state."
808      (setq rmail-total-messages 0
809            rmail-current-message 1)
810      (rmail-desc-clear-descriptors)
811      (widen)
812      (rmail-header-show-headers)
813      (setq rmail-total-messages (rmail-process-new-messages)))
814    
815  ;; Decode Babyl formatted part at the head of current buffer by  ;; Decode Babyl formatted part at the head of current buffer by
816  ;; rmail-file-coding-system, or if it is nil, do auto conversion.  ;; rmail-file-coding-system, or if it is nil, do auto conversion.
# Line 805  Note:    it means the file has no messag Line 850  Note:    it means the file has no messag
850            (or coding-system 'undecided))))            (or coding-system 'undecided))))
851    
852  (defvar rmail-mode-map nil)  (defvar rmail-mode-map nil)
853    (defvar rmail-url-map nil)
854  (if rmail-mode-map  (if rmail-mode-map
855      nil      nil
856    (setq rmail-mode-map (make-keymap))    (setq rmail-mode-map (make-keymap))
857    (suppress-keymap rmail-mode-map)    (suppress-keymap rmail-mode-map)
858    (define-key rmail-mode-map "a"      'rmail-add-label)    (define-key rmail-mode-map "a"      'rmail-add-label)
859    (define-key rmail-mode-map "b"      'rmail-bury)    (define-key rmail-mode-map "b"      'rmail-bury)
860      (define-key rmail-mode-map "B"      'rmail-browse-body)
861    (define-key rmail-mode-map "c"      'rmail-continue)    (define-key rmail-mode-map "c"      'rmail-continue)
862    (define-key rmail-mode-map "d"      'rmail-delete-forward)    (define-key rmail-mode-map "d"      'rmail-delete-forward)
863    (define-key rmail-mode-map "\C-d"   'rmail-delete-backward)    (define-key rmail-mode-map "\C-d"   'rmail-delete-backward)
# Line 819  Note:    it means the file has no messag Line 866  Note:    it means the file has no messag
866    (define-key rmail-mode-map "g"      'rmail-get-new-mail)    (define-key rmail-mode-map "g"      'rmail-get-new-mail)
867    (define-key rmail-mode-map "h"      'rmail-summary)    (define-key rmail-mode-map "h"      'rmail-summary)
868    (define-key rmail-mode-map "i"      'rmail-input)    (define-key rmail-mode-map "i"      'rmail-input)
869    (define-key rmail-mode-map "j"      'rmail-show-message)    (define-key rmail-mode-map "j"      'rmail-message)
870    (define-key rmail-mode-map "k"      'rmail-kill-label)    (define-key rmail-mode-map "k"      'rmail-kill-label)
871    (define-key rmail-mode-map "l"      'rmail-summary-by-labels)    (define-key rmail-mode-map "l"      'rmail-summary-by-labels)
872    (define-key rmail-mode-map "\e\C-h" 'rmail-summary)    (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
# Line 832  Note:    it means the file has no messag Line 879  Note:    it means the file has no messag
879    (define-key rmail-mode-map "n"      'rmail-next-undeleted-message)    (define-key rmail-mode-map "n"      'rmail-next-undeleted-message)
880    (define-key rmail-mode-map "\en"    'rmail-next-message)    (define-key rmail-mode-map "\en"    'rmail-next-message)
881    (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)    (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
882    (define-key rmail-mode-map "o"      'rmail-output-to-rmail-file)    (define-key rmail-mode-map "o"      'rmail-output)
883    (define-key rmail-mode-map "\C-o"   'rmail-output)    (define-key rmail-mode-map "\C-o"   'rmail-output)
884    (define-key rmail-mode-map "p"      'rmail-previous-undeleted-message)    (define-key rmail-mode-map "p"      'rmail-previous-undeleted-message)
885    (define-key rmail-mode-map "\ep"    'rmail-previous-message)    (define-key rmail-mode-map "\ep"    'rmail-previous-message)
# Line 862  Note:    it means the file has no messag Line 909  Note:    it means the file has no messag
909    (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels)    (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
910    (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)    (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
911    (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)    (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
912    )  
913      ;; Set up a keymap derived from the standard Rmail mode keymap to
914      ;; send activated URLs to a browser.
915      (setq rmail-url-map (make-sparse-keymap))
916      (set-keymap-parent rmail-url-map rmail-mode-map)
917      (define-key rmail-url-map [mouse-2] 'rmail-visit-url-at-mouse)
918      (define-key rmail-url-map "\r" 'rmail-visit-url-at-point))
919    
920  (define-key rmail-mode-map [menu-bar] (make-sparse-keymap))  (define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
921    
# Line 882  Note:    it means the file has no messag Line 935  Note:    it means the file has no messag
935    '("Output (inbox)..." . rmail-output))    '("Output (inbox)..." . rmail-output))
936    
937  (define-key rmail-mode-map [menu-bar classify output]  (define-key rmail-mode-map [menu-bar classify output]
938    '("Output (Rmail)..." . rmail-output-to-rmail-file))    '("Output (Rmail)..." . rmail-output))
939    
940  (define-key rmail-mode-map [menu-bar classify kill-label]  (define-key rmail-mode-map [menu-bar classify kill-label]
941    '("Kill Label..." . rmail-kill-label))    '("Kill Label..." . rmail-kill-label))
# Line 1153  Instead, these commands are available: Line 1206  Instead, these commands are available:
1206          (progn          (progn
1207            (set-buffer rmail-buffer)            (set-buffer rmail-buffer)
1208            (rmail-mode-2)            (rmail-mode-2)
1209            ;; Convert all or part to Babyl file if possible.  
           (rmail-convert-file)  
1210            ;; We have read the file as raw-text, so the buffer is set to            ;; We have read the file as raw-text, so the buffer is set to
1211            ;; unibyte.  Make it multibyte if necessary.            ;; unibyte.  Make it multibyte if necessary.
1212            (if (and rmail-enable-multibyte            (if (and rmail-enable-multibyte
1213                     (not enable-multibyte-characters))                     (not enable-multibyte-characters))
1214                (set-buffer-multibyte t))                (set-buffer-multibyte t))
1215            (goto-char (point-max))            (rmail-initialize-messages)
           (rmail-set-message-counters)  
1216            (rmail-show-message rmail-total-messages)            (rmail-show-message rmail-total-messages)
1217            (run-hooks 'rmail-mode-hook)))))            (run-hooks 'rmail-mode-hook)))))
1218    
1219    ;; NOT DONE
1220  ;; Return a list of files from this buffer's Mail: option.  ;; Return a list of files from this buffer's Mail: option.
1221  ;; Does not assume that messages have been parsed.  ;; Does not assume that messages have been parsed.
1222  ;; Just returns nil if buffer does not look like Babyl format.  ;; Just returns nil if buffer does not look like Babyl format.
# Line 1183  Instead, these commands are available: Line 1235  Instead, these commands are available:
1235                     (goto-char (point-min))                     (goto-char (point-min))
1236                     (mail-parse-comma-list))))))))                     (mail-parse-comma-list))))))))
1237    
1238    ;;; mbox: ready
1239  (defun rmail-expunge-and-save ()  (defun rmail-expunge-and-save ()
1240    "Expunge and save RMAIL file."    "Expunge and save RMAIL file."
1241    (interactive)    (interactive)
1242    (rmail-expunge)    (rmail-expunge)
   (set-buffer rmail-buffer)  
1243    (save-buffer)    (save-buffer)
1244      (rmail-display-summary-maybe))
1245    
1246    ;;; mbox: ready
1247    (defun rmail-display-summary-maybe ()
1248      "If a summary buffer exists then make sure it is updated and displayed."
1249    (if (rmail-summary-exists)    (if (rmail-summary-exists)
1250        (rmail-select-summary (set-buffer-modified-p nil))))        (let ((current-message rmail-current-message))
1251            (rmail-select-summary
1252             (rmail-summary-goto-msg current-message)
1253             (rmail-summary-rmail-update)
1254             (set-buffer-modified-p nil)))))
1255    
1256    ;;; mbox: ready
1257  (defun rmail-quit ()  (defun rmail-quit ()
1258    "Quit out of RMAIL.    "Quit out of RMAIL.
1259  Hook `rmail-quit-hook' is run after expunging."  Hook `rmail-quit-hook' is run after expunging."
# Line 1215  Hook `rmail-quit-hook' is run after expu Line 1277  Hook `rmail-quit-hook' is run after expu
1277        (quit-window)        (quit-window)
1278        (replace-buffer-in-windows obuf))))        (replace-buffer-in-windows obuf))))
1279    
1280    ;;; mbox: ready
1281  (defun rmail-bury ()  (defun rmail-bury ()
1282    "Bury current Rmail buffer and its summary buffer."    "Bury current Rmail buffer and its summary buffer."
1283    (interactive)    (interactive)
# Line 1228  Hook `rmail-quit-hook' is run after expu Line 1291  Hook `rmail-quit-hook' is run after expu
1291            (bury-buffer rmail-summary-buffer)))            (bury-buffer rmail-summary-buffer)))
1292      (quit-window)))      (quit-window)))
1293    
1294    ;;; mbox: not ready
1295  (defun rmail-duplicate-message ()  (defun rmail-duplicate-message ()
1296    "Create a duplicated copy of the current message.    "Create a duplicated copy of the current message.
1297  The duplicate copy goes into the Rmail file just after the  The duplicate copy goes into the Rmail file just after the
# Line 1236  original copy." Line 1300  original copy."
1300    (widen)    (widen)
1301    (let ((buffer-read-only nil)    (let ((buffer-read-only nil)
1302          (number rmail-current-message)          (number rmail-current-message)
1303          (string (buffer-substring (rmail-msgbeg rmail-current-message)          (string (buffer-substring (rmail-desc-get-start rmail-current-message)
1304                                    (rmail-msgend rmail-current-message))))                                    (rmail-desc-get-end rmail-current-message))))
1305      (goto-char (rmail-msgend rmail-current-message))      (goto-char (rmail-desc-get-end rmail-current-message))
1306      (insert string)      (insert string)
1307      (rmail-forget-messages)      (rmail-forget-messages)
1308      (rmail-show-message number)      (rmail-show-message number)
# Line 1311  original copy." Line 1375  original copy."
1375              (cons "Output Rmail File"              (cons "Output Rmail File"
1376                    (rmail-list-to-menu "Output Rmail File"                    (rmail-list-to-menu "Output Rmail File"
1377                                        files                                        files
1378                                        'rmail-output-to-rmail-file))))                                        'rmail-output))))
1379    
1380        (define-key rmail-mode-map [menu-bar classify input-menu]        (define-key rmail-mode-map [menu-bar classify input-menu]
1381          '("Input Rmail File" . rmail-disable-menu))          '("Input Rmail File" . rmail-disable-menu))
# Line 1324  original copy." Line 1388  original copy."
1388  ;; RLK feature not added in this version:  ;; RLK feature not added in this version:
1389  ;; argument specifies inbox file or files in various ways.  ;; argument specifies inbox file or files in various ways.
1390    
1391    ;;; DOC NOT DONE
1392  (defun rmail-get-new-mail (&optional file-name)  (defun rmail-get-new-mail (&optional file-name)
1393    "Move any new mail from this RMAIL file's inbox files.    "Move any new mail from this RMAIL file's inbox files.
1394  The inbox files can be specified with the file's Mail: option.  The  The inbox files can be specified with the file's Mail: option.  The
# Line 1350  It returns t if it got any new messages. Line 1415  It returns t if it got any new messages.
1415    (or (verify-visited-file-modtime (current-buffer))    (or (verify-visited-file-modtime (current-buffer))
1416        (find-file (buffer-file-name)))        (find-file (buffer-file-name)))
1417    (set-buffer rmail-buffer)    (set-buffer rmail-buffer)
   (rmail-maybe-set-message-counters)  
1418    (widen)    (widen)
1419    ;; Get rid of all undo records for this buffer.    ;; Get rid of all undo records for this buffer.
1420    (or (eq buffer-undo-list t)    (or (eq buffer-undo-list t)
# Line 1358  It returns t if it got any new messages. Line 1422  It returns t if it got any new messages.
1422    (let ((all-files (if file-name (list file-name)    (let ((all-files (if file-name (list file-name)
1423                       rmail-inbox-list))                       rmail-inbox-list))
1424          (rmail-enable-multibyte (default-value 'enable-multibyte-characters))          (rmail-enable-multibyte (default-value 'enable-multibyte-characters))
1425          found)          found current-message)
1426      (unwind-protect      (unwind-protect
1427          (progn          (progn
1428            (while all-files            (while all-files
# Line 1371  It returns t if it got any new messages. Line 1435  It returns t if it got any new messages.
1435                    (buffer-read-only nil)                    (buffer-read-only nil)
1436                    ;; Don't make undo records for what we do in getting mail.                    ;; Don't make undo records for what we do in getting mail.
1437                    (buffer-undo-list t)                    (buffer-undo-list t)
                   success  
1438                    ;; Files to insert this time around.                    ;; Files to insert this time around.
1439                    files                    files
1440                    ;; Last names of those files.                    ;; Last names of those files.
# Line 1390  It returns t if it got any new messages. Line 1453  It returns t if it got any new messages.
1453                ;; Put them back in their original order.                ;; Put them back in their original order.
1454                (setq files (nreverse files))                (setq files (nreverse files))
1455    
               (goto-char (point-max))  
               (skip-chars-backward " \t\n") ; just in case of brain damage  
               (delete-region (point) (point-max)) ; caused by require-final-newline  
1456                (save-excursion                (save-excursion
1457                  (save-restriction                  (save-restriction
1458                      (goto-char (point-max))
1459                    (narrow-to-region (point) (point))                    (narrow-to-region (point) (point))
1460                    ;; Read in the contents of the inbox files,                    ;; Read in the contents of the inbox files,
1461                    ;; renaming them as necessary,                    ;; renaming them as necessary,
# Line 1402  It returns t if it got any new messages. Line 1463  It returns t if it got any new messages.
1463                    (if file-name                    (if file-name
1464                        (rmail-insert-inbox-text files nil)                        (rmail-insert-inbox-text files nil)
1465                      (setq delete-files (rmail-insert-inbox-text files t)))                      (setq delete-files (rmail-insert-inbox-text files t)))
1466                    ;; Scan the new text and convert each message to babyl format.                    (unless (equal (point-min) (point-max))
1467                    (goto-char (point-min))                      (setq new-messages (rmail-process-new-messages)
1468                    (unwind-protect                            rmail-current-message (1+ rmail-total-messages)
1469                        (save-excursion                            rmail-total-messages (rmail-desc-get-count))
1470                          (setq new-messages (rmail-convert-to-babyl-format)                      (run-hooks 'rmail-get-new-mail-hook)
1471                                success t))                      (save-buffer))
1472                      ;; Try to delete the garbage just inserted.                    ;; Delete the old files, now that the RMAIL file is saved.
                     (or success (delete-region (point-min) (point-max)))  
                     ;; If we could not convert the file's inboxes,  
                     ;; rename the files we tried to read  
                     ;; so we won't over and over again.  
                     (if (and (not file-name) (not success))  
                         (let ((delfiles delete-files)  
                               (count 0))  
                           (while delfiles  
                             (while (file-exists-p (format "RMAILOSE.%d" count))  
                               (setq count (1+ count)))  
                             (rename-file (car delfiles)  
                                          (format "RMAILOSE.%d" count))  
                             (setq delfiles (cdr delfiles))))))  
                   (or (zerop new-messages)  
                       (let (success)  
                         (widen)  
                         (search-backward "\n\^_" nil t)  
                         (narrow-to-region (point) (point-max))  
                         (goto-char (1+ (point-min)))  
                         (rmail-count-new-messages)  
                         (run-hooks 'rmail-get-new-mail-hook)  
                         (save-buffer)))  
                   ;; Delete the old files, now that babyl file is saved.  
1473                    (while delete-files                    (while delete-files
1474                      (condition-case ()                      (condition-case ()
1475                          ;; First, try deleting.                          ;; First, try deleting.
# Line 1446  It returns t if it got any new messages. Line 1484  It returns t if it got any new messages.
1484                    (progn (goto-char opoint)                    (progn (goto-char opoint)
1485                           (if (or file-name rmail-inbox-list)                           (if (or file-name rmail-inbox-list)
1486                               (message "(No new mail has arrived)")))                               (message "(No new mail has arrived)")))
1487    
1488                    ;; Make the first unseen message the current message
1489                    ;; and update the summary buffer, if one exists.
1490                    (setq current-message (rmail-first-unseen-message))
1491                  (if (rmail-summary-exists)                  (if (rmail-summary-exists)
1492                      (rmail-select-summary                      (with-current-buffer rmail-summary-buffer
1493                       (rmail-update-summary)))                        (rmail-update-summary)
1494                          (rmail-summary-goto-msg current-message))
1495                      (rmail-show-message current-message))
1496                    (run-hooks 'rmail-after-get-new-mail-hook)
1497                  (message "%d new message%s read"                  (message "%d new message%s read"
1498                           new-messages (if (= 1 new-messages) "" "s"))                           new-messages (if (= 1 new-messages) "" "s"))
                 ;; Move to the first new message  
                 ;; unless we have other unseen messages before it.  
                 (rmail-show-message (rmail-first-unseen-message))  
                 (run-hooks 'rmail-after-get-new-mail-hook)  
1499                  (setq found t))))                  (setq found t))))
1500            found)            found)
1501        ;; Don't leave the buffer screwed up if we get a disk-full error.        ;; Don't leave the buffer screwed up if we get a disk-full error.
# Line 1617  It returns t if it got any new messages. Line 1658  It returns t if it got any new messages.
1658    (decode-coding-region from to coding))    (decode-coding-region from to coding))
1659    
1660  ;; the  rmail-break-forwarded-messages  feature is not implemented  ;; the  rmail-break-forwarded-messages  feature is not implemented
1661    ;;; NOT DONE  but not called any more
1662  (defun rmail-convert-to-babyl-format ()  (defun rmail-convert-to-babyl-format ()
1663    (let ((count 0) start    (let ((count 0) start
1664          (case-fold-search nil)          (case-fold-search nil)
# Line 1745  It returns t if it got any new messages. Line 1787  It returns t if it got any new messages.
1787                          (message "Ignoring invalid Content-Length field")                          (message "Ignoring invalid Content-Length field")
1788                          (sit-for 1 0 t)))                          (sit-for 1 0 t)))
1789                   (if (let ((case-fold-search nil))                   (if (let ((case-fold-search nil))
1790                         (re-search-forward                         (re-search-forward
1791                          (concat "^[\^_]?\\("                          (concat "^[\^_]?\\("
1792                                  rmail-unix-mail-delimiter                                  rmail-unix-mail-delimiter
1793                                  "\\|"                                  "\\|"
1794                                  rmail-mmdf-delim1 "\\|"                                  rmail-mmdf-delim1 "\\|"
1795                                  "^BABYL OPTIONS:\\|"                                  "^BABYL OPTIONS:\\|"
1796                                  "\^L\n[01],\\)") nil t))                                  "\^L\n[01],\\)") nil t))
1797                       (goto-char (match-beginning 1))                       (goto-char (match-beginning 1))
1798                     (goto-char (point-max)))                     (goto-char (point-max)))
1799                   (setq count (1+ count))                   (setq count (1+ count))
1800                   (if quoted-printable-header-field-end                   (if quoted-printable-header-field-end
# Line 1840  It returns t if it got any new messages. Line 1882  It returns t if it got any new messages.
1882            (t            (t
1883             (message "Malformed MIME quoted-printable message")))))             (message "Malformed MIME quoted-printable message")))))
1884    
1885    ;;; DEPRECATED -pmr
1886  ;; Delete the "From ..." line, creating various other headers with  ;; Delete the "From ..." line, creating various other headers with
1887  ;; information from it if they don't already exist.  Now puts the  ;; information from it if they don't already exist.  Now puts the
1888  ;; original line into a mail-from: header line for debugging and for  ;; original line into a mail-from: header line for debugging and for
# Line 1961  Otherwise, delete all header fields whos Line 2004  Otherwise, delete all header fields whos
2004                                 (1- (point))                                 (1- (point))
2005                               (point-max)))))))))                               (point-max)))))))))
2006    
2007  (defun rmail-msg-is-pruned ()  (defun rmail-msg-is-pruned (&optional msg)
2008    (rmail-maybe-set-message-counters)    "Determine if the headers for the current message are being
2009    (save-restriction    displayed. If MSG is non-nil it will be used as the message number
2010      (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))    instead of the current message."
2011      (save-excursion    (rmail-desc-get-header-display-state (or msg rmail-current-message)))
       (goto-char (point-min))  
       (forward-line 1)  
       (= (following-char) ?1))))  
2012    
2013  (defun rmail-msg-restore-non-pruned-header ()  (defun rmail-msg-restore-non-pruned-header ()
2014    (let ((old-point (point))    (let ((old-point (point))
# Line 2018  Otherwise, delete all header fields whos Line 2058  Otherwise, delete all header fields whos
2058  With argument ARG, show the message header pruned if ARG is greater than zero;  With argument ARG, show the message header pruned if ARG is greater than zero;
2059  otherwise, show it in full."  otherwise, show it in full."
2060    (interactive "P")    (interactive "P")
2061    (let* ((pruned (with-current-buffer rmail-buffer    (rmail-header-toggle-visibility arg)
2062                     (rmail-msg-is-pruned)))    (rmail-highlight-headers))
          (prune (if arg  
                     (> (prefix-numeric-value arg) 0)  
                   (not pruned))))  
     (if (eq pruned prune)  
         t  
       (set-buffer rmail-buffer)  
       (rmail-maybe-set-message-counters)  
       (if rmail-enable-mime  
           (let ((buffer-read-only nil))  
             (if pruned  
                 (rmail-msg-restore-non-pruned-header)  
               (rmail-msg-prune-header))  
             (funcall rmail-show-mime-function))  
         (let* ((buffer-read-only nil)  
                (window (get-buffer-window (current-buffer)))  
                (at-point-min (= (point) (point-min)))  
                (all-headers-visible (= (window-start window) (point-min)))  
                (on-header  
                 (save-excursion  
                   (and (not (search-backward "\n\n" nil t))  
                        (progn  
                          (end-of-line)  
                          (re-search-backward "^[-A-Za-z0-9]+:" nil t))  
                        (match-string 0))))  
                (old-screen-line  
                 (rmail-count-screen-lines (window-start window) (point))))  
           (if pruned  
               (rmail-msg-restore-non-pruned-header)  
             (rmail-msg-prune-header))  
           (cond (at-point-min  
                  (goto-char (point-min)))  
                 (on-header  
                  (goto-char (point-min))  
                  (search-forward "\n\n")  
                  (or (re-search-backward  
                       (concat "^" (regexp-quote on-header)) nil t)  
                      (goto-char (point-min))))  
                 (t  
                  (save-selected-window  
                    (select-window window)  
                    (recenter old-screen-line)  
                    (if (and all-headers-visible  
                             (not (= (window-start) (point-min))))  
                        (recenter (- (window-height) 2))))))))  
       (rmail-highlight-headers))))  
2063    
2064  (defun rmail-narrow-to-non-pruned-header ()  (defun rmail-narrow-to-non-pruned-header ()
2065    "Narrow to the whole (original) header of the current message."    "Narrow to the whole (original) header of the current message."
2066    (let (start end)    (let (start end)
2067      (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))      (narrow-to-region (rmail-desc-get-start rmail-current-message) (point-max))
2068      (goto-char (point-min))      (goto-char (point-min))
2069      (forward-line 1)      (forward-line 1)
2070      (if (= (following-char) ?1)      (if (= (following-char) ?1)
# Line 2096  otherwise, show it in full." Line 2091  otherwise, show it in full."
2091    
2092  ;;;; *** Rmail Attributes and Keywords ***  ;;;; *** Rmail Attributes and Keywords ***
2093    
2094  ;; Make a string describing current message's attributes and keywords  ;; Make a string describing the current message's attributes by
2095  ;; and set it up as the name of a minor mode  ;; keywords and set it up as the name of a minor mode so it will
2096  ;; so it will appear in the mode line.  ;; appear in the mode line.
2097  (defun rmail-display-labels ()  (defun rmail-display-labels ()
2098    (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))    (let (keyword-list result)
2099      (save-excursion  
2100        (unwind-protect      ;; Update the keyword list for the current message.
2101            (progn      (if (> rmail-current-message 0)
2102              (widen)          (setq keyword-list (rmail-desc-get-keywords rmail-current-message)))
2103              (goto-char (rmail-msgbeg rmail-current-message))  
2104              (forward-line 1)      ;; Generate the result string.
2105              (if (looking-at "[01],")      (setq result (mapconcat '(lambda (arg) arg) keyword-list " "))
2106                  (progn  
2107                    (narrow-to-region (point) (progn (end-of-line) (point)))      ;; Update the mode line to display the keywords, the current
2108                    ;; Truly valid BABYL format requires a space before each      ;; message index and the total number of messages.
                   ;; attribute or keyword name.  Put them in if missing.  
                   (let (buffer-read-only)  
                     (goto-char (point-min))  
                     (while (search-forward "," nil t)  
                       (or (looking-at "[ ,]") (eobp)  
                           (insert " "))))  
                   (goto-char (point-max))  
                   (if (search-backward ",," nil 'move)  
                       (progn  
                         (if (> (point) (1+ (point-min)))  
                             (setq blurb (buffer-substring (+ 1 (point-min)) (point))))  
                         (if (> (- (point-max) (point)) 2)  
                             (setq blurb  
                                   (concat blurb  
                                           ";"  
                                           (buffer-substring (+ (point) 3)  
                                                             (1- (point-max)))))))))))  
         ;; Note: we don't use save-restriction because that does not work right  
         ;; if changes are made outside the saved restriction  
         ;; before that restriction is restored.  
         (narrow-to-region beg end)  
         (set-marker beg nil)  
         (set-marker end nil)))  
     (while (string-match " +," blurb)  
       (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","  
                           (substring blurb (match-end 0)))))  
     (while (string-match ", +" blurb)  
       (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","  
                           (substring blurb (match-end 0)))))  
2109      (setq mode-line-process      (setq mode-line-process
2110            (format " %d/%d%s"            (format " %d/%d %s"
2111                    rmail-current-message rmail-total-messages blurb))                    rmail-current-message rmail-total-messages result))
2112    
2113      ;; If rmail-enable-mime is non-nil, we may have to update      ;; If rmail-enable-mime is non-nil, we may have to update
2114      ;; `mode-line-process' of rmail-view-buffer too.      ;; `mode-line-process' of rmail-view-buffer too.
2115      (if (and rmail-enable-mime      (if (and rmail-enable-mime
# Line 2156  otherwise, show it in full." Line 2123  otherwise, show it in full."
2123  ;; ATTR is the name of the attribute, as a string.  ;; ATTR is the name of the attribute, as a string.
2124  ;; MSGNUM is message number to change; nil means current message.  ;; MSGNUM is message number to change; nil means current message.
2125  (defun rmail-set-attribute (attr state &optional msgnum)  (defun rmail-set-attribute (attr state &optional msgnum)
2126    (set-buffer rmail-buffer)    (save-excursion
2127    (let ((omax (point-max-marker))      (save-restriction
2128          (omin (point-min-marker))        (let ((attr-index (rmail-desc-get-attr-index attr)))
2129          (buffer-read-only nil))          (set-buffer rmail-buffer)
2130      (or msgnum (setq msgnum rmail-current-message))          (or msgnum (setq msgnum rmail-current-message))
2131      (if (> msgnum 0)          (rmail-desc-set-attribute attr-index state msgnum)
2132          (unwind-protect  
2133              (save-excursion          ;; Deal with the summary buffer.
2134                (widen)          (if rmail-summary-buffer
2135                (goto-char (+ 3 (rmail-msgbeg msgnum)))              (with-current-buffer rmail-summary-buffer
2136                (let ((curstate                (rmail-summary-update-attribute attr-index msgnum)))))))
                      (not  
                       (null (search-backward (concat ", " attr ",")  
                                              (prog1 (point) (end-of-line)) t)))))  
                 (or (eq curstate (not (not state)))  
                     (if curstate  
                         (delete-region (point) (1- (match-end 0)))  
                       (beginning-of-line)  
                       (forward-char 2)  
                       (insert " " attr ","))))  
               (if (string= attr "deleted")  
                   (rmail-set-message-deleted-p msgnum state)))  
           ;; Note: we don't use save-restriction because that does not work right  
           ;; if changes are made outside the saved restriction  
           ;; before that restriction is restored.  
           (narrow-to-region omin omax)  
           (set-marker omin nil)  
           (set-marker omax nil)  
           (if (= msgnum rmail-current-message)  
               (rmail-display-labels))))))  
2137    
2138  ;; Return t if the attributes/keywords line of msg number MSG  ;; Return t if the attributes/keywords line of msg number MSG
2139  ;; contains a match for the regexp LABELS.  ;; contains a match for the regexp LABELS.
# Line 2193  otherwise, show it in full." Line 2141  otherwise, show it in full."
2141    (save-excursion    (save-excursion
2142      (save-restriction      (save-restriction
2143        (widen)        (widen)
2144        (goto-char (rmail-msgbeg msg))        (goto-char (rmail-desc-get-start msg))
2145        (forward-char 3)        (forward-line 1)
2146        (re-search-backward labels (prog1 (point) (end-of-line)) t))))        (re-search-backward labels (prog1 (point) (end-of-line)) t))))
2147    
2148  ;;;; *** Rmail Message Selection And Support ***  ;;;; *** Rmail Message Selection And Support ***
# Line 2216  change the invisible header text." Line 2164  change the invisible header text."
2164    (save-excursion    (save-excursion
2165      (unwind-protect      (unwind-protect
2166          (progn          (progn
2167            (narrow-to-region (rmail-msgbeg rmail-current-message)            (narrow-to-region (rmail-desc-get-start rmail-current-message)
2168                              (point-max))                              (point-max))
2169            (goto-char (point-min))            (goto-char (point-min))
2170            (funcall function))            (funcall function))
2171          ;; Note: we don't use save-restriction because that does not work right          ;; Note: we don't use save-restriction because that does not work right
2172          ;; if changes are made outside the saved restriction          ;; if changes are made outside the saved restriction
2173          ;; before that restriction is restored.          ;; before that restriction is restored.
2174        (narrow-to-region (rmail-msgbeg rmail-current-message)        (narrow-to-region (rmail-desc-get-start rmail-current-message)
2175                          (rmail-msgend rmail-current-message)))))                          (rmail-desc-get-end rmail-current-message)))))
2176    
2177    (defun rmail-process-new-messages (&optional nomsg)
2178      "Process the new messages in the buffer.  The buffer has been
2179    narrowed to expose only the new messages.  For each new message append
2180    an entry to the message vector and, if necessary, add a header that
2181    will capture the salient BABYL information.  Return the number of new
2182    messages.  If NOMSG is non-nil then do not show any progress
2183    messages."
2184      (let ((inhibit-read-only t)
2185            (case-fold-search nil)
2186            (new-message-counter 0)
2187            (start (point-max))
2188            end attributes keywords message-descriptor-list date)
2189        (or nomsg (message "Processing new messages..."))
2190    
2191        ;; Process each message in turn starting from the back and
2192        ;; proceeding to the front of the region.  This is especially a
2193        ;; good approach since the buffer will likely have new headers
2194        ;; added.
2195        (goto-char start)
2196        (while (re-search-backward rmail-unix-mail-delimiter nil t)
2197    
2198          ;; Cache the message date to facilitate generating a message
2199          ;; summary later.  The format is '(DAY-OF-WEEK DAY-NUMBER MON
2200          ;; YEAR TIME)
2201          (setq date
2202                (list (buffer-substring (match-beginning 2) (match-end 2))
2203                      (buffer-substring (match-beginning 4) (match-end 4))
2204                      (buffer-substring (match-beginning 3) (match-end 3))
2205                      (buffer-substring (match-beginning 7) (match-end 7))
2206                      (buffer-substring (match-beginning 5) (match-end 5))))
2207    
2208    
2209          ;;Set start and end to bracket this message.
2210          (setq end start)
2211          (setq start (point))
2212          (save-excursion
2213            (save-restriction
2214              (narrow-to-region start end)
2215              (goto-char start)
2216    
2217              ;; Bump the new message counter.
2218              (setq new-message-counter (1+ new-message-counter))
2219    
2220              ;; I don't understand why the following is done ... -pmr
2221              ;; Detect messages that have been added with DOS line
2222              ;; endings and convert the line endings for such messages.
2223              (if (save-excursion (end-of-line) (= (preceding-char) ?\r))
2224                  (let ((buffer-read-only nil)
2225                        (buffer-undo t)
2226                        (end-marker (copy-marker end)))
2227                    (message
2228                     "Processing new messages...(converting line endings)")
2229                    (save-excursion
2230                      (goto-char (point-max))
2231                      (while (search-backward "\r\n" (point-min) t)
2232                        (delete-char 1)))
2233                    (setq end (marker-position end-marker))
2234                    (set-marker end-marker nil)))
2235    
2236              ;; Make sure we have an Rmail BABYL attribute header field.
2237              ;; All we can assume is that the Rmail BABYL header field is
2238              ;; in the header section.  It's placement can be modified by
2239              ;; another mailer.
2240              (setq attributes
2241                    (rmail-header-get-header rmail-header-attribute-header))
2242              (unless attributes
2243    
2244                ;; No suitable header exists.  Append the default BABYL
2245                ;; data header for a new message.
2246                (setq attributes (rmail-desc-get-default-attrs))
2247                (rmail-header-add-header
2248                 rmail-header-attribute-header attributes))
2249    
2250              ;; Set up keywords, if any.  The keywords are provided via a
2251              ;; comma separated list and returned as a list of strings.
2252              (setq keywords (rmail-header-get-keywords))
2253              (if keywords
2254    
2255                  ;; Keywords do exist.  Register them with the keyword
2256                  ;; management library.
2257                  (rmail-keyword-register-keywords keywords))
2258                    
2259    
2260              ;; Insure that we have From and Date headers.
2261              ;;(rmail-decode-from-line)
2262              
2263              ;; Perform User defined filtering.
2264              (save-excursion
2265                (if rmail-message-filter (funcall rmail-message-filter)))
2266    
2267              ;; Accumulate the message attributes along with the message
2268              ;; markers and the message date list.
2269              (setq message-descriptor-list
2270                    (vconcat (list (list (point-min-marker)
2271                                         attributes
2272                                         keywords
2273                                         date
2274                                         (count-lines start end)
2275                                         (rmail-get-sender)
2276                                         (rmail-header-get-header "subject")))
2277                             message-descriptor-list)))))
2278    
2279        ;; Add the new message data lists to the Rmail message descriptor
2280        ;; vector.
2281        (rmail-desc-add-descriptors message-descriptor-list)
2282    
2283        ;; Unless requested otherwise, show the number of new messages.
2284        ;; Return the number of new messages.
2285        (or nomsg (message "Processing new messages...done (%d)" new-message-counter))
2286        new-message-counter))
2287    
2288    ;;; mbox: deprecated
2289  (defun rmail-forget-messages ()  (defun rmail-forget-messages ()
2290    (unwind-protect    (unwind-protect
2291        (if (vectorp rmail-message-vector)        (if (vectorp rmail-message-vector)
# Line 2239  change the invisible header text." Line 2299  change the invisible header text."
2299      (setq rmail-msgref-vector nil)      (setq rmail-msgref-vector nil)
2300      (setq rmail-deleted-vector nil)))      (setq rmail-deleted-vector nil)))
2301    
2302    ;;; mbox: deprecated
2303  (defun rmail-maybe-set-message-counters ()  (defun rmail-maybe-set-message-counters ()
2304    (if (not (and rmail-deleted-vector    (if (not (and rmail-deleted-vector
2305                  rmail-message-vector                  rmail-message-vector
# Line 2281  change the invisible header text." Line 2342  change the invisible header text."
2342      (goto-char (point-min))      (goto-char (point-min))
2343      (or nomsg (message "Counting new messages...done (%d)" total-messages))))      (or nomsg (message "Counting new messages...done (%d)" total-messages))))
2344    
2345    ;;; DEPRECATED
2346  (defun rmail-set-message-counters ()  (defun rmail-set-message-counters ()
2347    (rmail-forget-messages)    (rmail-forget-messages)
2348    (save-excursion    (save-excursion
# Line 2318  change the invisible header text." Line 2380  change the invisible header text."
2380              (setq i (1+ i))))              (setq i (1+ i))))
2381          (message "Counting messages...done")))))          (message "Counting messages...done")))))
2382    
2383    ;;; DEPRECATED  
2384  (defun rmail-set-message-counters-counter (&optional stop)  (defun rmail-set-message-counters-counter (&optional stop)
2385    (let ((start (point))    (let ((start (point))
2386          next)          next)
# Line 2347  change the invisible header text." Line 2410  change the invisible header text."
2410        (if (zerop (% (setq total-messages (1+ total-messages)) 20))        (if (zerop (% (setq total-messages (1+ total-messages)) 20))
2411            (message "Counting messages...%d" total-messages)))))            (message "Counting messages...%d" total-messages)))))
2412    
2413    ;;; DEPRECATED
2414  (defun rmail-beginning-of-message ()  (defun rmail-beginning-of-message ()
2415    "Show current message starting from the beginning."    "Show current message starting from the beginning."
2416    (interactive)    (interactive)
# Line 2354  change the invisible header text." Line 2418  change the invisible header text."
2418    
2419  (defun rmail-show-message (&optional n no-summary)  (defun rmail-show-message (&optional n no-summary)
2420    "Show message number N (prefix argument), counting from start of file.    "Show message number N (prefix argument), counting from start of file.
2421  If summary buffer is currently displayed, update current message there also."  If NO-SUMMARY is non-nil, then do not update the summary buffer."
2422    (interactive "p")    (interactive "p")
2423    (or (eq major-mode 'rmail-mode)    (or (eq major-mode 'rmail-mode)
2424        (switch-to-buffer rmail-buffer))        (switch-to-buffer rmail-buffer))
2425    (rmail-maybe-set-message-counters)  
2426    (widen)    ;; If there are no messages to display, then provide a message to
2427      ;; indicate thusly.
2428    (if (zerop rmail-total-messages)    (if (zerop rmail-total-messages)
2429        (progn (narrow-to-region (point-min) (1- (point-max)))  
2430               (goto-char (point-min))        ;; There are no messages so display the Babyl boilerplate in the
2431               (setq mode-line-process nil))        ;; presentation buffer.  It is important to keep the boilerplate
2432          ;; out of the Rmail file so as not to break other mail agents.
2433          (progn
2434            (message "No messages to show.  Add something better soon.")
2435            (rmail-display-labels)
2436            (force-mode-line-update))
2437    
2438        ;; There are messages.  Show one.
2439      (let (blurb coding-system)      (let (blurb coding-system)
2440          ;; Set n to the first sane message based on the sign of n:
2441          ;; positive but greater than the total number of messages -> n;
2442          ;; negative -> 1.
2443        (if (not n)        (if (not n)
2444            (setq n rmail-current-message)            (setq n rmail-current-message)
2445          (cond ((<= n 0)          (cond ((<= n 0)
# Line 2377  If summary buffer is currently displayed Line 2452  If summary buffer is currently displayed
2452                       blurb "No following message"))                       blurb "No following message"))
2453                (t                (t
2454                 (setq rmail-current-message n))))                 (setq rmail-current-message n))))
2455        (let ((beg (rmail-msgbeg n)))  
2456          (goto-char beg)        ;; Index into the Rmail message vector.
2457          (forward-line 1)        (let ((beg (rmail-desc-get-start n))
2458          (save-excursion              (end (rmail-desc-get-end n)))
2459            (let ((end (rmail-msgend n)))  
2460              (save-restriction          ;; Narrow the region to message N and display the headers
2461                (if (prog1 (= (following-char) ?0)          ;; appropriately.
2462                      (forward-line 2)          (rmail-header-show-headers)
2463                      ;; If there's a Summary-line in the (otherwise empty)          (widen)
2464                      ;; header, we didn't yet get past the EOOH line.          (narrow-to-region beg end)
2465                      (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")          (goto-char (point-min))
2466                          (forward-line 1))  
2467                      (narrow-to-region (point) end))          ;; I think this is stale. -pmr
2468                    (rfc822-goto-eoh)          ;;(rfc822-goto-eoh)
2469                  (search-forward "\n*** EOOH ***\n" end t))          ;;(narrow-to-region beg (point))
2470                (narrow-to-region beg (point))          ;;(goto-char (point-min))
2471                (goto-char (point-min))          ;;(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2472                (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)          ;;    (let ((coding-system (intern (match-string 1))))
2473                    (let ((coding-system (intern (match-string 1))))          ;;      (check-coding-system coding-system)
2474                      (condition-case nil          ;;      (setq buffer-file-coding-system coding-system))
2475                          (progn          ;;  (setq buffer-file-coding-system nil))))
2476                            (check-coding-system coding-system)  
2477                            (setq buffer-file-coding-system coding-system))          ;; Do something here with the coding system, I'm not sure what. -pmr
2478                        (error          (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2479                         (setq buffer-file-coding-system nil))))              (let ((coding-system (intern (match-string 1))))
2480                  (setq buffer-file-coding-system nil)))))                (condition-case nil
2481          ;; Clear the "unseen" attribute when we show a message.                    (progn
2482          (rmail-set-attribute "unseen" nil)                      (check-coding-system coding-system)
2483          (let ((end (rmail-msgend n)))                      (setq buffer-file-coding-system coding-system))
2484            ;; Reformat the header, or else find the reformatted header.                  (error
2485            (if (= (following-char) ?0)                   (setq buffer-file-coding-system nil))))
2486                (rmail-reformat-message beg end)            (setq buffer-file-coding-system nil))
2487              (search-forward "\n*** EOOH ***\n" end t)  
2488              (narrow-to-region (point) end)))          ;; Clear the "unseen" attribute when we show a message, unless
2489          (goto-char (point-min))          ;; it is already cleared.
2490          (walk-windows          (if (rmail-desc-attr-p rmail-desc-unseen-index n)
2491           (function (lambda (window)              (rmail-desc-set-attribute rmail-desc-unseen-index nil n))
2492                       (if (eq (window-buffer window) (current-buffer))  
2493                           (set-window-point window (point)))))  ;; More code that has been added that I ill understand.
2494           nil t)  ;;      (walk-windows
2495    ;;       (function (lambda (window)
2496    ;;                   (if (eq (window-buffer window) (current-buffer))
2497    ;;                       (set-window-point window (point)))))
2498    ;;       nil t)
2499    
2500          (rmail-display-labels)          (rmail-display-labels)
2501    
2502            ;; Deal with MIME
2503          (if (eq rmail-enable-mime t)          (if (eq rmail-enable-mime t)
2504              (funcall rmail-show-mime-function)              (funcall rmail-show-mime-function)
2505            (setq rmail-view-buffer rmail-buffer)            (setq rmail-view-buffer rmail-buffer))
2506            )  
2507            ;; Deal with the message headers and URLs..
2508            (rmail-header-hide-headers)
2509          (rmail-highlight-headers)          (rmail-highlight-headers)
2510            (rmail-activate-urls)
2511    
2512            ;; ?
2513          (if transient-mark-mode (deactivate-mark))          (if transient-mark-mode (deactivate-mark))
2514    
2515            ;; Make sure that point in the Rmail window is at the beginning of the buffer.
2516            (set-window-point (get-buffer-window rmail-buffer) (point))
2517    
2518            ;; Run any User code.
2519          (run-hooks 'rmail-show-message-hook)          (run-hooks 'rmail-show-message-hook)
2520            
2521          ;; If there is a summary buffer, try to move to this message          ;; If there is a summary buffer, try to move to this message
2522          ;; in that buffer.  But don't complain if this message          ;; in that buffer.  But don't complain if this message
2523          ;; is not mentioned in the summary.          ;; is not mentioned in the summary.
2524          ;; Don't do this at all if we were called on behalf          ;; Don't do this at all if we were called on behalf
2525          ;; of cursor motion in the summary buffer.          ;; of cursor motion in the summary buffer.
2526          (and (rmail-summary-exists) (not no-summary)          (and (rmail-summary-exists) (not no-summary)
2527               (let ((curr-msg rmail-current-message))               (save-excursion
2528                 (rmail-select-summary                 (let ((curr-msg rmail-current-message))
2529                  (rmail-summary-goto-msg curr-msg t t))))                   ;; Set the summary current message, disabling the
2530                     ;; Rmail buffer update.
2531                     (set-buffer rmail-summary-buffer)
2532                     (rmail-summary-goto-msg curr-msg nil t))))
2533    ;;;                 (rmail-summary-rmail-update))))
2534    
2535            ;; What is going on here?
2536          (with-current-buffer rmail-buffer          (with-current-buffer rmail-buffer
2537            (rmail-auto-file))            (rmail-auto-file))
2538    
2539            ;; Post back any status messages.
2540          (if blurb          (if blurb
2541              (message blurb))))))              (message blurb))))))
2542    
2543    ;;; NOT DONE
2544  (defun rmail-redecode-body (coding)  (defun rmail-redecode-body (coding)
2545    "Decode the body of the current message using coding system CODING.    "Decode the body of the current message using coding system CODING.
2546  This is useful with mail messages that have malformed or missing  This is useful with mail messages that have malformed or missing
# Line 2460  iso-8859, koi8-r, etc." Line 2562  iso-8859, koi8-r, etc."
2562      (or (eq major-mode 'rmail-mode)      (or (eq major-mode 'rmail-mode)
2563          (switch-to-buffer rmail-buffer))          (switch-to-buffer rmail-buffer))
2564      (save-excursion      (save-excursion
2565        (let ((pruned (rmail-msg-is-pruned)))        (unwind-protect
2566          (unwind-protect            (let ((msgbeg (rmail-desc-get-start rmail-current-message))
2567              (let ((msgbeg (rmail-msgbeg rmail-current-message))                  (msgend (rmail-desc-get-end rmail-current-message))
2568                    (msgend (rmail-msgend rmail-current-message))                  x-coding-header)
2569                    x-coding-header)              ;; We need the message headers pruned (we later restore
2570                ;; We need the message headers pruned (we later restore              ;; the pruned stat to what it was, see the end of
2571                ;; the pruned stat to what it was, see the end of              ;; unwind-protect form).
2572                ;; unwind-protect form).              (rmail-header-show-headers)
2573                (or pruned              (narrow-to-region msgbeg msgend)
2574                    (rmail-toggle-header 1))              (goto-char (point-min))
2575                (narrow-to-region msgbeg msgend)              (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2576                (goto-char (point-min))                  (let ((old-coding (intern (match-string 1)))
2577                (when (search-forward "\n*** EOOH ***\n" (point-max) t)                        (buffer-read-only nil))
2578                  (narrow-to-region msgbeg (point)))                    (check-coding-system old-coding)
2579                (goto-char (point-min))                    ;; Make sure the new coding system uses the same EOL
2580                (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)                    ;; conversion, to prevent ^M characters from popping
2581                    (let ((old-coding (intern (match-string 1)))                    ;; up all over the place.
2582                          (buffer-read-only nil))                    (setq coding
2583                      (check-coding-system old-coding)                          (coding-system-change-eol-conversion
2584                      ;; Make sure the new coding system uses the same EOL                           coding
2585                      ;; conversion, to prevent ^M characters from popping                           (coding-system-eol-type old-coding)))
2586                      ;; up all over the place.                    (setq x-coding-header (point-marker))
2587                      (setq coding                    (narrow-to-region msgbeg msgend)
2588                            (coding-system-change-eol-conversion                    (encode-coding-region (point) msgend old-coding)
2589                             coding                    (decode-coding-region (point) msgend coding)
2590                             (coding-system-eol-type old-coding)))                    (setq last-coding-system-used coding)
2591                      (setq x-coding-header (point-marker))                    ;; Rewrite the coding-system header according
2592                      (narrow-to-region msgbeg msgend)                    ;; to what we did.
2593                      (encode-coding-region (point) msgend old-coding)                    (goto-char x-coding-header)
2594                      (decode-coding-region (point) msgend coding)                    (delete-region (point)
2595                      (setq last-coding-system-used coding)                                   (save-excursion
2596                      ;; Rewrite the coding-system header according                                     (beginning-of-line)
2597                      ;; to what we did.                                     (point)))
2598                      (goto-char x-coding-header)                    (insert "X-Coding-System: "
2599                      (delete-region (point)                            (symbol-name last-coding-system-used))
2600                                     (save-excursion                    (set-marker x-coding-header nil)
2601                                       (beginning-of-line)                    (rmail-show-message))
2602                                       (point)))                (error "No X-Coding-System header found")))
2603                      (insert "X-Coding-System: "          (rmail-header-hide-headers)))))
                             (symbol-name last-coding-system-used))  
                     (set-marker x-coding-header nil)  
                     (rmail-show-message))  
                 (error "No X-Coding-System header found")))  
           (or pruned  
               (rmail-toggle-header 0)))))))  
2604    
2605  ;; Find all occurrences of certain fields, and highlight them.  ;; Find all occurrences of certain fields, and highlight them.
2606  (defun rmail-highlight-headers ()  (defun rmail-highlight-headers ()
# Line 2549  iso-8859, koi8-r, etc." Line 2645  iso-8859, koi8-r, etc."
2645                    (setq rmail-overlay-list                    (setq rmail-overlay-list
2646                          (cons overlay rmail-overlay-list))))))))))                          (cons overlay rmail-overlay-list))))))))))
2647    
2648    ;;; mbox ready
2649  (defun rmail-auto-file ()  (defun rmail-auto-file ()
2650    "Automatically move a message into a sub-folder based on criteria.    "Automatically move a message into a sub-folder based on criteria.
2651  Called when a new message is displayed."  Called when a new message is displayed."
# Line 2561  Called when a new message is displayed." Line 2658  Called when a new message is displayed."
2658      (let ((from (mail-fetch-field "from"))      (let ((from (mail-fetch-field "from"))
2659            (subj (mail-fetch-field "subject"))            (subj (mail-fetch-field "subject"))
2660            (to   (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))            (to   (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
2661            (d rmail-automatic-folder-directives)            (directives rmail-automatic-folder-directives)
2662            (directive-loop nil)            (directive-loop nil)
2663            (folder nil))            (folder nil))
2664        (while d        (while directives
2665          (setq folder (car (car d))          (setq folder (car (car directives))
2666                directive-loop (cdr (car d)))                directive-loop (cdr (car directives)))
2667          (while (and (car directive-loop)          (while (and (car directive-loop)
2668                      (let ((f (cond                      (let ((f (cond
2669                                ((string= (car directive-loop) "from") from)                                ((string= (car directive-loop) "from") from)
# Line 2581  Called when a new message is displayed." Line 2678  Called when a new message is displayed."
2678                  (rmail-delete-forward)                  (rmail-delete-forward)
2679                (if (string= "/dev/null" folder)                (if (string= "/dev/null" folder)
2680                    (rmail-delete-message)                    (rmail-delete-message)
2681                  (rmail-output-to-rmail-file folder 1 t)                  (rmail-output folder 1 t)
2682                  (setq d nil))))                  (setq directives nil))))
2683          (setq d (cdr d))))))          (setq directives (cdr directives))))))
2684    
2685  (defun rmail-next-message (n)  (defun rmail-next-message (n)
2686    "Show following message whether deleted or not.    "Show following message whether deleted or not.
# Line 2606  or backward if N is negative. Line 2703  or backward if N is negative.
2703    
2704  Returns t if a new message is being shown, nil otherwise."  Returns t if a new message is being shown, nil otherwise."
2705    (interactive "p")    (interactive "p")
   (set-buffer rmail-buffer)  
   (rmail-maybe-set-message-counters)  
2706    (let ((lastwin rmail-current-message)    (let ((lastwin rmail-current-message)
2707          (current rmail-current-message))          (current rmail-current-message))
2708    
2709        ;; Handle forward movement looking for an undeleted message.  Move
2710        ;; forward a message at a time as long as there are subsequent
2711        ;; messages.  Stop if the last message is encountered.
2712      (while (and (> n 0) (< current rmail-total-messages))      (while (and (> n 0) (< current rmail-total-messages))
2713        (setq current (1+ current))        (setq current (1+ current))
2714        (if (not (rmail-message-deleted-p current))        (if (not (rmail-desc-deleted-p current))
2715            (setq lastwin current n (1- n))))            (setq lastwin current
2716                    n (1- n))))
2717    
2718        ;; Handle backward movement looking for an undeleted message.
2719        ;; Move backward a message at a time as long as there are
2720        ;; preceding messages.  Stop if the first message is encountered.
2721      (while (and (< n 0) (> current 1))      (while (and (< n 0) (> current 1))
2722        (setq current (1- current))        (setq current (1- current))
2723        (if (not (rmail-message-deleted-p current))        (if (not (rmail-desc-deleted-p current))
2724            (setq lastwin current n (1+ n))))            (setq lastwin current
2725                    n (1+ n))))
2726    
2727        ;; Show the message (even if no movement took place so that the
2728        ;; delete attribute is marked) and determine the result value.
2729        (rmail-show-message lastwin)
2730      (if (/= lastwin rmail-current-message)      (if (/= lastwin rmail-current-message)
2731          (progn (rmail-show-message lastwin)          t
                t)  
2732        (if (< n 0)        (if (< n 0)
2733            (message "No previous nondeleted message"))            (message "No previous nondeleted message"))
2734        (if (> n 0)        (if (> n 0)
2735            (message "No following nondeleted message"))            (message "No following nondeleted message"))
2736        nil)))        nil)))
2737    
2738    ;;; mbox: ready.
2739  (defun rmail-previous-undeleted-message (n)  (defun rmail-previous-undeleted-message (n)
2740    "Show previous non-deleted message.    "Show previous non-deleted message.
2741  With prefix argument N, moves backward N non-deleted messages,  With prefix argument N, moves backward N non-deleted messages,
# Line 2634  or forward if N is negative." Line 2743  or forward if N is negative."
2743    (interactive "p")    (interactive "p")
2744    (rmail-next-undeleted-message (- n)))    (rmail-next-undeleted-message (- n)))
2745    
2746    ;;; mbox: ready.
2747  (defun rmail-first-message ()  (defun rmail-first-message ()
2748    "Show first message in file."    "Show first message in file."
2749    (interactive)    (interactive)
   (rmail-maybe-set-message-counters)  
2750    (rmail-show-message 1))    (rmail-show-message 1))
2751    
2752    ;;; mbox: ready
2753  (defun rmail-last-message ()  (defun rmail-last-message ()
2754    "Show last message in file."    "Show last message in file."
2755    (interactive)    (interactive)
   (rmail-maybe-set-message-counters)  
2756    (rmail-show-message rmail-total-messages))    (rmail-show-message rmail-total-messages))
2757    
2758    ;;; mbox: not called
2759  (defun rmail-what-message ()  (defun rmail-what-message ()
2760    (let ((where (point))    (let ((where (point))
2761          (low 1)          (low 1)
2762          (high rmail-total-messages)          (high rmail-total-messages)
2763          (mid (/ rmail-total-messages 2)))          (mid (/ rmail-total-messages 2)))
2764      (while (> (- high low) 1)      (while (> (- high low) 1)
2765        (if (>= where (rmail-msgbeg mid))        (if (>= where (rmail-desc-get-start mid))
2766            (setq low mid)            (setq low mid)
2767          (setq high mid))          (setq high mid))
2768        (setq mid (+ low (/ (- high low) 2))))        (setq mid (+ low (/ (- high low) 2))))
2769      (if (>= where (rmail-msgbeg high)) high low)))      (if (>= where (rmail-desc-get-start high)) high low)))
2770    
2771    ;;; mbox: ready
2772    (defun rmail-narrow-to-header (msg)
2773      (save-excursion
2774        (let ((start (rmail-desc-get-start msg))
2775              (end (rmail-desc-get-end msg)))
2776          (widen)
2777          (goto-char start)
2778        (search-forward "\n\n" end nil t)
2779        (narrow-to-region start (point)))))
2780    
2781    ;;; mbox: ready
2782  (defun rmail-message-recipients-p (msg recipients &optional primary-only)  (defun rmail-message-recipients-p (msg recipients &optional primary-only)
2783    (save-restriction    (save-restriction
     (goto-char (rmail-msgbeg msg))  
     (search-forward "\n*** EOOH ***\n")  
     (narrow-to-region (point) (progn (search-forward "\n\n") (point)))  
2784      (or (string-match recipients (or (mail-fetch-field "To") ""))      (or (string-match recipients (or (mail-fetch-field "To") ""))
2785          (string-match recipients (or (mail-fetch-field "From") ""))          (string-match recipients (or (mail-fetch-field "From") ""))
2786          (if (not primary-only)          (if (not primary-only)
2787              (string-match recipients (or (mail-fetch-field "Cc") ""))))))              (string-match recipients (or (mail-fetch-field "Cc") ""))))))
2788    
2789  (defun rmail-message-regexp-p (n regexp)  ;;; mbox: ready
2790    "Return t, if for message number N, regexp REGEXP matches in the header."  (defun rmail-message-regexp-p (msg regexp)
2791    (let ((beg (rmail-msgbeg n))    "Return t, if for message number MSG, regexp REGEXP matches in the header."
2792          (end (rmail-msgend n)))    (save-excursion
2793      (goto-char beg)      (save-restriction
2794      (forward-line 1)        (rmail-narrow-to-header msg)
2795      (save-excursion        (re-search-forward regexp nil t))))
       (save-restriction  
         (if (prog1 (= (following-char) ?0)  
               (forward-line 2)  
               ;; If there's a Summary-line in the (otherwise empty)  
               ;; header, we didn't yet get past the EOOH line.  
               (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")  
                 (forward-line 1))  
               (setq beg (point))  
               (narrow-to-region (point) end))  
             (progn  
               (rfc822-goto-eoh)  
               (setq end (point)))  
           (setq beg (point))  
           (search-forward "\n*** EOOH ***\n" end t)  
           (setq end (1+ (match-beginning 0)))))  
         (goto-char beg)  
         (if rmail-enable-mime  
             (funcall rmail-search-mime-header-function n regexp end)  
           (re-search-forward regexp end t)))))  
2796    
2797    ;;; mbox: ready
2798  (defun rmail-search-message (msg regexp)  (defun rmail-search-message (msg regexp)
2799    "Return non-nil, if for message number MSG, regexp REGEXP matches."    "Return non-nil, if for message number MSG, regexp REGEXP matches."
2800    (goto-char (rmail-msgbeg msg))    (goto-char (rmail-desc-get-start msg))
2801    (if rmail-enable-mime    (if rmail-enable-mime
2802        (funcall rmail-search-mime-message-function msg regexp)        (funcall rmail-search-mime-message-function msg regexp)
2803      (re-search-forward regexp (rmail-msgend msg) t)))      (re-search-forward regexp (rmail-desc-get-end msg) t)))
2804    
2805    ;;; mbox: ready
2806  (defvar rmail-search-last-regexp nil)  (defvar rmail-search-last-regexp nil)
2807  (defun rmail-search (regexp &optional n)  (defun rmail-search (regexp &optional n)
2808    "Show message containing next match for REGEXP (but not the current msg).    "Show message containing next match for REGEXP (but not the current msg).
# Line 2730  Interactively, empty argument means use Line 2831  Interactively, empty argument means use
2831             (if (< n 0) "Reverse " "")             (if (< n 0) "Reverse " "")
2832             regexp)             regexp)
2833    (set-buffer rmail-buffer)    (set-buffer rmail-buffer)
   (rmail-maybe-set-message-counters)  
2834    (let ((omin (point-min))    (let ((omin (point-min))
2835          (omax (point-max))          (omax (point-max))
2836          (opoint (point))          (opoint (point))
         win  
2837          (reversep (< n 0))          (reversep (< n 0))
2838          (msg rmail-current-message))          (msg rmail-current-message)
2839            win)
2840      (unwind-protect      (unwind-protect
2841          (progn          (progn
2842            (widen)            (widen)
# Line 2798  Interactively, empty argument means use Line 2898  Interactively, empty argument means use
2898              (prefix-numeric-value current-prefix-arg))))              (prefix-numeric-value current-prefix-arg))))
2899    (rmail-search regexp (- (or n 1))))    (rmail-search regexp (- (or n 1))))
2900    
 ;; Show the first message which has the `unseen' attribute.  
2901  (defun rmail-first-unseen-message ()  (defun rmail-first-unseen-message ()
2902    (rmail-maybe-set-message-counters)    "Show the first message which has not been seen.  If all messages
2903    have been seen, then show the last message."
2904    (let ((current 1)    (let ((current 1)
2905          found)          found)
2906      (save-restriction      (while (and (not found) (<= current rmail-total-messages))
2907        (widen)        (if (rmail-desc-attr-p rmail-desc-unseen-index current)
2908        (while (and (not found) (<= current rmail-total-messages))            (setq found current))
2909          (if (rmail-message-labels-p current ", ?\\(unseen\\),")        (setq current (1+ current)))
             (setq found current))  
         (setq current (1+ current))))  
 ;; Let the caller show the message.  
 ;;    (if found  
 ;;      (rmail-show-message found))  
2910      found))      found))
2911    
2912  (defun rmail-next-same-subject (n)  (defun rmail-next-same-subject (n)
# Line 2836  If N is negative, go backwards instead." Line 2931  If N is negative, go backwards instead."
2931      (save-excursion      (save-excursion
2932        (save-restriction        (save-restriction
2933          (widen)          (widen)
2934          (while (and (/= n 0)          (if forward
2935                      (if forward              (while (and (/= n 0) (< i rmail-total-messages))
2936                          (< i rmail-total-messages)                (let (done)
2937                        (> i 1)))                  (while (and (not done)
2938            (let (done)                              (< i rmail-total-messages))
2939              (while (and (not done)                    (setq i (+ i 1))
2940                          (if forward                    (rmail-narrow-to-header i)
2941                              (< i rmail-total-messages)                    (goto-char (point-min))
2942                            (> i 1)))                    (setq done (re-search-forward search-regexp (point-max) t)))
2943                (setq i (if forward (1+ i) (1- i)))                  (if done (setq found i)))
2944                (goto-char (rmail-msgbeg i))                (setq n (1- n)))
2945                (search-forward "\n*** EOOH ***\n")            (while (and (/= n 0) (> i 1))
2946                (let ((beg (point)) end)              (let (done)
2947                  (search-forward "\n\n")                (while (and (not done) (> i 1))
2948                  (setq end (point))                  (setq i (- i 1))
2949                  (goto-char beg)                  (rmail-narrow-to-header i)
2950                  (setq done (re-search-forward search-regexp end t))))                  (goto-char (point-min))
2951              (if done (setq found i)))                  (setq done (re-search-forward search-regexp (point-max) t)))
2952            (setq n (if forward (1- n) (1+ n))))))                (if done (setq found i)))
2953                (setq n (1+ n))))))
2954      (if found      (if found
2955          (rmail-show-message found)          (rmail-show-message found)
2956        (error "No %s message with same subject"        (error "No %s message with same subject"
# Line 2869  If N is negative, go forwards instead." Line 2965  If N is negative, go forwards instead."
2965    
2966  ;;;; *** Rmail Message Deletion Commands ***  ;;;; *** Rmail Message Deletion Commands ***
2967    
2968    ;;; mbox: ready
2969  (defun rmail-message-deleted-p (n)  (defun rmail-message-deleted-p (n)
2970    (= (aref rmail-deleted-vector n) ?D))    (rmail-desc-deleted-p n))
2971    
2972  (defun rmail-set-message-deleted-p (n state)  (defun rmail-set-message-deleted-p (n state)
2973    (aset rmail-deleted-vector n (if state ?D ?\ )))    (aset rmail-deleted-vector n (if state ?D ?\ )))
# Line 2878  If N is negative, go forwards instead." Line 2975  If N is negative, go forwards instead."
2975  (defun rmail-delete-message ()  (defun rmail-delete-message ()
2976    "Delete this message and stay on it."    "Delete this message and stay on it."
2977    (interactive)    (interactive)
2978    (rmail-set-attribute "deleted" t)    (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message)
2979    (run-hooks 'rmail-delete-message-hook))    (run-hooks 'rmail-delete-message-hook)
2980      (rmail-show-message rmail-current-message))
2981    
2982  (defun rmail-undelete-previous-message ()  (defun rmail-undelete-previous-message ()
2983    "Back up to deleted message, select it, and undelete it."    "Back up to deleted message, select it, and undelete it."
# Line 2887  If N is negative, go forwards instead." Line 2985  If N is negative, go forwards instead."
2985    (set-buffer rmail-buffer)    (set-buffer rmail-buffer)
2986    (let ((msg rmail-current-message))    (let ((msg rmail-current-message))
2987      (while (and (> msg 0)      (while (and (> msg 0)
2988                  (not (rmail-message-deleted-p msg)))                  (not (rmail-desc-attr-p rmail-desc-deleted-index msg)))
2989        (setq msg (1- msg)))        (setq msg (1- msg)))
2990      (if (= msg 0)      (if (= msg 0)
2991          (error "No previous deleted message")          (error "No previous deleted message")
2992        (if (/= msg rmail-current-message)        (rmail-desc-set-attribute rmail-desc-deleted-index nil msg)
2993            (rmail-show-message msg))        (rmail-show-message msg)
       (rmail-set-attribute "deleted" nil)  
2994        (if (rmail-summary-exists)        (if (rmail-summary-exists)
2995            (save-excursion            (save-excursion
2996              (set-buffer rmail-summary-buffer)              (set-buffer rmail-summary-buffer)
2997              (rmail-summary-mark-undeleted msg)))              (rmail-summary-mark-undeleted msg)))
2998        (rmail-maybe-display-summary))))        (rmail-maybe-display-summary))))
2999    
3000    ;;; mbox: ready
3001  (defun rmail-delete-forward (&optional backward)  (defun rmail-delete-forward (&optional backward)
3002    "Delete this message and move to next nondeleted one.    "Delete this message and move to next nondeleted one.
3003  Deleted messages stay in the file until the \\[rmail-expunge] command is given.  Deleted messages stay in the file until the \\[rmail-expunge] command is given.
# Line 2907  With prefix argument, delete and move ba Line 3005  With prefix argument, delete and move ba
3005    
3006  Returns t if a new message is displayed after the delete, or nil otherwise."  Returns t if a new message is displayed after the delete, or nil otherwise."
3007    (interactive "P")    (interactive "P")
3008    (rmail-set-attribute "deleted" t)    (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message)
3009    (run-hooks 'rmail-delete-message-hook)    (run-hooks 'rmail-delete-message-hook)
3010    (let ((del-msg rmail-current-message))    (let ((del-msg rmail-current-message))
3011      (if (rmail-summary-exists)      (if (rmail-summary-exists)
# Line 2916  Returns t if a new message is displayed Line 3014  Returns t if a new message is displayed
3014      (prog1 (rmail-next-undeleted-message (if backward -1 1))      (prog1 (rmail-next-undeleted-message (if backward -1 1))
3015        (rmail-maybe-display-summary))))        (rmail-maybe-display-summary))))
3016    
3017    ;;; mbox: ready
3018  (defun rmail-delete-backward ()  (defun rmail-delete-backward ()
3019    "Delete this message and move to previous nondeleted one.    "Delete this message and move to previous nondeleted one.
3020  Deleted messages stay in the file until the \\[rmail-expunge] command is given."  Deleted messages stay in the file until the \\[rmail-expunge] command is given."
3021    (interactive)    (interactive)
3022    (rmail-delete-forward t))    (rmail-delete-forward t))
3023    
3024    ;;; mbox: deprecated
3025  ;; Compute the message number a given message would have after expunging.  ;; Compute the message number a given message would have after expunging.
3026  ;; The present number of the message is OLDNUM.  ;; The present number of the message is OLDNUM.
3027  ;; DELETEDVEC should be rmail-deleted-vector.  ;; DELETEDVEC should be rmail-deleted-vector.
# Line 2947  See also user-option `rmail-confirm-expu Line 3047  See also user-option `rmail-confirm-expu
3047        (funcall rmail-confirm-expunge        (funcall rmail-confirm-expunge
3048                 "Erase deleted messages from Rmail file? ")))                 "Erase deleted messages from Rmail file? ")))
3049    
3050    ;;; mbox: ready
3051  (defun rmail-only-expunge ()  (defun rmail-only-expunge ()
3052    "Actually erase all deleted messages in the file."    "Actually erase all deleted messages in the file."
3053    (interactive)    (interactive)
   (set-buffer rmail-buffer)  
3054    (message "Expunging deleted messages...")    (message "Expunging deleted messages...")
3055    
3056    ;; Discard all undo records for this buffer.    ;; Discard all undo records for this buffer.
3057    (or (eq buffer-undo-list t)    (or (eq buffer-undo-list t) (setq buffer-undo-list nil))
       (setq buffer-undo-list nil))  
   (rmail-maybe-set-message-counters)  
   (let* ((omax (- (buffer-size) (point-max)))  
          (omin (- (buffer-size) (point-min)))  
          (opoint (if (and (> rmail-current-message 0)  
                           (rmail-message-deleted-p rmail-current-message))  
                      0  
                    (if rmail-enable-mime  
                        (with-current-buffer rmail-view-buffer  
                          (- (point)(point-min)))  
                      (- (point) (point-min)))))  
          (messages-head (cons (aref rmail-message-vector 0) nil))  
          (messages-tail messages-head)  
          ;; Don't make any undo records for the expunging.  
          (buffer-undo-list t)  
          (win))  
     (unwind-protect  
         (save-excursion  
           (widen)  
           (goto-char (point-min))  
           (let ((counter 0)  
                 (number 1)  
                 (total rmail-total-messages)  
                 (new-message-number rmail-current-message)  
                 (new-summary nil)  
                 (new-msgref (list (list 0)))  
                 (rmailbuf (current-buffer))  
                 (buffer-read-only nil)  
                 (messages rmail-message-vector)  
                 (deleted rmail-deleted-vector)  
                 (summary rmail-summary-vector))  
             (setq rmail-total-messages nil  
                   rmail-current-message nil  
                   rmail-message-vector nil  
                   rmail-deleted-vector nil  
                   rmail-summary-vector nil)  
   
             (while (<= number total)  
               (if (= (aref deleted number) ?D)  
                   (progn  
                     (delete-region  
                       (marker-position (aref messages number))  
                       (marker-position (aref messages (1+ number))))  
                     (move-marker (aref messages number) nil)  
                     (if (> new-message-number counter)  
                         (setq new-message-number (1- new-message-number))))  
                 (setq counter (1+ counter))  
                 (setq messages-tail  
                       (setcdr messages-tail  
                               (cons (aref messages number) nil)))  
                 (setq new-summary  
                       (cons (if (= counter number) (aref summary (1- number)))  
                             new-summary))  
                 (setq new-msgref  
                       (cons (aref rmail-msgref-vector number)  
                             new-msgref))  
                 (setcar (car new-msgref) counter))  
               (if (zerop (% (setq number (1+ number)) 20))  
                   (message "Expunging deleted messages...%d" number)))  
             (setq messages-tail  
                   (setcdr messages-tail  
                           (cons (aref messages number) nil)))  
             (setq rmail-current-message new-message-number  
                   rmail-total-messages counter  
                   rmail-message-vector (apply 'vector messages-head)  
                   rmail-deleted-vector (make-string (1+ counter) ?\ )  
                   rmail-summary-vector (vconcat (nreverse new-summary))  
                   rmail-msgref-vector (apply 'vector (nreverse new-msgref))  
                   win t)))  
       (message "Expunging deleted messages...done")  
       (if (not win)  
           (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))  
       (rmail-show-message  
        (if (zerop rmail-current-message) 1 nil))  
       (if rmail-enable-mime  
           (goto-char (+ (point-min) opoint))  
         (goto-char (+ (point) opoint))))))  
3058    
3059      ;; Remove the messages from the buffer and from the Rmail message
3060      ;; descriptor vector.
3061      (rmail-desc-prune-deleted-messages 'rmail-expunge-callback)
3062    
3063      ;; Update the Rmail message counter, deal with the summary buffer,
3064      ;; show the current message and update the User status.
3065      (setq rmail-total-messages (rmail-desc-get-count))
3066      (rmail-show-message rmail-current-message t)
3067      (if rmail-summary-buffer
3068          (save-excursion
3069            (set-buffer rmail-summary-buffer)
3070            (rmail-update-summary)))
3071      (message "Expunging deleted messages...done"))
3072    
3073    ;;; We'll deal with this later. -pmr
3074    ;;;    (if rmail-enable-mime
3075    ;;;     (goto-char (+ (point-min) opoint))
3076    ;;;      (goto-char (+ (point) opoint))))))
3077    
3078    ;;; mbox: ready
3079    (defun rmail-expunge-callback (n)
3080      "Called after message N has been pruned to update the current Rmail
3081      message counter."
3082      (if (< n rmail-current-message)
3083          (setq rmail-current-message (1- rmail-current-message))))
3084    
3085    ;;; mbox: ready
3086  (defun rmail-expunge ()  (defun rmail-expunge ()
3087    "Erase deleted messages from Rmail file and summary buffer."    "Erase deleted messages from Rmail file and summary buffer."
3088    (interactive)    (interactive)
3089    (when (rmail-expunge-confirmed)    (when (rmail-expunge-confirmed)
3090      (rmail-only-expunge)      (rmail-only-expunge)))
     (if (rmail-summary-exists)  
         (rmail-select-summary (rmail-update-summary)))))  
3091    
3092  ;;;; *** Rmail Mailing Commands ***  ;;;; *** Rmail Mailing Commands ***
3093    
3094    ;;; mbox: In progress.  I'm still not happy with the initial citation
3095    ;;; stuff. -pmr
3096  (defun rmail-start-mail (&optional noerase to subject in-reply-to cc  (defun rmail-start-mail (&optional noerase to subject in-reply-to cc
3097                                     replybuffer sendactions same-window others)                                     replybuffer sendactions same-window others)
3098    (let (yank-action)    (let (yank-action)
# Line 3078  original message into it." Line 3129  original message into it."
3129    (interactive)    (interactive)
3130    (rmail-start-mail t))    (rmail-start-mail t))
3131    
3132    ;;; mbox: ready -pmr
3133  (defun rmail-reply (just-sender)  (defun rmail-reply (just-sender)
3134    "Reply to the current message.    "Reply to the current message.
3135  Normally include CC: to all other recipients of original message;  Normally include CC: to all other recipients of original message;
3136  prefix argument means ignore them.  While composing the reply,  prefix argument means ignore them.  While composing the reply,
3137  use \\[mail-yank-original] to yank the original message into it."  use \\[mail-yank-original] to yank the original message into it."
3138    (interactive "P")    (interactive "P")
3139    (let (from reply-to cc subject date to message-id references    (save-excursion
3140               resent-to resent-cc resent-reply-to      (save-restriction
3141               (msgnum rmail-current-message))        (let ((msgnum rmail-current-message)
3142      (save-excursion              (display-state (rmail-desc-get-header-display-state rmail-current-message))
3143        (save-restriction              from reply-to cc subject date to message-id references
3144          (if rmail-enable-mime              resent-to resent-cc resent-reply-to)
3145              (narrow-to-region          (rmail-header-show-headers)
3146               (goto-char (point-min))          (setq from (mail-fetch-field "from")
3147               (if (search-forward "\n\n" nil 'move)                reply-to (or (mail-fetch-field "reply-to" nil t) from)
3148                   (1+ (match-beginning 0))                cc (and (not just-sender)
3149                 (point)))                        (mail-fetch-field "cc" nil t))
3150            (widen)                subject (mail-fetch-field "subject")
3151            (goto-char (rmail-msgbeg rmail-current-message))                date (mail-fetch-field "date")
3152            (forward-line 1)                to (or (mail-fetch-field "to" nil t) "")
3153            (if (= (following-char) ?0)                message-id (mail-fetch-field "message-id")
3154                (narrow-to-region                references (mail-fetch-field "references" nil nil t)
3155                 (progn (forward-line 2)                resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
3156                        (point))                resent-cc (and (not just-sender)
3157                 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)                               (mail-fetch-field "resent-cc" nil t))
3158                                        'move)                resent-to (or (mail-fetch-field "resent-to" nil t) ""))
                       (point)))  
             (narrow-to-region (point)  
                               (progn (search-forward "\n*** EOOH ***\n")  
                                      (beginning-of-line) (point)))))  
         (setq from (mail-fetch-field "from")  
               reply-to (or (mail-fetch-field "reply-to" nil t)  
                            from)  
               cc (and (not just-sender)  
                       (mail-fetch-field "cc" nil t))  
               subject (mail-fetch-field "subject")  
               date (mail-fetch-field "date")  
               to (or (mail-fetch-field "to" nil t) "")  
               message-id (mail-fetch-field "message-id")  
               references (mail-fetch-field "references" nil nil t)  
               resent-reply-to (mail-fetch-field "resent-reply-to" nil t)  
               resent-cc (and (not just-sender)  
                              (mail-fetch-field "resent-cc" nil t))  
               resent-to (or (mail-fetch-field "resent-to" nil t) "")  
3159  ;;;           resent-subject (mail-fetch-field "resent-subject")  ;;;           resent-subject (mail-fetch-field "resent-subject")
3160  ;;;           resent-date (mail-fetch-field "resent-date")  ;;;           resent-date (mail-fetch-field "resent-date")
3161  ;;;           resent-message-id (mail-fetch-field "resent-message-id")  ;;;           resent-message-id (mail-fetch-field "resent-message-id")
3162                )))  
3163      ;; Merge the resent-to and resent-cc into the to and cc.          ;; Merge the resent-to and resent-cc into the to and cc.
3164      (if (and resent-to (not (equal resent-to "")))          (if (and resent-to (not (equal resent-to "")))
3165          (if (not (equal to ""))              (if (not (equal to ""))
3166              (setq to (concat to ", " resent-to))                  (setq to (concat to ", " resent-to))
3167            (setq to resent-to)))                (setq to resent-to)))
3168      (if (and resent-cc (not (equal resent-cc "")))          (if (and resent-cc (not (equal resent-cc "")))
3169          (if (not (equal cc ""))              (if (not (equal cc ""))
3170              (setq cc (concat cc ", " resent-cc))                  (setq cc (concat cc ", " resent-cc))
3171            (setq cc resent-cc)))                (setq cc resent-cc)))
3172      ;; Add `Re: ' to subject if not there already.          ;; Add `Re: ' to subject if not there already.
3173      (and (stringp subject)          (and (stringp subject)
3174           (setq subject               (setq subject
3175                 (concat rmail-reply-prefix                     (concat rmail-reply-prefix
3176                         (if (let ((case-fold-search t))                             (if (let ((case-fold-search t))
3177                               (string-match rmail-reply-regexp subject))                                   (string-match rmail-reply-regexp subject))
3178                             (substring subject (match-end 0))                                 (substring subject (match-end 0))
3179                           subject))))                               subject))))
3180      (rmail-start-mail          ;; Reset the headers display state before switching to the
3181       nil          ;; reply buffer.
3182       ;; Using mail-strip-quoted-names is undesirable with newer mailers          (rmail-header-toggle-visibility (if display-state 1 0))
3183       ;; since they can handle the names unstripped.  
3184       ;; I don't know whether there are other mailers that still          ;; Now setup the mail reply buffer.
3185       ;; need the names to be stripped.          (rmail-start-mail
3186  ;;;     (mail-strip-quoted-names reply-to)           nil
3187       reply-to           ;; Using mail-strip-quoted-names is undesirable with newer mailers
3188       subject           ;; since they can handle the names unstripped.
3189       (rmail-make-in-reply-to-field from date message-id)           ;; I don't know whether there are other mailers that still
3190       (if just-sender           ;; need the names to be stripped.
3191           nil           (mail-strip-quoted-names reply-to)
3192         ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to           subject
3193         ;; to do its job.           (rmail-make-in-reply-to-field from date message-id)
3194         (let* ((cc-list (rmail-dont-reply-to           (if just-sender
3195                          (mail-strip-quoted-names               nil
3196                           (if (null cc) to (concat to ", " cc))))))             ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to
3197           (if (string= cc-list "") nil cc-list)))             ;; to do its job.
3198       rmail-view-buffer             (let* ((cc-list (rmail-dont-reply-to
3199       (list (list 'rmail-mark-message                              (mail-strip-quoted-names
3200                   rmail-buffer                               (if (null cc) to (concat to ", " cc))))))
3201                   (with-current-buffer rmail-buffer               (if (string= cc-list "") nil cc-list)))
3202                     (aref rmail-msgref-vector msgnum))           rmail-view-buffer
3203                   "answered"))           (list (list 'rmail-reply-callback rmail-buffer "answered" t msgnum))
3204       nil           nil
3205       (list (cons "References" (concat (mapconcat 'identity references " ")           (list (cons "References" (concat (mapconcat 'identity references " ")
3206                                        " " message-id))))))                                            " " message-id))))))))
3207    
3208  (defun rmail-mark-message (buffer msgnum-list attribute)  (defun rmail-reply-callback (buffer attr state n)
3209    "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.    "Mail reply callback function. Sets ATTR (a string) if STATE is
3210  This is use in the send-actions for message buffers.    non-nil, otherwise clears it.  N is the message number.  BUFFER,
3211  MSGNUM-LIST is a list of the form (MSGNUM)    possibly narrowed, contains an mbox mail message."
 which is an element of rmail-msgref-vector."  
3212    (save-excursion    (save-excursion
3213      (set-buffer buffer)      (set-buffer buffer)
3214      (if (car msgnum-list)      (rmail-set-attribute attr state n)))
3215          (rmail-set-attribute attribute t (car msgnum-list)))))  
3216    (defun rmail-mark-message (msgnum-list attr-index)
3217      "Set the attribute denoted by ATTRIBUTE-INDEX in the message denoted
3218    by the car of MSGNUM-LIST.  This is used in the send-actions for
3219    message buffers.  MSGNUM-LIST is a list of the form (MSGNUM)."
3220      (save-excursion
3221        (let ((n (car msgnum-list)))
3222          (set-buffer rmail-buffer)
3223          (rmail-narrow-to-message n)
3224          (rmail-desc-set-attribute attr-index t n))))
3225    
3226    (defun rmail-narrow-to-message (n)
3227      "Set the narrowing restriction in the current (rmail) buffer to
3228      bracket message N."
3229      (widen)
3230      (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)))
3231    
3232  (defun rmail-make-in-reply-to-field (from date message-id)  (defun rmail-make-in-reply-to-field (from date message-id)
3233    (cond ((not from)    (cond ((not from)
# Line 3240  which is an element of rmail-msgref-vect Line 3288  which is an element of rmail-msgref-vect
3288           (let ((mail-use-rfc822 t))           (let ((mail-use-rfc822 t))
3289             (rmail-make-in-reply-to-field from date message-id)))))             (rmail-make-in-reply-to-field from date message-id)))))
3290    
3291    ;;; mbox: ready
3292  (defun rmail-forward (resend)  (defun rmail-forward (resend)
3293    "Forward the current message to another user.    "Forward the current message to another user.
3294  With prefix argument, \"resend\" the message instead of forwarding it;  With prefix argument, \"resend\" the message instead of forwarding it;
# Line 3262  see the documentation of `rmail-resend'. Line 3311  see the documentation of `rmail-resend'.
3311             (list (list 'rmail-mark-message             (list (list 'rmail-mark-message
3312                         forward-buffer                         forward-buffer
3313                         (with-current-buffer rmail-buffer                         (with-current-buffer rmail-buffer
3314                           (aref rmail-msgref-vector msgnum))                           (rmail-desc-get-start msgnum))
3315                         "forwarded"))                         "forwarded"))
3316             ;; If only one window, use it for the mail buffer.             ;; If only one window, use it for the mail buffer.
3317             ;; Otherwise, use another window for the mail buffer             ;; Otherwise, use another window for the mail buffer
# Line 3404  typically for purposes of moderating a l Line 3453  typically for purposes of moderating a l
3453  (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"  (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
3454   "A regexp that matches the header of a MIME body part with a failed message.")   "A regexp that matches the header of a MIME body part with a failed message.")
3455    
3456    ;;; NOT DONE
3457  (defun rmail-retry-failure ()  (defun rmail-retry-failure ()
3458    "Edit a mail message which is based on the contents of the current message.    "Edit a mail message which is based on the contents of the current message.
3459  For a message rejected by the mail system, extract the interesting headers and  For a message rejected by the mail system, extract the interesting headers and
# Line 3753  encoded string (and the same mask) will Line 3803  encoded string (and the same mask) will
3803       (setq i (1+ i)))       (setq i (1+ i)))
3804     (concat string-vector)))     (concat string-vector)))
3805    
3806  (provide 'rmail)  ;;;; Browser related functions
3807    
3808    (defun rmail-activate-urls ()
3809      "Highlight URLs embedded in the message body."
3810      (save-excursion
3811        (goto-char (point-min))
3812        (search-forward "\n\n" nil t)
3813        (browse-url-activate-urls (point) (point-max)
3814                                  'bold 'bold-italic 'highlight rmail-url-map)))
3815    
3816    ;;; mbox: not ready, there is a bug here which I don't
3817    ;;; understand. When invoked with the summary buffer as the current
3818    ;;; buffer, the save-excursion does not seem to work.  -pmr
3819    (defun rmail-visit-url-at-mouse (event)
3820      "Visit the URL underneath the mouse."
3821      (interactive "e")
3822      (save-window-excursion
3823    
3824        ;; Determine if the function has been invoked from a summary
3825        ;; buffer.
3826        (if (eq major-mode 'rmail-summary-mode)
3827    
3828            ;; It has.  DTRT.
3829            (progn
3830              (set-buffer rmail-buffer)
3831              (save-excursion
3832                (browse-url-at-mouse event)
3833                (rmail-show-message rmail-current-message))
3834              (switch-to-buffer rmail-summary-buffer))
3835    
3836          ;; The function has been invoked from an Rmail buffer.  Visit the
3837          ;; URL and then repaint the current message to reflect a visited
3838          ;; URL.
3839          (browse-url-at-mouse event)
3840          (rmail-show-message rmail-current-message))))
3841    
3842    (defun rmail-visit-url-at-point ()
3843      "Visit the URL at point."
3844      (interactive)
3845      (save-excursion
3846    
3847        ;; Visit the URL and then repaint the current message to reflect a
3848        ;; visited URL.
3849        (browse-url-at-point)
3850        (rmail-show-message rmail-current-message)))
3851    
3852    (defun rmail-browse-body ()
3853      "Send the message body to a browser to be rendered."
3854      (interactive)
3855      (save-excursion
3856        (save-restriction
3857          (goto-char (point-min))
3858          (search-forward "\n\n" (point-max) t)
3859          (narrow-to-region (point) (point-max))
3860          (browse-url-of-buffer))))
3861    
3862    ;;; New functions that need better placement.
3863    (defun rmail-get-sender ()
3864      "Return the message sender.
3865    The current buffer (possibly narrowed) contains a single message."
3866      (save-excursion
3867        (goto-char (point-min))
3868        (if (not (re-search-forward "^From:[ \t]*" nil t))
3869            "                         "
3870          (let* ((from (mail-strip-quoted-names
3871                        (buffer-substring
3872                         (1- (point))
3873                         ;; Get all the lines of the From field
3874                         ;; so that we get a whole comment if there is one,
3875                         ;; so that mail-strip-quoted-names can discard it.
3876                         (let ((opoint (point)))
3877                           (while (progn (forward-line 1)
3878                                         (looking-at "[ \t]")))
3879                           ;; Back up over newline, then trailing spaces or tabs
3880                           (forward-char -1)
3881                           (skip-chars-backward " \t")
3882                           (point)))))
3883                 len mch lo)
3884            (if (string-match (concat "^\\("
3885                                      (regexp-quote (user-login-name))
3886                                      "\\($\\|@\\)\\|"
3887                                      (regexp-quote
3888                                       ;; Don't lose if run from init file
3889                                       ;; where user-mail-address is not
3890                                       ;; set yet.
3891                                       (or user-mail-address
3892                                           (concat (user-login-name) "@"
3893                                                   (or mail-host-address
3894                                                       (system-name)))))
3895                                      "\\>\\)")
3896                              from)
3897                (save-excursion
3898                  (goto-char (point-min))
3899                  (if (not (re-search-forward "^To:[ \t]*" nil t))
3900                      nil
3901                    (setq from
3902                          (concat "to: "
3903                                  (mail-strip-quoted-names
3904                                   (buffer-substring
3905                                    (point)
3906                                    (progn (end-of-line)
3907                                           (skip-chars-backward " \t")
3908                                           (point)))))))))
3909            (setq len (length from))
3910            (setq mch (string-match "[@%]" from))
3911            (format "%25s"
3912                    (if (or (not mch) (<= len 25))
3913                        (substring from (max 0 (- len 25)))
3914                      (substring from
3915                                 (setq lo (cond ((< (- mch 14) 0) 0)
3916                                                ((< len (+ mch 11))
3917                                                 (- len 25))
3918                                                (t (- mch 14))))
3919                                 (min len (+ lo 25)))))))))
3920    
3921    
3922  ;;; rmail.el ends here  ;;; rmail.el ends here

Legend:
Removed from v.1.368  
changed lines
  Added in v.1.368.2.1

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