Mercurial > emacs

changeset 98313:c7eef45e0d32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First pass at handling decoding the mbox message into the view buffer.
author Paul Reilly <pmr@pajato.com>
date Tue, 23 Sep 2008 11:30:17 +0000
parents d8a3b46ba292
children 7fafc74e823f
files lisp/mail/pmail.el
diffstat 1 files changed, 132 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/pmail.el	Tue Sep 23 08:25:44 2008 +0000
+++ b/lisp/mail/pmail.el	Tue Sep 23 11:30:17 2008 +0000
@@ -910,7 +910,7 @@
     (pmail-maybe-set-message-counters)
     (unwind-protect
 	(unless (and (not file-name-arg) (pmail-get-new-mail))
-	  (pmail-show-message (pmail-first-unseen-message)))
+	  (pmail-show-message-maybe (pmail-first-unseen-message)))
       (progn
 	(if pmail-display-summary (pmail-summary))
 	(pmail-construct-io-menu)
@@ -984,6 +984,18 @@
 Note:   If you are seeing it in pmail,
 Note:    it means the file has no messages in it.\n\^_")))
 
+(defun pmail-get-coding-system ()
+  "Return a suitable coding system to use for the mail message in
+the region."
+  (let ((content-type-header (mail-fetch-field "content-type"))
+	separator)
+    (save-excursion
+      (setq separator (search-forward "\n\n")))
+    (if (and content-type-header
+	     (string-match pmail-mime-charset-pattern content-type-header))
+	(substring content-type-header (match-beginning 1) (match-end 1))
+      'undecided)))
+
 ;; Decode Babyl formatted part at the head of current buffer by
 ;; pmail-file-coding-system, or if it is nil, do auto conversion.
 
@@ -1036,7 +1048,7 @@
   (define-key pmail-mode-map "g"      'pmail-get-new-mail)
   (define-key pmail-mode-map "h"      'pmail-summary)
   (define-key pmail-mode-map "i"      'pmail-input)
-  (define-key pmail-mode-map "j"      'pmail-show-message)
+  (define-key pmail-mode-map "j"      'pmail-show-message-maybe)
   (define-key pmail-mode-map "k"      'pmail-kill-label)
   (define-key pmail-mode-map "l"      'pmail-summary-by-labels)
   (define-key pmail-mode-map "\e\C-h" 'pmail-summary)
@@ -1252,7 +1264,7 @@
 \\[pmail-previous-message]	Move to Previous message whether deleted or not.
 \\[pmail-first-message]	Move to the first message in Pmail file.
 \\[pmail-last-message]	Move to the last message in Pmail file.
-\\[pmail-show-message]	Jump to message specified by numeric position in file.
+\\[pmail-show-message-maybe]	Jump to message specified by numeric position in file.
 \\[pmail-search]	Search for string and show message it is found in.
 \\[pmail-delete-forward]	Delete this message, move to next nondeleted.
 \\[pmail-delete-backward]	Delete this message, move to previous nondeleted.
@@ -1298,7 +1310,7 @@
 	(goto-char (point-max))
 	(set-buffer-multibyte t)))
     (pmail-set-message-counters)
-    (pmail-show-message pmail-total-messages)
+    (pmail-show-message-maybe pmail-total-messages)
     (when finding-pmail-file
       (when pmail-display-summary
 	(pmail-summary))
@@ -1339,7 +1351,10 @@
   (make-local-variable 'pmail-buffer)
   (setq pmail-buffer (current-buffer))
   (make-local-variable 'pmail-view-buffer)
-  (setq pmail-view-buffer (pmail-generate-viewer-buffer))
+  (save-excursion
+    (setq pmail-view-buffer (pmail-generate-viewer-buffer))
+    (set-buffer pmail-view-buffer)
+    (set-buffer-multibyte t))
   (make-local-variable 'pmail-summary-buffer)
   (make-local-variable 'pmail-summary-vector)
   (make-local-variable 'pmail-current-message)
@@ -1421,7 +1436,7 @@
 	  (set-buffer-multibyte t))
       (goto-char (point-max))
       (pmail-set-message-counters)
-      (pmail-show-message pmail-total-messages)
+      (pmail-show-message-maybe pmail-total-messages)
       (run-hooks 'pmail-mode-hook))))
 
 ;; Return a list of files from this buffer's Mail: option.
@@ -1501,7 +1516,7 @@
     (goto-char (pmail-msgend pmail-current-message))
     (insert string)
     (pmail-forget-messages)
-    (pmail-show-message number)
+    (pmail-show-message-maybe number)
     (message "Message duplicated")))
 
 ;;;###autoload
@@ -1774,12 +1789,12 @@
 
 		;; Move to the first new message
 		;; unless we have other unseen messages before it.
-		(pmail-show-message (pmail-first-unseen-message))
+		(pmail-show-message-maybe (pmail-first-unseen-message))
 		(run-hooks 'pmail-after-get-new-mail-hook)
 		(setq found t))))
 	  found)
       ;; Don't leave the buffer screwed up if we get a disk-full error.
-      (or found (pmail-show-message)))))
+      (or found (pmail-show-message-maybe)))))
 
 (defun pmail-parse-url (file)
   "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
@@ -1976,13 +1991,13 @@
 
 ;; Decode the region specified by FROM and TO by CODING.
 ;; If CODING is nil or an invalid coding system, decode by `undecided'.
-(defun pmail-decode-region (from to coding)
+(defun pmail-decode-region (from to coding &optional destination)
   (if (or (not coding) (not (coding-system-p coding)))
       (setq coding 'undecided))
   ;; Use -dos decoding, to remove ^M characters left from base64 or
   ;; rogue qp-encoded text.
-  (decode-coding-region from to
-			(coding-system-change-eol-conversion coding 1))
+  (decode-coding-region
+   from to (coding-system-change-eol-conversion coding 1) destination)
   ;; Don't reveal the fact we used -dos decoding, as users generally
   ;; will not expect the PMAIL buffer to use DOS EOL format.
   (setq buffer-file-coding-system
@@ -2382,8 +2397,7 @@
 copy all header fields whose names do not match
 `rmail-ignored-headers' (unless they also match
 `rmail-nonignored-headers')."
-  (let ((result "")
-	(header-start-regexp "\n[^ \t]")
+  (let ((header-start-regexp "\n[^ \t]")
 	lim)
     (with-current-buffer pmail-buffer
       (when (search-forward "\n\n" nil t)
@@ -2398,7 +2412,7 @@
 	  (cond
 	   ;; Handle the case where all headers should be copied.
 	   ((eq pmail-header-style 'full)
-	    (setq result (buffer-substring beg (point-max))))
+	    (prepend-to-buffer pmail-view-buffer beg (point-max)))
 	   ;; Handle the case where the headers matching the diplayed
 	   ;; headers regexp should be copied.
 	   ((and pmail-displayed-headers (null ignored-headers))
@@ -2408,7 +2422,7 @@
 			      (1+ (match-beginning 0))
 			    (point-max))))
 	      (when (looking-at pmail-displayed-headers)
-		(setq result (concat result (buffer-substring (point) lim))))
+		(append-to-buffer pmail-view-buffer (point) lim))
 	      (goto-char lim)))
 	   ;; Handle the ignored headers.
 	   ((or ignored-headers (setq ignored-headers pmail-ignored-headers))
@@ -2420,19 +2434,9 @@
 	      (if (and (looking-at ignored-headers)
 		       (not (looking-at pmail-nonignored-headers)))
 		  (goto-char lim)
-		(setq result (concat result (buffer-substring (point) lim)))
+		(append-to-buffer pmail-view-buffer (point) lim)
 		(goto-char lim))))
-	   (t (error "No headers selected for display!"))))))
-    result))
-
-(defun pmail-copy-body (beg end)
-  "Return the message body to be displayed in the view buffer.
-BEG and END marks the start and end positions of the message in
-the mail buffer."
-  (with-current-buffer pmail-buffer
-    (if (search-forward "\n\n" nil t)
-	(buffer-substring (point) end)
-      (error "Invalid message format: no header/body separator"))))
+	   (t (error "No headers selected for display!"))))))))
 
 (defun pmail-toggle-header (&optional arg)
   "Show original message header if pruned header currently shown, or vice versa.
@@ -2444,7 +2448,7 @@
 	 ((and (numberp arg) (> arg 0)) 'normal)
 	 ((eq pmail-header-style 'full) 'normal)
 	 (t 'full)))
-  (pmail-show-message))
+  (pmail-show-message-maybe))
 
 ;; Lifted from repos-count-screen-lines.
 ;; Return number of screen lines between START and END.
@@ -2750,7 +2754,7 @@
   (let ((pmail-show-message-hook
 	 (list (function (lambda ()
 			   (goto-char (point-min)))))))
-    (pmail-show-message pmail-current-message)))
+    (pmail-show-message-maybe pmail-current-message)))
 
 (defun pmail-end-of-message ()
   "Show bottom of current message."
@@ -2759,7 +2763,7 @@
 	 (list (function (lambda ()
 			   (goto-char (point-max))
 			   (recenter (1- (window-height))))))))
-    (pmail-show-message pmail-current-message)))
+    (pmail-show-message-maybe pmail-current-message)))
 
 (defun pmail-unknown-mail-followup-to ()
   "Handle a \"Mail-Followup-To\" header field with an unknown mailing list.
@@ -2801,7 +2805,7 @@
       (buffer-swap-text pmail-view-buffer)
       (setq pmail-buffers-swapped-p nil))))
 
-(defun pmail-show-message (&optional n no-summary)
+(defun pmail-show-message-maybe (&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")
@@ -2816,39 +2820,10 @@
 	  (with-current-buffer pmail-view-buffer
 	    (erase-buffer)
 	    (setq blurb "No mail.")))
-      (if (not n)
-	  (setq n pmail-current-message)
-	(cond ((<= n 0)
-	       (setq n 1
-		     pmail-current-message 1
-		     blurb "No previous message"))
-	      ((> n pmail-total-messages)
-	       (setq n pmail-total-messages
-		     pmail-current-message pmail-total-messages
-		     blurb "No following message"))
-	      (t
-	       (setq pmail-current-message n))))
-      (let ((buf pmail-buffer)
-	    (beg (pmail-msgbeg n))
-	    (end (pmail-msgend n))
-	    headers body)
-	(goto-char beg)
-	(setq headers (pmail-copy-headers beg end)
-	      body (pmail-copy-body beg end))
-	(pmail-set-attribute pmail-unseen-attr-index nil)
-	(with-current-buffer pmail-view-buffer
-	  (erase-buffer)
-	  (insert headers "\n")
-	  (pmail-highlight-headers)
-	  (insert body)
-	  (goto-char (point-min)))))
+      (setq blurb (pmail-show-message n)))
     (when mail-mailing-lists
       (pmail-unknown-mail-followup-to))
     (if transient-mark-mode (deactivate-mark))
-    (pmail-display-labels)
-    (buffer-swap-text pmail-view-buffer)
-    (setq pmail-buffers-swapped-p t)
-    (run-hooks 'pmail-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.
@@ -2863,6 +2838,93 @@
     (if blurb
 	(message blurb))))
 
+(defun pmail-is-text-p ()
+  "Return t if the region contains a text message, nil
+otherwise."
+  (save-excursion
+    (let ((text-regexp "\\(text\\|message\\)/")
+	  (content-type-header (mail-fetch-field "content-type")))
+      ;; The message is text if either there is no content type header
+      ;; (a default of "text/plain; charset=US-ASCII" is assumed) or
+      ;; the base content type is either text or message.
+      (or (not content-type-header)
+	  (string-match text-regexp content-type-header)))))
+
+(defun pmail-show-message (&optional msg)
+  "Show message MSG using a special view buffer.
+Return text to display in the minibuffer if MSG is out of
+range (displaying a reasonable choice as well), nil otherwise.
+The current mail message becomes the message displayed."
+  (let ((mbox-buf pmail-buffer)
+	(view-buf pmail-view-buffer)
+	blurb beg end body-start coding-system character-coding is-text-message)
+    (if (not msg)
+	(setq msg pmail-current-message))
+    (cond ((<= msg 0)
+	   (setq msg 1
+		 pmail-current-message 1
+		 blurb "No previous message"))
+	  ((> msg pmail-total-messages)
+	   (setq msg pmail-total-messages
+		 pmail-current-message pmail-total-messages
+		 blurb "No following message"))
+	  (t (setq pmail-current-message msg)))
+    (with-current-buffer pmail-buffer
+      ;; Mark the message as seen, bracket the message in the mail
+      ;; buffer and determine the coding system the transfer encoding.
+      (pmail-set-attribute pmail-unseen-attr-index nil)
+      (setq beg (pmail-msgbeg msg)
+	    end (pmail-msgend msg))
+      (widen)
+      (narrow-to-region beg end)
+      (goto-char beg)
+      (setq body-start (search-forward "\n\n" nil t))
+      (narrow-to-region beg (point))
+      (goto-char beg)
+      (setq character-coding (mail-fetch-field "content-transfer-encoding")
+	    is-text-message (pmail-is-text-p)
+	    coding-system (pmail-get-coding-system))
+      (widen)
+      (narrow-to-region beg end)
+      ;; Decode the message body into an empty view buffer using a
+      ;; unibyte temporary buffer where the character decoding takes
+      ;; place.
+      (with-current-buffer pmail-view-buffer
+	(erase-buffer))
+      (with-temp-buffer
+	(set-buffer-multibyte nil)
+	(insert-buffer-substring mbox-buf body-start end)
+	(cond
+	 ((string= character-coding "quoted-printable")
+	  (mail-unquote-printable-region (point-min) (point-max)))
+	 ((and (string= character-coding "base64") is-text-message)
+	  (base64-decode-region (point-min) (point-max)))
+	 ((eq character-coding 'uuencode)
+	  (error "Not supported yet."))
+	 (t))
+	(pmail-decode-region (point-min) (point-max) coding-system view-buf))
+      ;; Copy the headers to the front of the message view buffer.
+      (with-current-buffer pmail-view-buffer
+	(goto-char (point-min)))
+      (pmail-copy-headers beg end)
+      ;; Add the separator (blank line) between headers and body;
+      ;; highlight the message, activate any URL like text and add
+      ;; special highlighting for and quoted material.
+      (with-current-buffer pmail-view-buffer
+	(insert "\n")
+	(goto-char (point-min))
+	(pmail-highlight-headers)
+	;(pmail-activate-urls)
+	;(pmail-process-quoted-material)
+	)
+      ;; Update the mode-line with message status information and swap
+      ;; the view buffer/mail buffer contents.
+      (pmail-display-labels)
+      (buffer-swap-text pmail-view-buffer)
+      (setq pmail-buffers-swapped-p t)
+      (run-hooks 'pmail-show-message-hook))
+    blurb))
+
 ;; Find all occurrences of certain fields, and highlight them.
 (defun pmail-highlight-headers ()
   ;; Do this only if the system supports faces.
@@ -2950,7 +3012,7 @@
   (interactive "p")
   (set-buffer pmail-buffer)
   (pmail-maybe-set-message-counters)
-  (pmail-show-message (+ pmail-current-message n)))
+  (pmail-show-message-maybe (+ pmail-current-message n)))
 
 (defun pmail-previous-message (n)
   "Show previous message whether deleted or not.
@@ -2978,7 +3040,7 @@
       (if (not (pmail-message-deleted-p current))
 	  (setq lastwin current n (1+ n))))
     (if (/= lastwin pmail-current-message)
- 	(progn (pmail-show-message lastwin)
+ 	(progn (pmail-show-message-maybe lastwin)
  	       t)
       (if (< n 0)
 	  (message "No previous nondeleted message"))
@@ -2997,13 +3059,13 @@
   "Show first message in file."
   (interactive)
   (pmail-maybe-set-message-counters)
-  (pmail-show-message 1))
+  (pmail-show-message-maybe (< 1 pmail-total-messages)))
 
 (defun pmail-last-message ()
   "Show last message in file."
   (interactive)
   (pmail-maybe-set-message-counters)
-  (pmail-show-message pmail-total-messages))
+  (pmail-show-message-maybe pmail-total-messages))
 
 (defun pmail-what-message ()
   (let ((where (point))
@@ -3113,7 +3175,7 @@
 	    (setq n (+ n (if reversep 1 -1)))))
       (if win
 	  (progn
-	    (pmail-show-message msg)
+	    (pmail-show-message-maybe msg)
 	    ;; Search forward (if this is a normal search) or backward
 	    ;; (if this is a reverse search) through this message to
 	    ;; position point.  This search may fail because REGEXP
@@ -3245,7 +3307,7 @@
 	    (if done (setq found i)))
 	  (setq n (if forward (1- n) (1+ n))))))
     (if found
-	(pmail-show-message found)
+	(pmail-show-message-maybe found)
       (error "No %s message with same subject"
 	     (if forward "following" "previous")))))
 
@@ -3281,7 +3343,7 @@
     (if (= msg 0)
 	(error "No previous deleted message")
       (if (/= msg pmail-current-message)
-	  (pmail-show-message msg))
+	  (pmail-show-message-maybe msg))
       (pmail-set-attribute pmail-deleted-attr-index nil)
       (if (pmail-summary-exists)
 	  (save-excursion
@@ -3416,8 +3478,7 @@
       (if (not win)
 	  (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
       (if (not dont-show)
-	  (pmail-show-message
-	   (if (zerop pmail-current-message) 1 nil)))
+	  (pmail-show-message-maybe (< pmail-current-message pmail-total-messages)))
       (pmail-swap-buffers-maybe)
       (if pmail-enable-mime
 	  (goto-char (+ (point-min) opoint))