X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-score.el;h=8847ba755900fc50271b4ecd674f784f80edd02d;hb=c887cd278db9c7728fcd4475b5b4ee3d885fd3ca;hp=b6bb3fe701cd80dcab118f1a5d2fab6249679649;hpb=80eb0514a723f45d04b352b663bdb8fa7895baa2;p=elisp%2Fwanderlust.git diff --git a/wl/wl-score.el b/wl/wl-score.el index b6bb3fe..8847ba7 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -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) @@ -164,54 +164,31 @@ Remove Re, Was, Fwd etc." ;; (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)))) + (string-to-number 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) + ;; FIXME + (if (or (eq index 'to) (eq index 'cc)) + 'string + nil))) -(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." @@ -283,7 +260,8 @@ Set `wl-score-cache' nil." (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) @@ -339,9 +317,9 @@ Set `wl-score-cache' nil." (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 @@ -351,11 +329,12 @@ Set `wl-score-cache' nil." (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,32 +368,27 @@ Set `wl-score-cache' nil." (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 @@ -442,7 +416,7 @@ Set `wl-score-cache' nil." (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)) @@ -564,13 +538,13 @@ Set `wl-score-cache' nil." nil)) (defmacro wl-score-put-alike () - (` (elmo-set-hash-val (format "#%d" (wl-count-lines)) - alike - wl-score-alike-hashtb))) + '(elmo-set-hash-val (format "#%d" (wl-count-lines)) + alike + wl-score-alike-hashtb)) (defmacro wl-score-get-alike () - (` (elmo-get-hash-val (format "#%d" (wl-count-lines)) - wl-score-alike-hashtb))) + '(elmo-get-hash-val (format "#%d" (wl-count-lines)) + wl-score-alike-hashtb)) (defun wl-score-insert-header (header messages &optional extra-header) (let ((mime-decode (nth 3 (assoc header wl-score-header-index))) @@ -588,13 +562,14 @@ Set `wl-score-cache' nil." (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) wl-score-index extra-header)) - (and this (setq this (std11-unfold-string this))) + (when (stringp this) + (setq this (std11-unfold-string this))) (if (equal last this) ;; O(N*H) cons-cells used here, where H is the number of ;; headers. @@ -784,9 +759,9 @@ Set `wl-score-cache' nil." 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)) @@ -810,7 +785,7 @@ Set `wl-score-cache' nil." (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 @@ -822,7 +797,7 @@ Set `wl-score-cache' nil." (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) @@ -840,7 +815,7 @@ Set `wl-score-cache' nil." "Automatically mark messages with score below SCORE as read." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Mark below: "))))) + (string-to-number (read-string "Mark below: "))))) (setq score (or score wl-summary-default-score 0)) (wl-score-set 'mark (list score)) (wl-score-set 'touched '(t)) @@ -851,7 +826,7 @@ Set `wl-score-cache' nil." "Automatically expunge messages with score below SCORE." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Expunge below: "))))) + (string-to-number (read-string "Expunge below: "))))) (setq score (or score wl-summary-default-score 0)) (wl-score-set 'expunge (list score)) (wl-score-set 'touched '(t))) @@ -897,7 +872,7 @@ Set `wl-score-cache' nil." ;; transform from string to int. (when (eq (nth 1 (assoc (car entry) wl-score-header-index)) 'wl-score-integer) - (setq match (string-to-int match))) + (setq match (string-to-number match))) ;; set score (if score (setq lscore rscore) @@ -922,38 +897,34 @@ Set `wl-score-cache' nil." (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*") @@ -1090,7 +1061,7 @@ Set `wl-score-cache' nil." ;; read the score. (unless (or score increase) - (setq score (string-to-int (read-string "Set score: "))))) + (setq score (string-to-number (read-string "Set score: "))))) (message "") (wl-score-kill-help-buffer)) @@ -1108,7 +1079,7 @@ Set `wl-score-cache' nil." (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))) @@ -1143,8 +1114,8 @@ Set `wl-score-cache' nil." (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)) @@ -1154,7 +1125,7 @@ Set `wl-score-cache' nil." "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)) @@ -1164,18 +1135,16 @@ Set `wl-score-cache' nil." ;; 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." @@ -1184,91 +1153,76 @@ Set `wl-score-cache' nil." (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)) - (i 0) - (update-unread nil) - num score dels visible score-mark mark-alist) + (let ((alist wl-summary-scored) + (update-unread nil) + wl-summary-unread-message-hook + num score dels visible score-mark mark-alist) (save-excursion - (message "Updating score...") - (while alist - (setq num (caar alist) - 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-score-trace)) - (setq score-mark (wl-summary-get-score-mark num)) - (and (setq visible (wl-summary-jump-to-msg num)) - (wl-summary-set-score-mark score-mark)) - (cond ((and wl-summary-expunge-below - (< score wl-summary-expunge-below)) - (wl-push num dels)) - ((< score wl-summary-mark-below) - (if visible - (wl-summary-mark-as-read t); opened - (setq update-unread t) - (wl-summary-mark-as-read t nil nil 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-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 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 - (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-folder-mark-as-read wl-summary-buffer-elmo-folder - dels) - (elmo-msgdb-set-mark-alist (wl-summary-buffer-msgdb) mark-alist) - (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)))) + (elmo-with-progress-display (wl-update-score (length alist)) + "Updating score" + (while alist + (setq num (caar alist) + 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-score-trace)) + (setq score-mark (wl-summary-get-score-mark num)) + (and (setq visible (wl-summary-jump-to-msg num)) + (wl-summary-set-score-mark score-mark)) + (cond ((and wl-summary-expunge-below + (< score wl-summary-expunge-below)) + (wl-push num dels)) + ((< score wl-summary-mark-below) + (if visible + (wl-summary-mark-as-read num); opened + (setq update-unread t) + (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-set-persistent-mark 'important num))) + ((and wl-summary-target-above + (> score wl-summary-target-above)) + (if visible + (wl-summary-set-mark "*")))) + (setq alist (cdr alist)) + (elmo-progress-notify 'wl-update-score)) + (when dels + (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) ;; Update Folder mode (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) - (list 0 - (let ((pair - (wl-summary-count-unread - mark-alist))) - (+ (car pair) (cdr pair))) - (length num-db))) + (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 () @@ -1365,7 +1319,7 @@ Entering Score mode calls the value of `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." @@ -1373,7 +1327,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))) @@ -1470,7 +1425,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)))))