*** dist/vm-delete.el.dist Fri Feb 14 16:19:38 2003 --- vm-delete.el Tue Feb 18 12:29:51 2003 *************** *** 274,276 **** (vm-set-deleted-flag-of (car curr) 'expunged) ! ;; disable summary any summary update that may have ;; already been scheduled. --- 274,276 ---- (vm-set-deleted-flag-of (car curr) 'expunged) ! ;; disable any summary update that may have ;; already been scheduled. *** dist/vm-digest.el.dist Wed Sep 5 22:28:03 2001 --- vm-digest.el Mon Feb 24 14:02:55 2003 *************** *** 51,53 **** (goto-char beg) ! (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)") (vm-reorder-message-headers nil keep-list discard-regexp))))) --- 51,53 ---- (goto-char beg) ! (vm-reorder-message-headers nil nil vm-internal-unforwarded-header-regexp) (vm-reorder-message-headers nil keep-list discard-regexp))))) *************** *** 101,103 **** (vm-reorder-message-headers nil vm-mime-header-list ! "\\(X-VM-\\|Status:\\)") ;; skip past the MIME headers so that when the --- 101,103 ---- (vm-reorder-message-headers nil vm-mime-header-list ! vm-internal-unforwarded-header-regexp) ;; skip past the MIME headers so that when the *************** *** 280,282 **** (vm-reorder-message-headers nil vm-mime-header-list ! "\\(X-VM-\\|Status:\\)") ;; skip past the MIME headers so that when the --- 280,282 ---- (vm-reorder-message-headers nil vm-mime-header-list ! vm-internal-unforwarded-header-regexp) ;; skip past the MIME headers so that when the *************** *** 372,374 **** (vm-reorder-message-headers nil vm-mime-header-list ! "\\(X-VM-\\|Status:\\)") ;; skip past the MIME headers so that when the --- 372,374 ---- (vm-reorder-message-headers nil vm-mime-header-list ! vm-internal-unforwarded-header-regexp) ;; skip past the MIME headers so that when the *** dist/vm-imap.el.dist Fri Feb 14 16:19:38 2003 --- vm-imap.el Mon Mar 3 23:42:17 2003 *************** *** 1,3 **** ;;; Simple IMAP4 (RFC 2060) client for VM ! ;;; Copyright (C) 1998, 2001 Kyle E. Jones ;;; --- 1,3 ---- ;;; Simple IMAP4 (RFC 2060) client for VM ! ;;; Copyright (C) 1998, 2001, 2003 Kyle E. Jones ;;; *************** *** 26,27 **** --- 26,33 ---- + (defun vm-imap-capability (cap) + (memq cap vm-imap-capabilities)) + + (defun vm-imap-auth-method (auth) + (memq auth vm-imap-auth-methods)) + ;; Our goal is to drag the mail from the IMAP maildrop to the crash box. *************** *** 47,49 **** (source-nopwd (vm-imapdrop-sans-password source)) ! (use-rfc822-peek nil) auto-expunge x select source-list uid --- 53,55 ---- (source-nopwd (vm-imapdrop-sans-password source)) ! (use-body-peek (vm-imap-capability 'IMAP4REV1)) auto-expunge x select source-list uid *************** *** 136,139 **** n mailbox-count imapdrop) ! (if use-rfc822-peek (progn (vm-imap-send-command process --- 142,151 ---- n mailbox-count imapdrop) ! (if use-body-peek (progn + (vm-imap-send-command process + (format "FETCH %d (BODY.PEEK[])" + n)) + (vm-imap-retrieve-to-crashbox process destination + statblob t)) + (progn (vm-imap-send-command process *************** *** 142,156 **** (vm-imap-retrieve-to-crashbox process destination ! statblob nil)) ! (condition-case data ! (progn ! (vm-imap-send-command process ! (format "FETCH %d (BODY.PEEK[])" ! n)) ! (vm-imap-retrieve-to-crashbox process destination ! statblob t)) ! (vm-imap-protocol-error ! (vm-imap-send-command process ! (format "FETCH %d (RFC822.PEEK)" n)) ! (vm-imap-retrieve-to-crashbox process destination ! statblob nil)))) (vm-increment retrieved) --- 154,156 ---- (vm-imap-retrieve-to-crashbox process destination ! statblob nil))) (vm-increment retrieved) *************** *** 391,393 **** (let ((process-to-shutdown nil) ! process (imapdrop (vm-safe-imapdrop-string source)) --- 391,393 ---- (let ((process-to-shutdown nil) ! process ooo (imapdrop (vm-safe-imapdrop-string source)) *************** *** 512,515 **** --- 512,523 ---- (setq process-to-shutdown process) + ;; record server capabilities + (vm-imap-send-command process "CAPABILITY") + (if (null (setq ooo (vm-imap-read-capability-response process))) + (throw 'end-of-session nil)) + (set (make-local-variable 'vm-imap-capabilities) (car ooo)) + (set (make-local-variable 'vm-imap-auth-methods) (nth 1 ooo)) ;; authentication (cond ((equal auth "login") + ;; LOGIN must be supported by all imap servers, + ;; no need to check for it in CAPABILITIES. (vm-imap-send-command process *************** *** 529,530 **** --- 537,540 ---- ((equal auth "cram-md5") + (if (not (vm-imap-auth-method 'CRAM-MD5)) + (error "CRAM-MD5 authentication unsupported by this server")) (let ((ipad (make-string 64 54)) *************** *** 533,535 **** (secret (concat ! pass (make-string (- 64 (length pass)) 0))) response p challenge answer) --- 543,547 ---- (secret (concat ! pass ! (make-string (max 0 (- 64 (length pass))) ! 0))) response p challenge answer) *************** *** 987,988 **** --- 999,1041 ---- size )) + + (defun vm-imap-read-capability-response (process) + (let (response r cap-list auth-list (need-ok t)) + (while need-ok + (setq response (vm-imap-read-response process)) + (if (vm-imap-response-matches response 'VM 'NO) + (error "server said NO to CAPABILITY")) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to CAPABILITY")) + (if (vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil) + (if (not (vm-imap-response-matches response '* 'CAPABILITY)) + nil + ;; skip * CAPABILITY + (setq response (cdr (cdr response))) + (while response + (setq r (car response)) + (if (not (eq (car r) 'atom)) + nil + (if (save-excursion + (goto-char (nth 1 r)) + (let ((case-fold-search t)) + (eq (re-search-forward "AUTH=." (nth 2 r) t) + (+ 6 (nth 1 r))))) + (progn + (setq auth-list (cons (intern + (upcase (buffer-substring + (+ 5 (nth 1 r)) + (nth 2 r)))) + auth-list))) + (setq r (car response)) + (if (not (eq (car r) 'atom)) + nil + (setq cap-list (cons (intern + (upcase (buffer-substring + (nth 1 r) (nth 2 r)))) + cap-list))))) + (setq response (cdr response)))))) + (if (or cap-list auth-list) + (list (nreverse cap-list) (nreverse auth-list)) + nil))) *** dist/vm-menu.el.dist Fri Apr 19 13:45:10 2002 --- vm-menu.el Mon Mar 3 23:24:02 2003 *************** *** 443,445 **** 'vm-mouse-send-url-to-netscape) ! t]))) --- 443,451 ---- 'vm-mouse-send-url-to-netscape) ! t] ! ["Konqueror" ! (vm-mouse-send-url-at-position (point) ! 'vm-mouse-send-url-to-konqueror)] ! ["X Clipboard" ! (vm-mouse-send-url-at-position (point) ! 'vm-mouse-send-url-to-clipboard)]))) *************** *** 492,518 **** ! (defvar vm-menu-content-disposition-menu (let ((title (if (vm-menu-fsfemacs19-menus-p) ! (list "Set Content Disposition" ! "Set Content Disposition" "---" "---") ! (list "Set Content Disposition")))) `(,@title ! ["Unspecified" ! (vm-mime-set-attachment-disposition-at-point 'unspecified) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) ! 'unspecified)] ! ["Inline" ! (vm-mime-set-attachment-disposition-at-point 'inline) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)] ! ["Attachment" ! (vm-mime-set-attachment-disposition-at-point 'attachment) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) ! 'attachment)]))) --- 498,589 ---- ! (defvar vm-menu-attachment-menu (let ((title (if (vm-menu-fsfemacs19-menus-p) ! (list "Fiddle With Attachment" ! "Fiddle With Attachment" "---" "---") ! (list "Fiddle With Attachment")))) `(,@title ! ( ! ,@(if (vm-menu-fsfemacs19-menus-p) ! (list "Set Content Disposition..." ! "Set Content Disposition..." ! "---" ! "---") ! (list "Set Content Disposition...")) ! ["Unspecified" ! (vm-mime-set-attachment-disposition-at-point 'unspecified) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) ! 'unspecified)] ! ["Inline" ! (vm-mime-set-attachment-disposition-at-point 'inline) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)] ! ["Attachment" ! (vm-mime-set-attachment-disposition-at-point 'attachment) ! :active vm-send-using-mime ! :style radio ! :selected (eq (vm-mime-attachment-disposition-at-point) ! 'attachment)]) ! ( ! ,@(if (vm-menu-fsfemacs19-menus-p) ! (list "Forward Local External Bodies" ! "Forward Local External Bodies" ! "---" ! "---") ! (list "Forward Local External Bodies")) ! ["Forward Unchanged" ! (vm-mime-set-attachment-forward-local-refs-at-point t) ! :active vm-send-using-mime ! :style radio ! :selected (vm-mime-attachment-forward-local-refs-at-point)] ! ["Convert to Internal Object" ! (vm-mime-set-attachment-forward-local-refs-at-point nil) ! :active vm-send-using-mime ! :style radio ! :selected (not (vm-mime-attachment-forward-local-refs-at-point))]) ! ))) ! ! (defvar vm-menu-image-menu ! (let ((title (if (vm-menu-fsfemacs19-menus-p) ! (list "Redisplay Image" ! "Redisplay Image" ! "---" ! "---") ! (list "Redisplay Image")))) ! `(,@title ! ["4x Larger" ! (vm-mime-run-display-function-at-point 'vm-mime-larger-image) ! (stringp vm-imagemagick-convert-program)] ! ["4x Smaller" ! (vm-mime-run-display-function-at-point 'vm-mime-smaller-image) ! (stringp vm-imagemagick-convert-program)] ! ["Rotate Left" ! (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-left) ! (stringp vm-imagemagick-convert-program)] ! ["Rotate Right" ! (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-right) ! (stringp vm-imagemagick-convert-program)] ! ["Mirror" ! (vm-mime-run-display-function-at-point 'vm-mime-mirror-image) ! (stringp vm-imagemagick-convert-program)] ! ["Brighter" ! (vm-mime-run-display-function-at-point 'vm-mime-brighten-image) ! (stringp vm-imagemagick-convert-program)] ! ["Dimmer" ! (vm-mime-run-display-function-at-point 'vm-mime-dim-image) ! (stringp vm-imagemagick-convert-program)] ! ["Monochrome" ! (vm-mime-run-display-function-at-point 'vm-mime-monochrome-image) ! (stringp vm-imagemagick-convert-program)] ! ["Revert to Original" ! (vm-mime-run-display-function-at-point 'vm-mime-revert-image) ! (get ! (vm-mm-layout-cache ! (vm-extent-property (vm-find-layout-extent-at-point) 'vm-mime-layout)) ! 'vm-image-modified)] ! ))) *************** *** 705,710 **** vm-menu-mime-dispose-menu) ! ;; content disposition menu ! (vm-easy-menu-define vm-menu-fsfemacs-content-disposition-menu (list dummy) nil ! vm-menu-content-disposition-menu) ;; block the global menubar entries in the map so that VM --- 776,785 ---- vm-menu-mime-dispose-menu) ! ;; attachment menu ! (vm-easy-menu-define vm-menu-fsfemacs-attachment-menu ! (list dummy) nil ! vm-menu-attachment-menu) ! ;; image menu ! (vm-easy-menu-define vm-menu-fsfemacs-image-menu (list dummy) nil ! vm-menu-image-menu) ;; block the global menubar entries in the map so that VM *************** *** 806,808 **** ! (defvar vm-menu-fsfemacs-content-disposition-menu) (defun vm-menu-popup-context-menu (event) --- 881,883 ---- ! (defvar vm-menu-fsfemacs-attachment-menu) (defun vm-menu-popup-context-menu (event) *************** *** 821,823 **** (vm-menu-popup-fsfemacs-menu ! event vm-menu-fsfemacs-content-disposition-menu) (let (o-list o menu (found nil)) --- 896,898 ---- (vm-menu-popup-fsfemacs-menu ! event vm-menu-fsfemacs-attachment-menu) (let (o-list o menu (found nil)) *************** *** 831,832 **** --- 906,910 ---- (vm-menu-popup-fsfemacs-menu event menu)) + ((setq menu (overlay-get (car o-list) 'vm-image)) + (setq found t) + (vm-menu-popup-fsfemacs-menu event menu)) ((overlay-get (car o-list) 'vm-mime-layout) *************** *** 882,884 **** ! (defun vm-menu-popup-content-disposition-menu (event) (interactive "e") --- 960,972 ---- ! (defun vm-menu-popup-attachment-menu (event) ! (interactive "e") ! (vm-menu-goto-event event) ! (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) ! (popup-menu vm-menu-attachment-menu)) ! ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) ! (vm-menu-popup-fsfemacs-menu ! event vm-menu-fsfemacs-attachment-menu)))) ! ! (defvar vm-menu-fsfemacs-image-menu) ! (defun vm-menu-popup-image-menu (event) (interactive "e") *************** *** 886,891 **** (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) ! (popup-menu vm-menu-content-disposition-menu)) ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) (vm-menu-popup-fsfemacs-menu ! event vm-menu-fsfemacs-content-disposition-menu)))) --- 974,979 ---- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) ! (popup-menu vm-menu-image-menu)) ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) (vm-menu-popup-fsfemacs-menu ! event vm-menu-fsfemacs-image-menu)))) *** dist/vm-mime.el.dist Fri Feb 14 16:19:38 2003 --- vm-mime.el Mon Mar 3 23:41:25 2003 *************** *** 1,3 **** ;;; MIME support functions ! ;;; Copyright (C) 1997-1998, 2000, 2001 Kyle E. Jones ;;; --- 1,3 ---- ;;; MIME support functions ! ;;; Copyright (C) 1997-1998, 2000, 2001, 2003 Kyle E. Jones ;;; *************** *** 1052,1053 **** --- 1052,1054 ---- (or c-t (setq c-t '("text/plain" "charset=us-ascii"))) + (or c-t-e (setq c-t-e "7bit")) ;; don't let subpart parse errors make the whole parse fail. use default *************** *** 2235,2236 **** --- 2236,2318 ---- + (defun vm-mime-retrieve-external-body (layout) + "Fetch an external body into the current buffer. + LAYOUT is the MIME layout struct for the message/external-body object." + (let ((access-method (downcase (vm-mime-get-parameter layout "access-type"))) + (work-buffer (current-buffer))) + (cond ((string= access-method "local-file") + (let ((name (vm-mime-get-parameter layout "name"))) + (if (null name) + (vm-mime-error + "%s access type missing `name' parameter" + access-method)) + (if (not (file-exists-p name)) + (vm-mime-error "file %s does not exist" name)) + (condition-case data + (insert-file-contents name) + (error (signal 'vm-mime-error (cdr data)))))) + ((and (string= access-method "url") + vm-url-retrieval-methods) + (defvar w3-configuration-directory) ; for bytecompiler + (let ((url (vm-mime-get-parameter layout "url")) + ;; needed or url-retrieve will bitch + (w3-configuration-directory + (if (boundp 'w3-configuration-directory) + w3-configuration-directory + "~"))) + (if (null url) + (vm-mime-error + "%s access type missing `url' parameter" + access-method)) + (setq url (vm-with-string-as-temp-buffer + url + (function + (lambda () + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]" nil t) + (delete-char -1)))))) + (vm-mime-fetch-url-with-programs url work-buffer))) + ((and (or (string= access-method "ftp") + (string= access-method "anon-ftp")) + (or (fboundp 'efs-file-handler-function) + (fboundp 'ange-ftp-hook-function))) + (let ((name (vm-mime-get-parameter layout "name")) + (directory (vm-mime-get-parameter layout "directory")) + (site (vm-mime-get-parameter layout "site")) + user) + (if (null name) + (vm-mime-error + "%s access type missing `name' parameter" + access-method)) + (if (null site) + (vm-mime-error + "%s access type missing `site' parameter" + access-method)) + (cond ((string= access-method "ftp") + (setq user (read-string + (format "User name to access %s: " + site) + (user-login-name)))) + (t (setq user "anonymous"))) + (if (and (string= access-method "ftp") + vm-url-retrieval-methods + (vm-mime-fetch-url-with-programs + (if directory + (concat "ftp:////" site "/" + directory "/" name) + (concat "ftp:////" site "/" name)) + work-buffer)) + t + (cond (directory + (setq directory + (concat "/" user "@" site ":" directory)) + (setq name (expand-file-name name directory))) + (t + (setq name (concat "/" user "@" site ":" + name)))) + (condition-case data + (insert-file-contents name) + (error (signal 'vm-mime-error + (format "%s" (cdr data))))))))))) + + (defun vm-mime-display-internal-message/external-body (layout) *************** *** 2265,2356 **** (cond ! ((string= access-method "local-file") ! (let ((name (vm-mime-get-parameter layout "name"))) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (not (file-exists-p name)) ! (vm-mime-error "file %s does not exist" name)) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error (cdr data)))))) ! ((and (string= access-method "url") ! vm-url-retrieval-methods) ! (defvar w3-configuration-directory) ; for bytecompiler ! (let ((url (vm-mime-get-parameter layout "url")) ! ;; needed or url-retrieve will bitch ! (w3-configuration-directory ! (if (boundp 'w3-configuration-directory) ! w3-configuration-directory ! "~")) ! (url-work-buffer (buffer-name work-buffer))) ! (if (null url) ! (vm-mime-error ! "%s access type missing `url' parameter" ! access-method)) ! (setq url (vm-with-string-as-temp-buffer ! url ! (function ! (lambda () ! (goto-char (point-min)) ! (while (re-search-forward "[ \t\n]" nil t) ! (delete-char -1)))))) ! (cond ! ((vm-mime-fetch-url-with-programs url work-buffer) t) ! ((and (fboundp 'url-retrieve) ! (memq 'url-w3 vm-url-retrieval-methods)) ! (condition-case data ! (progn ! (url-retrieve url) ! ;; url-retrieve kills the buffer before ! ;; starting so work-buffer must be set ! ;; to the buffer object again. ! (setq work-buffer (get-buffer url-work-buffer)) ! (if (zerop (buffer-size)) ! (error "file empty or URL retrieval failed"))) ! (error (signal 'vm-mime-error (cdr data))))) ! (t nil)))) ! ((and (or (string= access-method "ftp") ! (string= access-method "anon-ftp")) ! (or (fboundp 'efs-file-handler-function) ! (fboundp 'ange-ftp-hook-function))) ! (let ((name (vm-mime-get-parameter layout "name")) ! (directory (vm-mime-get-parameter layout ! "directory")) ! (site (vm-mime-get-parameter layout "site")) ! user) ! (if (null name) ! (vm-mime-error ! "%s access type missing `name' parameter" ! access-method)) ! (if (null site) ! (vm-mime-error ! "%s access type missing `site' parameter" ! access-method)) ! (cond ((string= access-method "ftp") ! (setq user (read-string ! (format "User name to access %s: " ! site) ! (user-login-name)))) ! (t (setq user "anonymous"))) ! (if (and (string= access-method "ftp") ! vm-url-retrieval-methods ! (vm-mime-fetch-url-with-programs ! (if directory ! (concat "ftp:////" site "/" ! directory "/" name) ! (concat "ftp:////" site "/" name)) ! work-buffer)) ! t ! (cond (directory ! (setq directory ! (concat "/" user "@" site ":" directory)) ! (setq name (expand-file-name name directory))) ! (t ! (setq name (concat "/" user "@" site ":" ! name)))) ! (condition-case data ! (insert-file-contents name) ! (error (signal 'vm-mime-error ! (format "%s" (cdr data)))))))) ((string= access-method "mail-server") --- 2347,2353 ---- (cond ! ((or (string= access-method "ftp") ! (string= access-method "anon-ftp") ! (string= access-method "local-file") ! (string= access-method "url")) ! (vm-mime-retrieve-external-body layout)) ((string= access-method "mail-server") *************** *** 2374,2376 **** (let ((vm-confirm-mail-send nil)) ! (vm-mail-send)))) (t --- 2371,2375 ---- (let ((vm-confirm-mail-send nil)) ! (vm-mail-send)) ! (message "Retrieval message sent. Retry viewing this object after the response arrives.") ! (sleep-for 2))) (t *************** *** 2393,2415 **** (and ! (eq t (cond ((and (memq 'wget vm-url-retrieval-methods) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-wget-program ! "-q" "-O" "-" url) ! (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) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-lynx-program ! "-source" url) ! (error nil)))))) (save-excursion --- 2392,2453 ---- (and ! (eq t (cond ((if (and (memq 'wget vm-url-retrieval-methods) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-wget-program ! "-q" "-O" "-" url) ! (error nil))) ! t ! (save-excursion ! (set-buffer buffer) ! (erase-buffer) ! nil ))) ! ((if (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))) ! t ! (save-excursion ! (set-buffer buffer) ! (erase-buffer) ! nil ))) ! ((if (and (memq 'fetch vm-url-retrieval-methods) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-fetch-program ! "-o" "-" url) ! (error nil))) ! t ! (save-excursion ! (set-buffer buffer) ! (erase-buffer) ! nil ))) ! ((if (and (memq 'curl vm-url-retrieval-methods) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-curl-program ! url) ! (error nil))) ! t ! (save-excursion ! (set-buffer buffer) ! (erase-buffer) ! nil ))) ! ((if (and (memq 'lynx vm-url-retrieval-methods) ! (condition-case data ! (vm-run-command-on-region (point) (point) ! buffer ! vm-lynx-program ! "-source" url) ! (error nil))) ! t ! (save-excursion ! (set-buffer buffer) ! (erase-buffer) ! nil ))))) (save-excursion *************** *** 2418,2419 **** --- 2456,2499 ---- + (defun vm-mime-internalize-local-external-bodies (layout) + (cond ((vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (if (not (string= (downcase + (vm-mime-get-parameter layout "access-type")) + "local-file")) + nil + (let ((work-buffer nil)) + (unwind-protect + (let ((child-layout (car (vm-mm-layout-parts layout))) + oldsize + (i (1- (length layout)))) + (save-excursion + (setq work-buffer + (vm-make-multibyte-work-buffer + (format "*%s mime object*" + (car (vm-mm-layout-type child-layout))))) + (set-buffer work-buffer) + (vm-mime-retrieve-external-body layout)) + (goto-char (vm-mm-layout-body-start child-layout)) + (setq oldsize (buffer-size)) + (condition-case data + (insert-buffer-substring work-buffer) + (error (signal 'vm-mime-error (cdr data)))) + (goto-char (+ (point) (- (buffer-size) oldsize))) + (if (< (point) (vm-mm-layout-body-end child-layout)) + (delete-region (point) + (vm-mm-layout-body-end child-layout)) + (vm-set-mm-layout-body-end child-layout (point-marker))) + (delete-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout)) + (while (>= i 0) + (aset layout i (aref child-layout i)) + (setq i (1- i))))) + (and work-buffer (kill-buffer work-buffer))))) + ((vm-mime-composite-type-p (car (vm-mm-layout-type layout))) + (let ((p (vm-mm-layout-parts layout))) + (while p + (vm-mime-internalize-local-external-bodies (car p)) + (setq p (cdr p))))) + (t nil))) + (defun vm-mime-display-internal-message/partial (layout) *************** *** 2566,2570 **** do-strips (buffer-read-only nil)) ! (if (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) nil --- 2646,2652 ---- do-strips + (keymap (make-sparse-keymap)) (buffer-read-only nil)) ! (if (and (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) ! (file-readable-p tempfile)) nil *************** *** 2594,2596 **** --- 2676,2680 ---- process image-list extent-list + start (first t)) + (define-key keymap 'button3 'vm-menu-popup-image-menu) (setq process (car strips) *************** *** 2599,2600 **** --- 2683,2685 ---- (vm-register-message-garbage-files strips) + (setq start (point)) (while strips *************** *** 2615,2618 **** --- 2700,2709 ---- (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'keymap keymap) (setq extent-list (cons e extent-list)) (setq strips (cdr strips))) + (setq e (make-extent start (point))) + (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-disposable t) + (vm-set-extent-property e 'keymap keymap) (save-excursion *************** *** 2660,2663 **** --- 2751,2758 ---- (insert " \n") + (define-key keymap 'button3 'vm-menu-popup-image-menu) (setq e (vm-make-extent (- (point) 2) (1- (point)))) + (vm-set-extent-property e 'keymap keymap) (vm-set-extent-property e 'begin-glyph g) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-disposable t) (vm-set-extent-property e 'start-open t))) *************** *** 2665,2666 **** --- 2760,2763 ---- + (defvar vm-menu-fsfemacs-image-menu) + (defun vm-mime-display-internal-image-fsfemacs-21-xxxx (layout image-type name) *************** *** 2673,2676 **** (buffer-read-only nil)) ! (if (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) nil --- 2770,2774 ---- (buffer-read-only nil)) ! (if (and (setq tempfile (get (vm-mm-layout-cache layout) ! 'vm-mime-display-internal-image-xxxx)) ! (file-readable-p tempfile)) nil *************** *** 2704,2706 **** (first t) ! o process image-list overlay-list) (setq process (car strips) --- 2802,2804 ---- (first t) ! start o process image-list overlay-list) (setq process (car strips) *************** *** 2709,2710 **** --- 2807,2809 ---- (vm-register-message-garbage-files strips) + (setq start (point)) (while strips *************** *** 2720,2721 **** --- 2819,2824 ---- (setq strips (cdr strips))) + (setq o (make-overlay start (point) nil t nil)) + (overlay-put o 'vm-mime-layout layout) + (overlay-put o 'vm-mime-disposable t) + (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu) (save-excursion *************** *** 2745,2747 **** (insert "z") ! (put-text-property (1- (point)) (point) 'display image))) t ) --- 2848,2857 ---- (insert "z") ! (put-text-property (1- (point)) (point) 'display image) ! (clear-image-cache t) ! (let (o) ! (setq o (make-overlay (- (point) 1) (point) nil t nil)) ! (overlay-put o 'evaporate t) ! (overlay-put o 'vm-mime-layout layout) ! (overlay-put o 'vm-mime-disposable t) ! (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu)))) t ) *************** *** 2754,2756 **** (let ((selective-display nil) ! start end tempfile image work-buffer (hroll (if vm-fsfemacs-mule-p --- 2864,2866 ---- (let ((selective-display nil) ! start end origfile workfile image work-buffer (hroll (if vm-fsfemacs-mule-p *************** *** 2770,2772 **** dims width height char-width char-height ! horiz-pad vert-pad (buffer-read-only nil)) --- 2880,2882 ---- dims width height char-width char-height ! horiz-pad vert-pad trash-list (buffer-read-only nil)) *************** *** 2776,2785 **** (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 --- 2886,2896 ---- (progn ! (setq origfile (car blob) ! workfile (nth 1 blob) ! width (nth 2 blob) ! height (nth 3 blob) ! char-width (nth 4 blob) ! char-height (nth 5 blob)) (and (= char-width (frame-char-width)) (= char-height (frame-char-height))))) ! (setq strips (nth 6 blob)) (unwind-protect *************** *** 2789,2799 **** (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 --- 2900,2916 ---- (set-buffer work-buffer) ! (if (and origfile (file-exists-p origfile)) ! (progn ! (insert-file-contents origfile) ! (setq start (point-min) ! end (vm-marker (point-max)))) ! (setq start (point)) ! (vm-mime-insert-mime-body layout) ! (setq end (point-marker)) ! (vm-mime-transfer-decode-region layout start end) ! (setq origfile (vm-make-tempfile)) ! (setq trash-list (cons origfile trash-list)) ! (let ((coding-system-for-write (vm-binary-coding-system))) ! (write-region start end origfile nil 0))) (setq dims (condition-case error-data ! (vm-get-image-dimensions origfile) (error *************** *** 2840,2847 **** 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)))) --- 2957,2969 ---- height (+ height (* 2 (/ vert-pad 2)))) + (if (null workfile) + (setq workfile (vm-make-tempfile) + trash-list (cons workfile trash-list))) (let ((coding-system-for-write (vm-binary-coding-system))) ! (write-region (point-min) (point-max) workfile nil 0)) (put (vm-mm-layout-cache layout) 'vm-mime-display-internal-image-xxxx ! (list origfile workfile width height ! char-width char-height))) ! (and trash-list ! (vm-register-folder-garbage-files trash-list))) (and work-buffer (kill-buffer work-buffer)))) *************** *** 2850,2855 **** (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 image-type t nil --- 2972,2977 ---- (condition-case error-data ! (let (o i-start start process image-list overlay-list) (if (and strips (file-exists-p (car strips))) (setq image-list strips) ! (setq strips (vm-make-image-strips workfile char-height image-type t nil *************** *** 2861,2865 **** 'vm-mime-display-internal-image-xxxx ! (list tempfile width height char-width char-height strips)) (vm-register-message-garbage-files strips)) (while strips --- 2983,2989 ---- 'vm-mime-display-internal-image-xxxx ! (list origfile workfile width height ! char-width char-height strips)) (vm-register-message-garbage-files strips)) + (setq i-start (point)) (while strips *************** *** 2873,2874 **** --- 2997,3002 ---- (setq strips (cdr strips))) + (setq o (make-overlay i-start (point) nil t nil)) + (overlay-put o 'vm-mime-layout layout) + (overlay-put o 'vm-mime-disposable t) + (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu) (if process *************** *** 3188,3189 **** --- 3316,3421 ---- + (defun vm-mime-frob-image-xxxx (extent &rest convert-args) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + success tempfile + (work-buffer nil)) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (setq success + (eq 0 (apply 'call-process vm-imagemagick-convert-program + tempfile t nil + (append convert-args (list "-" "-"))))) + (if success + (progn + (write-region (point-min) (point-max) tempfile nil 0) + (if (consp blob) + (setcar (nthcdr 5 blob) 0)) + (put (vm-mm-layout-cache layout) 'vm-image-modified t)))) + (and work-buffer (kill-buffer work-buffer))) + (if success + (progn + (vm-mark-image-tempfile-as-message-garbage-once layout tempfile) + (vm-mime-display-generic extent))))) + + (defun vm-mark-image-tempfile-as-message-garbage-once (layout tempfile) + (if (get (vm-mm-layout-cache layout) 'vm-message-garbage) + nil + (vm-register-message-garbage-files (list tempfile)) + (put (vm-mm-layout-cache layout) 'vm-message-garbage t))) + + (defun vm-mime-rotate-image-left (extent) + (vm-mime-frob-image-xxxx extent "-rotate" "-90")) + + (defun vm-mime-rotate-image-right (extent) + (vm-mime-frob-image-xxxx extent "-rotate" "90")) + + (defun vm-mime-mirror-image (extent) + (vm-mime-frob-image-xxxx extent "-flop")) + + (defun vm-mime-brighten-image (extent) + (vm-mime-frob-image-xxxx extent "-modulate" "115")) + + (defun vm-mime-dim-image (extent) + (vm-mime-frob-image-xxxx extent "-modulate" "85")) + + (defun vm-mime-monochrome-image (extent) + (vm-mime-frob-image-xxxx extent "-monochrome")) + + (defun vm-mime-revert-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (and (stringp tempfile) + (vm-error-free-call 'delete-file tempfile)) + (put (vm-mm-layout-cache layout) 'vm-image-modified nil) + (vm-mime-display-generic extent))) + + (defun vm-mime-larger-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + dims tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq dims (vm-get-image-dimensions tempfile)) + (vm-mime-frob-image-xxxx extent + "-scale" + (concat (int-to-string (* 2 (car dims))) + "x" + (int-to-string (* 2 (nth 1 dims))))))) + + (defun vm-mime-smaller-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + dims tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq dims (vm-get-image-dimensions tempfile)) + (vm-mime-frob-image-xxxx extent + "-scale" + (concat (int-to-string (/ (car dims) 2)) + "x" + (int-to-string (/ (nth 1 dims) 2)))))) + (defun vm-mime-display-internal-audio/basic (layout) *************** *** 3220,3221 **** --- 3452,3459 ---- + (defun vm-mime-display-generic (layout) + (save-excursion + (let ((vm-auto-displayed-mime-content-types t) + (vm-auto-displayed-mime-content-type-exceptions nil)) + (vm-decode-mime-layout layout t)))) + (defun vm-mime-display-button-xxxx (layout disposable) *************** *** 3223,3230 **** (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) ! (function ! (lambda (layout) ! (save-excursion ! (let ((vm-auto-displayed-mime-content-types t) ! (vm-auto-displayed-mime-content-type-exceptions nil)) ! (vm-decode-mime-layout layout t))))) layout disposable) --- 3461,3463 ---- (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) ! (function vm-mime-display-generic) layout disposable) *************** *** 4134,4136 **** (goto-char (point-min)) ! (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)")) (and description (setq description --- 4367,4370 ---- (goto-char (point-min)) ! (vm-reorder-message-headers nil nil ! vm-internal-unforwarded-header-regexp)) (and description (setq description *************** *** 4196,4198 **** ! (let (e layout (work-buffer nil) buf start) (setq e (vm-find-layout-extent-at-point) --- 4430,4432 ---- ! (let (e layout (work-buffer nil) buf start w) (setq e (vm-find-layout-extent-at-point) *************** *** 4219,4220 **** --- 4453,4459 ---- t) + ;; move windwo point forward so that if this command + ;; is used consecutively, the insertions will be in + ;; the correct order in the composition buffer. + (setq w (vm-get-buffer-window composition)) + (and w (set-window-point w (point))) (setq buf work-buffer *************** *** 4234,4236 **** (error "Can't attach MIME object to already encoded MIME buffer.")) ! (let (start end e tag-string disposition) (if (< (point) (save-excursion (mail-text) (point))) --- 4473,4476 ---- (error "Can't attach MIME object to already encoded MIME buffer.")) ! (let (start end e tag-string disposition ! (fb (list vm-mime-forward-local-external-bodies))) (if (< (point) (save-excursion (mail-text) (point))) *************** *** 4263,4264 **** --- 4503,4505 ---- (put-text-property start end 'face vm-mime-button-face) + (put-text-property start end 'vm-mime-forward-local-refs fb) (put-text-property start end 'vm-mime-type type) *************** *** 4278,4282 **** (define-key keymap 'button3 ! 'vm-menu-popup-content-disposition-menu)) (set-extent-property e 'keymap keymap) (set-extent-property e 'balloon-help 'vm-mouse-3-help)) (set-extent-property e 'vm-mime-type type) --- 4519,4524 ---- (define-key keymap 'button3 ! 'vm-menu-popup-attachment-menu)) (set-extent-property e 'keymap keymap) (set-extent-property e 'balloon-help 'vm-mouse-3-help)) + (set-extent-property e 'vm-mime-forward-local-refs fb) (set-extent-property e 'vm-mime-type type) *************** *** 4288,4289 **** --- 4530,4549 ---- + (defun vm-mime-attachment-forward-local-refs-at-point () + (cond (vm-fsfemacs-p + (let ((fb (get-text-property (point) 'vm-mime-forward-local-refs))) + (car fb) )) + (vm-xemacs-p + (let* ((e (extent-at (point) nil 'vm-mime-type)) + (fb (extent-property e 'vm-mime-forward-local-refs))) + (car fb) )))) + + (defun vm-mime-set-attachment-forward-local-refs-at-point (val) + (cond (vm-fsfemacs-p + (let ((fb (get-text-property (point) 'vm-mime-forward-local-refs))) + (setcar fb val) )) + (vm-xemacs-p + (let* ((e (extent-at (point) nil 'vm-mime-type)) + (fb (extent-property e 'vm-mime-forward-local-refs))) + (setcar fb val) )))) + (defun vm-mime-attachment-disposition-at-point () *************** *** 4655,4657 **** (enriched (and (boundp 'enriched-mode) enriched-mode)) ! already-mimed layout e e-list boundary type encoding charset params description disposition object --- 4915,4917 ---- (enriched (and (boundp 'enriched-mode) enriched-mode)) ! forward-local-refs already-mimed layout e e-list boundary type encoding charset params description disposition object *************** *** 4773,4774 **** --- 5033,5036 ---- (cdr (vm-mm-layout-qtype layout))) + forward-local-refs + (car (extent-property e 'vm-mime-forward-local-refs)) description (extent-property e 'vm-mime-description) *************** *** 4783,4784 **** --- 5045,5048 ---- params (extent-property e 'vm-mime-parameters) + forward-local-refs + (car (extent-property e 'vm-mime-forward-local-refs)) description (extent-property e 'vm-mime-description) *************** *** 4811,4819 **** (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)) --- 5075,5085 ---- (insert "Content-Type: " type "\n") ! ;; vm-mime-transfer-encode-layout will replace ;; this if the transfer encoding changes. (insert "Content-Transfer-Encoding: 7bit\n\n") + (setq layout (vm-mime-parse-entity + nil (list "text/plain" "charset=us-ascii") + "7bit")) (setq already-mimed t))) ! (and layout (not forward-local-refs) ! (vm-mime-internalize-local-external-bodies layout)) (setq encoding (vm-mime-transfer-encode-layout layout)) *************** *** 4824,4831 **** (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 --- 5090,5097 ---- (t ! (and layout (not forward-local-refs) ! (vm-mime-internalize-local-external-bodies layout)) ! (if already-mimed ! (setq encoding (vm-mime-transfer-encode-layout layout)) ! (vm-mime-base64-encode-region (point-min) (point-max)) ! (setq encoding "base64")))) (if just-one *************** *** 4977,4981 **** (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) --- 5243,5247 ---- (enriched (and (boundp 'enriched-mode) enriched-mode)) ! forward-local-refs already-mimed layout o o-list boundary type encoding charset params description disposition object ! opoint-min delete-object) (mail-text) *************** *** 5092,5095 **** (setq object (overlay-get o 'vm-mime-object)) ! ;; insert the object (cond ((bufferp object) ;; as of FSF Emacs 19.34, even with the hooks --- 5358,5378 ---- (setq object (overlay-get o 'vm-mime-object)) ! (setq delete-object nil) (cond ((bufferp object) + ;; Under Emacs 20.7 inserting a unibyte buffer + ;; contents that contain 8-bit characters into a + ;; multibyte buffer causes the inserted data to be + ;; corrupted with the dreaded \201 corruption. So + ;; we write the data out to disk and let the file + ;; be inserted, which gets aoround the problem. + (let ((tempfile (vm-make-tempfile))) + ;; make note to delete the tempfile after insertion + (setq delete-object t) + (save-excursion + (set-buffer object) + (let ((buffer-file-coding-system + (vm-binary-coding-system))) + (write-region (point-min) (point-max) tempfile nil 0)) + (setq object tempfile))))) + ;; insert the object + (cond ((stringp object) ;; as of FSF Emacs 19.34, even with the hooks *************** *** 5099,5107 **** ;; 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 " ") --- 5382,5385 ---- ;; beyond the scope of this comment and I ! ;; don't know the answer anyway. This ! ;; insertion dance work to prevent it. (insert-before-markers " ") *************** *** 5128,5129 **** --- 5406,5409 ---- (error + (if delete-object + (vm-error-free-call 'delete-file object)) ;; font-lock could signal this error in FSF *************** *** 5134,5135 **** --- 5414,5417 ---- (signal (car data) (cdr data)))))) + (if delete-object + (vm-error-free-call 'delete-file object)) (goto-char (point-max)) *************** *** 5145,5146 **** --- 5427,5430 ---- (cdr (vm-mm-layout-qtype layout))) + forward-local-refs + (car (overlay-get o 'vm-mime-forward-local-refs)) description (overlay-get o 'vm-mime-description) *************** *** 5155,5156 **** --- 5439,5442 ---- params (overlay-get o 'vm-mime-parameters) + forward-local-refs + (car (overlay-get o 'vm-mime-forward-local-refs)) description (overlay-get o 'vm-mime-description) *************** *** 5183,5191 **** (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)) --- 5469,5479 ---- (insert "Content-Type: " type "\n") ! ;; vm-mime-transfer-encode-layout will replace ;; this if the transfer encoding changes. (insert "Content-Transfer-Encoding: 7bit\n\n") + (setq layout (vm-mime-parse-entity + nil (list "text/plain" "charset=us-ascii") + "7bit")) (setq already-mimed t))) ! (and layout (not forward-local-refs) ! (vm-mime-internalize-local-external-bodies layout)) (setq encoding (vm-mime-transfer-encode-layout layout)) *************** *** 5196,5203 **** (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 --- 5484,5491 ---- (t ! (and layout (not forward-local-refs) ! (vm-mime-internalize-local-external-bodies layout)) ! (if already-mimed ! (setq encoding (vm-mime-transfer-encode-layout layout)) ! (vm-mime-base64-encode-region (point-min) (point-max)) ! (setq encoding "base64")))) (if just-one *************** *** 5455,5456 **** --- 5743,5745 ---- (defun vm-mime-compile-format-1 (format start-index) + (or start-index (setq start-index 0)) (let ((case-fold-search nil) *** dist/vm-mouse.el.dist Fri Feb 14 16:19:38 2003 --- vm-mouse.el Mon Mar 3 23:21:45 2003 *************** *** 272,273 **** --- 272,296 ---- + (defun vm-mouse-send-url-to-konqueror (url &optional new-konqueror) + (message "Sending URL to Konqueror...") + (if new-konqueror + (apply 'vm-run-background-command vm-konqueror-program + (append vm-konqueror-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-konqueror-client-program + (append vm-konqueror-client-program-switches + (list "openURL" url)))))) + (message "Sending URL to Konqueror... done")) + + (defun vm-mouse-send-url-to-konqueror-new-browser (url) + (vm-mouse-send-url-to-konqueror url t)) + + (defun vm-mouse-send-url-to-clipboard (url) + (message "Sending URL to X Clipboard...") + (cond ((fboundp 'own-selection) + (own-selection url 'CLIPBOARD)) + ((fboundp 'x-own-clipboard) + (x-own-clipboard url)) + ((fboundp 'x-own-selection-internal) + (x-own-selection-internal 'CLIPBOARD url))) + (message "Sending URL to X Clipboard... done")) + (defun vm-mouse-install-mouse () *** dist/vm-startup.el.dist Fri Feb 14 16:19:38 2003 --- vm-startup.el Mon Mar 3 23:46:57 2003 *************** *** 1,3 **** ;;; Entry points for VM ! ;;; Copyright (C) 1994-1998 Kyle E. Jones ;;; --- 1,3 ---- ;;; Entry points for VM ! ;;; Copyright (C) 1994-1998, 2003 Kyle E. Jones ;;; *************** *** 354,356 **** ! This is VM 7.08. --- 354,356 ---- ! This is VM 7.09. *************** *** 617,618 **** --- 617,619 ---- vm-mime-external-content-types-alist + vm-mime-forward-local-external-bodies vm-mime-ignore-composite-type-opaque-transfer-encoding *************** *** 1406,1407 **** --- 1407,1409 ---- 'vm-mime-external-content-types-alist + 'vm-mime-forward-local-external-bodies 'vm-mime-ignore-composite-type-opaque-transfer-encoding *** dist/vm-summary.el.dist Fri Feb 14 16:19:38 2003 --- vm-summary.el Sun Feb 23 12:17:54 2003 *************** *** 344,346 **** (defun vm-summary-compile-format (format tokenize) ! (let ((return-value (vm-summary-compile-format-1 format tokenize))) (if tokenize --- 344,346 ---- (defun vm-summary-compile-format (format tokenize) ! (let ((return-value (nth 1 (vm-summary-compile-format-1 format tokenize)))) (if tokenize *************** *** 356,358 **** (insert tokens) ! (let (token) (while tokens --- 356,358 ---- (insert tokens) ! (let (token group-list) (while tokens *************** *** 363,364 **** --- 363,394 ---- (insert token))) + ((eq token 'group-begin) + (setq group-list (cons (list (point) (nth 1 tokens) + (nth 2 tokens)) + group-list) + tokens (cdr (cdr tokens)))) + ((eq token 'group-end) + (let* ((space (string-to-char " ")) + (blob (car group-list)) + (start (car blob)) + (field-width (nth 1 blob)) + (precision (nth 2 blob)) + (end (vm-marker (point)))) + (if (integerp field-width) + (if (< (- end start) (vm-abs field-width)) + (if (< field-width 0) + (insert-char space (vm-abs (+ field-width + (- end start)))) + (save-excursion + (goto-char start) + (insert-char space (- field-width + (- end start))))))) + (if (integerp precision) + (if (> (- end start) (vm-abs precision)) + (if (> precision 0) + (delete-char (- precision (- end start))) + (save-excursion + (goto-char start) + (delete-char (vm-abs (+ precision + (- end start)))))))) + (setq group-list (cdr group-list)))) ((eq token 'number) *************** *** 374,378 **** ! (defun vm-summary-compile-format-1 (format &optional tokenize) (let ((case-fold-search nil) ! (done nil) (list nil) --- 404,409 ---- ! (defun vm-summary-compile-format-1 (format &optional tokenize start-index) ! (or start-index (setq start-index 0)) (let ((case-fold-search nil) ! (finished-parsing-format nil) (list nil) *************** *** 380,396 **** (sexp-fmt nil) ! (last-match-end 0) ! token conv-spec) (store-match-data nil) ! (while (not done) ! (setq token nil) (while ! (and (not token) (string-match ! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([aAcdfFhHiIlLmMnstTwyz*%]\\|U[A-Za-z]\\)" ! format (match-end 0))) (setq conv-spec (aref format (match-beginning 5))) ! (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?H ?i ?L ?I ?l ?M ! ?m ?n ?s ?t ?T ?U ?w ?y ?z ?* )) (progn ! (cond ((= conv-spec ?a) (setq sexp (cons (list 'vm-su-attribute-indicators --- 411,453 ---- (sexp-fmt nil) ! (saw-close-group nil) ! (last-match-end start-index) ! new-match-end token conv-spec splice) (store-match-data nil) ! (while (and (not saw-close-group) (not finished-parsing-format)) ! (setq token nil ! splice nil) (while ! (and (not saw-close-group) (not token) (string-match ! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()aAcdfFhHiIlLmMnstTwyz*%]\\|U[A-Za-z]\\)" ! format last-match-end)) (setq conv-spec (aref format (match-beginning 5))) ! (setq new-match-end (match-end 0)) ! (if (and (memq conv-spec '(?\( ?\) ?a ?A ?c ?d ?f ?F ?h ?H ?i ?I ! ?l ?L ?M ?m ?n ?s ?t ?T ?U ?w ?y ?z ?* )) ! ;; for the non-tokenized path, we don't want ! ;; the close group spcifier processed here, we ! ;; want to just bail out and return, which is ! ;; accomplished by setting a flag in the other ! ;; branch of this 'if'. ! (or tokenize (not (= conv-spec ?\))))) (progn ! (cond ((= conv-spec ?\() ! (if (not tokenize) ! (save-match-data ! (let ((retval (vm-summary-compile-format-1 ! format tokenize (match-end 5)))) ! (setq sexp (cons (nth 1 retval) sexp) ! new-match-end (car retval)))) ! (setq token `('group-begin ! ,(if (match-beginning 2) ! (string-to-int ! (concat (match-string 1 format) ! (match-string 2 format)))) ! ,(string-to-int ! (match-string 4 format))) ! splice t))) ! ((= conv-spec ?\)) ! (setq token ''group-end)) ! ((= conv-spec ?a) (setq sexp (cons (list 'vm-su-attribute-indicators *************** *** 522,524 **** (setq sexp-fmt ! (cons "%%" (cons (substring format --- 579,583 ---- (setq sexp-fmt ! (cons (if (eq conv-spec ?\)) ! (prog1 "" (setq saw-close-group t)) ! "%%") (cons (substring format *************** *** 527,530 **** sexp-fmt)))) ! (setq last-match-end (match-end 0))) ! (if (not token) (setq sexp-fmt --- 586,589 ---- sexp-fmt)))) ! (setq last-match-end new-match-end)) ! (if (and (not saw-close-group) (not token)) (setq sexp-fmt *************** *** 532,534 **** sexp-fmt) ! done t)) (setq sexp-fmt (apply 'concat (nreverse sexp-fmt))) --- 591,593 ---- sexp-fmt) ! finished-parsing-format t)) (setq sexp-fmt (apply 'concat (nreverse sexp-fmt))) *************** *** 539,544 **** (setq list (nconc list (if (equal sexp "") nil (list sexp)) ! (and token (list token))) sexp nil sexp-fmt nil))) ! (if list (cons 'list list) sexp))) --- 598,603 ---- (setq list (nconc list (if (equal sexp "") nil (list sexp)) ! (and token (if splice token (list token)))) sexp nil sexp-fmt nil))) ! (list last-match-end (if list (cons 'list list) sexp)))) *************** *** 1100,1102 **** (defun vm-su-thread-indent (m) ! (if (natnump vm-summary-thread-indent-level) (make-string (* (vm-th-thread-indentation m) --- 1159,1161 ---- (defun vm-su-thread-indent (m) ! (if (and vm-summary-show-threads (natnump vm-summary-thread-indent-level)) (make-string (* (vm-th-thread-indentation m) *** dist/vm-vars.el.dist Fri Feb 14 16:19:38 2003 --- vm-vars.el Mon Mar 3 23:41:01 2003 *************** *** 1,3 **** ;;; VM user and internal variable initialization ! ;;; Copyright (C) 1989-1998 Kyle E. Jones ;;; --- 1,3 ---- ;;; VM user and internal variable initialization ! ;;; Copyright (C) 1989-2003 Kyle E. Jones ;;; *************** *** 2128,2129 **** --- 2128,2146 ---- + (defcustom vm-mime-forward-local-external-bodies nil + "*Non-nil value means forward messages that contain + message/external-body parts that use the `local-file' access + method. A nil value means copy the externally referenced objects + into the message before forwarding. This copying is only done + for objects accessed with the `local-file' access method. Objects + referenced with other method are not copied. + + Messages that use the mesage/external-body type contain a + reference to an object (image, audio, etc.) instead of the object + itself. So instead of the data that makes up an image, there + might be a reference to a local file that contains the image. If + the recipient doesn't have access to your local filesystems then + they will not be able to use the message/external-body reference. + That is why the default value of this variable is nil, which + forces such referneces to be converted to objects present in the + message itself.") *************** *** 2481,2482 **** --- 2498,2505 ---- * - `*' if the message is marked, ` ' otherwise + ( - starts a group, terminated by %). Useful for specifying + the field width and precision for the concatentation of + group of format specifiers. Example: \"%.35(%I%s%)\" + specifies a maximum display width of 35 characters for the + concatenation of the thread indentation and the subject. + ) - ends a group. *************** *** 2977,2979 **** ! (defcustom vm-url-retrieval-methods '(lynx wget w3m url-w3) "*Non-nil value specifies how VM is permitted to retrieve URLs. --- 3000,3002 ---- ! (defcustom vm-url-retrieval-methods '(lynx wget fetch curl w3m url-w3) "*Non-nil value specifies how VM is permitted to retrieve URLs. *************** *** 2985,2989 **** lynx - means VM should try to use the lynx program. ! 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. --- 3008,3013 ---- lynx - means VM should try to use the lynx program. ! wget - means VM should try to use the wget program. ! w3m - means VM should try to use the w3m program. ! fetch - means VM should try to use the fetch program. ! curl - means VM should try to use the curl program. *************** *** 2999,3000 **** --- 3023,3026 ---- (const w3m) + (const fetch) + (const curl) (const url-w3))) *************** *** 3574,3575 **** --- 3600,3619 ---- + (defcustom vm-konqueror-program "konqueror" + "*Name of program to use to run Konqueror. + `vm-mouse-send-url-to-konqueror' uses this." + :type 'string) + + (defcustom vm-konqueror-program-switches nil + "*List of command line switches to pass to Konqueror." + :type '(repeat string)) + + (defcustom vm-konqueror-client-program "kfmclient" + "*Name of program to use to issue requests to Konqueror. + `vm-mouse-send-url-to-konqueror' uses this." + :type 'string) + + (defcustom vm-konqueror-client-program-switches nil + "*List of command line switches to pass to Konqueror client." + :type '(repeat string)) + (defcustom vm-wget-program "wget" *************** *** 3584,3585 **** --- 3628,3640 ---- + (defcustom vm-fetch-program "fetch" + "*Name of program to use to run fetch. + This is used to retrieve URLs. Fetch is part of the standard + FreeBSD installation." + :type 'string) + + (defcustom vm-curl-program "curl" + "*Name of program to use to run curl. + This is used to retrieve URLs." + :type 'string) + (defcustom vm-lynx-program "lynx" *************** *** 4031,4032 **** --- 4086,4089 ---- (defconst vm-berkeley-mail-status-header-regexp "^Status: \\(..?\\)\n") + (defconst vm-internal-unforwarded-header-regexp + "\\(X-VM-\\|Status:\\|Content-Length:\\)") (defvar vm-matched-header-vector (make-vector 6 nil)) *************** *** 4413,4414 **** --- 4470,4473 ---- (make-variable-buffer-local 'vm-imap-retrieved-messages) + (defvar vm-imap-capabilities nil) + (defvar vm-imap-auth-methods nil) (defvar vm-pop-keep-failed-trace-buffers 5) *** dist/vm-version.el.dist Fri Feb 14 16:19:38 2003 --- vm-version.el Mon Mar 3 23:46:57 2003 *************** *** 4,6 **** ! (defconst vm-version "7.08" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "7.09" "Version number of VM.")