[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Rmail mbox diffs
|
From: |
Paul Michael Reilly |
|
Subject: |
Rmail mbox diffs |
|
Date: |
Mon, 26 Aug 2002 19:41:06 -0400 |
The following diffs and two new files enable Rmail to operate on Unix
mbox format files instead of Babyl format.
Feel free to give them a test run.
If you don't use Rmail presently, you can simply install these
changes and run M-x rmail.
If you currently use Rmail, then back up your RMAIL file first and
save all the messages to a Unix mbox folder. After Rmail is running
you can re-read that folder to get the messages back into the RMAIL
file.
Other methods will work equally well no doubt.
Enjoy,
-pmr
Index: lisp/mail/rmail.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.363
diff -c -r1.363 rmail.el
*** lisp/mail/rmail.el 24 Aug 2002 14:26:06 -0000 1.363
--- lisp/mail/rmail.el 26 Aug 2002 23:28:25 -0000
***************
*** 38,46 ****
;; buffers, summary by topic or by regular expression, rmail-reply-prefix
;; variable, and a bury rmail buffer (wipe) command.
;;
! (require 'mail-utils)
! (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority
; These variables now declared in paths.el.
;(defvar rmail-spool-directory "/usr/spool/mail/"
--- 38,61 ----
;; buffers, summary by topic or by regular expression, rmail-reply-prefix
;; variable, and a bury rmail buffer (wipe) command.
;;
+ (provide 'rmail)
+
+ (eval-when-compile
+ (require 'font-lock)
+ (require 'mail-utils)
+ (require 'mailabbrev)
+ (require 'mailalias)
+ (require 'mule-util) ; for detect-coding-with-priority
+ (require 'rfc822)
+ (require 'rmailout)
+ (require 'rmailsum)
+ (require 'sendmail)
+ (require 'speedbar))
! (eval-and-compile
! (require 'browse-url)
! (require 'rmaildesc)
! (require 'rmailhdr))
; These variables now declared in paths.el.
;(defvar rmail-spool-directory "/usr/spool/mail/"
***************
*** 91,97 ****
:prefix "rmail-edit-"
:group 'rmail)
-
(defcustom rmail-movemail-program nil
"If non-nil, name of program for fetching new mail."
:group 'rmail-retrieve
--- 106,111 ----
***************
*** 148,154 ****
;;;###autoload
(defcustom rmail-ignored-headers
! (concat "^via:\\|^mail-from:\\|^origin:\\|^references:"
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
--- 162,168 ----
;;;###autoload
(defcustom rmail-ignored-headers
! (concat "^via:\\|^from \\|^origin:\\|^references:"
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
***************
*** 161,167 ****
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
"\\|^content-type:\\|^content-length:"
"\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:"
! "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:")
"*Regexp to match header fields that Rmail should normally hide.
This variable is used for reformatting the message header,
which normally happens once for each message,
--- 175,183 ----
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
"\\|^content-type:\\|^content-length:"
"\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:"
! "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:"
! "\\|^x-authentication-warning:\\|x-operating-system:"
! "\\|^x-babyl-v6-attributes:\\|x-babyl-v6-keywords:")
"*Regexp to match header fields that Rmail should normally hide.
This variable is used for reformatting the message header,
which normally happens once for each message,
***************
*** 173,179 ****
:group 'rmail-headers)
;;;###autoload
! (defcustom rmail-displayed-headers nil
"*Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'."
--- 189,196 ----
:group 'rmail-headers)
;;;###autoload
! (defcustom rmail-displayed-headers "\
! ^\\(to\\|from\\|sender\\|cc\\|date\\|subject\\|reply-to\\):[ \t]+"
"*Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'."
***************
*** 283,288 ****
--- 300,306 ----
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
"Regexp marking the end of an mmdf message")
+ ;;;###autoload
(defcustom rmail-message-filter nil
"If non-nil, a filter function for new messages in RMAIL.
Called with region narrowed to the message, including headers,
***************
*** 290,303 ****
:group 'rmail-headers
:type 'function)
(defcustom rmail-automatic-folder-directives nil
"List of directives specifying where to put a message.
Each element of the list is of the form:
(FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
! Where FOLDERNAME is the name of a BABYL format folder to put the
! message. If any of the field regexp's are nil, then it is ignored.
If FOLDERNAME is \"/dev/null\", it is deleted.
If FOLDERNAME is nil then it is deleted, and skipped.
--- 308,323 ----
:group 'rmail-headers
:type 'function)
+ ;;;###autoload
(defcustom rmail-automatic-folder-directives nil
"List of directives specifying where to put a message.
Each element of the list is of the form:
(FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
! Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox
! or Unix inbox format) folder to put the message. If any of the field
! regexp's are nil, then it is ignored.
If FOLDERNAME is \"/dev/null\", it is deleted.
If FOLDERNAME is nil then it is deleted, and skipped.
***************
*** 324,329 ****
--- 344,350 ----
(defvar rmail-reply-regexp
"\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
+ ;;;###autoload
(defcustom rmail-display-summary nil
"*If non-nil, Rmail always displays the summary buffer."
:group 'rmail-summary
***************
*** 349,360 ****
--- 370,384 ----
(defvar rmail-total-messages nil)
(put 'rmail-total-messages 'permanent-local t)
+ ;;; mbox: deprecated. -pmr
(defvar rmail-message-vector nil)
(put 'rmail-message-vector 'permanent-local t)
+ ;;; mbox: deprecated. -pmr
(defvar rmail-deleted-vector nil)
(put 'rmail-deleted-vector 'permanent-local t)
+ ;; mbox: deprecated. -pmr
(defvar rmail-msgref-vector nil
"In an Rmail buffer, a vector whose Nth element is a list (N).
When expunging renumbers messages, these lists are modified
***************
*** 387,400 ****
--- 411,427 ----
(defvar rmail-last-regexp nil)
(put 'rmail-last-regexp 'permanent-local t)
+ ;;;###autoload
(defcustom rmail-default-file "~/xmail"
"*Default file name for \\[rmail-output]."
:type 'file
:group 'rmail-files)
+
(defcustom rmail-default-rmail-file "~/XMAIL"
"*Default file name for \\[rmail-output-to-rmail-file]."
:type 'file
:group 'rmail-files)
+
(defcustom rmail-default-body-file "~/mailout"
"*Default file name for \\[rmail-output-body-to-file]."
:type 'file
***************
*** 486,494 ****
;;; Regexp matching the delimiter of messages in UNIX mail format
! ;;; (UNIX From lines), minus the initial ^. Note that if you change
! ;;; this expression, you must change the code in rmail-nuke-pinhead-header
! ;;; that knows the exact ordering of the \\( \\) subexpressions.
(defvar rmail-unix-mail-delimiter
(let ((time-zone-regexp
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
--- 513,520 ----
;;; Regexp matching the delimiter of messages in UNIX mail format
! ;;; (UNIX From lines), with an initial ^. Used in rmail-decode-from-line,
! ;;; which knows the exact ordering of the \\(...\\) subexpressions.
(defvar rmail-unix-mail-delimiter
(let ((time-zone-regexp
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
***************
*** 496,502 ****
"\\|"
"\\) *")))
(concat
! "From "
;; Many things can happen to an RFC 822 mailbox before it is put into
;; a `From' line. The leading phrase can be stripped, e.g.
--- 522,528 ----
"\\|"
"\\) *")))
(concat
! "^From "
;; Many things can happen to an RFC 822 mailbox before it is put into
;; a `From' line. The leading phrase can be stripped, e.g.
***************
*** 573,579 ****
(save-excursion
(unwind-protect
(progn
! (pop-to-buffer rmail-summary-buffer)
;; rmail-total-messages is a buffer-local var
;; in the rmail buffer.
;; This way we make it available for the body
--- 599,606 ----
(save-excursion
(unwind-protect
(progn
! ;;(pop-to-buffer rmail-summary-buffer)
! (set-buffer rmail-summary-buffer)
;; rmail-total-messages is a buffer-local var
;; in the rmail buffer.
;; This way we make it available for the body
***************
*** 594,600 ****
(defvar rmail-enable-multibyte nil)
!
(defun rmail-require-mime-maybe ()
"Require `rmail-mime-feature' if that is non-nil.
Signal an error and set `rmail-mime-feature' to nil if the feature
--- 621,627 ----
(defvar rmail-enable-multibyte nil)
! ;;; mbox don't care
(defun rmail-require-mime-maybe ()
"Require `rmail-mime-feature' if that is non-nil.
Signal an error and set `rmail-mime-feature' to nil if the feature
***************
*** 608,613 ****
--- 635,641 ----
(setq rmail-enable-mime nil)))))
+ ;;; mbox ready
;;;###autoload
(defun rmail (&optional file-name-arg)
"Read and edit incoming mail.
***************
*** 670,693 ****
(setq run-mail-hook t)
(rmail-mode-2)
;; Convert all or part to Babyl file if possible.
! (rmail-convert-file)
(goto-char (point-max)))
;; As we have read a file by raw-text, the buffer is set to
;; unibyte. We must make it multibyte if necessary.
(if (and rmail-enable-multibyte
(not enable-multibyte-characters))
(set-buffer-multibyte t))
! ;; If necessary, scan to find all the messages.
! (rmail-maybe-set-message-counters)
! (unwind-protect
! (unless (and (not file-name-arg)
! (rmail-get-new-mail))
! (rmail-show-message (rmail-first-unseen-message)))
! (progn
! (if rmail-display-summary (rmail-summary))
! (rmail-construct-io-menu)
! (if run-mail-hook
! (run-hooks 'rmail-mode-hook))))))
;; Given the value of MAILPATH, return a list of inbox file names.
;; This is turned off because it is not clear that the user wants
--- 698,731 ----
(setq run-mail-hook t)
(rmail-mode-2)
;; Convert all or part to Babyl file if possible.
! ;;; (rmail-convert-file)
(goto-char (point-max)))
;; As we have read a file by raw-text, the buffer is set to
;; unibyte. We must make it multibyte if necessary.
(if (and rmail-enable-multibyte
(not enable-multibyte-characters))
(set-buffer-multibyte t))
!
! ;; Initialize the Rmail state and process any messages in the buffer.
! (rmail-initialize-messages)
!
! ;; Get new mail only if there is no explicit file argument.
! (and (not file-name-arg) (rmail-get-new-mail))
!
! ;; Deal with the summary display.
! (if rmail-display-summary (rmail-summary))
!
! ;; Show the first unseen message or, if all messages have been
! ;; seen, the last message.
! (rmail-show-message (or (rmail-first-unseen-message)
! rmail-total-messages))
!
! ;; Not sure what this is all about.
! (rmail-construct-io-menu)
!
! ;; Run any User callbacks.
! (if run-mail-hook
! (run-hooks 'rmail-mode-hook))))
;; Given the value of MAILPATH, return a list of inbox file names.
;; This is turned off because it is not clear that the user wants
***************
*** 708,713 ****
--- 746,752 ----
;; This calls rmail-decode-babyl-format if the file is already Babyl.
+ ;;; mbox: DEPECATED
(defun rmail-convert-file ()
(let (convert)
(widen)
***************
*** 752,767 ****
;; We still have to decode BABYL part.
(rmail-decode-babyl-format)))))
(defun rmail-insert-rmail-file-header ()
! (let ((buffer-read-only nil))
! ;; -*-rmail-*- is here so that visiting the file normally
! ;; recognizes it as an Rmail file.
! (insert "BABYL OPTIONS: -*- rmail -*-
! Version: 5
Labels:
Note: This is the header of an rmail file.
Note: If you are seeing it in rmail,
! Note: it means the file has no messages in it.\n\^_")))
;; Decode Babyl formatted part at the head of current buffer by
;; rmail-file-coding-system, or if it is nil, do auto conversion.
--- 791,822 ----
;; We still have to decode BABYL part.
(rmail-decode-babyl-format)))))
+ ;;;###deprecated
(defun rmail-insert-rmail-file-header ()
! (let ((buffer-read-only nil)
! (header-line "X-BABYL: -*-rmail-*-"))
! ;; Determine if the header has already been inserted.
! (goto-char (point-min))
! (if (not (looking-at "X-BABYL: "))
! ;; The header has not been inserted. Insert -*-rmail-*- here
! ;; so that visiting the file normally recognizes it as an
! ;; Rmail file.
! (insert (concat header-line "\nX-BABYL-Version: 6
! Version: 6
Labels:
Note: This is the header of an rmail file.
Note: If you are seeing it in rmail,
! Note: it means the file has no messages in it.")))))
!
! (defun rmail-initialize-messages ()
! "Initialize message state and process the messages in the buffer to
! update message state."
! (setq rmail-total-messages 0
! rmail-current-message 1)
! (rmail-desc-clear-descriptors)
! (widen)
! (rmail-header-show-headers)
! (setq rmail-total-messages (rmail-process-new-messages)))
;; Decode Babyl formatted part at the head of current buffer by
;; rmail-file-coding-system, or if it is nil, do auto conversion.
***************
*** 801,812 ****
--- 856,869 ----
(or coding-system 'undecided))))
(defvar rmail-mode-map nil)
+ (defvar rmail-url-map nil)
(if rmail-mode-map
nil
(setq rmail-mode-map (make-keymap))
(suppress-keymap rmail-mode-map)
(define-key rmail-mode-map "a" 'rmail-add-label)
(define-key rmail-mode-map "b" 'rmail-bury)
+ (define-key rmail-mode-map "B" 'rmail-browse-body)
(define-key rmail-mode-map "c" 'rmail-continue)
(define-key rmail-mode-map "d" 'rmail-delete-forward)
(define-key rmail-mode-map "\C-d" 'rmail-delete-backward)
***************
*** 815,821 ****
(define-key rmail-mode-map "g" 'rmail-get-new-mail)
(define-key rmail-mode-map "h" 'rmail-summary)
(define-key rmail-mode-map "i" 'rmail-input)
! (define-key rmail-mode-map "j" 'rmail-show-message)
(define-key rmail-mode-map "k" 'rmail-kill-label)
(define-key rmail-mode-map "l" 'rmail-summary-by-labels)
(define-key rmail-mode-map "\e\C-h" 'rmail-summary)
--- 872,878 ----
(define-key rmail-mode-map "g" 'rmail-get-new-mail)
(define-key rmail-mode-map "h" 'rmail-summary)
(define-key rmail-mode-map "i" 'rmail-input)
! (define-key rmail-mode-map "j" 'rmail-message)
(define-key rmail-mode-map "k" 'rmail-kill-label)
(define-key rmail-mode-map "l" 'rmail-summary-by-labels)
(define-key rmail-mode-map "\e\C-h" 'rmail-summary)
***************
*** 828,834 ****
(define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
(define-key rmail-mode-map "\en" 'rmail-next-message)
(define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
! (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
(define-key rmail-mode-map "\C-o" 'rmail-output)
(define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
(define-key rmail-mode-map "\ep" 'rmail-previous-message)
--- 885,891 ----
(define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
(define-key rmail-mode-map "\en" 'rmail-next-message)
(define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
! (define-key rmail-mode-map "o" 'rmail-output)
(define-key rmail-mode-map "\C-o" 'rmail-output)
(define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
(define-key rmail-mode-map "\ep" 'rmail-previous-message)
***************
*** 858,864 ****
(define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
(define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
(define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
! )
(define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
--- 915,927 ----
(define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
(define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
(define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
!
! ;; Set up a keymap derived from the standard Rmail mode keymap to
! ;; send activated URLs to a browser.
! (setq rmail-url-map (make-sparse-keymap))
! (set-keymap-parent rmail-url-map rmail-mode-map)
! (define-key rmail-url-map [mouse-2] 'rmail-visit-url-at-mouse)
! (define-key rmail-url-map "\r" 'rmail-visit-url-at-point))
(define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
***************
*** 878,884 ****
'("Output (inbox)..." . rmail-output))
(define-key rmail-mode-map [menu-bar classify output]
! '("Output (Rmail)..." . rmail-output-to-rmail-file))
(define-key rmail-mode-map [menu-bar classify kill-label]
'("Kill Label..." . rmail-kill-label))
--- 941,947 ----
'("Output (inbox)..." . rmail-output))
(define-key rmail-mode-map [menu-bar classify output]
! '("Output (Rmail)..." . rmail-output))
(define-key rmail-mode-map [menu-bar classify kill-label]
'("Kill Label..." . rmail-kill-label))
***************
*** 1149,1166 ****
(progn
(set-buffer rmail-buffer)
(rmail-mode-2)
! ;; Convert all or part to Babyl file if possible.
! (rmail-convert-file)
;; We have read the file as raw-text, so the buffer is set to
;; unibyte. Make it multibyte if necessary.
(if (and rmail-enable-multibyte
(not enable-multibyte-characters))
(set-buffer-multibyte t))
! (goto-char (point-max))
! (rmail-set-message-counters)
(rmail-show-message rmail-total-messages)
(run-hooks 'rmail-mode-hook)))))
;; Return a list of files from this buffer's Mail: option.
;; Does not assume that messages have been parsed.
;; Just returns nil if buffer does not look like Babyl format.
--- 1212,1228 ----
(progn
(set-buffer rmail-buffer)
(rmail-mode-2)
!
;; We have read the file as raw-text, so the buffer is set to
;; unibyte. Make it multibyte if necessary.
(if (and rmail-enable-multibyte
(not enable-multibyte-characters))
(set-buffer-multibyte t))
! (rmail-initialize-messages)
(rmail-show-message rmail-total-messages)
(run-hooks 'rmail-mode-hook)))))
+ ;; NOT DONE
;; Return a list of files from this buffer's Mail: option.
;; Does not assume that messages have been parsed.
;; Just returns nil if buffer does not look like Babyl format.
***************
*** 1179,1193 ****
(goto-char (point-min))
(mail-parse-comma-list))))))))
(defun rmail-expunge-and-save ()
"Expunge and save RMAIL file."
(interactive)
(rmail-expunge)
- (set-buffer rmail-buffer)
(save-buffer)
(if (rmail-summary-exists)
! (rmail-select-summary (set-buffer-modified-p nil))))
(defun rmail-quit ()
"Quit out of RMAIL.
Hook `rmail-quit-hook' is run after expunging."
--- 1241,1265 ----
(goto-char (point-min))
(mail-parse-comma-list))))))))
+ ;;; mbox: ready
(defun rmail-expunge-and-save ()
"Expunge and save RMAIL file."
(interactive)
(rmail-expunge)
(save-buffer)
+ (rmail-display-summary-maybe))
+
+ ;;; mbox: ready
+ (defun rmail-display-summary-maybe ()
+ "If a summary buffer exists then make sure it is updated and displayed."
(if (rmail-summary-exists)
! (let ((current-message rmail-current-message))
! (rmail-select-summary
! (rmail-summary-goto-msg current-message)
! (rmail-summary-rmail-update)
! (set-buffer-modified-p nil)))))
+ ;;; mbox: ready
(defun rmail-quit ()
"Quit out of RMAIL.
Hook `rmail-quit-hook' is run after expunging."
***************
*** 1211,1216 ****
--- 1283,1289 ----
(quit-window)
(replace-buffer-in-windows obuf))))
+ ;;; mbox: ready
(defun rmail-bury ()
"Bury current Rmail buffer and its summary buffer."
(interactive)
***************
*** 1224,1229 ****
--- 1297,1303 ----
(bury-buffer rmail-summary-buffer)))
(quit-window)))
+ ;;; mbox: not ready
(defun rmail-duplicate-message ()
"Create a duplicated copy of the current message.
The duplicate copy goes into the Rmail file just after the
***************
*** 1232,1240 ****
(widen)
(let ((buffer-read-only nil)
(number rmail-current-message)
! (string (buffer-substring (rmail-msgbeg rmail-current-message)
! (rmail-msgend rmail-current-message))))
! (goto-char (rmail-msgend rmail-current-message))
(insert string)
(rmail-forget-messages)
(rmail-show-message number)
--- 1306,1314 ----
(widen)
(let ((buffer-read-only nil)
(number rmail-current-message)
! (string (buffer-substring (rmail-desc-get-start rmail-current-message)
! (rmail-desc-get-end rmail-current-message))))
! (goto-char (rmail-desc-get-end rmail-current-message))
(insert string)
(rmail-forget-messages)
(rmail-show-message number)
***************
*** 1307,1313 ****
(cons "Output Rmail File"
(rmail-list-to-menu "Output Rmail File"
files
! 'rmail-output-to-rmail-file))))
(define-key rmail-mode-map [menu-bar classify input-menu]
'("Input Rmail File" . rmail-disable-menu))
--- 1381,1387 ----
(cons "Output Rmail File"
(rmail-list-to-menu "Output Rmail File"
files
! 'rmail-output))))
(define-key rmail-mode-map [menu-bar classify input-menu]
'("Input Rmail File" . rmail-disable-menu))
***************
*** 1320,1325 ****
--- 1394,1400 ----
;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.
+ ;;; DOC NOT DONE
(defun rmail-get-new-mail (&optional file-name)
"Move any new mail from this RMAIL file's inbox files.
The inbox files can be specified with the file's Mail: option. The
***************
*** 1346,1352 ****
(or (verify-visited-file-modtime (current-buffer))
(find-file (buffer-file-name)))
(set-buffer rmail-buffer)
- (rmail-maybe-set-message-counters)
(widen)
;; Get rid of all undo records for this buffer.
(or (eq buffer-undo-list t)
--- 1421,1426 ----
***************
*** 1354,1360 ****
(let ((all-files (if file-name (list file-name)
rmail-inbox-list))
(rmail-enable-multibyte (default-value 'enable-multibyte-characters))
! found)
(unwind-protect
(progn
(while all-files
--- 1428,1434 ----
(let ((all-files (if file-name (list file-name)
rmail-inbox-list))
(rmail-enable-multibyte (default-value 'enable-multibyte-characters))
! found current-message)
(unwind-protect
(progn
(while all-files
***************
*** 1367,1373 ****
(buffer-read-only nil)
;; Don't make undo records for what we do in getting mail.
(buffer-undo-list t)
- success
;; Files to insert this time around.
files
;; Last names of those files.
--- 1441,1446 ----
***************
*** 1386,1396 ****
;; Put them back in their original order.
(setq files (nreverse files))
- (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
(save-excursion
(save-restriction
(narrow-to-region (point) (point))
;; Read in the contents of the inbox files,
;; renaming them as necessary,
--- 1459,1467 ----
;; Put them back in their original order.
(setq files (nreverse files))
(save-excursion
(save-restriction
+ (goto-char (point-max))
(narrow-to-region (point) (point))
;; Read in the contents of the inbox files,
;; renaming them as necessary,
***************
*** 1398,1433 ****
(if file-name
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t)))
! ;; Scan the new text and convert each message to babyl format.
! (goto-char (point-min))
! (unwind-protect
! (save-excursion
! (setq new-messages (rmail-convert-to-babyl-format)
! success t))
! ;; Try to delete the garbage just inserted.
! (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.
(while delete-files
(condition-case ()
;; First, try deleting.
--- 1469,1481 ----
(if file-name
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t)))
! (unless (equal (point-min) (point-max))
! (setq new-messages (rmail-process-new-messages)
! rmail-current-message (1+ rmail-total-messages)
! rmail-total-messages (rmail-desc-get-count))
! (run-hooks 'rmail-get-new-mail-hook)
! (save-buffer))
! ;; Delete the old files, now that the RMAIL file is saved.
(while delete-files
(condition-case ()
;; First, try deleting.
***************
*** 1442,1456 ****
(progn (goto-char opoint)
(if (or file-name rmail-inbox-list)
(message "(No new mail has arrived)")))
(if (rmail-summary-exists)
! (rmail-select-summary
! (rmail-update-summary)))
(message "%d new message%s read"
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)
(setq found t))))
found)
;; Don't leave the buffer screwed up if we get a disk-full error.
--- 1490,1507 ----
(progn (goto-char opoint)
(if (or file-name rmail-inbox-list)
(message "(No new mail has arrived)")))
+
+ ;; Make the first unseen message the current message
+ ;; and update the summary buffer, if one exists.
+ (setq current-message (rmail-first-unseen-message))
(if (rmail-summary-exists)
! (with-current-buffer rmail-summary-buffer
! (rmail-update-summary)
! (rmail-summary-goto-msg current-message))
! (rmail-show-message current-message))
! (run-hooks 'rmail-after-get-new-mail-hook)
(message "%d new message%s read"
new-messages (if (= 1 new-messages) "" "s"))
(setq found t))))
found)
;; Don't leave the buffer screwed up if we get a disk-full error.
***************
*** 1613,1618 ****
--- 1664,1670 ----
(decode-coding-region from to coding))
;; the rmail-break-forwarded-messages feature is not implemented
+ ;;; NOT DONE but not called any more
(defun rmail-convert-to-babyl-format ()
(let ((count 0) start
(case-fold-search nil)
***************
*** 1835,1840 ****
--- 1887,1893 ----
(t
(message "Malformed MIME quoted-printable message")))))
+ ;;; DEPRECATED -pmr 2002-MM-DD
;; Delete the "From ..." line, creating various other headers with
;; information from it if they don't already exist. Now puts the
;; original line into a mail-from: header line for debugging and for
***************
*** 1956,1969 ****
(1- (point))
(point-max)))))))))
! (defun rmail-msg-is-pruned ()
! (rmail-maybe-set-message-counters)
! (save-restriction
! (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
! (save-excursion
! (goto-char (point-min))
! (forward-line 1)
! (= (following-char) ?1))))
(defun rmail-msg-restore-non-pruned-header ()
(let ((old-point (point))
--- 2009,2019 ----
(1- (point))
(point-max)))))))))
! (defun rmail-msg-is-pruned (&optional msg)
! "Determine if the headers for the current message are being
! displayed. If MSG is non-nil it will be used as the message number
! instead of the current message."
! (rmail-desc-get-header-display-state (or msg rmail-current-message)))
(defun rmail-msg-restore-non-pruned-header ()
(let ((old-point (point))
***************
*** 2013,2070 ****
With argument ARG, show the message header pruned if ARG is greater than zero;
otherwise, show it in full."
(interactive "P")
! (let* ((pruned (with-current-buffer rmail-buffer
! (rmail-msg-is-pruned)))
! (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))))
(defun rmail-narrow-to-non-pruned-header ()
"Narrow to the whole (original) header of the current message."
(let (start end)
! (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
(goto-char (point-min))
(forward-line 1)
(if (= (following-char) ?1)
--- 2063,2075 ----
With argument ARG, show the message header pruned if ARG is greater than zero;
otherwise, show it in full."
(interactive "P")
! (rmail-header-toggle-visibility arg)
! (rmail-highlight-headers))
(defun rmail-narrow-to-non-pruned-header ()
"Narrow to the whole (original) header of the current message."
(let (start end)
! (narrow-to-region (rmail-desc-get-start rmail-current-message)
(point-max))
(goto-char (point-min))
(forward-line 1)
(if (= (following-char) ?1)
***************
*** 2091,2143 ****
;;;; *** Rmail Attributes and Keywords ***
! ;; Make a string describing current message's attributes and keywords
! ;; and set it up as the name of a minor mode
! ;; so it will appear in the mode line.
(defun rmail-display-labels ()
! (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))
! (save-excursion
! (unwind-protect
! (progn
! (widen)
! (goto-char (rmail-msgbeg rmail-current-message))
! (forward-line 1)
! (if (looking-at "[01],")
! (progn
! (narrow-to-region (point) (progn (end-of-line) (point)))
! ;; Truly valid BABYL format requires a space before each
! ;; 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)))))
(setq mode-line-process
! (format " %d/%d%s"
! rmail-current-message rmail-total-messages blurb))
;; If rmail-enable-mime is non-nil, we may have to update
;; `mode-line-process' of rmail-view-buffer too.
(if (and rmail-enable-mime
--- 2096,2120 ----
;;;; *** Rmail Attributes and Keywords ***
! ;; Make a string describing the current message's attributes by
! ;; keywords and set it up as the name of a minor mode so it will
! ;; appear in the mode line.
(defun rmail-display-labels ()
! (let (keyword-list result)
!
! ;; Update the keyword list for the current message.
! (if (> rmail-current-message 0)
! (setq keyword-list (rmail-desc-get-keywords rmail-current-message)))
!
! ;; Generate the result string.
! (setq result (mapconcat '(lambda (arg) arg) keyword-list " "))
!
! ;; Update the mode line to display the keywords, the current
! ;; message index and the total number of messages.
(setq mode-line-process
! (format " %d/%d %s"
! rmail-current-message rmail-total-messages result))
!
;; If rmail-enable-mime is non-nil, we may have to update
;; `mode-line-process' of rmail-view-buffer too.
(if (and rmail-enable-mime
***************
*** 2151,2186 ****
;; ATTR is the name of the attribute, as a string.
;; MSGNUM is message number to change; nil means current message.
(defun rmail-set-attribute (attr state &optional msgnum)
! (set-buffer rmail-buffer)
! (let ((omax (point-max-marker))
! (omin (point-min-marker))
! (buffer-read-only nil))
! (or msgnum (setq msgnum rmail-current-message))
! (if (> msgnum 0)
! (unwind-protect
! (save-excursion
! (widen)
! (goto-char (+ 3 (rmail-msgbeg msgnum)))
! (let ((curstate
! (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))))))
;; Return t if the attributes/keywords line of msg number MSG
;; contains a match for the regexp LABELS.
--- 2128,2144 ----
;; ATTR is the name of the attribute, as a string.
;; MSGNUM is message number to change; nil means current message.
(defun rmail-set-attribute (attr state &optional msgnum)
! (save-excursion
! (save-restriction
! (let ((attr-index (rmail-desc-get-attr-index attr)))
! (set-buffer rmail-buffer)
! (or msgnum (setq msgnum rmail-current-message))
! (rmail-desc-set-attribute attr-index state msgnum)
!
! ;; Deal with the summary buffer.
! (if rmail-summary-buffer
! (with-current-buffer rmail-summary-buffer
! (rmail-summary-update-attribute attr-index msgnum)))))))
;; Return t if the attributes/keywords line of msg number MSG
;; contains a match for the regexp LABELS.
***************
*** 2188,2195 ****
(save-excursion
(save-restriction
(widen)
! (goto-char (rmail-msgbeg msg))
! (forward-char 3)
(re-search-backward labels (prog1 (point) (end-of-line)) t))))
;;;; *** Rmail Message Selection And Support ***
--- 2146,2153 ----
(save-excursion
(save-restriction
(widen)
! (goto-char (rmail-desc-get-start msg))
! (forward-line 1)
(re-search-backward labels (prog1 (point) (end-of-line)) t))))
;;;; *** Rmail Message Selection And Support ***
***************
*** 2211,2226 ****
(save-excursion
(unwind-protect
(progn
! (narrow-to-region (rmail-msgbeg rmail-current-message)
(point-max))
(goto-char (point-min))
(funcall function))
;; 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 (rmail-msgbeg rmail-current-message)
! (rmail-msgend rmail-current-message)))))
(defun rmail-forget-messages ()
(unwind-protect
(if (vectorp rmail-message-vector)
--- 2169,2296 ----
(save-excursion
(unwind-protect
(progn
! (narrow-to-region (rmail-desc-get-start rmail-current-message)
(point-max))
(goto-char (point-min))
(funcall function))
;; 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 (rmail-desc-get-start rmail-current-message)
! (rmail-desc-get-end rmail-current-message)))))
!
! (defun rmail-process-new-messages (&optional nomsg)
! "Process the new messages in the buffer. The buffer has been
! narrowed to expose only the new messages. For each new message append
! an entry to the message vector and, if necessary, add a header that
! will capture the salient BABYL information. Return the number of new
! messages. If NOMSG is non-nil then do not show any progress
! messages."
! (let ((inhibit-read-only t)
! (case-fold-search nil)
! (new-message-counter 0)
! (start (point-max))
! end attributes keywords message-descriptor-list date)
! (or nomsg (message "Processing new messages..."))
!
! ;; Process each message in turn starting from the back and
! ;; proceeding to the front of the region. This is especially a
! ;; good approach since the buffer will likely have new headers
! ;; added.
! (goto-char start)
! (while (re-search-backward rmail-unix-mail-delimiter nil t)
!
! ;; Cache the message date to facilitate generating a message
! ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON
! ;; YEAR TIME)
! (setq date
! (list (buffer-substring (match-beginning 2) (match-end 2))
! (buffer-substring (match-beginning 4) (match-end 4))
! (buffer-substring (match-beginning 3) (match-end 3))
! (buffer-substring (match-beginning 7) (match-end 7))
! (buffer-substring (match-beginning 5) (match-end 5))))
!
+ ;;Set start and end to bracket this message.
+ (setq end start)
+ (setq start (point))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+
+ ;; Bump the new message counter.
+ (setq new-message-counter (1+ new-message-counter))
+
+ ;; I don't understand why the following is done ... -pmr
+ ;; Detect messages that have been added with DOS line
+ ;; endings and convert the line endings for such messages.
+ (if (save-excursion (end-of-line) (= (preceding-char) ?\r))
+ (let ((buffer-read-only nil)
+ (buffer-undo t)
+ (end-marker (copy-marker end)))
+ (message
+ "Processing new messages...(converting line endings)")
+ (save-excursion
+ (goto-char (point-max))
+ (while (search-backward "\r\n" (point-min) t)
+ (delete-char 1)))
+ (setq end (marker-position end-marker))
+ (set-marker end-marker nil)))
+
+ ;; Make sure we have an Rmail BABYL attribute header field.
+ ;; All we can assume is that the Rmail BABYL header field is
+ ;; in the header section. It's placement can be modified by
+ ;; another mailer.
+ (setq attributes
+ (rmail-header-get-header rmail-header-attribute-header))
+ (unless attributes
+
+ ;; No suitable header exists. Append the default BABYL
+ ;; data header for a new message.
+ (setq attributes (rmail-desc-get-default-attrs))
+ (rmail-header-add-header
+ rmail-header-attribute-header attributes))
+
+ ;; Set up keywords, if any. The keywords are provided via a
+ ;; comma separated list and returned as a list of strings.
+ (setq keywords (rmail-header-get-keywords))
+ (if keywords
+
+ ;; Keywords do exist. Register them with the keyword
+ ;; management library.
+ (rmail-keyword-register-keywords keywords))
+
+
+ ;; Insure that we have From and Date headers.
+ ;;(rmail-decode-from-line)
+
+ ;; Perform User defined filtering.
+ (save-excursion
+ (if rmail-message-filter (funcall rmail-message-filter)))
+
+ ;; Accumulate the message attributes along with the message
+ ;; markers and the message date list.
+ (setq message-descriptor-list
+ (vconcat (list (list (point-min-marker)
+ attributes
+ keywords
+ date
+ (count-lines start end)
+ (rmail-get-sender)
+ (rmail-header-get-header "subject")))
+ message-descriptor-list)))))
+
+ ;; Add the new message data lists to the Rmail message descriptor
+ ;; vector.
+ (rmail-desc-add-descriptors message-descriptor-list)
+
+ ;; Unless requested otherwise, show the number of new messages.
+ ;; Return the number of new messages.
+ (or nomsg (message "Processing new messages...done (%d)"
new-message-counter))
+ new-message-counter))
+
+ ;;; mbox: deprecated
(defun rmail-forget-messages ()
(unwind-protect
(if (vectorp rmail-message-vector)
***************
*** 2234,2239 ****
--- 2304,2310 ----
(setq rmail-msgref-vector nil)
(setq rmail-deleted-vector nil)))
+ ;;; mbox: deprecated
(defun rmail-maybe-set-message-counters ()
(if (not (and rmail-deleted-vector
rmail-message-vector
***************
*** 2276,2281 ****
--- 2347,2353 ----
(goto-char (point-min))
(or nomsg (message "Counting new messages...done (%d)" total-messages))))
+ ;;; DEPRECATED
(defun rmail-set-message-counters ()
(rmail-forget-messages)
(save-excursion
***************
*** 2283,2289 ****
(widen)
(let* ((point-save (point))
(total-messages 0)
! (messages-after-point)
(case-fold-search nil)
(messages-head nil)
(deleted-head nil))
--- 2355,2361 ----
(widen)
(let* ((point-save (point))
(total-messages 0)
! (messages-after-point nil)
(case-fold-search nil)
(messages-head nil)
(deleted-head nil))
***************
*** 2313,2320 ****
--- 2385,2396 ----
(setq i (1+ i))))
(message "Counting messages...done")))))
+ ;;; DEPRECATED
(defun rmail-set-message-counters-counter (&optional stop)
(let ((start (point))
+ (messages-head nil)
+ (deleted-head nil)
+ (total-messages 0)
next)
(while (search-backward "\n\^_\^L" stop t)
;; Detect messages that have been added with DOS line endings and
***************
*** 2342,2347 ****
--- 2418,2424 ----
(if (zerop (% (setq total-messages (1+ total-messages)) 20))
(message "Counting messages...%d" total-messages)))))
+ ;;; DEPRECATED
(defun rmail-beginning-of-message ()
"Show current message starting from the beginning."
(interactive)
***************
*** 2349,2365 ****
(defun rmail-show-message (&optional n no-summary)
"Show message number N (prefix argument), counting from start of file.
! If summary buffer is currently displayed, update current message there also."
(interactive "p")
(or (eq major-mode 'rmail-mode)
(switch-to-buffer rmail-buffer))
! (rmail-maybe-set-message-counters)
! (widen)
(if (zerop rmail-total-messages)
! (progn (narrow-to-region (point-min) (1- (point-max)))
! (goto-char (point-min))
! (setq mode-line-process nil))
(let (blurb coding-system)
(if (not n)
(setq n rmail-current-message)
(cond ((<= n 0)
--- 2426,2453 ----
(defun rmail-show-message (&optional n no-summary)
"Show message number N (prefix argument), counting from start of file.
! If NO-SUMMARY is non-nil, then do not update the summary buffer."
(interactive "p")
(or (eq major-mode 'rmail-mode)
(switch-to-buffer rmail-buffer))
!
! ;; If there are no messages to display, then provide a message to
! ;; indicate thusly.
(if (zerop rmail-total-messages)
!
! ;; There are no messages so display the Babyl boilerplate in the
! ;; presentation buffer. It is important to keep the boilerplate
! ;; out of the Rmail file so as not to break other mail agents.
! (progn
! (message "No messages to show. Add something better soon.")
! (rmail-display-labels)
! (force-mode-line-update))
!
! ;; There are messages. Show one.
(let (blurb coding-system)
+ ;; Set n to the first sane message based on the sign of n:
+ ;; positive but greater than the total number of messages -> n;
+ ;; negative -> 1.
(if (not n)
(setq n rmail-current-message)
(cond ((<= n 0)
***************
*** 2372,2439 ****
blurb "No following message"))
(t
(setq rmail-current-message n))))
! (let ((beg (rmail-msgbeg n)))
! (goto-char beg)
! (forward-line 1)
! (save-excursion
! (let ((end (rmail-msgend n)))
! (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.
! (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")
! (forward-line 1))
! (narrow-to-region (point) end))
! (rfc822-goto-eoh)
! (search-forward "\n*** EOOH ***\n" end t))
! (narrow-to-region beg (point))
! (goto-char (point-min))
! (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
! (let ((coding-system (intern (match-string 1))))
! (condition-case nil
! (progn
! (check-coding-system coding-system)
! (setq buffer-file-coding-system coding-system))
! (error
! (setq buffer-file-coding-system nil))))
! (setq buffer-file-coding-system nil)))))
! ;; Clear the "unseen" attribute when we show a message.
! (rmail-set-attribute "unseen" nil)
! (let ((end (rmail-msgend n)))
! ;; Reformat the header, or else find the reformatted header.
! (if (= (following-char) ?0)
! (rmail-reformat-message beg end)
! (search-forward "\n*** EOOH ***\n" end t)
! (narrow-to-region (point) end)))
! (goto-char (point-min))
! (walk-windows
! (function (lambda (window)
! (if (eq (window-buffer window) (current-buffer))
! (set-window-point window (point)))))
! nil t)
(rmail-display-labels)
(if (eq rmail-enable-mime t)
(funcall rmail-show-mime-function)
! (setq rmail-view-buffer rmail-buffer)
! )
(rmail-highlight-headers)
(if transient-mark-mode (deactivate-mark))
(run-hooks 'rmail-show-message-hook)
;; If there is a summary buffer, try to move to this message
;; in that buffer. But don't complain if this message
;; is not mentioned in the summary.
;; Don't do this at all if we were called on behalf
;; of cursor motion in the summary buffer.
(and (rmail-summary-exists) (not no-summary)
! (let ((curr-msg rmail-current-message))
! (rmail-select-summary
! (rmail-summary-goto-msg curr-msg t t))))
(with-current-buffer rmail-buffer
(rmail-auto-file))
(if blurb
(message blurb))))))
(defun rmail-redecode-body (coding)
"Decode the body of the current message using coding system CODING.
This is useful with mail messages that have malformed or missing
--- 2460,2554 ----
blurb "No following message"))
(t
(setq rmail-current-message n))))
!
! ;; Index into the Rmail message vector.
! (let ((beg (rmail-desc-get-start n))
! (end (rmail-desc-get-end n)))
!
! ;; Narrow the region to message N and display the headers
! ;; appropriately.
! (rmail-header-show-headers)
! (widen)
! (narrow-to-region beg end)
! (goto-char (point-min))
!
! ;; I think this is stale. -pmr
! ;;(rfc822-goto-eoh)
! ;;(narrow-to-region beg (point))
! ;;(goto-char (point-min))
! ;;(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
! ;; (let ((coding-system (intern (match-string 1))))
! ;; (check-coding-system coding-system)
! ;; (setq buffer-file-coding-system coding-system))
! ;; (setq buffer-file-coding-system nil))))
!
! ;; Do something here with the coding system, I'm not sure what. -pmr
! (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
! (let ((coding-system (intern (match-string 1))))
! (condition-case nil
! (progn
! (check-coding-system coding-system)
! (setq buffer-file-coding-system coding-system))
! (error
! (setq buffer-file-coding-system nil))))
! (setq buffer-file-coding-system nil))
!
! ;; Clear the "unseen" attribute when we show a message, unless
! ;; it is already cleared.
! (if (rmail-desc-attr-p rmail-desc-unseen-index n)
! (rmail-desc-set-attribute rmail-desc-unseen-index nil n))
!
! ;; More code that has been added that I ill understand.
! ;; (walk-windows
! ;; (function (lambda (window)
! ;; (if (eq (window-buffer window) (current-buffer))
! ;; (set-window-point window (point)))))
! ;; nil t)
!
(rmail-display-labels)
+
+ ;; Deal with MIME
(if (eq rmail-enable-mime t)
(funcall rmail-show-mime-function)
! (setq rmail-view-buffer rmail-buffer))
!
! ;; Deal with the message headers and URLs..
! (rmail-header-hide-headers)
(rmail-highlight-headers)
+ (rmail-activate-urls)
+
+ ;; ?
(if transient-mark-mode (deactivate-mark))
+
+ ;; Make sure that point in the Rmail window is at the beginning of
the buffer.
+ (set-window-point (get-buffer-window rmail-buffer) (point))
+
+ ;; Run any User code.
(run-hooks 'rmail-show-message-hook)
+
;; If there is a summary buffer, try to move to this message
;; in that buffer. But don't complain if this message
;; is not mentioned in the summary.
;; Don't do this at all if we were called on behalf
;; of cursor motion in the summary buffer.
(and (rmail-summary-exists) (not no-summary)
! (save-excursion
! (let ((curr-msg rmail-current-message))
! ;; Set the summary current message, disabling the
! ;; Rmail buffer update.
! (set-buffer rmail-summary-buffer)
! (rmail-summary-goto-msg curr-msg nil t))))
! ;;; (rmail-summary-rmail-update))))
!
! ;; What is going on here?
(with-current-buffer rmail-buffer
(rmail-auto-file))
+
+ ;; Post back any status messages.
(if blurb
(message blurb))))))
+ ;;; NOT DONE
(defun rmail-redecode-body (coding)
"Decode the body of the current message using coding system CODING.
This is useful with mail messages that have malformed or missing
***************
*** 2455,2505 ****
(or (eq major-mode 'rmail-mode)
(switch-to-buffer rmail-buffer))
(save-excursion
! (let ((pruned (rmail-msg-is-pruned)))
! (unwind-protect
! (let ((msgbeg (rmail-msgbeg rmail-current-message))
! (msgend (rmail-msgend rmail-current-message))
! x-coding-header)
! ;; We need the message headers pruned (we later restore
! ;; the pruned stat to what it was, see the end of
! ;; unwind-protect form).
! (or pruned
! (rmail-toggle-header 1))
! (narrow-to-region msgbeg msgend)
! (goto-char (point-min))
! (when (search-forward "\n*** EOOH ***\n" (point-max) t)
! (narrow-to-region msgbeg (point)))
! (goto-char (point-min))
! (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
! (let ((old-coding (intern (match-string 1)))
! (buffer-read-only nil))
! (check-coding-system old-coding)
! ;; Make sure the new coding system uses the same EOL
! ;; conversion, to prevent ^M characters from popping
! ;; up all over the place.
! (setq coding
! (coding-system-change-eol-conversion
! coding
! (coding-system-eol-type old-coding)))
! (setq x-coding-header (point-marker))
! (narrow-to-region msgbeg msgend)
! (encode-coding-region (point) msgend old-coding)
! (decode-coding-region (point) msgend coding)
! (setq last-coding-system-used coding)
! ;; Rewrite the coding-system header according
! ;; to what we did.
! (goto-char x-coding-header)
! (delete-region (point)
! (save-excursion
! (beginning-of-line)
! (point)))
! (insert "X-Coding-System: "
! (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)))))))
;; Find all occurrences of certain fields, and highlight them.
(defun rmail-highlight-headers ()
--- 2570,2614 ----
(or (eq major-mode 'rmail-mode)
(switch-to-buffer rmail-buffer))
(save-excursion
! (unwind-protect
! (let ((msgbeg (rmail-desc-get-start rmail-current-message))
! (msgend (rmail-desc-get-end rmail-current-message))
! x-coding-header)
! ;; We need the message headers pruned (we later restore
! ;; the pruned stat to what it was, see the end of
! ;; unwind-protect form).
! (rmail-header-show-headers)
! (narrow-to-region msgbeg msgend)
! (goto-char (point-min))
! (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
! (let ((old-coding (intern (match-string 1)))
! (buffer-read-only nil))
! (check-coding-system old-coding)
! ;; Make sure the new coding system uses the same EOL
! ;; conversion, to prevent ^M characters from popping
! ;; up all over the place.
! (setq coding
! (coding-system-change-eol-conversion
! coding
! (coding-system-eol-type old-coding)))
! (setq x-coding-header (point-marker))
! (narrow-to-region msgbeg msgend)
! (encode-coding-region (point) msgend old-coding)
! (decode-coding-region (point) msgend coding)
! (setq last-coding-system-used coding)
! ;; Rewrite the coding-system header according
! ;; to what we did.
! (goto-char x-coding-header)
! (delete-region (point)
! (save-excursion
! (beginning-of-line)
! (point)))
! (insert "X-Coding-System: "
! (symbol-name last-coding-system-used))
! (set-marker x-coding-header nil)
! (rmail-show-message))
! (error "No X-Coding-System header found")))
! (rmail-header-hide-headers)))))
;; Find all occurrences of certain fields, and highlight them.
(defun rmail-highlight-headers ()
***************
*** 2544,2549 ****
--- 2653,2659 ----
(setq rmail-overlay-list
(cons overlay rmail-overlay-list))))))))))
+ ;;; mbox ready
(defun rmail-auto-file ()
"Automatically move a message into a sub-folder based on criteria.
Called when a new message is displayed."
***************
*** 2556,2567 ****
(let ((from (mail-fetch-field "from"))
(subj (mail-fetch-field "subject"))
(to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
! (d rmail-automatic-folder-directives)
(directive-loop nil)
(folder nil))
! (while d
! (setq folder (car (car d))
! directive-loop (cdr (car d)))
(while (and (car directive-loop)
(let ((f (cond
((string= (car directive-loop) "from") from)
--- 2666,2677 ----
(let ((from (mail-fetch-field "from"))
(subj (mail-fetch-field "subject"))
(to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
! (directives rmail-automatic-folder-directives)
(directive-loop nil)
(folder nil))
! (while directives
! (setq folder (car (car directives))
! directive-loop (cdr (car directives)))
(while (and (car directive-loop)
(let ((f (cond
((string= (car directive-loop) "from") from)
***************
*** 2576,2584 ****
(rmail-delete-forward)
(if (string= "/dev/null" folder)
(rmail-delete-message)
! (rmail-output-to-rmail-file folder 1 t)
! (setq d nil))))
! (setq d (cdr d))))))
(defun rmail-next-message (n)
"Show following message whether deleted or not.
--- 2686,2694 ----
(rmail-delete-forward)
(if (string= "/dev/null" folder)
(rmail-delete-message)
! (rmail-output folder 1 t)
! (setq directives nil))))
! (setq directives (cdr directives))))))
(defun rmail-next-message (n)
"Show following message whether deleted or not.
***************
*** 2601,2627 ****
Returns t if a new message is being shown, nil otherwise."
(interactive "p")
- (set-buffer rmail-buffer)
- (rmail-maybe-set-message-counters)
(let ((lastwin rmail-current-message)
(current rmail-current-message))
(while (and (> n 0) (< current rmail-total-messages))
(setq current (1+ current))
! (if (not (rmail-message-deleted-p current))
! (setq lastwin current n (1- n))))
(while (and (< n 0) (> current 1))
(setq current (1- current))
! (if (not (rmail-message-deleted-p current))
! (setq lastwin current n (1+ n))))
(if (/= lastwin rmail-current-message)
! (progn (rmail-show-message lastwin)
! t)
(if (< n 0)
(message "No previous nondeleted message"))
(if (> n 0)
(message "No following nondeleted message"))
nil)))
(defun rmail-previous-undeleted-message (n)
"Show previous non-deleted message.
With prefix argument N, moves backward N non-deleted messages,
--- 2711,2749 ----
Returns t if a new message is being shown, nil otherwise."
(interactive "p")
(let ((lastwin rmail-current-message)
(current rmail-current-message))
+
+ ;; Handle forward movement looking for an undeleted message. Move
+ ;; forward a message at a time as long as there are subsequent
+ ;; messages. Stop if the last message is encountered.
(while (and (> n 0) (< current rmail-total-messages))
(setq current (1+ current))
! (if (not (rmail-desc-deleted-p current))
! (setq lastwin current
! n (1- n))))
!
! ;; Handle backward movement looking for an undeleted message.
! ;; Move backward a message at a time as long as there are
! ;; preceding messages. Stop if the first message is encountered.
(while (and (< n 0) (> current 1))
(setq current (1- current))
! (if (not (rmail-desc-deleted-p current))
! (setq lastwin current
! n (1+ n))))
!
! ;; Show the message (even if no movement took place so that the
! ;; delete attribute is marked) and determine the result value.
! (rmail-show-message lastwin)
(if (/= lastwin rmail-current-message)
! t
(if (< n 0)
(message "No previous nondeleted message"))
(if (> n 0)
(message "No following nondeleted message"))
nil)))
+ ;;; mbox: ready.
(defun rmail-previous-undeleted-message (n)
"Show previous non-deleted message.
With prefix argument N, moves backward N non-deleted messages,
***************
*** 2629,2702 ****
(interactive "p")
(rmail-next-undeleted-message (- n)))
(defun rmail-first-message ()
"Show first message in file."
(interactive)
- (rmail-maybe-set-message-counters)
(rmail-show-message 1))
(defun rmail-last-message ()
"Show last message in file."
(interactive)
- (rmail-maybe-set-message-counters)
(rmail-show-message rmail-total-messages))
(defun rmail-what-message ()
(let ((where (point))
(low 1)
(high rmail-total-messages)
(mid (/ rmail-total-messages 2)))
(while (> (- high low) 1)
! (if (>= where (rmail-msgbeg mid))
(setq low mid)
(setq high mid))
(setq mid (+ low (/ (- high low) 2))))
! (if (>= where (rmail-msgbeg high)) high low)))
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
(save-restriction
- (goto-char (rmail-msgbeg msg))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
(or (string-match recipients (or (mail-fetch-field "To") ""))
(string-match recipients (or (mail-fetch-field "From") ""))
(if (not primary-only)
(string-match recipients (or (mail-fetch-field "Cc") ""))))))
! (defun rmail-message-regexp-p (n regexp)
! "Return t, if for message number N, regexp REGEXP matches in the header."
! (let ((beg (rmail-msgbeg n))
! (end (rmail-msgend n)))
! (goto-char beg)
! (forward-line 1)
! (save-excursion
! (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)))))
(defun rmail-search-message (msg regexp)
"Return non-nil, if for message number MSG, regexp REGEXP matches."
! (goto-char (rmail-msgbeg msg))
(if rmail-enable-mime
(funcall rmail-search-mime-message-function msg regexp)
! (re-search-forward regexp (rmail-msgend msg) t)))
(defvar rmail-search-last-regexp nil)
(defun rmail-search (regexp &optional n)
"Show message containing next match for REGEXP (but not the current msg).
--- 2751,2816 ----
(interactive "p")
(rmail-next-undeleted-message (- n)))
+ ;;; mbox: ready.
(defun rmail-first-message ()
"Show first message in file."
(interactive)
(rmail-show-message 1))
+ ;;; mbox: ready
(defun rmail-last-message ()
"Show last message in file."
(interactive)
(rmail-show-message rmail-total-messages))
+ ;;; mbox: not called
(defun rmail-what-message ()
(let ((where (point))
(low 1)
(high rmail-total-messages)
(mid (/ rmail-total-messages 2)))
(while (> (- high low) 1)
! (if (>= where (rmail-desc-get-start mid))
(setq low mid)
(setq high mid))
(setq mid (+ low (/ (- high low) 2))))
! (if (>= where (rmail-desc-get-start high)) high low)))
!
! ;;; mbox: ready
! (defun rmail-narrow-to-header (msg)
! (save-excursion
! (let ((start (rmail-desc-get-start msg))
! (end (rmail-desc-get-end msg)))
! (widen)
! (goto-char start)
! (search-forward "\n\n" end nil t)
! (narrow-to-region start (point)))))
+ ;;; mbox: ready
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
(save-restriction
(or (string-match recipients (or (mail-fetch-field "To") ""))
(string-match recipients (or (mail-fetch-field "From") ""))
(if (not primary-only)
(string-match recipients (or (mail-fetch-field "Cc") ""))))))
! ;;; mbox: ready
! (defun rmail-message-regexp-p (msg regexp)
! "Return t, if for message number MSG, regexp REGEXP matches in the header."
! (save-excursion
! (save-restriction
! (rmail-narrow-to-header msg)
! (re-search-forward regexp nil t))))
+ ;;; mbox: ready
(defun rmail-search-message (msg regexp)
"Return non-nil, if for message number MSG, regexp REGEXP matches."
! (goto-char (rmail-desc-get-start msg))
(if rmail-enable-mime
(funcall rmail-search-mime-message-function msg regexp)
! (re-search-forward regexp (rmail-desc-get-end msg) t)))
+ ;;; mbox: ready
(defvar rmail-search-last-regexp nil)
(defun rmail-search (regexp &optional n)
"Show message containing next match for REGEXP (but not the current msg).
***************
*** 2725,2737 ****
(if (< n 0) "Reverse " "")
regexp)
(set-buffer rmail-buffer)
- (rmail-maybe-set-message-counters)
(let ((omin (point-min))
(omax (point-max))
(opoint (point))
- win
(reversep (< n 0))
! (msg rmail-current-message))
(unwind-protect
(progn
(widen)
--- 2839,2850 ----
(if (< n 0) "Reverse " "")
regexp)
(set-buffer rmail-buffer)
(let ((omin (point-min))
(omax (point-max))
(opoint (point))
(reversep (< n 0))
! (msg rmail-current-message)
! win)
(unwind-protect
(progn
(widen)
***************
*** 2793,2812 ****
(prefix-numeric-value current-prefix-arg))))
(rmail-search regexp (- (or n 1))))
- ;; Show the first message which has the `unseen' attribute.
(defun rmail-first-unseen-message ()
! (rmail-maybe-set-message-counters)
(let ((current 1)
found)
! (save-restriction
! (widen)
! (while (and (not found) (<= current rmail-total-messages))
! (if (rmail-message-labels-p current ", ?\\(unseen\\),")
! (setq found current))
! (setq current (1+ current))))
! ;; Let the caller show the message.
! ;; (if found
! ;; (rmail-show-message found))
found))
(defun rmail-next-same-subject (n)
--- 2906,2920 ----
(prefix-numeric-value current-prefix-arg))))
(rmail-search regexp (- (or n 1))))
(defun rmail-first-unseen-message ()
! "Show the first message which has not been seen. If all messages
! have been seen, then show the last message."
(let ((current 1)
found)
! (while (and (not found) (<= current rmail-total-messages))
! (if (rmail-desc-attr-p rmail-desc-unseen-index current)
! (setq found current))
! (setq current (1+ current)))
found))
(defun rmail-next-same-subject (n)
***************
*** 2831,2855 ****
(save-excursion
(save-restriction
(widen)
! (while (and (/= n 0)
! (if forward
! (< i rmail-total-messages)
! (> i 1)))
! (let (done)
! (while (and (not done)
! (if forward
! (< i rmail-total-messages)
! (> i 1)))
! (setq i (if forward (1+ i) (1- i)))
! (goto-char (rmail-msgbeg i))
! (search-forward "\n*** EOOH ***\n")
! (let ((beg (point)) end)
! (search-forward "\n\n")
! (setq end (point))
! (goto-char beg)
! (setq done (re-search-forward search-regexp end t))))
! (if done (setq found i)))
! (setq n (if forward (1- n) (1+ n))))))
(if found
(rmail-show-message found)
(error "No %s message with same subject"
--- 2939,2964 ----
(save-excursion
(save-restriction
(widen)
! (if forward
! (while (and (/= n 0) (< i rmail-total-messages))
! (let (done)
! (while (and (not done)
! (< i rmail-total-messages))
! (setq i (+ i 1))
! (rmail-narrow-to-header i)
! (goto-char (point-min))
! (setq done (re-search-forward search-regexp (point-max) t)))
! (if done (setq found i)))
! (setq n (1- n)))
! (while (and (/= n 0) (> i 1))
! (let (done)
! (while (and (not done) (> i 1))
! (setq i (- i 1))
! (rmail-narrow-to-header i)
! (goto-char (point-min))
! (setq done (re-search-forward search-regexp (point-max) t)))
! (if done (setq found i)))
! (setq n (1+ n))))))
(if found
(rmail-show-message found)
(error "No %s message with same subject"
***************
*** 2864,2871 ****
;;;; *** Rmail Message Deletion Commands ***
(defun rmail-message-deleted-p (n)
! (= (aref rmail-deleted-vector n) ?D))
(defun rmail-set-message-deleted-p (n state)
(aset rmail-deleted-vector n (if state ?D ?\ )))
--- 2973,2981 ----
;;;; *** Rmail Message Deletion Commands ***
+ ;;; mbox: ready
(defun rmail-message-deleted-p (n)
! (rmail-desc-deleted-p n))
(defun rmail-set-message-deleted-p (n state)
(aset rmail-deleted-vector n (if state ?D ?\ )))
***************
*** 2873,2880 ****
(defun rmail-delete-message ()
"Delete this message and stay on it."
(interactive)
! (rmail-set-attribute "deleted" t)
! (run-hooks 'rmail-delete-message-hook))
(defun rmail-undelete-previous-message ()
"Back up to deleted message, select it, and undelete it."
--- 2983,2991 ----
(defun rmail-delete-message ()
"Delete this message and stay on it."
(interactive)
! (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message)
! (run-hooks 'rmail-delete-message-hook)
! (rmail-show-message rmail-current-message))
(defun rmail-undelete-previous-message ()
"Back up to deleted message, select it, and undelete it."
***************
*** 2882,2900 ****
(set-buffer rmail-buffer)
(let ((msg rmail-current-message))
(while (and (> msg 0)
! (not (rmail-message-deleted-p msg)))
(setq msg (1- msg)))
(if (= msg 0)
(error "No previous deleted message")
! (if (/= msg rmail-current-message)
! (rmail-show-message msg))
! (rmail-set-attribute "deleted" nil)
(if (rmail-summary-exists)
(save-excursion
(set-buffer rmail-summary-buffer)
(rmail-summary-mark-undeleted msg)))
(rmail-maybe-display-summary))))
(defun rmail-delete-forward (&optional backward)
"Delete this message and move to next nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is
given.
--- 2993,3011 ----
(set-buffer rmail-buffer)
(let ((msg rmail-current-message))
(while (and (> msg 0)
! (not (rmail-desc-attr-p rmail-desc-deleted-index msg)))
(setq msg (1- msg)))
(if (= msg 0)
(error "No previous deleted message")
! (rmail-desc-set-attribute rmail-desc-deleted-index nil msg)
! (rmail-show-message msg)
(if (rmail-summary-exists)
(save-excursion
(set-buffer rmail-summary-buffer)
(rmail-summary-mark-undeleted msg)))
(rmail-maybe-display-summary))))
+ ;;; mbox: ready
(defun rmail-delete-forward (&optional backward)
"Delete this message and move to next nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is
given.
***************
*** 2902,2908 ****
Returns t if a new message is displayed after the delete, or nil otherwise."
(interactive "P")
! (rmail-set-attribute "deleted" t)
(run-hooks 'rmail-delete-message-hook)
(let ((del-msg rmail-current-message))
(if (rmail-summary-exists)
--- 3013,3019 ----
Returns t if a new message is displayed after the delete, or nil otherwise."
(interactive "P")
! (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message)
(run-hooks 'rmail-delete-message-hook)
(let ((del-msg rmail-current-message))
(if (rmail-summary-exists)
***************
*** 2911,2922 ****
--- 3022,3035 ----
(prog1 (rmail-next-undeleted-message (if backward -1 1))
(rmail-maybe-display-summary))))
+ ;;; mbox: ready
(defun rmail-delete-backward ()
"Delete this message and move to previous nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is
given."
(interactive)
(rmail-delete-forward t))
+ ;;; mbox: deprecated
;; Compute the message number a given message would have after expunging.
;; The present number of the message is OLDNUM.
;; DELETEDVEC should be rmail-deleted-vector.
***************
*** 2942,3042 ****
(funcall rmail-confirm-expunge
"Erase deleted messages from Rmail file? ")))
(defun rmail-only-expunge ()
"Actually erase all deleted messages in the file."
(interactive)
- (set-buffer rmail-buffer)
(message "Expunging deleted messages...")
;; Discard all undo records for this buffer.
! (or (eq buffer-undo-list t)
! (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))))))
(defun rmail-expunge ()
"Erase deleted messages from Rmail file and summary buffer."
(interactive)
(when (rmail-expunge-confirmed)
! (rmail-only-expunge)
! (if (rmail-summary-exists)
! (rmail-select-summary (rmail-update-summary)))))
;;;; *** Rmail Mailing Commands ***
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
replybuffer sendactions same-window others)
(let (yank-action)
--- 3055,3106 ----
(funcall rmail-confirm-expunge
"Erase deleted messages from Rmail file? ")))
+ ;;; mbox: ready
(defun rmail-only-expunge ()
"Actually erase all deleted messages in the file."
(interactive)
(message "Expunging deleted messages...")
+
;; Discard all undo records for this buffer.
! (or (eq buffer-undo-list t) (setq buffer-undo-list nil))
+ ;; Remove the messages from the buffer and from the Rmail message
+ ;; descriptor vector.
+ (rmail-desc-prune-deleted-messages 'rmail-expunge-callback)
+
+ ;; Update the Rmail message counter, deal with the summary buffer,
+ ;; show the current message and update the User status.
+ (setq rmail-total-messages (rmail-desc-get-count))
+ (rmail-show-message rmail-current-message t)
+ (if rmail-summary-buffer
+ (save-excursion
+ (set-buffer rmail-summary-buffer)
+ (rmail-update-summary)))
+ (message "Expunging deleted messages...done"))
+
+ ;;; We'll deal with this later. -pmr
+ ;;; (if rmail-enable-mime
+ ;;; (goto-char (+ (point-min) opoint))
+ ;;; (goto-char (+ (point) opoint))))))
+
+ ;;; mbox: ready
+ (defun rmail-expunge-callback (n)
+ "Called after message N has been pruned to update the current Rmail
+ message counter."
+ (if (< n rmail-current-message)
+ (setq rmail-current-message (1- rmail-current-message))))
+
+ ;;; mbox: ready
(defun rmail-expunge ()
"Erase deleted messages from Rmail file and summary buffer."
(interactive)
(when (rmail-expunge-confirmed)
! (rmail-only-expunge)))
;;;; *** Rmail Mailing Commands ***
+ ;;; mbox: In progress. I'm still not happy with the initial citation
+ ;;; stuff. -pmr
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
replybuffer sendactions same-window others)
(let (yank-action)
***************
*** 3073,3179 ****
(interactive)
(rmail-start-mail t))
(defun rmail-reply (just-sender)
"Reply to the current message.
Normally include CC: to all other recipients of original message;
prefix argument means ignore them. While composing the reply,
use \\[mail-yank-original] to yank the original message into it."
(interactive "P")
! (let (from reply-to cc subject date to message-id references
! resent-to resent-cc resent-reply-to
! (msgnum rmail-current-message))
! (save-excursion
! (save-restriction
! (if rmail-enable-mime
! (narrow-to-region
! (goto-char (point-min))
! (if (search-forward "\n\n" nil 'move)
! (1+ (match-beginning 0))
! (point)))
! (widen)
! (goto-char (rmail-msgbeg rmail-current-message))
! (forward-line 1)
! (if (= (following-char) ?0)
! (narrow-to-region
! (progn (forward-line 2)
! (point))
! (progn (search-forward "\n\n" (rmail-msgend
rmail-current-message)
! 'move)
! (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) "")
;;; resent-subject (mail-fetch-field "resent-subject")
;;; resent-date (mail-fetch-field "resent-date")
;;; resent-message-id (mail-fetch-field "resent-message-id")
! )))
! ;; Merge the resent-to and resent-cc into the to and cc.
! (if (and resent-to (not (equal resent-to "")))
! (if (not (equal to ""))
! (setq to (concat to ", " resent-to))
! (setq to resent-to)))
! (if (and resent-cc (not (equal resent-cc "")))
! (if (not (equal cc ""))
! (setq cc (concat cc ", " resent-cc))
! (setq cc resent-cc)))
! ;; Add `Re: ' to subject if not there already.
! (and (stringp subject)
! (setq subject
! (concat rmail-reply-prefix
! (if (let ((case-fold-search t))
! (string-match rmail-reply-regexp subject))
! (substring subject (match-end 0))
! subject))))
! (rmail-start-mail
! nil
! ;; Using mail-strip-quoted-names is undesirable with newer mailers
! ;; since they can handle the names unstripped.
! ;; I don't know whether there are other mailers that still
! ;; need the names to be stripped.
! (mail-strip-quoted-names reply-to)
! subject
! (rmail-make-in-reply-to-field from date message-id)
! (if just-sender
! nil
! ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to
! ;; to do its job.
! (let* ((cc-list (rmail-dont-reply-to
! (mail-strip-quoted-names
! (if (null cc) to (concat to ", " cc))))))
! (if (string= cc-list "") nil cc-list)))
! rmail-view-buffer
! (list (list 'rmail-mark-message
! rmail-buffer
! (with-current-buffer rmail-buffer
! (aref rmail-msgref-vector msgnum))
! "answered"))
! nil
! (list (cons "References" (concat (mapconcat 'identity references " ")
! " " message-id))))))
!
! (defun rmail-mark-message (buffer msgnum-list attribute)
! "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.
! This is use in the send-actions for message buffers.
! MSGNUM-LIST is a list of the form (MSGNUM)
! which is an element of rmail-msgref-vector."
(save-excursion
(set-buffer buffer)
! (if (car msgnum-list)
! (rmail-set-attribute attribute t (car msgnum-list)))))
(defun rmail-make-in-reply-to-field (from date message-id)
(cond ((not from)
--- 3137,3241 ----
(interactive)
(rmail-start-mail t))
+ ;;; mbox: ready -pmr
(defun rmail-reply (just-sender)
"Reply to the current message.
Normally include CC: to all other recipients of original message;
prefix argument means ignore them. While composing the reply,
use \\[mail-yank-original] to yank the original message into it."
(interactive "P")
! (save-excursion
! (save-restriction
! (let ((msgnum rmail-current-message)
! (display-state (rmail-desc-get-header-display-state
rmail-current-message))
! from reply-to cc subject date to message-id references
! resent-to resent-cc resent-reply-to)
! (rmail-header-show-headers)
! (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) ""))
;;; resent-subject (mail-fetch-field "resent-subject")
;;; resent-date (mail-fetch-field "resent-date")
;;; resent-message-id (mail-fetch-field "resent-message-id")
!
! ;; Merge the resent-to and resent-cc into the to and cc.
! (if (and resent-to (not (equal resent-to "")))
! (if (not (equal to ""))
! (setq to (concat to ", " resent-to))
! (setq to resent-to)))
! (if (and resent-cc (not (equal resent-cc "")))
! (if (not (equal cc ""))
! (setq cc (concat cc ", " resent-cc))
! (setq cc resent-cc)))
! ;; Add `Re: ' to subject if not there already.
! (and (stringp subject)
! (setq subject
! (concat rmail-reply-prefix
! (if (let ((case-fold-search t))
! (string-match rmail-reply-regexp subject))
! (substring subject (match-end 0))
! subject))))
! ;; Reset the headers display state before switching to the
! ;; reply buffer.
! (rmail-header-toggle-visibility display-state)
!
! ;; Now setup the mail reply buffer.
! (rmail-start-mail
! nil
! ;; Using mail-strip-quoted-names is undesirable with newer mailers
! ;; since they can handle the names unstripped.
! ;; I don't know whether there are other mailers that still
! ;; need the names to be stripped.
! (mail-strip-quoted-names reply-to)
! subject
! (rmail-make-in-reply-to-field from date message-id)
! (if just-sender
! nil
! ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to
! ;; to do its job.
! (let* ((cc-list (rmail-dont-reply-to
! (mail-strip-quoted-names
! (if (null cc) to (concat to ", " cc))))))
! (if (string= cc-list "") nil cc-list)))
! rmail-view-buffer
! (list (list 'rmail-reply-callback rmail-buffer "answered" t msgnum))
! nil
! (list (cons "References" (concat (mapconcat 'identity references " ")
! " " message-id))))))))
!
! (defun rmail-reply-callback (buffer attr state n)
! "Mail reply callback function. Sets ATTR (a string) if STATE is
! non-nil, otherwise clears it. N is the message number. BUFFER,
! possibly narrowed, contains an mbox mail message."
(save-excursion
(set-buffer buffer)
! (rmail-set-attribute attr state n)))
!
! (defun rmail-mark-message (msgnum-list attr-index)
! "Set the attribute denoted by ATTRIBUTE-INDEX in the message denoted
! by the car of MSGNUM-LIST. This is used in the send-actions for
! message buffers. MSGNUM-LIST is a list of the form (MSGNUM)."
! (save-excursion
! (let ((n (car msgnum-list)))
! (set-buffer rmail-buffer)
! (rmail-narrow-to-message n)
! (rmail-desc-set-attribute attr-index t n))))
!
! (defun rmail-narrow-to-message (n)
! "Set the narrowing restriction in the current (rmail) buffer to
! bracket message N."
! (widen)
! (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)))
(defun rmail-make-in-reply-to-field (from date message-id)
(cond ((not from)
***************
*** 3181,3187 ****
message-id
nil))
(mail-use-rfc822
- (require 'rfc822)
(let ((tem (car (rfc822-addresses from))))
(if message-id
(if (or (not tem)
--- 3243,3248 ----
***************
*** 3234,3239 ****
--- 3295,3301 ----
(let ((mail-use-rfc822 t))
(rmail-make-in-reply-to-field from date message-id)))))
+ ;;; mbox: ready
(defun rmail-forward (resend)
"Forward the current message to another user.
With prefix argument, \"resend\" the message instead of forwarding it;
***************
*** 3256,3262 ****
(list (list 'rmail-mark-message
forward-buffer
(with-current-buffer rmail-buffer
! (aref rmail-msgref-vector msgnum))
"forwarded"))
;; If only one window, use it for the mail buffer.
;; Otherwise, use another window for the mail buffer
--- 3318,3324 ----
(list (list 'rmail-mark-message
forward-buffer
(with-current-buffer rmail-buffer
! (rmail-desc-get-start msgnum))
"forwarded"))
;; If only one window, use it for the mail buffer.
;; Otherwise, use another window for the mail buffer
***************
*** 3301,3308 ****
Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
typically for purposes of moderating a list."
(interactive "sResend to: ")
- (require 'sendmail)
- (require 'mailalias)
(unless (or (eq rmail-view-buffer (current-buffer))
(eq rmail-buffer (current-buffer)))
(error "Not an Rmail buffer"))
--- 3363,3368 ----
***************
*** 3398,3403 ****
--- 3458,3464 ----
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
"A regexp that matches the header of a MIME body part with a failed
message.")
+ ;;; NOT DONE
(defun rmail-retry-failure ()
"Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
***************
*** 3409,3415 ****
The variable `rmail-retry-ignored-headers' is a regular expression
specifying headers which should not be copied into the new message."
(interactive)
- (require 'mail-utils)
(let ((rmail-this-buffer (current-buffer))
(msgnum rmail-current-message)
bounce-start bounce-end bounce-indent resending
--- 3470,3475 ----
***************
*** 3593,3603 ****
(font-lock-fontify-region (point-min) (point-max))
(and (not modified) (buffer-modified-p) (set-buffer-modified-p
nil)))))))
- ;;; Speedbar support for RMAIL files.
- (eval-when-compile (require 'speedbar))
(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
! "*This regex is used to match folder names to be displayed in speedbar.
Enabling this will permit speedbar to display your folders for easy
browsing, and moving of messages.")
--- 3653,3661 ----
(font-lock-fontify-region (point-min) (point-max))
(and (not modified) (buffer-modified-p) (set-buffer-modified-p
nil)))))))
(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
! "*This regex us used to match folder names to be displayed in speedbar.
Enabling this will permit speedbar to display your folders for easy
browsing, and moving of messages.")
***************
*** 3716,3723 ****
(setq rmail-encoded-pop-password nil)))
(defun rmail-get-pop-password ()
! "Get the password for retrieving mail from a POP server. If none
! has been set, then prompt the user for one."
(if (not rmail-encoded-pop-password)
(progn (if (not rmail-pop-password)
(setq rmail-pop-password (read-passwd "POP password: ")))
--- 3774,3781 ----
(setq rmail-encoded-pop-password nil)))
(defun rmail-get-pop-password ()
! "Get the password for retrieving mail from a POP server.
! If none has been set, then prompt the user for one."
(if (not rmail-encoded-pop-password)
(progn (if (not rmail-pop-password)
(setq rmail-pop-password (read-passwd "POP password: ")))
***************
*** 3747,3752 ****
(setq i (1+ i)))
(concat string-vector)))
! (provide 'rmail)
;;; rmail.el ends here
--- 3805,3924 ----
(setq i (1+ i)))
(concat string-vector)))
! ;;;; Browser related functions
!
! (defun rmail-activate-urls ()
! "Highlight URLs embedded in the message body."
! (save-excursion
! (goto-char (point-min))
! (search-forward "\n\n" nil t)
! (browse-url-activate-urls (point) (point-max)
! 'bold 'bold-italic 'highlight rmail-url-map)))
!
! ;;; mbox: not ready, there is a bug here which I don't
! ;;; understand. When invoked with the summary buffer as the current
! ;;; buffer, the save-excursion does not seem to work. -pmr
! (defun rmail-visit-url-at-mouse (event)
! "Visit the URL underneath the mouse."
! (interactive "e")
! (save-window-excursion
!
! ;; Determine if the function has been invoked from a summary
! ;; buffer.
! (if (eq major-mode 'rmail-summary-mode)
!
! ;; It has. DTRT.
! (progn
! (set-buffer rmail-buffer)
! (save-excursion
! (browse-url-at-mouse event)
! (rmail-show-message rmail-current-message))
! (switch-to-buffer rmail-summary-buffer))
!
! ;; The function has been invoked from an Rmail buffer. Visit the
! ;; URL and then repaint the current message to reflect a visited
! ;; URL.
! (browse-url-at-mouse event)
! (rmail-show-message rmail-current-message))))
!
! (defun rmail-visit-url-at-point ()
! "Visit the URL at point."
! (interactive)
! (save-excursion
!
! ;; Visit the URL and then repaint the current message to reflect a
! ;; visited URL.
! (browse-url-at-point)
! (rmail-show-message rmail-current-message)))
!
! (defun rmail-browse-body ()
! "Send the message body to a browser to be rendered."
! (interactive)
! (save-excursion
! (save-restriction
! (goto-char (point-min))
! (search-forward "\n\n" (point-max) t)
! (narrow-to-region (point) (point-max))
! (browse-url-of-buffer))))
!
! ;;; New functions that need better placement.
! (defun rmail-get-sender ()
! "Return the message sender.
! The current buffer (possibly narrowed) contains a single message."
! (save-excursion
! (goto-char (point-min))
! (if (not (re-search-forward "^From:[ \t]*" nil t))
! " "
! (let* ((from (mail-strip-quoted-names
! (buffer-substring
! (1- (point))
! ;; Get all the lines of the From field
! ;; so that we get a whole comment if there is one,
! ;; so that mail-strip-quoted-names can discard it.
! (let ((opoint (point)))
! (while (progn (forward-line 1)
! (looking-at "[ \t]")))
! ;; Back up over newline, then trailing spaces or tabs
! (forward-char -1)
! (skip-chars-backward " \t")
! (point)))))
! len mch lo)
! (if (string-match (concat "^\\("
! (regexp-quote (user-login-name))
! "\\($\\|@\\)\\|"
! (regexp-quote
! ;; Don't lose if run from init file
! ;; where user-mail-address is not
! ;; set yet.
! (or user-mail-address
! (concat (user-login-name) "@"
! (or mail-host-address
! (system-name)))))
! "\\>\\)")
! from)
! (save-excursion
! (goto-char (point-min))
! (if (not (re-search-forward "^To:[ \t]*" nil t))
! nil
! (setq from
! (concat "to: "
! (mail-strip-quoted-names
! (buffer-substring
! (point)
! (progn (end-of-line)
! (skip-chars-backward " \t")
! (point)))))))))
! (setq len (length from))
! (setq mch (string-match "address@hidden" from))
! (format "%25s"
! (if (or (not mch) (<= len 25))
! (substring from (max 0 (- len 25)))
! (substring from
! (setq lo (cond ((< (- mch 14) 0) 0)
! ((< len (+ mch 11))
! (- len 25))
! (t (- mch 14))))
! (min len (+ lo 25)))))))))
!
;;; rmail.el ends here
Index: lisp/mail/rmailedit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailedit.el,v
retrieving revision 1.25
diff -c -r1.25 rmailedit.el
*** lisp/mail/rmailedit.el 15 Jul 2001 16:15:35 -0000 1.25
--- lisp/mail/rmailedit.el 26 Aug 2002 23:28:25 -0000
***************
*** 26,32 ****
;;; Code:
! (require 'rmail)
(defcustom rmail-edit-mode-hook nil
"List of functions to call when editing an RMAIL message."
--- 26,37 ----
;;; Code:
! (provide 'rmailedit)
!
! (eval-when-compile
! (require 'rmail)
! (require 'rmaildesc)
! (require 'rmailsum))
(defcustom rmail-edit-mode-hook nil
"List of functions to call when editing an RMAIL message."
***************
*** 100,105 ****
--- 105,111 ----
(message "%s" (substitute-command-keys
"Editing: Type \\[rmail-cease-edit] to return to Rmail,
\\[rmail-abort-edit] to abort"))))
+ ;;; mbox: ready
(defun rmail-cease-edit ()
"Finish editing message; switch back to Rmail proper."
(interactive)
***************
*** 113,120 ****
(if (/= (preceding-char) ?\n)
(insert "\n"))
;; Adjust the marker that points to the end of this message.
! (set-marker (aref rmail-message-vector (1+ rmail-current-message))
! (point)))
(let ((old rmail-old-text))
(force-mode-line-update)
(kill-all-local-variables)
--- 119,125 ----
(if (/= (preceding-char) ?\n)
(insert "\n"))
;; Adjust the marker that points to the end of this message.
! (rmail-desc-set-start (1+ rmail-current-message) (point)))
(let ((old rmail-old-text))
(force-mode-line-update)
(kill-all-local-variables)
***************
*** 127,145 ****
(string= old (buffer-substring (point-min) (point-max))))
()
(setq old nil)
! (rmail-set-attribute "edited" t)
! (if (boundp 'rmail-summary-vector)
! (progn
! (aset rmail-summary-vector (1- rmail-current-message) nil)
! (save-excursion
! (rmail-widen-to-current-msgbeg
! (function (lambda ()
! (forward-line 2)
! (if (looking-at "Summary-line: ")
! (let ((buffer-read-only nil))
! (delete-region (point)
! (progn (forward-line 1)
! (point))))))))))))
(save-excursion
(rmail-show-message)
(rmail-toggle-header (if rmail-old-pruned 1 0))))
--- 132,138 ----
(string= old (buffer-substring (point-min) (point-max))))
()
(setq old nil)
! (rmail-set-attribute "edited" t))
(save-excursion
(rmail-show-message)
(rmail-toggle-header (if rmail-old-pruned 1 0))))
Index: lisp/mail/rmailkwd.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailkwd.el,v
retrieving revision 1.14
diff -c -r1.14 rmailkwd.el
*** lisp/mail/rmailkwd.el 15 Jul 2001 16:15:35 -0000 1.14
--- lisp/mail/rmailkwd.el 26 Aug 2002 23:28:25 -0000
***************
*** 24,35 ****
--- 24,44 ----
;;; Commentary:
+ ;; This library manages keywords (labels). Labels are stored in the
+ ;; variable `rmail-keywords'.
+
;;; Code:
;; Global to all RMAIL buffers. It exists primarily for the sake of
;; completion. It is better to use strings with the label functions
;; and let them worry about making the label.
+ (provide 'rmailkwd)
+
+ (eval-when-compile
+ (require 'mail-utils)
+ (require 'rmail))
+
(defvar rmail-label-obarray (make-vector 47 0))
;; Named list of symbols representing valid message attributes in RMAIL.
***************
*** 51,57 ****
"Add LABEL to labels associated with current RMAIL message.
Completion is performed over known labels when reading."
(interactive (list (rmail-read-label "Add label")))
! (rmail-set-label string t))
;;;###autoload
(defun rmail-kill-label (string)
--- 60,67 ----
"Add LABEL to labels associated with current RMAIL message.
Completion is performed over known labels when reading."
(interactive (list (rmail-read-label "Add label")))
! (rmail-set-label string t)
! (rmail-display-labels))
;;;###autoload
(defun rmail-kill-label (string)
***************
*** 60,69 ****
(interactive (list (rmail-read-label "Remove label")))
(rmail-set-label string nil))
;;;###autoload
(defun rmail-read-label (prompt)
(with-current-buffer rmail-buffer
- (if (not rmail-keywords) (rmail-parse-file-keywords))
(let ((result
(completing-read (concat prompt
(if rmail-last-label
--- 70,79 ----
(interactive (list (rmail-read-label "Remove label")))
(rmail-set-label string nil))
+ ;;; mbox: not ready
;;;###autoload
(defun rmail-read-label (prompt)
(with-current-buffer rmail-buffer
(let ((result
(completing-read (concat prompt
(if rmail-last-label
***************
*** 78,127 ****
rmail-last-label
(setq rmail-last-label (rmail-make-label result t))))))
(defun rmail-set-label (l state &optional n)
(with-current-buffer rmail-buffer
- (rmail-maybe-set-message-counters)
(if (not n) (setq n rmail-current-message))
! (aset rmail-summary-vector (1- n) nil)
! (let* ((attribute (rmail-attribute-p l))
! (keyword (and (not attribute)
! (or (rmail-keyword-p l)
! (rmail-install-keyword l))))
! (label (or attribute keyword)))
! (if label
! (let ((omax (- (buffer-size) (point-max)))
! (omin (- (buffer-size) (point-min)))
! (buffer-read-only nil)
! (case-fold-search t))
! (unwind-protect
! (save-excursion
! (widen)
! (goto-char (rmail-msgbeg n))
! (forward-line 1)
! (if (not (looking-at "[01],"))
! nil
! (let ((start (1+ (point)))
! (bound))
! (narrow-to-region (point) (progn (end-of-line) (point)))
! (setq bound (point-max))
! (search-backward ",," nil t)
! (if attribute
! (setq bound (1+ (point)))
! (setq start (1+ (point))))
! (goto-char start)
! ; (while (re-search-forward "[ \t]*,[ \t]*" nil t)
! ; (replace-match ","))
! ; (goto-char start)
! (if (re-search-forward
! (concat ", " (rmail-quote-label-name label) ",")
! bound
! 'move)
! (if (not state) (replace-match ","))
! (if state (insert " " (symbol-name label) ",")))
! (if (eq label rmail-deleted-label)
! (rmail-set-message-deleted-p n state)))))
! (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))
! (if (= n rmail-current-message) (rmail-display-labels))))))))
;; Commented functions aren't used by RMAIL but might be nice for user
;; packages that do stuff with RMAIL. Note that rmail-message-labels-p
--- 88,126 ----
rmail-last-label
(setq rmail-last-label (rmail-make-label result t))))))
+ ;;; mbox: not ready
(defun rmail-set-label (l state &optional n)
+ "Add (STATE is non-nil) or remove (STATE is nil) label L in message N.
+ If N is nil then use the current Rmail message. The current buffer,
+ possibly narrowed, displays a message."
(with-current-buffer rmail-buffer
(if (not n) (setq n rmail-current-message))
!
! ;; Make message N the curent message.
! (save-restriction
! (widen)
! (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n))
!
! (if (rmail-attribute-p l)
!
! ;; Handle the case where the label is one of the predefined
! ;; attributes by using rmail code to set the attribute.
! (rmail-set-attribute l state n)
!
! ;; Handle the case where the label is a keyword. Make sure the
! ;; keyword is registered.
! (or (rmail-keyword-p l) (rmail-install-keyword l))
!
! ;; Determine if we are adding or removing the keyword.
! (let ((keyword (symbol-name l)))
! (if state
!
! ;; Add the keyword to this message.
! (rmail-desc-add-keyword keyword n)
!
! ;; Remove the keyword from the keyword header.
! (rmail-desc-remove-keyword keyword n)))))))
!
;; Commented functions aren't used by RMAIL but might be nice for user
;; packages that do stuff with RMAIL. Note that rmail-message-labels-p
***************
*** 161,167 ****
(defun rmail-keyword-p (s)
(let ((symbol (rmail-make-label s)))
! (if (memq symbol (cdr (rmail-keywords))) symbol)))
(defun rmail-make-label (s &optional forcep)
(cond ((symbolp s) s)
--- 160,166 ----
(defun rmail-keyword-p (s)
(let ((symbol (rmail-make-label s)))
! (if (memq symbol (cdr rmail-keywords)) symbol)))
(defun rmail-make-label (s &optional forcep)
(cond ((symbolp s) s)
***************
*** 220,232 ****
(if (> n 0)
(message "No following message with labels %s" labels))))
! ;;; Manipulate the file's Labels option.
! ;; Return a list of symbols for all
! ;; the keywords (labels) recorded in this file's Labels option.
(defun rmail-keywords ()
! (or rmail-keywords (rmail-parse-file-keywords)))
;; Set rmail-keywords to a list of symbols for all
;; the keywords (labels) recorded in this file's Labels option.
(defun rmail-parse-file-keywords ()
--- 219,243 ----
(if (> n 0)
(message "No following message with labels %s" labels))))
! ;;;; Manipulate the file's Labels option.
! ;;; mbox: deprecated
(defun rmail-keywords ()
! "Return a list of all known keywords."
! (or rmail-keywords (rmail-init-keywords)))
!
! (defun rmail-init-keywords ()
! "Initialize the variable `rmail-keywords' to an empty list."
! (setq rmail-keywords (cons 'rmail-keywords nil)))
!
! ;;;###autoload
! (defun rmail-keyword-register-keywords (keyword-list)
! "Add the strings in KEYWORD-LIST to `rmail-keywords'.
! If a symbol already exists, then ignore that string.
! Return a list of the keywords added."
! (delq nil (mapcar 'rmail-install-keyword keyword-list)))
+ ;;; mbox: deprecated
;; Set rmail-keywords to a list of symbols for all
;; the keywords (labels) recorded in this file's Labels option.
(defun rmail-parse-file-keywords ()
***************
*** 243,274 ****
(mapcar 'rmail-force-make-label
(mail-parse-comma-list)))))))))
;; Add WORD to the list in the file's Labels option.
;; Any keyword used for the first time needs this done.
(defun rmail-install-keyword (word)
(let ((keyword (rmail-make-label word t))
(keywords (rmail-keywords)))
(if (not (or (rmail-attribute-p keyword)
(rmail-keyword-p keyword)))
! (let ((omin (- (buffer-size) (point-min)))
! (omax (- (buffer-size) (point-max))))
! (unwind-protect
! (save-excursion
! (widen)
! (goto-char 1)
! (let ((case-fold-search t)
! (buffer-read-only nil))
! (or (search-forward "\nLabels:" nil t)
! (progn
! (end-of-line)
! (insert "\nLabels:")))
! (delete-region (point) (progn (end-of-line) (point)))
! (setcdr keywords (cons keyword (cdr keywords)))
! (while (setq keywords (cdr keywords))
! (insert (symbol-name (car keywords)) ","))
! (delete-char -1)))
! (narrow-to-region (- (buffer-size) omin)
! (- (buffer-size) omax)))))
! keyword))
;;; rmailkwd.el ends here
--- 254,271 ----
(mapcar 'rmail-force-make-label
(mail-parse-comma-list)))))))))
+ ;;; mbox: ready
;; Add WORD to the list in the file's Labels option.
;; Any keyword used for the first time needs this done.
(defun rmail-install-keyword (word)
+ "Append WORD to the global list of keywords. Ignore duplicates.
+ Return WORD if it is a new entry, nil otherwise."
(let ((keyword (rmail-make-label word t))
(keywords (rmail-keywords)))
(if (not (or (rmail-attribute-p keyword)
(rmail-keyword-p keyword)))
! (progn
! (setcdr keywords (cons keyword (cdr keywords)))
! keyword))))
;;; rmailkwd.el ends here
Index: lisp/mail/rmailmsc.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailmsc.el,v
retrieving revision 1.12
diff -c -r1.12 rmailmsc.el
*** lisp/mail/rmailmsc.el 15 Jul 2001 16:15:35 -0000 1.12
--- lisp/mail/rmailmsc.el 26 Aug 2002 23:28:25 -0000
***************
*** 26,31 ****
--- 26,34 ----
;;; Code:
+ (eval-when-compile
+ (require 'rmail))
+
;;;###autoload
(defun set-rmail-inbox-list (file-name)
"Set the inbox list of the current RMAIL file to FILE-NAME.
Index: lisp/mail/rmailout.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailout.el,v
retrieving revision 1.65
diff -c -r1.65 rmailout.el
*** lisp/mail/rmailout.el 15 Jul 2001 16:15:35 -0000 1.65
--- lisp/mail/rmailout.el 26 Aug 2002 23:28:25 -0000
***************
*** 1,4 ****
! ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
--- 1,4 ----
! ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
***************
*** 26,34 ****
;;; Code:
- (require 'rmail)
(provide 'rmailout)
;;;###autoload
(defcustom rmail-output-file-alist nil
"*Alist matching regexps to suggested output Rmail files.
--- 26,38 ----
;;; Code:
(provide 'rmailout)
+ (eval-when-compile
+ (require 'rmail)
+ (require 'rmaildesc))
+
+
;;;###autoload
(defcustom rmail-output-file-alist nil
"*Alist matching regexps to suggested output Rmail files.
***************
*** 62,68 ****
(let ((read-file
(expand-file-name
(read-file-name
! (concat "Output message to Rmail file: (default "
(file-name-nondirectory default-file)
") ")
(file-name-directory default-file)
--- 66,72 ----
(let ((read-file
(expand-file-name
(read-file-name
! (concat "Output message to Rmail (mbox) file: (default "
(file-name-nondirectory default-file)
") ")
(file-name-directory default-file)
***************
*** 76,81 ****
--- 80,86 ----
read-file)
read-file)))))
+ ;;; mbox: deprecated
(defun rmail-output-read-file-name ()
"Read the file name to use for `rmail-output'.
Set `rmail-default-file' to this name as well as returning it."
***************
*** 108,118 ****
(or read-file (file-name-nondirectory default-file))
(file-name-directory default-file)))))))
;;; There are functions elsewhere in Emacs that use this function;
;;; look at them before you change the calling method.
;;;###autoload
(defun rmail-output-to-rmail-file (file-name &optional count stay)
! "Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
If file is being visited, the message is appended to the Emacs
buffer visiting that file.
--- 113,124 ----
(or read-file (file-name-nondirectory default-file))
(file-name-directory default-file)))))))
+ ;;; mbox: ready
;;; There are functions elsewhere in Emacs that use this function;
;;; look at them before you change the calling method.
;;;###autoload
(defun rmail-output-to-rmail-file (file-name &optional count stay)
! "Append the current message to an Rmail (mbox) file named FILE-NAME.
If the file does not exist, ask if it should be created.
If file is being visited, the message is appended to the Emacs
buffer visiting that file.
***************
*** 130,240 ****
(interactive
(list (rmail-output-read-rmail-file-name)
(prefix-numeric-value current-prefix-arg)))
! (or count (setq count 1))
! (setq file-name
! (expand-file-name file-name
! (file-name-directory rmail-default-rmail-file)))
! (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
! (rmail-output file-name count)
! (rmail-maybe-set-message-counters)
! (setq file-name (abbreviate-file-name file-name))
! (or (find-buffer-visiting file-name)
! (file-exists-p file-name)
! (if (yes-or-no-p
! (concat "\"" file-name "\" does not exist, create it? "))
! (let ((file-buffer (create-file-buffer file-name)))
! (save-excursion
! (set-buffer file-buffer)
! (rmail-insert-rmail-file-header)
! (let ((require-final-newline nil)
! (coding-system-for-write
! (or rmail-file-coding-system
! 'emacs-mule-unix)))
! (write-region (point-min) (point-max) file-name t 1)))
! (kill-buffer file-buffer))
! (error "Output file does not exist")))
! (while (> count 0)
! (let (redelete)
! (unwind-protect
! (progn
! (set-buffer rmail-buffer)
! ;; Temporarily turn off Deleted attribute.
! ;; Do this outside the save-restriction, since it would
! ;; shift the place in the buffer where the visible text starts.
! (if (rmail-message-deleted-p rmail-current-message)
! (progn (setq redelete t)
! (rmail-set-attribute "deleted" nil)))
! (save-restriction
! (widen)
! ;; Decide whether to append to a file or to an Emacs buffer.
! (save-excursion
! (let ((buf (find-buffer-visiting file-name))
! (cur (current-buffer))
! (beg (1+ (rmail-msgbeg rmail-current-message)))
! (end (1+ (rmail-msgend rmail-current-message)))
! (coding-system-for-write
! (or rmail-file-coding-system
! 'emacs-mule-unix)))
! (if (not buf)
! ;; Output to a file.
! (if rmail-fields-not-to-output
! ;; Delete some fields while we output.
! (let ((obuf (current-buffer)))
! (set-buffer (get-buffer-create " rmail-out-temp"))
! (insert-buffer-substring obuf beg end)
! (rmail-delete-unwanted-fields)
! (append-to-file (point-min) (point-max) file-name)
! (set-buffer obuf)
! (kill-buffer (get-buffer " rmail-out-temp")))
! (append-to-file beg end file-name))
! (if (eq buf (current-buffer))
! (error "Can't output message to same file it's
already in"))
! ;; File has been visited, in buffer BUF.
! (set-buffer buf)
! (let ((buffer-read-only nil)
! (msg (and (boundp 'rmail-current-message)
! rmail-current-message)))
! ;; If MSG is non-nil, buffer is in RMAIL mode.
! (if msg
! (progn
! ;; Turn on auto save mode, if it's off in this
! ;; buffer but enabled by default.
! (and (not buffer-auto-save-file-name)
! auto-save-default
! (auto-save-mode t))
! (rmail-maybe-set-message-counters)
! (widen)
! (narrow-to-region (point-max) (point-max))
! (insert-buffer-substring cur beg end)
! (goto-char (point-min))
! (widen)
! (search-backward "\n\^_")
! (narrow-to-region (point) (point-max))
! (rmail-delete-unwanted-fields)
! (rmail-count-new-messages t)
! (if (rmail-summary-exists)
! (rmail-select-summary
! (rmail-update-summary)))
! (rmail-show-message msg))
! ;; Output file not in rmail mode => just insert at
the end.
! (narrow-to-region (point-min) (1+ (buffer-size)))
! (goto-char (point-max))
! (insert-buffer-substring cur beg end)
! (rmail-delete-unwanted-fields)))))))
! (rmail-set-attribute "filed" t))
! (if redelete (rmail-set-attribute "deleted" t))))
! (setq count (1- count))
! (if rmail-delete-after-output
! (unless
! (if (and (= count 0) stay)
! (rmail-delete-message)
! (rmail-delete-forward))
! (setq count 0))
! (if (> count 0)
! (unless
! (if (not stay) (rmail-next-undeleted-message 1))
! (setq count 0)))))))
;;;###autoload
(defcustom rmail-fields-not-to-output nil
"*Regexp describing fields to exclude when outputting a message to a file."
--- 136,158 ----
(interactive
(list (rmail-output-read-rmail-file-name)
(prefix-numeric-value current-prefix-arg)))
!
! ;; Use the 'rmail-output function to perform the output.
! (rmail-output file-name count nil nil)
!
! ;; Deal with the next message
! (if rmail-delete-after-output
! (unless
! (if (and (= count 0) stay)
! (rmail-delete-message)
! (rmail-delete-forward))
! (setq count 0))
! (if (> count 0)
! (unless
! (if (not stay) (rmail-next-undeleted-message 1))
! (setq count 0)))))
+ ;;; mbox: deprecated
;;;###autoload
(defcustom rmail-fields-not-to-output nil
"*Regexp describing fields to exclude when outputting a message to a file."
***************
*** 242,247 ****
--- 160,166 ----
regexp)
:group 'rmail-output)
+ ;;; mbox: deprecated
;; Delete from the buffer header fields we don't want output.
;; NOT-RMAIL if t means this buffer does not have the full header
;; and *** EOOH *** that a message in an Rmail file has.
***************
*** 259,276 ****
(delete-region (point)
(progn (forward-line 1) (point)))))))))
;;; There are functions elsewhere in Emacs that use this function;
;;; look at them before you change the calling method.
;;;###autoload
! (defun rmail-output (file-name &optional count noattribute from-gnus)
! "Append this message to system-inbox-format mail file named FILE-NAME.
! A prefix argument N says to output N consecutive messages
! starting with the current one. Deleted messages are skipped and don't count.
! When called from lisp code, N may be omitted.
!
! If the pruned message header is shown on the current message, then
! messages will be appended with pruned headers; otherwise, messages
! will be appended with their original headers.
The default file name comes from `rmail-default-file',
which is updated to the name you use in this command.
--- 178,192 ----
(delete-region (point)
(progn (forward-line 1) (point)))))))))
+ ;;; mbox: ready
;;; There are functions elsewhere in Emacs that use this function;
;;; look at them before you change the calling method.
;;;###autoload
! (defun rmail-output (file-name &optional count noattribute ext)
! "Append an mbox formatted message to the mbox formatted file named
! FILE-NAME. A prefix argument COUNT says to output COUNT consecutive
! messages starting with the current one. Deleted messages are skipped
! and don't count. When called from lisp code, COUNT may be omitted.
The default file name comes from `rmail-default-file',
which is updated to the name you use in this command.
***************
*** 278,284 ****
The optional third argument NOATTRIBUTE, if non-nil, says not
to set the `filed' attribute, and not to display a message.
! The optional fourth argument FROM-GNUS is set when called from GNUS."
(interactive
(list (rmail-output-read-file-name)
(prefix-numeric-value current-prefix-arg)))
--- 194,201 ----
The optional third argument NOATTRIBUTE, if non-nil, says not
to set the `filed' attribute, and not to display a message.
! The optional fourth argument EXT is set when called from outside of an
! Rmail function, for example by GNUS or Sendmail."
(interactive
(list (rmail-output-read-file-name)
(prefix-numeric-value current-prefix-arg)))
***************
*** 287,388 ****
(expand-file-name file-name
(and rmail-default-file
(file-name-directory rmail-default-file))))
- (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
- (rmail-output-to-rmail-file file-name count)
- (set-buffer rmail-buffer)
- (let ((orig-count count)
- (rmailbuf (current-buffer))
- (case-fold-search t)
- (tembuf (get-buffer-create " rmail-output"))
- (original-headers-p
- (and (not from-gnus)
- (save-excursion
- (save-restriction
- (narrow-to-region (rmail-msgbeg rmail-current-message)
(point-max))
- (goto-char (point-min))
- (forward-line 1)
- (= (following-char) ?0)))))
- header-beginning
- mail-from mime-version)
- (while (> count 0)
- ;; Preserve the Mail-From and MIME-Version fields
- ;; even if they have been pruned.
- (or from-gnus
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (rmail-msgbeg rmail-current-message))
- (setq header-beginning (point))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region header-beginning (point))
- (setq mail-from
- (mail-fetch-field "Mail-From")
- mime-version
- (unless rmail-enable-mime
- (mail-fetch-field "MIME-Version"))))))
- (save-excursion
- (set-buffer tembuf)
- (erase-buffer)
- (insert-buffer-substring rmailbuf)
- (when rmail-enable-mime
- (if original-headers-p
- (delete-region (goto-char (point-min))
- (if (search-forward "\n*** EOOH ***\n")
- (match-end 0)))
- (goto-char (point-min))
- (forward-line 2)
- (delete-region (point-min)(point))
- (search-forward "\n*** EOOH ***\n")
- (delete-region (match-beginning 0)
- (if (search-forward "\n\n")
- (1- (match-end 0)))))
- (setq buffer-file-coding-system (or rmail-file-coding-system
- 'raw-text)))
- (rmail-delete-unwanted-fields t)
- (or (bolp) (insert "\n"))
- (goto-char (point-min))
- (if mail-from
- (insert mail-from "\n")
- (insert "From "
- (mail-strip-quoted-names (or (mail-fetch-field "from")
- (mail-fetch-field
"really-from")
- (mail-fetch-field "sender")
- "unknown"))
- " " (current-time-string) "\n"))
- (if mime-version
- (insert "MIME-Version: " mime-version "\n"))
- ;; ``Quote'' "\nFrom " as "\n>From "
- ;; (note that this isn't really quoting, as there is no requirement
- ;; that "\n[>]+From " be quoted in the same transparent way.)
- (let ((case-fold-search nil))
- (while (search-forward "\nFrom " nil t)
- (forward-char -5)
- (insert ?>)))
- (write-region (point-min) (point-max) file-name t
- (if noattribute 'nomsg)))
- (or noattribute
- (if (equal major-mode 'rmail-mode)
- (rmail-set-attribute "filed" t)))
- (setq count (1- count))
- (or from-gnus
- (let ((next-message-p
- (if rmail-delete-after-output
- (rmail-delete-forward)
- (if (> count 0)
- (rmail-next-undeleted-message 1))))
- (num-appended (- orig-count count)))
- (if (and next-message-p original-headers-p)
- (rmail-toggle-header))
- (if (and (> count 0) (not next-message-p))
- (progn
- (error
- (save-excursion
- (set-buffer rmailbuf)
- (format "Only %d message%s appended" num-appended
- (if (= num-appended 1) "" "s"))))
- (setq count 0))))))
- (kill-buffer tembuf))))
;;;###autoload
(defun rmail-output-body-to-file (file-name)
"Write this message body to the file FILE-NAME.
--- 204,304 ----
(expand-file-name file-name
(and rmail-default-file
(file-name-directory rmail-default-file))))
+ ;; Use the Rmail buffer, likely narrowed, as the message source
+ ;; unless being called from an external party, such as GNUS or
+ ;; Sendmail.
+ (unless ext
+ (set-buffer rmail-buffer))
+
+ (let ((orig-count count)
+ (src-buf (current-buffer))
+ (dst-buf (find-buffer-visiting file-name))
+ (current-message rmail-current-message)
+ (tembuf (get-buffer-create " rmail-output"))
+ (original-headers-p
+ (and (not ext) (not (rmail-msg-is-pruned)))))
+
+ ;; Output each message to the destination file.
+ (while (> count 0)
+ (save-excursion
+
+ ;; Copy the message, including all headers, to the temporary
+ ;; buffer.
+ (set-buffer tembuf)
+ (erase-buffer)
+ (insert-buffer-substring src-buf)
+
+ ;; Deal with MIME --- tbd.
+ ;;(when rmail-enable-mime ...
+
+ ;; Determine whether a buffer is already visiting the output
+ ;; file.
+ (if dst-buf
+
+ ;; The destination file is being visited. Update it.
+ (progn
+ (set-buffer dst-buf)
+
+ ;; Determine if the destination file is an Rmail file.
+ (let ((buffer-read-only nil)
+ (dst-current-message (and (boundp 'rmail-current-message)
+ rmail-current-message)))
+ (if dst-current-message
+
+ ;; The buffer is an Rmail buffer. Append the message.
+ (progn
+ (widen)
+ (narrow-to-region (point-max) (point-max))
+ (insert-buffer-substring src-buf)
+ (insert "\n")
+ (rmail-process-new-messages)
+ (rmail-show-message dst-current-message))
+
+ ;; The destination file is not an Rmail file, just
+ ;; insert at the end.
+ (goto-char (point-max))
+ (insert-buffer-substring src-buf))))
+
+ ;; The destination file is not being visited, just write out
+ ;; the processed message.
+ (write-region (point-min) (point-max) file-name t
+ (if noattribute 'nomsg))))
+
+ ;; Do housekeeping, such as setting the "Filed" attribute, if
+ ;; necessary and moving to the next message.
+ (or noattribute
+ (if (equal major-mode 'rmail-mode)
+ (progn
+ (rmail-set-attribute "filed" t current-message)
+ (setq current-message (1+ current-message)))))
+
+ ;; Determine if Rmail post output operations need to be handled.
+ (or ext
+
+ ;; They do. Move to the next non-deleted message.
+ (let ((next-message-p
+ (if rmail-delete-after-output
+ (rmail-delete-forward)
+ (if (> count 1)
+ (rmail-next-undeleted-message 1))))
+ (num-appended (- orig-count count)))
+ (if (and (> count 1) (not next-message-p))
+ (progn
+ (error
+ (save-excursion
+ (set-buffer src-buf)
+ (format "Only %d message%s appended" num-appended
+ (if (= num-appended 1) "" "s"))))
+ (setq count 0)))))
+
+ ;; Decrement the count for the next iteration. If an error has
+ ;; occurred, then count will be -1, which is every bit as good
+ ;; as 0.
+ (setq count (1- count)))
+ (kill-buffer tembuf)))
+
+ ;;; mbox: ready
;;;###autoload
(defun rmail-output-body-to-file (file-name)
"Write this message body to the file FILE-NAME.
***************
*** 409,415 ****
(error "Operation aborted"))
(write-region (point) (point-max) file-name)
(if (equal major-mode 'rmail-mode)
! (rmail-set-attribute "stored" t)))
(if rmail-delete-after-output
(rmail-delete-forward)))
--- 325,331 ----
(error "Operation aborted"))
(write-region (point) (point-max) file-name)
(if (equal major-mode 'rmail-mode)
! (rmail-desc-set-attribute rmail-desc-stored-index t
rmail-current-message)))
(if rmail-delete-after-output
(rmail-delete-forward)))
Index: lisp/mail/rmailsort.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailsort.el,v
retrieving revision 1.28
diff -c -r1.28 rmailsort.el
*** lisp/mail/rmailsort.el 15 Jul 2001 16:15:35 -0000 1.28
--- lisp/mail/rmailsort.el 26 Aug 2002 23:28:25 -0000
***************
*** 27,36 ****
;;; Code:
! (require 'sort)
! ;; For rmail-select-summary
! (require 'rmail)
(autoload 'timezone-make-date-sortable "timezone")
--- 27,38 ----
;;; Code:
! (provide 'rmailsort)
! (eval-when-compile
! (require 'mail-utils)
! (require 'sort)
! (require 'rmail))
(autoload 'timezone-make-date-sortable "timezone")
***************
*** 243,249 ****
"Make DATE sortable using the function string-lessp."
;; Assume the default time zone is GMT.
(timezone-make-date-sortable date "GMT" "GMT"))
-
- (provide 'rmailsort)
;;; rmailsort.el ends here
--- 245,249 ----
Index: lisp/mail/rmailsum.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmailsum.el,v
retrieving revision 1.125
diff -c -r1.125 rmailsum.el
*** lisp/mail/rmailsum.el 2 Jul 2002 14:49:22 -0000 1.125
--- lisp/mail/rmailsum.el 26 Aug 2002 23:28:25 -0000
***************
*** 25,34 ****
--- 25,43 ----
;;; Commentary:
+ ;; All commands run from the summary buffer update the buffer local
+ ;; variable `rmail-current-message'. As part of the post command
+ ;; processing point is moved to the beginning of the line describing
+ ;; the current message.
+
+ ;;; History:
+
;; Extended by Bob Weiner of Motorola
;; Provided all commands from rmail-mode in rmail-summary-mode and made key
;; bindings in both modes wholly compatible.
+ ;; Overhauled by Paul Reilly to support mbox format.
+
;;; Code:
;; For rmail-select-summary
***************
*** 47,59 ****
:group 'rmail-summary)
(defvar rmail-summary-font-lock-keywords
! '(("^.....D.*" . font-lock-string-face) ; Deleted.
! ("^.....-.*" . font-lock-type-face) ;
Unread.
;; Neither of the below will be highlighted if either of the above are:
! ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
("{ \\([^\n}]+\\),}" 1 font-lock-comment-face)) ; Labels.
"Additional expressions to highlight in Rmail Summary mode.")
;; Entry points for making a summary buffer.
;; Regenerate the contents of the summary
--- 56,78 ----
:group 'rmail-summary)
(defvar rmail-summary-font-lock-keywords
! '(("^....D.*" . font-lock-string-face) ; Deleted.
! ("^....-.*" . font-lock-type-face) ;
Unread.
;; Neither of the below will be highlighted if either of the above are:
! ("^....[^D-]....\\(......\\)" 1 font-lock-keyword-face) ; Date.
("{ \\([^\n}]+\\),}" 1 font-lock-comment-face)) ; Labels.
"Additional expressions to highlight in Rmail Summary mode.")
+ (defvar rmail-summary-redo nil
+ "Private storage for Rmail summary history.")
+
+ (defvar rmail-summary-overlay nil
+ "Private storage for an Rmail summary overlay cache")
+ (put 'rmail-summary-overlay 'permanent-local t)
+
+ (defvar rmail-summary-mode-map nil
+ "Storage for the Ramil summary mode keymap.")
+
;; Entry points for making a summary buffer.
;; Regenerate the contents of the summary
***************
*** 161,170 ****
(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
(string-match senders (or (mail-fetch-field "From") ""))))
! ;; General making of a summary buffer.
(defvar rmail-summary-symbol-number 0)
(defun rmail-new-summary (description redo-form function &rest args)
"Create a summary of selected messages.
DESCRIPTION makes part of the mode line of the summary buffer.
--- 180,190 ----
(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
(string-match senders (or (mail-fetch-field "From") ""))))
! ;;;; General making of a summary buffer.
(defvar rmail-summary-symbol-number 0)
+ ;;; mbox: ready
(defun rmail-new-summary (description redo-form function &rest args)
"Create a summary of selected messages.
DESCRIPTION makes part of the mode line of the summary buffer.
***************
*** 172,274 ****
and if the result is non-nil, that message is included.
nil for FUNCTION means all messages."
(message "Computing summary lines...")
! (let (sumbuf mesg was-in-summary)
(save-excursion
! ;; Go to the Rmail buffer.
! (if (eq major-mode 'rmail-summary-mode)
! (setq was-in-summary t))
! (set-buffer rmail-buffer)
! ;; Find its summary buffer, or make one.
! (setq sumbuf
! (if (and rmail-summary-buffer
! (buffer-name rmail-summary-buffer))
! rmail-summary-buffer
! (generate-new-buffer (concat (buffer-name) "-summary"))))
! (setq mesg rmail-current-message)
! ;; Filter the messages; make or get their summary lines.
! (let ((summary-msgs ())
! (new-summary-line-count 0))
! (let ((msgnum 1)
! (buffer-read-only nil)
! (old-min (point-min-marker))
! (old-max (point-max-marker)))
! ;; Can't use save-restriction here; that doesn't work if we
! ;; plan to modify text outside the original restriction.
! (save-excursion
! (widen)
! (goto-char (point-min))
! (while (>= rmail-total-messages msgnum)
! (if (or (null function)
! (apply function (cons msgnum args)))
! (setq summary-msgs
! (cons (cons msgnum (rmail-make-summary-line msgnum))
! summary-msgs)))
! (setq msgnum (1+ msgnum)))
! (setq summary-msgs (nreverse summary-msgs)))
! (narrow-to-region old-min old-max))
! ;; Temporarily, while summary buffer is unfinished,
! ;; we "don't have" a summary.
! (setq rmail-summary-buffer nil)
! (if rmail-enable-mime
! (with-current-buffer rmail-view-buffer
! (setq rmail-summary-buffer nil)))
! (save-excursion
! (let ((rbuf (current-buffer))
! (vbuf rmail-view-buffer)
! (total rmail-total-messages))
! (set-buffer sumbuf)
! ;; Set up the summary buffer's contents.
! (let ((buffer-read-only nil))
! (erase-buffer)
! (while summary-msgs
! (princ (cdr (car summary-msgs)) sumbuf)
! (setq summary-msgs (cdr summary-msgs)))
! (goto-char (point-min)))
! ;; Set up the rest of its state and local variables.
! (setq buffer-read-only t)
! (rmail-summary-mode)
! (make-local-variable 'minor-mode-alist)
! (setq minor-mode-alist (list (list t (concat ": " description))))
! (setq rmail-buffer rbuf
! rmail-view-buffer vbuf
! rmail-summary-redo redo-form
! rmail-total-messages total))))
! (setq rmail-summary-buffer sumbuf))
;; Now display the summary buffer and go to the right place in it.
(or was-in-summary
! (progn
! (if (and (one-window-p)
! pop-up-windows (not pop-up-frames))
! ;; If there is just one window, put the summary on the top.
! (progn
! (split-window (selected-window) rmail-summary-window-size)
! (select-window (next-window (frame-first-window)))
! (pop-to-buffer sumbuf)
! ;; If pop-to-buffer did not use that window, delete that
! ;; window. (This can happen if it uses another frame.)
! (if (not (eq sumbuf (window-buffer (frame-first-window))))
! (delete-other-windows)))
! (pop-to-buffer sumbuf))
! (set-buffer rmail-buffer)
! ;; This is how rmail makes the summary buffer reappear.
! ;; We do this here to make the window the proper size.
! (rmail-select-summary nil)
! (set-buffer rmail-summary-buffer)))
! (rmail-summary-goto-msg mesg t t)
! (rmail-summary-construct-io-menu)
(message "Computing summary lines...done")))
! ;; Low levels of generating a summary.
(defun rmail-make-summary-line (msg)
! (let ((line (or (aref rmail-summary-vector (1- msg))
! (progn
! (setq new-summary-line-count
! (1+ new-summary-line-count))
! (if (zerop (% new-summary-line-count 10))
! (message "Computing summary lines...%d"
! new-summary-line-count))
! (rmail-make-summary-line-1 msg)))))
;; Fix up the part of the summary that says "deleted" or "unseen".
(aset line 5
(if (rmail-message-deleted-p msg) ?\D
--- 192,291 ----
and if the result is non-nil, that message is included.
nil for FUNCTION means all messages."
(message "Computing summary lines...")
! (let ((summary-msgs ())
! (new-summary-line-count 0)
! (msgnum 1)
! current-message sumbuf was-in-summary)
!
! ;; Go to the Rmail buffer.
! (if (eq major-mode 'rmail-summary-mode)
! (progn
! (setq was-in-summary t)
! (set-buffer rmail-buffer)))
!
! ;; Find its summary buffer, or make one.
! (setq current-message rmail-current-message
! sumbuf
! (if (and rmail-summary-buffer
! (buffer-name rmail-summary-buffer))
! rmail-summary-buffer
! (generate-new-buffer (concat (buffer-name) "-summary"))))
!
! ;; Collect the message summaries based on the filtering
! ;; argument (FUNCTION).
! (while (>= rmail-total-messages msgnum)
! (if (or (null function)
! (apply function (cons msgnum args)))
! (setq summary-msgs
! (cons (cons msgnum (rmail-summary-get-summary msgnum))
! summary-msgs)))
! (setq msgnum (1+ msgnum)))
! (setq summary-msgs (nreverse summary-msgs))
!
! ;; Place the collected summaries into the summary buffer.
! (setq rmail-summary-buffer nil)
(save-excursion
! (let ((rbuf (current-buffer))
! (vbuf rmail-view-buffer)
! (total rmail-total-messages))
! (set-buffer sumbuf)
! ;; Set up the summary buffer's contents.
! (let ((buffer-read-only nil))
! (erase-buffer)
! (while summary-msgs
! (princ (cdr (car summary-msgs)) sumbuf)
! (setq summary-msgs (cdr summary-msgs)))
! (goto-char (point-min)))
! ;; Set up the rest of its state and local variables.
! (setq buffer-read-only t)
! (rmail-summary-mode)
! (make-local-variable 'minor-mode-alist)
! (setq minor-mode-alist (list (list t (concat ": " description))))
! (setq rmail-buffer rbuf
! rmail-view-buffer vbuf
! rmail-summary-redo redo-form
! rmail-total-messages total
! rmail-current-message current-message)))
! (setq rmail-summary-buffer sumbuf)
!
! (set-buffer rmail-summary-buffer)
! (rmail-summary-goto-msg current-message nil t)
! (rmail-summary-construct-io-menu)
!
;; Now display the summary buffer and go to the right place in it.
(or was-in-summary
! (progn
! (if (and (one-window-p)
! pop-up-windows (not pop-up-frames))
! ;; If there is just one window, put the summary on the top.
! (progn
! (split-window (selected-window) rmail-summary-window-size)
! (select-window (next-window (frame-first-window)))
! (pop-to-buffer sumbuf)
! ;; If pop-to-buffer did not use that window, delete that
! ;; window. (This can happen if it uses another frame.)
! (if (not (eq sumbuf (window-buffer (frame-first-window))))
! (delete-other-windows))))
! ;;(pop-to-buffer sumbuf))
! (set-buffer rmail-buffer)
! ;; This is how rmail makes the summary buffer reappear.
! ;; We do this here to make the window the proper size.
! (rmail-select-summary nil)))
(message "Computing summary lines...done")))
! ;;;; Low levels of generating a summary.
+ ;;; mbox: deprecated
(defun rmail-make-summary-line (msg)
! (let* ((new-summary-line-count 0)
! (line (or (aref rmail-summary-vector (1- msg))
! (progn
! (setq new-summary-line-count
! (1+ new-summary-line-count))
! (if (zerop (% new-summary-line-count 10))
! (message "Computing summary lines...%d"
! new-summary-line-count))
! (rmail-make-summary-line-1 msg)))))
;; Fix up the part of the summary that says "deleted" or "unseen".
(aset line 5
(if (rmail-message-deleted-p msg) ?\D
***************
*** 284,297 ****
:type 'function
:group 'rmail-summary)
(defun rmail-make-summary-line-1 (msg)
(goto-char (rmail-msgbeg msg))
(let* ((lim (save-excursion (forward-line 2) (point)))
! pos
! (labels
! (progn
! (forward-char 3)
! (concat
; (if (save-excursion (re-search-forward ",answered," lim t))
; "*" "")
; (if (save-excursion (re-search-forward ",filed," lim t))
--- 301,314 ----
:type 'function
:group 'rmail-summary)
+ ;;; mbox: deprecated
(defun rmail-make-summary-line-1 (msg)
(goto-char (rmail-msgbeg msg))
(let* ((lim (save-excursion (forward-line 2) (point)))
! (labels
! (progn
! (forward-char 3)
! (concat
; (if (save-excursion (re-search-forward ",answered," lim t))
; "*" "")
; (if (save-excursion (re-search-forward ",filed," lim t))
***************
*** 308,316 ****
(if (looking-at "Summary-line: ")
(progn
(goto-char (match-end 0))
! (setq line
! (buffer-substring (point)
! (progn (forward-line 1)
(point)))))))))
;; Obsolete status lines lacking a # should be flushed.
(and line
(not (string-match "#" line))
--- 325,334 ----
(if (looking-at "Summary-line: ")
(progn
(goto-char (match-end 0))
! (buffer-substring (point)
! (progn (forward-line 1) (point)))))))
! pos)
!
;; Obsolete status lines lacking a # should be flushed.
(and line
(not (string-match "#" line))
***************
*** 363,368 ****
--- 381,387 ----
:group 'rmail-retrieve
:version "21.1")
+ ;;; mbox: deprecated
(defun rmail-make-basic-summary-line ()
(goto-char (point-min))
(concat (save-excursion
***************
*** 454,461 ****
(save-excursion
(save-restriction
(widen)
! (let ((beg (rmail-msgbeg msgnum))
! (end (rmail-msgend msgnum))
lines)
(save-excursion
(goto-char beg)
--- 473,480 ----
(save-excursion
(save-restriction
(widen)
! (let ((beg (rmail-msgbeg rmail-current-message))
! (end (rmail-msgend rmail-current-message))
lines)
(save-excursion
(goto-char beg)
***************
*** 480,488 ****
(buffer-substring (point) (progn (end-of-line) (point))))
"\n"))
! ;; Simple motion in a summary buffer.
(defun rmail-summary-next-all (&optional number)
(interactive "p")
(forward-line (if number number 1))
;; It doesn't look nice to move forward past the last message line.
--- 499,511 ----
(buffer-substring (point) (progn (end-of-line) (point))))
"\n"))
! ;;;; Simple motion in a summary buffer.
(defun rmail-summary-next-all (&optional number)
+ "Move to an nearby message.
+ If NUMBER is positive then move forward NUMBER messages. If NUMBER is
+ negative then move backwards NUMBER messages. If NUMBER is nil then
+ move forward one message."
(interactive "p")
(forward-line (if number number 1))
;; It doesn't look nice to move forward past the last message line.
***************
*** 498,521 ****
(forward-line -1))
(display-buffer rmail-buffer))
(defun rmail-summary-next-msg (&optional number)
"Display next non-deleted msg from rmail file.
With optional prefix argument NUMBER, moves forward this number of non-deleted
messages, or backward if NUMBER is negative."
(interactive "p")
! (forward-line 0)
! (and (> number 0) (end-of-line))
! (let ((count (if (< number 0) (- number) number))
! (search (if (> number 0) 're-search-forward 're-search-backward))
! (non-del-msg-found nil))
! (while (and (> count 0) (setq non-del-msg-found
! (or (funcall search "^....[^D]" nil t)
! non-del-msg-found)))
! (setq count (1- count))))
! (beginning-of-line)
! (display-buffer rmail-view-buffer)
! )
(defun rmail-summary-previous-msg (&optional number)
(interactive "p")
(rmail-summary-next-msg (- (if number number 1))))
--- 521,539 ----
(forward-line -1))
(display-buffer rmail-buffer))
+ ;;; mbox: ready
(defun rmail-summary-next-msg (&optional number)
"Display next non-deleted msg from rmail file.
With optional prefix argument NUMBER, moves forward this number of non-deleted
messages, or backward if NUMBER is negative."
(interactive "p")
! (let (msg)
! (with-current-buffer rmail-buffer
! (rmail-next-undeleted-message number)
! (setq msg rmail-current-message))
! (rmail-summary-goto-msg msg)))
+ ;;; mbox: ready
(defun rmail-summary-previous-msg (&optional number)
(interactive "p")
(rmail-summary-next-msg (- (if number number 1))))
***************
*** 529,535 ****
(set-buffer rmail-buffer)
(rmail-next-labeled-message n labels)
(setq msg rmail-current-message))
! (rmail-summary-goto-msg msg)))
(defun rmail-summary-previous-labeled-message (n labels)
"Show previous message with LABEL. Defaults to last labels used.
--- 547,553 ----
(set-buffer rmail-buffer)
(rmail-next-labeled-message n labels)
(setq msg rmail-current-message))
! (setq rmail-current-message msg)))
(defun rmail-summary-previous-labeled-message (n labels)
"Show previous message with LABEL. Defaults to last labels used.
***************
*** 540,598 ****
(set-buffer rmail-buffer)
(rmail-previous-labeled-message n labels)
(setq msg rmail-current-message))
! (rmail-summary-goto-msg msg)))
(defun rmail-summary-next-same-subject (n)
"Go to the next message in the summary having the same subject.
With prefix argument N, do this N times.
If N is negative, go backwards."
(interactive "p")
! (let (subject search-regexp i found
! (forward (> n 0)))
! (save-excursion
! (set-buffer rmail-buffer)
! (setq subject (mail-fetch-field "Subject"))
! (setq i rmail-current-message))
! (if (string-match "Re:[ \t]*" subject)
! (setq subject (substring subject (match-end 0))))
! (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
! (regexp-quote subject)
! "\n"))
! (save-excursion
! (while (and (/= n 0)
! (if forward
! (not (eobp))
! (not (bobp))))
! (let (done)
! (while (and (not done)
! (if forward
! (not (eobp))
! (not (bobp))))
! ;; Advance thru summary.
! (forward-line (if forward 1 -1))
! ;; Get msg number of this line.
! (setq i (string-to-int
! (buffer-substring (point)
! (min (point-max) (+ 6 (point))))))
! ;; See if that msg has desired subject.
! (save-excursion
! (set-buffer rmail-buffer)
! (save-restriction
! (widen)
! (goto-char (rmail-msgbeg i))
! (search-forward "\n*** EOOH ***\n")
! (let ((beg (point)) end)
! (search-forward "\n\n")
! (setq end (point))
! (goto-char beg)
! (setq done (re-search-forward search-regexp end t))))))
! (if done (setq found i)))
! (setq n (if forward (1- n) (1+ n)))))
! (if found
! (rmail-summary-goto-msg found)
! (error "No %s message with same subject"
! (if forward "following" "previous")))))
(defun rmail-summary-previous-same-subject (n)
"Go to the previous message in the summary having the same subject.
With prefix argument N, do this N times.
--- 558,581 ----
(set-buffer rmail-buffer)
(rmail-previous-labeled-message n labels)
(setq msg rmail-current-message))
! (setq rmail-current-message msg)))
+ ;;; mbox: ready
(defun rmail-summary-next-same-subject (n)
"Go to the next message in the summary having the same subject.
With prefix argument N, do this N times.
If N is negative, go backwards."
(interactive "p")
! (let (found)
! (with-current-buffer rmail-buffer
! (rmail-next-same-subject n)
! (setq found rmail-current-message))
+ (if found
+ (setq rmail-current-message found
+ rmail-summary-skip-rmail t))))
+
+ ;;; mbox: ready
(defun rmail-summary-previous-same-subject (n)
"Go to the previous message in the summary having the same subject.
With prefix argument N, do this N times.
***************
*** 602,607 ****
--- 585,591 ----
;; Delete and undelete summary commands.
+ ;;; mbox: ready
(defun rmail-summary-delete-forward (&optional count)
"Delete this message and move to next nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is
given.
***************
*** 621,631 ****
(save-excursion (beginning-of-line)
(looking-at " *[0-9]+D")))
(forward-line (if backward -1 1)))
- ;; It looks ugly to move to the empty line at end of buffer.
- (and (eobp) (not backward)
- (forward-line -1))
(setq count
! (if (> count 0) (1- count) (1+ count))))))
(defun rmail-summary-delete-backward (&optional count)
"Delete this message and move to previous nondeleted one.
--- 605,616 ----
(save-excursion (beginning-of-line)
(looking-at " *[0-9]+D")))
(forward-line (if backward -1 1)))
(setq count
! (if (> count 0) (1- count) (1+ count))))
!
! ;; Update the summary buffer current message counter and show the
! ;; message in the Rmail buffer.
! (rmail-summary-goto-msg (rmail-summary-get-message-at-point))))
(defun rmail-summary-delete-backward (&optional count)
"Delete this message and move to previous nondeleted one.
***************
*** 635,643 ****
(interactive "p")
(rmail-summary-delete-forward (- count)))
(defun rmail-summary-mark-deleted (&optional n undel)
;; Since third arg is t, this only alters the summary, not the Rmail buf.
! (and n (rmail-summary-goto-msg n t t))
(or (eobp)
(not (overlay-get rmail-summary-overlay 'face))
(let ((buffer-read-only nil))
--- 620,630 ----
(interactive "p")
(rmail-summary-delete-forward (- count)))
+ ;;; mbox: deprecated
+ ;;;###autoload
(defun rmail-summary-mark-deleted (&optional n undel)
;; Since third arg is t, this only alters the summary, not the Rmail buf.
! (and n (rmail-summary-goto-msg n t))
(or (eobp)
(not (overlay-get rmail-summary-overlay 'face))
(let ((buffer-read-only nil))
***************
*** 650,665 ****
(insert "D"))))
(beginning-of-line))
(defun rmail-summary-mark-undeleted (n)
(rmail-summary-mark-deleted n t))
(defun rmail-summary-deleted-p (&optional n)
! (save-excursion
! (and n (rmail-summary-goto-msg n nil t))
! (skip-chars-forward " ")
! (skip-chars-forward "[0-9]")
! (looking-at "D")))
(defun rmail-summary-undelete (&optional arg)
"Undelete current message.
Optional prefix ARG means undelete ARG previous messages."
--- 637,655 ----
(insert "D"))))
(beginning-of-line))
+ ;;; mbox: deprecated
+ ;;;###autoload
(defun rmail-summary-mark-undeleted (n)
(rmail-summary-mark-deleted n t))
+ ;;; mbox: ready
(defun rmail-summary-deleted-p (&optional n)
! (unless n
! (setq n rmail-current-message)
! (with-current-buffer rmail-buffer
! (rmail-desc-deleted-p n))))
+ ;;; mbox: not sure.
(defun rmail-summary-undelete (&optional arg)
"Undelete current message.
Optional prefix ARG means undelete ARG previous messages."
***************
*** 682,687 ****
--- 672,678 ----
(pop-to-buffer rmail-summary-buffer))
(t (goto-char opoint))))))
+ ;;; mbox: ready for testing
(defun rmail-summary-undelete-many (&optional n)
"Undelete all deleted msgs, optional prefix arg N means undelete N prev
msgs."
(interactive "P")
***************
*** 704,711 ****
(if (rmail-summary-deleted-p rmail-current-message)
(progn (rmail-summary-mark-undeleted rmail-current-message)
(setq msgs-undeled (1+ msgs-undeled))))
! (setq rmail-current-message (1- rmail-current-message))))
! (rmail-summary-goto-msg)))
;; Rmail Summary mode is suitable only for specially formatted data.
(put 'rmail-summary-mode 'mode-class 'special)
--- 695,701 ----
(if (rmail-summary-deleted-p rmail-current-message)
(progn (rmail-summary-mark-undeleted rmail-current-message)
(setq msgs-undeled (1+ msgs-undeled))))
! (setq rmail-current-message (1- rmail-current-message))))))
;; Rmail Summary mode is suitable only for specially formatted data.
(put 'rmail-summary-mode 'mode-class 'special)
***************
*** 775,840 ****
;; but only if the Rmail buffer is already visible.
;; This is a post-command-hook in summary buffers.
(defun rmail-summary-rmail-update ()
! (let (buffer-read-only)
! (save-excursion
! ;; If at end of buffer, pretend we are on the last text line.
! (if (eobp)
! (forward-line -1))
! (beginning-of-line)
! (skip-chars-forward " ")
! (let ((msg-num (string-to-int (buffer-substring
! (point)
! (progn (skip-chars-forward "0-9")
! (point))))))
! ;; Always leave `unseen' removed
! ;; if we get out of isearch mode.
! ;; Don't let a subsequent isearch restore that `unseen'.
! (if (not isearch-mode)
! (setq rmail-summary-put-back-unseen nil))
!
! (or (eq rmail-current-message msg-num)
! (let ((window (get-buffer-window rmail-view-buffer t))
! (owin (selected-window)))
! (if isearch-mode
! (save-excursion
! (set-buffer rmail-buffer)
! ;; If we first saw the previous message in this search,
! ;; and we have gone to a different message while searching,
! ;; put back `unseen' on the former one.
! (if rmail-summary-put-back-unseen
! (rmail-set-attribute "unseen" t
! rmail-current-message))
! ;; Arrange to do that later, for the new current message,
! ;; if it still has `unseen'.
! (setq rmail-summary-put-back-unseen
! (rmail-message-labels-p msg-num ", ?\\(unseen\\),")))
! (setq rmail-summary-put-back-unseen nil))
!
! ;; Go to the desired message.
! (setq rmail-current-message msg-num)
!
! ;; Update the summary to show the message has been seen.
! (if (= (following-char) ?-)
! (progn
! (delete-char 1)
! (insert " ")))
!
! (if window
! ;; Using save-window-excursion would cause the new value
! ;; of point to get lost.
! (unwind-protect
! (progn
! (select-window window)
! (rmail-show-message msg-num t))
! (select-window owin))
! (if (buffer-name rmail-buffer)
! (save-excursion
! (set-buffer rmail-buffer)
! (rmail-show-message msg-num t))))))
! (rmail-summary-update-highlight nil)))))
!
! (defvar rmail-summary-mode-map nil)
(if rmail-summary-mode-map
nil
(setq rmail-summary-mode-map (make-keymap))
--- 765,834 ----
;; but only if the Rmail buffer is already visible.
;; This is a post-command-hook in summary buffers.
(defun rmail-summary-rmail-update ()
! "Update the Rmail summary buffer.
! Put the cursor on the beginning of the line containing the current
! message and highlight the buffer."
+ (let (buffer-read-only)
+ (save-excursion
+ ;; If at end of buffer, pretend we are on the last text line.
+ (if (eobp)
+ (forward-line -1))
+
+ ;; Determine the message number correpsonding to line point is on.
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (let ((msg-num (string-to-int (buffer-substring
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point))))))
+
+ ;; Always leave `unseen' removed if we get out of isearch mode.
+ ;; Don't let a subsequent isearch restore `unseen'.
+ (if (not isearch-mode)
+ (setq rmail-summary-put-back-unseen nil))
+
+ (or (eq rmail-current-message msg-num)
+ (let ((window (get-buffer-window rmail-view-buffer t))
+ (owin (selected-window)))
+ (if isearch-mode
+ (save-excursion
+ (set-buffer rmail-buffer)
+ ;; If we first saw the previous message in this search,
+ ;; and we have gone to a different message while searching,
+ ;; put back `unseen' on the former one.
+ (if rmail-summary-put-back-unseen
+ (rmail-set-attribute "unseen" t
+ rmail-current-message))
+ ;; Arrange to do that later, for the new current message,
+ ;; if it still has `unseen'.
+ (setq rmail-summary-put-back-unseen
+ (rmail-message-labels-p msg-num ", ?\\(unseen\\),")))
+ (setq rmail-summary-put-back-unseen nil))
+
+ ;; Go to the desired message.
+ (setq rmail-current-message msg-num)
+
+ ;; Update the summary to show the message has been seen.
+ (if (= (following-char) ?-)
+ (progn
+ (delete-char 1)
+ (insert " ")))
+
+ (if window
+ ;; Using save-window-excursion would cause the new value
+ ;; of point to get lost.
+ (unwind-protect
+ (progn
+ (select-window window)
+ (rmail-show-message msg-num t))
+ (select-window owin))
+ (if (buffer-name rmail-buffer)
+ (save-excursion
+ (set-buffer rmail-buffer)
+ (rmail-show-message msg-num t))))))
+ (rmail-summary-update-highlight nil)))))
+
(if rmail-summary-mode-map
nil
(setq rmail-summary-mode-map (make-keymap))
***************
*** 843,848 ****
--- 837,843 ----
(define-key rmail-summary-mode-map [mouse-2]
'rmail-summary-mouse-goto-message)
(define-key rmail-summary-mode-map "a" 'rmail-summary-add-label)
(define-key rmail-summary-mode-map "b" 'rmail-summary-bury)
+ (define-key rmail-summary-mode-map "B" 'rmail-summary-browse-body)
(define-key rmail-summary-mode-map "c" 'rmail-summary-continue)
(define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)
(define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)
***************
*** 865,871 ****
(define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
(define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
(define-key rmail-summary-mode-map "\e\C-n"
'rmail-summary-next-labeled-message)
! (define-key rmail-summary-mode-map "o"
'rmail-summary-output-to-rmail-file)
(define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output)
(define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
(define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
--- 860,866 ----
(define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
(define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
(define-key rmail-summary-mode-map "\e\C-n"
'rmail-summary-next-labeled-message)
! (define-key rmail-summary-mode-map "o" 'rmail-summary-output)
(define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output)
(define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
(define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
***************
*** 930,936 ****
'("Output (inbox)..." . rmail-summary-output))
(define-key rmail-summary-mode-map [menu-bar classify output]
! '("Output (Rmail)..." . rmail-summary-output-to-rmail-file))
(define-key rmail-summary-mode-map [menu-bar classify kill-label]
'("Kill Label..." . rmail-summary-kill-label))
--- 925,931 ----
'("Output (inbox)..." . rmail-summary-output))
(define-key rmail-summary-mode-map [menu-bar classify output]
! '("Output (Rmail)..." . rmail-summary-output))
(define-key rmail-summary-mode-map [menu-bar classify kill-label]
'("Kill Label..." . rmail-summary-kill-label))
***************
*** 1028,1067 ****
(define-key rmail-summary-mode-map [menu-bar move next]
'("Next" . rmail-summary-next-all))
- (defvar rmail-summary-overlay nil)
- (put 'rmail-summary-overlay 'permanent-local t)
-
(defun rmail-summary-mouse-goto-message (event)
"Select the message whose summary line you click on."
(interactive "@e")
(goto-char (posn-point (event-end event)))
! (rmail-summary-goto-msg))
(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
"Go to message N in the summary buffer and the Rmail buffer.
If N is nil, use the message corresponding to point in the summary
! and move to that message in the Rmail buffer.
If NOWARN, don't say anything if N is out of range.
If SKIP-RMAIL, don't do anything to the Rmail buffer."
(interactive "P")
(if (consp n) (setq n (prefix-numeric-value n)))
(if (eobp) (forward-line -1))
(beginning-of-line)
! (let* ((obuf (current-buffer))
! (buf rmail-buffer)
! (cur (point))
! message-not-found
! (curmsg (string-to-int
! (buffer-substring (point)
! (min (point-max) (+ 6 (point))))))
! (total (save-excursion (set-buffer buf) rmail-total-messages)))
! ;; If message number N was specified, find that message's line
! ;; or set message-not-found.
! ;; If N wasn't specified or that message can't be found.
! ;; set N by default.
! (if (not n)
! (setq n curmsg)
(if (< n 1)
(progn (message "No preceding message")
(setq n 1)))
--- 1023,1080 ----
(define-key rmail-summary-mode-map [menu-bar move next]
'("Next" . rmail-summary-next-all))
(defun rmail-summary-mouse-goto-message (event)
"Select the message whose summary line you click on."
(interactive "@e")
(goto-char (posn-point (event-end event)))
! (setq rmail-current-message (rmail-summary-get-message-at-point))
! (rmail-summary-rmail-update))
!
! (defun rmail-summary-get-message-at-point ()
! "Return the message number corresponding to the line containing point.
! If the summary buffer contains no messages, nil is returned."
! (save-excursion
+ ;; Position point at the beginning of a line.
+ (if (eobp)
+ (forward-line -1)
+ (forward-line 0))
+
+ ;; Parse the message number.
+ (string-to-int
+ (buffer-substring (point) (min (point-max) (+ 4 (point)))))))
+
(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
"Go to message N in the summary buffer and the Rmail buffer.
If N is nil, use the message corresponding to point in the summary
! buffer and move to that message in the Rmail buffer.
If NOWARN, don't say anything if N is out of range.
If SKIP-RMAIL, don't do anything to the Rmail buffer."
(interactive "P")
(if (consp n) (setq n (prefix-numeric-value n)))
+
+ ;; Do the end of buffer adjustment.
(if (eobp) (forward-line -1))
(beginning-of-line)
!
! ;; Set N to the current message unless it was already set by the
! ;; caller.
! (unless n
! (setq n (rmail-summary-get-message-at-point)))
!
! (let* ((obuf (current-buffer))
! (buf rmail-buffer)
! (cur (point))
! message-not-found
! (curmsg (string-to-int
! (buffer-substring (point)
! (min (point-max) (+ 6 (point))))))
! (total (save-excursion (set-buffer buf) rmail-total-messages)))
!
! ;; Do a validity check on N. If it is valid then set the current
! ;; summary message to N. `rmail-summary-rmail-update' will then
! ;; actually move point to the selected message.
(if (< n 1)
(progn (message "No preceding message")
(setq n 1)))
***************
*** 1070,1098 ****
(goto-char (point-max))
(rmail-summary-goto-msg nil nowarn skip-rmail)))
(goto-char (point-min))
! (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t))
(progn (or nowarn (message "Message %d not found" n))
(setq n curmsg)
(setq message-not-found t)
! (goto-char cur))))
! (beginning-of-line)
! (skip-chars-forward " ")
! (skip-chars-forward "0-9")
! (save-excursion (if (= (following-char) ?-)
! (let ((buffer-read-only nil))
! (delete-char 1)
! (insert " "))))
! (rmail-summary-update-highlight message-not-found)
! (beginning-of-line)
! (if skip-rmail
! nil
! (let ((selwin (selected-window)))
! (unwind-protect
! (progn (pop-to-buffer buf)
! (rmail-show-message n))
! (select-window selwin)
! ;; The actions above can alter the current buffer. Preserve it.
! (set-buffer obuf))))))
;; Update the highlighted line in an rmail summary buffer.
;; That should be current. We highlight the line point is on.
--- 1083,1131 ----
(goto-char (point-max))
(rmail-summary-goto-msg nil nowarn skip-rmail)))
(goto-char (point-min))
! (if (not (re-search-forward (format "^%4d[^0-9]" n) nil t))
(progn (or nowarn (message "Message %d not found" n))
(setq n curmsg)
(setq message-not-found t)
! (goto-char cur)))
! (beginning-of-line)
! (skip-chars-forward " ")
! (skip-chars-forward "0-9")
! (save-excursion (if (= (following-char) ?-)
! (let ((buffer-read-only nil))
! (delete-char 1)
! (insert " "))))
! (rmail-summary-update-highlight message-not-found)
! (beginning-of-line)
!
! ;; Determine if the Rmail buffer needs to be processed.
! (if skip-rmail
! nil
!
! ;; It does.
! (let ((selwin (selected-window)))
! (unwind-protect
! (progn (pop-to-buffer buf)
! (rmail-show-message n))
! (select-window selwin)
! ;; The actions above can alter the current buffer. Preserve it.
! (set-buffer obuf))))))
!
! (defun rmail-summary-goto-msg-new (&optional n nowarn skip-rmail)
! ;; Do a validity check on N. If it is valid then set the current
! ;; summary message to N. `rmail-summary-rmail-update' will then
! ;; actually move point to the selected message.
! (cond
! ((< n 1)
! (or nowarn (message "No preceding message")))
! ((> n (save-excursion (set-buffer rmail-buffer) rmail-total-messages))
! (or nowarn (message "No following message")))
! (t
!
! ;; Make N the current message in the summary buffer and make
! ;; sure the Rmail buffer is being displayed.
! (setq rmail-current-message n)
! (display-buffer rmail-buffer))))
;; Update the highlighted line in an rmail summary buffer.
;; That should be current. We highlight the line point is on.
***************
*** 1213,1240 ****
;; Switch windows to the rmail buffer, or switch to it in this window.
(pop-to-buffer local-rmail-buffer)))
(defun rmail-summary-expunge ()
"Actually erase all deleted messages and recompute summary headers."
(interactive)
! (save-excursion
! (set-buffer rmail-buffer)
! (when (rmail-expunge-confirmed)
! (rmail-only-expunge)))
! (rmail-update-summary))
(defun rmail-summary-expunge-and-save ()
"Expunge and save RMAIL file."
(interactive)
! (save-excursion
! (set-buffer rmail-buffer)
! (when (rmail-expunge-confirmed)
! (rmail-only-expunge)))
! (rmail-update-summary)
! (save-excursion
! (set-buffer rmail-buffer)
! (save-buffer))
(set-buffer-modified-p nil))
(defun rmail-summary-get-new-mail (&optional file-name)
"Get new mail and recompute summary headers.
--- 1246,1270 ----
;; Switch windows to the rmail buffer, or switch to it in this window.
(pop-to-buffer local-rmail-buffer)))
+ ;;; mbox: ready
(defun rmail-summary-expunge ()
"Actually erase all deleted messages and recompute summary headers."
(interactive)
! (set-buffer rmail-buffer)
! (rmail-expunge)
! (set-buffer rmail-summary-buffer))
+ ;;; mbox: ready
(defun rmail-summary-expunge-and-save ()
"Expunge and save RMAIL file."
(interactive)
! (set-buffer rmail-buffer)
! (rmail-expunge)
! (save-buffer)
! (set-buffer rmail-summary-buffer)
(set-buffer-modified-p nil))
+ ;;; mbox: ready
(defun rmail-summary-get-new-mail (&optional file-name)
"Get new mail and recompute summary headers.
***************
*** 1245,1259 ****
(interactive
(list (if current-prefix-arg
(read-file-name "Get new mail from file: "))))
! (let (msg)
! (save-excursion
! (set-buffer rmail-buffer)
(rmail-get-new-mail file-name)
! ;; Get the proper new message number.
! (setq msg rmail-current-message))
! ;; Make sure that message is displayed.
! (or (zerop msg)
! (rmail-summary-goto-msg msg))))
(defun rmail-summary-input (filename)
"Run Rmail on file FILENAME."
--- 1275,1285 ----
(interactive
(list (if current-prefix-arg
(read-file-name "Get new mail from file: "))))
! (let (current-message)
! (with-current-buffer rmail-buffer
(rmail-get-new-mail file-name)
! (setq current-message rmail-current-message))
! (rmail-summary-goto-msg current-message nil t)))
(defun rmail-summary-input (filename)
"Run Rmail on file FILENAME."
***************
*** 1363,1387 ****
(rmail-search regexp n))
(set-buffer buffer))))
(defun rmail-summary-toggle-header ()
"Show original message header if pruned header currently shown, or vice
versa."
(interactive)
! (save-window-excursion
(set-buffer rmail-buffer)
! (rmail-toggle-header))
! ;; Inside save-excursion, some changes to point in the RMAIL buffer are
lost.
! ;; Set point to point-min in the RMAIL buffer, if it is visible.
! (let ((window (get-buffer-window rmail-view-buffer)))
! (if window
! ;; Using save-window-excursion would lose the new value of point.
! (let ((owin (selected-window)))
! (unwind-protect
! (progn
! (select-window window)
! (goto-char (point-min)))
! (select-window owin))))))
!
(defun rmail-summary-add-label (label)
"Add LABEL to labels associated with current Rmail message.
Completion is performed over known labels when reading."
--- 1389,1403 ----
(rmail-search regexp n))
(set-buffer buffer))))
+ ;;; mbox: ready
(defun rmail-summary-toggle-header ()
"Show original message header if pruned header currently shown, or vice
versa."
(interactive)
! (save-excursion
(set-buffer rmail-buffer)
! (rmail-toggle-header)))
+ ;;; mbox: ready
(defun rmail-summary-add-label (label)
"Add LABEL to labels associated with current Rmail message.
Completion is performed over known labels when reading."
***************
*** 1431,1436 ****
--- 1447,1453 ----
(set-buffer rmail-buffer)))
(rmail-start-mail t))
+ ;;; mbox: ready
(defun rmail-summary-reply (just-sender)
"Reply to the current message.
Normally include CC: to all other recipients of original message;
***************
*** 1484,1491 ****
(set-buffer rmail-buffer)))
(call-interactively 'rmail-resend)))
! ;; Summary output commands.
(defun rmail-summary-output-to-rmail-file (&optional file-name n)
"Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
--- 1501,1509 ----
(set-buffer rmail-buffer)))
(call-interactively 'rmail-resend)))
! ;;;; Summary output commands.
+ ;;; mbox: ready for testing
(defun rmail-summary-output-to-rmail-file (&optional file-name n)
"Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
***************
*** 1515,1520 ****
--- 1533,1539 ----
(if (< i n)
(rmail-summary-next-msg 1))))))
+ ;;; mbox: ready
(defun rmail-summary-output (&optional file-name n)
"Append this message to Unix mail file named FILE-NAME.
***************
*** 1642,1647 ****
--- 1661,1731 ----
(progn (pop-to-buffer rmail-buffer)
(funcall sortfun reverse))
(select-window selwin))))
+
+ (defun rmail-summary-get-line-count (n)
+ "Return a string containing the count of lines in message N for the
+ summary buffer if the User has enabled line counts, otherwise return
+ an empty string."
+ (if rmail-summary-line-count-flag
+ (format "[%s]" (rmail-desc-get-line-count n))
+ ""))
+
+ (defun rmail-summary-get-summary-attributes (n)
+ "Return the attribute character codes to use in the summary buffer
+ for message N: `-' for an unseen message, `D' for a message marked
+ for deletion."
+ (format "%s%s%s%s%s"
+ (cond ((rmail-desc-attr-p rmail-desc-unseen-index n) "-")
+ ((rmail-desc-attr-p rmail-desc-deleted-index n) "D")
+ (t " "))
+ (or (rmail-desc-get-attr-code rmail-desc-answered-index n) " ")
+ (or (rmail-desc-get-attr-code rmail-desc-filed-index n) " ")
+ (or (rmail-desc-get-attr-code rmail-desc-edited-index n) " ")
+ (or (rmail-desc-get-attr-code rmail-desc-stored-index n) " ")))
+
+ (defun rmail-summary-get-summary (n)
+ "Return a summary line for message N."
+ (format "%4s%s%6s %25s %s %s\n"
+ n
+ (rmail-summary-get-summary-attributes n)
+ (concat (rmail-desc-get-day-number n) "-"
+ (rmail-desc-get-month n))
+ (rmail-desc-get-sender n)
+ (rmail-summary-get-line-count n)
+ (rmail-desc-get-subject n)))
+
+ (defun rmail-summary-update-attribute (attr-index n)
+ "Update the attribute denoted by ATTR-INDEX in message N."
+ (save-excursion
+ (let (offset)
+
+ ;; Position point at the beginning of the attributes.
+ (rmail-summary-goto-msg n)
+ (skip-chars-forward " ")
+ (skip-chars-forward "0-9")
+
+ ;; Determine if the attribute is represented on the summary
+ ;; line.
+ (setq offset (rmail-desc-get-summary-offset attr-index))
+ (if offset
+
+ ;; It is. If necessary, replace the character code
+ ;; corresponding to ATTR-INDEX.
+ (let ((char (rmail-desc-get-attr-code attr-index n))
+ (buffer-read-only nil))
+ (goto-char (+ (point) offset))
+ (unless (looking-at char)
+ (delete-char 1)
+ (insert char)))))))
+
+ ;;;; Browser related functions.
+
+ (defun rmail-summary-browse-body ()
+ "Send the message body to the browser."
+ (interactive)
+ (save-excursion
+ (set-buffer rmail-buffer)
+ (rmail-browse-body)))
(provide 'rmailsum)
Index: lisp/net/browse-url.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/net/browse-url.el,v
retrieving revision 1.23
diff -c -r1.23 browse-url.el
*** lisp/net/browse-url.el 22 Jul 2002 15:21:41 -0000 1.23
--- lisp/net/browse-url.el 26 Aug 2002 23:28:26 -0000
***************
*** 1,6 ****
;;; browse-url.el --- pass a URL to a WWW browser
! ;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Denis Howe <address@hidden>
--- 1,6 ----
;;; browse-url.el --- pass a URL to a WWW browser
! ;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Denis Howe <address@hidden>
***************
*** 145,150 ****
--- 145,155 ----
;; In Dired, to display the file named on the current line:
;; M-x browse-url-of-dired-file RET
+ ;; To activate URLs in a region of a buffer such the URLs are diplayed
+ ;; in one face if the URL has not been visited, another if the URL has
+ ;; been visited and yet anothe if the mouse is hovering over the URL:
+ ;; M-x browse-url-activate-urls RET
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customisation (~/.emacs)
***************
*** 213,223 ****
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
! (eval-when-compile (require 'thingatpt)
! (require 'term)
! (require 'dired)
! (require 'executable)
! (require 'w3-auto nil t))
(defgroup browse-url nil
"Use a web browser to look at a URL."
--- 218,230 ----
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
! (eval-and-compile
! (progn
! (require 'thingatpt)
! (require 'term)
! (require 'dired)
! (require 'executable)
! (require 'w3-auto nil t)))
(defgroup browse-url nil
"Use a web browser to look at a URL."
***************
*** 539,544 ****
--- 546,554 ----
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+ (defvar browse-url-visited-urls nil
+ "A list of activated URLs that have been visited in a browser.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
***************
*** 692,700 ****
(interactive "P")
(let ((url (browse-url-url-at-point)))
(if url
! (browse-url url (if arg
! (not browse-url-new-window-flag)
! browse-url-new-window-flag))
(error "No URL found"))))
;;;###autoload
--- 702,714 ----
(interactive "P")
(let ((url (browse-url-url-at-point)))
(if url
! (progn
! (browse-url url (if arg
! (not browse-url-new-window-flag)
! browse-url-new-window-flag))
! (unless (member url browse-url-visited-urls)
! (setq browse-url-visited-urls
! (append (list url) browse-url-visited-urls))))
(error "No URL found"))))
;;;###autoload
***************
*** 1266,1271 ****
--- 1280,1366 ----
(message "Sending URL to KDE...")
(apply #'start-process `(,(concat "KDE" url) nil ,browse-url-kde-program
,@browse-url-kde-args ,url)))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;; Setting up text to be browsed.
+
+ (defvar browse-url-activation-alist nil
+ "A per buffer cache of overlays that mark URLs in the buffer.")
+
+ (defun browse-url-activate-urls (start end &optional face visited-face
mouse-face keymap)
+ "Activate the URLs in the region of the current buffer bracketed by START
and END.
+ This creates an overlay on each URL in the region. FACE, if provided,
+ marks a URL that has not yet been visited. If FACE is nil then the
+ 'bold' face is used. VISITED-FACE, if provided, marks a URL that has
+ already been visited. If VISITED-FACE is nil then the `bold-italic'
+ face is used. MOUSE-FACE, if provided is the face that will appear
+ when the mouse is hovering over the URL. If MOUSE-FACE is nil then
+ the 'highlight' face is used.
+
+ If KEYMAP is non-nil it specifies a keymap that determines when to
+ send the URL to the browser, otherwise a local keymap will be set up
+ on the URL that sets up mouse button 2 and newline as the input to
+ send the URL to the browser."
+ (save-excursion
+
+ (let ((overlays (cdr (assoc (current-buffer)
browse-url-activation-alist)))
+ (unarmed-face (or face 'bold))
+ (visited-face (or visited-face 'bold-italic))
+ (armed-face (or mouse-face 'highlight))
+ overlay-list url normal-face overlay bounds)
+
+ ;; Clear the cache of URL overlays for the current buffer.
+ (mapcar 'delete-overlay overlays)
+
+ ;; Copy the cached overlays to be handed out as needed.
+ (setq overlay-list overlays)
+
+ ;; Determine if we should set up a keymap on the URLs
+ (unless keymap
+
+ ;; Go ahead and set up a local keymap defaulting to the
+ ;; browse-url functions for sending the URL to a browser.
+ (setq keymap (make-sparse-keymap))
+ (define-key keymap [mouse-2] 'browse-url-at-mouse)
+ (define-key keymap "\r" 'browse-url-at-point))
+
+ ;; Determine if there are any more URLs in the region following
+ ;; the headers.
+ (goto-char start)
+ (while (re-search-forward thing-at-point-url-regexp end t)
+
+ ;; There are. Get the URL.
+ (setq bounds (thing-at-point-bounds-of-url-at-point)
+ url (buffer-substring (car bounds) (cdr bounds)))
+
+ ;; Get an overlay (from the cache if possible).
+ (if (null overlay-list)
+
+ ;; Create an overlay to use for the current URL that
+ ;; highlights the URL and provides a keymap for sending
+ ;; the URL to a browser via a mouse button 2 keypress or a
+ ;; newline press.
+ (progn
+ (setq overlay (make-overlay (car bounds) (cdr bounds)))
+ (if (null overlays)
+ (setq overlays (list overlay)
+ browse-url-activation-alist
+ (append (list (cons (current-buffer) overlays))
+ browse-url-activation-alist))
+ (setq overlays (append (list overlay) overlays)))
+ (overlay-put overlay 'mouse-face armed-face)
+ (overlay-put overlay 'local-map keymap))
+
+ ;; Grab an overlay from the cache.
+ (setq overlay (car overlay-list)
+ overlay-list (cdr overlay-list))
+ (move-overlay overlay (car bounds) (cdr bounds)))
+
+ ;; Select the normal face based on whether or not the URL has
+ ;; been visited.
+ (overlay-put overlay 'face (if (member url browse-url-visited-urls)
+ visited-face
+ unarmed-face))))))
(provide 'browse-url)
Index: lisp/textmodes/ispell.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/textmodes/ispell.el,v
retrieving revision 1.132
diff -c -r1.132 ispell.el
*** lisp/textmodes/ispell.el 29 Jul 2002 17:29:31 -0000 1.132
--- lisp/textmodes/ispell.el 26 Aug 2002 23:28:26 -0000
***************
*** 813,818 ****
--- 813,819 ----
(not xemacsp)
'reload))
+ ;;;###autoload
(defvar ispell-library-directory (condition-case ()
(check-ispell-version)
(error nil))
lisp/mail/rmaildesc.el
;;; rmaildesc.el --- Low level message descriptor library for Rmail.
;; Copyright (C) 2002
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; This package provides low level functions for tracking messages in Rmail.
;;; Code:
;; Written by Paul Reilly as part of moving BABYL to mbox format.
(eval-when-compile
(require 'rmailhdr)
(require 'mail-utils))
(defvar rmail-desc-attributes nil
"A private variable providing temporary access to message attributes.")
(defvar rmail-desc-delete-callback nil
"A function pointer called after a message has been deleted.
It expects one argument --- the message number.")
(defvar rmail-desc-vector nil
"A vector of message descriptors.
A message descriptor contains data formatted as follows:
(START ATTRIBUTES KEYWORDS DATE LINE-COUNT SENDER SUBJECT)
where
START is a marker at the beginning of the header
ATTRIBUTES is a string where each character encodes an
attribute. A hyphen (-) indicates that the attribute is not
set:
ANSWERED The message has been replied to (A).
DELETED The message has been marked for deletion (D).
EDITED The message has been edited (E).
FILED The message has been filed (F).
RESENT The message has been resent (R).
STORED The message has been saved to a file (S).
UNSEEN The message has not been read (-).
KEYWORDS is a list of User defined label strings.
DATE is a list of strings describing the message date:
DAY-OF-WEEK Mon, Sun, etc.
DAY-NUMBER 9, 13, 15, etc.
MONTH Feb, Jun, etc.
YEAR 2001, 2002, etc.
TIME 12:03:25, etc.
LINE-COUNT is the number of lines in the message.
SENDER is the name of the User sending the message.
SUBJECT is the subject header, cached to support fast summary line
generation.
")
(put 'rmail-desc-vector 'permanent-local t)
;;;; Constants supporting message vector processing.
;;; Message component indexes.
(defconst rmail-desc-beg-index 0
"The message descriptor element index for the start of the message text.")
(defconst rmail-desc-attrs-index 1
"The message descriptor element index for the attributes string.")
(defconst rmail-desc-keywords-index 2
"The message descriptor element index for the User defined labels.")
(defconst rmail-desc-date-index 3
"The message descriptor element index for the message date information.")
(defconst rmail-desc-line-count-index 4
"The message descriptor element index for the message line count.")
(defconst rmail-desc-sender-index 5
"The message descriptor element index for the message line count.")
(defconst rmail-desc-subject-index 6
"The message descriptor element index for the message line count.")
;;; Attribute indexes
(defconst rmail-desc-answered-index 0
"The index for the `answered' attribute.")
(defconst rmail-desc-deleted-index 1
"The index for the `deleted' attribute.")
(defconst rmail-desc-edited-index 2
"The index for the `edited' attirute.")
(defconst rmail-desc-filed-index 3
"The index for the `filed' attribute.")
(defconst rmail-desc-resent-index 4
"The index for the `resent' attribute.")
(defconst rmail-desc-stored-index 5
"The index for the `stored' attribute.")
(defconst rmail-desc-unseen-index 6
"The index for the `unseen' attribute.")
(defconst rmail-desc-attr-code-index 0
"The index for the attibute code.")
(defconst rmail-desc-attr-keyword-index 1
"The index for the attribute keyword.")
(defconst rmail-desc-attr-summary-offset-index 2
"The index for the attribute offset in a summary buffer.")
(defconst rmail-desc-attr-alist
(list (cons rmail-desc-answered-index (list ?A "answered" 1))
(cons rmail-desc-deleted-index (list ?D "deleted" 0))
(cons rmail-desc-edited-index (list ?E "edited" 3))
(cons rmail-desc-filed-index (list ?F "filed" 2))
(cons rmail-desc-resent-index (list ?R "resent" nil))
(cons rmail-desc-stored-index (list ?S "stored" 4))
(cons rmail-desc-unseen-index (list ? "unseen" 0)))
"An alist mapping an attribute to a keycode, keyword and summary offset.")
(defconst rmail-desc-attr-index-map
(list (cons "answered" rmail-desc-answered-index)
(cons "deleted" rmail-desc-deleted-index)
(cons "edited" rmail-desc-edited-index)
(cons "filed" rmail-desc-filed-index)
(cons "resent" rmail-desc-resent-index)
(cons "stored" rmail-desc-stored-index)
(cons "unseen" rmail-desc-unseen-index)))
;;; Date indexes
(defconst rmail-desc-date-day-of-week-index 0
"The DAY-OF-WEEK index into the list of date information.")
(defconst rmail-desc-date-day-number-index 1
"The DAY-NUMBER index into the list of date information.")
(defconst rmail-desc-date-month-index 2
"The MONTH index into the list of date information.")
(defconst rmail-desc-date-year-index 3
"The YEAR index into the list of date information.")
(defconst rmail-desc-date-time-index 4
"The TIME index into the list of date information.")
(defsubst rmail-desc-get-descriptor (n)
"Return a descriptor for message N.
N is 1 based, i.e. the first message number is 1."
(aref rmail-desc-vector (1- n)))
(defsubst rmail-desc-get-start (n)
"Return the position of the start of message N."
(marker-position
(nth rmail-desc-beg-index (rmail-desc-get-descriptor n))))
(defun rmail-desc-get-end (n)
"Return the position of the end of message N."
(if (= n (length rmail-desc-vector))
(save-restriction
(widen)
(point-max))
(rmail-desc-get-start (1+ n))))
(defun rmail-desc-add-descriptors (descriptor-list)
"Append DESCRIPTOR-LIST to the Rmail message descriptor vector."
(setq rmail-desc-vector
(vconcat rmail-desc-vector descriptor-list)))
(defun rmail-desc-add-keyword (keyword n)
"Add KEYWORD to the list of keywords for message N.
The current buffer, likely narrowed, contains message N."
;; Append KEYWORD to the descriptor for message N.
(save-excursion
(save-restriction
(let ((keyword-list (rmail-desc-get-keyword-list n))
(display-state (rmail-desc-get-header-display-state n)))
(rmail-header-show-headers)
(if keyword-list
;; ??? Don't use setcdr for this.
;; Just add it to the front of the list
;; and store the updated list back in its proper place.
;; Append the string to the list unless it already is there.
(unless (member-ignore-case keyword keyword-list)
(setcdr keyword-list (append (cdr keyword-list) (list keyword)))
;; Persist the label for this message.
(rmail-header-add-header
rmail-header-keyword-header
(concat (rmail-header-get-header rmail-header-keyword-header)
"," keyword)))
;; Create the initial keyword list as well as the keyword header
;; and persist the header.
(setq keyword-list
(nthcdr rmail-desc-keywords-index (rmail-desc-get-descriptor
n)))
(setcar keyword-list (list keyword))
(rmail-header-add-header rmail-header-keyword-header keyword))
(rmail-header-toggle-visibility display-state)))))
(defun rmail-desc-remove-keyword (keyword n)
"Remove KEYWORD from the list of keywords for message N.
The current buffer, likely narrowed, contains message N."
;; Remove KEYWORD from the descriptor for message N.
(save-excursion
(save-restriction
(let ((desc-list (nthcdr rmail-desc-keywords-index
(rmail-desc-get-descriptor n)))
(display-state (rmail-desc-get-header-display-state n)))
;; Remove the keyword from the descriptor.
(setcar desc-list (delete keyword (car desc-list)))
;; Persist the change by removing the keyword for the keywords
;; header and restore the display state.
(rmail-header-show-headers)
(rmail-header-delete-keyword keyword)
(rmail-header-toggle-visibility display-state)))))
(defun rmail-desc-attr-p (attr-index n)
"Return the state of the the attribute denoted by ATTR-INDEX in
message N."
(let ((attrs (nth rmail-desc-attrs-index
(rmail-desc-get-descriptor n))))
(not (equal "-" (substring attrs attr-index (1+ attr-index))))))
(defun rmail-desc-clear-descriptors ()
"Clear the Rmail message vector of all messages."
(setq rmail-desc-vector nil))
(defun rmail-desc-deleted-p (n)
"Return non-nil if message N is marked for deletion."
(rmail-desc-attr-p rmail-desc-deleted-index n))
(defun rmail-desc-delete-maybe (n)
"Determine if message N is marked for deletion. If so then delete it.
Return t if the message is deleted, nil if not."
(if (rmail-desc-deleted-p n)
(progn
(rmail-desc-delete n)
t)))
(defun rmail-desc-delete (n)
"Remove message N from the Rmail buffer and from the descriptor vector."
(save-excursion
(save-restriction
;; Enable the buffer to be written, ignore intangibility and do
;; not record these changes in the undo list.
(let ((inhibit-read-only t)
(inhibit-point-motion-hooks t)
(buffer-undo-list t)
start end)
(widen)
;; Remove the message from the buffer and neutralize the
;; marker pointing to the start of the message.
(delete-region (rmail-desc-get-start n) (rmail-desc-get-end n))
(move-marker (nth rmail-desc-beg-index (rmail-desc-get-descriptor n))
nil)
;; Remove the message descriptor from the Rmail message vector
;; and execute the callback indicating the message has been
;; deleted.
(aset rmail-desc-vector (1- n) t)
(funcall rmail-desc-delete-callback n)))))
(defun rmail-desc-get-attr-code (attr-index n)
"Return the attribute code for ATTR-INDEX in message N.
If the attribute is not set, return nil."
(if (rmail-desc-attr-p attr-index n)
(string (nth rmail-desc-attr-code-index
(cdr (assoc attr-index rmail-desc-attr-alist))))))
(defun rmail-desc-get-attr-index (attr)
"Return the attribute index associated with attribute ATTR, a string."
(cdr (assoc attr rmail-desc-attr-index-map)))
(defun rmail-desc-get-attributes (n)
"Return the attribute vector for message N."
(nth rmail-desc-attrs-index (rmail-desc-get-descriptor n)))
(defsubst rmail-desc-get-count ()
"Return the number of messages described in the Rmail descriptor vector."
(length rmail-desc-vector))
(defun rmail-desc-get-date (n)
"Return the date list generated when the messages were read in."
(nth rmail-desc-date-index (rmail-desc-get-descriptor n)))
(defun rmail-desc-get-day-number (n)
"Return the day number (1..31) from the date associated with message N."
(nth rmail-desc-date-day-number-index
(nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
(defun rmail-desc-get-day-of-week (n)
"Return the day of week (Sun .. Sat) from the date associated with message N."
(nth rmail-desc-date-day-of-week-index
(nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
(defun rmail-desc-get-default-attrs ()
"Return the default attributes for a new message."
(format "%s" "------U"))
(defun rmail-desc-get-header-display-state (n)
"Return t if ignorable headers are being displayed, nil otherwise."
(null (overlays-at (rmail-desc-get-start n))))
(defun rmail-desc-get-keyword (attr-index)
"Return the keyword string associated with ATTR-INDEX."
(nth rmail-desc-attr-keyword-index
(cdr (assoc attr-index rmail-desc-attr-alist))))
(defun rmail-desc-get-keyword-list (n)
"Return the list of User defined keywords for message N."
(nth rmail-desc-keywords-index (rmail-desc-get-descriptor n)))
(defun rmail-desc-get-keyword-maybe (attribute)
"Return the keyword associated with ATTRIBUTE if it is set, nil otherwise.
ATTRIBUTE is a cons cell associating an attribute index with a keyword string."
(let ((index (car attribute)))
(if (not (equal "-" (substring rmail-desc-attributes index (1+ index))))
(nth rmail-desc-attr-keyword-index (cdr attribute)))))
(defun rmail-desc-get-keywords (n)
"Return a list of keywords for message N."
;; Combine the attribute keywords with the User defined keywords.
(setq rmail-desc-attributes (rmail-desc-get-attributes n))
(append (delq nil (mapcar
'rmail-desc-get-keyword-maybe
rmail-desc-attr-alist))
(rmail-desc-get-keyword-list n)))
(defun rmail-desc-get-line-count (n)
"Return the message body line count."
(nth rmail-desc-line-count-index (rmail-desc-get-descriptor n)))
(defun rmail-desc-get-month (n)
"Return the month (Jan .. Dec) from the date associated with message N."
(nth rmail-desc-date-month-index
(nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
(defun rmail-desc-get-sender (n)
"Return the User registered as the mail sender."
(nth rmail-desc-sender-index (rmail-desc-get-descriptor n)))
(defun rmail-desc-get-subject (n)
"Return the cached subject header."
(nth rmail-desc-subject-index (rmail-desc-get-descriptor n)))
(defun rmail-desc-get-summary-offset (attr-index)
"Return the summary buffer offset associated with ATTR-INDEX.
This is the relative position where the attribute code letter is
displayed in the Rmail summary buffer."
(nth rmail-desc-attr-summary-offset-index
(cdr (assoc attr-index rmail-desc-attr-alist))))
(defun rmail-desc-get-time (n)
"Return the time (hh:mm:ss) from the date associated with message N."
(nth rmail-desc-date-time-index
(nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
(defun rmail-desc-get-year (n)
"Return the year (1969 ... 2###) from the date associated with message N."
(nth rmail-desc-date-year-index
(nth rmail-desc-date-index (rmail-desc-get-descriptor n))))
;; This is a strange thing to use.
;; Why not write a simple loop instead?
(defun rmail-desc-make-index-list ()
"Return a list of integers from 1 to the total number of messages."
(let ((result (make-vector (length rmail-desc-vector) nil))
(index 0))
(while (< index (length result))
(aset result index (1+ index))
(setq index (1+ index)))
(append result nil)))
(defun rmail-desc-prune-deleted-messages (callback)
"Remove all messages marked for marked for deletion.
Return the number of messages removed. Invoke CALLBACK immediately
after a message has been deleted.."
;; Set the callback.
(setq rmail-desc-delete-callback callback)
;; Remove all messages marked for deletion from the Rmail buffer and
;; their descriptors from the Rmail message vector.
(let ((result (length (delq t (mapcar 'rmail-desc-delete-maybe
(rmail-desc-make-index-list))))))
(setq rmail-desc-vector
(vconcat (delq t (append rmail-desc-vector nil))))
result))
(defun rmail-desc-set-attribute (attr-index state n)
"Set the attribute denoted by ATTR-INDEX in message N according to STATE.
If STATE is non-nil the attribute will be set to the single character code
associated with ATTR-INDEX in rmail-desc-attr-alist, otherwise the attribute is
set to the hyphen character (-)."
(let ((attributes (nth rmail-desc-attrs-index (rmail-desc-get-descriptor n)))
code)
(setq code (if state
(car (cdr (assoc attr-index rmail-desc-attr-alist)))
?-))
(aset attributes attr-index code)
(rmail-header-persist-attributes attributes)))
(defun rmail-desc-set-start (n pos)
"Set the start position for message N to POS."
(set-marker (nth rmail-desc-beg-index (rmail-desc-get-descriptor n)) pos))
(defun rmail-desc-showing-message-p (n)
"Return t if the current buffer is displaying message N, nil otherwise."
(let ((beg (rmail-desc-get-start n))
(end (rmail-desc-get-end n))
(curpos (point)))
(and (>= curpos beg) (< curpos end))))
(provide 'rmaildesc)
lisp/mail/rmailhdr.el
;;; rmail-header.el --- Header handling code of "RMAIL" mail reader for Emacs
;; Copyright (C) 2002
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
;; Written by Paul Reilly as part of moving BABYL to inbox/mbox format.
(eval-when-compile
(require 'mail-utils))
(defconst rmail-header-attribute-header "X-BABYL-V6-ATTRIBUTES"
"The header that persists the Rmail attribute data.")
(defconst rmail-header-keyword-header "X-BABYL-V6-KEYWORDS"
"The header that persists the Rmail keyword data.")
(defvar rmail-header-overlay-list nil
"A list of cached overlays used to make headers hidden or visible.")
(defvar rmail-header-display-mode nil
"Records the current header display mode.
nil means headers are displayed, t indicates headers are not displayed.")
(defmacro rmail-header-get-limit ()
'(progn
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
(1- (point))
(error "Invalid message format."))))
;;; The following functions are presented alphabetically ordered by
;;; name.
(defun rmail-header-add-header (header value)
"Add HEADER to the list of headers and associate VALUE with it.
The current buffer, possibly narrowed, contains a single message."
(save-excursion
(let* ((inhibit-read-only t)
(case-fold-search t)
(limit (rmail-header-get-limit))
start end)
;; Search for the given header. If found, then set it's value.
;; If not then add the header to the end of the header section.
(goto-char (point-min))
(if (re-search-forward (format "^%s: " header) limit t)
;; Kill the current value and replace it with the new.
(progn
(beginning-of-line)
(setq start (point))
(while (progn
(forward-line 1)
(looking-at "[ \t]+")))
(kill-region start (point)))
;; Add a new header at the end of the headers.
(goto-char limit))
(insert header ": " value "\n"))))
(defun rmail-header-contains-keyword-p (keyword)
"Return t if KEYWORD exists in the current buffer, nil otherwise."
(let ((limit (rmail-header-get-limit)))
(goto-char (point-min))
(if (re-search-forward (format "^%s: " rmail-header-keyword-header) limit t)
;; Some keywords exist. Now search for the specific keyword.
(let ((start (point))
(end (progn (end-of-line) (point))))
(if (re-search-forward (concat "\\(" keyword ",\\|" keyword "$\\)"))
t)))))
(defun rmail-header-get-header (header)
"Return the text value for HEADER, nil if no such header exists.
The current buffer, possibly narrowed, contains a single message."
(save-excursion
(let ((case-fold-search t)
(inhibit-point-motion-hooks t)
(limit (rmail-header-get-limit))
result start end)
;; Search for the given header. If found return it, otherwise
;; nil.
(goto-char (point-min))
(if (re-search-forward (format "^%s: " header) limit t)
;; Get the value, including extension parts.
(progn
(setq start (point))
(end-of-line)
(setq result (buffer-substring start (point)))
(while (progn
(forward-line 1)
(looking-at "[ \t]+"))
(setq start (match-end 0))
(end-of-line)
(setq result (format "%s %s" result
(buffer-substring start (point)))))))
result)))
(defun rmail-header-get-keywords ()
"Return the keywords in the current message.
The current buffer, possibly narrowed, contains a single message."
;; Search for a keyword header and return the comma separated
;; strings as a list.
(let ((limit (rmail-header-get-limit)) result)
(goto-char (point-min))
(if (re-search-forward
(format "^%s: " rmail-header-keyword-header) limit t)
(save-excursion
(save-restriction
(narrow-to-region (point) (progn (end-of-line) (point)))
(goto-char (point-min))
(mail-parse-comma-list))))))
(defun rmail-header-hide-headers ()
"Hide ignored headers. All others will be visible.
The current buffer, possibly narrowed, contains a single message."
(save-excursion
(let ((case-fold-search t)
(limit (rmail-header-get-limit))
(inhibit-point-motion-hooks t)
start end visibility-p overlay overlay-list)
;; Record the display state as having headers hidden.
(setq rmail-header-display-mode t)
;; Clear the pool of overlays for reuse.
(mapcar 'delete-overlay rmail-header-overlay-list)
(setq overlay-list rmail-header-overlay-list)
;; Determine whether to use the displayed headers or the ignored
;; headers.
(if rmail-displayed-headers
;; Set the visibility predicate function to ignore headers
;; marked for display.
(setq visibility-p 'rmail-header-show-displayed-p)
;; Set the visibility predicate function to hide ignored
;; headers.
(setq visibility-p 'rmail-header-hide-ignored-p))
;; Walk through all the headers marking the non-displayed
;; headers as invisible.
(goto-char (point-min))
(while (re-search-forward "^[^ \t:]+[ :]" limit t)
;; Determine if the current header needs to be hidden.
(beginning-of-line)
(if (funcall visibility-p)
;; It does. Make this header hidden by setting an overlay
;; with both the invisible and intangible properties set.
(progn
(setq start (point))
(forward-line 1)
(while (looking-at "[ \t]+")
(forward-line 1))
(setq end (point))
;; Use one of the cleared, cached overlays until they
;; run out.
(if (car overlay-list)
;; Use a cached overlay.
(progn
(setq overlay (car overlay-list)
overlay-list (cdr overlay-list))
(move-overlay overlay start end))
;; No overlay exists for this header. Create one and
;; add it to the cache.
(setq overlay (make-overlay start end)
rmail-header-overlay-list
(append (list overlay)
rmail-header-overlay-list))
(overlay-put overlay 'invisible t)
(overlay-put overlay 'intangible t)))
;; It does not. Move point away from this header.
(forward-line 1))))))
(defun rmail-header-persist-attributes (attributes)
"Save ATTRIBUTES in the Rmail BABYL header.
The current buffer, possibly narrowed, contains a single message."
(rmail-header-set-header rmail-header-attribute-header attributes))
(defun rmail-header-remove-keyword (keyword)
"..."
;; tbd
)
(defun rmail-header-set-header (header value)
"Set the current value of HEADER to VALUE.
The current buffer, possibly narrowed, contains a single message."
(save-excursion
;; Enable the buffer to be written, search for the header case
;; insensitively, ignore intangibility and do not record these
;; changes in the undo list.
(let ((inhibit-read-only t)
(case-fold-search t)
(inhibit-point-motion-hooks t)
(buffer-undo-list t)
(limit (rmail-header-get-limit))
start end)
;; Search for the given header. If found, then set it's value.
;; If not generate an error.
(goto-char (point-min))
(if (re-search-forward (format "^%s: " header) limit t)
;; Kill the current value and replace it with the new.
(progn
(setq start (point))
(while (progn
(forward-line 1)
(looking-at "[ \t]+")))
(setq end (point-marker))
(goto-char start)
(insert-and-inherit value)
(kill-region (point) (1- (marker-position end))))
;; Generate an error since the header does not exist.
(error "Header %s not found." header)))))
(defun rmail-header-show-headers ()
"Show all headers.
The current buffer, possibly narrowed, contains a single message."
;; Remove all the overlays used to control hiding headers.
(mapcar 'delete-overlay rmail-header-overlay-list)
(setq rmail-header-display-mode nil))
(defun rmail-header-toggle-visibility (&optional arg)
"Toggle the visibility of the ignored headers if ARG is nil.
Hide the ignored headers if ARG is greater than 0, otherwise show the
ignored headers. The current buffer, possibly narrowed, contains a
single message."
(cond ((eq arg nil)
(if rmail-header-display-mode
(rmail-header-show-headers)
(rmail-header-hide-headers)))
((> arg 0)
(rmail-header-hide-headers))
(t (rmail-header-show-headers))))
(defun rmail-header-hide-ignored-p ()
"Test that the header is one of the headers marked to be ignored."
(looking-at rmail-ignored-headers))
(defun rmail-header-show-displayed-p ()
"Test that the header is not one of the headers marked for display."
(not (looking-at rmail-displayed-headers)))
(provide 'rmailhdr)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- Rmail mbox diffs,
Paul Michael Reilly <=