*** dist/README.dist Fri Aug 27 16:50:44 1999 --- README Tue Nov 21 21:42:24 2000 *************** *** 2,4 **** ! 0) Look at the Makefile and change the values of EMACS, INFODIR, LISPDIR, and PIXMAPDIR. If they are not right for your system, --- 2,4 ---- ! 0) Look at the Makefile and review the values of EMACS, INFODIR, LISPDIR, and PIXMAPDIR. If they are not right for your system, *************** *** 6,20 **** ! 1) Do one of these: ! `make'. `make vm.info' to build the Info online help document. `make all' to make everything. ! Ignore the byte compiler warnings. ! 2) Put all the .elc files into a Lisp directory that Emacs knows ! about. (see load-path). ! 3) If you're using XEmacs 19.14 and you want toolbar support, ! make a directory called `vm' in the XEmacs `etc' directory. ! Copy the files in pixmaps directory into the directory you ! just created. VM will look for the pixmaps there by default. --- 6,25 ---- ! 1) Your build options: ! `make' to build a usable VM. `make vm.info' to build the Info online help document. + 'make utils' to compile the external Quoted-Printable and + BASE64 encoders and decoders. `make all' to make everything. ! If there are byte compiler warnings, ignore them. They ! probably can't be avoided with code that is run on multipe ! Emacs versions. ! 2) Put all the .elc files into a Lisp directory that is in your ! Emacs load-path. If you've already set LISPDIR to this ! directory, just `make install'. ! 3) If you're using XEmacs and you want toolbar support, make a ! directory called `vm' in the XEmacs `etc' directory. Copy ! the files in pixmaps directory into the directory you just ! created. VM will look for the pixmaps there by default. *************** *** 23,25 **** variable vm-toolbar-pixmap-directory at the direrctory where ! you put the files. --- 28,34 ---- variable vm-toolbar-pixmap-directory at the direrctory where ! you put the files. That is ! ! (setq vm-toolbar-pixmap-directory "/path/to/pixmaps") ! ! in your .emacs or .vm file. *** dist/Makefile.dist Tue Nov 14 21:42:27 2000 --- Makefile Wed Nov 22 01:14:38 2000 *************** *** 17,18 **** --- 17,22 ---- + # where the binaries should be go. + # only used if you 'make install-utils' + BINDIR = /usr/local/bin + ############## no user servicable parts beyond this point ################### *************** *** 64,65 **** --- 68,71 ---- + UTILS = qp-decode qp-encode base64-decode base64-encode + vm: vm.elc *************** *** 74,81 **** @echo "building vm.elc (with all modules set to autoload)..." ! @echo "(require 'vm-version)" > vm.elc ! @echo "(require 'vm-startup)" >> vm.elc ! @echo "(require 'vm-vars)" >> vm.elc ! @echo "(require 'vm-autoload)" >> vm.elc ! all: vm.info vm --- 80,90 ---- @echo "building vm.elc (with all modules set to autoload)..." ! @echo "(defun vm-its-such-a-cruel-world ()" > vm.el ! @echo " (require 'vm-version)" >> vm.el ! @echo " (require 'vm-startup)" >> vm.el ! @echo " (require 'vm-vars)" >> vm.el ! @echo " (require 'vm-autoload))" >> vm.el ! @echo "(vm-its-such-a-cruel-world)" >> vm.el ! @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm.el ! all: vm.info vm utils *************** *** 85,86 **** --- 94,109 ---- + utils: $(UTILS) + + qp-decode: qp-decode.c + $(CC) $(CFLAGS) -o qp-decode qp-decode.c + + qp-encode: qp-encode.c + $(CC) $(CFLAGS) -o qp-encode qp-encode.c + + base64-decode: base64-decode.c + $(CC) $(CFLAGS) -o base64-decode base64-decode.c + + base64-encode: base64-encode.c + $(CC) $(CFLAGS) -o base64-encode base64-encode.c + install: all *************** *** 89,93 **** cp pixmaps/*.xpm $(PIXMAPDIR) clean: ! rm -f vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc --- 112,117 ---- cp pixmaps/*.xpm $(PIXMAPDIR) + cp $(UTILS) $(BINDIR) clean: ! rm -f $(UTILS) vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc *** dist/vm-folder.el.dist Tue Nov 14 21:42:27 2000 --- vm-folder.el Thu Nov 23 08:55:39 2000 *************** *** 3749,3751 **** (vm-sort-messages "thread"))) ! (if (and vm-arrived-message-hook new-messages --- 3749,3751 ---- (vm-sort-messages "thread"))) ! (if (and (or vm-arrived-message-hook vm-arrived-messages-hook) new-messages *************** *** 3767,3773 **** (vm-update-summary-and-mode-line) ! (while new-messages ! (vm-run-message-hook (car new-messages) 'vm-arrived-message-hook) ! (setq new-messages (cdr new-messages))))) ! (vm-update-summary-and-mode-line) ! (run-hooks 'vm-arrived-messages-hook) (if (and new-messages vm-virtual-buffers) --- 3767,3774 ---- (vm-update-summary-and-mode-line) ! (if vm-arrived-message-hook ! (while new-messages ! (vm-run-message-hook (car new-messages) ! 'vm-arrived-message-hook) ! (setq new-messages (cdr new-messages)))) ! (run-hooks 'vm-arrived-messages-hook))) (if (and new-messages vm-virtual-buffers) *** dist/vm-macro.el.dist Thu Nov 16 00:07:05 2000 --- vm-macro.el Wed Nov 22 01:29:08 2000 *************** *** 118,120 **** (vm-xemacs-file-coding-p 'binary) ! (t 'no-conversion))) --- 118,120 ---- (vm-xemacs-file-coding-p 'binary) ! (t 'raw-text))) *************** *** 123,124 **** (vm-xemacs-file-coding-p 'no-conversion) ! (t 'raw-text))) --- 123,124 ---- (vm-xemacs-file-coding-p 'no-conversion) ! (t 'no-conversion))) *** dist/vm-mime.el.dist Thu Nov 16 00:07:05 2000 --- vm-mime.el Wed Nov 22 14:58:45 2000 *************** *** 1212,1220 **** (cond ((vm-mime-types-match "image/jpeg" type) ! (and (featurep 'jpeg) (vm-images-possible-here-p))) ((vm-mime-types-match "image/gif" type) ! (and (featurep 'gif) (vm-images-possible-here-p))) ((vm-mime-types-match "image/png" type) ! (and (featurep 'png) (vm-images-possible-here-p))) ((vm-mime-types-match "image/tiff" type) ! (and (featurep 'tiff) (vm-images-possible-here-p))) ((vm-mime-types-match "audio/basic" type) --- 1212,1220 ---- (cond ((vm-mime-types-match "image/jpeg" type) ! (and (vm-image-type-available-p 'jpeg) (vm-images-possible-here-p))) ((vm-mime-types-match "image/gif" type) ! (and (vm-image-type-available-p 'gif) (vm-images-possible-here-p))) ((vm-mime-types-match "image/png" type) ! (and (vm-image-type-available-p 'png) (vm-images-possible-here-p))) ((vm-mime-types-match "image/tiff" type) ! (and (vm-image-type-available-p 'tiff) (vm-images-possible-here-p))) ((vm-mime-types-match "audio/basic" type) *************** *** 1674,1708 **** (cond ((or (null tempfile) (null (file-exists-p tempfile))) ! (vm-with-unibyte-buffer ! (setq start (point)) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq suffix (vm-mime-extract-filename-suffix layout)) ! (setq tempfile (vm-make-tempfile-name suffix)) ! (let ((buffer-file-type buffer-file-type) ! (selective-display nil) ! buffer-file-coding-system) ! ;; Tell DOS/Windows NT whether the file is binary ! (setq buffer-file-type ! (not (vm-mime-text-type-layout-p layout))) ! ;; Tell XEmacs/MULE not to mess with the bits unless ! ;; this is a text type. ! (if (fboundp 'set-buffer-file-coding-system) ! (if (vm-mime-text-type-layout-p layout) ! (set-buffer-file-coding-system ! (vm-line-ending-coding-system) nil) ! (set-buffer-file-coding-system ! (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)))))) --- 1674,1707 ---- (cond ((or (null tempfile) (null (file-exists-p tempfile))) ! (setq start (point)) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq suffix (vm-mime-extract-filename-suffix layout)) ! (setq tempfile (vm-make-tempfile-name suffix)) ! (let ((buffer-file-type buffer-file-type) ! (selective-display nil) ! buffer-file-coding-system) ! ;; Tell DOS/Windows NT whether the file is binary ! (setq buffer-file-type ! (not (vm-mime-text-type-layout-p layout))) ! ;; Tell XEmacs/MULE not to mess with the bits unless ! ;; this is a text type. ! (if (fboundp 'set-buffer-file-coding-system) ! (if (vm-mime-text-type-layout-p layout) ! (set-buffer-file-coding-system ! (vm-line-ending-coding-system) nil) ! (set-buffer-file-coding-system ! (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)))))) *************** *** 1912,1916 **** (buffer-read-only nil)) ! (vm-with-unibyte-buffer ! (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout))) ! (insert ?\n)) (save-excursion --- 1911,1914 ---- (buffer-read-only nil)) ! (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout))) ! (insert ?\n) (save-excursion *************** *** 1975,1977 **** (setq work-buffer ! (vm-make-work-buffer (format "*%s mime object*" --- 1973,1975 ---- (setq work-buffer ! (vm-make-multibyte-work-buffer (format "*%s mime object*" *************** *** 1979,1980 **** --- 1977,1981 ---- (set-buffer work-buffer) + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system + (vm-binary-coding-system) t)) (cond *************** *** 2258,2262 **** ! (defun vm-mime-display-internal-image-xxxx (layout feature name) (if (and (vm-images-possible-here-p) ! (featurep feature)) (let ((start (point-marker)) end tempfile g e --- 2259,2270 ---- ! (defun vm-mime-display-internal-image-xxxx (layout image-type name) ! (cond ! (vm-xemacs-p ! (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)))) ! ! (defun vm-mime-display-internal-image-xemacs-xxxx (layout image-type name) (if (and (vm-images-possible-here-p) ! (vm-image-type-available-p image-type)) (let ((start (point-marker)) end tempfile g e *************** *** 2267,2309 **** nil ! (vm-with-unibyte-buffer ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (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 ! ;; we don't need to set it here. ! (write-region start end tempfile nil 0) ! (message "Creating %s glyph..." name) ! (setq g (make-glyph ! (list ! (cons (list 'win) ! (vector feature ':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)) --- 2275,2316 ---- nil ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (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 ! ;; we don't need to set it here. ! (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)) *************** *** 2315,2316 **** --- 2322,2358 ---- + (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 (point-marker)) end tempfile + (selective-display nil) + (buffer-read-only nil)) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (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 + ;; we don't need to set it here. + (write-region start end tempfile nil 0) + ;; keep one char so we can attach the image to it. + (delete-region start (1- end)) + (put-text-property (1- end) end 'display + (list 'image + ':type image-type + ':file tempfile)) + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons tempfile 'delete-file) + vm-folder-garbage-alist))) + (if (not (save-excursion (goto-char start) (bolp))) + (insert-char ?\n 2) + (insert-char ?\n 1)) + t ) + nil )) + (defun vm-mime-display-internal-image/gif (layout) *************** *** 2341,2366 **** nil ! (vm-with-unibyte-buffer ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (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 ! ;; we don't need to set it here. ! (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))) (start-itimer "audioplayer" --- 2383,2407 ---- nil ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (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 ! ;; we don't need to set it here. ! (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)) (start-itimer "audioplayer" *************** *** 2462,2466 **** ! (defun vm-mime-set-extent-glyph-for-type (e type) (if (and (vm-images-possible-here-p) ! (featurep 'xpm) (> (device-bitplanes) 7)) --- 2503,2514 ---- ! (defun vm-mime-set-image-stamp-for-type (e type) ! (cond ! (vm-xemacs-p ! (vm-mime-xemacs-set-image-stamp-for-type e type)) ! (vm-fsfemacs-p ! (vm-mime-fsfemacs-set-image-stamp-for-type e type)))) ! ! (defun vm-mime-xemacs-set-image-stamp-for-type (e type) (if (and (vm-images-possible-here-p) ! (vm-image-type-available-p 'xpm) (> (device-bitplanes) 7)) *************** *** 2497,2498 **** --- 2545,2590 ---- + (defun vm-mime-fsfemacs-set-image-stamp-for-type (e type) + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p 'xpm)) + (let ((dir vm-image-directory) + ;; no device-bitplanes under FSF Emacs, so assume we + ;; have a >=16-bit display + (colorful t) + (tuples + '(("text" "document-simple.xpm" "document-colorful.xpm") + ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm") + ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm") + ("video" "film-simple.xpm" "film-colorful.xpm") + ("message" "message-simple.xpm" "message-colorful.xpm") + ("application" "gear-simple.xpm" "gear-colorful.xpm") + ("multipart" "stuffed_box-simple.xpm" + "stuffed_box-colorful.xpm"))) + file) + (setq file (catch 'done + (while tuples + (if (vm-mime-types-match (car (car tuples)) type) + (throw 'done (car tuples)) + (setq tuples (cdr tuples)))) + nil) + file (and file (if colorful (nth 2 file) (nth 1 file))) + file (and file (expand-file-name file dir))) + (if file + (save-excursion + (let ((buffer-read-only nil)) + (set-buffer (overlay-buffer e)) + (goto-char (overlay-start e)) + (insert "x") + (move-overlay e (1- (point)) (overlay-end e)) + (put-text-property (1- (point)) (point) 'display + (list 'image + ':ascent 80 + ':color-symbols + (list + (cons "background" + (cdr (assq + 'background-color + (frame-parameters))))) + ':type 'xpm + ':file file)))))))) + (defun vm-mime-insert-button (caption action layout disposable) *************** *** 2519,2521 **** (set-extent-property e 'end-open t)) ! (vm-mime-set-extent-glyph-for-type e (car (vm-mm-layout-type layout))) ;; for emacs --- 2611,2613 ---- (set-extent-property e 'end-open t)) ! (vm-mime-set-image-stamp-for-type e (car (vm-mm-layout-type layout))) ;; for emacs *************** *** 2541,2543 **** ! (defun vm-mime-send-body-to-file (layout &optional default-filename) (if (not (vectorp layout)) --- 2633,2635 ---- ! (defun vm-mime-send-body-to-file (layout &optional default-filename file) (if (not (vectorp layout)) *************** *** 2555,2571 **** file) ! (while (not done) ! (setq file ! (read-file-name ! (if default-filename ! (format "Write MIME body to file (default %s): " ! default-filename) ! "Write MIME body to file: ") ! dir default-filename) ! file (expand-file-name file dir)) ! (if (not (file-directory-p file)) ! (setq done t) ! (if (null default-filename) ! (error "%s is a directory" file)) ! (setq file (expand-file-name default-filename file) ! done t))) (save-excursion --- 2647,2665 ---- file) ! (if file ! nil ! (while (not done) ! (setq file ! (read-file-name ! (if default-filename ! (format "Write MIME body to file (default %s): " ! default-filename) ! "Write MIME body to file: ") ! dir default-filename) ! file (expand-file-name file dir)) ! (if (not (file-directory-p file)) ! (setq done t) ! (if (null default-filename) ! (error "%s is a directory" file)) ! (setq file (expand-file-name default-filename file) ! done t)))) (save-excursion *************** *** 2586,2590 **** (set-buffer-file-coding-system (vm-binary-coding-system) t))) ! (vm-with-unibyte-buffer ! (vm-mime-insert-mime-body layout) ! (vm-mime-transfer-decode-region layout (point-min) (point-max))) (or (not (file-exists-p file)) --- 2680,2683 ---- (set-buffer-file-coding-system (vm-binary-coding-system) t))) ! (vm-mime-insert-mime-body layout) ! (vm-mime-transfer-decode-region layout (point-min) (point-max)) (or (not (file-exists-p file)) *************** *** 2926,2928 **** ! (defun vm-mime-attach-file (file type &optional charset description) "Attach a file to a VM composition buffer to be sent along with the message. --- 3019,3022 ---- ! (defun vm-mime-attach-file (file type &optional charset description ! no-suggested-filename) "Attach a file to a VM composition buffer to be sent along with the message. *************** *** 2941,2943 **** should be a one line description of the file. Nil means include ! no description. --- 3035,3039 ---- should be a one line description of the file. Nil means include ! no description. Optional fifth argument NO-SUGGESTED-FILENAME non-nil ! means that VM should not add a filename to the Content-Disposition ! header created for the object. *************** *** 2974,2976 **** (setq description nil)) ! (list file type charset description))) (if (null vm-send-using-mime) --- 3070,3072 ---- (setq description nil)) ! (list file type charset description nil))) (if (null vm-send-using-mime) *************** *** 3181,3183 **** ! (defun vm-mime-attach-object (object type params description mimed) (if (not (eq major-mode 'mail-mode)) --- 3277,3280 ---- ! (defun vm-mime-attach-object (object type params description mimed ! &optional no-suggested-filename) (if (not (eq major-mode 'mail-mode)) *************** *** 3200,3206 **** (setq disposition (list "inline"))) ! (setq disposition (nconc disposition ! (list ! (concat "filename=\"" ! (file-name-nondirectory object) ! "\""))))) (setq disposition (list "unspecified"))) --- 3297,3304 ---- (setq disposition (list "inline"))) ! (if (not no-suggested-filename) ! (setq disposition (nconc disposition ! (list ! (concat "filename=\"" ! (file-name-nondirectory object) ! "\"")))))) (setq disposition (list "unspecified"))) *************** *** 3222,3224 **** (setq e (make-extent start end)) ! (vm-mime-set-extent-glyph-for-type e (or type "text/plain")) (set-extent-property e 'start-open t) --- 3320,3322 ---- (setq e (make-extent start end)) ! (vm-mime-set-image-stamp-for-type e (or type "text/plain")) (set-extent-property e 'start-open t) *************** *** 3915,4279 **** (error "Message is already MIME encoded.")) ! (vm-with-unibyte-buffer ! (let ((8bit nil) ! (just-one nil) ! (boundary-positions nil) ! (enriched (and (boundp 'enriched-mode) enriched-mode)) ! already-mimed layout o o-list boundary ! type encoding charset params description disposition object ! opoint-min) ! (mail-text) ! (setq o-list (vm-mime-fake-attachment-overlays (point) (point-max)) ! o-list (vm-delete (function ! (lambda (o) ! (overlay-get o 'vm-mime-object))) ! o-list t) ! o-list (sort o-list (function ! (lambda (e1 e2) ! (< (overlay-end e1) ! (overlay-end e2)))))) ! ;; If there's just one attachment and no other readable ! ;; text in the buffer then make the message type just be ! ;; the attachment type rather than sending a multipart ! ;; message with one attachment ! (setq just-one (and (= (length o-list) 1) ! (looking-at "[ \t\n]*") ! (= (match-end 0) ! (overlay-start (car o-list))) ! (save-excursion ! (goto-char (overlay-end (car o-list))) ! (looking-at "[ \t\n]*\\'")))) ! (if (null o-list) ! (progn ! (narrow-to-region (point) (point-max)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (enriched-encode (point-min) (point-max)))) ! (setq charset (vm-determine-proper-charset (point-min) ! (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point-min) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point-min) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point-min) ! (point-max) ! t)) ! (widen) ! (vm-remove-mail-mode-header-separator) ! (goto-char (point-min)) ! (vm-reorder-message-headers ! nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)") ! (insert "MIME-Version: 1.0\n") ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n") ! (vm-add-mail-mode-header-separator)) ! (while o-list ! (setq o (car o-list)) ! (if (or just-one ! (save-excursion ! (eq (overlay-start o) ! (re-search-forward "[ \t\n]*" (overlay-start o) t)))) ! (delete-region (point) (overlay-start o)) ! (narrow-to-region (point) (overlay-start o)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (save-excursion ! ;; insert/delete trick needed to avoid ! ;; enriched-mode tags from seeping into the ! ;; attachment overlays. I really wish ! ;; front-advance / rear-advance overlay ! ;; endpoint properties actually worked. ! (goto-char (point-max)) ! (insert-before-markers "\n") ! (enriched-encode (point-min) (1- (point))) ! (goto-char (point-max)) ! (delete-char -1)))) ! (setq charset (vm-determine-proper-charset (point-min) (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point-min) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point-min) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point-min) ! (point-max) ! t) ! description (vm-mime-text-description (point-min) ! (point-max))) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (if description (insert "Content-Description: " description "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n\n") ! (widen)) ! (goto-char (overlay-start o)) ! (narrow-to-region (point) (point)) ! (setq object (overlay-get o 'vm-mime-object)) ! ;; insert the object ! (cond ((bufferp object) ! ;; as of FSF Emacs 19.34, even with the hooks ! ;; we've attached to the attachment overlays, ! ;; text STILL can be inserted into them when ! ;; font-lock is enabled. Explaining why is ! ;; beyond the scope of this comment and I ! ;; don't know the answer anyway. This works ! ;; to prevent it. ! (insert-before-markers " ") ! (forward-char -1) ! (insert-buffer-substring object) (delete-char 1)) ! ((stringp object) ! (insert-before-markers " ") ! (forward-char -1) ! (let ((coding-system-for-read ! (if (vm-mime-text-type-p ! (overlay-get o 'vm-mime-type)) ! (vm-line-ending-coding-system) ! (vm-binary-coding-system))) ! ;; no transformations! ! (format-alist nil) ! ;; no decompression! ! (jka-compr-compression-info-list nil) ! ;; don't let buffer-file-coding-system be ! ;; changed by insert-file-contents. The ! ;; value we bind to it to here isn't ! ;; important. ! (buffer-file-coding-system (vm-binary-coding-system)) ! ;; For NTEmacs 19: need to do this to make ! ;; sure CRs aren't eaten. ! (file-name-buffer-file-type-alist '(("." . t)))) ! (insert-file-contents object)) ! (goto-char (point-max)) ! (delete-char -1))) ! ;; gather information about the object from the extent. ! (if (setq already-mimed (overlay-get o 'vm-mime-encoded)) ! (setq layout (vm-mime-parse-entity ! nil (list "text/plain" "charset=us-ascii") ! "7bit") ! type (or (overlay-get o 'vm-mime-type) ! (car (vm-mm-layout-type layout))) ! params (or (overlay-get o 'vm-mime-parameters) ! (cdr (vm-mm-layout-qtype layout))) ! description (overlay-get o 'vm-mime-description) ! disposition ! (if (not ! (equal ! (car (overlay-get o 'vm-mime-disposition)) ! "unspecified")) ! (overlay-get o 'vm-mime-disposition) ! (vm-mm-layout-qdisposition layout))) ! (setq type (overlay-get o 'vm-mime-type) ! params (overlay-get o 'vm-mime-parameters) ! description (overlay-get o 'vm-mime-description) ! disposition ! (if (not (equal ! (car (overlay-get o 'vm-mime-disposition)) ! "unspecified")) ! (overlay-get o 'vm-mime-disposition) ! nil))) ! (cond ((vm-mime-types-match "text" type) ! (setq encoding ! (vm-determine-proper-content-transfer-encoding ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max)) ! encoding (vm-mime-transfer-encode-region ! encoding ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max) ! t)) ! (setq 8bit (or 8bit (equal encoding "8bit")))) ! ((vm-mime-composite-type-p type) ! (setq opoint-min (point-min)) ! (if (not already-mimed) ! (progn ! (goto-char (point-min)) ! (insert "Content-Type: " type "\n") ! ;; vm-mime-trasnfer-encode-layout will replace ! ;; this if the transfer encoding changes. ! (insert "Content-Transfer-Encoding: 7bit\n\n") ! (setq already-mimed t))) ! (setq layout (vm-mime-parse-entity ! nil (list "text/plain" "charset=us-ascii") ! "7bit")) ! (setq encoding (vm-mime-transfer-encode-layout layout)) ! (setq 8bit (or 8bit (equal encoding "8bit"))) ! (goto-char (point-max)) ! (widen) ! (narrow-to-region opoint-min (point))) ! (t ! (vm-mime-base64-encode-region ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max)) ! (setq encoding "base64"))) ! (if just-one ! nil ! (goto-char (point-min)) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if (not already-mimed) ! nil ! ;; trim headers ! (vm-reorder-message-headers nil '("Content-ID:") nil) ! ;; remove header/text separator ! (goto-char (1- (vm-mm-layout-body-start layout))) ! (if (looking-at "\n") ! (delete-char 1))) ! (insert "Content-Type: " type) ! (if params ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity params "; ") "\n") ! (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) ! (insert "\n")) ! (and description ! (insert "Content-Description: " description "\n")) ! (if disposition ! (progn ! (insert "Content-Disposition: " (car disposition)) ! (if (cdr disposition) ! (insert ";\n\t" (mapconcat 'identity ! (cdr disposition) ! ";\n\t"))) ! (insert "\n"))) ! (insert "Content-Transfer-Encoding: " encoding "\n\n")) ! (goto-char (point-max)) ! (widen) ! (save-excursion ! (goto-char (overlay-start o)) ! (vm-assert (looking-at "\\[ATTACHMENT"))) ! (delete-region (overlay-start o) ! (overlay-end o)) ! (delete-overlay o) ! (if (looking-at "\n") ! (delete-char 1)) ! (setq o-list (cdr o-list))) ! ;; handle the remaining chunk of text after the last ! ;; extent, if any. ! (if (or just-one (looking-at "[ \t\n]*\\'")) ! (delete-region (point) (point-max)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (enriched-encode (point) (point-max)))) ! (setq charset (vm-determine-proper-charset (point) ! (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point) ! (point-max) ! t) ! description (vm-mime-text-description (point) (point-max))) ! (setq 8bit (or 8bit (equal encoding "8bit"))) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (if description ! (insert "Content-Description: " description "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n\n") ! (goto-char (point-max))) ! (setq boundary (vm-mime-make-multipart-boundary)) ! (mail-text) ! (while (re-search-forward (concat "^--" ! (regexp-quote boundary) ! "\\(--\\)?$") ! nil t) ! (setq boundary (vm-mime-make-multipart-boundary)) ! (mail-text)) ! (goto-char (point-max)) ! (or just-one (insert "\n--" boundary "--\n")) ! (while boundary-positions ! (goto-char (car boundary-positions)) ! (insert "\n--" boundary "\n") ! (setq boundary-positions (cdr boundary-positions))) ! (if (and just-one already-mimed) ! (progn ! (goto-char (vm-mm-layout-header-start layout)) ! ;; trim headers ! (vm-reorder-message-headers nil '("Content-ID:") nil) ! ;; remove header/text separator ! (goto-char (vm-mm-layout-header-end layout)) ! (if (looking-at "\n") ! (delete-char 1)) ! ;; copy remainder to enclosing entity's header section ! (goto-char (point-max)) ! (insert-buffer-substring (current-buffer) ! (vm-mm-layout-header-start layout) ! (vm-mm-layout-body-start layout)) ! (delete-region (vm-mm-layout-header-start layout) ! (vm-mm-layout-body-start layout)))) ! (goto-char (point-min)) ! (vm-remove-mail-mode-header-separator) ! (vm-reorder-message-headers ! nil nil "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") ! (vm-add-mail-mode-header-separator) ! (insert "MIME-Version: 1.0\n") ! (if (not just-one) ! (insert (if vm-mime-avoid-folding-content-type ! "Content-Type: multipart/mixed; boundary=\"" ! "Content-Type: multipart/mixed;\n\tboundary=\"") ! boundary "\"\n") ! (insert "Content-Type: " type) ! (if params ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity params "; ") "\n") ! (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) ! (insert "\n"))) ! (if (and just-one description) ! (insert "Content-Description: " description "\n")) ! (if (and just-one disposition) ! (progn ! (insert "Content-Disposition: " (car disposition)) ! (if (cdr disposition) ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity (cdr disposition) "; ") ! "\n") ! (insert ";\n\t" (mapconcat 'identity (cdr disposition) ! ";\n\t") "\n")) ! (insert "\n")))) ! (if just-one ! (insert "Content-Transfer-Encoding: " encoding "\n") ! (if 8bit ! (insert "Content-Transfer-Encoding: 8bit\n") ! (insert "Content-Transfer-Encoding: 7bit\n")))))))) --- 4013,4376 ---- (error "Message is already MIME encoded.")) ! (let ((8bit nil) ! (just-one nil) ! (boundary-positions nil) ! (enriched (and (boundp 'enriched-mode) enriched-mode)) ! already-mimed layout o o-list boundary ! type encoding charset params description disposition object ! opoint-min) ! (mail-text) ! (setq o-list (vm-mime-fake-attachment-overlays (point) (point-max)) ! o-list (vm-delete (function ! (lambda (o) ! (overlay-get o 'vm-mime-object))) ! o-list t) ! o-list (sort o-list (function ! (lambda (e1 e2) ! (< (overlay-end e1) ! (overlay-end e2)))))) ! ;; If there's just one attachment and no other readable ! ;; text in the buffer then make the message type just be ! ;; the attachment type rather than sending a multipart ! ;; message with one attachment ! (setq just-one (and (= (length o-list) 1) ! (looking-at "[ \t\n]*") ! (= (match-end 0) ! (overlay-start (car o-list))) ! (save-excursion ! (goto-char (overlay-end (car o-list))) ! (looking-at "[ \t\n]*\\'")))) ! (if (null o-list) ! (progn ! (narrow-to-region (point) (point-max)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (enriched-encode (point-min) (point-max)))) ! (setq charset (vm-determine-proper-charset (point-min) ! (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point-min) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point-min) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point-min) ! (point-max) ! t)) ! (widen) ! (vm-remove-mail-mode-header-separator) ! (goto-char (point-min)) ! (vm-reorder-message-headers ! nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)") ! (insert "MIME-Version: 1.0\n") ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n") ! (vm-add-mail-mode-header-separator)) ! (while o-list ! (setq o (car o-list)) ! (if (or just-one ! (save-excursion ! (eq (overlay-start o) ! (re-search-forward "[ \t\n]*" (overlay-start o) t)))) ! (delete-region (point) (overlay-start o)) ! (narrow-to-region (point) (overlay-start o)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (save-excursion ! ;; insert/delete trick needed to avoid ! ;; enriched-mode tags from seeping into the ! ;; attachment overlays. I really wish ! ;; front-advance / rear-advance overlay ! ;; endpoint properties actually worked. ! (goto-char (point-max)) ! (insert-before-markers "\n") ! (enriched-encode (point-min) (1- (point))) ! (goto-char (point-max)) ! (delete-char -1)))) ! (setq charset (vm-determine-proper-charset (point-min) ! (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point-min) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point-min) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point-min) ! (point-max) ! t) ! description (vm-mime-text-description (point-min) (point-max))) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (if description ! (insert "Content-Description: " description "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n\n") ! (widen)) ! (goto-char (overlay-start o)) ! (narrow-to-region (point) (point)) ! (setq object (overlay-get o 'vm-mime-object)) ! ;; insert the object ! (cond ((bufferp object) ! ;; as of FSF Emacs 19.34, even with the hooks ! ;; we've attached to the attachment overlays, ! ;; text STILL can be inserted into them when ! ;; font-lock is enabled. Explaining why is ! ;; beyond the scope of this comment and I ! ;; don't know the answer anyway. This works ! ;; to prevent it. ! (insert-before-markers " ") ! (forward-char -1) ! (insert-buffer-substring object) ! (delete-char 1)) ! ((stringp object) ! (insert-before-markers " ") ! (forward-char -1) ! (let ((coding-system-for-read ! (if (vm-mime-text-type-p ! (overlay-get o 'vm-mime-type)) ! (vm-line-ending-coding-system) ! (vm-binary-coding-system))) ! ;; no transformations! ! (format-alist nil) ! ;; no decompression! ! (jka-compr-compression-info-list nil) ! ;; don't let buffer-file-coding-system be ! ;; changed by insert-file-contents. The ! ;; value we bind to it to here isn't ! ;; important. ! (buffer-file-coding-system (vm-binary-coding-system)) ! ;; For NTEmacs 19: need to do this to make ! ;; sure CRs aren't eaten. ! (file-name-buffer-file-type-alist '(("." . t)))) ! (insert-file-contents object)) ! (goto-char (point-max)) ! (delete-char -1))) ! ;; gather information about the object from the extent. ! (if (setq already-mimed (overlay-get o 'vm-mime-encoded)) ! (setq layout (vm-mime-parse-entity ! nil (list "text/plain" "charset=us-ascii") ! "7bit") ! type (or (overlay-get o 'vm-mime-type) ! (car (vm-mm-layout-type layout))) ! params (or (overlay-get o 'vm-mime-parameters) ! (cdr (vm-mm-layout-qtype layout))) ! description (overlay-get o 'vm-mime-description) ! disposition ! (if (not ! (equal ! (car (overlay-get o 'vm-mime-disposition)) ! "unspecified")) ! (overlay-get o 'vm-mime-disposition) ! (vm-mm-layout-qdisposition layout))) ! (setq type (overlay-get o 'vm-mime-type) ! params (overlay-get o 'vm-mime-parameters) ! description (overlay-get o 'vm-mime-description) ! disposition ! (if (not (equal ! (car (overlay-get o 'vm-mime-disposition)) ! "unspecified")) ! (overlay-get o 'vm-mime-disposition) ! nil))) ! (cond ((vm-mime-types-match "text" type) ! (setq encoding ! (vm-determine-proper-content-transfer-encoding ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max)) ! encoding (vm-mime-transfer-encode-region ! encoding ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max) ! t)) ! (setq 8bit (or 8bit (equal encoding "8bit")))) ! ((vm-mime-composite-type-p type) ! (setq opoint-min (point-min)) ! (if (not already-mimed) ! (progn ! (goto-char (point-min)) ! (insert "Content-Type: " type "\n") ! ;; vm-mime-trasnfer-encode-layout will replace ! ;; this if the transfer encoding changes. ! (insert "Content-Transfer-Encoding: 7bit\n\n") ! (setq already-mimed t))) ! (setq layout (vm-mime-parse-entity ! nil (list "text/plain" "charset=us-ascii") ! "7bit")) ! (setq encoding (vm-mime-transfer-encode-layout layout)) ! (setq 8bit (or 8bit (equal encoding "8bit"))) ! (goto-char (point-max)) ! (widen) ! (narrow-to-region opoint-min (point))) ! (t ! (vm-mime-base64-encode-region ! (if already-mimed ! (vm-mm-layout-body-start layout) ! (point-min)) ! (point-max)) ! (setq encoding "base64"))) ! (if just-one ! nil ! (goto-char (point-min)) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if (not already-mimed) ! nil ! ;; trim headers ! (vm-reorder-message-headers nil '("Content-ID:") nil) ! ;; remove header/text separator ! (goto-char (1- (vm-mm-layout-body-start layout))) ! (if (looking-at "\n") ! (delete-char 1))) ! (insert "Content-Type: " type) ! (if params ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity params "; ") "\n") ! (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) ! (insert "\n")) ! (and description (insert "Content-Description: " description "\n")) ! (if disposition ! (progn ! (insert "Content-Disposition: " (car disposition)) ! (if (cdr disposition) ! (insert ";\n\t" (mapconcat 'identity ! (cdr disposition) ! ";\n\t"))) ! (insert "\n"))) ! (insert "Content-Transfer-Encoding: " encoding "\n\n")) ! (goto-char (point-max)) ! (widen) ! (save-excursion ! (goto-char (overlay-start o)) ! (vm-assert (looking-at "\\[ATTACHMENT"))) ! (delete-region (overlay-start o) ! (overlay-end o)) ! (delete-overlay o) ! (if (looking-at "\n") ! (delete-char 1)) ! (setq o-list (cdr o-list))) ! ;; handle the remaining chunk of text after the last ! ;; extent, if any. ! (if (or just-one (looking-at "[ \t\n]*\\'")) ! (delete-region (point) (point-max)) ! ;; support enriched-mode for text/enriched composition ! (if enriched ! (let ((enriched-initial-annotation "")) ! (enriched-encode (point) (point-max)))) ! (setq charset (vm-determine-proper-charset (point) ! (point-max))) ! (if vm-fsfemacs-mule-p ! (let ((coding-system ! (car (cdr (vm-string-assoc ! charset ! vm-mime-mule-charset-to-coding-alist))))) ! (if (null coding-system) ! (error "Can't find a coding system for charset %s" ! charset) ! (encode-coding-region (point) (point-max) ! coding-system)))) ! (setq encoding (vm-determine-proper-content-transfer-encoding ! (point) ! (point-max)) ! encoding (vm-mime-transfer-encode-region encoding ! (point) ! (point-max) ! t) ! description (vm-mime-text-description (point) (point-max))) ! (setq 8bit (or 8bit (equal encoding "8bit"))) ! (setq boundary-positions (cons (point-marker) boundary-positions)) ! (if enriched ! (insert "Content-Type: text/enriched; charset=" charset "\n") ! (insert "Content-Type: text/plain; charset=" charset "\n")) ! (if description ! (insert "Content-Description: " description "\n")) ! (insert "Content-Transfer-Encoding: " encoding "\n\n") ! (goto-char (point-max))) ! (setq boundary (vm-mime-make-multipart-boundary)) ! (mail-text) ! (while (re-search-forward (concat "^--" ! (regexp-quote boundary) ! "\\(--\\)?$") ! nil t) ! (setq boundary (vm-mime-make-multipart-boundary)) ! (mail-text)) ! (goto-char (point-max)) ! (or just-one (insert "\n--" boundary "--\n")) ! (while boundary-positions ! (goto-char (car boundary-positions)) ! (insert "\n--" boundary "\n") ! (setq boundary-positions (cdr boundary-positions))) ! (if (and just-one already-mimed) ! (progn ! (goto-char (vm-mm-layout-header-start layout)) ! ;; trim headers ! (vm-reorder-message-headers nil '("Content-ID:") nil) ! ;; remove header/text separator ! (goto-char (vm-mm-layout-header-end layout)) ! (if (looking-at "\n") (delete-char 1)) ! ;; copy remainder to enclosing entity's header section ! (goto-char (point-max)) ! (insert-buffer-substring (current-buffer) ! (vm-mm-layout-header-start layout) ! (vm-mm-layout-body-start layout)) ! (delete-region (vm-mm-layout-header-start layout) ! (vm-mm-layout-body-start layout)))) ! (goto-char (point-min)) ! (vm-remove-mail-mode-header-separator) ! (vm-reorder-message-headers ! nil nil "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") ! (vm-add-mail-mode-header-separator) ! (insert "MIME-Version: 1.0\n") ! (if (not just-one) ! (insert (if vm-mime-avoid-folding-content-type ! "Content-Type: multipart/mixed; boundary=\"" ! "Content-Type: multipart/mixed;\n\tboundary=\"") ! boundary "\"\n") ! (insert "Content-Type: " type) ! (if params ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity params "; ") "\n") ! (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) ! (insert "\n"))) ! (if (and just-one description) ! (insert "Content-Description: " description "\n")) ! (if (and just-one disposition) ! (progn ! (insert "Content-Disposition: " (car disposition)) ! (if (cdr disposition) ! (if vm-mime-avoid-folding-content-type ! (insert "; " (mapconcat 'identity (cdr disposition) "; ") ! "\n") ! (insert ";\n\t" (mapconcat 'identity (cdr disposition) ! ";\n\t") "\n")) ! (insert "\n")))) ! (if just-one ! (insert "Content-Transfer-Encoding: " encoding "\n") ! (if 8bit ! (insert "Content-Transfer-Encoding: 8bit\n") ! (insert "Content-Transfer-Encoding: 7bit\n"))))))) *** dist/vm-minibuf.el.dist Sun Nov 5 22:40:19 2000 --- vm-minibuf.el Wed Nov 22 11:26:09 2000 *************** *** 22,23 **** --- 22,31 ---- (let ((opoint (point)) + ;; In Emacs 21, during a minibuffer read the minibuffer + ;; contains propt as buffer text and that text is read + ;; only. So we can no longer assume that (point-min) is + ;; where the user-entered text starts and we must avoid + ;; modifying that prompt text. Calling + ;; previous-property-change is a kludge but it does the + ;; job. + (point-min (previous-property-change (point) nil (point-min))) trimmed-c-list c-list beg end diff word word-prefix-regexp completion) *************** *** 34,36 **** (if (not vm-completion-auto-space) ! (setq beg (point-min)) (skip-chars-backward "^ \t\n") --- 42,44 ---- (if (not vm-completion-auto-space) ! (setq beg point-min) (skip-chars-backward "^ \t\n") *** dist/vm-misc.el.dist Thu Nov 16 00:07:05 2000 --- vm-misc.el Thu Nov 16 10:13:51 2000 *************** *** 571,572 **** --- 571,586 ---- + (defun vm-extent-at (pos &optional object property) + (if (fboundp 'extent-at) + (extent-at pos object property) + (let ((o-list (overlays-at pos)) + (o nil)) + (if (null property) + (car o-list) + (while o-list + (if (overlay-get (car o-list) property) + (setq o (car o-list) + o-list nil) + (setq o-list (cdr o-list)))) + o )))) + (defun vm-copy-extent (e) *** dist/vm-page.el.dist Tue Nov 14 21:42:27 2000 --- vm-page.el Tue Nov 21 10:55:22 2000 *************** *** 599,600 **** --- 599,601 ---- vm-mime-decode-for-preview + vm-preview-lines (not (equal vm-preview-lines 0)) *************** *** 609,614 **** ;; messages. ! (let ((vm-auto-displayed-mime-content-types ! '("text" "multipart" "message")) ! (vm-auto-displayed-mime-content-type-exceptions ! '("message/external-body")) (vm-mime-external-content-types-alist nil)) --- 610,613 ---- ;; 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)) *************** *** 797,805 **** '(vm-beginning-of-message reading-message)) ! (let ((osw (selected-window))) ! (unwind-protect ! (progn ! (select-window (vm-get-visible-buffer-window (current-buffer))) ! (goto-char (point-min))) ! (if (not (eq osw (selected-window))) ! (select-window osw)))) (if vm-honor-page-delimiters --- 796,805 ---- '(vm-beginning-of-message reading-message)) ! (vm-save-buffer-excursion ! (let ((osw (selected-window))) ! (unwind-protect ! (progn ! (select-window (vm-get-visible-buffer-window (current-buffer))) ! (goto-char (point-min))) ! (if (not (eq osw (selected-window))) ! (select-window osw))))) (if vm-honor-page-delimiters *************** *** 825,834 **** '(vm-end-of-message reading-message)) ! (let ((osw (selected-window))) ! (unwind-protect ! (progn ! (select-window (vm-get-visible-buffer-window (current-buffer))) ! (goto-char (point-max))) ! (if (not (eq osw (selected-window))) ! (select-window osw)))) (if vm-honor-page-delimiters (vm-narrow-to-page))) --- 825,926 ---- '(vm-end-of-message reading-message)) ! (vm-save-buffer-excursion ! (let ((osw (selected-window))) ! (unwind-protect ! (progn ! (select-window (vm-get-visible-buffer-window (current-buffer))) ! (goto-char (point-max))) ! (if (not (eq osw (selected-window))) ! (select-window osw))))) (if vm-honor-page-delimiters (vm-narrow-to-page))) + + (defun vm-move-to-next-button (count) + "Moves to the next button in the current message. + Prefix argument N means move to the Nth next button. + Negavite N means move to the Nth previous button. + If there is no next button, an error is signaled and point is not moved. + + A button is a highlighted region of text where pressing RETURN + will produce an action. If the message is being previewed, it is + exposed and marked as read." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) + (vm-error-if-folder-empty) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (vm-widen-page) + (vm-display (current-buffer) t '(vm-move-to-next-button) + '(vm-move-to-next-button reading-message)) + (select-window (vm-get-visible-buffer-window (current-buffer))) + (unwind-protect + (vm-move-to-xxxx-button (vm-abs count) (>= count 0)) + (if vm-honor-page-delimiters + (vm-narrow-to-page)))) + + (defun vm-move-to-previous-button (count) + "Moves to the previous button in the current message. + Prefix argument N means move to the Nth previous button. + Negavite N means move to the Nth next button. + If there is no previous button, an error is signaled and point is not moved. + + A button is a highlighted region of text where pressing RETURN + will produce an action. If the message is being previewed, it is + exposed and marked as read." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) + (vm-error-if-folder-empty) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (vm-widen-page) + (vm-display (current-buffer) t '(vm-move-to-previous-button) + '(vm-move-to-previous-button reading-message)) + (select-window (vm-get-visible-buffer-window (current-buffer))) + (unwind-protect + (vm-move-to-xxxx-button (vm-abs count) (< count 0)) + (if vm-honor-page-delimiters + (vm-narrow-to-page)))) + + (defun vm-move-to-xxxx-button (count next) + (let ((old-point (point)) + (endp (if next 'eobp 'bobp)) + (extent-end-position (if vm-xemacs-p + (if next + 'extent-end-position + 'extent-start-position) + (if next + 'overlay-end + 'overlay-start))) + (next-extent-change (if vm-xemacs-p + (if next + 'next-etent-change + 'previous-extent-change) + (if next + 'next-overlay-change + 'previous-overlay-change))) + e) + (setq e (or (vm-extent-at (point) nil 'keymap) + (vm-extent-at (point) nil 'local-map))) + (and e (goto-char (funcall extent-end-position e))) + (while (and (> count 0) (not (funcall endp))) + (goto-char (funcall next-extent-change (+ (point) (if next 0 -1)))) + (setq e (vm-extent-at (point))) + (if e + (if (or (vm-extent-property e 'keymap) + (vm-extent-property e 'local-map)) + (vm-decrement count) + (goto-char (funcall extent-end-position e))) + (goto-char old-point) + (error "No more buttons"))) + (and e (goto-char (vm-extent-start-position e))))) *** dist/vm-pop.el.dist Thu Nov 16 00:07:05 2000 --- vm-pop.el Mon Nov 20 10:23:13 2000 *************** *** 470,473 **** (vm-pop-send-command process "QUIT") ! ;; we don't care about the response ! ;;(vm-pop-read-response process) (if (not keep-buffer) --- 470,477 ---- (vm-pop-send-command process "QUIT") ! ;; Previously we did not read the QUIT response because of ! ;; TCP shutdown problems (under Windows?) that made it better ! ;; if we just closed the connection. Microsoft Exchange ! ;; apparently fails to expunge messages if we shut down the ! ;; connection without reading the QUIT response. ! (vm-pop-read-response process) (if (not keep-buffer) *** dist/vm-save.el.dist Tue Nov 14 21:42:27 2000 --- vm-save.el Fri Nov 17 09:12:39 2000 *************** *** 367,375 **** "Save the current message to a file, without its header section. ! If the file already exists, the message will be appended to it. ! Prefix arg COUNT means save the next COUNT messages. A negative COUNT means ! save the previous COUNT. When invoked on marked messages (via vm-next-command-uses-marks), ! all marked messages in the current folder are saved; other messages are ! ignored. --- 367,375 ---- "Save the current message to a file, without its header section. ! If the file already exists, the message body will be appended to it. ! Prefix arg COUNT means save the next COUNT message bodiess. A ! negative COUNT means save the previous COUNT bodies. When invoked on marked messages (via vm-next-command-uses-marks), ! only the next COUNT marked messages are saved; other intervening ! messages are ignored. *************** *** 411,413 **** (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? "))) --- 411,413 ---- (setq file-buffer (vm-get-file-buffer file)))) ! (if (and (not (memq (vm-get-folder-type file) '(nil unknown))) (not (y-or-n-p "This file looks like a mail folder, append to it anyway? "))) *** dist/vm-startup.el.dist Thu Nov 16 00:07:05 2000 --- vm-startup.el Thu Nov 23 16:00:33 2000 *************** *** 345,347 **** ! This is VM 6.84. --- 345,347 ---- ! This is VM 6.85. *************** *** 368,369 **** --- 368,371 ---- > - go to end of current message + [ - go to previous button + ] - go to next button *************** *** 372,374 **** u - undelete ! k - flag for deletion all messages with same subject as the current message --- 374,376 ---- u - undelete ! k - delete all messages with same subject as the current message *** dist/vm-toolbar.el.dist Tue Nov 14 21:42:27 2000 --- vm-toolbar.el Thu Nov 23 13:58:53 2000 *************** *** 151,154 **** ! (defvar vm-toolbar-delete-icon nil) ! (defvar vm-toolbar-undelete-icon nil) --- 151,157 ---- ! ;; The values of these two are used by the FSF Emacs toolbar ! ;; code. The values don't matter as long as they are different ! ;; (as compared with eq). Under XEmacs these values are ignored ! ;; and overwritten. ! (defvar vm-toolbar-delete-icon t) (defvar vm-toolbar-undelete-icon nil) *************** *** 318,368 **** (defun vm-toolbar-install-toolbar () ! (if (not (and (stringp vm-toolbar-pixmap-directory) ! (file-directory-p vm-toolbar-pixmap-directory))) ! (progn ! (message "Bad toolbar pixmap directory, can't setup toolbar.") ! (sit-for 2)) ! (vm-toolbar-initialize) ! (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon)))) ! (width (+ 4 (glyph-width (car vm-toolbar-help-icon)))) ! (frame (selected-frame)) ! (buffer (current-buffer)) ! (tag-set '(win)) ! (myframe (vm-created-this-frame-p)) ! toolbar ) ! ;; glyph-width and glyph-height return 0 at startup sometimes ! ;; use reasonable values if they fail. ! (if (= width 4) ! (setq width 68)) ! (if (= height 4) ! (setq height 46)) ! ;; honor user setting of vm-toolbar if they are daring enough ! ;; to set it. ! (if vm-toolbar ! (setq toolbar vm-toolbar) ! (setq toolbar (vm-toolbar-make-toolbar-spec) ! vm-toolbar toolbar)) ! (cond ((eq vm-toolbar-orientation 'right) ! (setq vm-toolbar-specifier right-toolbar) ! (if myframe ! (set-specifier right-toolbar toolbar frame tag-set)) ! (set-specifier right-toolbar toolbar buffer) ! (set-specifier right-toolbar-width width frame tag-set)) ! ((eq vm-toolbar-orientation 'left) ! (setq vm-toolbar-specifier left-toolbar) ! (if myframe ! (set-specifier left-toolbar toolbar frame tag-set)) ! (set-specifier left-toolbar toolbar buffer) ! (set-specifier left-toolbar-width width frame tag-set)) ! ((eq vm-toolbar-orientation 'bottom) ! (setq vm-toolbar-specifier bottom-toolbar) ! (if myframe ! (set-specifier bottom-toolbar toolbar frame tag-set)) ! (set-specifier bottom-toolbar toolbar buffer) ! (set-specifier bottom-toolbar-height height frame tag-set)) ! (t ! (setq vm-toolbar-specifier top-toolbar) ! (if myframe ! (set-specifier top-toolbar toolbar frame tag-set)) ! (set-specifier top-toolbar toolbar buffer) ! (set-specifier top-toolbar-height height frame tag-set)))))) --- 321,373 ---- (defun vm-toolbar-install-toolbar () ! (if vm-fsfemacs-p ! (vm-toolbar-fsfemacs-install-toolbar) ! (if (not (and (stringp vm-toolbar-pixmap-directory) ! (file-directory-p vm-toolbar-pixmap-directory))) ! (progn ! (message "Bad toolbar pixmap directory, can't setup toolbar.") ! (sit-for 2)) ! (vm-toolbar-initialize) ! (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon)))) ! (width (+ 4 (glyph-width (car vm-toolbar-help-icon)))) ! (frame (selected-frame)) ! (buffer (current-buffer)) ! (tag-set '(win)) ! (myframe (vm-created-this-frame-p)) ! toolbar ) ! ;; glyph-width and glyph-height return 0 at startup sometimes ! ;; use reasonable values if they fail. ! (if (= width 4) ! (setq width 68)) ! (if (= height 4) ! (setq height 46)) ! ;; honor user setting of vm-toolbar if they are daring enough ! ;; to set it. ! (if vm-toolbar ! (setq toolbar vm-toolbar) ! (setq toolbar (vm-toolbar-make-toolbar-spec) ! vm-toolbar toolbar)) ! (cond ((eq vm-toolbar-orientation 'right) ! (setq vm-toolbar-specifier right-toolbar) ! (if myframe ! (set-specifier right-toolbar toolbar frame tag-set)) ! (set-specifier right-toolbar toolbar buffer) ! (set-specifier right-toolbar-width width frame tag-set)) ! ((eq vm-toolbar-orientation 'left) ! (setq vm-toolbar-specifier left-toolbar) ! (if myframe ! (set-specifier left-toolbar toolbar frame tag-set)) ! (set-specifier left-toolbar toolbar buffer) ! (set-specifier left-toolbar-width width frame tag-set)) ! ((eq vm-toolbar-orientation 'bottom) ! (setq vm-toolbar-specifier bottom-toolbar) ! (if myframe ! (set-specifier bottom-toolbar toolbar frame tag-set)) ! (set-specifier bottom-toolbar toolbar buffer) ! (set-specifier bottom-toolbar-height height frame tag-set)) ! (t ! (setq vm-toolbar-specifier top-toolbar) ! (if myframe ! (set-specifier top-toolbar toolbar frame tag-set)) ! (set-specifier top-toolbar toolbar buffer) ! (set-specifier top-toolbar-height height frame tag-set))))))) *************** *** 410,411 **** --- 415,417 ---- (cond + (vm-fsfemacs-p nil) ((null vm-toolbar-help-icon) *************** *** 477 **** --- 483,660 ---- (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon)) + + (defun vm-toolbar-fsfemacs-install-toolbar () + (let ((button-list (reverse vm-use-toolbar)) + (dir vm-toolbar-pixmap-directory) + (extension (if (image-type-available-p 'xpm) "xpm" "xbm")) + item t-spec sym name images) + (defvar tool-bar-map) + ;; hide the toolbar entries that are in the global keymap so + ;; VM has full control of the toolbar in its buffers. + (if (and (boundp 'tool-bar-map) + (consp tool-bar-map)) + (let ((map (cdr tool-bar-map)) + (v [tool-bar x])) + (while map + (aset v 1 (car (car map))) + (define-key vm-mode-map v 'undefined) + (setq map (cdr map))))) + (while button-list + (setq sym (car button-list)) + (cond ((null sym) + ;; can't do flushright in FSF Emacs + t) + ((integerp sym) + ;; can't do separators in FSF Emacs + t) + ((memq sym '(autofile compose file getmail + mime next previous print quit reply visit)) + (setq t-spec (symbol-value + (intern (format "vm-toolbar-%s-button" sym)))) + (if (eq sym 'mime) + (setq name "mime-colorful") + (setq name (symbol-name sym))) + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar sym) item)) + ((eq sym 'delete/undelete) + (setq t-spec vm-toolbar-delete/undelete-button) + (setq name "delete") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-delete/undelete-icon + vm-toolbar-delete-icon) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'delete) item) + (setq name "undelete") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-delete/undelete-icon + vm-toolbar-undelete-icon) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'undelete) item)) + ((eq sym 'help) + (setq t-spec vm-toolbar-help-button) + (setq name "help") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-helper-command 'vm-help) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-help) item) + (setq name "recover") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-helper-command + 'recover-file) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-recover) item) + (setq name "getmail") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-helper-command + 'vm-get-new-mail) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-getmail) item) + (setq name "mime-colorful") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir)) + (setq item + (list 'menu-item + (aref t-spec 3) + (aref t-spec 1) + ':visible '(eq vm-toolbar-helper-command + 'vm-decode-mime-message) + ':enable (aref t-spec 2) + ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-mime) item))) + (setq button-list (cdr button-list))))) + + (defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir) + (if (string= extension "xpm") + (vector + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-up.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir))) + (vector + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-up.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-xx.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-xx.%s" + name extension) + dir))))) *** dist/vm-vars.el.dist Thu Nov 16 00:07:05 2000 --- vm-vars.el Thu Nov 23 13:10:04 2000 *************** *** 2209,2211 **** ! (defvar vm-folders-summary-directories nil "*List of directories containing folders to be listed in the folders summary. --- 2209,2212 ---- ! (defvar vm-folders-summary-directories ! (list (or vm-folder-directory (file-name-directory vm-primary-inbox))) "*List of directories containing folders to be listed in the folders summary. *************** *** 2993,2995 **** (defvar vm-mode-map ! (let ((map (make-sparse-keymap))) ;; unneeded now that VM buffers all have buffer-read-only == t. --- 2994,2996 ---- (defvar vm-mode-map ! (let ((map (make-keymap))) ;; unneeded now that VM buffers all have buffer-read-only == t. *************** *** 3060,3061 **** --- 3061,3064 ---- (define-key map ">" 'vm-end-of-message) + (define-key map "[" 'vm-move-to-previous-button) + (define-key map "]" 'vm-move-to-next-button) (define-key map "\M-s" 'vm-isearch-forward) *************** *** 3347,3348 **** --- 3350,3352 ---- ("vm-expunge-pop-messages") + ("vm-folders-summarize") ("vm-followup") *************** *** 3386,3387 **** --- 3390,3393 ---- ("vm-move-message-forward-physically") + ("vm-move-to-previous-button") + ("vm-move-to-next-button") ("vm-next-command-uses-marks") *************** *** 3432,3434 **** ("vm-submit-bug-report") - ("vm-folders-summarize") ("vm-summarize") --- 3438,3439 ---- *** dist/vm-version.el.dist Thu Nov 16 00:07:05 2000 --- vm-version.el Thu Nov 23 16:00:33 2000 *************** *** 4,6 **** ! (defconst vm-version "6.84" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "6.85" "Version number of VM.") *************** *** 81,83 **** (defun vm-toolbar-support-possible-p () ! (and vm-xemacs-p (featurep 'toolbar))) --- 81,84 ---- (defun vm-toolbar-support-possible-p () ! (or (and vm-xemacs-p (featurep 'toolbar)) ! (and vm-fsfemacs-p (fboundp 'tool-bar-mode)))) *************** *** 90,92 **** (defun vm-images-possible-here-p () ! (and vm-xemacs-p (memq (device-type) '(x mswindows)))) --- 91,98 ---- (defun vm-images-possible-here-p () ! (or (and vm-xemacs-p (memq (device-type) '(x mswindows))) ! (and vm-fsfemacs-p window-system (fboundp 'image-type-available-p)))) + (defun vm-image-type-available-p (type) + (if (fboundp 'image-type-available-p) + (image-type-available-p type) + (featurep type))) *** dist/vm-virtual.el.dist Fri May 21 01:07:46 1999 --- vm-virtual.el Thu Nov 16 20:09:58 2000 *************** *** 262,264 **** (vm-error-if-folder-empty) ! (let (vm-virtual-folder-alist) (if (null name) --- 262,265 ---- (vm-error-if-folder-empty) ! (let ((use-marks (eq last-command 'vm-next-command-uses-marks)) ! vm-virtual-folder-alist) (if (null name) *************** *** 271,273 **** (list (list (list 'get-buffer (buffer-name))) ! (if arg (list selector arg) (list selector)))))) (vm-visit-virtual-folder name read-only)) --- 272,277 ---- (list (list (list 'get-buffer (buffer-name))) ! (if use-marks ! (list 'and '(marked) ! (if arg (list selector arg) (list selector))) ! (if arg (list selector arg) (list selector))))))) (vm-visit-virtual-folder name read-only)) *************** *** 296,297 **** --- 300,302 ---- (let ((vfolder (assoc name vm-virtual-folder-alist)) + (use-marks (eq last-command 'vm-next-command-uses-marks)) clauses vm-virtual-folder-alist) *************** *** 302,303 **** --- 307,313 ---- (setcar (car clauses) (list (list 'get-buffer (buffer-name)))) + (if use-marks + (setcdr (car clauses) + (list (list 'and '(marked) + (nconc (list 'or) (cdr (car clauses))))))) + (message "%S" (car clauses)) (setq clauses (cdr clauses)))