Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mime.el @ 131:869e1851236b xemacs-20-1p4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag xemacs-20-1p4
author cvs
date Mon, 13 Aug 2007 09:29:07 +0200
parents 1370575f1259
children b980b6286996
comparison
equal deleted inserted replaced
130:4ae9a57f18b2 131:869e1851236b
35 (defun vm-mm-layout-qdisposition (e) (aref e 6)) 35 (defun vm-mm-layout-qdisposition (e) (aref e 6))
36 (defun vm-mm-layout-header-start (e) (aref e 7)) 36 (defun vm-mm-layout-header-start (e) (aref e 7))
37 (defun vm-mm-layout-body-start (e) (aref e 8)) 37 (defun vm-mm-layout-body-start (e) (aref e 8))
38 (defun vm-mm-layout-body-end (e) (aref e 9)) 38 (defun vm-mm-layout-body-end (e) (aref e 9))
39 (defun vm-mm-layout-parts (e) (aref e 10)) 39 (defun vm-mm-layout-parts (e) (aref e 10))
40 ;; if display of MIME part fails, error string will be here.
40 (defun vm-mm-layout-cache (e) (aref e 11)) 41 (defun vm-mm-layout-cache (e) (aref e 11))
41 42
42 (defun vm-set-mm-layout-type (e type) (aset e 0 type)) 43 (defun vm-set-mm-layout-type (e type) (aset e 0 type))
43 (defun vm-set-mm-layout-cache (e c) (aset e 11 c)) 44 (defun vm-set-mm-layout-cache (e c) (aset e 11 c))
44 45
1246 (vm-mime-types-match "text" type)) 1247 (vm-mime-types-match "text" type))
1247 ;; display unmatched message and text types as 1248 ;; display unmatched message and text types as
1248 ;; text/plain. 1249 ;; text/plain.
1249 (vm-mime-display-internal-text/plain layout))) 1250 (vm-mime-display-internal-text/plain layout)))
1250 (t (and extent (vm-mime-rewrite-failed-button 1251 (t (and extent (vm-mime-rewrite-failed-button
1251 extent (vm-mm-layout-cache layout))) 1252 extent
1253 (or (vm-mm-layout-cache layout)
1254 "no external viewer defined for type")))
1252 (vm-mime-display-internal-application/octet-stream 1255 (vm-mime-display-internal-application/octet-stream
1253 (or extent layout)))) 1256 (or extent layout))))
1254 (and extent (vm-mime-delete-button-maybe extent))) 1257 (and extent (vm-mime-delete-button-maybe extent)))
1255 (set-buffer-modified-p modified))) 1258 (set-buffer-modified-p modified)))
1256 t ) 1259 t )
1257 1260
1258 (defun vm-mime-display-button-text (layout) 1261 (defun vm-mime-display-button-text (layout)
1259 (vm-mime-display-button-xxxx layout t)) 1262 (vm-mime-display-button-xxxx layout t))
1260 1263
1261 (defun vm-mime-display-internal-text/html (layout) 1264 (defun vm-mime-display-internal-text/html (layout)
1262 (let ((buffer-read-only nil) 1265 (if (fboundp 'w3-region)
1263 (work-buffer nil)) 1266 (let ((buffer-read-only nil)
1264 (message "Inlining text/html, be patient...") 1267 (work-buffer nil))
1265 ;; w3-region is not as tame as we would like. 1268 (message "Inlining text/html, be patient...")
1266 ;; make sure the yoke is firmly attached. 1269 ;; w3-region is not as tame as we would like.
1267 (unwind-protect 1270 ;; make sure the yoke is firmly attached.
1268 (progn 1271 (unwind-protect
1269 (save-excursion 1272 (progn
1270 (set-buffer (setq work-buffer 1273 (save-excursion
1271 (generate-new-buffer " *workbuf*"))) 1274 (set-buffer (setq work-buffer
1272 (vm-mime-insert-mime-body layout) 1275 (generate-new-buffer " *workbuf*")))
1273 (vm-mime-transfer-decode-region layout (point-min) (point-max)) 1276 (vm-mime-insert-mime-body layout)
1274 (save-excursion 1277 (vm-mime-transfer-decode-region layout (point-min) (point-max))
1275 (save-window-excursion 1278 (save-excursion
1276 (w3-region (point-min) (point-max))))) 1279 (save-window-excursion
1277 (insert-buffer-substring work-buffer)) 1280 (w3-region (point-min) (point-max)))))
1278 (and work-buffer (kill-buffer work-buffer))) 1281 (insert-buffer-substring work-buffer))
1279 (message "Inlining text/html... done") 1282 (and work-buffer (kill-buffer work-buffer)))
1280 t )) 1283 (message "Inlining text/html... done")
1284 t )
1285 (vm-set-mm-layout-cache layout "Need W3 to inline HTML")
1286 nil ))
1281 1287
1282 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) 1288 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting)
1283 (let ((start (point)) end old-size 1289 (let ((start (point)) end old-size
1284 (buffer-read-only nil) 1290 (buffer-read-only nil)
1285 (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) 1291 (charset (or (vm-mime-get-parameter layout "charset") "us-ascii")))
1762 nil )) 1768 nil ))
1763 1769
1764 (defun vm-mime-display-button-xxxx (layout disposable) 1770 (defun vm-mime-display-button-xxxx (layout disposable)
1765 (let ((description (vm-mime-layout-description layout))) 1771 (let ((description (vm-mime-layout-description layout)))
1766 (vm-mime-insert-button 1772 (vm-mime-insert-button
1767 (format "%-35.35s [%s to display]" 1773 (format "%-35.35s [%s to attempt display]"
1768 description 1774 description
1769 (if (vm-mouse-support-possible-p) "Click mouse-2" "Press RETURN")) 1775 (if (vm-mouse-support-possible-p) "Click mouse-2" "Press RETURN"))
1770 (function 1776 (function
1771 (lambda (layout) 1777 (lambda (layout)
1772 (save-excursion 1778 (save-excursion
1873 1879
1874 (defun vm-mime-rewrite-failed-button (button error-string) 1880 (defun vm-mime-rewrite-failed-button (button error-string)
1875 (let* ((buffer-read-only nil) 1881 (let* ((buffer-read-only nil)
1876 (start (point))) 1882 (start (point)))
1877 (goto-char (vm-extent-start-position button)) 1883 (goto-char (vm-extent-start-position button))
1878 (insert (format "DISPLAY FAILED -- %s" error-string)) 1884 (insert (format "DISPLAY FAILED -- %s\n" error-string))
1879 (vm-set-extent-endpoints button start (vm-extent-end-position button)) 1885 (vm-set-extent-endpoints button start (vm-extent-end-position button))
1880 (delete-region (point) (vm-extent-end-position button)))) 1886 (delete-region (point) (vm-extent-end-position button))))
1881 1887
1882 (defun vm-mime-send-body-to-file (layout &optional default-filename) 1888 (defun vm-mime-send-body-to-file (layout &optional default-filename)
1883 (if (not (vectorp layout)) 1889 (if (not (vectorp layout))
2452 (if (null e-list) 2458 (if (null e-list)
2453 (progn 2459 (progn
2454 (narrow-to-region (point) (point-max)) 2460 (narrow-to-region (point) (point-max))
2455 (setq charset (vm-determine-proper-charset (point-min) 2461 (setq charset (vm-determine-proper-charset (point-min)
2456 (point-max))) 2462 (point-max)))
2457 (if vm-xemacs-mule-p
2458 (encode-coding-region (point-min) (point-max)
2459 buffer-file-coding-system))
2460 (setq encoding (vm-determine-proper-content-transfer-encoding 2463 (setq encoding (vm-determine-proper-content-transfer-encoding
2461 (point-min) 2464 (point-min)
2462 (point-max)) 2465 (point-max))
2463 encoding (vm-mime-transfer-encode-region encoding 2466 encoding (vm-mime-transfer-encode-region encoding
2464 (point-min) 2467 (point-min)
2496 (setq object (extent-property e 'vm-mime-object)) 2499 (setq object (extent-property e 'vm-mime-object))
2497 ;; insert the object 2500 ;; insert the object
2498 (cond ((bufferp object) 2501 (cond ((bufferp object)
2499 (insert-buffer-substring object)) 2502 (insert-buffer-substring object))
2500 ((stringp object) 2503 ((stringp object)
2501 (let ((coding-system-for-read 'no-conversion)) 2504 (let ((coding-system-for-read 'no-conversion)
2505 ;; don't let file-coding-system be changed
2506 ;; by insert-file-contents-literally. The
2507 ;; value we bind to it to here isn't important.
2508 (buffer-file-coding-system 'no-conversion))
2502 (insert-file-contents-literally object)))) 2509 (insert-file-contents-literally object))))
2503 ;; gather information about the object from the extent. 2510 ;; gather information about the object from the extent.
2504 (if (setq already-mimed (extent-property e 'vm-mime-encoded)) 2511 (if (setq already-mimed (extent-property e 'vm-mime-encoded))
2505 (setq layout (vm-mime-parse-entity 2512 (setq layout (vm-mime-parse-entity
2506 nil (list "text/plain" "charset=us-ascii") 2513 nil (list "text/plain" "charset=us-ascii")
2636 ;; extent, if any. 2643 ;; extent, if any.
2637 (if (or just-one (= (point) (point-max))) 2644 (if (or just-one (= (point) (point-max)))
2638 nil 2645 nil
2639 (setq charset (vm-determine-proper-charset (point) 2646 (setq charset (vm-determine-proper-charset (point)
2640 (point-max))) 2647 (point-max)))
2641 (if vm-xemacs-mule-p
2642 (encode-coding-region (point-min) (point-max)
2643 buffer-file-coding-system))
2644 (setq encoding (vm-determine-proper-content-transfer-encoding 2648 (setq encoding (vm-determine-proper-content-transfer-encoding
2645 (point) 2649 (point)
2646 (point-max)) 2650 (point-max))
2647 encoding (vm-mime-transfer-encode-region encoding 2651 encoding (vm-mime-transfer-encode-region encoding
2648 (point) 2652 (point)
2756 (if (null o-list) 2760 (if (null o-list)
2757 (progn 2761 (progn
2758 (narrow-to-region (point) (point-max)) 2762 (narrow-to-region (point) (point-max))
2759 (setq charset (vm-determine-proper-charset (point-min) 2763 (setq charset (vm-determine-proper-charset (point-min)
2760 (point-max))) 2764 (point-max)))
2761 (if vm-xemacs-mule-p
2762 (encode-coding-region (point-min) (point-max)
2763 file-coding-system))
2764 (setq encoding (vm-determine-proper-content-transfer-encoding 2765 (setq encoding (vm-determine-proper-content-transfer-encoding
2765 (point-min) 2766 (point-min)
2766 (point-max)) 2767 (point-max))
2767 encoding (vm-mime-transfer-encode-region encoding 2768 encoding (vm-mime-transfer-encode-region encoding
2768 (point-min) 2769 (point-min)
2953 ;; extent, if any. 2954 ;; extent, if any.
2954 (if (or just-one (= (point) (point-max))) 2955 (if (or just-one (= (point) (point-max)))
2955 nil 2956 nil
2956 (setq charset (vm-determine-proper-charset (point) 2957 (setq charset (vm-determine-proper-charset (point)
2957 (point-max))) 2958 (point-max)))
2958 (if vm-xemacs-mule-p
2959 (encode-coding-region (point-min) (point-max)
2960 file-coding-system))
2961 (setq encoding (vm-determine-proper-content-transfer-encoding 2959 (setq encoding (vm-determine-proper-content-transfer-encoding
2962 (point) 2960 (point)
2963 (point-max)) 2961 (point-max))
2964 encoding (vm-mime-transfer-encode-region encoding 2962 encoding (vm-mime-transfer-encode-region encoding
2965 (point) 2963 (point)