Mercurial > hg > xemacs-beta
diff lisp/vm/vm-mime.el @ 26:441bb1e64a06 r19-15b96
Import from CVS: tag r19-15b96
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:51:32 +0200 |
parents | 4103f0995bd7 |
children | ec9a17fef872 |
line wrap: on
line diff
--- a/lisp/vm/vm-mime.el Mon Aug 13 08:51:05 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 08:51:32 2007 +0200 @@ -153,7 +153,7 @@ (vm-mime-qp-decode-region start end))))) (defun vm-mime-base64-decode-region (start end &optional crlf) - (vm-unsaved-message "Decoding base64...") + (message "Decoding base64...") (let ((work-buffer nil) (done nil) (counter 0) @@ -219,11 +219,11 @@ (insert-buffer-substring work-buffer) (delete-region (point) end)) (and work-buffer (kill-buffer work-buffer)))) - (vm-unsaved-message "Decoding base64... done")) + (message "Decoding base64... done")) (defun vm-mime-base64-encode-region (start end &optional crlf B-encoding) (and (> (- end start) 200) - (vm-unsaved-message "Encoding base64...")) + (message "Encoding base64...")) (let ((work-buffer nil) (counter 0) (cols 0) @@ -244,7 +244,13 @@ vm-mime-base64-encoder-program vm-mime-base64-encoder-switches))) (if (not (eq status t)) - (vm-mime-error "%s" (cdr status)))) + (vm-mime-error "%s" (cdr status))) + (if B-encoding + (progn + ;; if we're B encoding, strip out the line breaks + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (delete-char -1))))) (setq inputpos start) (while (< inputpos end) (setq bits (+ bits (char-after inputpos))) @@ -286,13 +292,13 @@ (insert-buffer-substring work-buffer) (delete-region (point) end) (and (> (- end start) 200) - (vm-unsaved-message "Encoding base64... done")) + (message "Encoding base64... done")) (- end start)) (and work-buffer (kill-buffer work-buffer))))) (defun vm-mime-qp-decode-region (start end) (and (> (- end start) 200) - (vm-unsaved-message "Decoding quoted-printable...")) + (message "Decoding quoted-printable...")) (let ((work-buffer nil) (buf (current-buffer)) (case-fold-search nil) @@ -354,11 +360,11 @@ (delete-region (point) end)) (and work-buffer (kill-buffer work-buffer)))) (and (> (- end start) 200) - (vm-unsaved-message "Decoding quoted-printable... done"))) + (message "Decoding quoted-printable... done"))) (defun vm-mime-qp-encode-region (start end &optional Q-encoding) (and (> (- end start) 200) - (vm-unsaved-message "Encoding quoted-printable...")) + (message "Encoding quoted-printable...")) (let ((work-buffer nil) (buf (current-buffer)) (cols 0) @@ -402,7 +408,7 @@ (insert-buffer-substring work-buffer) (delete-region (point) end) (and (> (- end start) 200) - (vm-unsaved-message "Encoding quoted-printable... done")) + (message "Encoding quoted-printable... done")) (- end start)) (and work-buffer (kill-buffer work-buffer))))) @@ -480,13 +486,11 @@ (or pos (setq pos (point-max) done t)) (if charset (progn - (message " pos = %d start = %d" pos start) (if (setq coding (get-text-property start 'vm-coding)) (progn (setq old-size (buffer-size)) (encode-coding-region start pos coding) (setq pos (+ pos (- (buffer-size) old-size))))) - (message " pos = %d start = %d" pos start) (setq pos (+ start (if (setq q-encoding @@ -494,7 +498,6 @@ charset)) (vm-mime-Q-encode-region start pos) (vm-mime-B-encode-region start pos)))) - (message " pos = %d start = %d" pos start) (goto-char pos) (insert "?=") (setq pos (point)) @@ -605,7 +608,7 @@ (let ((case-fold-search t) version type qtype encoding id description disposition qdisposition boundary boundary-regexp start multipart-list c-t c-t-e done p returnval) - (and m (vm-unsaved-message "Parsing MIME message...")) + (and m (message "Parsing MIME message...")) (prog1 (catch 'return-value (save-excursion @@ -788,7 +791,7 @@ (vm-marker (point-max)) (nreverse multipart-list) nil ))))) - (and m (vm-unsaved-message "Parsing MIME message... done")) + (and m (message "Parsing MIME message... done")) ))) (defun vm-mime-parse-entity-safe (&optional m c-t c-t-e) @@ -882,7 +885,7 @@ ;; Tell XEmacs/MULE not to mess with the text on writes. buffer-read-only t mode-line-format vm-mode-line-format) - (and (fboundp 'set-file-coding-system) + (and (vm-xemacs-mule-p) (set-file-coding-system 'binary t)) (cond ((vm-fsfemacs-19-p) ;; need to do this outside the let because @@ -1079,7 +1082,7 @@ (defun vm-mime-convert-undisplayable-layout (layout) (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout))))) - (vm-unsaved-message "Converting %s to %s..." + (message "Converting %s to %s..." (car (vm-mm-layout-type layout)) (nth 1 ooo)) (save-excursion @@ -1095,7 +1098,7 @@ (insert "Content-Type: " (nth 1 ooo) "\n") (insert "Content-Transfer-Encoding: binary\n\n") (set-buffer-modified-p nil) - (vm-unsaved-message "Converting %s to %s... done" + (message "Converting %s to %s... done" (car (vm-mm-layout-type layout)) (nth 1 ooo)) (vector (list (nth 1 ooo)) @@ -1220,7 +1223,7 @@ (vm-preview-current-message))) (let ((layout (vm-mm-layout (car vm-message-pointer))) (m (car vm-message-pointer))) - (vm-unsaved-message "Decoding MIME message...") + (message "Decoding MIME message...") (cond ((stringp layout) (error "Invalid MIME message: %s" layout))) (if (vm-mime-plain-message-p m) @@ -1251,7 +1254,7 @@ (setq vm-mime-decoded 'decoded)) (intern (buffer-name vm-mail-buffer) vm-buffers-needing-display-update) (vm-update-summary-and-mode-line) - (vm-unsaved-message "Decoding MIME message... done")))) + (message "Decoding MIME message... done")))) (vm-display nil nil '(vm-decode-mime-message) '(vm-decode-mime-message reading-message))) @@ -1322,7 +1325,7 @@ ;;(defun vm-mime-display-internal-text/html (layout) ;; (let ((buffer-read-only nil) ;; (work-buffer nil)) -;; (vm-unsaved-message "Inlining text/html, be patient...") +;; (message "Inlining text/html, be patient...") ;; ;; w3-region is not as tame as we would like. ;; ;; make sure the yoke is firmly attached. ;; (unwind-protect @@ -1337,7 +1340,7 @@ ;; (w3-region (point-min) (point-max))))) ;; (insert-buffer-substring work-buffer)) ;; (and work-buffer (kill-buffer work-buffer))) -;; (vm-unsaved-message "Inlining text/html... done") +;; (message "Inlining text/html... done") ;; t )) (defun vm-mime-display-internal-text/plain (layout &optional ignore-urls) @@ -1361,7 +1364,7 @@ (let ((start (point)) end (buffer-read-only nil) (enriched-verbose t)) - (vm-unsaved-message "Decoding text/enriched, be patient...") + (message "Decoding text/enriched, be patient...") (vm-mime-insert-mime-body layout) (setq end (point-marker)) (vm-mime-transfer-decode-region layout start end) @@ -1374,7 +1377,7 @@ (enriched-decode start end) (vm-energize-urls-in-message-region start end) (goto-char end) - (vm-unsaved-message "Decoding text/enriched... done") + (message "Decoding text/enriched... done") t )) (defun vm-mime-display-external-generic (layout) @@ -1398,7 +1401,7 @@ (setq buffer-file-type (not (vm-mime-text-type-p layout))) ;; Tell XEmacs/MULE not to mess with the bits unless ;; this is a text type. - (if (fboundp 'set-file-coding-system) + (if (vm-xemacs-mule-p) (if (vm-mime-text-type-p layout) (set-file-coding-system 'no-conversion nil) (set-file-coding-system 'binary t))) @@ -1409,7 +1412,7 @@ (setq vm-folder-garbage-alist (cons (cons tempfile 'delete-file) vm-folder-garbage-alist))))) - (vm-unsaved-message "Launching %s..." (mapconcat 'identity + (message "Launching %s..." (mapconcat 'identity program-list " ")) (setq process @@ -1417,7 +1420,7 @@ (format "view %25s" (vm-mime-layout-description layout)) nil (append program-list (list tempfile)))) (process-kill-without-query process t) - (vm-unsaved-message "Launching %s... done" (mapconcat 'identity + (message "Launching %s... done" (mapconcat 'identity program-list " ")) (save-excursion @@ -1617,7 +1620,7 @@ (save-excursion (vm-mime-display-internal-message/partial layout)))) layout nil)) - (vm-unsaved-message "Assembling message...") + (message "Assembling message...") (let ((parts nil) (missing nil) (work-buffer nil) @@ -1721,7 +1724,7 @@ (goto-char (point-max)) (insert (vm-trailing-message-separator)) (set-buffer-modified-p nil) - (vm-unsaved-message "Assembling message... done") + (message "Assembling message... done") (vm-save-buffer-excursion (vm-goto-new-folder-frame-maybe 'folder) (vm-mode)) @@ -1747,14 +1750,14 @@ (setq tempfile (vm-make-tempfile-name)) ;; coding system for presentation buffer is binary (write-region start end tempfile nil 0) - (vm-unsaved-message "Creating %s glyph..." name) + (message "Creating %s glyph..." name) (setq g (make-glyph (list (vector feature ':file tempfile) (vector 'string ':data (format "[Unknown %s image encoding]\n" name))))) - (vm-unsaved-message "") + (message "") (vm-set-mm-layout-cache layout g) (save-excursion (vm-select-folder-buffer) @@ -1967,7 +1970,7 @@ (setq buffer-file-type (not (vm-mime-text-type-p layout))) ;; Tell XEmacs/MULE not to mess with the bits unless ;; this is a text type. - (if (fboundp 'set-file-coding-system) + (if (vm-xemacs-mule-p) (if (vm-mime-text-type-p layout) (set-file-coding-system 'no-conversion nil) (set-file-coding-system 'binary t))) @@ -2036,37 +2039,41 @@ (and work-buffer (kill-buffer work-buffer)))))) (defun vm-mime-layout-description (layout) - (if (vm-mm-layout-description layout) - (vm-mime-scrub-description (vm-mm-layout-description layout)) - (let ((type (car (vm-mm-layout-type layout))) - name) - (cond ((vm-mime-types-match "multipart/digest" type) - (let ((n (length (vm-mm-layout-parts layout)))) - (format "digest (%d message%s)" n (if (= n 1) "" "s")))) - ((vm-mime-types-match "multipart/alternative" type) - "multipart alternative") - ((vm-mime-types-match "multipart" type) - (let ((n (length (vm-mm-layout-parts layout)))) - (format "multipart message (%d part%s)" n (if (= n 1) "" "s")))) - ((vm-mime-types-match "text/plain" type) - (format "plain text%s" - (let ((charset (vm-mime-get-parameter layout "charset"))) - (if charset - (concat ", " charset) - "")))) - ((vm-mime-types-match "text/enriched" type) - "enriched text") - ((vm-mime-types-match "text/html" type) - "HTML") - ((vm-mime-types-match "image/gif" type) - "GIF image") - ((vm-mime-types-match "image/jpeg" type) - "JPEG image") - ((and (vm-mime-types-match "application/octet-stream" type) - (setq name (vm-mime-get-parameter layout "name")) - (save-match-data (not (string-match "^[ \t]*$" name)))) - name) - (t type))))) + (let ((type (car (vm-mm-layout-type layout))) + description name) + (setq description + (if (vm-mm-layout-description layout) + (vm-mime-scrub-description (vm-mm-layout-description layout)))) + (concat + (if description description "") + (if description ", " "") + (cond ((vm-mime-types-match "multipart/digest" type) + (let ((n (length (vm-mm-layout-parts layout)))) + (format "digest (%d message%s)" n (if (= n 1) "" "s")))) + ((vm-mime-types-match "multipart/alternative" type) + "multipart alternative") + ((vm-mime-types-match "multipart" type) + (let ((n (length (vm-mm-layout-parts layout)))) + (format "multipart message (%d part%s)" n (if (= n 1) "" "s")))) + ((vm-mime-types-match "text/plain" type) + (format "plain text%s" + (let ((charset (vm-mime-get-parameter layout "charset"))) + (if charset + (concat ", " charset) + "")))) + ((vm-mime-types-match "text/enriched" type) + "enriched text") + ((vm-mime-types-match "text/html" type) + "HTML") + ((vm-mime-types-match "image/gif" type) + "GIF image") + ((vm-mime-types-match "image/jpeg" type) + "JPEG image") + ((and (vm-mime-types-match "application/octet-stream" type) + (setq name (vm-mime-get-parameter layout "name")) + (save-match-data (not (string-match "^[ \t]*$" name)))) + name) + (t type))))) (defun vm-mime-layout-contains-type (layout type) (if (vm-mime-types-match type (car (vm-mm-layout-type layout))) @@ -2304,7 +2311,7 @@ (let ((o-list nil) (done nil) (pos start) - object pos props o) + object props o) (save-excursion (save-restriction (narrow-to-region start end) @@ -2426,7 +2433,7 @@ (narrow-to-region (point) (point-max)) (setq charset (vm-determine-proper-charset (point-min) (point-max))) - (if (fboundp 'encode-coding-region) + (if (vm-xemacs-mule-p) (encode-coding-region (point-min) (point-max) file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2596,7 +2603,7 @@ nil (setq charset (vm-determine-proper-charset (point) (point-max))) - (if (fboundp 'encode-coding-region) + (if (vm-xemacs-mule-p) (encode-coding-region (point-min) (point-max) file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2678,7 +2685,7 @@ (defun vm-mime-fragment-composition (size) (save-restriction (widen) - (vm-unsaved-message "Fragmenting message...") + (message "Fragmenting message...") (let ((buffers nil) (id (vm-mime-make-multipart-boundary)) (n 1) @@ -2738,7 +2745,7 @@ (vm-increment n) (set-buffer master-buffer) (setq start (point))) - (vm-unsaved-message "Fragmenting message... done") + (message "Fragmenting message... done") (nreverse buffers)))) (defun vm-mime-preview-composition () @@ -2755,25 +2762,11 @@ e-list) (unwind-protect (progn - (mail-text) - (setq e-list (if (fboundp 'extent-list) - (extent-list nil (point) (point-max)) - (overlays-in (point) (point-max))) - e-list (vm-delete (function - (lambda (e) - (vm-extent-property e 'vm-mime-object))) - e-list t) - e-list (sort e-list (function - (lambda (e1 e2) - (< (vm-extent-end-position e1) - (vm-extent-end-position e2)))))) (setq temp-buffer (generate-new-buffer "composition preview")) (set-buffer temp-buffer) ;; so vm-mime-encode-composition won't complain (setq major-mode 'mail-mode) (vm-insert-region-from-buffer mail-buffer) - (if (vm-fsfemacs-19-p) - (mapcar 'vm-copy-extent e-list)) (goto-char (point-min)) (or (vm-mail-mode-get-header-contents "From") (insert "From: " (or user-mail-address (user-login-name)) "\n"))