(require 'shimbun)
(eval-when-compile
+ (require 'cl)
(defun-maybe shimbun-servers-list ()))
(defcustom elmo-shimbun-check-interval 60
(integer :tag "number"))))
:group 'elmo)
-(defcustom elmo-shimbun-update-overview-folder-list nil
+(defcustom elmo-shimbun-update-overview-folder-list 'all
"*List of FOLDER-REGEXP.
FOLDER-REGEXP is the regexp of shimbun folder name which should be
-update overview when message is fetched."
- :type '(repeat (regexp :tag "Folder Regexp"))
+update overview when message is fetched.
+If it is the symbol `all', update overview for all shimbun folders."
+ :type '(choice (const :tag "All shimbun folders" all)
+ (repeat (regexp :tag "Folder Regexp")))
:group 'elmo)
;; Shimbun header.
(luna-define-internal-accessors 'shimbun-elmo-mua))
(luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id)
- (elmo-msgdb-message-entity (elmo-folder-msgdb
- (shimbun-elmo-mua-folder-internal mua))
- id))
+ (elmo-message-entity (shimbun-elmo-mua-folder-internal mua) id))
(eval-and-compile
(luna-define-class elmo-shimbun-folder
(defsubst elmo-shimbun-folder-shimbun-header (folder location)
(let ((hash (elmo-shimbun-folder-header-hash-internal folder)))
(or (and hash (elmo-get-hash-val location hash))
- (let ((entity (elmo-msgdb-message-entity
- (elmo-folder-msgdb folder)
- location))
+ (let ((entity (elmo-message-entity folder location))
(elmo-hash-minimum-size 63)
header)
(when entity
(elmo-shimbun-folder-set-header-hash-internal
folder
(setq hash (elmo-make-hash))))
- (elmo-set-hash-val (elmo-message-entity-field entity
- 'message-id)
+ (elmo-set-hash-val (elmo-message-entity-field entity 'message-id)
header
hash)
header)))))
(+ (* (- (car now) (car time)) 65536)
(- (nth 1 now) (nth 1 time)))))
-(defun elmo-shimbun-parse-time-string (string)
- "Parse the time-string STRING and return its time as Emacs style."
- (ignore-errors
- (let ((x (timezone-fix-time string nil nil)))
- (encode-time (aref x 5) (aref x 4) (aref x 3)
- (aref x 2) (aref x 1) (aref x 0)
- (aref x 6)))))
-
(defsubst elmo-shimbun-headers-check-p (folder)
(or (null (elmo-shimbun-folder-last-check-internal folder))
(and (elmo-shimbun-folder-last-check-internal folder)
(defun elmo-shimbun-entity-to-header (entity)
(let (message-id shimbun-id)
- (if (setq message-id (elmo-message-entity-field
- entity 'x-original-id))
+ (if (setq message-id (elmo-message-entity-field entity 'x-original-id))
(setq shimbun-id (elmo-message-entity-field entity 'message-id))
(setq message-id (elmo-message-entity-field entity 'message-id)
shimbun-id nil))
- (elmo-set-work-buf
- (set-buffer-multibyte t)
- (shimbun-make-header
- (elmo-message-entity-number entity)
- (shimbun-mime-encode-string
- (elmo-message-entity-field entity 'subject 'decode))
- (shimbun-mime-encode-string
- (elmo-message-entity-field entity 'from 'decode))
- (elmo-message-entity-field entity 'date)
- message-id
- (elmo-message-entity-field entity 'references)
- 0
- 0
- (elmo-message-entity-field entity 'xref)
- (and shimbun-id
- (list (cons "x-shimbun-id" shimbun-id)))))))
+ (elmo-with-enable-multibyte
+ (shimbun-create-header
+ (elmo-message-entity-number entity)
+ (elmo-message-entity-field entity 'subject)
+ (elmo-message-entity-field entity 'from)
+ (elmo-time-make-date-string
+ (elmo-message-entity-field entity 'date))
+ message-id
+ (elmo-message-entity-field entity 'references)
+ (elmo-message-entity-field entity 'size)
+ 0
+ (elmo-message-entity-field entity 'xref)
+ (and shimbun-id
+ (list (cons "x-shimbun-id" shimbun-id)))))))
(defsubst elmo-shimbun-folder-header-hash-setup (folder headers)
(let ((hash (or (elmo-shimbun-folder-header-hash-internal folder)
(delq nil
(mapcar
(lambda (x)
- (unless (elmo-msgdb-message-entity
- (elmo-folder-msgdb folder)
- (shimbun-header-id x))
+ (unless (elmo-message-entity folder (shimbun-header-id x))
x))
;; This takes much time.
(shimbun-headers
(when (nth 0 server-group) ; server
(elmo-shimbun-folder-set-shimbun-internal
folder
- (shimbun-open (nth 0 server-group)
- (luna-make-entity 'shimbun-elmo-mua :folder folder))))
+ (condition-case nil
+ (shimbun-open (nth 0 server-group)
+ (luna-make-entity 'shimbun-elmo-mua :folder folder))
+ (file-error
+ (luna-make-entity 'shimbun :server (nth 0 server-group))))))
(when (nth 1 server-group)
(elmo-shimbun-folder-set-group-internal
folder
(elmo-shimbun-folder-shimbun-internal folder)
(elmo-shimbun-folder-group-internal folder))
(let ((inhibit-quit t))
- (unless (elmo-map-folder-location-alist-internal folder)
- (elmo-map-folder-location-setup
+ (unless (elmo-location-map-alist folder)
+ (elmo-location-map-setup
folder
(elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))
(when (and (elmo-folder-plugged-p folder)
(elmo-shimbun-headers-check-p folder))
(elmo-shimbun-get-headers folder)
- (elmo-map-folder-update-locations
+ (elmo-location-map-update
folder
(elmo-map-folder-list-message-locations folder))))))
folder nil))
(luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
- (elmo-plugged-p
- "shimbun"
- (and (elmo-shimbun-folder-shimbun-internal folder)
- (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))
- nil nil
- (and (elmo-shimbun-folder-shimbun-internal folder)
- (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))))
+ (if (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-plugged-p
+ "shimbun"
+ (shimbun-server (elmo-shimbun-folder-shimbun-internal folder))
+ nil nil
+ (shimbun-server (elmo-shimbun-folder-shimbun-internal folder)))
+ t))
(luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
plugged &optional add)
(elmo-shimbun-folder-shimbun-internal folder)
header)
(setq ov (elmo-msgdb-create-message-entity-from-buffer
- (elmo-folder-msgdb-internal folder) number))
+ (elmo-msgdb-message-entity-handler
+ (elmo-folder-msgdb-internal folder)) number))
(elmo-message-entity-set-field
ov
'xref (shimbun-header-xref header)))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
numlist flag-table)
(let ((new-msgdb (elmo-make-msgdb))
- entity i percent length msgid flags)
- (setq length (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-shimbun-msgdb-create-entity
- folder (car numlist)))
- (when entity
- (setq msgid (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table msgid))
- (elmo-global-flags-set flags folder (car numlist) msgid)
- (elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> length elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) length))
- (elmo-display-progress
- 'elmo-folder-msgdb-create "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
- (elmo-msgdb-sort-by-date new-msgdb)))
+ entity msgid flags)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numlist))
+ "Creating msgdb"
+ (dolist (number numlist)
+ (setq entity (elmo-shimbun-msgdb-create-entity folder number))
+ (when entity
+ (setq msgid (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table msgid))
+ (elmo-global-flags-set flags folder number msgid)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
+ new-msgdb))
(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
nil)
-(defsubst elmo-shimbun-update-overview (folder shimbun-id header)
- (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder)
- shimbun-id))
- (message-id (shimbun-header-id header))
+(defsubst elmo-shimbun-update-overview (folder entity shimbun-id header)
+ (let ((message-id (shimbun-header-id header))
references)
- (unless (string= shimbun-id message-id)
- (elmo-message-entity-set-field
- entity 'x-original-id message-id)
- (elmo-shimbun-header-set-extra-field
- header "x-shimbun-id" shimbun-id)
- (elmo-set-hash-val message-id
- entity
- (elmo-shimbun-folder-entity-hash folder))
- (elmo-set-hash-val shimbun-id
- entity
- (elmo-shimbun-folder-entity-hash folder)))
- (elmo-message-entity-set-field
- entity
- 'from
- (elmo-mime-string (shimbun-header-from header)))
- (elmo-message-entity-set-field
- entity
- 'subject
- (elmo-mime-string (shimbun-header-subject header)))
- (elmo-message-entity-set-field
- entity
- 'date
- (shimbun-header-date header))
- (when (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"))))
- (elmo-message-entity-set-field
- entity
- 'references
- (or (elmo-message-entity-field
- (elmo-get-hash-val
- references
- (elmo-shimbun-folder-entity-hash folder))
- 'message-id)
- references)))))
+ (when (elmo-msgdb-update-entity
+ (elmo-folder-msgdb folder)
+ entity
+ (nconc
+ (unless (string= shimbun-id message-id)
+ (elmo-shimbun-header-set-extra-field
+ header "x-shimbun-id" shimbun-id)
+ (elmo-set-hash-val message-id
+ entity
+ (elmo-shimbun-folder-entity-hash folder))
+ (elmo-set-hash-val shimbun-id
+ entity
+ (elmo-shimbun-folder-entity-hash folder))
+ (list (cons 'x-original-id message-id)))
+ (list
+ (cons 'from (shimbun-header-from header 'no-encode))
+ (cons 'subject (shimbun-header-subject header 'no-encode))
+ (cons 'date (shimbun-header-date header))
+ (cons 'references
+ (elmo-msgdb-get-references-from-buffer)))))
+ (elmo-emit-signal 'update-overview folder
+ (elmo-message-entity-number entity)))))
(luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
location strategy
shimbun-id)
(shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
header)
- (when (elmo-string-match-member
- (elmo-folder-name-internal folder)
- elmo-shimbun-update-overview-folder-list)
- (elmo-shimbun-update-overview folder location header))
+ (when (or (eq elmo-shimbun-update-overview-folder-list 'all)
+ (elmo-string-match-member
+ (elmo-folder-name-internal folder)
+ elmo-shimbun-update-overview-folder-list))
+ (let ((entity (elmo-message-entity folder location)))
+ (when entity
+ (elmo-shimbun-update-overview folder entity location header))))
(when (setq shimbun-id
(elmo-shimbun-header-extra-field header "x-shimbun-id"))
(goto-char (point-min))
(when (and (elmo-message-entity-field ov 'xref)
(if expire-days
(< (elmo-shimbun-lapse-seconds
- (elmo-shimbun-parse-time-string
- (elmo-message-entity-field ov 'date)))
+ (elmo-message-entity-field ov 'date))
(* expire-days 86400 ; seconds per day
))
t))
(setq folders
(append folders
(mapcar
- (lambda (fld) (concat prefix server "." fld))
+ (lambda (group) (concat prefix server "." group))
(shimbun-groups
- (shimbun-open server
- (let ((fld
- (elmo-make-folder
- (concat prefix server))))
- (luna-make-entity
- 'shimbun-elmo-mua
- :folder fld))))))))
+ (elmo-shimbun-folder-shimbun-internal
+ (elmo-get-folder (concat prefix server))))))))
folders)))))
(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
(if (elmo-shimbun-folder-group-internal folder)
- (progn
+ (if (fboundp 'shimbun-group-p)
+ (shimbun-group-p (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-shimbun-folder-group-internal folder))
(member
(elmo-shimbun-folder-group-internal folder)
- (shimbun-groups (elmo-shimbun-folder-shimbun-internal
- folder))))
+ (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder))))
t))
+(luna-define-method elmo-folder-delete-messages ((folder elmo-shimbun-folder)
+ numbers)
+ (elmo-folder-kill-messages folder numbers)
+ t)
+
+(luna-define-method elmo-message-entity-parent ((folder elmo-shimbun-folder)
+ entity)
+ (let ((references (elmo-message-entity-field entity 'references)))
+ (and references
+ (elmo-get-hash-val references
+ (elmo-shimbun-folder-entity-hash folder)))))
+
(require 'product)
(product-provide (provide 'elmo-shimbun) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff