*** dist/vm-crypto.el.dist Sun Oct 28 22:13:03 2001 --- vm-crypto.el Tue Nov 13 14:45:31 2001 *************** *** 42,43 **** --- 42,48 ---- vm-pop-md5-program retval))) + ;; md5sum generates extra output even when summing stdin. + (goto-char (point-min)) + (if (search-forward " -\n" nil t) + (replace-match "")) + (goto-char (point-min)) *************** *** 114,116 **** (format "SSH tunnel to %s:%s" host port) ! nil vm-ssh-program --- 119,121 ---- (format "SSH tunnel to %s:%s" host port) ! (vm-make-work-buffer) vm-ssh-program *************** *** 120,132 **** vm-ssh-program-switches ! (list host) ! (list vm-ssh-remote-command))) done t) ! (process-kill-without-query process)) (t (delete-process process)))) ! ;; give ssh time to establish the connection. ! ;; probably should have the remote command output something ! ;; back thorugh the connection and run accept-process-output ! ;; until we see it on this end. ! (sleep-for 1) local-port )) --- 125,138 ---- vm-ssh-program-switches ! (list host vm-ssh-remote-command))) done t) ! (process-kill-without-query process) ! (set-process-sentinel process 'vm-process-sentinel-kill-buffer)) (t (delete-process process)))) ! ! ;; wait for some output from vm-ssh-remote-command. this ! ;; ensures that when we return the ssh connection is ready to ! ;; do port-forwarding. ! (accept-process-output process) ! local-port )) *** dist/vm-edit.el.dist Wed Sep 5 22:28:03 2001 --- vm-edit.el Tue Oct 30 19:48:18 2001 *************** *** 82,84 **** vm-mail-buffer folder-buffer ! vm-system-state 'editing) (run-hooks 'vm-edit-message-hook) --- 82,85 ---- vm-mail-buffer folder-buffer ! vm-system-state 'editing ! buffer-offer-save t) (run-hooks 'vm-edit-message-hook) *** dist/vm-folder.el.dist Sun Oct 28 22:13:04 2001 --- vm-folder.el Sun Nov 18 10:59:18 2001 *************** *** 4101,4102 **** --- 4101,4153 ---- + (defun vm-register-global-garbage-files (files) + (while files + (setq vm-global-garbage-alist + (cons (cons (car files) 'delete-file) + vm-global-garbage-alist) + files (cdr files)))) + + (defun vm-register-folder-garbage-files (files) + (vm-register-global-garbage-files files) + (save-excursion + (vm-select-folder-buffer) + (while files + (setq vm-folder-garbage-alist + (cons (cons (car files) 'delete-file) + vm-folder-garbage-alist) + files (cdr files))))) + + (defun vm-register-folder-garbage (action garbage) + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons garbage action) + vm-folder-garbage-alist)))) + + (defun vm-register-message-garbage-files (files) + (vm-register-folder-garbage-files files) + (save-excursion + (vm-select-folder-buffer) + (while files + (setq vm-message-garbage-alist + (cons (cons (car files) 'delete-file) + vm-message-garbage-alist) + files (cdr files))))) + + (defun vm-register-message-garbage (action garbage) + (vm-register-folder-garbage action garbage) + (save-excursion + (vm-select-folder-buffer) + (setq vm-message-garbage-alist + (cons (cons garbage action) + vm-message-garbage-alist)))) + + (defun vm-garbage-collect-global () + (save-excursion + (while vm-global-garbage-alist + (condition-case nil + (funcall (cdr (car vm-global-garbage-alist)) + (car (car vm-global-garbage-alist))) + (error nil)) + (setq vm-global-garbage-alist (cdr vm-global-garbage-alist))))) + (defun vm-garbage-collect-folder () *** dist/vm-mime.el.dist Sun Oct 28 22:13:04 2001 --- vm-mime.el Sun Nov 18 23:54:04 2001 *************** *** 70,71 **** --- 70,76 ---- + (defun vm-mime-make-cache-symbol () + (let ((s (make-symbol "<>"))) + (set s s) + s )) + (defun vm-mm-layout (m) *************** *** 666,668 **** (buffer-read-only nil) ! charset encoding match-start match-end start end) (save-excursion --- 671,673 ---- (buffer-read-only nil) ! charset need-conversion encoding match-start match-end start end) (save-excursion *************** *** 678,680 **** ;; character set properly. ! (if (not (vm-mime-charset-internally-displayable-p charset)) nil --- 683,687 ---- ;; character set properly. ! (if (and (not (vm-mime-charset-internally-displayable-p charset)) ! (not (setq need-conversion ! (vm-mime-can-convert-charset charset)))) nil *************** *** 692,693 **** --- 699,703 ---- (delete-region (point) end))) + (and need-conversion + (setq charset (vm-mime-charset-convert-region + charset start end))) (vm-mime-charset-decode-region charset start end) *************** *** 892,894 **** (vm-text-end-of m) ! nil nil (vm-mime-make-message-symbol m) --- 902,905 ---- (vm-text-end-of m) ! nil ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 906,908 **** (vm-marker (point-max)) ! nil nil (vm-mime-make-message-symbol m) --- 917,920 ---- (vm-marker (point-max)) ! nil ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 944,946 **** c-t-e t))) ! nil (vm-mime-make-message-symbol m) --- 956,958 ---- c-t-e t))) ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 958,960 **** (vm-marker (point-max)) ! nil nil (vm-mime-make-message-symbol m) --- 970,973 ---- (vm-marker (point-max)) ! nil ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 1009,1011 **** (nreverse multipart-list) ! nil (vm-mime-make-message-symbol m) --- 1022,1024 ---- (nreverse multipart-list) ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 1047,1049 **** text-end ! nil nil (vm-mime-make-message-symbol m) --- 1060,1063 ---- text-end ! nil ! (vm-mime-make-cache-symbol) (vm-mime-make-message-symbol m) *************** *** 1051,1053 **** ! (defun vm-mime-get-xxx-parameter (layout name param-list) (let ((match-end (1+ (length name))) --- 1065,1067 ---- ! (defun vm-mime-get-xxx-parameter (name param-list) (let ((match-end (1+ (length name))) *************** *** 1065,1071 **** (defun vm-mime-get-parameter (layout name) ! (vm-mime-get-xxx-parameter layout name (cdr (vm-mm-layout-type layout)))) (defun vm-mime-get-disposition-parameter (layout name) ! (vm-mime-get-xxx-parameter layout name ! (cdr (vm-mm-layout-disposition layout)))) --- 1079,1104 ---- (defun vm-mime-get-parameter (layout name) ! (vm-mime-get-xxx-parameter name (cdr (vm-mm-layout-type layout)))) (defun vm-mime-get-disposition-parameter (layout name) ! (vm-mime-get-xxx-parameter name (cdr (vm-mm-layout-disposition layout)))) ! ! (defun vm-mime-set-xxx-parameter (name value param-list) ! (let ((match-end (1+ (length name))) ! (name-regexp (concat (regexp-quote name) "=")) ! (case-fold-search t) ! (done nil)) ! (while (and param-list (not done)) ! (if (and (string-match name-regexp (car param-list)) ! (= (match-end 0) match-end)) ! (setq done t) ! (setq param-list (cdr param-list)))) ! (and (car param-list) ! (setcar param-list (concat "charset=" value))))) ! ! (defun vm-mime-set-parameter (layout name value) ! (vm-mime-set-xxx-parameter name value (cdr (vm-mm-layout-type layout)))) ! ! (defun vm-mime-set-qparameter (layout name value) ! (setq value (concat "\"" value "\"")) ! (vm-mime-set-xxx-parameter name value (cdr (vm-mm-layout-qtype layout)))) *************** *** 1265,1266 **** --- 1298,1305 ---- (and (vm-image-type-available-p 'tiff) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/xpm" type) + (and (vm-image-type-available-p 'xpm) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/pbm" type) + (and (vm-image-type-available-p 'pbm) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/xbm" type) + (and (vm-image-type-available-p 'xbm) (vm-images-possible-here-p))) ((vm-mime-types-match "audio/basic" type) *************** *** 1290,1292 **** "us-ascii"))) ! (vm-mime-charset-internally-displayable-p charset))) (t nil)))) --- 1329,1332 ---- "us-ascii"))) ! (or (vm-mime-charset-internally-displayable-p charset) ! (vm-mime-can-convert-charset charset)))) (t nil)))) *************** *** 1294,1296 **** (defun vm-mime-can-convert (type) ! (let ((alist vm-mime-type-converter-alist) ;; fake layout. make it the wrong length so an error will --- 1334,1340 ---- (defun vm-mime-can-convert (type) ! (or (vm-mime-can-convert-0 type vm-mime-type-converter-alist) ! (vm-mime-can-convert-0 type vm-mime-image-type-converter-alist))) ! ! (defun vm-mime-can-convert-0 (type alist) ! (let ( ;; fake layout. make it the wrong length so an error will *************** *** 1311,1321 **** (defun vm-mime-convert-undisplayable-layout (layout) ! (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout))))) ! (message "Converting %s to %s..." ! (car (vm-mm-layout-type layout)) (nth 1 ooo)) (save-excursion ! (set-buffer (vm-make-work-buffer " *mime object*")) ! (setq vm-message-garbage-alist ! (cons (cons (current-buffer) 'kill-buffer) ! vm-message-garbage-alist)) ;; call-process-region calls write-region. --- 1355,1427 ---- (defun vm-mime-convert-undisplayable-layout (layout) ! (catch 'done ! (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout)))) ! ex work-buffer) ! (message "Converting %s to %s..." ! (car (vm-mm-layout-type layout)) ! (nth 1 ooo)) ! (save-excursion ! (setq work-buffer (vm-make-work-buffer " *mime object*")) ! (vm-register-message-garbage 'kill-buffer work-buffer) ! (set-buffer work-buffer) ! ;; call-process-region calls write-region. ! ;; don't let it do CR -> LF translation. ! (setq selective-display nil) ! (vm-mime-insert-mime-body layout) ! (vm-mime-transfer-decode-region layout (point-min) (point-max)) ! (setq ex (call-process-region (point-min) (point-max) shell-file-name ! t t nil shell-command-switch (nth 2 ooo))) ! (if (not (eq ex 0)) ! (progn ! (message "Conversion from %s to %s failed (exit code %s)" ! (car (vm-mm-layout-type layout)) ! (nth 1 ooo) ! ex) ! (throw 'done nil))) ! (goto-char (point-min)) ! (insert "Content-Type: " (nth 1 ooo) "\n") ! (insert "Content-Transfer-Encoding: binary\n\n") ! (set-buffer-modified-p nil) ! (message "Converting %s to %s... done" ! (car (vm-mm-layout-type layout)) ! (nth 1 ooo)) ! (vector (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout))) ! (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout))) ! "binary" ! (vm-mm-layout-id layout) ! (vm-mm-layout-description layout) ! (vm-mm-layout-disposition layout) ! (vm-mm-layout-qdisposition layout) ! (vm-marker (point-min)) ! (vm-marker (1- (point))) ! (vm-marker (point)) ! (vm-marker (point-max)) ! nil ! (vm-mime-make-cache-symbol) ! (vm-mime-make-message-symbol (vm-mm-layout-message layout)) ! nil))))) ! ! (defun vm-mime-can-convert-charset (charset) ! (vm-mime-can-convert-charset-0 charset vm-mime-charset-converter-alist)) ! ! (defun vm-mime-can-convert-charset-0 (charset alist) ! (let ((done nil)) ! (while (and alist (not done)) ! (cond ((and (vm-string-equal-ignore-case (car (car alist)) charset) ! (vm-mime-charset-internally-displayable-p ! (nth 1 (car alist)))) ! (setq done t)) ! (t (setq alist (cdr alist))))) ! (and alist (car alist)))) ! ! (defun vm-mime-convert-undisplayable-charset (layout) ! (let ((charset (vm-mime-get-parameter layout "charset")) ! ooo work-buffer) ! (setq ooo (vm-mime-can-convert-charset charset)) ! (message "Converting charset %s to %s..." ! charset (nth 1 ooo)) (save-excursion ! (setq work-buffer (vm-make-work-buffer " *mime object*")) ! (vm-register-message-garbage 'kill-buffer work-buffer) ! (set-buffer work-buffer) ;; call-process-region calls write-region. *************** *** 1327,1350 **** t t nil shell-command-switch (nth 2 ooo)) (goto-char (point-min)) ! (insert "Content-Type: " (nth 1 ooo) "\n") ! (insert "Content-Transfer-Encoding: binary\n\n") (set-buffer-modified-p nil) ! (message "Converting %s to %s... done" ! (car (vm-mm-layout-type layout)) (nth 1 ooo)) ! (vector (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout))) ! (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout))) ! "binary" ! (vm-mm-layout-id layout) ! (vm-mm-layout-description layout) ! (vm-mm-layout-disposition layout) ! (vm-mm-layout-qdisposition layout) ! (vm-marker (point-min)) ! (vm-marker (1- (point))) ! (vm-marker (point)) ! (vm-marker (point-max)) ! nil ! nil ! (vm-mime-make-message-symbol (vm-mm-layout-message layout)) ! nil)))) --- 1433,1490 ---- t t nil shell-command-switch (nth 2 ooo)) + (setq layout + (vector (copy-sequence (vm-mm-layout-type layout)) + (copy-sequence (vm-mm-layout-type layout)) + "binary" + (vm-mm-layout-id layout) + (vm-mm-layout-description layout) + (vm-mm-layout-disposition layout) + (vm-mm-layout-qdisposition layout) + (vm-marker (point-min)) + (vm-marker (1- (point))) + (vm-marker (point)) + (vm-marker (point-max)) + nil + (vm-mime-make-cache-symbol) + (vm-mime-make-message-symbol (vm-mm-layout-message layout)) + nil)) + (vm-mime-set-parameter layout "charset" (nth 1 ooo)) + (vm-mime-set-qparameter layout "charset" (nth 1 ooo)) (goto-char (point-min)) ! (insert-before-markers "Content-Type: " (car (vm-mm-layout-type layout))) ! (insert-before-markers ";\n\t" ! (mapconcat 'identity ! (car (vm-mm-layout-type layout)) ! ";\n\t") ! "\n") ! (insert-before-markers "Content-Transfer-Encoding: binary\n\n") (set-buffer-modified-p nil) ! (message "Converting charset %s to %s... done" ! charset (nth 1 ooo)) ! layout))) ! ! (defun vm-mime-charset-convert-region (charset b-start b-end) ! (let ((b (current-buffer)) ! start end oldsize work-buffer ooo) ! (setq ooo (vm-mime-can-convert-charset charset)) ! (unwind-protect ! (save-excursion ! (setq work-buffer (vm-make-work-buffer " *mime object*")) ! (setq oldsize (- b-end b-start)) ! (set-buffer work-buffer) ! (insert-buffer-substring b b-start b-end) ! ;; call-process-region calls write-region. ! ;; don't let it do CR -> LF translation. ! (setq selective-display nil) ! (call-process-region (point-min) (point-max) shell-file-name ! t t nil shell-command-switch (nth 2 ooo)) ! (and vm-fsfemacs-mule-p (set-buffer-multibyte t)) ! (setq start (point-min) end (point-max)) ! (save-excursion ! (set-buffer b) ! (goto-char b-start) ! (insert-buffer-substring work-buffer start end) ! (delete-region (point) (+ (point) oldsize))) ! (nth 1 ooo)) ! (and work-buffer (kill-buffer work-buffer))))) *************** *** 1525,1527 **** (let ((modified (buffer-modified-p)) ! file type type2 type-no-subtype (extent nil)) (unwind-protect --- 1665,1667 ---- (let ((modified (buffer-modified-p)) ! new-layout file type type2 type-no-subtype (extent nil)) (unwind-protect *************** *** 1587,1591 **** extent 'vm-mime-disposable nil))) ! ((vm-mime-can-convert type) ! (vm-decode-mime-layout ! (vm-mime-convert-undisplayable-layout layout))) (t (and extent (vm-mime-rewrite-failed-button --- 1727,1732 ---- extent 'vm-mime-disposable nil))) ! ((and (vm-mime-can-convert type) ! (setq new-layout ! (vm-mime-convert-undisplayable-layout layout))) ! (vm-decode-mime-layout new-layout)) (t (and extent (vm-mime-rewrite-failed-button *************** *** 1654,1656 **** (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) ! (let ((start (point)) end (buffer-read-only nil) --- 1795,1797 ---- (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) ! (let ((start (point)) end need-conversion (buffer-read-only nil) *************** *** 1658,1660 **** (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) ! (if (not (vm-mime-charset-internally-displayable-p charset)) (progn --- 1799,1802 ---- (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) ! (if (and (not (vm-mime-charset-internally-displayable-p charset)) ! (not (setq need-conversion (vm-mime-can-convert-charset charset)))) (progn *************** *** 1666,1667 **** --- 1808,1811 ---- (vm-mime-transfer-decode-region layout start end) + (and need-conversion + (setq charset (vm-mime-charset-convert-region charset start end))) (vm-mime-charset-decode-region charset start end) *************** *** 1722,1725 **** process tempfile cache end suffix) ! (setq cache (cdr (assq 'vm-mime-display-external-generic ! (vm-mm-layout-cache layout))) process (nth 0 cache) --- 1866,1869 ---- process tempfile cache end suffix) ! (setq cache (get (vm-mm-layout-cache layout) ! 'vm-mime-display-external-generic) process (nth 0 cache) *************** *** 1732,1734 **** (unwind-protect ! (progn (setq work-buffer (vm-make-work-buffer)) --- 1876,1878 ---- (unwind-protect ! (save-excursion (setq work-buffer (vm-make-work-buffer)) *************** *** 1753,1755 **** (vm-mime-find-filename-suffix-for-type layout))) ! (setq tempfile (vm-make-tempfile-name suffix)) (let ((buffer-file-type buffer-file-type) --- 1897,1900 ---- (vm-mime-find-filename-suffix-for-type layout))) ! (setq tempfile (vm-make-tempfile suffix)) ! (vm-register-message-garbage-files (list tempfile)) (let ((buffer-file-type buffer-file-type) *************** *** 1768,1781 **** (vm-binary-coding-system) t))) - ;; Write an empty tempfile out to disk and set its - ;; permissions to 0600, then write the actual buffer - ;; contents to tempfile. - (write-region start start tempfile nil 0) - (set-file-modes tempfile 384) (write-region start end tempfile nil 0) ! (delete-region start end) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-message-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-message-garbage-alist)))))) --- 1913,1916 ---- (vm-binary-coding-system) t))) (write-region start end tempfile nil 0) ! (delete-region start end)))) *************** *** 1817,1828 **** (if vm-mime-delete-viewer-processes ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-message-garbage-alist ! (cons (cons process 'delete-process) ! vm-message-garbage-alist)))) ! (vm-set-mm-layout-cache ! layout ! (nconc (vm-mm-layout-cache layout) ! (list (cons 'vm-mime-display-external-generic ! (list process tempfile))))))) t ) --- 1952,1957 ---- (if vm-mime-delete-viewer-processes ! (vm-register-message-garbage 'delete-process process)) ! (put (vm-mm-layout-cache layout) ! 'vm-mime-display-external-generic ! (list process tempfile)))) t ) *************** *** 2197,2198 **** --- 2326,2334 ---- (error nil)))) + ((and (memq 'w3m vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region (point) (point) + buffer + vm-w3m-program + "-dump_source" url) + (error nil)))) ((and (memq 'lynx vm-url-retrieval-methods) *************** *** 2344,2347 **** (vm-mime-display-internal-image-xemacs-xxxx layout image-type name)) ! (vm-fsfemacs-p ! (vm-mime-display-internal-image-fsfemacs-xxxx layout image-type name)))) --- 2480,2485 ---- (vm-mime-display-internal-image-xemacs-xxxx layout image-type name)) ! ((and vm-fsfemacs-p (fboundp 'image-type-available-p)) ! (vm-mime-display-internal-image-fsfemacs-21-xxxx layout image-type name)) ! ((and vm-fsfemacs-p (stringp vm-imagemagick-convert-program)) ! (vm-mime-display-internal-image-fsfemacs-19-xxxx layout image-type name)))) *************** *** 2352,2356 **** (selective-display nil) (buffer-read-only nil)) ! (if (setq g (cdr (assq 'vm-mime-display-internal-image-xxxx ! (vm-mm-layout-cache layout)))) nil --- 2490,2495 ---- (selective-display nil) + do-strips (buffer-read-only nil)) ! (if (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) nil *************** *** 2359,2366 **** (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile-name)) ! ;; Write an empty tempfile out to disk and set its ! ;; permissions to 0600, then write the actual buffer ! ;; contents to tempfile. ! (write-region start start tempfile nil 0) ! (set-file-modes tempfile 384) ;; coding system for presentation buffer is binary so --- 2498,2501 ---- (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile)) ! (vm-register-folder-garbage-files (list tempfile)) ;; coding system for presentation buffer is binary so *************** *** 2368,2413 **** (write-region start end tempfile nil 0) ! (message "Creating %s glyph..." name) ! (setq g (make-glyph ! (list ! (cons (list 'win) ! (vector image-type ':file tempfile)) ! (cons (list 'win) ! (vector 'string ! ':data ! (format "[Unknown/Bad %s image encoding]" ! name))) ! (cons nil ! (vector 'string ! ':data ! (format "[%s image]\n" name)))))) ! (message "") ! ;; XEmacs 21.2 can pixel scroll images if the entire ! ;; image is above the baseline. ! (set-glyph-baseline g 100) ! (vm-set-mm-layout-cache ! layout ! (nconc (vm-mm-layout-cache layout) ! (list (cons 'vm-mime-display-internal-image-xxxx g)))) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-folder-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-folder-garbage-alist))) (delete-region start end)) ! (if (not (bolp)) ! (insert-char ?\n 2) ! (insert-char ?\n 1)) ! (setq e (vm-make-extent (1- (point)) (point))) ! (vm-set-extent-property e 'begin-glyph g) ! (vm-set-extent-property e 'start-open t) t ))) ! (defun vm-mime-display-internal-image-fsfemacs-xxxx (layout image-type name) (if (and (vm-images-possible-here-p) ! (image-type-available-p image-type)) (let (start end tempfile image work-buffer (selective-display nil) (buffer-read-only nil)) ! (if (setq image (cdr (assq 'vm-mime-display-internal-image-xxxx ! (vm-mm-layout-cache layout)))) nil --- 2503,2596 ---- (write-region start end tempfile nil 0) ! (put (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx ! tempfile) (delete-region start end)) ! (if (or (not (bolp)) ! (bobp) ! (map-extents 'extent-property nil (1- (point)) (point) ! 'begin-glyph)) ! (insert "\n")) ! (setq do-strips (and (stringp vm-imagemagick-convert-program) ! vm-mime-use-image-strips)) ! (cond (do-strips ! (condition-case error-data ! (let ((strips (vm-make-image-strips tempfile ! (font-height ! (face-font 'default)) ! t)) ! process image-list extent-list ! (first t)) ! (setq process (car strips) ! strips (cdr strips) ! image-list strips) ! (vm-register-message-garbage-files strips) ! (while strips ! (setq g (make-glyph ! (list ! (cons nil ! (vector 'string ! ':data ! (if (or first ! (null (cdr strips))) ! (progn ! (setq first nil) ! "+-----+") ! "|image|")))))) ! (setq e (vm-make-extent (1- (point)) (point))) ! (if (cdr strips) (insert "\n")) ! (vm-set-extent-property e 'begin-glyph g) ! (vm-set-extent-property e 'start-open t) ! (setq extent-list (cons e extent-list)) ! (setq strips (cdr strips))) ! (save-excursion ! (set-buffer (process-buffer process)) ! (set (make-local-variable 'vm-image-list) image-list) ! (set (make-local-variable 'vm-image-type) image-type) ! (set (make-local-variable 'vm-image-type-name) ! name) ! (set (make-local-variable 'vm-extent-list) ! (nreverse extent-list))) ! (set-process-sentinel ! process ! 'vm-process-sentinel-display-image-strips)) ! (vm-image-too-small ! (setq do-strips nil)) ! (error ! (message "Failed making image strips: %s" error-data) ! ;; fallback to the non-strips way ! (setq do-strips nil))))) ! (cond ((not do-strips) ! (message "Creating %s glyph..." name) ! (setq g (make-glyph ! (list ! (cons (list 'win) ! (vector image-type ':file tempfile)) ! (cons (list 'win) ! (vector 'string ! ':data ! (format "[Unknown/Bad %s image encoding]" ! name))) ! (cons nil ! (vector 'string ! ':data ! (format "[%s image]\n" name)))))) ! (message "") ! ;; XEmacs 21.2 can pixel scroll images (sort of) ! ;; if the entire image is above the baseline. ! (set-glyph-baseline g 100) ! (set-glyph-face g 'vm-xface) ! (setq e (vm-make-extent (1- (point)) (point))) ! (vm-set-extent-property e 'begin-glyph g) ! (vm-set-extent-property e 'start-open t))) t ))) ! (defun vm-mime-display-internal-image-fsfemacs-21-xxxx (layout image-type name) (if (and (vm-images-possible-here-p) ! (vm-image-type-available-p image-type)) (let (start end tempfile image work-buffer (selective-display nil) + do-strips (buffer-read-only nil)) ! (if (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) nil *************** *** 2422,2449 **** (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile-name)) (let ((coding-system-for-write (vm-binary-coding-system))) - ;; Write an empty tempfile out to disk and set its - ;; permissions to 0600, then write the actual buffer - ;; contents to tempfile. - (write-region start start tempfile nil 0) - (set-file-modes tempfile 384) (write-region start end tempfile nil 0)) ! (setq image (list 'image ':type image-type ':file tempfile)) ! (vm-set-mm-layout-cache ! layout ! (nconc (vm-mm-layout-cache layout) ! (list (cons 'vm-mime-display-internal-image-xxxx ! image))))) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-folder-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-folder-garbage-alist)))) (and work-buffer (kill-buffer work-buffer)))) ! ;; insert one char so we can attach the image to it. ! (insert "z") ! (put-text-property (1- (point)) (point) 'display image) ! (if (not (save-excursion (goto-char (1- (point))) (bolp))) ! (insert-char ?\n 2) ! (insert-char ?\n 1)) t ) --- 2605,2662 ---- (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile)) (let ((coding-system-for-write (vm-binary-coding-system))) (write-region start end tempfile nil 0)) ! (put (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx ! tempfile)) ! (vm-register-folder-garbage-files (list tempfile))) (and work-buffer (kill-buffer work-buffer)))) ! (if (not (bolp)) ! (insert-char ?\n 1)) ! (setq do-strips (and (stringp vm-imagemagick-convert-program) ! vm-mime-use-image-strips)) ! (cond (do-strips ! (condition-case error-data ! (let ((strips (vm-make-image-strips tempfile ! (frame-char-height) ! t)) ! (first t) ! o process image-list overlay-list) ! (setq process (car strips) ! strips (cdr strips) ! image-list strips) ! (vm-register-message-garbage-files strips) ! (while strips ! (if (or first (null (cdr strips))) ! (progn ! (setq first nil) ! (insert "+-----+")) ! (insert "|image|")) ! (setq o (make-overlay (- (point) 7) (point))) ! (overlay-put o 'evaporate t) ! (setq overlay-list (cons o overlay-list)) ! (insert "\n") ! (setq strips (cdr strips))) ! (save-excursion ! (set-buffer (process-buffer process)) ! (set (make-local-variable 'vm-image-list) image-list) ! (set (make-local-variable 'vm-image-type) image-type) ! (set (make-local-variable 'vm-image-type-name) ! name) ! (set (make-local-variable 'vm-overlay-list) ! (nreverse overlay-list))) ! (set-process-sentinel ! process ! 'vm-process-sentinel-display-image-strips)) ! (vm-image-too-small ! (setq do-strips nil)) ! (error ! (message "Failed making image strips: %s" error-data) ! ;; fallback to the non-strips way ! (setq do-strips nil))))) ! (cond ((not do-strips) ! (setq image (list 'image ':type image-type ':file tempfile)) ! ;; insert one char so we can attach the image to it. ! (insert "z") ! (put-text-property (1- (point)) (point) 'display image))) t ) *************** *** 2451,2452 **** --- 2664,2964 ---- + (defun vm-mime-display-internal-image-fsfemacs-19-xxxx (layout image-type name) + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p image-type)) + (catch 'done + (let ((selective-display nil) + start end tempfile image work-buffer + (hroll (if vm-fsfemacs-mule-p + (+ (cdr (assq 'internal-border-width + (frame-parameters))) + (if (memq (cdr (assq 'vertical-scroll-bars + (frame-parameters))) + '(t left)) + (vm-fsfemacs-scroll-bar-width) + 0)) + (cdr (assq 'internal-border-width + (frame-parameters))))) + (vroll (cdr (assq 'internal-border-width (frame-parameters)))) + (reverse (eq (cdr (assq 'background-mode (frame-parameters))) + 'dark)) + blob strips + dims width height char-width char-height + horiz-pad vert-pad + (buffer-read-only nil)) + (if (and (setq blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + (file-exists-p (car blob)) + (progn + (setq tempfile (car blob) + width (nth 1 blob) + height (nth 2 blob) + char-width (nth 3 blob) + char-height (nth 4 blob)) + (and (= char-width (frame-char-width)) + (= char-height (frame-char-height))))) + (setq strips (nth 5 blob)) + (unwind-protect + (progn + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (setq start (point)) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile)) + (let ((coding-system-for-write (vm-binary-coding-system))) + (write-region start end tempfile nil 0)) + (setq dims (condition-case error-data + (vm-get-image-dimensions tempfile) + (error + (message "Failed getting image dimensions: %s" + error-data) + (throw 'done nil))) + width (nth 0 dims) + height (nth 1 dims) + char-width (frame-char-width) + char-height (frame-char-height) + horiz-pad (if (< width char-width) + (- char-width width) + (% width char-width)) + horiz-pad (if (zerop horiz-pad) + horiz-pad + (- char-width horiz-pad)) + vert-pad (if (< height char-height) + (- char-height height) + (% height char-height)) + vert-pad (if (zerop vert-pad) + vert-pad + (- char-height vert-pad))) + ;; crop one line from the bottom of the image + ;; if vertical padding needed is odd so that + ;; the image height plus the padding will be an + ;; exact multiple of the char height. + (if (not (zerop (% vert-pad 2))) + (setq height (1- height) + vert-pad (1+ vert-pad))) + (call-process-region start end + vm-imagemagick-convert-program + t t nil + (if reverse "-negate" "-matte") + "-crop" + (format "%dx%d+0+0" width height) + "-mattecolor" "white" + "-frame" + (format "%dx%d+0+0" + (/ (1+ horiz-pad) 2) + (/ vert-pad 2)) + "-" + "-") + (setq width (+ width (* 2 (/ (1+ horiz-pad) 2))) + height (+ height (* 2 (/ vert-pad 2)))) + (let ((coding-system-for-write (vm-binary-coding-system))) + (write-region (point-min) (point-max) tempfile nil 0)) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + (list tempfile width height char-width char-height))) + (vm-register-folder-garbage-files (list tempfile))) + (and work-buffer (kill-buffer work-buffer)))) + (if (not (bolp)) + (insert-char ?\n 1)) + (condition-case error-data + (let (o start process image-list overlay-list) + (if (and strips (file-exists-p (car strips))) + (setq image-list strips) + (setq strips (vm-make-image-strips tempfile char-height t + hroll vroll) + process (car strips) + strips (cdr strips) + image-list strips) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + (list tempfile width height char-width char-height + strips)) + (vm-register-message-garbage-files strips)) + (while strips + (setq start (point)) + (insert-char ?\ (/ width char-width)) + (setq o (make-overlay start (point) nil t)) + (overlay-put o 'evaporate t) + (setq overlay-list (cons o overlay-list)) + (insert "\n") + (setq strips (cdr strips))) + (if process + (save-excursion + (set-buffer (process-buffer process)) + (set (make-local-variable 'vm-image-list) image-list) + (set (make-local-variable 'vm-image-type) image-type) + (set (make-local-variable 'vm-image-type-name) + name) + (set (make-local-variable 'vm-overlay-list) + (nreverse overlay-list)) + (set-process-sentinel + process + 'vm-process-sentinel-display-image-strips)) + (vm-display-image-strips-on-overlay-regions image-list + (nreverse + overlay-list) + image-type))) + (error + (message "Failed making image strips: %s" error-data))) + t )) + nil )) + + (defun vm-get-image-dimensions (file) + (let (work-buffer width height) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (call-process vm-imagemagick-convert-program nil t nil + "-verbose" file "/dev/null") + (goto-char (point-min)) + (or (search-forward file nil t) + (error "file name missing from 'convert' output")) + (if (not (looking-at " \\([0-9]+\\)x\\([0-9]+\\)")) + (error "file dimensions missing from 'convert' output")) + (setq width (string-to-int (match-string 1)) + height (string-to-int (match-string 2)))) + (and work-buffer (kill-buffer work-buffer))) + (list width height))) + + (defun vm-make-image-strips (file min-height async &optional hroll vroll) + (or hroll (setq hroll 0)) + (or vroll (setq vroll 0)) + (let ((process-connection-type nil) + image-list dimensions width height starty newfile work-buffer + remainder process) + (setq dimensions (vm-get-image-dimensions file) + width (car dimensions) + height (car (cdr dimensions)) + remainder (% height min-height) + starty 0) + (if (< height min-height) + (signal 'vm-image-too-small nil)) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (goto-char (point-min)) + (while (< starty height) + (setq newfile (vm-make-tempfile-name)) + (if async + (insert vm-imagemagick-convert-program + " -crop" + (format " %dx%d+0+%d" + width + (if (zerop remainder) + min-height + (+ min-height 1)) + starty) + (format " -roll +%d+%d" hroll vroll) + " '" file "' '" newfile "'\n") + (call-process vm-imagemagick-convert-program nil nil nil + "-crop" + (format "%dx%d+0+%d" + width + (min min-height (- height starty)) + starty) + "-roll" + (format "+%d+%d" hroll vroll) + file newfile)) + (setq image-list (cons newfile image-list) + starty (+ starty min-height (if (zerop remainder) + 0 + (setq remainder (1- remainder)) + 1 )))) + (if (not async) + nil + (insert "exit\n") + (setq process + (start-process (format "image strip maker for %s" file) + (current-buffer) + shell-file-name)) + (process-send-string process (buffer-string)) + (setq work-buffer nil)) + (if async + (cons process (nreverse image-list)) + (nreverse image-list))) + (and work-buffer (kill-buffer work-buffer))))) + + (defvar vm-image-list) + (defvar vm-image-type) + (defvar vm-image-type-name) + (defvar vm-extent-list) + (defvar vm-overlay-list) + (defun vm-process-sentinel-display-image-strips (process what-happened) + (save-excursion + (set-buffer (process-buffer process)) + (cond ((and (boundp 'vm-extent-list) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (extents vm-extent-list) + (image-type vm-image-type) + (type-name vm-image-type-name)) + (vm-display-image-strips-on-extents strips extents image-type + type-name))) + ((and (boundp 'vm-overlay-list) + (overlay-buffer (car vm-overlay-list)) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (overlays vm-overlay-list) + (image-type vm-image-type)) + (vm-display-image-strips-on-overlay-regions strips overlays + image-type)))) + (kill-buffer (current-buffer)))) + + (defun vm-display-image-strips-on-extents (strips extents image-type type-name) + (let (g) + (while (and strips + (file-exists-p (car strips)) + (extent-live-p (car extents)) + (extent-object (car extents))) + (setq g (make-glyph + (list + (cons (list 'win) + (vector image-type ':file (car strips))) + (cons (list 'win) + (vector + 'string + ':data + (format "[Unknown/Bad %s image encoding]" + type-name))) + (cons nil + (vector 'string + ':data + (format "[%s image]\n" type-name)))))) + (set-glyph-baseline g 50) + (set-glyph-face g 'vm-xface) + (set-extent-begin-glyph (car extents) g) + (setq strips (cdr strips) + extents (cdr extents))))) + + (defun vm-display-image-strips-on-overlay-regions (strips overlays image-type) + (let (prop value (omodified (buffer-modified-p))) + (save-excursion + (set-buffer (overlay-buffer (car vm-overlay-list))) + (save-restriction + (widen) + (unwind-protect + (let ((buffer-read-only nil)) + (if (fboundp 'image-type-available-p) + (setq prop 'display) + (setq prop 'face)) + (while (and strips + (file-exists-p (car strips)) + (overlay-end (car overlays))) + (if (fboundp 'image-type-available-p) + (setq value (list 'image ':type image-type + ':file (car strips) + ':ascent 80)) + (setq value (make-face (make-symbol ""))) + (set-face-stipple value (car strips))) + (put-text-property (overlay-start (car overlays)) + (overlay-end (car overlays)) + prop value) + (setq strips (cdr strips) + overlays (cdr overlays)))) + (set-buffer-modified-p omodified)))))) + (defun vm-mime-display-internal-image/gif (layout) *************** *** 2463,2464 **** --- 2975,2985 ---- + (defun vm-mime-display-internal-image/xpm (layout) + (vm-mime-display-internal-image-xxxx layout 'xpm "XPM")) + + (defun vm-mime-display-internal-image/pbm (layout) + (vm-mime-display-internal-image-xxxx layout 'pbm "PBM")) + + (defun vm-mime-display-internal-image/xbm (layout) + (vm-mime-display-internal-image-xxxx layout 'xbm "XBM")) + (defun vm-mime-display-internal-audio/basic (layout) *************** *** 2474,2477 **** (buffer-read-only nil)) ! (if (setq tempfile (cdr (assq 'vm-mime-display-internal-audio/basic ! (vm-mm-layout-cache layout)))) nil --- 2995,2998 ---- (buffer-read-only nil)) ! (if (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-audio/basic)) nil *************** *** 2480,2487 **** (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile-name)) ! ;; Write an empty tempfile out to disk and set its ! ;; permissions to 0600, then write the actual buffer ! ;; contents to tempfile. ! (write-region start start tempfile nil 0) ! (set-file-modes tempfile 384) ;; coding system for presentation buffer is binary, so --- 3001,3004 ---- (vm-mime-transfer-decode-region layout start end) ! (setq tempfile (vm-make-tempfile)) ! (vm-register-folder-garbage-files (list tempfile)) ;; coding system for presentation buffer is binary, so *************** *** 2489,2500 **** (write-region start end tempfile nil 0) ! (vm-set-mm-layout-cache ! layout ! (nconc (vm-mm-layout-cache layout) ! (list (cons 'vm-mime-display-internal-audio/basic ! tempfile)))) ! (save-excursion ! (vm-select-folder-buffer) ! (setq vm-folder-garbage-alist ! (cons (cons tempfile 'delete-file) ! vm-folder-garbage-alist))) (delete-region start end)) --- 3006,3010 ---- (write-region start end tempfile nil 0) ! (put (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-audio/basic ! tempfile) (delete-region start end)) *************** *** 2598,2599 **** --- 3108,3113 ---- + (defun vm-mime-reader-map-display-object-as-type () + (interactive) + (vm-mime-run-display-function-at-point 'vm-mime-display-object-as-type)) + ;; for the karking compiler *************** *** 2901,2902 **** --- 3415,3429 ---- + (defun vm-mime-display-object-as-type (button) + (let ((vm-auto-displayed-mime-content-types t) + (vm-auto-displayed-mime-content-type-exceptions nil) + (old-layout (vm-extent-property button 'vm-mime-layout)) + layout + (type (read-string "View as MIME type: "))) + (setq layout (copy-sequence old-layout)) + (vm-set-extent-property button 'vm-mime-layout layout) + ;; not universally correct, but close enough. + (setcar (vm-mm-layout-type layout) type) + (goto-char (vm-extent-start-position button)) + (vm-decode-mime-layout button t))) + (defun vm-mime-display-body-using-external-viewer (button) *************** *** 2913,2918 **** (vm-extent-property button 'vm-mime-layout)))) ! (vm-set-extent-property button 'vm-mime-disposable t) ! (vm-set-extent-property button 'vm-mime-layout layout) ! (goto-char (vm-extent-start-position button)) ! (vm-decode-mime-layout button t))) --- 3440,3447 ---- (vm-extent-property button 'vm-mime-layout)))) ! (if (null layout) ! nil ! (vm-set-extent-property button 'vm-mime-disposable t) ! (vm-set-extent-property button 'vm-mime-layout layout) ! (goto-char (vm-extent-start-position button)) ! (vm-decode-mime-layout button t)))) *************** *** 3825,3827 **** (vm-set-mm-layout-parts layout nil) - (vm-set-mm-layout-cache layout nil) (vm-set-mm-layout-display-error layout nil))))))) --- 4354,4355 ---- *** dist/vm-misc.el.dist Sun Oct 28 22:13:04 2001 --- vm-misc.el Sun Nov 18 12:36:09 2001 *************** *** 866 **** --- 866,878 ---- (delete-region (- (point) 1) (- (point) 4)))))) + + (defun vm-process-sentinel-kill-buffer (process what-happened) + (kill-buffer (process-buffer process))) + + (defun vm-fsfemacs-scroll-bar-width () + (or vm-fsfemacs-cached-scroll-bar-width + (let (size) + (setq size (frame-pixel-width)) + (scroll-bar-mode nil) + (setq size (- size (frame-pixel-width))) + (scroll-bar-mode nil) + (setq vm-fsfemacs-cached-scroll-bar-width size)))) *** dist/vm-page.el.dist Tue Jul 24 21:01:44 2001 --- vm-page.el Sun Nov 18 22:53:46 2001 *************** *** 539,541 **** ! (defun vm-narrow-for-preview () (widen) --- 539,541 ---- ! (defun vm-narrow-for-preview (&optional just-passing-through) (widen) *************** *** 552,554 **** ;; will be displayed even if the extent is at the end ! ;; of a narrowed region. Thus a message continaing ;; only an image will have the image displayed at --- 552,554 ---- ;; will be displayed even if the extent is at the end ! ;; of a narrowed region. Thus a message containing ;; only an image will have the image displayed at *************** *** 559,561 **** ;; we're doing MIME decode for preview. ! (if (and vm-xemacs-p vm-mail-buffer ; in presentation buffer --- 559,562 ---- ;; we're doing MIME decode for preview. ! (if (and (not just-passing-through) ! vm-xemacs-p vm-mail-buffer ; in presentation buffer *************** *** 574,662 **** (defun vm-preview-current-message () ! (vm-save-buffer-excursion ! (setq vm-system-state 'previewing ! vm-mime-decoded nil) ! (if vm-real-buffers ! (vm-make-virtual-copy (car vm-message-pointer))) ! ! ;; run the message select hooks. ! (save-excursion ! (vm-select-folder-buffer) ! (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook) ! (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer)) ! (vm-run-message-hook (car vm-message-pointer) ! 'vm-select-new-message-hook)) ! (and vm-select-unread-message-hook ! (vm-unread-flag (car vm-message-pointer)) ! (vm-run-message-hook (car vm-message-pointer) ! 'vm-select-unread-message-hook))) ! ! (vm-narrow-for-preview) ! (if (or vm-mime-display-function ! (natnump vm-fill-paragraphs-containing-long-lines) ! (and vm-display-using-mime ! (not (vm-mime-plain-message-p (car vm-message-pointer))))) ! (let ((layout (vm-mm-layout (car vm-message-pointer)))) ! (vm-make-presentation-copy (car vm-message-pointer)) ! (vm-save-buffer-excursion ! (vm-replace-buffer-in-windows (current-buffer) ! vm-presentation-buffer)) ! (set-buffer vm-presentation-buffer) ! (setq vm-system-state 'previewing) ! (vm-narrow-for-preview)) ! (setq vm-presentation-buffer nil) ! (and vm-presentation-buffer-handle ! (vm-replace-buffer-in-windows vm-presentation-buffer-handle ! (current-buffer)))) ! ! ;; at this point the current buffer is the presentation buffer ! ;; if we're using one for this message. ! (vm-unbury-buffer (current-buffer)) ! ! (if (and vm-display-using-mime ! vm-auto-decode-mime-messages ! vm-mime-decode-for-preview ! vm-preview-lines ! (if vm-mail-buffer ! (not (vm-buffer-variable-value vm-mail-buffer ! 'vm-mime-decoded)) ! (not vm-mime-decoded)) ! (not (vm-mime-plain-message-p (car vm-message-pointer)))) ! ;; restrict the things that are auto-displayed, since ! ;; decode-for-preview is meant to allow a numeric ! ;; vm-preview-lines to be useful in the face of multipart ! ;; messages. ! (let ((vm-auto-displayed-mime-content-type-exceptions ! (cons "message/external-body" vm-auto-displayed-mime-content-type-exceptions)) ! (vm-mime-external-content-types-alist nil)) ! (condition-case data (progn ! (vm-decode-mime-message) ! ;; reset vm-mime-decoded so that when the user ! ;; opens the message completely, the full MIME ! ;; display will happen. ! (and vm-mail-buffer ! (vm-set-buffer-variable vm-mail-buffer ! 'vm-mime-decoded nil))) ! (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer) ! (car (cdr data))) ! (message "%s" (car (cdr data))))) ! (vm-narrow-for-preview)) ! (vm-energize-urls-in-message-region) ! (vm-highlight-headers-maybe) ! (vm-energize-headers-and-xfaces)) ! ! (if vm-honor-page-delimiters ! (vm-narrow-to-page)) ! (goto-char (vm-text-of (car vm-message-pointer))) ! ;; If we have a window, set window start appropriately. ! (let ((w (vm-get-visible-buffer-window (current-buffer)))) ! (if w ! (progn (set-window-start w (point-min)) ! (set-window-point w (vm-text-of (car vm-message-pointer)))))) ! (if (or (null vm-preview-lines) ! (and (not vm-preview-read-messages) ! (not (vm-new-flag (car vm-message-pointer))) ! (not (vm-unread-flag (car vm-message-pointer))))) ! (vm-show-current-message) ! (vm-update-summary-and-mode-line)))) --- 575,675 ---- (defun vm-preview-current-message () ! ;; Set just-passing-through if the user will never see the ! ;; message in the previewed state. Save some time later by not ! ;; doing preview action that hte user will never see anyway. ! (let ((just-passing-through ! (or (null vm-preview-lines) ! (and (not vm-preview-read-messages) ! (not (vm-new-flag (car vm-message-pointer))) ! (not (vm-unread-flag (car vm-message-pointer))))))) ! (vm-save-buffer-excursion ! (setq vm-system-state 'previewing ! vm-mime-decoded nil) ! (if vm-real-buffers ! (vm-make-virtual-copy (car vm-message-pointer))) ! ! ;; run the message select hooks. ! (save-excursion ! (vm-select-folder-buffer) ! (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook) ! (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer)) ! (vm-run-message-hook (car vm-message-pointer) ! 'vm-select-new-message-hook)) ! (and vm-select-unread-message-hook ! (vm-unread-flag (car vm-message-pointer)) ! (vm-run-message-hook (car vm-message-pointer) ! 'vm-select-unread-message-hook))) ! ! (vm-narrow-for-preview just-passing-through) ! (if (or vm-mime-display-function ! (natnump vm-fill-paragraphs-containing-long-lines) ! (and vm-display-using-mime ! (not (vm-mime-plain-message-p (car vm-message-pointer))))) ! (let ((layout (vm-mm-layout (car vm-message-pointer)))) ! (vm-make-presentation-copy (car vm-message-pointer)) ! (vm-save-buffer-excursion ! (vm-replace-buffer-in-windows (current-buffer) ! vm-presentation-buffer)) ! (set-buffer vm-presentation-buffer) ! (setq vm-system-state 'previewing) ! (vm-narrow-for-preview)) ! (setq vm-presentation-buffer nil) ! (and vm-presentation-buffer-handle ! (vm-replace-buffer-in-windows vm-presentation-buffer-handle ! (current-buffer)))) ! ! ;; at this point the current buffer is the presentation buffer ! ;; if we're using one for this message. ! (vm-unbury-buffer (current-buffer)) ! ! (if (and vm-display-using-mime ! vm-auto-decode-mime-messages ! vm-mime-decode-for-preview ! (not just-passing-through) ! (if vm-mail-buffer ! (not (vm-buffer-variable-value vm-mail-buffer ! 'vm-mime-decoded)) ! (not vm-mime-decoded)) ! (not (vm-mime-plain-message-p (car vm-message-pointer)))) ! (if (eq vm-preview-lines 0) (progn ! (vm-decode-mime-message-headers (car vm-message-pointer)) ! (vm-energize-urls) ! (vm-highlight-headers-maybe) ! (vm-energize-headers-and-xfaces)) ! ;; restrict the things that are auto-displayed, since ! ;; decode-for-preview is meant to allow a numeric ! ;; vm-preview-lines to be useful in the face of multipart ! ;; messages. ! (let ((vm-auto-displayed-mime-content-type-exceptions ! (cons "message/external-body" ! vm-auto-displayed-mime-content-type-exceptions)) ! (vm-mime-external-content-types-alist nil)) ! (condition-case data ! (progn ! (vm-decode-mime-message) ! ;; reset vm-mime-decoded so that when the user ! ;; opens the message completely, the full MIME ! ;; display will happen. ! (and vm-mail-buffer ! (vm-set-buffer-variable vm-mail-buffer ! 'vm-mime-decoded nil))) ! (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer) ! (car (cdr data))) ! (message "%s" (car (cdr data))))) ! (vm-narrow-for-preview))) ! (vm-energize-urls-in-message-region) ! (vm-highlight-headers-maybe) ! (vm-energize-headers-and-xfaces)) ! ! (if (and vm-honor-page-delimiters (not just-passing-through)) ! (vm-narrow-to-page)) ! (goto-char (vm-text-of (car vm-message-pointer))) ! ;; If we have a window, set window start appropriately. ! (let ((w (vm-get-visible-buffer-window (current-buffer)))) ! (if w ! (progn (set-window-start w (point-min)) ! (set-window-point w (vm-text-of (car vm-message-pointer)))))) ! (if just-passing-through ! (vm-show-current-message) ! (vm-update-summary-and-mode-line))))) *** dist/vm-reply.el.dist Sun Oct 28 22:13:04 2001 --- vm-reply.el Sun Nov 18 22:33:27 2001 *************** *** 1440,1445 **** (vm-remove-mail-mode-header-separator) (goto-char (point-min)) ! (insert (vm-leading-message-separator vm-default-From_-folder-type)) (goto-char (point-max)) ! (insert (vm-trailing-message-separator vm-default-From_-folder-type)) (set-buffer-modified-p nil) --- 1440,1446 ---- (vm-remove-mail-mode-header-separator) + (vm-munge-message-separators 'mmdf (point-min) (point-max)) (goto-char (point-min)) ! (insert (vm-leading-message-separator 'mmdf)) (goto-char (point-max)) ! (insert (vm-trailing-message-separator 'mmdf)) (set-buffer-modified-p nil) *** dist/vm-startup.el.dist Sun Oct 28 22:13:05 2001 --- vm-startup.el Sun Nov 18 23:56:25 2001 *************** *** 339,341 **** ! This is VM 6.97. --- 339,341 ---- ! This is VM 6.98. *************** *** 545,546 **** --- 545,547 ---- vm-image-directory + vm-imagemagick-convert-program vm-imap-auto-expunge-alist *************** *** 585,586 **** --- 586,588 ---- vm-mime-button-format-alist + vm-mime-charset-converter-alist vm-mime-charset-font-alist *************** *** 604,606 **** --- 606,610 ---- vm-mime-qp-encoder-switches + vm-mime-require-mime-version-header vm-mime-type-converter-alist + vm-mime-use-image-strips vm-mime-uuencode-decoder-program *************** *** 660,663 **** --- 664,673 ---- vm-spooled-mail-waiting-hook + vm-ssh-program + vm-ssh-program-switches + vm-ssh-remote-command vm-startup-with-summary vm-strip-reply-headers + vm-stunnel-program + vm-stunnel-program-switches + vm-stunnel-random-data-method vm-subject-significant-chars *************** *** 1184,1185 **** --- 1194,1196 ---- 'vm-image-directory + 'vm-imagemagick-convert-program ;; IMAP passwords might be listed here *************** *** 1227,1228 **** --- 1238,1240 ---- 'vm-mime-button-format-alist + 'vm-mime-charset-converter-alist 'vm-mime-charset-font-alist *************** *** 1246,1248 **** --- 1258,1262 ---- 'vm-mime-qp-encoder-switches + 'vm-mime-require-mime-version-header 'vm-mime-type-converter-alist + 'vm-mime-use-image-strips 'vm-mime-uuencode-decoder-program *************** *** 1307,1310 **** --- 1321,1330 ---- 'vm-spooled-mail-waiting-hook + 'vm-ssh-program + 'vm-ssh-program-switches + 'vm-ssh-remote-command 'vm-startup-with-summary 'vm-strip-reply-headers + 'vm-stunnel-program + 'vm-stunnel-program-switches + 'vm-stunnel-random-data-method 'vm-subject-significant-chars *************** *** 1393,1394 **** --- 1413,1415 ---- (vm-check-emacs-version) + (add-hook 'kill-emacs-hook 'vm-garbage-collect-global) ;; (vm-set-debug-flags) *** dist/vm-vars.el.dist Sun Oct 28 22:13:05 2001 --- vm-vars.el Sun Nov 18 12:34:24 2001 *************** *** 76,81 **** (setq vm-spool-files ! (vm-parse vm-spool-files ! "\\([^:%?]+\\)\\([%?][^:]*\\)?\\(:\\|$\\)"))) (and (setq vm-spool-files (getenv "MAIL")) ! (setq vm-spool-files (list vm-spool-files))))) --- 76,83 ---- (setq vm-spool-files ! (vm-delete-directory-names ! (vm-parse vm-spool-files ! "\\([^:%?]+\\)\\([%?][^:]*\\)?\\(:\\|$\\)")))) (and (setq vm-spool-files (getenv "MAIL")) ! (setq vm-spool-files (vm-delete-directory-names ! (list vm-spool-files)))))) *************** *** 119,128 **** ! The second form is used to speak POP over a SSL connection. You must have the stunnel program installed and the variable vm-stunnel-program naming it in order for IMAP over SSL to ! work. HOST is the host name of the POP server ! PORT is the TCP port number to connect to (should normally be 110). USER is the user name sent to the server. PASSWORD is the secret shared by you and the server for --- 121,143 ---- ! The second form is used to speak POP over an SSL connection. You must have the stunnel program installed and the variable vm-stunnel-program naming it in order for IMAP over SSL to ! work. The SSL version of the POP server will not use the ! same port as the non-SSL version. ! ! The third form is used to speak POP over an SSH connection. ! You must have the ssh program installed and the variable ! `vm-ssh-program' must name it in order for IMAP over SSH to ! work. SSH must be able to authenticate without a password, ! which means you must be using either .shosts authentication ! or RSA authentication. HOST is the host name of the POP server ! ! PORT is the TCP port number to connect to. This should ! normally be 110, unless you're using POP over SSL in which ! case the stanard port is 995. ! USER is the user name sent to the server. + PASSWORD is the secret shared by you and the server for *************** *** 157,167 **** ! The second form is used to speak IMAP over a SSL connection. You must have the stunnel program installed and the variable ! vm-stunnel-program naming it in order for IMAP over SSL to work. ! The third form is used to speak IMAP over a SSH connection. You must have the ssh program installed and the variable `vm-ssh-program' must name it in order for IMAP over SSH to ! work. --- 172,183 ---- ! The second form is used to speak IMAP over an SSL connection. You must have the stunnel program installed and the variable ! `vm-stunnel-program' naming it in order for IMAP over SSL to work. ! The third form is used to speak IMAP over an SSH connection. You must have the ssh program installed and the variable `vm-ssh-program' must name it in order for IMAP over SSH to ! work. SSH must be able to authenticate without a password, ! which means you must be using .shosts authentication or RSA. *************** *** 169,171 **** ! PORT is the TCP port number to connect to (should normally be 143). --- 185,189 ---- ! PORT is the TCP port number to connect to. This should ! normally be 143. For IMAP over SSL, the standard port is ! 993. There is no special port for IMAP over SSH. *************** *** 865,866 **** --- 883,916 ---- + (defvar vm-mime-charset-converter-alist nil + "*Alist of MIME charsets and programs that can convert between them. + If VM cannot display a particular character set, it will scan this list to + see if the charset can be converted into a charset that it can display. + + The alist format is + + ( ( START-CHARSET END-CHARSET COMMAND-LINE ) ... ) + + START-CHARSET is a string specifying a MIME charset. + Example \"iso-8859-1\" or \"utf-8\". + + END-CHARSET is a string specifying the charset to which START-CHARSET + will be converted. + + COMMAND-LINE is a string giving a command line to be passed to + the shell. The characters in START-CHARSET will be written to the + standard input of the shell command and VM expects characters + encoded in END-CHARSET to appear at the standard output of the + COMMAND-LINE. COMMAND-LINE is passed to the shell, so you can + use pipelines, shell variables and redirections. + + Example: + + (setq vm-mime-charset-converter-alist + '( + (\"utf-8\" \"iso-2022-jp\" \"iconv -f utf-8 -t iso-2022-jp\") + ) + ) + + The first matching list element will be used.") + (defvar vm-mime-alternative-select-method 'best-internal *************** *** 946,947 **** --- 996,1043 ---- + (defvar vm-mime-use-image-strips t + "*Non-nil means chop an image into horizontal strip for display. + Emacs treats a displayed image as a single large character and + cannot scroll vertically within an image. To work around this + limitation VM can display an image as a series of contiguous + horizontal strips that Emacs' scrolling routines can better + handle. To do this VM needs to have the ImageMagick program + 'convert' installed; `vm-imagemagick-convert-program' must point + to it. + + A nil value means VM should display images without cutting them + into strips.") + + (defun vm-locate-executable-file (name) + (cond ((fboundp 'locate-file) + (locate-file name exec-path nil 1)) + (t + (let (file done (dirs exec-path)) + (while (and dirs (not done)) + (setq file (expand-file-name name (car dirs))) + (if (file-executable-p file) + (setq done t) + (setq dirs (cdr dirs)))) + (and dirs file))))) + + (defvar vm-imagemagick-convert-program (vm-locate-executable-file "convert") + "*Name of ImageMagick 'convert' program. + VM uses this to gather information about images and to slice up + images for display. It may also use this program to convert + between various image types if Emacs can display one type but + not another. Set this to nil and VM will not use the 'convert' + program.") + + (defvar vm-mime-image-type-converter-alist + (if (stringp vm-imagemagick-convert-program) + (let ((x vm-imagemagick-convert-program)) + (list + (list "image" "image/png" (format "%s - png:-" x)) + (list "image" "image/jpeg" (format "%s - jpeg:-" x)) + (list "image" "image/gif" (format "%s - gif:-" x)) + (list "image" "image/tiff" (format "%s - tiff:-" x)) + (list "image" "image/pbm" (format "%s - xbm:-" x)) + (list "image" "image/xpm" (format "%s - xpm:-" x)) + (list "image" "image/xbm" (format "%s - xbm:-" x)) + )))) + (defvar vm-mime-delete-after-saving nil *************** *** 1114,1115 **** --- 1210,1213 ---- ("\\.xls$" . "application/vnd.ms-excel") + ("\\.doc$" . "application/msword") + ("\\.ppt$" . "application/vnd.ms-powerpoint") ) *************** *** 2576,2578 **** ! (defvar vm-url-retrieval-methods '(lynx wget url-w3) "*Non-nil value specifies how VM is permitted to retrieve URLs. --- 2674,2676 ---- ! (defvar vm-url-retrieval-methods '(lynx wget w3m url-w3) "*Non-nil value specifies how VM is permitted to retrieve URLs. *************** *** 2585,2586 **** --- 2683,2685 ---- wget - means VM should to use the wget program. + w3m - means VM should to use the w3m program. url-w3 - means use Emacs-W3's URL retrieval package. *************** *** 3087,3088 **** --- 3186,3191 ---- + (defvar vm-w3m-program "w3m" + "*Name of program to use to run w3m. + This is used to retrieve URLs.") + (defvar vm-lynx-program "lynx" *************** *** 3130,3133 **** ! (defvar vm-ssh-remote-command "sleep 15" ! "*Shell command to run to hold open the SSH connection.") --- 3233,3239 ---- ! (defvar vm-ssh-remote-command "echo ready; sleep 15" ! "*Shell command to run to hold open the SSH connection. ! This command must generate one line of output and then ! sleep long enough for VM to open a port-forwarded connection. ! The default should work on UNIX systems.") *************** *** 3136,3137 **** --- 3242,3244 ---- (and (file-directory-p "/tmp") "/tmp") + (and (file-directory-p "C:\\TEMP") "C:\\TEMP") (and (file-directory-p "C:\\") "C:\\") *************** *** 3337,3338 **** --- 3444,3446 ---- (define-key map "$e" 'vm-mime-reader-map-display-using-external-viewer) + (define-key map "$v" 'vm-mime-reader-map-display-object-as-type) (define-key map "\r" 'vm-mime-run-display-function-at-point) *************** *** 3760,3763 **** "You may give out copies of VM. Type \\[vm-show-copying-restrictions] to see the conditions" ! "VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details" ! "ALL YOUR BASE ARE BELONG TO US")) (defconst vm-startup-message-displayed nil) --- 3868,3870 ---- "You may give out copies of VM. Type \\[vm-show-copying-restrictions] to see the conditions" ! "VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details")) (defconst vm-startup-message-displayed nil) *************** *** 4006,4007 **** --- 4113,4115 ---- (make-variable-buffer-local 'vm-folder-garbage-alist) + (defvar vm-global-garbage-alist nil) (defconst vm-mime-header-list '("MIME-Version:" "Content-")) *************** *** 4037,4038 **** --- 4145,4148 ---- ("koi8-r" koi8-r) + ("ks_c_5601-1987" euc-kr) + ("euc-jp" euc-jp) ;; probably not correct, but probably better than nothing. *************** *** 4134 **** --- 4244,4245 ---- (defvar vm-stunnel-random-data-file nil) + (defvar vm-fsfemacs-cached-scroll-bar-width nil) *** dist/vm-version.el.dist Sun Oct 28 22:13:05 2001 --- vm-version.el Sun Nov 18 23:56:25 2001 *************** *** 4,6 **** ! (defconst vm-version "6.97" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "6.98" "Version number of VM.") *************** *** 99,101 **** (or (and vm-xemacs-p (memq (device-type) '(x mswindows))) ! (and vm-fsfemacs-p window-system (fboundp 'image-type-available-p)))) --- 99,103 ---- (or (and vm-xemacs-p (memq (device-type) '(x mswindows))) ! (and vm-fsfemacs-p window-system ! (or (fboundp 'image-type-available-p) ! (stringp vm-imagemagick-convert-program))))) *************** *** 104,105 **** (image-type-available-p type) ! (featurep type))) --- 106,107 ---- (image-type-available-p type) ! (or (featurep type) (eq type 'xbm)))) *** dist/vm-window.el.dist Wed Nov 29 20:40:33 2000 --- vm-window.el Thu Nov 15 13:59:21 2001 *************** *** 406,410 **** (if (vm-created-this-frame-p delete-me) ! (vm-delete-frame delete-me)) ! (if (eq delete-me start) ! (setq start nil))) (error nil)) --- 406,411 ---- (if (vm-created-this-frame-p delete-me) ! (progn ! (vm-delete-frame delete-me) ! (if (eq delete-me start) ! (setq start nil))))) (error nil))