X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-msgdb.el;h=286741a78f03594731eb406be8e694834c58fc7c;hb=64eb91d7fe775e78e0f1e6555b595e40f391260a;hp=384090893b4cb70283c90618aaae05c8e597a8a7;hpb=59b0d312b553d915248a50b069369ecc1df57199;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 3840908..286741a 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -38,6 +38,42 @@ (require 'std11) (require 'mime) +(defcustom elmo-msgdb-new-mark "N" + "Mark for new message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-unread-uncached-mark "U" + "Mark for unread and uncached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-unread-cached-mark "!" + "Mark for unread but already cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-read-uncached-mark "u" + "Mark for read but uncached message." + :type '(string :tag "Mark") + :group 'elmo) + +;; Not implemented yet. +(defcustom elmo-msgdb-answered-cached-mark "&" + "Mark for answered and cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-answered-uncached-mark "A" + "Mark for answered but cached message." + :type '(string :tag "Mark") + :group 'elmo) + +(defcustom elmo-msgdb-important-mark"$" + "Mark for important message." + :type '(string :tag "Mark") + :group 'elmo) + ;;; MSGDB interface. (defun elmo-load-msgdb (path) "Load the MSGDB from PATH." @@ -60,25 +96,188 @@ (defsubst elmo-msgdb-set-mark (msgdb number mark) "Set MARK of the message with NUMBER in the MSGDB. if MARK is nil, mark is removed." - (elmo-msgdb-set-mark-alist - msgdb - (elmo-msgdb-mark-alist-set (elmo-msgdb-get-mark-alist msgdb) - number - mark msgdb)) - (unless mark - (elmo-clear-hash-val (format "#%d" number) - (elmo-msgdb-get-mark-hashtb msgdb)))) - -(defsubst elmo-msgdb-count-marks (msgdb new-mark unread-marks) + (let ((elem (elmo-get-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb)))) + (if elem + (if mark + ;; Set mark of the elem + (setcar (cdr elem) mark) + ;; Delete elem from mark-alist + (elmo-msgdb-set-mark-alist + msgdb + (delq elem (elmo-msgdb-get-mark-alist msgdb))) + (elmo-clear-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb))) + (when mark + ;; Append new element. + (elmo-msgdb-set-mark-alist + msgdb + (nconc + (elmo-msgdb-get-mark-alist msgdb) + (list (setq elem (list number mark))))) + (elmo-set-hash-val (format "#%d" number) elem + (elmo-msgdb-get-mark-hashtb msgdb)))) + ;; return value. + t)) + +(defun elmo-msgdb-get-cached (msgdb number) + "Return non-nil if message is cached." + (not (member (elmo-msgdb-get-mark msgdb number) + (elmo-msgdb-uncached-marks)))) + +(defun elmo-msgdb-set-cached (msgdb number cached use-cache) + "Set message cache status. +If mark is changed, return non-nil." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id)))) + (unless (eq cached cur-cached) + (case cur-flag + (read + (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cached)) + elmo-msgdb-read-uncached-mark))) + (important nil) + (answered + (elmo-msgdb-set-mark msgdb number + (if cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark))) + (t + (elmo-msgdb-set-mark msgdb number + (if cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark))))))) + +(defun elmo-msgdb-set-flag (msgdb folder number flag) + "Set message flag. +MSGDB is the ELMO msgdb. +FOLDER is a ELMO folder structure. +NUMBER is a message number to set flag. +FLAG is a symbol which is one of the following: +`read' ... Messages which are already read. +`important' ... Messages which are marked as important. +`answered' ... Messages which are marked as answered." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (use-cache (elmo-message-use-cache-p folder number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id))) + mark-modified) + (case flag + (read + (case cur-flag + ((read important answered)) + (t (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cur-cached)) + elmo-msgdb-read-uncached-mark)) + (setq mark-modified t)))) + (important + (unless (eq cur-flag 'important) + (elmo-msgdb-set-mark msgdb number elmo-msgdb-important-mark) + (setq mark-modified t))) + (answered + (unless (or (eq cur-flag 'answered) (eq cur-flag 'important)) + (elmo-msgdb-set-mark msgdb number + (if cur-cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark))) + (setq mark-modified t))) + (if mark-modified (elmo-folder-set-mark-modified-internal folder t)))) + +(defun elmo-msgdb-unset-flag (msgdb folder number flag) + "Unset message flag. +MSGDB is the ELMO msgdb. +FOLDER is a ELMO folder structure. +NUMBER is a message number to be set flag. +FLAG is a symbol which is one of the following: +`read' ... Messages which are already read. +`important' ... Messages which are marked as important. +`answered' ... Messages which are marked as answered." + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (use-cache (elmo-message-use-cache-p folder number)) + (cur-flag (cond + ((string= cur-mark elmo-msgdb-important-mark) + 'important) + ((member cur-mark (elmo-msgdb-answered-marks)) + 'answered) + ((not (member cur-mark (elmo-msgdb-unread-marks))) + 'read))) + (cur-cached (elmo-file-cache-exists-p + (elmo-msgdb-get-field msgdb number 'message-id))) + mark-modified) + (case flag + (read + (when (eq cur-flag 'read) + (elmo-msgdb-set-mark msgdb number + (if cur-cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) + (setq mark-modified t))) + (important + (when (eq cur-flag 'important) + (elmo-msgdb-set-mark msgdb number nil) + (setq mark-modified t))) + (answered + (when (eq cur-flag 'answered) + (elmo-msgdb-set-mark msgdb number + (if (and use-cache (not cur-cached)) + elmo-msgdb-read-uncached-mark)) + (setq mark-modified t)))) + (if mark-modified (elmo-folder-set-mark-modified-internal folder t)))) + +(defvar elmo-msgdb-unread-marks-internal nil) +(defsubst elmo-msgdb-unread-marks () + "Return an unread mark list" + (or elmo-msgdb-unread-marks-internal + (setq elmo-msgdb-unread-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark)))) + +(defvar elmo-msgdb-answered-marks-internal nil) +(defsubst elmo-msgdb-answered-marks () + "Return an answered mark list" + (or elmo-msgdb-answered-marks-internal + (setq elmo-msgdb-answered-marks-internal + (list elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)))) + +(defvar elmo-msgdb-uncached-marks-internal nil) +(defsubst elmo-msgdb-uncached-marks () + (or elmo-msgdb-uncached-marks-internal + (setq elmo-msgdb-uncached-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-answered-uncached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-read-uncached-mark)))) + +(defsubst elmo-msgdb-count-marks (msgdb) (let ((new 0) - (unreads 0)) + (unreads 0) + (answered 0)) (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) (cond - ((string= (cadr elem) new-mark) + ((string= (cadr elem) elmo-msgdb-new-mark) (incf new)) - ((member (cadr elem) unread-marks) - (incf unreads)))) - (cons new unreads))) + ((member (cadr elem) (elmo-msgdb-unread-marks)) + (incf unreads)) + ((member (cadr elem) (elmo-msgdb-answered-marks)) + (incf answered)))) + (list new unreads answered))) (defsubst elmo-msgdb-get-number (msgdb message-id) "Get number of the message which corrensponds to MESSAGE-ID from MSGDB." @@ -253,30 +452,13 @@ content of MSGDB is changed." ;;; ;; persistent mark handling ;; (for each folder) -(defun elmo-msgdb-mark-alist-set (alist id mark msgdb) - (let ((ret-val alist) - entity) - (setq entity (assq id alist)) - (if entity - (if (eq mark nil) - ;; delete this entity - (setq ret-val (delq entity alist)) - ;; set mark - (setcar (cdr entity) mark)) - (when mark - (setq ret-val (elmo-msgdb-append-element ret-val - (setq entity - (list id mark)))) - (elmo-set-hash-val (format "#%d" id) entity - (elmo-msgdb-get-mark-hashtb msgdb)))) - ret-val)) (defun elmo-msgdb-mark-append (alist id mark) "Append mark." (setq alist (elmo-msgdb-append-element alist (list id mark)))) -(defun elmo-msgdb-seen-list (msgdb seen-marks) +(defun elmo-msgdb-seen-list (msgdb) "Get SEEN-MSGID-LIST from MSGDB." (let ((ov (elmo-msgdb-get-overview msgdb)) mark seen-list) @@ -284,7 +466,8 @@ content of MSGDB is changed." (if (setq mark (elmo-msgdb-get-mark msgdb (elmo-msgdb-overview-entity-get-number (car ov)))) - (if (and mark (member mark seen-marks)) + (if (and mark (not (member mark + (elmo-msgdb-unread-marks)))) (setq seen-list (cons (elmo-msgdb-overview-entity-get-id (car ov)) seen-list))) @@ -416,6 +599,19 @@ header separator." (setcar (cdr entity) after)) (setq mark-alist (cdr mark-alist))))) +(defsubst elmo-msgdb-mark (flag cached) + (case flag + (unread + (if cached + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) + (important + elmo-msgdb-important-mark) + (answered + (if cached + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)))) + (defsubst elmo-msgdb-seen-save (dir obj) (elmo-object-save (expand-file-name elmo-msgdb-seen-filename dir) @@ -426,7 +622,7 @@ header separator." (expand-file-name elmo-msgdb-overview-filename dir) overview)) -(defun elmo-msgdb-match-condition-primitive (condition entity numbers) +(defun elmo-msgdb-match-condition-primitive (condition mark entity numbers) (catch 'unresolved (let ((key (elmo-filter-key condition)) (case-fold-search t) @@ -446,6 +642,26 @@ header separator." entity) numbers))) (string-to-int (elmo-filter-value condition))))) + ((string= key "flag") + (setq result + (cond + ((string= (elmo-filter-value condition) "any") + (not (or (null mark) + (string= mark elmo-msgdb-read-uncached-mark)))) + ((string= (elmo-filter-value condition) "digest") + (not (or (null mark) + (string= mark elmo-msgdb-read-uncached-mark) + (string= mark elmo-msgdb-answered-cached-mark) + (string= mark elmo-msgdb-answered-uncached-mark)))) +;; (member mark (append (elmo-msgdb-answered-marks) +;; (list elmo-msgdb-important-mark) +;; (elmo-msgdb-unread-marks)))) + ((string= (elmo-filter-value condition) "unread") + (member mark (elmo-msgdb-unread-marks))) + ((string= (elmo-filter-value condition) "important") + (string= mark elmo-msgdb-important-mark)) + ((string= (elmo-filter-value condition) "answered") + (member mark (elmo-msgdb-answered-marks)))))) ((string= key "from") (setq result (string-match (elmo-filter-value condition) @@ -488,31 +704,31 @@ header separator." (not result) result)))) -(defun elmo-msgdb-match-condition (condition entity numbers) +(defun elmo-msgdb-match-condition-internal (condition mark entity numbers) (cond ((vectorp condition) - (elmo-msgdb-match-condition-primitive condition entity numbers)) + (elmo-msgdb-match-condition-primitive condition mark entity numbers)) ((eq (car condition) 'and) - (let ((lhs (elmo-msgdb-match-condition (nth 1 condition) - entity numbers))) + (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))) + (let ((rhs (elmo-msgdb-match-condition-internal + (nth 2 condition) mark entity numbers))) (cond ((elmo-filter-condition-p rhs) (list 'and lhs rhs)) (rhs lhs)))) (lhs - (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))))) + (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))))) ((eq (car condition) 'or) - (let ((lhs (elmo-msgdb-match-condition (nth 1 condition) - entity numbers))) + (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))) + (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))) (cond ((elmo-filter-condition-p rhs) (list 'or lhs rhs)) (rhs @@ -522,8 +738,22 @@ header separator." (lhs t) (t - (elmo-msgdb-match-condition (nth 2 condition) - entity numbers))))))) + (elmo-msgdb-match-condition-internal (nth 2 condition) + mark entity numbers))))))) + +(defun elmo-msgdb-match-condition (msgdb condition number numbers) + "Check whether the condition of the message is satisfied or not. +MSGDB is the msgdb to search from. +CONDITION is the search condition. +NUMBER is the message number to check. +NUMBERS is the target message number list. +Return CONDITION itself if no entity exists in msgdb." + (let ((entity (elmo-msgdb-overview-get-entity number msgdb))) + (if entity + (elmo-msgdb-match-condition-internal condition + (elmo-msgdb-get-mark msgdb number) + entity numbers) + condition))) (defsubst elmo-msgdb-set-overview (msgdb overview) (setcar msgdb overview)) @@ -749,12 +979,12 @@ header separator." elmo-msgdb-directory) alist)) -(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list) +(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb seen-list) ;; Add to seen list. (let (mark) (while msgs (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs))) - (unless (member mark unread-marks) ;; not unread mark + (unless (member mark (elmo-msgdb-unread-marks)) ;; not unread mark (setq seen-list (cons (elmo-msgdb-get-field msgdb (car msgs) 'message-id) @@ -768,38 +998,43 @@ header separator." seen-list)) (defun elmo-msgdb-get-message-id-from-buffer () - (or (elmo-field-body "message-id") + (let ((msgid (elmo-field-body "message-id"))) + (if msgid + (if (string-match "<\\(.+\\)>$" msgid) + msgid + (concat "<" msgid ">")) ; Invaild message-id. ;; no message-id, so put dummy msgid. - (concat (timezone-make-date-sortable - (elmo-field-body "date")) + (concat "<" (timezone-make-date-sortable + (elmo-field-body "date")) (nth 1 (eword-extract-address-components - (or (elmo-field-body "from") "nobody")))))) + (or (elmo-field-body "from") "nobody"))) ">")))) (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time) "Create overview entity from current buffer. Header region is supposed to be narrowed." (save-excursion (let ((extras elmo-msgdb-extra-fields) + (default-mime-charset default-mime-charset) message-id references from subject to cc date - default-mime-charset extra field-body charset) (elmo-set-buffer-multibyte default-enable-multibyte-characters) - (setq message-id (elmo-msgdb-get-message-id-from-buffer) - charset (intern-soft (cdr (assoc "charset" - (mime-read-Content-Type))))) - (if charset (setq default-mime-charset charset)) + (setq message-id (elmo-msgdb-get-message-id-from-buffer)) + (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type)))) + (setq charset (intern-soft charset)) + (setq default-mime-charset charset)) (setq references (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")) (elmo-msgdb-get-last-message-id (elmo-field-body "references")))) - (setq from (elmo-mime-string (elmo-delete-char - ?\" - (or - (elmo-field-body "from") - elmo-no-from))) - subject (elmo-mime-string (or (elmo-field-body "subject") - elmo-no-subject))) + (setq from (elmo-replace-in-string + (elmo-mime-string (or (elmo-field-body "from") + elmo-no-from)) + "\t" " ") + subject (elmo-replace-in-string + (elmo-mime-string (or (elmo-field-body "subject") + elmo-no-subject)) + "\t" " ")) (setq date (or (elmo-field-body "date") time)) (setq to (mapconcat 'identity (elmo-multiple-field-body "to") ",")) (setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ",")) @@ -950,6 +1185,48 @@ Return the updated INDEX." elmo-msgdb-location-filename dir) alist)) +(defun elmo-msgdb-list-flagged (msgdb flag) + (let ((case-fold-search nil) + mark-regexp matched) + (case flag + (new + (setq mark-regexp (regexp-quote elmo-msgdb-new-mark))) + (unread + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (answered + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (important + (setq mark-regexp (regexp-quote elmo-msgdb-important-mark))) + (read + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (digest + (setq mark-regexp (elmo-regexp-opt + (append (elmo-msgdb-unread-marks) + (list elmo-msgdb-important-mark))))) + (any + (setq mark-regexp (elmo-regexp-opt + (append + (elmo-msgdb-unread-marks) + (elmo-msgdb-answered-marks) + (list elmo-msgdb-important-mark)))))) + (when mark-regexp + (if (eq flag 'read) + (dolist (number (elmo-msgdb-get-number-alist msgdb)) + (unless (string-match mark-regexp (elmo-msgdb-get-mark + msgdb number)) + (setq matched (cons number matched)))) + (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched)))))) + matched)) + +(put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1) +(def-edebug-spec elmo-msgdb-do-each-entity + ((symbolp form &rest form) &rest form)) +(defmacro elmo-msgdb-do-each-entity (spec &rest form) + `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec)))) + ,@form)) + (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version))