(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)
;;
(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."
(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)
(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))
(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
(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
(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))
(< 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))
(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*")
(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))
"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))
;; 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."
(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)
(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
((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))
'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)))
(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)))
(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)))))
projects / elisp / wanderlust.git / blobdiff