*** dist/README.dist Thu Nov 23 16:16:54 2000 --- README Mon Nov 27 15:39:08 2000 *************** *** 3,6 **** 0) Look at the Makefile and review the values of EMACS, INFODIR, ! LISPDIR, and PIXMAPDIR. If they are not right for your system, ! change them. --- 3,6 ---- 0) Look at the Makefile and review the values of EMACS, INFODIR, ! LISPDIR, BINDIR and PIXMAPDIR. If they are not right for your ! system, change them. *************** *** 27,32 **** want or just leave them where they are. Be sure to point the ! variable vm-toolbar-pixmap-directory at the direrctory where ! you put the files. That is (setq vm-toolbar-pixmap-directory "/path/to/pixmaps") --- 27,33 ---- want or just leave them where they are. Be sure to point the ! variables vm-toolbar-pixmap-directory and vm-image-directory at ! the direrctory where you put the files. That is (setq vm-toolbar-pixmap-directory "/path/to/pixmaps") + (setq vm-image-directory "/path/to/pixmaps") *** dist/Makefile.dist Thu Nov 23 16:16:54 2000 --- Makefile Mon Nov 27 14:51:42 2000 *************** *** 18,20 **** # where the binaries should be go. - # only used if you 'make install-utils' BINDIR = /usr/local/bin --- 18,19 ---- *************** *** 108,113 **** ! install: all cp vm.info vm.info-* $(INFODIR) cp *.elc $(LISPDIR) ! cp pixmaps/*.xpm $(PIXMAPDIR) cp $(UTILS) $(BINDIR) --- 107,120 ---- ! install: all install-info install-vm install-pixmaps install-utils ! ! install-info: vm.info cp vm.info vm.info-* $(INFODIR) + + install-vm: vm.elc cp *.elc $(LISPDIR) ! ! install-pixmaps: ! cp pixmaps/*.x[pb]m $(PIXMAPDIR) ! ! install-utils: $(UTILS) cp $(UTILS) $(BINDIR) *** dist/vm-delete.el.dist Tue Nov 14 21:42:27 2000 --- vm-delete.el Sun Nov 26 22:23:19 2000 *************** *** 30,32 **** ! When invoked on marked messages (via vm-next-command-uses-marks), only marked messages are deleted, other messages are ignored." --- 30,32 ---- ! When invoked on marked messages (via `vm-next-command-uses-marks'), only marked messages are deleted, other messages are ignored." *************** *** 77,79 **** ! When invoked on marked messages (via vm-next-command-uses-marks), only marked messages are undeleted, other messages are ignored." --- 77,79 ---- ! When invoked on marked messages (via `vm-next-command-uses-marks'), only marked messages are undeleted, other messages are ignored." *************** *** 152,153 **** --- 152,201 ---- + (defun vm-delete-duplicate-messages () + "Delete duplicate messages in the current folder. + This command works by computing an MD5 hash for each non-deleted + message in the folder and deleting messages that have a hash that + has already been seen. Messages that already deleted are never + hashed, so VM will never delete the last copy of a message in a + folder. 'Deleting' means flagging for deletion; you will have to + expunge the messages with `vm-expunge-folder' to really get rid + of them. as usual. + + When invoked on marked messages (via `vm-next-command-uses-marks'), + only duplicate messages among the marked messages are deleted, + unmarked messages are not hashed or considerd for deletion." + (interactive) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-read-only) + (vm-error-if-folder-empty) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (mlist vm-message-list) + (table (make-vector 61 0)) + hash + (del-count 0)) + (if used-marks + (setq mlist (vm-select-marked-or-prefixed-messages 0))) + (save-excursion + (save-restriction + (widen) + (while mlist + (if (vm-deleted-flag (car mlist)) + nil + (setq hash (vm-md5-region (vm-text-of (car mlist)) + (vm-text-end-of (car mlist)))) + (if (intern-soft hash table) + (progn + (vm-set-deleted-flag (car mlist) t) + (vm-increment del-count)) + (intern hash table))) + (setq mlist (cdr mlist))))) + (vm-display nil nil '(vm-delete-duplicate-messages) + (list this-command)) + (if (zerop del-count) + (message "No messages deleted") + (message "%d message%s deleted" + del-count + (if (= 1 del-count) "" "s"))) + (vm-update-summary-and-mode-line))) + (defun vm-expunge-folder (&optional shaddap) *************** *** 163,165 **** ! When invoked on marked messages (via vm-next-command-uses-marks), only messages both marked and deleted are expunged, other messages are --- 211,213 ---- ! When invoked on marked messages (via `vm-next-command-uses-marks'), only messages both marked and deleted are expunged, other messages are *** dist/vm-folder.el.dist Thu Nov 23 16:16:54 2000 --- vm-folder.el Wed Nov 29 08:11:56 2000 *************** *** 3445,3484 **** (mail-waiting nil)) ! (while (and triples (not done)) ! (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) ! maildrop (nth 1 (car triples)) ! crash (nth 2 (car triples))) ! (if (vm-movemail-specific-spool-file-p maildrop) ! ;; spool file is accessible only with movemail ! ;; so skip it. ! nil ! (if (eq (current-buffer) (vm-get-file-buffer in)) ! (progn ! (if (file-exists-p crash) ! (progn ! (setq mail-waiting t ! done t)) ! (cond ((and vm-recognize-imap-maildrops ! (string-match vm-recognize-imap-maildrops ! maildrop)) ! (setq meth 'vm-imap-check-mail)) ! ((and vm-recognize-pop-maildrops ! (string-match vm-recognize-pop-maildrops ! maildrop)) ! (setq meth 'vm-pop-check-mail)) ! (t (setq meth 'vm-spool-check-mail))) ! (if (not interactive) ! ;; allow no error to be signaled ! (condition-case nil ! (setq mail-waiting ! (or mail-waiting ! (funcall meth maildrop))) ! (error nil)) ! (setq mail-waiting ! (or mail-waiting ! (funcall meth maildrop)))) ! (if mail-waiting ! (setq done t)))))) ! (setq triples (cdr triples))) ! (setq vm-spooled-mail-waiting mail-waiting) ! mail-waiting ))) --- 3445,3490 ---- (mail-waiting nil)) ! ;; vm-block-new-mail is bound and it is a local variable. ! ;; Emacs 19 has a bug where if the current buffer changes ! ;; while such a variable is bound, the wrong buffers value ! ;; of the variable is restored. So we protect against ! ;; this. ! (save-excursion ! (while (and triples (not done)) ! (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) ! maildrop (nth 1 (car triples)) ! crash (nth 2 (car triples))) ! (if (vm-movemail-specific-spool-file-p maildrop) ! ;; spool file is accessible only with movemail ! ;; so skip it. ! nil ! (if (eq (current-buffer) (vm-get-file-buffer in)) ! (progn ! (if (file-exists-p crash) ! (progn ! (setq mail-waiting t ! done t)) ! (cond ((and vm-recognize-imap-maildrops ! (string-match vm-recognize-imap-maildrops ! maildrop)) ! (setq meth 'vm-imap-check-mail)) ! ((and vm-recognize-pop-maildrops ! (string-match vm-recognize-pop-maildrops ! maildrop)) ! (setq meth 'vm-pop-check-mail)) ! (t (setq meth 'vm-spool-check-mail))) ! (if (not interactive) ! ;; allow no error to be signaled ! (condition-case nil ! (setq mail-waiting ! (or mail-waiting ! (funcall meth maildrop))) ! (error nil)) ! (setq mail-waiting ! (or mail-waiting ! (funcall meth maildrop)))) ! (if mail-waiting ! (setq done t)))))) ! (setq triples (cdr triples))) ! (setq vm-spooled-mail-waiting mail-waiting) ! mail-waiting )))) *************** *** 3497,3587 **** (got-mail nil)) ! (if (and (not (verify-visited-file-modtime (current-buffer))) ! (or (null interactive) ! (not (yes-or-no-p ! (format ! "Folder %s changed on disk, discard those changes? " ! (buffer-name (current-buffer))))))) ! (progn ! (message "Folder %s changed on disk, consider M-x revert-buffer" ! (buffer-name (current-buffer))) ! (sleep-for 2) ! nil ) ! (while triples ! (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) ! maildrop (nth 1 (car triples)) ! crash (nth 2 (car triples))) ! (setq safe-maildrop maildrop ! non-file-maildrop nil) ! (cond ((vm-movemail-specific-spool-file-p maildrop) ! (setq non-file-maildrop t) ! (setq retrieval-function 'vm-spool-move-mail)) ! ((and vm-recognize-imap-maildrops ! (string-match vm-recognize-imap-maildrops ! maildrop)) ! (setq non-file-maildrop t) ! (setq safe-maildrop (vm-safe-imapdrop-string maildrop)) ! (setq retrieval-function 'vm-imap-move-mail)) ! ((and vm-recognize-pop-maildrops ! (string-match vm-recognize-pop-maildrops ! maildrop)) ! (setq non-file-maildrop t) ! (setq safe-maildrop (vm-safe-popdrop-string maildrop)) ! (setq retrieval-function 'vm-pop-move-mail)) ! (t (setq retrieval-function 'vm-spool-move-mail))) ! (if (eq (current-buffer) (vm-get-file-buffer in)) ! (progn ! (if (file-exists-p crash) ! (progn ! (message "Recovering messages from %s..." crash) ! (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) ! (message "Recovering messages from %s... done" crash))) ! (if (or non-file-maildrop ! (and (not (equal 0 (nth 7 (file-attributes maildrop)))) ! (file-readable-p maildrop))) ! (progn ! (setq crash (expand-file-name crash vm-folder-directory)) ! (if (not non-file-maildrop) ! (setq maildrop (expand-file-name maildrop ! vm-folder-directory))) ! (if (if got-mail ! ;; don't allow errors to be signaled unless no ! ;; mail has been appended to the incore ! ;; copy of the folder. otherwise the ! ;; user will wonder where the mail is, ! ;; since it is not in the crash box or ! ;; the spool file and doesn't _appear_ to ! ;; be in the folder either. ! (condition-case error-data ! (funcall retrieval-function maildrop crash) ! (error (message "%s signaled: %s" ! retrieval-function ! error-data) ! (sleep-for 2) ! ;; we don't know if mail was ! ;; put into the crash box or ! ;; not, so return t just to be ! ;; safe. ! t ) ! (quit (message "quitting from %s..." ! retrieval-function) ! (sleep-for 2) ! ;; we don't know if mail was ! ;; put into the crash box or ! ;; not, so return t just to be ! ;; safe. ! t )) ! (funcall retrieval-function maildrop crash)) ! (if (vm-gobble-crash-box crash) ! (progn ! (setq got-mail t) ! (message "Got mail from %s." ! safe-maildrop)))))))) ! (setq triples (cdr triples))) ! ;; not really correct, but it is what the user expects to see. ! (setq vm-spooled-mail-waiting nil) ! (intern (buffer-name) vm-buffers-needing-display-update) ! (vm-update-summary-and-mode-line) ! (if got-mail ! (run-hooks 'vm-retrieved-spooled-mail-hook)) ! got-mail ))) --- 3503,3599 ---- (got-mail nil)) ! ;; vm-block-new-mail is bound and it is a local variable. ! ;; Emacs 19 has a bug where if the current buffer changes ! ;; while such a variable is bound, the wrong buffers value ! ;; of the variable is restored. So we protect against ! ;; this. ! (save-excursion ! (if (and (not (verify-visited-file-modtime (current-buffer))) ! (or (null interactive) ! (not (yes-or-no-p ! (format ! "Folder %s changed on disk, discard those changes? " ! (buffer-name (current-buffer))))))) ! (progn ! (message "Folder %s changed on disk, consider M-x revert-buffer" ! (buffer-name (current-buffer))) ! (sleep-for 2) ! nil ) ! (while triples ! (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) ! maildrop (nth 1 (car triples)) ! crash (nth 2 (car triples))) ! (setq safe-maildrop maildrop ! non-file-maildrop nil) ! (cond ((vm-movemail-specific-spool-file-p maildrop) ! (setq non-file-maildrop t) ! (setq retrieval-function 'vm-spool-move-mail)) ! ((and vm-recognize-imap-maildrops ! (string-match vm-recognize-imap-maildrops ! maildrop)) ! (setq non-file-maildrop t) ! (setq safe-maildrop (vm-safe-imapdrop-string maildrop)) ! (setq retrieval-function 'vm-imap-move-mail)) ! ((and vm-recognize-pop-maildrops ! (string-match vm-recognize-pop-maildrops ! maildrop)) ! (setq non-file-maildrop t) ! (setq safe-maildrop (vm-safe-popdrop-string maildrop)) ! (setq retrieval-function 'vm-pop-move-mail)) ! (t (setq retrieval-function 'vm-spool-move-mail))) ! (if (eq (current-buffer) (vm-get-file-buffer in)) ! (progn ! (if (file-exists-p crash) ! (progn ! (message "Recovering messages from %s..." crash) ! (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) ! (message "Recovering messages from %s... done" crash))) ! (if (or non-file-maildrop ! (and (not (equal 0 (nth 7 (file-attributes maildrop)))) ! (file-readable-p maildrop))) ! (progn ! (setq crash (expand-file-name crash vm-folder-directory)) ! (if (not non-file-maildrop) ! (setq maildrop (expand-file-name maildrop ! vm-folder-directory))) ! (if (if got-mail ! ;; don't allow errors to be signaled unless no ! ;; mail has been appended to the incore ! ;; copy of the folder. otherwise the ! ;; user will wonder where the mail is, ! ;; since it is not in the crash box or ! ;; the spool file and doesn't _appear_ to ! ;; be in the folder either. ! (condition-case error-data ! (funcall retrieval-function maildrop crash) ! (error (message "%s signaled: %s" ! retrieval-function ! error-data) ! (sleep-for 2) ! ;; we don't know if mail was ! ;; put into the crash box or ! ;; not, so return t just to be ! ;; safe. ! t ) ! (quit (message "quitting from %s..." ! retrieval-function) ! (sleep-for 2) ! ;; we don't know if mail was ! ;; put into the crash box or ! ;; not, so return t just to be ! ;; safe. ! t )) ! (funcall retrieval-function maildrop crash)) ! (if (vm-gobble-crash-box crash) ! (progn ! (setq got-mail t) ! (message "Got mail from %s." ! safe-maildrop)))))))) ! (setq triples (cdr triples))) ! ;; not really correct, but it is what the user expects to see. ! (setq vm-spooled-mail-waiting nil) ! (intern (buffer-name) vm-buffers-needing-display-update) ! (vm-update-summary-and-mode-line) ! (if got-mail ! (run-hooks 'vm-retrieved-spooled-mail-hook)) ! got-mail )))) *** dist/vm-mime.el.dist Sun Nov 26 16:19:33 2000 --- vm-mime.el Wed Nov 29 11:34:08 2000 *************** *** 251,253 **** ((and (featurep 'base64) ! (fboundp 'base64-decode-region)) (condition-case data --- 251,256 ---- ((and (featurep 'base64) ! (fboundp 'base64-decode-region) ! ;; W3 reportedly has a Lisp version of this, and ! ;; there's no point running it. ! (subrp (symbol-function 'base64-decode-region))) (condition-case data *************** *** 333,335 **** ((and (featurep 'base64) ! (fboundp 'base64-encode-region)) (condition-case data --- 336,341 ---- ((and (featurep 'base64) ! (fboundp 'base64-encode-region) ! ;; W3 reportedly has a Lisp version of this, and ! ;; there's no point running it. ! (subrp (symbol-function 'base64-encode-region))) (condition-case data *************** *** 605,608 **** (coding-system-for-write (vm-binary-coding-system)) - (process-coding-system-alist - (list (cons "." (vm-binary-coding-system)))) (status (apply 'vm-run-command-on-region --- 611,612 ---- *************** *** 1043,1047 **** (real-m (vm-real-message-of m)) ! (modified (buffer-modified-p)) ! (coding-system-for-read (vm-binary-coding-system)) ! (coding-system-for-write (vm-binary-coding-system))) (cond ((or (null vm-presentation-buffer-handle) --- 1047,1049 ---- (real-m (vm-real-message-of m)) ! (modified (buffer-modified-p))) (cond ((or (null vm-presentation-buffer-handle) *************** *** 1192,1194 **** (goto-char (point-min)) ! (and (re-search-forward "[\200-\377]" nil t) (throw 'done "8bit")) --- 1194,1196 ---- (goto-char (point-min)) ! (and (re-search-forward "[^\000-\177]" nil t) (throw 'done "8bit")) *************** *** 2330,2331 **** --- 2332,2334 ---- (let ((start (point-marker)) end tempfile + (coding-system-for-write (vm-binary-coding-system)) (selective-display nil) *************** *** 2341,2344 **** (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) --- 2344,2345 ---- *************** *** 2670,2673 **** (unwind-protect ! (let ((coding-system-for-read (vm-binary-coding-system)) ! (coding-system-for-write (vm-binary-coding-system))) (setq work-buffer (vm-make-work-buffer)) --- 2671,2673 ---- (unwind-protect ! (let ((coding-system-for-read (vm-binary-coding-system))) (setq work-buffer (vm-make-work-buffer)) *************** *** 2715,2717 **** ;; 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 --- 2715,2717 ---- ;; Tell DOS/Windows NT whether the file is binary ! (setq buffer-file-type t) ;; Tell XEmacs/MULE not to mess with the bits unless *************** *** 2719,2724 **** (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))) (vm-mime-insert-mime-body layout) --- 2719,2722 ---- (if (fboundp 'set-buffer-file-coding-system) ! (set-buffer-file-coding-system ! (vm-line-ending-coding-system) nil)) (vm-mime-insert-mime-body layout) *** dist/vm-misc.el.dist Sun Nov 26 16:19:33 2000 --- vm-misc.el Sun Nov 26 22:07:29 2000 *************** *** 184,186 **** (let ((temp-buffer nil) - (coding-system-for-read (vm-line-ending-coding-system)) (coding-system-for-write (vm-line-ending-coding-system))) --- 184,185 ---- *************** *** 825 **** --- 824,846 ---- (delete-region (- (point) 1) (- (point) 4)))))) + + (defun vm-md5-region (start end) + (if (fboundp 'md5) + (md5 (current-buffer) start end) + (let ((buffer nil) + (curbuf (current-buffer))) + (unwind-protect + (save-excursion + (setq buffer (vm-make-work-buffer)) + (set-buffer buffer) + (insert-buffer-substring curbuf start end) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") t buffer nil + shell-command-switch vm-pop-md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) + (and buffer (kill-buffer buffer)))))) *** dist/vm-page.el.dist Thu Nov 23 16:16:54 2000 --- vm-page.el Mon Nov 27 11:52:20 2000 *************** *** 906,908 **** (if next ! 'next-etent-change 'previous-extent-change) --- 906,908 ---- (if next ! 'next-extent-change 'previous-extent-change) *************** *** 912,916 **** 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))) --- 912,913 ---- *************** *** 919,923 **** (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))) --- 916,921 ---- (if e ! (progn ! (if (or (vm-extent-property e 'keymap) ! (vm-extent-property e 'local-map)) ! (vm-decrement count)) (goto-char (funcall extent-end-position e))) *** dist/vm-reply.el.dist Tue Nov 14 21:42:27 2000 --- vm-reply.el Mon Nov 27 01:11:57 2000 *************** *** 1079,1081 **** (let ((address (car (vm-parse url "^mailto:\\(.+\\)")))) ! (setq address (vm-url-decode address)) (vm-select-folder-buffer) --- 1079,1081 ---- (let ((address (car (vm-parse url "^mailto:\\(.+\\)")))) ! (setq address (vm-url-decode-string address)) (vm-select-folder-buffer) *** dist/vm-startup.el.dist Sun Nov 26 16:19:34 2000 --- vm-startup.el Wed Nov 29 20:38:21 2000 *************** *** 339,341 **** ! This is VM 6.86. --- 339,341 ---- ! This is VM 6.87. *** dist/vm-toolbar.el.dist Sun Nov 26 16:19:34 2000 --- vm-toolbar.el Sun Nov 26 18:29:02 2000 *************** *** 326,328 **** (if vm-fsfemacs-p ! (if vm-fsfemacs-toolbar-installed-p (vm-toolbar-fsfemacs-install-toolbar)) --- 326,328 ---- (if vm-fsfemacs-p ! (if (not vm-fsfemacs-toolbar-installed-p) (vm-toolbar-fsfemacs-install-toolbar)) *** dist/vm-undo.el.dist Fri May 21 01:07:45 1999 --- vm-undo.el Mon Nov 27 16:40:45 2000 *************** *** 305,307 **** A numeric prefix argument COUNT causes the current message and ! the next COUNT-1 message to have the labels added. A negative COUNT arg causes the current message and the previous --- 305,307 ---- A numeric prefix argument COUNT causes the current message and ! the next COUNT-1 messages to have the labels added. A negative COUNT arg causes the current message and the previous *************** *** 379,380 **** --- 379,381 ---- "[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*")) + (ignored-labels nil) labels act-labels m mm-list) *************** *** 391,395 **** (if (intern-soft (car act-labels) vm-label-obarray) ! (setq newlist (cons (car act-labels) newlist))) (setq act-labels (cdr act-labels))) (setq action-labels newlist)))) (while m-list --- 392,399 ---- (if (intern-soft (car act-labels) vm-label-obarray) ! (setq newlist (cons (car act-labels) newlist)) ! (setq ignored-labels (cons (car act-labels) ignored-labels))) (setq act-labels (cdr act-labels))) (setq action-labels newlist)))) + (if (null action-labels) + (setq m-list nil)) (while m-list *************** *** 425,428 **** (vm-set-labels (car m-list) labels) ! (setq m-list (cdr m-list)))) ! (vm-update-summary-and-mode-line)) --- 429,433 ---- (vm-set-labels (car m-list) labels) ! (setq m-list (cdr m-list))) ! (vm-update-summary-and-mode-line) ! ignored-labels)) *** dist/vm-version.el.dist Sun Nov 26 16:19:34 2000 --- vm-version.el Wed Nov 29 20:38:21 2000 *************** *** 4,6 **** ! (defconst vm-version "6.86" "Version number of VM.") --- 4,6 ---- ! (defconst vm-version "6.87" "Version number of VM.") *** dist/vm-window.el.dist Sun Nov 26 16:19:35 2000 --- vm-window.el Wed Nov 29 19:34:03 2000 *************** *** 454,456 **** (save-window-excursion ! (switch-to-buffer buffer)))) --- 454,461 ---- (save-window-excursion ! ;; catch errors--- the selected window might be a dedicated ! ;; window or a minibuffer window. We don't care and we ! ;; don't want to crash because of it. ! (condition-case data ! (switch-to-buffer buffer) ! (error nil)))))