X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-score.el;h=e0a771de80b26f17b549010eed2d60dc879fa206;hb=aedb114b8b1917d3e0d96cb19ed4a9d6f958ae1a;hp=9ec2ade1e13ac31d4dc9a212e6a234bfb3022859;hpb=806725e3db0748ddc973ba045053a6681e840287;p=elisp%2Fwanderlust.git diff --git a/wl/wl-score.el b/wl/wl-score.el index 9ec2ade..e0a771d 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -1,7 +1,7 @@ -;;; wl-score.el -- Scoring in Wanderlust. +;;; wl-score.el --- Scoring in Wanderlust. -;; Copyright 1998,1999,2000 Masahiro MURATA -;; Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Masahiro MURATA +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Masahiro MURATA ;; Keywords: mail, net news @@ -28,7 +28,7 @@ ;; Original codes are gnus-score.el and score-mode.el ;;; Code: -;; +;; (require 'wl-vars) @@ -69,20 +69,20 @@ (defconst wl-score-header-index ;; Name to function alist. - '(("number" wl-score-integer elmo-msgdb-overview-entity-get-number) ;;0 - ("subject" wl-score-string 3 charset) - ("from" wl-score-string 2 charset) - ("date" wl-score-date elmo-msgdb-overview-entity-get-date) ;;4 - ("message-id" wl-score-string elmo-msgdb-overview-entity-get-id) - ("references" wl-score-string 1) - ("to" wl-score-string 5) - ("cc" wl-score-string 6) - ("chars" wl-score-integer elmo-msgdb-overview-entity-get-size) ;;7 - ("lines" wl-score-integer wl-score-overview-entity-get-lines) - ("xref" wl-score-string wl-score-overview-entity-get-xref) - ("extra" wl-score-extra wl-score-overview-entity-get-extra mime) - ("followup" wl-score-followup 2 charset) - ("thread" wl-score-thread 1))) + '(("number" wl-score-integer number) + ("subject" wl-score-string subject charset) + ("from" wl-score-string from charset) + ("date" wl-score-date date) + ("message-id" wl-score-string message-id) + ("references" wl-score-string references) + ("to" wl-score-string to) + ("cc" wl-score-string cc) + ("chars" wl-score-integer size) + ("lines" wl-score-integer lines) + ("xref" wl-score-string xref) + ("extra" wl-score-extra extra mime) + ("followup" wl-score-followup from charset) + ("thread" wl-score-thread references))) (defvar wl-score-auto-make-followup-entry nil) (defvar wl-score-debug nil) @@ -101,7 +101,7 @@ (defvar wl-score-header-buffer-list nil) (defvar wl-score-alike-hashtb nil) -(defvar wl-score-edit-exit-func nil +(defvar wl-score-edit-exit-function nil "Function run on exit from the score buffer.") (make-variable-buffer-local 'wl-current-score-file) @@ -115,7 +115,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -wl-score-simplify-fuzzy-regexp." +`wl-score-simplify-fuzzy-regexp'." (let ((regexp (if (listp wl-score-simplify-fuzzy-regexp) (mapconcat (function identity) wl-score-simplify-fuzzy-regexp @@ -137,7 +137,7 @@ wl-score-simplify-fuzzy-regexp." (elmo-buffer-replace "^ +"))) (defun wl-score-simplify-string-fuzzy (string) - "Simplify a string fuzzily. + "Simplify a STRING fuzzily. See `wl-score-simplify-buffer-fuzzy' for details." (elmo-set-work-buf (let ((case-fold-search t)) @@ -146,6 +146,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (buffer-string)))) (defun wl-score-simplify-subject (subject) + "Simplify a SUBJECT fuzzily. +Remove Re, Was, Fwd etc." (elmo-set-work-buf (let ((regexp (if (listp wl-score-simplify-fuzzy-regexp) @@ -162,62 +164,37 @@ See `wl-score-simplify-buffer-fuzzy' for details." ;; (defun wl-score-overview-entity-get-lines (entity) - (let ((lines - (elmo-msgdb-overview-entity-get-extra-field entity "lines"))) + (let ((lines (elmo-message-entity-field entity 'lines))) (and lines (string-to-int lines)))) (defun wl-score-overview-entity-get-xref (entity) - (or (elmo-msgdb-overview-entity-get-extra-field entity "xref") + (or (elmo-message-entity-field entity 'xref) "")) -(defun wl-score-overview-entity-get-extra (entity header &optional decode) - (let ((extra (elmo-msgdb-overview-entity-get-extra-field entity header))) - (if (and extra decode) - (eword-decode-string - (decode-mime-charset-string extra elmo-mime-charset)) - (or extra "")))) - (defun wl-string> (s1 s2) (not (or (string< s1 s2) (string= s1 s2)))) -(defmacro wl-score-ov-entity-get-by-index (entity index) - (` (aref (cdr (, entity)) (, index)))) - -(defsubst wl-score-ov-entity-get (entity index &optional extra decode) - (let ((str (cond ((integerp index) - (wl-score-ov-entity-get-by-index entity index)) - (extra - (funcall index entity extra decode)) - (t - (funcall index entity))))) - (if (and decode (not extra)) - (decode-mime-charset-string str elmo-mime-charset) - str))) - -(defun wl-score-string-index< (a1 a2) - (string-lessp (wl-score-ov-entity-get-by-index (car a1) wl-score-index) - (wl-score-ov-entity-get-by-index (car a2) wl-score-index))) +(defsubst wl-score-ov-entity-get (entity index &optional extra) + (elmo-message-entity-field entity (if extra (intern extra) index))) -(defun wl-score-string-func< (a1 a2) - (string-lessp (funcall wl-score-index (car a1)) - (funcall wl-score-index (car a2)))) +(defun wl-score-string< (a1 a2) + (string-lessp (wl-score-ov-entity-get (car a1) wl-score-index) + (wl-score-ov-entity-get (car a2) wl-score-index))) (defun wl-score-string-sort (messages index) - (let ((func (cond ((integerp index) - 'wl-score-string-index<) - (t - 'wl-score-string-func<)))) - (sort messages func))) + (sort messages 'wl-score-string<)) (defsubst wl-score-get (symbol &optional alist) + "Get SYMBOL's definition in ALIST." ;; Get SYMBOL's definition in ALIST. (cdr (assoc symbol (or alist wl-score-alist)))) (defun wl-score-set (symbol value &optional alist warn) + "Set SYMBOL to VALUE in ALIST." ;; Set SYMBOL to VALUE in ALIST. (let* ((alist (or alist wl-score-alist)) (entry (assoc symbol alist))) @@ -234,6 +211,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (cons (cons symbol value) (cdr alist))))))) (defun wl-score-cache-clean () + "Cleaning score cache. +Set `wl-score-cache' nil." (interactive) (setq wl-score-cache nil)) @@ -260,6 +239,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq wl-score-alist alist))))))) (defun wl-score-save () + "Save all score information." ;; Save all score information. (let ((cache wl-score-cache) entry score file dir) @@ -276,7 +256,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq score (setcdr entry (wl-delete-alist 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook - (lisp-mode-syntax-table wl-score-mode-syntax-table)) + (lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp score (current-buffer))) (setq dir (file-name-directory file)) (if (file-directory-p dir) @@ -303,12 +284,12 @@ See `wl-score-simplify-buffer-fuzzy' for details." (or (and (string-match (concat "^" (regexp-quote (expand-file-name - wl-score-files-dir))) + wl-score-files-directory))) (expand-file-name file)) file) (expand-file-name file - (file-name-as-directory wl-score-files-dir))))) + (file-name-as-directory wl-score-files-directory))))) (cached (assoc file wl-score-cache)) alist) (if cached @@ -330,42 +311,26 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq wl-current-score-file file) (setq wl-score-alist alist))) -(defun wl-score-guess-like-gnus (folder) - (let* (score-list - (spec (elmo-folder-get-spec folder)) - (method (symbol-name (car spec))) - (fld-name (elmo-string (car (cdr spec))))) - (when (stringp fld-name) - (while (string-match "[\\/:,;*?\"<>|]" fld-name) - (setq fld-name (replace-match "." t nil fld-name))) - (setq score-list (list (concat method "@" fld-name ".SCORE"))) - (while (string-match "[\\/.][^\\/.]*$" fld-name) - (setq fld-name (substring fld-name 0 (match-beginning 0))) - (wl-append score-list (list (concat method "@" fld-name - ".all.SCORE")))) - score-list))) - (defun wl-score-get-score-files (score-alist folder) (let ((files (wl-get-assoc-list-value - score-alist folder + score-alist (elmo-folder-name-internal folder) (if (not wl-score-folder-alist-matchone) 'all-list))) - fl f) + fl f) (while (setq f (wl-pop files)) (wl-append fl (cond ((functionp f) (funcall f folder)) - ((and (symbolp f) (eq f 'guess)) - (wl-score-guess-like-gnus folder)) (t (list f))))) fl)) -(defun wl-score-get-score-alist (&optional folder) +(defun wl-score-get-score-alist () (interactive) - (let* ((fld (or folder wl-summary-buffer-folder-name)) - (score-alist (reverse - (wl-score-get-score-files wl-score-folder-alist fld))) + (let* ((score-alist (reverse + (wl-score-get-score-files + wl-score-folder-alist + wl-summary-buffer-elmo-folder))) alist scores) (setq wl-current-score-file nil) (unless (and wl-score-default-file @@ -399,32 +364,27 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq score-alist (cdr score-alist))) scores)) -(defun wl-score-headers (scores &optional msgdb force-msgs not-add) +(defun wl-score-headers (scores &optional force-msgs not-add) (let* ((elmo-mime-charset wl-summary-buffer-mime-charset) - (now (wl-day-number (current-time-string))) + (folder wl-summary-buffer-elmo-folder) + (now (elmo-time-to-days (current-time))) (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) - (overview (elmo-msgdb-get-overview - (or msgdb wl-summary-buffer-msgdb))) - (mark-alist (elmo-msgdb-get-mark-alist - (or msgdb wl-summary-buffer-msgdb))) (wl-score-stop-add-entry not-add) entries news new num entry ov header) (setq wl-scores-messages nil) (message "Scoring...") - ;; Create messages, an alist of the form `(OVERVIEW . SCORE)'. - (while (setq ov (pop overview)) - (when (and (not (assq - (setq num - (elmo-msgdb-overview-entity-get-number ov)) - wl-summary-scored)) + ;; Create messages, an alist of the form `(ENTITY . SCORE)'. + (dolist (num (elmo-folder-list-messages folder 'visible 'in-db)) + (when (and (not (assq num wl-summary-scored)) (or (memq num force-msgs) - (member (cadr (assq num mark-alist)) + (member (wl-summary-message-mark folder num) wl-summary-score-marks))) (setq wl-scores-messages - (cons (cons ov (or wl-summary-default-score 0)) + (cons (cons (elmo-message-entity folder num) + (or wl-summary-default-score 0)) wl-scores-messages)))) (save-excursion @@ -452,7 +412,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (while wl-scores-messages (when (or (/= wl-summary-default-score (cdar wl-scores-messages))) - (setq num (elmo-msgdb-overview-entity-get-number + (setq num (elmo-message-entity-number (caar wl-scores-messages)) score (cdar wl-scores-messages)) (if (setq entry (assq num wl-summary-scored)) @@ -598,7 +558,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (make-local-variable 'wl-score-alike-hashtb) (setq wl-score-alike-hashtb (elmo-make-hash (* (length messages) 2))) (when mime-decode - (elmo-set-buffer-multibyte default-enable-multibyte-characters)) + (set-buffer-multibyte default-enable-multibyte-characters)) (let (art last this alike) (while (setq art (pop messages)) (setq this (wl-score-ov-entity-get (car art) @@ -624,6 +584,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (eword-decode-region (point-min) (point-max)))))))) (defun wl-score-string (scores header now expire &optional extra-header) + "Insert the unique message headers in the buffer." ;; Insert the unique message headers in the buffer. (let ((wl-score-index (nth 2 (assoc header wl-score-header-index))) entries alist messages @@ -678,7 +639,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (and (eolp) (= (save-excursion (forward-line 0) (point)) (match-beginning 0)))) - ;;(end-of-line) +;;; (end-of-line) (setq found (setq arts (wl-score-get-alike))) ;; Found a match, update scores. (while (setq art (pop arts)) @@ -743,6 +704,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (wl-score-followup scores header now expire t)) (defun wl-score-followup (scores header now expire &optional thread) + "Insert the unique message headers in the buffer." ;; Insert the unique message headers in the buffer. (let ((wl-score-index (nth 2 (assoc header wl-score-header-index))) (all-scores scores) @@ -782,7 +744,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (and (eolp) (= (progn (beginning-of-line) (point)) (match-beginning 0)))) - ;;(end-of-line) +;;; (end-of-line) (setq found (setq arts (wl-score-get-alike))) ;; Found a match, update scores. (while (setq art (pop arts)) @@ -792,9 +754,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." expire (< expire (setq day - (wl-day-number - (elmo-msgdb-overview-entity-get-date - (car art))))))) + (elmo-time-to-days + (elmo-message-entity-field + (car art) 'date)))))) (when (setq new (wl-score-add-followups (car art) score all-scores alist thread day)) @@ -818,7 +780,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (list (cons "references" news))))) (defun wl-score-add-followups (header score scores alist &optional thread day) - (let* ((id (car header)) + (let* ((id (elmo-message-entity-field header 'message-id)) (scores (car scores)) entry dont) (when id @@ -830,7 +792,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq dont t))) (unless dont (let ((entry (list id score - (or day (wl-day-number (current-time-string))) 's))) + (or day (elmo-time-to-days (current-time))) 's))) (unless (or thread wl-score-stop-add-entry) (wl-score-update-score-entry "references" entry alist)) (wl-score-set 'touched '(t) alist) @@ -867,7 +829,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (defun wl-score-change-score-file (file) "Change current score alist." (interactive - (list (read-file-name "Change to score file: " wl-score-files-dir))) + (list (read-file-name "Change to score file: " wl-score-files-directory))) (wl-score-load-file file)) (defun wl-score-default (level) @@ -930,38 +892,34 @@ See `wl-score-simplify-buffer-fuzzy' for details." (wl-summary-score-effect (car entry) list (eq (nth 2 list) 'now))))) (defun wl-score-get-latest-msgs () - (let* ((now (wl-day-number (current-time-string))) + (let* ((now (elmo-time-to-days (current-time))) (expire (and wl-score-expiry-days (- now wl-score-expiry-days))) - (roverview (reverse (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) + (rnumbers (reverse wl-summary-buffer-number-list)) msgs) (if (not expire) - (mapcar 'car (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) ;; all messages + (elmo-folder-list-messages wl-summary-buffer-elmo-folder + nil t) (catch 'break - (while roverview - (if (< (wl-day-number - (elmo-msgdb-overview-entity-get-date (car roverview))) + (while rnumbers + (if (< (elmo-time-to-days + (elmo-message-entity-field wl-summary-buffer-elmo-folder + (car rnumbers) + 'date)) expire) (throw 'break t)) - (wl-push (elmo-msgdb-overview-entity-get-number (car roverview)) - msgs) - (setq roverview (cdr roverview)))) + (wl-push (car rnumbers) msgs) + (setq rnumbers (cdr rnumbers)))) msgs))) -(defsubst wl-score-get-overview () - (let ((num (wl-summary-message-number))) - (if num - (assoc (cdr (assq num (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) - (elmo-msgdb-get-overview wl-summary-buffer-msgdb))))) - (defun wl-score-get-header (header &optional extra) (let ((index (nth 2 (assoc header wl-score-header-index))) (decode (nth 3 (assoc header wl-score-header-index)))) (if index - (wl-score-ov-entity-get (wl-score-get-overview) index extra decode)))) + (wl-score-ov-entity-get + (elmo-message-entity wl-summary-buffer-elmo-folder + (wl-summary-message-number)) + index extra)))) (defun wl-score-kill-help-buffer () (when (get-buffer "*Score Help*") @@ -1002,19 +960,20 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq format (concat "%c: %-" (int-to-string pad) "s")) (insert (format format (caar alist) (nth idx (car alist)))) (setq alist (cdr alist)) - (setq i (1+ i)) - (set-buffer-modified-p nil))) - (when (and (get-buffer wl-message-buf-name) - (setq mes-win (get-buffer-window - (get-buffer wl-message-buf-name)))) - (select-window mes-win) - (unless (eq (next-window) cur-win) - (delete-window (next-window)))) - (split-window) - (pop-to-buffer "*Score Help*") - (let ((window-min-height 1)) - (shrink-window-if-larger-than-buffer)) - (select-window cur-win)))) + (setq i (1+ i))) + (set-buffer-modified-p nil))) + (when (and wl-message-buffer + (get-buffer wl-message-buffer) + (setq mes-win (get-buffer-window + (get-buffer wl-message-buffer)))) + (select-window mes-win) + (unless (eq (next-window) cur-win) + (delete-window (next-window)))) + (split-window) + (pop-to-buffer "*Score Help*") + (let ((window-min-height 1)) + (shrink-window-if-larger-than-buffer)) + (select-window cur-win))) (defun wl-score-get-header-entry (&optional match-func increase) (let (hchar tchar pchar @@ -1097,8 +1056,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." ;; read the score. (unless (or score increase) - (setq score (string-to-int (read-string "Set score: ")))) - (message ""))) + (setq score (string-to-int (read-string "Set score: "))))) + (message "") + (wl-score-kill-help-buffer)) (let* ((match-header (or (nth 2 hentry) header)) (match (if match-func @@ -1114,7 +1074,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (perm (cond ((eq perm 'perm) nil) ((eq perm 'temp) - (wl-day-number (current-time-string))) + (elmo-time-to-days (current-time))) ((eq perm 'now) perm))) (new (list match score perm type extra))) @@ -1149,8 +1109,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (cond ((string= header "followup") (if wl-score-auto-make-followup-entry (let ((wl-score-make-followup t)) - (wl-score-headers scores nil (wl-score-get-latest-msgs))) - (wl-score-headers scores nil + (wl-score-headers scores (wl-score-get-latest-msgs))) + (wl-score-headers scores (if (eq wl-summary-buffer-view 'thread) (wl-thread-get-children-msgs (wl-summary-message-number)) @@ -1160,7 +1120,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." "references" (cdr (assoc "references" (car scores)))))) ((string= header "thread") - (wl-score-headers scores nil + (wl-score-headers scores (if (eq wl-summary-buffer-view 'thread) (wl-thread-get-children-msgs (wl-summary-message-number)) @@ -1170,18 +1130,16 @@ See `wl-score-simplify-buffer-fuzzy' for details." ;; remove parent (cdr (cdaar scores))))) (t - (wl-score-headers scores nil + (wl-score-headers scores (list (wl-summary-message-number))))) (wl-summary-score-update-all-lines t))) -(defun wl-summary-rescore-msgs (number-alist) - (mapcar - 'car - (nthcdr - (max (- (length number-alist) - wl-summary-rescore-partial-threshold) - 0) - number-alist))) +(defun wl-summary-rescore-msgs (numbers) + (nthcdr + (max (- (length numbers) + wl-summary-rescore-partial-threshold) + 0) + numbers)) (defun wl-summary-rescore (&optional arg) "Redo the entire scoring process in the current summary." @@ -1190,29 +1148,28 @@ See `wl-score-simplify-buffer-fuzzy' for details." (wl-score-save) (setq wl-score-cache nil) (setq wl-summary-scored nil) - (setq number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) - (wl-summary-score-headers nil wl-summary-buffer-msgdb - (unless arg - (wl-summary-rescore-msgs number-alist))) + (wl-summary-score-headers (unless arg + (wl-summary-rescore-msgs + (elmo-folder-list-messages + wl-summary-buffer-elmo-folder t t)))) (setq expunged (wl-summary-score-update-all-lines t)) (if expunged (message "%d message(s) are expunged by scoring." (length expunged))) (set-buffer-modified-p nil))) ;; optional argument force-msgs is added by teranisi. -(defun wl-summary-score-headers (&optional folder msgdb force-msgs not-add) +(defun wl-summary-score-headers (&optional force-msgs not-add) "Do scoring if scoring is required." - (let ((scores (wl-score-get-score-alist - (or folder wl-summary-buffer-folder-name)))) + (let ((scores (wl-score-get-score-alist))) (when scores - (wl-score-headers scores msgdb force-msgs not-add)))) + (wl-score-headers scores force-msgs not-add)))) (defun wl-summary-score-update-all-lines (&optional update) (let* ((alist wl-summary-scored) (count (length alist)) - (folder wl-summary-buffer-folder-name) (i 0) (update-unread nil) + wl-summary-unread-message-hook num score dels visible score-mark mark-alist) (save-excursion (message "Updating score...") @@ -1221,7 +1178,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." score (cdar alist)) (when wl-score-debug (message "Scored %d with %d" score num) - (wl-push (list (elmo-string wl-summary-buffer-folder-name) num score) + (wl-push (list (elmo-string (wl-summary-buffer-folder-name)) num score) wl-score-trace)) (setq score-mark (wl-summary-get-score-mark num)) (and (setq visible (wl-summary-jump-to-msg num)) @@ -1231,19 +1188,17 @@ See `wl-score-simplify-buffer-fuzzy' for details." (wl-push num dels)) ((< score wl-summary-mark-below) (if visible - (wl-summary-mark-as-read t); opened + (wl-summary-mark-as-read num); opened (setq update-unread t) - (wl-summary-mark-as-read t nil nil num))) ; closed + (wl-summary-mark-as-read num))) ; closed ((and wl-summary-important-above (> score wl-summary-important-above)) (if (wl-thread-jump-to-msg num);; force open - (wl-summary-mark-as-important num " "))) + (wl-summary-set-persistent-mark 'important num))) ((and wl-summary-target-above (> score wl-summary-target-above)) (if visible - (wl-summary-mark-line "*")) - (setq wl-summary-buffer-target-mark-list - (cons num wl-summary-buffer-target-mark-list)))) + (wl-summary-set-mark "*")))) (setq alist (cdr alist)) (when (> count elmo-display-progress-threshold) (setq i (1+ i)) @@ -1251,29 +1206,24 @@ See `wl-score-simplify-buffer-fuzzy' for details." 'wl-summary-score-update-all-lines "Updating score..." (/ (* i 100) count)))) (when dels - (setq mark-alist - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - (let ((marks dels)) - (while marks - (setq mark-alist - (elmo-msgdb-mark-set mark-alist (pop marks) nil)))) - (elmo-mark-as-read wl-summary-buffer-folder-name - dels wl-summary-buffer-msgdb) - (elmo-msgdb-set-mark-alist wl-summary-buffer-msgdb mark-alist) + (dolist (del dels) + (elmo-message-unset-flag wl-summary-buffer-elmo-folder + del 'unread)) + (elmo-folder-kill-messages wl-summary-buffer-elmo-folder dels) (wl-summary-delete-messages-on-buffer dels)) (when (and update update-unread) - (let ((num-db (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist - wl-summary-buffer-msgdb))) - ;; Update Folder mode - (wl-folder-set-folder-updated wl-summary-buffer-folder-name - (list 0 - (wl-summary-count-unread - mark-alist) - (length num-db))) - (wl-summary-update-modeline))) - (message "Updating score...done.") + ;; Update Folder mode + (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) + (list + 0 + (let ((flag-count + (wl-summary-count-unread))) + (or (cdr (assq 'unread flag-count)) + 0)) + (elmo-folder-length + wl-summary-buffer-elmo-folder))) + (wl-summary-update-modeline)) + (message "Updating score...done") dels))) (defun wl-score-edit-done () @@ -1292,9 +1242,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." (call-interactively 'wl-score-edit-file))) (defun wl-score-edit-file (file) - "Edit a score file." + "Edit a score FILE." (interactive - (list (read-file-name "Edit score file: " wl-score-files-dir))) + (list (read-file-name "Edit score file: " wl-score-files-directory))) (when (wl-collect-summary) (wl-score-save)) (let ((winconf (current-window-configuration)) @@ -1302,16 +1252,15 @@ See `wl-score-simplify-buffer-fuzzy' for details." (find-file-noselect file))) (sum-buf (current-buffer))) (if (string-match (concat "^" wl-summary-buffer-name) (buffer-name)) - (let ((cur-buf (current-buffer)) - (view-message-buffer (get-buffer wl-message-buf-name))) - (when view-message-buffer - (wl-select-buffer view-message-buffer) + (let ((cur-buf (current-buffer))) + (when wl-message-buffer + (wl-message-select-buffer wl-message-buffer) (delete-window) (select-window (get-buffer-window cur-buf))) - (wl-select-buffer edit-buffer)) + (wl-message-select-buffer edit-buffer)) (switch-to-buffer edit-buffer)) (wl-score-mode) - (setq wl-score-edit-exit-func 'wl-score-edit-done) + (setq wl-score-edit-exit-function 'wl-score-edit-done) (setq wl-score-edit-summary-buffer sum-buf) (make-local-variable 'wl-prev-winconf) (setq wl-prev-winconf winconf)) @@ -1364,14 +1313,14 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (setq major-mode 'wl-score-mode) (setq mode-name "Score") (lisp-mode-variables nil) - (make-local-variable 'wl-score-edit-exit-func) + (make-local-variable 'wl-score-edit-exit-function) (make-local-variable 'wl-score-edit-summary-buffer) (run-hooks 'emacs-lisp-mode-hook 'wl-score-mode-hook)) (defun wl-score-edit-insert-date () "Insert date in numerical format." (interactive) - (princ (wl-day-number (current-time-string)) (current-buffer))) + (princ (elmo-time-to-days (current-time)) (current-buffer))) (defun wl-score-pretty-print () "Format the current score file." @@ -1379,7 +1328,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (goto-char (point-min)) (let ((form (read (current-buffer)))) (erase-buffer) - (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table)) + (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp form (current-buffer)))) (goto-char (point-min))) @@ -1396,8 +1346,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (wl-as-mime-charset wl-score-mode-mime-charset (save-buffer))) (let ((buf (current-buffer))) - (when wl-score-edit-exit-func - (funcall wl-score-edit-exit-func)) + (when wl-score-edit-exit-function + (funcall wl-score-edit-exit-function)) (kill-buffer buf))) (defun wl-score-edit-kill () @@ -1405,8 +1355,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (interactive) (let ((buf (current-buffer))) (set-buffer-modified-p nil) - (when wl-score-edit-exit-func - (funcall wl-score-edit-exit-func)) + (when wl-score-edit-exit-function + (funcall wl-score-edit-exit-function)) (kill-buffer buf))) (defun wl-score-edit-get-summary-buf () @@ -1457,6 +1407,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'." wl-score-edit-header-char)) (error "Invalid match type"))) (message "") + (wl-score-kill-help-buffer) (let* ((header (nth 1 entry)) (value (wl-score-edit-get-header header))) (and value (prin1 value (current-buffer))))))) @@ -1475,7 +1426,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (wl-score-update-score-entry (car entry) (nth 1 entry) form) (setq form (list entry))) (erase-buffer) - (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table)) + (let ((emacs-lisp-mode-syntax-table wl-score-mode-syntax-table) + print-length print-level) (pp form (current-buffer))) (goto-char (point-min)))))