;;; wl-score.el -- Scoring in Wanderlust.
-;; Copyright 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
-;; Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
(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)
(defvar wl-score-edit-exit-func 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.
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]*[])}]?[:;] *")
(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))
(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))))
(sort messages func)))
(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)))
(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))
(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)
(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
fl
(cond ((functionp f)
(funcall f folder))
- ((and (symbolp f) (eq f 'guess))
- (wl-score-guess-like-gnus folder))
(t
(list f)))))
fl))
(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)))
+ (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 wl-summary-target-above))
(setq wl-summary-mark-below
(or mark mark-and-expunge wl-summary-mark-below))
(setq wl-summary-expunge-below
(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)))
(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)
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)))
(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
(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))
(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)
(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))
(defun wl-summary-rescore-msgs (number-alist)
(mapcar
'car
- (nthcdr
+ (nthcdr
(max (- (length number-alist)
wl-summary-rescore-partial-threshold)
0)
(unless arg
(wl-summary-rescore-msgs number-alist)))
(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)))
(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 t); opened
(setq update-unread t)
- (wl-thread-msg-mark-as-read num)));; closed
+ (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-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)))
+ (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)
+ (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-mark-as-read wl-summary-buffer-folder-name
dels wl-summary-buffer-msgdb)
(elmo-msgdb-set-mark-alist wl-summary-buffer-msgdb mark-alist)
;; Update Folder mode
(wl-folder-set-folder-updated wl-summary-buffer-folder-name
(list 0
- (wl-summary-count-unread
+ (wl-summary-count-unread
mark-alist)
(length num-db)))
(wl-summary-update-modeline)))
- (message "Updating score...done.")
+ (message "Updating score...done")
dels)))
(defun wl-score-edit-done ()
(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)))
(when (wl-collect-summary)
(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
projects / elisp / wanderlust.git / blobdiff