X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-score.el;h=8774a02cdaa586bf3411fa047505ca0f669e645b;hb=7577ad1b6ed9e227ce088a17bf93eda7d4ef0271;hp=69aca7506fb6fffa0793b4dcf4ee924a9eb35eb8;hpb=1e366a559be4aec4ad4d3cf3e954b8e62a20d2f3;p=elisp%2Fwanderlust.git diff --git a/wl/wl-score.el b/wl/wl-score.el index 69aca75..8774a02 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -1,11 +1,10 @@ -;;; 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 -;; Time-stamp: <00/03/14 19:35:28 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -29,13 +28,13 @@ ;; Original codes are gnus-score.el and score-mode.el ;;; Code: -;; +;; (require 'wl-vars) (require 'wl-util) (eval-when-compile - (provide 'elmo-msgdb)) + (require 'elmo-msgdb)) ; for inline functions (defvar wl-score-edit-header-char '((?a "from" nil string) @@ -70,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) @@ -102,15 +101,13 @@ (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.") -(mapcar - (function make-variable-buffer-local) - (list 'wl-current-score-file - 'wl-score-alist)) +(make-variable-buffer-local 'wl-current-score-file) +(make-variable-buffer-local 'wl-score-alist) -;; Utility functions +;; Utility functions (defun wl-score-simplify-buffer-fuzzy () "Simplify string in the buffer fuzzily. @@ -118,19 +115,18 @@ 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." - (let ((case-fold-search t) - (modified-tick)) +`wl-score-simplify-fuzzy-regexp'." + (let ((regexp + (if (listp wl-score-simplify-fuzzy-regexp) + (mapconcat (function identity) wl-score-simplify-fuzzy-regexp + "\\|") + wl-score-simplify-fuzzy-regexp)) + (case-fold-search t) + modified-tick) (elmo-buffer-replace "\t" " ") (while (not (eq modified-tick (buffer-modified-tick))) (setq modified-tick (buffer-modified-tick)) - (cond - ((listp wl-score-simplify-fuzzy-regexp) - (mapcar 'elmo-buffer-replace - wl-score-simplify-fuzzy-regexp)) - (wl-score-simplify-fuzzy-regexp - (elmo-buffer-replace - wl-score-simplify-fuzzy-regexp))) + (elmo-buffer-replace regexp) (elmo-buffer-replace "^ *\\[[-+?*!][-+?*!]\\] *") (elmo-buffer-replace "^ *\\(re\\|fw\\|fwd\\|forward\\)[[{(^0-9]*[])}]?[:;] *") @@ -141,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)) @@ -150,16 +146,17 @@ 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 ((case-fold-search t)) + (let ((regexp + (if (listp wl-score-simplify-fuzzy-regexp) + (mapconcat (function identity) wl-score-simplify-fuzzy-regexp + "\\|") + wl-score-simplify-fuzzy-regexp)) + (case-fold-search t)) (insert subject) - (cond - ((listp wl-score-simplify-fuzzy-regexp) - (mapcar 'elmo-buffer-replace - wl-score-simplify-fuzzy-regexp)) - (wl-score-simplify-fuzzy-regexp - (elmo-buffer-replace - wl-score-simplify-fuzzy-regexp))) + (elmo-buffer-replace regexp) (elmo-buffer-replace "^[ \t]*\\(re\\|was\\|fw\\|fwd\\|forward\\)[:;][ \t]*") (buffer-string)))) @@ -167,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))) - -(defun wl-score-string-func< (a1 a2) - (string-lessp (funcall wl-score-index (car a1)) - (funcall wl-score-index (car a2)))) + (elmo-message-entity-field entity (if extra (intern extra) index) decode)) + +(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))) @@ -239,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)) @@ -265,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) @@ -281,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) @@ -308,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 @@ -335,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 (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 @@ -389,12 +349,13 @@ See `wl-score-simplify-buffer-fuzzy' for details." (let ((mark (car (wl-score-get 'mark alist))) (expunge (car (wl-score-get 'expunge alist))) (mark-and-expunge (car (wl-score-get 'mark-and-expunge alist))) - (temp (car (wl-score-get 'temp alist))) + (temp (car (wl-score-get 'temp alist))) ; obsolate + (target (car (wl-score-get 'target alist))) (important (car (wl-score-get 'important alist)))) (setq wl-summary-important-above (or important wl-summary-important-above)) - (setq wl-summary-temp-above - (or temp wl-summary-temp-above)) + (setq wl-summary-target-above + (or target temp wl-summary-target-above)) (setq wl-summary-mark-below (or mark mark-and-expunge wl-summary-mark-below)) (setq wl-summary-expunge-below @@ -403,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) + (folder wl-summary-buffer-elmo-folder) (now (wl-day-number (current-time-string))) (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 @@ -456,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)) @@ -466,9 +422,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq wl-scores-messages (cdr wl-scores-messages)))) (message "Scoring...done") ;; Remove buffers. - (mapcar '(lambda (x) (elmo-kill-buffer x)) - wl-score-header-buffer-list) - (setq wl-score-header-buffer-list nil))) + (while wl-score-header-buffer-list + (elmo-kill-buffer (pop wl-score-header-buffer-list))))) (defun wl-score-integer (scores header now expire) (let ((wl-score-index (nth 2 (assoc header wl-score-header-index))) @@ -562,11 +517,6 @@ See `wl-score-simplify-buffer-fuzzy' for details." (setq entries rest))))) nil) -(defsubst wl-score-lines () - (save-excursion - (beginning-of-line) - (count-lines 1 (point)))) - (defun wl-score-extra (scores header now expire) (let ((score-list scores) entries alist extra extras) @@ -584,17 +534,13 @@ See `wl-score-simplify-buffer-fuzzy' for details." nil)) (defmacro wl-score-put-alike () - (` (elmo-set-hash-val (format "#%d" (wl-score-lines)) + (` (elmo-set-hash-val (format "#%d" (wl-count-lines)) alike wl-score-alike-hashtb))) -;;(push (cons (wl-score-lines) alike) wl-score-alike-alist) -;;(put-text-property (1- (point)) (point) 'messages alike) (defmacro wl-score-get-alike () - (` (elmo-get-hash-val (format "#%d" (wl-score-lines)) + (` (elmo-get-hash-val (format "#%d" (wl-count-lines)) wl-score-alike-hashtb))) -;;(cdr (assq (wl-score-lines) wl-score-alike-alist)) -;;(get-text-property (point) 'messages))) (defun wl-score-insert-header (header messages &optional extra-header) (let ((mime-decode (nth 3 (assoc header wl-score-header-index))) @@ -638,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 @@ -692,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)) @@ -757,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) @@ -796,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)) @@ -807,8 +755,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (< expire (setq day (wl-day-number - (elmo-msgdb-overview-entity-get-date - (car art))))))) + (elmo-message-entity-field + (car art) 'date)))))) (when (setq new (wl-score-add-followups (car art) score all-scores alist thread day)) @@ -881,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) @@ -947,35 +895,32 @@ See `wl-score-simplify-buffer-fuzzy' for details." (let* ((now (wl-day-number (current-time-string))) (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 + (while rnumbers (if (< (wl-day-number - (elmo-msgdb-overview-entity-get-date (car roverview))) + (elmo-message-entity-field + (elmo-message-entity 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 decode)))) (defun wl-score-kill-help-buffer () (when (get-buffer "*Score Help*") @@ -1016,19 +961,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 @@ -1111,8 +1057,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 @@ -1163,8 +1110,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)) @@ -1174,7 +1121,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)) @@ -1184,18 +1131,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." @@ -1204,29 +1149,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 + (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...") @@ -1235,7 +1179,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)) @@ -1245,50 +1189,41 @@ 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 nil nil nil (elmo-use-cache-p folder num));; opened + (wl-summary-mark-as-read num); opened (setq update-unread t) - (wl-thread-msg-mark-as-read 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 " "))) - ((and wl-summary-temp-above - (> score wl-summary-temp-above)) + ((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)))) - (setq i (1+ i)) - (and (zerop (% i 10)) - (message "Updating score...%d%%" (/ (* i 100) count))) - (setq alist (cdr alist))) + (wl-summary-set-mark "*")))) + (setq alist (cdr alist)) + (when (> count elmo-display-progress-threshold) + (setq i (1+ i)) + (elmo-display-progress + 'wl-summary-score-update-all-lines "Updating score..." + (/ (* i 100) count)))) (when dels -; (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name -; dels wl-summary-buffer-msgdb t) - ;; mark as read. - (setq mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - (mapcar (function (lambda (x) - (setq mark-alist - (elmo-msgdb-mark-set mark-alist x nil)))) - dels) - (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-set-flag wl-summary-buffer-elmo-folder + del 'read)) + (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 ((lst + (wl-summary-count-unread))) + (+ (car lst) (nth 1 lst))) + (elmo-folder-length + wl-summary-buffer-elmo-folder))) + (wl-summary-update-modeline)) + (message "Updating score...done") dels))) (defun wl-score-edit-done () @@ -1307,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)) @@ -1317,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)) @@ -1379,7 +1313,7 @@ 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)) @@ -1394,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))) @@ -1411,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 () @@ -1420,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 () @@ -1472,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))))))) @@ -1490,10 +1426,12 @@ 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))))) -(provide 'wl-score) +(require 'product) +(product-provide (provide 'wl-score) (require 'wl-version)) ;;; wl-score.el ends here