X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-score.el;h=bb465c33162f93853eea0692ada1d94ce8ea7a09;hb=926a13e272f397120115b4e78ca2d7b8bb60c0a1;hp=bddb74a78b56b0c98458b332b55ba4eeb40f8116;hpb=11a211bd3635f163da01872428b8251e4e92ec1a;p=elisp%2Fwanderlust.git diff --git a/wl/wl-score.el b/wl/wl-score.el index bddb74a..bb465c3 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,27 @@ 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)))) (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." @@ -283,7 +256,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,7 +313,7 @@ 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) (while (setq f (wl-pop files)) @@ -351,11 +325,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 +364,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) + (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 @@ -442,7 +412,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)) @@ -785,8 +755,8 @@ Set `wl-score-cache' nil." (< 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)) @@ -925,35 +895,32 @@ Set `wl-score-cache' nil." (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*") @@ -1143,8 +1110,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 +1121,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 +1131,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,22 +1149,21 @@ 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) @@ -1231,13 +1195,11 @@ Set `wl-score-cache' nil." ((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-add-flags-internal num '(important)))) ((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)) @@ -1245,27 +1207,22 @@ Set `wl-score-cache' nil." 'wl-summary-score-update-all-lines "Updating score..." (/ (* i 100) count)))) (when dels - (let ((marks dels)) - (while marks - (elmo-msgdb-set-mark (wl-summary-buffer-msgdb) - (pop marks) nil))) - (elmo-folder-mark-as-read wl-summary-buffer-elmo-folder - dels) + (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 - (let ((pair - (wl-summary-count-unread))) - (+ (car pair) (cdr pair))) - (length num-db))) - (wl-summary-update-modeline))) + ;; 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))) @@ -1371,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))) @@ -1468,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)))))