*** dist/vm-mime.el.dist Thu Nov 2 09:27:07 2000 --- vm-mime.el Sun Nov 5 02:04:39 2000 *************** *** 132,133 **** --- 132,134 ---- start end + oldsize retval *************** *** 137,139 **** (insert-buffer-substring b b-start b-end) ! (display-buffer work-buffer) (setq retval (apply 'encode-coding-region (point-min) (point-max) --- 138,140 ---- (insert-buffer-substring b b-start b-end) ! (setq oldsize (buffer-size)) (setq retval (apply 'encode-coding-region (point-min) (point-max) *************** *** 144,148 **** (set-buffer b) ! (goto-char b-end) (insert-buffer-substring work-buffer start end) ! (delete-region b-start b-end) (kill-buffer work-buffer) --- 145,154 ---- (set-buffer b) ! (goto-char b-start) (insert-buffer-substring work-buffer start end) ! (delete-region (point) (+ (point) oldsize)) ! ;; Fixup the end point. I have found no other way to ! ;; let the calling function know where the region ends ! ;; after encode-coding-region has the scrambled markers. ! (and (markerp b-end) ! (set-marker b-end (point))) (kill-buffer work-buffer) *************** *** 150,154 **** ! (defun vm-encode-coding-region (b-start b-end coding-system &rest foo) (let ((work-buffer (vm-make-work-buffer)) start end retval --- 156,161 ---- ! (defun vm-decode-coding-region (b-start b-end coding-system &rest foo) (let ((work-buffer (vm-make-work-buffer)) start end + oldsize retval *************** *** 158,163 **** (insert-buffer-substring b b-start b-end) ! (setq retval (apply 'encode-coding-region (point-min) (point-max) coding-system foo)) (setq start (point-min) end (point-max)) - (setq retval (buffer-size)) (save-excursion --- 165,171 ---- (insert-buffer-substring b b-start b-end) ! (setq oldsize (buffer-size)) ! (setq retval (apply 'decode-coding-region (point-min) (point-max) coding-system foo)) + (and vm-fsfemacs-p (set-buffer-multibyte t)) (setq start (point-min) end (point-max)) (save-excursion *************** *** 166,168 **** (insert-buffer-substring work-buffer start end) ! (delete-region (point) b-end) (kill-buffer work-buffer) --- 174,181 ---- (insert-buffer-substring work-buffer start end) ! (delete-region (point) (+ (point) oldsize)) ! ;; Fixup the end point. I have found no other way to ! ;; let the calling function know where the region ends ! ;; after decode-coding-region has the scrambled markers. ! (and (markerp b-end) ! (set-marker b-end (point))) (kill-buffer work-buffer) *************** *** 170,193 **** - (defun vm-decode-coding-region (b-start b-end coding-system &rest foo) - (if vm-xemacs-p - (apply 'decode-coding-region b-start b-end coding-system foo) - (let ((work-buffer (vm-make-work-buffer)) - start end - retval - (b (current-buffer))) - (save-excursion - (set-buffer work-buffer) - (insert-buffer-substring b b-start b-end) - (setq retval (apply 'decode-coding-region (point-min) (point-max) - coding-system foo)) - (set-buffer-multibyte t) - (setq start (point-min) end (point-max)) - (save-excursion - (set-buffer b) - (goto-char b-end) - (insert-buffer-substring work-buffer start end) - (delete-region b-start b-end) - (kill-buffer work-buffer) - retval ))))) - (defun vm-mime-charset-decode-region (charset start end) --- 183,184 ---- *************** *** 197,199 **** vm-fsfemacs-p - ;; (and vm-fsfemacs-p (memq window-system '(x w32))) nil) --- 188,189 ---- *************** *** 203,205 **** vm-mime-mule-charset-to-coding-alist))) - (oend (marker-position end)) (opoint (point))) --- 193,194 ---- *************** *** 207,219 **** (progn - '(if vm-fsfemacs-p - (set-marker end (+ start - (or (vm-encode-coding-region - start end 'iso-8859-1) - (- oend start))))) ;; decode 8-bit indeterminate char to correct ;; char in correct charset. ! (set-marker end (+ start ! (or (vm-decode-coding-region ! start end (car cell)) ! (- oend start)))) (put-text-property start end 'vm-string t) --- 196,200 ---- (progn ;; decode 8-bit indeterminate char to correct ;; char in correct charset. ! (vm-decode-coding-region start end (car cell)) (put-text-property start end 'vm-string t) *************** *** 348,350 **** (fboundp 'base64-encode-region)) ! (base64-encode-region start end t)) (t --- 329,331 ---- (fboundp 'base64-encode-region)) ! (base64-encode-region start end B-encoding)) (t *************** *** 407,410 **** (message "Encoding base64... done")) ! (- end start))) ! (and work-buffer (kill-buffer work-buffer)))) --- 388,391 ---- (message "Encoding base64... done")) ! (- end start)) ! (and work-buffer (kill-buffer work-buffer))))) *************** *** 669,670 **** --- 650,652 ---- (vm-mime-charset-decode-region charset start end) + (goto-char end) (delete-region match-start start)))))) *************** *** 701,702 **** --- 683,685 ---- (vm-mime-charset-decode-region charset start end) + (goto-char end) (delete-region match-start start)))))) *************** *** 1248,1250 **** ((vm-mime-types-match "multipart" type) t) ! ((vm-mime-types-match "message/external-body" type) nil) ((vm-mime-types-match "message" type) t) --- 1231,1233 ---- ((vm-mime-types-match "multipart" type) t) ! ((vm-mime-types-match "message/external-body" type) t) ((vm-mime-types-match "message" type) t) *************** *** 1562,1565 **** "no external viewer defined for type"))) ! (vm-mime-display-internal-application/octet-stream ! (or extent layout)))) (and extent (vm-mime-delete-button-maybe extent))) --- 1545,1552 ---- "no external viewer defined for type"))) ! (if (vm-mime-types-match type "message/external-body") ! (if (null extent) ! (vm-mime-display-button-xxxx layout t) ! (setq extent nil)) ! (vm-mime-display-internal-application/octet-stream ! (or extent layout))))) (and extent (vm-mime-delete-button-maybe extent))) *************** *** 1581,1599 **** (message "Inlining text/html, be patient...") ! (vm-with-unibyte-buffer ! ;; We need to keep track of where the end of the ! ;; processed text is. Best way to do this is to ! ;; avoid markers and save-excursion, and just use ! ;; buffer size changes as an indicator. ! (vm-mime-insert-mime-body layout) ! (setq end (point)) ! (setq buffer-size (buffer-size)) ! (vm-mime-transfer-decode-region layout start end) ! (setq end (+ end (- (buffer-size) buffer-size))) ! (setq buffer-size (buffer-size)) ! (w3-region start end) ! (setq end (+ end (- (buffer-size) buffer-size))) ! ;; remove read-only text properties ! (let ((inhibit-read-only t)) ! (remove-text-properties start end '(read-only nil))) ! (goto-char end)) (message "Inlining text/html... done") --- 1568,1577 ---- (message "Inlining text/html, be patient...") ! (setq end (point-marker)) ! (vm-mime-insert-mime-body layout) ! (vm-mime-transfer-decode-region layout start end) ! (w3-region start end) ! ;; remove read-only text properties ! (let ((inhibit-read-only t)) ! (remove-text-properties start end '(read-only nil))) ! (goto-char end) (message "Inlining text/html... done") *************** *** 1609,1611 **** (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) ! (let ((start (point)) end old-size (buffer-read-only nil) --- 1587,1589 ---- (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) ! (let ((start (point)) end (buffer-read-only nil) *************** *** 1618,1626 **** nil) ! ;; (vm-with-unibyte-buffer ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq old-size (buffer-size)) ! (vm-mime-charset-decode-region charset start end) ! (set-marker end (+ end (- (buffer-size) old-size)));) (or no-highlighting (vm-energize-urls-in-message-region start end)) --- 1596,1601 ---- nil) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (vm-mime-charset-decode-region charset start end) (or no-highlighting (vm-energize-urls-in-message-region start end)) *************** *** 1647,1652 **** (message "Decoding text/enriched, be patient...") ! (vm-with-unibyte-buffer ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end)) ;; enriched-decode expects a couple of headers at the top of --- 1622,1626 ---- (message "Decoding text/enriched, be patient...") ! (setq end (point-marker)) ! (vm-mime-insert-mime-body layout) ! (vm-mime-transfer-decode-region layout start end) ;; enriched-decode expects a couple of headers at the top of *************** *** 1973,2056 **** (unwind-protect ! (cond ((and (eq access-method "mail-server") ! (vm-mm-layout-id child-layout) ! (setq ob (vm-mime-find-leaf-content-id-in-layout-folder ! layout (vm-mm-layout-id child-layout)))) ! (setq child-layout ob)) ! ((eq (marker-buffer (vm-mm-layout-header-start child-layout)) ! (marker-buffer (vm-mm-layout-body-start child-layout))) ! (save-excursion ! (setq work-buffer ! (vm-make-work-buffer ! (format "*%s mime object*" ! (car (vm-mm-layout-type child-layout))))) ! (set-buffer work-buffer) ! (cond ((string= access-method "local-file") ! (let ((name (vm-mime-get-parameter layout "name"))) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (not (file-exists-p name)) ! (vm-mime-error "file %s does not exist" name)) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error (cdr data)))))) ! ((and (or (string= access-method "ftp") ! (string= access-method "anon-ftp")) ! (featurep 'efs)) ! (let ((name (vm-mime-get-parameter layout "name")) ! (directory (vm-mime-get-parameter layout ! "directory")) ! (site (vm-mime-get-parameter layout "site")) ! user) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (null site) ! (vm-mime-error ! "%s access type missing `site' parameter" ! access-method)) ! (cond ((string= access-method "anon-ftp") ! (setq user (read-string ! (format "User name to access %s: " ! site) ! (user-login-name)))) ! (t (setq user "anonymous"))) ! (cond (directory ! (setq directory ! (concat "/" user "@" site ":" directory)) ! (setq name (expand-file-name name directory))) ! (t ! (setq name (concat "/" user "@" site ":" ! name)))) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error (cdr data)))))) ! ((string= access-method "mail-server") ! (let ((server (vm-mime-get-parameter layout "server")) ! (subject (vm-mime-get-parameter layout "subject"))) ! (if (null server) ! (vm-mime-error ! "%s access type missing `server' parameter" ! access-method)) ! (if (not ! (y-or-n-p ! (format ! "Send message to %s to retrieve external body? " ! server))) ! (error "Aborted")) ! (vm-mail-internal ! (format "mail to MIME mail server %s" server) ! server subject) ! (mail-text) ! (vm-mime-insert-mime-body child-layout) ! (let ((vm-confirm-mail-send nil)) ! (vm-mail-send))))) ! (setq work-buffer nil) ! (vm-set-mm-layout-body-end child-layout (vm-marker (point-max))) ! (vm-set-mm-layout-body-start child-layout ! (vm-marker (point-min)))))) (and work-buffer (kill-buffer work-buffer))) ! (vm-decode-mime-layout child-layout))) --- 1947,2044 ---- (unwind-protect ! (cond ! ((and (eq access-method "mail-server") ! (vm-mm-layout-id child-layout) ! (setq ob (vm-mime-find-leaf-content-id-in-layout-folder ! layout (vm-mm-layout-id child-layout)))) ! (setq child-layout ob)) ! ((eq (marker-buffer (vm-mm-layout-header-start child-layout)) ! (marker-buffer (vm-mm-layout-body-start child-layout))) ! (condition-case data ! (save-excursion ! (setq work-buffer ! (vm-make-work-buffer ! (format "*%s mime object*" ! (car (vm-mm-layout-type child-layout))))) ! (set-buffer work-buffer) ! (cond ! ((string= access-method "local-file") ! (let ((name (vm-mime-get-parameter layout "name"))) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (not (file-exists-p name)) ! (vm-mime-error "file %s does not exist" name)) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error (cdr data)))))) ! ((and (or (string= access-method "ftp") ! (string= access-method "anon-ftp")) ! (or (fboundp 'efs-file-handler-function) ! (fboundp 'ange-ftp-hook-function))) ! (let ((name (vm-mime-get-parameter layout "name")) ! (directory (vm-mime-get-parameter layout ! "directory")) ! (site (vm-mime-get-parameter layout "site")) ! user) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (null site) ! (vm-mime-error ! "%s access type missing `site' parameter" ! access-method)) ! (cond ((string= access-method "ftp") ! (setq user (read-string ! (format "User name to access %s: " ! site) ! (user-login-name)))) ! (t (setq user "anonymous"))) ! (cond (directory ! (setq directory ! (concat "/" user "@" site ":" directory)) ! (setq name (expand-file-name name directory))) ! (t ! (setq name (concat "/" user "@" site ":" ! name)))) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error ! (format "%s" (cdr data))))))) ! ((string= access-method "mail-server") ! (let ((server (vm-mime-get-parameter layout "server")) ! (subject (vm-mime-get-parameter layout "subject"))) ! (if (null server) ! (vm-mime-error ! "%s access type missing `server' parameter" ! access-method)) ! (if (not ! (y-or-n-p ! (format ! "Send message to %s to retrieve external body? " ! server))) ! (error "Aborted")) ! (vm-mail-internal ! (format "mail to MIME mail server %s" server) ! server subject) ! (mail-text) ! (vm-mime-insert-mime-body child-layout) ! (let ((vm-confirm-mail-send nil)) ! (vm-mail-send)))) ! (t ! (vm-mime-error "unsupported access method: %s" ! access-method))) ! (cond (child-layout ! (setq work-buffer nil) ! (vm-set-mm-layout-body-end child-layout ! (vm-marker (point-max))) ! (vm-set-mm-layout-body-start child-layout ! (vm-marker ! (point-min)))))) ! (vm-mime-error ! (vm-set-mm-layout-display-error layout (cdr data)) ! (setq child-layout nil))))) (and work-buffer (kill-buffer work-buffer))) ! (and child-layout (vm-decode-mime-layout child-layout)))) *************** *** 4330,4332 **** (string-match ! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()acdefknNstT%]\\)" format last-match-end)) --- 4318,4320 ---- (string-match ! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()acdefknNstTx%]\\)" format last-match-end)) *************** *** 4334,4336 **** (setq new-match-end (match-end 0)) ! (if (memq conv-spec '(?\( ?a ?c ?d ?e ?f ?k ?n ?N ?s ?t ?T)) (progn --- 4322,4324 ---- (setq new-match-end (match-end 0)) ! (if (memq conv-spec '(?\( ?a ?c ?d ?e ?f ?k ?n ?N ?s ?t ?T ?x)) (progn *************** *** 4374,4375 **** --- 4362,4366 ---- (setq sexp (cons (list 'vm-mf-partial-total + 'vm-mime-layout) sexp))) + ((= conv-spec ?x) + (setq sexp (cons (list 'vm-mf-external-body-content-type 'vm-mime-layout) sexp)))) *************** *** 4454,4455 **** --- 4445,4449 ---- (car (vm-mm-layout-type layout))) + + (defun vm-mf-external-body-content-type (layout) + (car (vm-mm-layout-type (car (vm-mm-layout-parts layout))))) *** dist/vm-misc.el.dist Thu Nov 2 09:27:07 2000 --- vm-misc.el Fri Nov 3 10:28:30 2000 *************** *** 595,596 **** --- 595,608 ---- + (defun vm-make-multibyte-work-buffer (&optional name) + (let ((default-enable-multibyte-characters t) + work-buffer) + (setq work-buffer (generate-new-buffer (or name "*vm-workbuf*"))) + (buffer-disable-undo work-buffer) + ;; probably not worth doing since no one sets buffer-offer-save + ;; non-nil globally, do they? + ;; (save-excursion + ;; (set-buffer work-buffer) + ;; (setq buffer-offer-save nil)) + work-buffer )) + (defun vm-insert-char (char &optional count ignored buffer) *************** *** 633,635 **** (save-excursion ! (setq work-buffer (vm-make-work-buffer)) (set-buffer work-buffer) --- 645,647 ---- (save-excursion ! (setq work-buffer (vm-make-multibyte-work-buffer)) (set-buffer work-buffer) *** dist/vm-page.el.dist Thu Nov 2 09:27:07 2000 --- vm-page.el Sun Nov 5 01:42:44 2000 *************** *** 589,591 **** '("text" "multipart" "message")) ! (vm-auto-displayed-mime-content-type-exceptions nil) (vm-mime-external-content-types-alist nil)) --- 589,592 ---- '("text" "multipart" "message")) ! (vm-auto-displayed-mime-content-type-exceptions ! '("message/external-body")) (vm-mime-external-content-types-alist nil)) *** dist/vm-save.el.dist Thu Nov 2 09:27:08 2000 --- vm-save.el Thu Nov 2 23:37:12 2000 *************** *** 410,411 **** --- 410,414 ---- (setq file-buffer (vm-get-file-buffer file)))) + (if (and (not (eq (vm-get-folder-type file) 'unknown)) + (not (y-or-n-p "This file looks like a mail folder, append to it anyway? "))) + (error "Aborted")) (save-excursion *** dist/vm-startup.el.dist Thu Nov 2 09:27:08 2000 --- vm-startup.el Sun Nov 5 02:07:18 2000 *************** *** 327,329 **** ! This is VM 6.77. --- 327,329 ---- ! This is VM 6.78. *** dist/vm-vars.el.dist Thu Nov 2 09:27:08 2000 --- vm-vars.el Sat Nov 4 19:00:18 2000 *************** *** 916,917 **** --- 916,918 ---- ("message/partial" . "%-35.35(%d, part %N (of %T)%) [%k to %a]") + ("message/external-body" . "%-35.35(%d%) [%k to %a (%x)]") ("message" . "%-35.35(%d%) [%k to %a]") *************** *** 969,970 **** --- 970,973 ---- the total number of parts expected. + x - the content type of the external body of a message/external-body + object. ( - starts a group, terminated by %). Useful for specifying *************** *** 3619,3620 **** --- 3622,3624 ---- ("message/partial" . "attempt message assembly") + ("message/external-body" . "retrieve the object") ("message" . "display message") *************** *** 3643,3645 **** --- 3647,3652 ---- ("message/partial" . "message fragment") + ("message/external-body" . "external object") ("application/postscript" . "PostScript") + ("application/msword" . "Word document") + ("application/vnd.ms-excel" . "Excel spreadsheet") ("application/octet-stream" . "untyped binary data"))) *** dist/vm-version.el.dist Thu Nov 2 09:27:08 2000 --- vm-version.el Sun Nov 5 02:07:18 2000 *************** *** 4,6 **** ! (defconst vm-version "6.77" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "6.78" "Version number of VM.")