Mercurial > hg > xemacs-beta
diff lisp/vm/vm-mime.el @ 120:cca96a509cfe r20-1b12
Import from CVS: tag r20-1b12
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:25:29 +0200 |
parents | 7d55a9ba150c |
children | 1370575f1259 |
line wrap: on
line diff
--- a/lisp/vm/vm-mime.el Mon Aug 13 09:24:19 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:25:29 2007 +0200 @@ -104,7 +104,7 @@ (defun vm-mime-charset-decode-region (charset start end) (or (markerp end) (setq end (vm-marker end))) - (cond ((vm-xemacs-mule-p) + (cond (vm-xemacs-mule-p (if (eq (device-type) 'x) (let ((buffer-read-only nil) (cell (cdr (vm-string-assoc @@ -822,9 +822,9 @@ (defvar scroll-in-place) (make-local-variable 'scroll-in-place) (setq scroll-in-place nil) - (and (vm-xemacs-mule-p) + (and vm-xemacs-mule-p (set-buffer-file-coding-system 'no-conversion t)) - (cond ((vm-fsfemacs-19-p) + (cond (vm-fsfemacs-19-p ;; need to do this outside the let because ;; loading disp-table initializes ;; standard-display-table. @@ -896,7 +896,7 @@ (narrow-to-region beg end) (catch 'done (goto-char (point-min)) - (if (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (let ((charsets (delq 'ascii (charsets-in-region beg end)))) (cond ((null charsets) "us-ascii") @@ -960,23 +960,23 @@ (defun vm-mime-can-display-internal (layout) (let ((type (car (vm-mm-layout-type layout)))) (cond ((vm-mime-types-match "image/jpeg" type) - (and (vm-xemacs-p) + (and vm-xemacs-p (featurep 'jpeg) (eq (device-type) 'x))) ((vm-mime-types-match "image/gif" type) - (and (vm-xemacs-p) + (and vm-xemacs-p (featurep 'gif) (eq (device-type) 'x))) ((vm-mime-types-match "image/png" type) - (and (vm-xemacs-p) + (and vm-xemacs-p (featurep 'png) (eq (device-type) 'x))) ((vm-mime-types-match "image/tiff" type) - (and (vm-xemacs-p) + (and vm-xemacs-p (featurep 'tiff) (eq (device-type) 'x))) ((vm-mime-types-match "audio/basic" type) - (and (vm-xemacs-p) + (and vm-xemacs-p (or (featurep 'native-sound) (featurep 'nas-sound)) (or (device-sound-enabled-p) @@ -991,13 +991,11 @@ (let ((charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) (vm-mime-charset-internally-displayable-p charset))) -;; commented out until w3-region behavior gets worked out -;; -;; ((vm-mime-types-match "text/html" type) -;; (condition-case () -;; (progn (require 'w3) -;; (fboundp 'w3-region)) -;; (error nil))) + ((vm-mime-types-match "text/html" type) + (condition-case () + (progn (require 'w3) + (fboundp 'w3-region)) + (error nil))) (t nil)))) (defun vm-mime-can-convert (type) @@ -1260,28 +1258,26 @@ (defun vm-mime-display-button-text (layout) (vm-mime-display-button-xxxx layout t)) -;; commented out until w3-region behavior is worked out -;; -;;(defun vm-mime-display-internal-text/html (layout) -;; (let ((buffer-read-only nil) -;; (work-buffer nil)) -;; (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 -;; (progn -;; (save-excursion -;; (set-buffer (setq work-buffer -;; (generate-new-buffer " *workbuf*"))) -;; (vm-mime-insert-mime-body layout) -;; (vm-mime-transfer-decode-region layout (point-min) (point-max)) -;; (save-excursion -;; (save-window-excursion -;; (w3-region (point-min) (point-max))))) -;; (insert-buffer-substring work-buffer)) -;; (and work-buffer (kill-buffer work-buffer))) -;; (message "Inlining text/html... done") -;; t )) +(defun vm-mime-display-internal-text/html (layout) + (let ((buffer-read-only nil) + (work-buffer nil)) + (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 + (progn + (save-excursion + (set-buffer (setq work-buffer + (generate-new-buffer " *workbuf*"))) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (save-excursion + (save-window-excursion + (w3-region (point-min) (point-max))))) + (insert-buffer-substring work-buffer)) + (and work-buffer (kill-buffer work-buffer))) + (message "Inlining text/html... done") + t )) (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) (let ((start (point)) end old-size @@ -1344,7 +1340,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 (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (if (vm-mime-text-type-p layout) (set-buffer-file-coding-system 'no-conversion nil) (set-buffer-file-coding-system 'binary t))) @@ -1684,7 +1680,7 @@ 'vm-mime-display-internal-message/partial) (defun vm-mime-display-internal-image-xxxx (layout feature name) - (if (and (vm-xemacs-p) + (if (and vm-xemacs-p (featurep feature) (eq (device-type) 'x)) (let ((start (point)) end tempfile g e @@ -1732,7 +1728,7 @@ (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF")) (defun vm-mime-display-internal-audio/basic (layout) - (if (and (vm-xemacs-p) + (if (and vm-xemacs-p (or (featurep 'native-sound) (featurep 'nas-sound)) (or (device-sound-enabled-p) @@ -1782,7 +1778,7 @@ ;; drag window point along, to a place arbitrarily far from ;; where it was when the user triggered the button. (save-excursion - (cond ((vm-fsfemacs-19-p) + (cond (vm-fsfemacs-19-p (let (o-list o (found nil)) (setq o-list (overlays-at (point))) (while (and o-list (not found)) @@ -1792,7 +1788,7 @@ 'vm-mime-function)) (car o-list)))) (setq o-list (cdr o-list))))) - ((vm-xemacs-p) + (vm-xemacs-p (let ((e (extent-at (point) nil 'vm-mime-layout))) (funcall (or function (extent-property e 'vm-mime-function)) e)))))) @@ -1800,15 +1796,14 @@ ;; for the karking compiler (defvar vm-menu-mime-dispose-menu) -(defun vm-mime-set-extent-glyph-for-layout (e layout) - (if (and (vm-xemacs-p) (fboundp 'make-glyph) +(defun vm-mime-set-extent-glyph-for-type (e type) + (if (and vm-xemacs-p (fboundp 'make-glyph) (eq (device-type) 'x) (> (device-bitplanes) 7)) - (let ((type (car (vm-mm-layout-type layout))) - (dir vm-image-directory) + (let ((dir vm-image-directory) (colorful (> (device-bitplanes) 15)) (tuples '(("text" "document-simple.xpm" "document-colorful.xpm") - ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm") + ("image" "mona_stamp-simple.gif" "mona_stamp-colorful.gif") ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm") ("video" "film-simple.xpm" "film-colorful.xpm") ("message" "message-simple.xpm" "message-colorful.xpm") @@ -1822,7 +1817,7 @@ (throw 'done (car tuples)) (setq tuples (cdr tuples)))) nil) - file (and file (if colorful (nth 1 file) (nth 2 file))) + file (and file (if colorful (nth 2 file) (nth 1 file))) sym (and file (intern file vm-image-obarray)) glyph (and sym (boundp sym) (symbol-value sym)) glyph (or glyph (not file) @@ -1846,16 +1841,18 @@ (if (not (bolp)) (insert "\n")) (insert caption "\n") - ;; we MUST have the five arg make-overlay. overlays must - ;; advance when text is inserted at their start position or - ;; inline text and graphics will seep into the button - ;; overlay and then be removed when the button is removed. - (if (fboundp 'make-overlay) + ;; we must use the same interface that the vm-extent functions + ;; use. if they use overlays, then we call make-overlay. + (if (eq (symbol-function 'vm-make-extent) 'make-overlay) + ;; we MUST have the five arg make-overlay. overlays must + ;; advance when text is inserted at their start position or + ;; inline text and graphics will seep into the button + ;; overlay and then be removed when the button is removed. (setq e (make-overlay start (point) nil t nil)) (setq e (make-extent start (point))) (set-extent-property e 'start-open t) (set-extent-property e 'end-open t)) - (vm-mime-set-extent-glyph-for-layout e layout) + (vm-mime-set-extent-glyph-for-type e (car (vm-mm-layout-type layout))) ;; for emacs (vm-set-extent-property e 'mouse-face 'highlight) (vm-set-extent-property e 'local-map keymap) @@ -1920,7 +1917,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 (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (if (vm-mime-text-type-p layout) (set-buffer-file-coding-system 'no-conversion nil) (set-buffer-file-coding-system 'binary t))) @@ -2084,7 +2081,7 @@ (vm-mime-types-match "message" (car (vm-mm-layout-type layout))))) (defun vm-mime-charset-internally-displayable-p (name) - (cond ((and (vm-xemacs-mule-p) (eq (device-type) 'x)) + (cond ((and vm-xemacs-mule-p (eq (device-type) 'x)) (vm-string-assoc name vm-mime-mule-charset-to-coding-alist)) ((vm-multiple-fonts-possible-p) (or (vm-string-member name vm-mime-default-face-charsets) @@ -2119,7 +2116,7 @@ (car mp))) (defun vm-mime-make-multipart-boundary () - (let ((boundary (make-string 40 ?a)) + (let ((boundary (make-string 10 ?a)) (i 0)) (random t) (while (< i (length boundary)) @@ -2250,7 +2247,7 @@ (file-name-nondirectory object) "\""))))) (setq disposition (list "unspecified"))) - (cond ((vm-fsfemacs-19-p) + (cond (vm-fsfemacs-19-p (put-text-property start end 'front-sticky nil) (put-text-property start end 'rear-nonsticky t) ;; can't be intangible because menu clicking at a position needs @@ -2265,8 +2262,9 @@ (put-text-property start end 'vm-mime-disposition disposition) (put-text-property start end 'vm-mime-encoded mimed) (put-text-property start end 'vm-mime-object object)) - ((fboundp 'make-extent) + (vm-xemacs-p (setq e (make-extent start end)) + (vm-mime-set-extent-glyph-for-type e type) (set-extent-property e 'start-open t) (set-extent-property e 'face vm-mime-button-face) (set-extent-property e 'duplicable t) @@ -2284,19 +2282,19 @@ (set-extent-property e 'vm-mime-encoded mimed))))) (defun vm-mime-attachment-disposition-at-point () - (cond ((vm-fsfemacs-19-p) + (cond (vm-fsfemacs-19-p (let ((disp (get-text-property (point) 'vm-mime-disposition))) (intern (car disp)))) - ((vm-xemacs-p) + (vm-xemacs-p (let* ((e (extent-at (point) nil 'vm-mime-disposition)) (disp (extent-property e 'vm-mime-disposition))) (intern (car disp)))))) (defun vm-mime-set-attachment-disposition-at-point (sym) - (cond ((vm-fsfemacs-19-p) + (cond (vm-fsfemacs-19-p (let ((disp (get-text-property (point) 'vm-mime-disposition))) (setcar disp (symbol-name sym)))) - ((vm-xemacs-p) + (vm-xemacs-p (let* ((e (extent-at (point) nil 'vm-mime-disposition)) (disp (extent-property e 'vm-mime-disposition))) (setcar disp (symbol-name sym)))))) @@ -2400,11 +2398,11 @@ Attachment tags added to the buffer with vm-mime-attach-file are expanded and the approriate content-type and boundary markup information is added." (interactive) - (cond ((vm-xemacs-mule-p) + (cond (vm-xemacs-mule-p (vm-mime-xemacs-encode-composition)) - ((vm-xemacs-p) + (vm-xemacs-p (vm-mime-xemacs-encode-composition)) - ((vm-fsfemacs-19-p) + (vm-fsfemacs-19-p (vm-mime-fsfemacs-encode-composition)) (t (error "don't know how to MIME encode composition for %s" @@ -2449,7 +2447,7 @@ (narrow-to-region (point) (point-max)) (setq charset (vm-determine-proper-charset (point-min) (point-max))) - (if (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (encode-coding-region (point-min) (point-max) buffer-file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2562,7 +2560,7 @@ vm-mime-8bit-text-transfer-encoding))) (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout (vm-mm-layout-parts layout))) - ;; now figure out a proper content trasnfer + ;; now figure out a proper content transfer ;; encoding value for the enclosing entity. (re-search-forward "^\n" nil t) (save-restriction @@ -2633,7 +2631,7 @@ nil (setq charset (vm-determine-proper-charset (point) (point-max))) - (if (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (encode-coding-region (point-min) (point-max) buffer-file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2751,7 +2749,7 @@ (narrow-to-region (point) (point-max)) (setq charset (vm-determine-proper-charset (point-min) (point-max))) - (if (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (encode-coding-region (point-min) (point-max) file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2877,7 +2875,7 @@ vm-mime-8bit-text-transfer-encoding))) (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout (vm-mm-layout-parts layout))) - ;; now figure out a proper content trasnfer + ;; now figure out a proper content transfer ;; encoding value for the enclosing entity. (re-search-forward "^\n" nil t) (save-restriction @@ -2948,7 +2946,7 @@ nil (setq charset (vm-determine-proper-charset (point) (point-max))) - (if (vm-xemacs-mule-p) + (if vm-xemacs-mule-p (encode-coding-region (point-min) (point-max) file-coding-system)) (setq encoding (vm-determine-proper-content-transfer-encoding