From 6c6e4090f03b7ea3653fd6da422ebfaf5d164b5c Mon Sep 17 00:00:00 2001 From: teranisi Date: Fri, 18 Oct 2002 07:20:12 +0000 Subject: [PATCH] Synch up with main trunk. --- doc/TODO | 1 - doc/TODO.ja | 1 - doc/wl-ja.texi | 13 ++++- doc/wl.texi | 13 ++++- wl/ChangeLog | 12 ++++ wl/wl-e21.el | 1 + wl/wl-mime.el | 168 +++++++++++++++++++++++++++++++++++++++++--------------- wl/wl-mule.el | 1 + wl/wl-xmas.el | 1 + 9 files changed, 163 insertions(+), 48 deletions(-) diff --git a/doc/TODO b/doc/TODO index 47fb924..f51a770 100644 --- a/doc/TODO +++ b/doc/TODO @@ -16,5 +16,4 @@ ** organize optional setting for pipe folders to download messages at once when one checks new messages ** support for rfc2192, rfc2193, rfc2221 (managing imap referral) -** cite region and insert into the draft ** putting codes in order diff --git a/doc/TODO.ja b/doc/TODO.ja index 2e92259..312b77f 100644 --- a/doc/TODO.ja +++ b/doc/TODO.ja @@ -17,5 +17,4 @@ ** $B%Q%$%W%U%)%k%@$K!"?75,%a!<%k%A%'%C%/;~$K%@%&%s%m!<%I$^$G$d$C$F$7$^$&(B $B%*%W%7%g%s$r@_$1$k(B ** rfc2192, rfc2193, rfc2221 (imap referral $B$N=hM}(B) $B$X$NBP1~(B -** $B%j!<%8%g%s$r%I%i%U%H$X0zMQ$G$-$k$h$&$K$9$k(B ** $B%3!<%I$N@0M}(B diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 0aac627..09e9926 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -4021,6 +4021,14 @@ Non-nil $B$J$i(B @code{wl-summary-jump-to-msg-by-message-id} $B$G!"%a%C%;!<%8 $B%a%C%;!<%8$r>e$K%9%/%m!<%k$7$^$9!#%a%C%;!<%8$N@hF,$^$GE~C#$9$k$H!"(B $BA0$N%a%C%;!<%8$K0\F0$7$^$9!#(B (@code{wl-message-wheel-up}) + +@item D +@kindex D (Message) +@findex wl-message-delete-current-part +$B%+!<%=%k0LCV$N%Q!<%H$r:o=|$7$^$9!#l9g$K$O!"%j!<%8%g%s$r0zMQ$7$^$9(B +(@code{transient-mark-mode} (GNU Emacs $B$N>l9g(B) $B$+(B @code{zmacs-regions} +(XEmacs $B$N>l9g(B) $B$,(B Non-nil $B$N;~$N$_(B)$B!#(B (@code{wl-draft-yank-original}) @item C-c C-p diff --git a/doc/wl.texi b/doc/wl.texi index 8f7e82b..3d134d0 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -4052,6 +4052,14 @@ moves to the previous message. Scrolls the message forward. When the bottom of the message is hit, moves to the next message. (@code{wl-message-wheel-up}) + +@item D +@kindex D (Message) +@findex wl-message-delete-current-part +Delete the part under cursor. In fact it appends modified message to +the current folder then moves old one to trash folder. Therefore the +message number will be changed. +(@code{wl-message-delete-current-part}) @end table @section Customizable Variables @@ -4457,7 +4465,10 @@ http://www.iecc.com/pop-before-smtp.html @item C-c C-y @kindex C-c C-y (Draft) @findex wl-draft-yank-original -Cites the content of the current message buffer. +Cites the content of the current message buffer (the part under cursor). +If the region is active, cites the region (it affects only if +@code{transient-mark-mode} (on GNU Emacs) or @code{zmacs-regions} +(on XEmacs) is Non-nil). (@code{wl-draft-yank-original}) @item C-c C-p diff --git a/wl/ChangeLog b/wl/ChangeLog index c830d73..7993c63 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -19,6 +19,18 @@ Set wl-draft-parent-number. (wl-draft-kill): Delete answered mark if it is a reply. +2002-10-18 Yoichi NAKAYAMA + + * wl-mime.el (wl-mime-preview-follow-current-region): New function + that originates in mime-preview-follow-current-entity. + (wl-draft-yank-current-message-entity): Use it if region is active. + + * wl-mime.el (wl-message-delete-current-part): Remove restriction. + * wl-e21.el (wl-message-define-keymap): Bind "D" for + `wl-message-delete-current-part'. + * wl-mule.el (wl-message-define-keymap): Ditto. + * wl-xmas.el (wl-message-define-keymap): Ditto. + 2002-10-16 Yoichi NAKAYAMA * wl-mime.el (wl-message-delete-current-part): New function. diff --git a/wl/wl-e21.el b/wl/wl-e21.el index bd8c203..49110ef 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -528,6 +528,7 @@ (defun wl-message-define-keymap () (let ((keymap (make-sparse-keymap))) + (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) (define-key keymap [mouse-4] 'wl-message-wheel-down) (define-key keymap [mouse-5] 'wl-message-wheel-up) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 9df89f8..9d0c402 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -51,7 +51,11 @@ (defun wl-draft-yank-current-message-entity () "Yank currently displayed message entity. -By setting following-method as yank-content." +By setting following-method as yank-content. + +If region is active, yank region contents instead. \(this feature is available +if and only if `transient-mark-mode' \(GNU Emacs\) or `zmacs-regions' \(XEmacs\) +has Non-nil value\)" (let ((wl-draft-buffer (current-buffer)) (mime-view-following-method-alist (list (cons 'wl-original-message-mode @@ -61,10 +65,84 @@ By setting following-method as yank-content." (function wl-draft-yank-to-draft-buffer))))) (if (get-buffer (wl-current-message-buffer)) (save-excursion + (set-buffer (wl-current-message-buffer)) (save-restriction - (set-buffer (wl-current-message-buffer)) (widen) - (mime-preview-follow-current-entity)))))) + (if (or (and wl-on-xemacs + zmacs-regions zmacs-region-active-p) + (and transient-mark-mode mark-active)) + (wl-mime-preview-follow-current-region) + (mime-preview-follow-current-entity))))))) + +;; modified mime-preview-follow-current-entity from mime-view.el +(defun wl-mime-preview-follow-current-region () + "Write follow message to current region. +It calls following-method selected from variable +`mime-preview-following-method-alist'." + (interactive) + (let ((r-beg (region-beginning)) + (r-end (region-end)) + (entity (get-text-property (point-min) + 'mime-view-entity))) + (let* ((mode (mime-preview-original-major-mode 'recursive)) + (new-name + (format "%s-active-region" (buffer-name))) + new-buf + (the-buf (current-buffer)) + fields) + (save-excursion + (set-buffer (setq new-buf (get-buffer-create new-name))) + (erase-buffer) + (insert ?\n) + (insert-buffer-substring the-buf r-beg r-end) + (goto-char (point-min)) + (let ((current-entity + (if (and (eq (mime-entity-media-type entity) 'message) + (eq (mime-entity-media-subtype entity) 'rfc822)) + (car (mime-entity-children entity)) + entity))) + (while (and current-entity + (if (and (eq (mime-entity-media-type + current-entity) 'message) + (eq (mime-entity-media-subtype + current-entity) 'rfc822)) + nil + (mime-insert-header current-entity fields) + t)) + (setq fields (std11-collect-field-names) + current-entity (mime-entity-parent current-entity)) + )) + (let ((rest mime-view-following-required-fields-list) + field-name ret) + (while rest + (setq field-name (car rest)) + (or (std11-field-body field-name) + (progn + (save-excursion + (set-buffer the-buf) + (let ((entity (when mime-mother-buffer + (set-buffer mime-mother-buffer) + (get-text-property (point) + 'mime-view-entity)))) + (while (and entity + (null (setq ret (mime-entity-fetch-field + entity field-name)))) + (setq entity (mime-entity-parent entity))))) + (if ret + (insert (concat field-name ": " ret "\n")) + ))) + (setq rest (cdr rest)) + )) + ) + (let ((f (cdr (assq mode mime-preview-following-method-alist)))) + (if (functionp f) + (funcall f new-buf) + (message + (format + "Sorry, following method for %s is not implemented yet." + mode)) + )) + ))) (defalias 'wl-draft-enclose-digest-region 'mime-edit-enclose-digest-region) @@ -176,47 +254,49 @@ By setting following-method as yank-content." (defun wl-message-delete-current-part () "Delete a part under the cursor from the multipart message." (interactive) - (let* ((entity (get-text-property (point) 'mime-view-entity)) - (node-id (mime-entity-node-id entity)) - (header-start (mime-buffer-entity-header-start-internal entity)) - (body-end (mime-buffer-entity-body-end-internal entity)) - (folder (wl-folder-get-elmo-folder wl-message-buffer-cur-folder)) - (number wl-message-buffer-cur-number) - (msgid (elmo-message-field folder number 'message-id)) - (orig-buf wl-message-buffer-original-buffer)) - (if (eq (luna-class-name entity) 'mime-elmo-imap-entity) - (error "Please fetch the entire message (by typing 'C-u .') and try again")) - (with-current-buffer orig-buf - (unless (string-equal - (buffer-string) - (elmo-message-fetch folder number - (elmo-make-fetch-strategy 'entire))) - (error "Buffer content differs from actual message"))) - (when (and (elmo-folder-writable-p folder) - (buffer-live-p orig-buf) - node-id - (yes-or-no-p - (format "Do you really want to delete part %s? " - (wl-mime-node-id-to-string node-id)))) - (with-temp-buffer - (insert-buffer orig-buf) - (kill-region header-start body-end) - (goto-char header-start) - (insert "Content-Type: text/plain; charset=US-ASCII\n\n") - (insert "** This part has been removed by Wanderlust **\n\n") - (elmo-folder-append-buffer folder t)) - - (elmo-folder-append-messages - (wl-folder-get-elmo-folder wl-trash-folder) - folder (list number) nil) - (elmo-folder-delete-messages folder (list number)) - - (when (file-exists-p (elmo-cache-get-path msgid)) - (delete-file (elmo-cache-get-path msgid))) - - (mime-preview-quit) - (wl-summary-toggle-disp-msg 'off) - (wl-summary-sync nil "update")))) + (save-restriction + (widen) + (let* ((entity (get-text-property (point) 'mime-view-entity)) + (node-id (mime-entity-node-id entity)) + (header-start (mime-buffer-entity-header-start-internal entity)) + (body-end (mime-buffer-entity-body-end-internal entity)) + (folder (wl-folder-get-elmo-folder wl-message-buffer-cur-folder)) + (number wl-message-buffer-cur-number) + (msgid (elmo-message-field folder number 'message-id)) + (orig-buf wl-message-buffer-original-buffer)) + (if (eq (luna-class-name entity) 'mime-elmo-imap-entity) + (error "Please fetch the entire message (by typing 'C-u .') and try again")) + (with-current-buffer orig-buf + (unless (string-equal + (buffer-string) + (elmo-message-fetch folder number + (elmo-make-fetch-strategy 'entire))) + (error "Buffer content differs from actual message"))) + (when (and (elmo-folder-writable-p folder) + (buffer-live-p orig-buf) + node-id + (yes-or-no-p + (format "Do you really want to delete part %s? " + (wl-mime-node-id-to-string node-id)))) + (with-temp-buffer + (insert-buffer orig-buf) + (kill-region header-start body-end) + (goto-char header-start) + (insert "Content-Type: text/plain; charset=US-ASCII\n\n") + (insert "** This part has been removed by Wanderlust **\n\n") + (elmo-folder-append-buffer folder t)) + + (elmo-folder-append-messages + (wl-folder-get-elmo-folder wl-trash-folder) + folder (list number) nil) + (elmo-folder-delete-messages folder (list number)) + + (when (file-exists-p (elmo-cache-get-path msgid)) + (delete-file (elmo-cache-get-path msgid))) + + (mime-preview-quit) + (wl-summary-toggle-disp-msg 'off) + (wl-summary-sync nil "update"))))) ;;; Summary (defun wl-summary-burst-subr (message-entity target number) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 7dc9f6e..985768d 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -100,6 +100,7 @@ Special commands: (defun wl-message-define-keymap () (let ((keymap (make-sparse-keymap))) + (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) (define-key keymap [mouse-4] 'wl-message-wheel-down) (define-key keymap [mouse-5] 'wl-message-wheel-up) diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index d3d42b5..93da3a2 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -446,6 +446,7 @@ (defun wl-message-define-keymap () (let ((keymap (make-sparse-keymap))) + (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) (define-key keymap 'button4 'wl-message-wheel-down) (define-key keymap 'button5 'wl-message-wheel-up) -- 1.7.10.4