X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-score.el;h=0016bd2cddce739972d14acd59fe5114b6d21df0;hb=167053919d525e30162c34e574b6452bb858211b;hp=7e584a54afd8790f88b81d810fae384c121fbd4d;hpb=e7d7ccfbe7f86092db9723847be8106807d6327e;p=elisp%2Fwanderlust.git diff --git a/wl/wl-score.el b/wl/wl-score.el index 7e584a5..0016bd2 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -1,7 +1,7 @@ -;;; wl-score.el -- Scoring in Wanderlust. +;;; wl-score.el --- Scoring in Wanderlust. -;; Copyright 1998,1999,2000 Masahiro MURATA -;; Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Masahiro MURATA +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Masahiro MURATA ;; Keywords: mail, net news @@ -28,7 +28,7 @@ ;; Original codes are gnus-score.el and score-mode.el ;;; Code: -;; +;; (require 'wl-vars) @@ -101,7 +101,7 @@ (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) @@ -115,7 +115,7 @@ The string in the accessible portion of the current buffer is simplified. 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 @@ -137,7 +137,7 @@ 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)) @@ -146,6 +146,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -198,7 +200,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -212,12 +214,14 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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))) @@ -234,6 +238,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -260,6 +266,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -303,12 +310,12 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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 @@ -330,40 +337,23 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -405,9 +395,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -624,6 +614,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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 @@ -678,7 +669,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -743,6 +734,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -782,7 +774,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -867,7 +859,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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) @@ -934,11 +926,11 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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 @@ -954,8 +946,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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))) @@ -1002,19 +994,20 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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 @@ -1097,8 +1090,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." ;; 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 @@ -1190,8 +1184,8 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -1203,16 +1197,16 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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...") @@ -1221,7 +1215,7 @@ See `wl-score-simplify-buffer-fuzzy' for details." 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)) @@ -1252,25 +1246,27 @@ See `wl-score-simplify-buffer-fuzzy' for details." (/ (* i 100) count)))) (when dels (setq mark-alist - (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (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-folder-mark-as-read wl-summary-buffer-elmo-folder + dels) + (elmo-msgdb-set-mark-alist (wl-summary-buffer-msgdb) mark-alist) (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 + (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) (list 0 - (wl-summary-count-unread - mark-alist) + (let ((pair + (wl-summary-count-unread + mark-alist))) + (+ (car pair) (cdr pair))) (length num-db))) (wl-summary-update-modeline))) (message "Updating score...done") @@ -1292,9 +1288,9 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -1302,16 +1298,15 @@ See `wl-score-simplify-buffer-fuzzy' for details." (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)) @@ -1364,7 +1359,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (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)) @@ -1396,8 +1391,8 @@ Entering Score mode calls the value of `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 () @@ -1405,8 +1400,8 @@ Entering Score mode calls the value of `wl-score-mode-hook'." (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 () @@ -1457,6 +1452,7 @@ Entering Score mode calls the value of `wl-score-mode-hook'." 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)))))))