-;;; wl-score.el -- Scoring in Wanderlust.
+;;; 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
;; Original codes are gnus-score.el and score-mode.el
;;; Code:
-;;
+;;
(require 'wl-vars)
(defvar wl-score-header-buffer-list nil)
(defvar wl-score-alike-hashtb nil)
-(defvar wl-score-edit-exit-func nil
+(defvar wl-score-edit-exit-function nil
"Function run on exit from the score buffer.")
(make-variable-buffer-local 'wl-current-score-file)
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."
+`wl-score-simplify-fuzzy-regexp'."
(let ((regexp
(if (listp wl-score-simplify-fuzzy-regexp)
(mapconcat (function identity) wl-score-simplify-fuzzy-regexp
(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 ((regexp
(if (listp wl-score-simplify-fuzzy-regexp)
(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)))
+ (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))
(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)
(or (and (string-match
(concat "^" (regexp-quote
(expand-file-name
- wl-score-files-dir)))
+ wl-score-files-directory)))
(expand-file-name file))
file)
(expand-file-name
file
- (file-name-as-directory wl-score-files-dir)))))
+ (file-name-as-directory wl-score-files-directory)))))
(cached (assoc file wl-score-cache))
alist)
(if cached
(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 (elmo-string (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
(if (not wl-score-folder-alist-matchone) 'all-list)))
- fl f)
+ fl f)
(while (setq f (wl-pop files))
(wl-append
fl
(cond ((functionp f)
(funcall f folder))
- ((and (symbolp f) (eq f 'guess))
- (wl-score-guess-like-gnus folder))
(t
(list f)))))
fl))
(defun wl-score-get-score-alist (&optional folder)
(interactive)
- (let* ((fld (or folder wl-summary-buffer-folder-name))
+ (let* ((fld (or folder (wl-summary-buffer-folder-name)))
(score-alist (reverse
(wl-score-get-score-files wl-score-folder-alist fld)))
alist scores)
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(overview (elmo-msgdb-get-overview
- (or msgdb wl-summary-buffer-msgdb)))
+ (or msgdb (wl-summary-buffer-msgdb))))
(mark-alist (elmo-msgdb-get-mark-alist
- (or msgdb wl-summary-buffer-msgdb)))
+ (or msgdb (wl-summary-buffer-msgdb))))
(wl-score-stop-add-entry not-add)
entries
news new num entry ov header)
(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-score-change-score-file (file)
"Change current score alist."
(interactive
- (list (read-file-name "Change to score file: " wl-score-files-dir)))
+ (list (read-file-name "Change to score file: " wl-score-files-directory)))
(wl-score-load-file file))
(defun wl-score-default (level)
(expire (and wl-score-expiry-days
(- now wl-score-expiry-days)))
(roverview (reverse (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
msgs)
(if (not expire)
(mapcar 'car (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)) ;; all messages
+ (wl-summary-buffer-msgdb))) ;; all messages
(catch 'break
(while roverview
(if (< (wl-day-number
(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)))))
+ (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)))
(setq format (concat "%c: %-" (int-to-string pad) "s"))
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
- (setq i (1+ i))
- (set-buffer-modified-p nil)))
- (when (and (get-buffer wl-message-buf-name)
- (setq mes-win (get-buffer-window
- (get-buffer wl-message-buf-name))))
- (select-window mes-win)
- (unless (eq (next-window) cur-win)
- (delete-window (next-window))))
- (split-window)
- (pop-to-buffer "*Score Help*")
- (let ((window-min-height 1))
- (shrink-window-if-larger-than-buffer))
- (select-window cur-win))))
+ (setq i (1+ i)))
+ (set-buffer-modified-p nil)))
+ (when (and wl-message-buffer
+ (get-buffer wl-message-buffer)
+ (setq mes-win (get-buffer-window
+ (get-buffer wl-message-buffer))))
+ (select-window mes-win)
+ (unless (eq (next-window) cur-win)
+ (delete-window (next-window))))
+ (split-window)
+ (pop-to-buffer "*Score Help*")
+ (let ((window-min-height 1))
+ (shrink-window-if-larger-than-buffer))
+ (select-window cur-win)))
(defun wl-score-get-header-entry (&optional match-func increase)
(let (hchar tchar pchar
;; read the score.
(unless (or score increase)
- (setq score (string-to-int (read-string "Set score: "))))
- (message "")))
+ (setq score (string-to-int (read-string "Set score: ")))))
+ (message "")
+ (wl-score-kill-help-buffer))
(let* ((match-header (or (nth 2 hentry) header))
(match (if match-func
(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
+ (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)))
(setq expunged (wl-summary-score-update-all-lines t))
(defun wl-summary-score-headers (&optional folder msgdb force-msgs not-add)
"Do scoring if scoring is required."
(let ((scores (wl-score-get-score-alist
- (or folder wl-summary-buffer-folder-name))))
+ (or folder (wl-summary-buffer-folder-name)))))
(when scores
(wl-score-headers scores msgdb force-msgs not-add))))
(defun wl-summary-score-update-all-lines (&optional update)
(let* ((alist wl-summary-scored)
(count (length alist))
- (folder wl-summary-buffer-folder-name)
(i 0)
(update-unread nil)
+ wl-summary-unread-message-hook
num score dels visible score-mark mark-alist)
(save-excursion
(message "Updating score...")
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-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-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
'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-mark-as-read wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb)
- (elmo-msgdb-set-mark-alist wl-summary-buffer-msgdb mark-alist)
+ (elmo-msgdb-set-mark (wl-summary-buffer-msgdb)
+ (pop marks) nil)))
+ (elmo-folder-mark-as-read 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))
+ (wl-summary-buffer-msgdb)))
(mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
;; Update Folder mode
- (wl-folder-set-folder-updated wl-summary-buffer-folder-name
- (list 0
- (wl-summary-count-unread
- mark-alist)
- (length num-db)))
+ (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)))
- (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)))
+ (list (read-file-name "Edit score file: " wl-score-files-directory)))
(when (wl-collect-summary)
(wl-score-save))
(let ((winconf (current-window-configuration))
(find-file-noselect file)))
(sum-buf (current-buffer)))
(if (string-match (concat "^" wl-summary-buffer-name) (buffer-name))
- (let ((cur-buf (current-buffer))
- (view-message-buffer (get-buffer wl-message-buf-name)))
- (when view-message-buffer
- (wl-select-buffer view-message-buffer)
+ (let ((cur-buf (current-buffer)))
+ (when wl-message-buffer
+ (wl-message-select-buffer wl-message-buffer)
(delete-window)
(select-window (get-buffer-window cur-buf)))
- (wl-select-buffer edit-buffer))
+ (wl-message-select-buffer edit-buffer))
(switch-to-buffer edit-buffer))
(wl-score-mode)
- (setq wl-score-edit-exit-func 'wl-score-edit-done)
+ (setq wl-score-edit-exit-function 'wl-score-edit-done)
(setq wl-score-edit-summary-buffer sum-buf)
(make-local-variable 'wl-prev-winconf)
(setq wl-prev-winconf winconf))
(setq major-mode 'wl-score-mode)
(setq mode-name "Score")
(lisp-mode-variables nil)
- (make-local-variable 'wl-score-edit-exit-func)
+ (make-local-variable 'wl-score-edit-exit-function)
(make-local-variable 'wl-score-edit-summary-buffer)
(run-hooks 'emacs-lisp-mode-hook 'wl-score-mode-hook))
(wl-as-mime-charset wl-score-mode-mime-charset
(save-buffer)))
(let ((buf (current-buffer)))
- (when wl-score-edit-exit-func
- (funcall wl-score-edit-exit-func))
+ (when wl-score-edit-exit-function
+ (funcall wl-score-edit-exit-function))
(kill-buffer buf)))
(defun wl-score-edit-kill ()
(interactive)
(let ((buf (current-buffer)))
(set-buffer-modified-p nil)
- (when wl-score-edit-exit-func
- (funcall wl-score-edit-exit-func))
+ (when wl-score-edit-exit-function
+ (funcall wl-score-edit-exit-function))
(kill-buffer buf)))
(defun wl-score-edit-get-summary-buf ()
wl-score-edit-header-char))
(error "Invalid match type")))
(message "")
+ (wl-score-kill-help-buffer)
(let* ((header (nth 1 entry))
(value (wl-score-edit-get-header header)))
(and value (prin1 value (current-buffer)))))))
projects / elisp / wanderlust.git / blobdiff