Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mime.el @ 120:cca96a509cfe r20-1b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b12
author cvs
date Mon, 13 Aug 2007 09:25:29 +0200
parents 7d55a9ba150c
children 1370575f1259
comparison
equal deleted inserted replaced
119:d101af7320b8 120:cca96a509cfe
102 (delete-char -1) 102 (delete-char -1)
103 (insert "\r\n")))))) 103 (insert "\r\n"))))))
104 104
105 (defun vm-mime-charset-decode-region (charset start end) 105 (defun vm-mime-charset-decode-region (charset start end)
106 (or (markerp end) (setq end (vm-marker end))) 106 (or (markerp end) (setq end (vm-marker end)))
107 (cond ((vm-xemacs-mule-p) 107 (cond (vm-xemacs-mule-p
108 (if (eq (device-type) 'x) 108 (if (eq (device-type) 'x)
109 (let ((buffer-read-only nil) 109 (let ((buffer-read-only nil)
110 (cell (cdr (vm-string-assoc 110 (cell (cdr (vm-string-assoc
111 charset 111 charset
112 vm-mime-mule-charset-to-coding-alist))) 112 vm-mime-mule-charset-to-coding-alist)))
820 mode-line-format vm-mode-line-format) 820 mode-line-format vm-mode-line-format)
821 ;; scroll in place messes with scroll-up and this loses 821 ;; scroll in place messes with scroll-up and this loses
822 (defvar scroll-in-place) 822 (defvar scroll-in-place)
823 (make-local-variable 'scroll-in-place) 823 (make-local-variable 'scroll-in-place)
824 (setq scroll-in-place nil) 824 (setq scroll-in-place nil)
825 (and (vm-xemacs-mule-p) 825 (and vm-xemacs-mule-p
826 (set-buffer-file-coding-system 'no-conversion t)) 826 (set-buffer-file-coding-system 'no-conversion t))
827 (cond ((vm-fsfemacs-19-p) 827 (cond (vm-fsfemacs-19-p
828 ;; need to do this outside the let because 828 ;; need to do this outside the let because
829 ;; loading disp-table initializes 829 ;; loading disp-table initializes
830 ;; standard-display-table. 830 ;; standard-display-table.
831 (require 'disp-table) 831 (require 'disp-table)
832 (let* ((standard-display-table 832 (let* ((standard-display-table
894 (save-excursion 894 (save-excursion
895 (save-restriction 895 (save-restriction
896 (narrow-to-region beg end) 896 (narrow-to-region beg end)
897 (catch 'done 897 (catch 'done
898 (goto-char (point-min)) 898 (goto-char (point-min))
899 (if (vm-xemacs-mule-p) 899 (if vm-xemacs-mule-p
900 (let ((charsets (delq 'ascii (charsets-in-region beg end)))) 900 (let ((charsets (delq 'ascii (charsets-in-region beg end))))
901 (cond ((null charsets) 901 (cond ((null charsets)
902 "us-ascii") 902 "us-ascii")
903 ((cdr charsets) 903 ((cdr charsets)
904 (or (car (cdr 904 (or (car (cdr
958 (defvar native-sound-only-on-console) 958 (defvar native-sound-only-on-console)
959 959
960 (defun vm-mime-can-display-internal (layout) 960 (defun vm-mime-can-display-internal (layout)
961 (let ((type (car (vm-mm-layout-type layout)))) 961 (let ((type (car (vm-mm-layout-type layout))))
962 (cond ((vm-mime-types-match "image/jpeg" type) 962 (cond ((vm-mime-types-match "image/jpeg" type)
963 (and (vm-xemacs-p) 963 (and vm-xemacs-p
964 (featurep 'jpeg) 964 (featurep 'jpeg)
965 (eq (device-type) 'x))) 965 (eq (device-type) 'x)))
966 ((vm-mime-types-match "image/gif" type) 966 ((vm-mime-types-match "image/gif" type)
967 (and (vm-xemacs-p) 967 (and vm-xemacs-p
968 (featurep 'gif) 968 (featurep 'gif)
969 (eq (device-type) 'x))) 969 (eq (device-type) 'x)))
970 ((vm-mime-types-match "image/png" type) 970 ((vm-mime-types-match "image/png" type)
971 (and (vm-xemacs-p) 971 (and vm-xemacs-p
972 (featurep 'png) 972 (featurep 'png)
973 (eq (device-type) 'x))) 973 (eq (device-type) 'x)))
974 ((vm-mime-types-match "image/tiff" type) 974 ((vm-mime-types-match "image/tiff" type)
975 (and (vm-xemacs-p) 975 (and vm-xemacs-p
976 (featurep 'tiff) 976 (featurep 'tiff)
977 (eq (device-type) 'x))) 977 (eq (device-type) 'x)))
978 ((vm-mime-types-match "audio/basic" type) 978 ((vm-mime-types-match "audio/basic" type)
979 (and (vm-xemacs-p) 979 (and vm-xemacs-p
980 (or (featurep 'native-sound) 980 (or (featurep 'native-sound)
981 (featurep 'nas-sound)) 981 (featurep 'nas-sound))
982 (or (device-sound-enabled-p) 982 (or (device-sound-enabled-p)
983 (and (featurep 'native-sound) 983 (and (featurep 'native-sound)
984 (not native-sound-only-on-console) 984 (not native-sound-only-on-console)
989 ((or (vm-mime-types-match "text/plain" type) 989 ((or (vm-mime-types-match "text/plain" type)
990 (vm-mime-types-match "text/enriched" type)) 990 (vm-mime-types-match "text/enriched" type))
991 (let ((charset (or (vm-mime-get-parameter layout "charset") 991 (let ((charset (or (vm-mime-get-parameter layout "charset")
992 "us-ascii"))) 992 "us-ascii")))
993 (vm-mime-charset-internally-displayable-p charset))) 993 (vm-mime-charset-internally-displayable-p charset)))
994 ;; commented out until w3-region behavior gets worked out 994 ((vm-mime-types-match "text/html" type)
995 ;; 995 (condition-case ()
996 ;; ((vm-mime-types-match "text/html" type) 996 (progn (require 'w3)
997 ;; (condition-case () 997 (fboundp 'w3-region))
998 ;; (progn (require 'w3) 998 (error nil)))
999 ;; (fboundp 'w3-region))
1000 ;; (error nil)))
1001 (t nil)))) 999 (t nil))))
1002 1000
1003 (defun vm-mime-can-convert (type) 1001 (defun vm-mime-can-convert (type)
1004 (let ((alist vm-mime-type-converter-alist) 1002 (let ((alist vm-mime-type-converter-alist)
1005 ;; fake layout. make it the wrong length so an error will 1003 ;; fake layout. make it the wrong length so an error will
1258 t ) 1256 t )
1259 1257
1260 (defun vm-mime-display-button-text (layout) 1258 (defun vm-mime-display-button-text (layout)
1261 (vm-mime-display-button-xxxx layout t)) 1259 (vm-mime-display-button-xxxx layout t))
1262 1260
1263 ;; commented out until w3-region behavior is worked out 1261 (defun vm-mime-display-internal-text/html (layout)
1264 ;; 1262 (let ((buffer-read-only nil)
1265 ;;(defun vm-mime-display-internal-text/html (layout) 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 1281
1286 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) 1282 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting)
1287 (let ((start (point)) end old-size 1283 (let ((start (point)) end old-size
1288 (buffer-read-only nil) 1284 (buffer-read-only nil)
1289 (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) 1285 (charset (or (vm-mime-get-parameter layout "charset") "us-ascii")))
1342 buffer-file-coding-system) 1338 buffer-file-coding-system)
1343 ;; Tell DOS/Windows NT whether the file is binary 1339 ;; Tell DOS/Windows NT whether the file is binary
1344 (setq buffer-file-type (not (vm-mime-text-type-p layout))) 1340 (setq buffer-file-type (not (vm-mime-text-type-p layout)))
1345 ;; Tell XEmacs/MULE not to mess with the bits unless 1341 ;; Tell XEmacs/MULE not to mess with the bits unless
1346 ;; this is a text type. 1342 ;; this is a text type.
1347 (if (vm-xemacs-mule-p) 1343 (if vm-xemacs-mule-p
1348 (if (vm-mime-text-type-p layout) 1344 (if (vm-mime-text-type-p layout)
1349 (set-buffer-file-coding-system 'no-conversion nil) 1345 (set-buffer-file-coding-system 'no-conversion nil)
1350 (set-buffer-file-coding-system 'binary t))) 1346 (set-buffer-file-coding-system 'binary t)))
1351 (write-region start end tempfile nil 0)) 1347 (write-region start end tempfile nil 0))
1352 (delete-region start end) 1348 (delete-region start end)
1682 t )) 1678 t ))
1683 (fset 'vm-mime-display-button-message/partial 1679 (fset 'vm-mime-display-button-message/partial
1684 'vm-mime-display-internal-message/partial) 1680 'vm-mime-display-internal-message/partial)
1685 1681
1686 (defun vm-mime-display-internal-image-xxxx (layout feature name) 1682 (defun vm-mime-display-internal-image-xxxx (layout feature name)
1687 (if (and (vm-xemacs-p) 1683 (if (and vm-xemacs-p
1688 (featurep feature) 1684 (featurep feature)
1689 (eq (device-type) 'x)) 1685 (eq (device-type) 'x))
1690 (let ((start (point)) end tempfile g e 1686 (let ((start (point)) end tempfile g e
1691 (buffer-read-only nil)) 1687 (buffer-read-only nil))
1692 (if (vm-mm-layout-cache layout) 1688 (if (vm-mm-layout-cache layout)
1730 1726
1731 (defun vm-mime-display-internal-image/tiff (layout) 1727 (defun vm-mime-display-internal-image/tiff (layout)
1732 (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF")) 1728 (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF"))
1733 1729
1734 (defun vm-mime-display-internal-audio/basic (layout) 1730 (defun vm-mime-display-internal-audio/basic (layout)
1735 (if (and (vm-xemacs-p) 1731 (if (and vm-xemacs-p
1736 (or (featurep 'native-sound) 1732 (or (featurep 'native-sound)
1737 (featurep 'nas-sound)) 1733 (featurep 'nas-sound))
1738 (or (device-sound-enabled-p) 1734 (or (device-sound-enabled-p)
1739 (and (featurep 'native-sound) 1735 (and (featurep 'native-sound)
1740 (not native-sound-only-on-console) 1736 (not native-sound-only-on-console)
1780 (interactive) 1776 (interactive)
1781 ;; save excursion to keep point from moving. its motion would 1777 ;; save excursion to keep point from moving. its motion would
1782 ;; drag window point along, to a place arbitrarily far from 1778 ;; drag window point along, to a place arbitrarily far from
1783 ;; where it was when the user triggered the button. 1779 ;; where it was when the user triggered the button.
1784 (save-excursion 1780 (save-excursion
1785 (cond ((vm-fsfemacs-19-p) 1781 (cond (vm-fsfemacs-19-p
1786 (let (o-list o (found nil)) 1782 (let (o-list o (found nil))
1787 (setq o-list (overlays-at (point))) 1783 (setq o-list (overlays-at (point)))
1788 (while (and o-list (not found)) 1784 (while (and o-list (not found))
1789 (cond ((overlay-get (car o-list) 'vm-mime-layout) 1785 (cond ((overlay-get (car o-list) 'vm-mime-layout)
1790 (setq found t) 1786 (setq found t)
1791 (funcall (or function (overlay-get (car o-list) 1787 (funcall (or function (overlay-get (car o-list)
1792 'vm-mime-function)) 1788 'vm-mime-function))
1793 (car o-list)))) 1789 (car o-list))))
1794 (setq o-list (cdr o-list))))) 1790 (setq o-list (cdr o-list)))))
1795 ((vm-xemacs-p) 1791 (vm-xemacs-p
1796 (let ((e (extent-at (point) nil 'vm-mime-layout))) 1792 (let ((e (extent-at (point) nil 'vm-mime-layout)))
1797 (funcall (or function (extent-property e 'vm-mime-function)) 1793 (funcall (or function (extent-property e 'vm-mime-function))
1798 e)))))) 1794 e))))))
1799 1795
1800 ;; for the karking compiler 1796 ;; for the karking compiler
1801 (defvar vm-menu-mime-dispose-menu) 1797 (defvar vm-menu-mime-dispose-menu)
1802 1798
1803 (defun vm-mime-set-extent-glyph-for-layout (e layout) 1799 (defun vm-mime-set-extent-glyph-for-type (e type)
1804 (if (and (vm-xemacs-p) (fboundp 'make-glyph) 1800 (if (and vm-xemacs-p (fboundp 'make-glyph)
1805 (eq (device-type) 'x) (> (device-bitplanes) 7)) 1801 (eq (device-type) 'x) (> (device-bitplanes) 7))
1806 (let ((type (car (vm-mm-layout-type layout))) 1802 (let ((dir vm-image-directory)
1807 (dir vm-image-directory)
1808 (colorful (> (device-bitplanes) 15)) 1803 (colorful (> (device-bitplanes) 15))
1809 (tuples 1804 (tuples
1810 '(("text" "document-simple.xpm" "document-colorful.xpm") 1805 '(("text" "document-simple.xpm" "document-colorful.xpm")
1811 ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm") 1806 ("image" "mona_stamp-simple.gif" "mona_stamp-colorful.gif")
1812 ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm") 1807 ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm")
1813 ("video" "film-simple.xpm" "film-colorful.xpm") 1808 ("video" "film-simple.xpm" "film-colorful.xpm")
1814 ("message" "message-simple.xpm" "message-colorful.xpm") 1809 ("message" "message-simple.xpm" "message-colorful.xpm")
1815 ("application" "gear-simple.xpm" "gear-colorful.xpm") 1810 ("application" "gear-simple.xpm" "gear-colorful.xpm")
1816 ("multipart" "stuffed_box-simple.xpm" 1811 ("multipart" "stuffed_box-simple.xpm"
1820 (while tuples 1815 (while tuples
1821 (if (vm-mime-types-match (car (car tuples)) type) 1816 (if (vm-mime-types-match (car (car tuples)) type)
1822 (throw 'done (car tuples)) 1817 (throw 'done (car tuples))
1823 (setq tuples (cdr tuples)))) 1818 (setq tuples (cdr tuples))))
1824 nil) 1819 nil)
1825 file (and file (if colorful (nth 1 file) (nth 2 file))) 1820 file (and file (if colorful (nth 2 file) (nth 1 file)))
1826 sym (and file (intern file vm-image-obarray)) 1821 sym (and file (intern file vm-image-obarray))
1827 glyph (and sym (boundp sym) (symbol-value sym)) 1822 glyph (and sym (boundp sym) (symbol-value sym))
1828 glyph (or glyph (not file) 1823 glyph (or glyph (not file)
1829 (make-glyph 1824 (make-glyph
1830 (vector 'autodetect 1825 (vector 'autodetect
1844 (if (and (vm-mouse-xemacs-mouse-p) vm-popup-menu-on-mouse-3) 1839 (if (and (vm-mouse-xemacs-mouse-p) vm-popup-menu-on-mouse-3)
1845 (define-key keymap 'button3 'vm-menu-popup-mime-dispose-menu)) 1840 (define-key keymap 'button3 'vm-menu-popup-mime-dispose-menu))
1846 (if (not (bolp)) 1841 (if (not (bolp))
1847 (insert "\n")) 1842 (insert "\n"))
1848 (insert caption "\n") 1843 (insert caption "\n")
1849 ;; we MUST have the five arg make-overlay. overlays must 1844 ;; we must use the same interface that the vm-extent functions
1850 ;; advance when text is inserted at their start position or 1845 ;; use. if they use overlays, then we call make-overlay.
1851 ;; inline text and graphics will seep into the button 1846 (if (eq (symbol-function 'vm-make-extent) 'make-overlay)
1852 ;; overlay and then be removed when the button is removed. 1847 ;; we MUST have the five arg make-overlay. overlays must
1853 (if (fboundp 'make-overlay) 1848 ;; advance when text is inserted at their start position or
1849 ;; inline text and graphics will seep into the button
1850 ;; overlay and then be removed when the button is removed.
1854 (setq e (make-overlay start (point) nil t nil)) 1851 (setq e (make-overlay start (point) nil t nil))
1855 (setq e (make-extent start (point))) 1852 (setq e (make-extent start (point)))
1856 (set-extent-property e 'start-open t) 1853 (set-extent-property e 'start-open t)
1857 (set-extent-property e 'end-open t)) 1854 (set-extent-property e 'end-open t))
1858 (vm-mime-set-extent-glyph-for-layout e layout) 1855 (vm-mime-set-extent-glyph-for-type e (car (vm-mm-layout-type layout)))
1859 ;; for emacs 1856 ;; for emacs
1860 (vm-set-extent-property e 'mouse-face 'highlight) 1857 (vm-set-extent-property e 'mouse-face 'highlight)
1861 (vm-set-extent-property e 'local-map keymap) 1858 (vm-set-extent-property e 'local-map keymap)
1862 ;; for xemacs 1859 ;; for xemacs
1863 (vm-set-extent-property e 'highlight t) 1860 (vm-set-extent-property e 'highlight t)
1918 (set-buffer work-buffer) 1915 (set-buffer work-buffer)
1919 ;; Tell DOS/Windows NT whether the file is binary 1916 ;; Tell DOS/Windows NT whether the file is binary
1920 (setq buffer-file-type (not (vm-mime-text-type-p layout))) 1917 (setq buffer-file-type (not (vm-mime-text-type-p layout)))
1921 ;; Tell XEmacs/MULE not to mess with the bits unless 1918 ;; Tell XEmacs/MULE not to mess with the bits unless
1922 ;; this is a text type. 1919 ;; this is a text type.
1923 (if (vm-xemacs-mule-p) 1920 (if vm-xemacs-mule-p
1924 (if (vm-mime-text-type-p layout) 1921 (if (vm-mime-text-type-p layout)
1925 (set-buffer-file-coding-system 'no-conversion nil) 1922 (set-buffer-file-coding-system 'no-conversion nil)
1926 (set-buffer-file-coding-system 'binary t))) 1923 (set-buffer-file-coding-system 'binary t)))
1927 (vm-mime-insert-mime-body layout) 1924 (vm-mime-insert-mime-body layout)
1928 (vm-mime-transfer-decode-region layout (point-min) (point-max)) 1925 (vm-mime-transfer-decode-region layout (point-min) (point-max))
2082 (defun vm-mime-text-type-p (layout) 2079 (defun vm-mime-text-type-p (layout)
2083 (or (vm-mime-types-match "text" (car (vm-mm-layout-type layout))) 2080 (or (vm-mime-types-match "text" (car (vm-mm-layout-type layout)))
2084 (vm-mime-types-match "message" (car (vm-mm-layout-type layout))))) 2081 (vm-mime-types-match "message" (car (vm-mm-layout-type layout)))))
2085 2082
2086 (defun vm-mime-charset-internally-displayable-p (name) 2083 (defun vm-mime-charset-internally-displayable-p (name)
2087 (cond ((and (vm-xemacs-mule-p) (eq (device-type) 'x)) 2084 (cond ((and vm-xemacs-mule-p (eq (device-type) 'x))
2088 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist)) 2085 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist))
2089 ((vm-multiple-fonts-possible-p) 2086 ((vm-multiple-fonts-possible-p)
2090 (or (vm-string-member name vm-mime-default-face-charsets) 2087 (or (vm-string-member name vm-mime-default-face-charsets)
2091 (vm-string-assoc name vm-mime-charset-font-alist))) 2088 (vm-string-assoc name vm-mime-charset-font-alist)))
2092 (t 2089 (t
2117 (setq done t) 2114 (setq done t)
2118 (setq mp (cdr mp)))) 2115 (setq mp (cdr mp))))
2119 (car mp))) 2116 (car mp)))
2120 2117
2121 (defun vm-mime-make-multipart-boundary () 2118 (defun vm-mime-make-multipart-boundary ()
2122 (let ((boundary (make-string 40 ?a)) 2119 (let ((boundary (make-string 10 ?a))
2123 (i 0)) 2120 (i 0))
2124 (random t) 2121 (random t)
2125 (while (< i (length boundary)) 2122 (while (< i (length boundary))
2126 (aset boundary i (aref vm-mime-base64-alphabet 2123 (aset boundary i (aref vm-mime-base64-alphabet
2127 (% (vm-abs (lsh (random) -8)) 2124 (% (vm-abs (lsh (random) -8))
2248 (list 2245 (list
2249 (concat "filename=\"" 2246 (concat "filename=\""
2250 (file-name-nondirectory object) 2247 (file-name-nondirectory object)
2251 "\""))))) 2248 "\"")))))
2252 (setq disposition (list "unspecified"))) 2249 (setq disposition (list "unspecified")))
2253 (cond ((vm-fsfemacs-19-p) 2250 (cond (vm-fsfemacs-19-p
2254 (put-text-property start end 'front-sticky nil) 2251 (put-text-property start end 'front-sticky nil)
2255 (put-text-property start end 'rear-nonsticky t) 2252 (put-text-property start end 'rear-nonsticky t)
2256 ;; can't be intangible because menu clicking at a position needs 2253 ;; can't be intangible because menu clicking at a position needs
2257 ;; to set point inside the tag so that a command can access the 2254 ;; to set point inside the tag so that a command can access the
2258 ;; text properties there. 2255 ;; text properties there.
2263 (put-text-property start end 'vm-mime-parameters params) 2260 (put-text-property start end 'vm-mime-parameters params)
2264 (put-text-property start end 'vm-mime-description description) 2261 (put-text-property start end 'vm-mime-description description)
2265 (put-text-property start end 'vm-mime-disposition disposition) 2262 (put-text-property start end 'vm-mime-disposition disposition)
2266 (put-text-property start end 'vm-mime-encoded mimed) 2263 (put-text-property start end 'vm-mime-encoded mimed)
2267 (put-text-property start end 'vm-mime-object object)) 2264 (put-text-property start end 'vm-mime-object object))
2268 ((fboundp 'make-extent) 2265 (vm-xemacs-p
2269 (setq e (make-extent start end)) 2266 (setq e (make-extent start end))
2267 (vm-mime-set-extent-glyph-for-type e type)
2270 (set-extent-property e 'start-open t) 2268 (set-extent-property e 'start-open t)
2271 (set-extent-property e 'face vm-mime-button-face) 2269 (set-extent-property e 'face vm-mime-button-face)
2272 (set-extent-property e 'duplicable t) 2270 (set-extent-property e 'duplicable t)
2273 (let ((keymap (make-sparse-keymap))) 2271 (let ((keymap (make-sparse-keymap)))
2274 (if vm-popup-menu-on-mouse-3 2272 (if vm-popup-menu-on-mouse-3
2282 (set-extent-property e 'vm-mime-description description) 2280 (set-extent-property e 'vm-mime-description description)
2283 (set-extent-property e 'vm-mime-disposition disposition) 2281 (set-extent-property e 'vm-mime-disposition disposition)
2284 (set-extent-property e 'vm-mime-encoded mimed))))) 2282 (set-extent-property e 'vm-mime-encoded mimed)))))
2285 2283
2286 (defun vm-mime-attachment-disposition-at-point () 2284 (defun vm-mime-attachment-disposition-at-point ()
2287 (cond ((vm-fsfemacs-19-p) 2285 (cond (vm-fsfemacs-19-p
2288 (let ((disp (get-text-property (point) 'vm-mime-disposition))) 2286 (let ((disp (get-text-property (point) 'vm-mime-disposition)))
2289 (intern (car disp)))) 2287 (intern (car disp))))
2290 ((vm-xemacs-p) 2288 (vm-xemacs-p
2291 (let* ((e (extent-at (point) nil 'vm-mime-disposition)) 2289 (let* ((e (extent-at (point) nil 'vm-mime-disposition))
2292 (disp (extent-property e 'vm-mime-disposition))) 2290 (disp (extent-property e 'vm-mime-disposition)))
2293 (intern (car disp)))))) 2291 (intern (car disp))))))
2294 2292
2295 (defun vm-mime-set-attachment-disposition-at-point (sym) 2293 (defun vm-mime-set-attachment-disposition-at-point (sym)
2296 (cond ((vm-fsfemacs-19-p) 2294 (cond (vm-fsfemacs-19-p
2297 (let ((disp (get-text-property (point) 'vm-mime-disposition))) 2295 (let ((disp (get-text-property (point) 'vm-mime-disposition)))
2298 (setcar disp (symbol-name sym)))) 2296 (setcar disp (symbol-name sym))))
2299 ((vm-xemacs-p) 2297 (vm-xemacs-p
2300 (let* ((e (extent-at (point) nil 'vm-mime-disposition)) 2298 (let* ((e (extent-at (point) nil 'vm-mime-disposition))
2301 (disp (extent-property e 'vm-mime-disposition))) 2299 (disp (extent-property e 'vm-mime-disposition)))
2302 (setcar disp (symbol-name sym)))))) 2300 (setcar disp (symbol-name sym))))))
2303 2301
2304 (defun vm-disallow-overlay-endpoint-insertion (overlay after start end 2302 (defun vm-disallow-overlay-endpoint-insertion (overlay after start end
2398 (defun vm-mime-encode-composition () 2396 (defun vm-mime-encode-composition ()
2399 "MIME encode the current mail composition buffer. 2397 "MIME encode the current mail composition buffer.
2400 Attachment tags added to the buffer with vm-mime-attach-file are expanded 2398 Attachment tags added to the buffer with vm-mime-attach-file are expanded
2401 and the approriate content-type and boundary markup information is added." 2399 and the approriate content-type and boundary markup information is added."
2402 (interactive) 2400 (interactive)
2403 (cond ((vm-xemacs-mule-p) 2401 (cond (vm-xemacs-mule-p
2404 (vm-mime-xemacs-encode-composition)) 2402 (vm-mime-xemacs-encode-composition))
2405 ((vm-xemacs-p) 2403 (vm-xemacs-p
2406 (vm-mime-xemacs-encode-composition)) 2404 (vm-mime-xemacs-encode-composition))
2407 ((vm-fsfemacs-19-p) 2405 (vm-fsfemacs-19-p
2408 (vm-mime-fsfemacs-encode-composition)) 2406 (vm-mime-fsfemacs-encode-composition))
2409 (t 2407 (t
2410 (error "don't know how to MIME encode composition for %s" 2408 (error "don't know how to MIME encode composition for %s"
2411 (emacs-version))))) 2409 (emacs-version)))))
2412 2410
2447 (if (null e-list) 2445 (if (null e-list)
2448 (progn 2446 (progn
2449 (narrow-to-region (point) (point-max)) 2447 (narrow-to-region (point) (point-max))
2450 (setq charset (vm-determine-proper-charset (point-min) 2448 (setq charset (vm-determine-proper-charset (point-min)
2451 (point-max))) 2449 (point-max)))
2452 (if (vm-xemacs-mule-p) 2450 (if vm-xemacs-mule-p
2453 (encode-coding-region (point-min) (point-max) 2451 (encode-coding-region (point-min) (point-max)
2454 buffer-file-coding-system)) 2452 buffer-file-coding-system))
2455 (setq encoding (vm-determine-proper-content-transfer-encoding 2453 (setq encoding (vm-determine-proper-content-transfer-encoding
2456 (point-min) 2454 (point-min)
2457 (point-max)) 2455 (point-max))
2560 (if (vm-mime-types-match "message/partial" type) 2558 (if (vm-mime-types-match "message/partial" type)
2561 'quoted-printable 2559 'quoted-printable
2562 vm-mime-8bit-text-transfer-encoding))) 2560 vm-mime-8bit-text-transfer-encoding)))
2563 (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout 2561 (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout
2564 (vm-mm-layout-parts layout))) 2562 (vm-mm-layout-parts layout)))
2565 ;; now figure out a proper content trasnfer 2563 ;; now figure out a proper content transfer
2566 ;; encoding value for the enclosing entity. 2564 ;; encoding value for the enclosing entity.
2567 (re-search-forward "^\n" nil t) 2565 (re-search-forward "^\n" nil t)
2568 (save-restriction 2566 (save-restriction
2569 (narrow-to-region (point) (point-max)) 2567 (narrow-to-region (point) (point-max))
2570 (setq encoding 2568 (setq encoding
2631 ;; extent, if any. 2629 ;; extent, if any.
2632 (if (or just-one (= (point) (point-max))) 2630 (if (or just-one (= (point) (point-max)))
2633 nil 2631 nil
2634 (setq charset (vm-determine-proper-charset (point) 2632 (setq charset (vm-determine-proper-charset (point)
2635 (point-max))) 2633 (point-max)))
2636 (if (vm-xemacs-mule-p) 2634 (if vm-xemacs-mule-p
2637 (encode-coding-region (point-min) (point-max) 2635 (encode-coding-region (point-min) (point-max)
2638 buffer-file-coding-system)) 2636 buffer-file-coding-system))
2639 (setq encoding (vm-determine-proper-content-transfer-encoding 2637 (setq encoding (vm-determine-proper-content-transfer-encoding
2640 (point) 2638 (point)
2641 (point-max)) 2639 (point-max))
2749 (if (null o-list) 2747 (if (null o-list)
2750 (progn 2748 (progn
2751 (narrow-to-region (point) (point-max)) 2749 (narrow-to-region (point) (point-max))
2752 (setq charset (vm-determine-proper-charset (point-min) 2750 (setq charset (vm-determine-proper-charset (point-min)
2753 (point-max))) 2751 (point-max)))
2754 (if (vm-xemacs-mule-p) 2752 (if vm-xemacs-mule-p
2755 (encode-coding-region (point-min) (point-max) 2753 (encode-coding-region (point-min) (point-max)
2756 file-coding-system)) 2754 file-coding-system))
2757 (setq encoding (vm-determine-proper-content-transfer-encoding 2755 (setq encoding (vm-determine-proper-content-transfer-encoding
2758 (point-min) 2756 (point-min)
2759 (point-max)) 2757 (point-max))
2875 (if (vm-mime-types-match "message/partial" type) 2873 (if (vm-mime-types-match "message/partial" type)
2876 'quoted-printable 2874 'quoted-printable
2877 vm-mime-8bit-text-transfer-encoding))) 2875 vm-mime-8bit-text-transfer-encoding)))
2878 (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout 2876 (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout
2879 (vm-mm-layout-parts layout))) 2877 (vm-mm-layout-parts layout)))
2880 ;; now figure out a proper content trasnfer 2878 ;; now figure out a proper content transfer
2881 ;; encoding value for the enclosing entity. 2879 ;; encoding value for the enclosing entity.
2882 (re-search-forward "^\n" nil t) 2880 (re-search-forward "^\n" nil t)
2883 (save-restriction 2881 (save-restriction
2884 (narrow-to-region (point) (point-max)) 2882 (narrow-to-region (point) (point-max))
2885 (setq encoding 2883 (setq encoding
2946 ;; extent, if any. 2944 ;; extent, if any.
2947 (if (or just-one (= (point) (point-max))) 2945 (if (or just-one (= (point) (point-max)))
2948 nil 2946 nil
2949 (setq charset (vm-determine-proper-charset (point) 2947 (setq charset (vm-determine-proper-charset (point)
2950 (point-max))) 2948 (point-max)))
2951 (if (vm-xemacs-mule-p) 2949 (if vm-xemacs-mule-p
2952 (encode-coding-region (point-min) (point-max) 2950 (encode-coding-region (point-min) (point-max)
2953 file-coding-system)) 2951 file-coding-system))
2954 (setq encoding (vm-determine-proper-content-transfer-encoding 2952 (setq encoding (vm-determine-proper-content-transfer-encoding
2955 (point) 2953 (point)
2956 (point-max)) 2954 (point-max))