(require 'wl-vars)
(require 'wl-util)
(eval-when-compile
+ (require 'cl) ; cadaar, cddaar
(require 'elmo-msgdb)) ; for inline functions
(defvar wl-score-edit-header-char
(defun wl-score-overview-entity-get-lines (entity)
(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-message-entity-field entity 'xref)
(string= s1 s2))))
(defsubst wl-score-ov-entity-get (entity index &optional extra)
- (elmo-message-entity-field entity (if extra (intern extra) index)))
+ (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< (a1 a2)
(string-lessp (wl-score-ov-entity-get (car a1) wl-score-index)
(setq extras (cdr extras)))
nil))
-(defmacro wl-score-put-alike ()
- (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
- alike
- wl-score-alike-hashtb)))
+(defmacro wl-score-put-alike (alike)
+ `(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)))
+(defsubst wl-score-get-alike ()
+ (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)))
(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.
(wl-push art alike)
(when last
- (wl-score-put-alike)
+ (wl-score-put-alike alike)
(insert last ?\n))
(setq alike (list art)
last this)))
(when last
- (wl-score-put-alike)
+ (wl-score-put-alike alike)
(insert last ?\n))
(when mime-decode
(decode-mime-charset-region (point-min) (point-max)
(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)
entries alist messages
"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))
"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)))
(car entry)
(if increase "raise" "lower"))
(if (numberp match)
- (int-to-string match)
+ (number-to-string match)
match)))
;; 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)
(setq wl-score-help-winconf (current-window-configuration))
(let ((cur-win (selected-window))
mes-win)
- (save-excursion
- (set-buffer (get-buffer-create "*Score Help*"))
+ (with-current-buffer (get-buffer-create "*Score Help*")
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
(erase-buffer)
(delete-char -1) ; the `\n' takes a char
(insert "\n"))
(setq pad (- width 3))
- (setq format (concat "%c: %-" (int-to-string pad) "s"))
+ (setq format (concat "%c: %-" (number-to-string pad) "s"))
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
(setq i (1+ i)))
;; 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))
(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)
- wl-summary-unread-message-hook
- 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 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))
- (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
- (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 ((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")
+ (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 ((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)))
dels)))
(defun wl-score-edit-done ()
(let ((sum-buf (wl-score-edit-get-summary-buf))
(index (nth 2 (assoc header wl-score-header-index))))
(when (and sum-buf index)
- (save-excursion
- (set-buffer sum-buf)
+ (with-current-buffer sum-buf
(wl-score-get-header header extra)))))
(defun wl-score-edit-insert-number ()
(let ((sum-buf (wl-score-edit-get-summary-buf))
num)
(when sum-buf
- (if (setq num (save-excursion
- (set-buffer sum-buf)
+ (if (setq num (with-current-buffer sum-buf
(wl-summary-message-number)))
(prin1 num (current-buffer))))))
projects / elisp / wanderlust.git / blobdiff