From 6bcf0774dce897a429a04ee0039b0ecfed9be452 Mon Sep 17 00:00:00 2001 From: teranisi Date: Tue, 31 Aug 2004 13:23:46 +0000 Subject: [PATCH] * wl-vars.el (wl-reply-hook): Abolish. (wl-draft-reply-hook): New hook. (wl-summary-reply-hook): Ditto. (wl-draft-forward-hook): Ditto. (wl-summary-forward-hook): Ditto. (wl-draft-kill-flags): New variable. * wl-summary.el (wl-summary-mark-as-answered-region): Use wl-summary-set-persistent-mark-internal. (wl-summary-sync-marks): Use elmo-preserved-flags. (wl-summary-update-persistent-mark): Make it interactive. (wl-summary-set-persistent-mark-internal): New inline function. (wl-summary-mark-as-answered): Use it. (wl-summary-mark-as-unanswered): Ditto. (wl-summary-unset-persistent-mark): New function. (wl-summary-set-persistent-mark): Ditto. (wl-summary-reply): Don't set answered flag; Run wl-summary-reply-hook instead. (wl-summary-forward): Call wl-draft-forward with number. Run wl-summary-forward-hook. * wl-highlight.el (wl-summary-persistent-mark-face): New face. (wl-highlight-summary-line-face-spec): Use it as a default persistent mark face. * wl-draft.el (wl-draft-forward): Added optional argument number; Set wl-draft-parent-number; Run wl-draft-forward-hook. (wl-draft-reply): Run wl-draft-reply-hook instead of wl-reply-hook. (wl-draft-kill): Use wl-draft-kill-flags. --- wl/ChangeLog | 30 ++++++++++ wl/wl-draft.el | 11 ++-- wl/wl-highlight.el | 20 ++++++- wl/wl-summary.el | 154 +++++++++++++++++++++++++++++++--------------------- wl/wl-vars.el | 25 ++++++++- 5 files changed, 169 insertions(+), 71 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index c55fc6a..2ece5c4 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,35 @@ 2004-08-31 Yuuichi Teranishi + * wl-vars.el (wl-reply-hook): Abolish. + (wl-draft-reply-hook): New hook. + (wl-summary-reply-hook): Ditto. + (wl-draft-forward-hook): Ditto. + (wl-summary-forward-hook): Ditto. + (wl-draft-kill-flags): New variable. + + * wl-summary.el (wl-summary-mark-as-answered-region): Use + wl-summary-set-persistent-mark-internal. + (wl-summary-sync-marks): Use elmo-preserved-flags. + (wl-summary-update-persistent-mark): Make it interactive. + (wl-summary-set-persistent-mark-internal): New inline function. + (wl-summary-mark-as-answered): Use it. + (wl-summary-mark-as-unanswered): Ditto. + (wl-summary-unset-persistent-mark): New function. + (wl-summary-set-persistent-mark): Ditto. + (wl-summary-reply): Don't set answered flag; + Run wl-summary-reply-hook instead. + (wl-summary-forward): Call wl-draft-forward with number. + Run wl-summary-forward-hook. + + * wl-highlight.el (wl-summary-persistent-mark-face): New face. + (wl-highlight-summary-line-face-spec): Use it as a default + persistent mark face. + + * wl-draft.el (wl-draft-forward): Added optional argument number; + Set wl-draft-parent-number; Run wl-draft-forward-hook. + (wl-draft-reply): Run wl-draft-reply-hook instead of wl-reply-hook. + (wl-draft-kill): Use wl-draft-kill-flags. + * wl-vars.el (wl-summary-answered-uncached-mark): Fixed typo. * wl-folder.el (wl-folder-check-one-entity): Follow the change diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 633770d..f7253a2 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -271,7 +271,7 @@ e.g. wl-subject-re-prefix-regexp))) (t original-subject))) -(defun wl-draft-forward (original-subject summary-buf) +(defun wl-draft-forward (original-subject summary-buf &optional number) (let (references parent-folder subject) (with-current-buffer summary-buf (setq parent-folder (wl-summary-buffer-folder-name))) @@ -293,9 +293,11 @@ e.g. (cons 'Subject subject) (cons 'References references)) nil nil nil nil parent-folder)) + (setq wl-draft-parent-number number) (goto-char (point-max)) (wl-draft-insert-message) - (mail-position-on-field "To")) + (mail-position-on-field "To") + (run-hooks 'wl-draft-forward-hook)) (defun wl-draft-self-reply-p () "Return t when From address in the current message is user's self one or not." @@ -462,7 +464,7 @@ Reply to author if WITH-ARG is non-nil." (setq wl-draft-config-variables (append wl-draft-reply-saved-variables wl-draft-config-variables))) - (run-hooks 'wl-reply-hook)) + (run-hooks 'wl-draft-reply-hook)) (defun wl-draft-reply-position (position) (cond ((eq position 'body) @@ -783,7 +785,8 @@ Reply to author if WITH-ARG is non-nil." (string= (wl-summary-buffer-folder-name) folder-name))) (with-current-buffer buffer - (elmo-folder-unset-flag folder (list number) 'answered) + (dolist (flag wl-draft-kill-flags) + (elmo-folder-unset-flag folder (list number) flag)) (when (wl-summary-jump-to-msg number) (wl-summary-update-persistent-mark))) (elmo-folder-open folder 'load-msgdb) diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 278419d..d35420b 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -338,7 +338,20 @@ (:foreground "khaki4"))) "Face used for displaying answered messages." :group 'wl-summary-faces - :group 'wl-faces) + :group 'wl-faces) + +(wl-defface wl-summary-persistent-mark-face + '((((type tty)) + (:foreground "blue")) + (((class color) + (background dark)) + (:foreground "SeaGreen4")) + (((class color) + (background light)) + (:foreground "SeaGreen1"))) + "Dafault face used for displaying messages with persistent mark." + :group 'wl-summary-faces + :group 'wl-faces) ;; obsolete. (wl-defface wl-highlight-summary-temp-face @@ -849,8 +862,9 @@ (intern (format "wl-highlight-summary-%s-face" (car priorities)))) - (when (find-face face) - (list face)))))) + (if (find-face face) + (list face) + (list 'wl-summary-persistent-mark-face)))))) (setq priorities (cdr priorities))) result)) ((string= temp-mark wl-summary-score-below-mark) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 8ca71c7..910ced4 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -1616,7 +1616,8 @@ If ARG is non-nil, checking is omitted." 'answered)))) (if (null number-list) (message "No message.") - (wl-summary-mark-as-answered-internal remove number-list) + (wl-summary-set-persistent-mark-internal remove 'answered + number-list) (wl-summary-count-unread) (wl-summary-update-modeline)))) @@ -1786,7 +1787,7 @@ This function is defined for `window-scroll-functions'" (message "Updating marks...") (dolist (flag elmo-global-flag-list) - (unless (memq flag '(answered cached new unread)) + (unless (memq flag elmo-preserved-flags) (setq diff (elmo-list-diff (elmo-folder-list-flagged wl-summary-buffer-elmo-folder flag) @@ -1806,39 +1807,24 @@ This function is defined for `window-scroll-functions'" (list flag) 'no-server) (setq diffs (cdr diffs))))) - (setq diff (elmo-list-diff (elmo-folder-list-flagged - wl-summary-buffer-elmo-folder - 'answered) - (elmo-folder-list-flagged - wl-summary-buffer-elmo-folder - 'answered 'in-msgdb))) - (setq diffs (cadr diff)) - (setq mes (concat mes (format "-%d" (length diffs)))) - (while diffs - (wl-summary-mark-as-unanswered (car diffs) 'no-modeline) - (setq diffs (cdr diffs))) - (setq diffs (car diff)) ; unread-appends - (setq mes (concat mes (format "/+%d answered," (length diffs)))) - (while diffs - (wl-summary-mark-as-answered (car diffs) 'no-modeline) - (setq diffs (cdr diffs))) - - (setq diff (elmo-list-diff (elmo-folder-list-flagged - wl-summary-buffer-elmo-folder - 'unread) - (elmo-folder-list-flagged - wl-summary-buffer-elmo-folder - 'unread 'in-msgdb))) - (setq diffs (cadr diff)) - (setq mes (concat mes (format "-%d" (length diffs)))) - (while diffs - (wl-summary-mark-as-read (car diffs) 'no-folder 'no-modeline) - (setq diffs (cdr diffs))) - (setq diffs (car diff)) ; unread-appends - (setq mes (concat mes (format "/+%d unread." (length diffs)))) - (while diffs - (wl-summary-mark-as-unread (car diffs) 'no-folder 'no-modeline) - (setq diffs (cdr diffs))) + (dolist (flag (delete 'new (delete 'cached + (copy-sequence elmo-preserved-flags)))) + (setq diff (elmo-list-diff (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + flag) + (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + flag 'in-msgdb))) + (setq diffs (cadr diff)) + (setq mes (concat mes (format "-%d" (length diffs)))) + (while diffs + (wl-summary-unset-persistent-mark flag (car diffs) 'no-modeline) + (setq diffs (cdr diffs))) + (setq diffs (car diff) + mes (concat mes (format "/+%d %s " (length diffs) flag))) + (while diffs + (wl-summary-set-persistent-mark flag (car diffs) 'no-modeline) + (setq diffs (cdr diffs)))) (if (interactive-p) (message "%s" mes))))) (defun wl-summary-sync-update (&optional unset-cursor @@ -2841,19 +2827,20 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (setq mark wl-summary-flag-mark))) (when (memq (car priorities) flags) (setq mark - (or (case (car priorities) - (new - (if cached - wl-summary-new-cached-mark - wl-summary-new-uncached-mark)) - (answered - (if cached - wl-summary-answered-cached-mark - wl-summary-answered-uncached-mark)) - (unread - (if cached - wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark))))))) + (let ((var + (intern + (if cached + (format + "wl-summary-%s-cached-mark" (car priorities)) + (format + "wl-summary-%s-uncached-mark" (car priorities)))))) + (if (boundp var) + (symbol-value var) + (if cached + (downcase (substring (symbol-name (car priorities)) + 0 1)) + (upcase (substring (symbol-name (car priorities)) + 0 1)))))))) (setq priorities (cdr priorities))) (or mark (if (or cached (elmo-folder-local-p folder)) @@ -2982,6 +2969,7 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (defun wl-summary-update-persistent-mark (&optional number flags) "Synch up persistent mark of current line with msgdb's. Return non-nil if the mark is updated" + (interactive) (prog1 (when wl-summary-buffer-persistent-mark-column (save-excursion @@ -3065,10 +3053,11 @@ Return non-nil if the mark is updated" no-folder-mark no-modeline-update)) -(defsubst wl-summary-mark-as-answered-internal (inverse - &optional - number-or-numbers - no-modeline-update) +(defsubst wl-summary-set-persistent-mark-internal (inverse + &optional flag + number-or-numbers + no-modeline-update) + "Set persistent mark." (save-excursion (let ((folder wl-summary-buffer-elmo-folder) number number-list visible) @@ -3083,8 +3072,8 @@ Return non-nil if the mark is updated" (if (null number-list) (message "No message.") (if inverse - (elmo-folder-unset-flag folder number-list 'answered) - (elmo-folder-set-flag folder number-list 'answered)) + (elmo-folder-unset-flag folder number-list flag) + (elmo-folder-set-flag folder number-list flag)) (dolist (number number-list) (setq visible (wl-summary-jump-to-msg number)) ;; set mark on buffer @@ -3100,22 +3089,64 @@ Return non-nil if the mark is updated" (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))))))) +(defun wl-summary-unset-persistent-mark (&optional flag + number-or-numbers + no-modeline-update) + "Unset persistent mark." + (interactive) + (when (interactive-p) + (setq flag (intern (downcase + (completing-read + "Flag: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + elmo-preserved-flags) + nil + 'require-match))))) + (wl-summary-set-persistent-mark-internal 'inverse + flag + number-or-numbers + no-modeline-update)) + +(defun wl-summary-set-persistent-mark (&optional flag + number-or-numbers + no-modeline-update) + "Set persistent mark." + (interactive) + (when (interactive-p) + (setq flag (intern (downcase + (completing-read + "Flag: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + elmo-preserved-flags) + nil + 'require-match))))) + (wl-summary-set-persistent-mark-internal + nil + flag + number-or-numbers + no-modeline-update)) + (defun wl-summary-mark-as-answered (&optional number-or-numbers no-modeline-update) (interactive) - (wl-summary-mark-as-answered-internal + (wl-summary-set-persistent-mark-internal (and (interactive-p) (elmo-message-flagged-p wl-summary-buffer-elmo-folder (wl-summary-message-number) 'answered)) + 'answered number-or-numbers no-modeline-update)) (defun wl-summary-mark-as-unanswered (&optional number-or-numbers no-modeline-update) - (wl-summary-mark-as-answered-internal 'inverse - number-or-numbers - no-modeline-update)) + (wl-summary-set-persistent-mark-internal + 'inverse + 'answered + number-or-numbers + no-modeline-update)) (defun wl-summary-decide-flag (folder number) (let ((flags (elmo-get-global-flags (elmo-message-flags @@ -4070,9 +4101,7 @@ Reply to author if invoked with ARG." (run-hooks 'wl-mail-setup-hook))) (error (set-window-configuration winconf) (signal (car err)(cdr err)))) - (with-current-buffer summary-buf - (elmo-folder-set-flag folder (list number) 'answered) - (wl-summary-update-persistent-mark)) + (with-current-buffer summary-buf (run-hooks 'wl-summary-reply-hook)) t))) (defun wl-summary-write () @@ -4149,7 +4178,8 @@ Use function list is `wl-summary-write-current-folder-functions'." (elmo-message-entity folder number) 'subject 'decode) "")))) (set-buffer mes-buf) - (wl-draft-forward subject summary-buf) + (wl-draft-forward subject summary-buf number) + (with-current-buffer summary-buf (run-hooks 'wl-summary-forward-hook)) (unless without-setup-hook (run-hooks 'wl-mail-setup-hook))))) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index eaea8d7..862a643 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -754,8 +754,24 @@ the functions `wl-plugged-init-icons' and `wl-biff-init-icons' for reasons of system internal to accord facilities for the Emacs variants.") (defvar wl-hook nil "A hook called when Wanderlust is invoked.") -(defvar wl-reply-hook nil - "A hook called when replied.") + +(defvar wl-draft-reply-hook nil + "A hook called when replied. +This hook runs on the draft buffer.") + +(defvar wl-draft-forward-hook nil + "A hook called when forwarded. +This hook runs on the draft buffer.") + +(defvar wl-summary-reply-hook + '((lambda () (wl-summary-set-persistent-mark 'answered))) + "A hook called when `wl-summary-reply' is called. +This hook runs on the summary buffer.") + +(defvar wl-summary-forward-hook nil + "A hook called when `wl-summary-forward' is called. +This hook runs on the summary buffer.") + (defvar wl-mail-setup-hook nil "A hook called when Draft is prepared.") (defvar wl-draft-reedit-hook '(wl-draft-remove-text-plain-tag) @@ -1763,6 +1779,11 @@ message buffer." :group 'wl-pref :group 'wl-draft) +(defcustom wl-draft-kill-flags '(answered) + "Remove specified flags when parent message of current draft is killed." + :type '(repeat (symbol :tag "flag")) + :group 'wl-draft) + (defcustom wl-subject-re-prefix-regexp "^[ \t]*\\([Rr][Ee][:>][ \t]*\\)*[ \t]*" "*Regexp matching \"Re: \" in the subject line." :type 'regexp -- 1.7.10.4