-(defun wl-summary-get-newsgroups ()
- (let ((spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
- ng-list)
- (while spec-list
- (when (eq (caar spec-list) 'nntp)
- (wl-append ng-list (list (nth 1 (car spec-list)))))
- (setq spec-list (cdr spec-list)))
- ng-list))
-
-(defun wl-summary-set-crosspost (&optional type redisplay)
- (let* ((number (wl-summary-message-number))
- (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
- number))
- (folder (nth 1 spec))
- message-buf newsgroups)
- (when (eq (car spec) 'nntp)
- (if redisplay
- (wl-summary-redisplay))
- (save-excursion
- (if (setq message-buf (wl-message-get-original-buffer))
- (set-buffer message-buf))
- (setq newsgroups (std11-field-body "newsgroups")))
- (when newsgroups
- (let* ((msgdb wl-summary-buffer-msgdb)
- (num-db (elmo-msgdb-get-number-alist msgdb))
- (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
- crosspost-folders)
- (when (setq crosspost-folders
- (elmo-list-delete ng-list
- (wl-parse-newsgroups newsgroups t)))
- (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
- crosspost-folders
- type) ;;not used
- (setq wl-crosspost-alist-modified t)))))))
-
-(defun wl-summary-is-crosspost-folder (spec-list fld-list)
- (let (fld flds)
- (while spec-list
- (if (and (eq (caar spec-list) 'nntp)
- (member (setq fld (nth 1 (car spec-list))) fld-list))
- (wl-append flds (list fld)))
- (setq spec-list (cdr spec-list)))
- flds))
-
-(defun wl-summary-update-crosspost ()
- (let* ((msgdb wl-summary-buffer-msgdb)
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
- (alist elmo-crosspost-message-alist)
- (crossed 0)
- mark ngs num)
- (when (assq 'nntp spec-list)
- (while alist
- (when (setq ngs
- (wl-summary-is-crosspost-folder
- spec-list
- (nth 1 (car alist))))
- (when (setq num (car (rassoc (caar alist) number-alist)))
- (if (and (setq mark (cadr (assq num mark-alist)))
- (member mark (list wl-summary-new-mark
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark)))
- (setq crossed (1+ crossed)))
- (if (wl-summary-jump-to-msg num)
- (wl-summary-mark-as-read t);; opened
- (wl-summary-mark-as-read t nil nil num)));; closed
- ;; delete if message does't exists.
- (elmo-crosspost-message-delete (caar alist) ngs)
- (setq wl-crosspost-alist-modified t))
- (setq alist (cdr alist))))
- (if (> crossed 0)
- crossed)))
-
-(defun wl-crosspost-alist-load ()
- (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
- (setq wl-crosspost-alist-modified nil))
-
-(defun wl-crosspost-alist-save ()
- (when wl-crosspost-alist-modified
- ;; delete non-exists newsgroups
- (let ((alist elmo-crosspost-message-alist)
- newsgroups)
- (while alist
- (setq newsgroups
- (elmo-delete-if
- '(lambda (x)
- (not (intern-soft x wl-folder-newsgroups-hashtb)))
- (nth 1 (car alist))))
- (if newsgroups
- (setcar (cdar alist) newsgroups)
- (setq elmo-crosspost-message-alist
- (delete (car alist) elmo-crosspost-message-alist)))
- (setq alist (cdr alist)))
- (elmo-crosspost-alist-save elmo-crosspost-message-alist)
- (setq wl-crosspost-alist-modified nil))))