+2001-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-process-crosspost): New generic method.
+ (elmo-folder-writable-p): Ditto.
+ (elmo-folder-message-appendable-p): Eliminated.
+ (elmo-generic-folder-append-msgdb): Rewrite.
+ (elmo-newsgroups-hashtb): New internal variable.
+ (elmo-crosspost-message-set): Eliminated.
+ (elmo-crosspost-message-delete): Ditto.
+ (elmo-setup-subscribed-newsgroups): New function.
+ (elmo-crosspost-message-alist-modified): New internal variable.
+ (elmo-crosspost-message-alist-load): New function (Renamed from
+ `wl-crosspost-alist-load').
+ (elmo-crosspost-message-alist-save): Ditto (Renamed from
+ `wl-crosspost-alist-save').
+
+ * elmo-util.el (elmo-parse): New function (Renamed from `wl-parse').
+
+ * elmo-nntp.el (elmo-nntp-folder): New slots `temp-crosses' and
+ `unreads'.
+ (elmo-nntp-groups-hashtb): Eliminated (Renamed to
+ elmo-newsgroups-hashtb).
+ (elmo-nntp-message-fetch): Call `elmo-nntp-setup-crosspost-buffer',
+ `elmo-nntp-folder-update-crosspost-message-alist'.
+ (elmo-nntp-get-folders-info): Use `elmo-newsgroups-hashtb' instead of
+ `elmo-nntp-groups-hashtb'.
+ (elmo-nntp-make-groups-hashtb): Eliminated.
+ (elmo-nntp-parse-newsgroups): New function (Renamed from
+ `wl-parse-newsgroups').
+ (elmo-folder-creatable-p, elmo-folder-writable-p,
+ elmo-folder-close-internal, elmo-folder-mark-as-read,
+ elmo-folder-process-crosspost, elmo-folder-list-unreads-internal):
+ Define.
+ (elmo-nntp-folder-update-crosspost-message-alist): New function.
+
+ * elmo-net.el (elmo-message-fetch): Check buffer size.
+
+ * elmo-multi.el (elmo-multi-split-number-alist): New function.
+
+ * elmo-localdir.el (elmo-folder-append-buffer): Fixed logic.
+
+ * elmo-imap4.el (elmo-folder-rename-internal): Send `select' command
+ before `close' command.
+
+ * elmo.el (elmo-folder-list-unreads-internal): Added argument
+ `mark-alist' (All other related portions are changed).
+
+2001-02-13 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-util.el (elmo-create-hash-size): Eliminated.
+ (elmo-make-hash) Make a hash with `one less than a power of two'
+ length.
+
+ * elmo-vars.el (elmo-hash-minimum-size): New variable.
+ (elmo-hash-maximum-size): Changed value.
+
2001-02-09 Yuuichi Teranishi <teranisi@gohome.org>
* elmo-mime.el (elmo-mime-message-display): Added argument `unread'.
(elmo-folder-search (elmo-filter-folder-target-internal folder)
(elmo-filter-folder-condition-internal folder)))
-(defsubst elmo-filter-folder-list-unreads-internal (folder unread-marks)
+(defsubst elmo-filter-folder-list-unreads-internal (folder unread-marks
+ mark-alist)
(let ((unreads (elmo-folder-list-unreads-internal
(elmo-filter-folder-target-internal folder)
- unread-marks)))
+ unread-marks mark-alist)))
(unless (listp unreads)
(setq unreads
(delq nil
(luna-define-method elmo-folder-list-unreads-internal
((folder elmo-filter-folder)
- unread-marks)
- (elmo-filter-folder-list-unreads-internal folder unread-marks))
-
+ unread-marks &optional mark-alist)
+ (elmo-filter-folder-list-unreads-internal folder unread-marks mark-alist))
(defsubst elmo-filter-folder-list-importants-internal (folder important-mark)
(let ((importants (elmo-folder-list-importants-internal
(luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
new-folder)
(let ((session (elmo-imap4-get-session folder)))
+ ;; make sure the folder is selected.
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
(elmo-imap4-send-command-wait session "close")
(elmo-imap4-send-command-wait
session
(1+ (car (elmo-folder-status folder)))))))
(if (file-writable-p filename)
(write-region-as-binary
- (point-min) (point-max) filename nil 'no-msg)
- t)))
+ (point-min) (point-max) filename nil 'no-msg))
+ t))
(luna-define-method elmo-folder-append-messages :around ((folder elmo-localdir-folder)
src-folder numbers
strategy section outbuf unread))
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-map-folder) unread-marks)
+ ((folder elmo-map-folder) unread-marks &optional mark-alist)
(elmo-map-folder-locations-to-numbers
folder
(elmo-map-folder-list-unreads folder)))
;;; To override elmo-map-folder methods.
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-mark-folder) unread-marks)
+ ((folder elmo-mark-folder) unread-marks &optional mark-alist)
t)
(luna-define-method elmo-folder-list-importants-internal
elmo-message-sorted-field-list)
(run-hooks 'elmo-message-header-inserted-hook))
-(defun elmo-make-mime-message-location (folder number strategy rawbuf unseen)
+(defun elmo-make-mime-message-location (folder number strategy rawbuf unread)
;; Return the MIME message location structure.
;; FOLDER is the ELMO folder structure.
;; NUMBER is the number of the message in the FOLDER.
;; STRATEGY is the message fetching strategy.
;; RAWBUF is the output buffer for original message.
-;; If second optional argument UNSEEN is non-nil, message is not marked
+;; If second optional argument UNREAD is non-nil, message is not marked
;; as read.
(if (and strategy
(eq (elmo-fetch-strategy-entireness strategy) 'section))
(if strategy
(elmo-message-fetch folder number strategy
nil (current-buffer)
- unseen))))
+ unread))))
rawbuf))
(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
(setq cur-number (1+ cur-number)))
(elmo-msgdb-sort-by-date msgdb)))
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder)
+ &optional
+ number-alist)
+ (let ((number-alists (elmo-multi-split-number-alist
+ folder
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))))
+ (cur-number 1))
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (elmo-folder-process-crosspost child (car number-alists))
+ (setq cur-number (+ 1 cur-number)
+ number-alists (cdr number-alists)))))
+
(defsubst elmo-multi-folder-append-msgdb (folder append-msgdb)
- (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
- (all-alist (copy-sequence (append
- (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))
- number-alist)))
- (cur number-alist)
- to-be-deleted
- mark-alist same)
- (while cur
- (setq all-alist (delq (car cur) all-alist))
- ;; same message id exists.
- (if (setq same (rassoc (cdr (car cur)) all-alist))
- (unless (= (/ (car (car cur))
- (elmo-multi-folder-divide-number-internal folder))
- (/ (car same)
- (elmo-multi-folder-divide-number-internal folder)))
- ;; base is also same...delete it!
- (setq to-be-deleted (append to-be-deleted (list (car cur))))))
- (setq cur (cdr cur)))
- (setq mark-alist (elmo-delete-if
- (function
- (lambda (x)
- (assq (car x) to-be-deleted)))
- (elmo-msgdb-get-mark-alist append-msgdb)))
- (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
- (elmo-folder-set-msgdb-internal folder
- (elmo-msgdb-append
- (elmo-folder-msgdb-internal folder)
- append-msgdb t))
- (length to-be-deleted)))
+ (if append-msgdb
+ (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
+ (all-alist (copy-sequence (append
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))
+ number-alist)))
+ (cur number-alist)
+ to-be-deleted
+ mark-alist same)
+ (while cur
+ (setq all-alist (delq (car cur) all-alist))
+ ;; same message id exists.
+ (if (setq same (rassoc (cdr (car cur)) all-alist))
+ (unless (= (/ (car (car cur))
+ (elmo-multi-folder-divide-number-internal folder))
+ (/ (car same)
+ (elmo-multi-folder-divide-number-internal folder)))
+ ;; base is also same...delete it!
+ (setq to-be-deleted (append to-be-deleted (list (car cur))))))
+ (setq cur (cdr cur)))
+ (setq mark-alist (elmo-delete-if
+ (function
+ (lambda (x)
+ (assq (car x) to-be-deleted)))
+ (elmo-msgdb-get-mark-alist append-msgdb)))
+ (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-append
+ (elmo-folder-msgdb-internal folder)
+ append-msgdb t))
+ (length to-be-deleted))
+ 0))
(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder)
append-msgdb)
(elmo-folder-set-info-hashtb folder nil messages)
(cons unsync messages)))
+(defun elmo-multi-split-number-alist (folder number-alist)
+ (let ((alist (sort (copy-sequence number-alist)
+ (lambda (pair1 pair2)
+ (< (car pair1)(car pair2)))))
+ (cur-number 0)
+ one-alist split num)
+ (while alist
+ (setq cur-number (+ cur-number 1))
+ (setq one-alist nil)
+ (while (and alist
+ (eq 0
+ (/ (- (setq num (car (car alist)))
+ (* elmo-multi-divide-number cur-number))
+ (elmo-multi-folder-divide-number-internal folder))))
+ (setq one-alist (nconc
+ one-alist
+ (list
+ (cons
+ (% num (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number))
+ (cdr (car alist))))))
+ (setq alist (cdr alist)))
+ (setq split (nconc split (list one-alist))))
+ split))
+
(defun elmo-multi-split-mark-alist (folder mark-alist)
(let ((cur-number 0)
(alist (sort (copy-sequence mark-alist)
result))
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-multi-folder) unread-marks)
+ ((folder elmo-multi-folder) unread-marks &optional mark-alist)
(elmo-multi-folder-list-unreads-internal folder unread-marks))
(defun elmo-multi-folder-list-unreads-internal (folder unread-marks)
(setq cur-number (+ cur-number 1))
(unless (listp (setq unreads
(elmo-folder-list-unreads-internal
- (car folders) unread-marks)))
+ (car folders) unread-marks (car mark-alists))))
(setq unreads (delq nil
(mapcar
(lambda (x)
(error "Unplugged")))
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-net-folder) unread-marks)
+ ((folder elmo-net-folder) unread-marks &optional mark-alist)
(if (and (elmo-folder-plugged-p folder)
(elmo-folder-use-flag-p folder))
(elmo-folder-send folder 'elmo-folder-list-unreads-plugged)
number strategy section
(current-buffer) unseen)
(elmo-delete-cr-buffer)
- (when (elmo-fetch-strategy-save-cache strategy)
+ (when (and (> (buffer-size) 0)
+ (elmo-fetch-strategy-save-cache strategy))
(elmo-file-cache-save
(elmo-fetch-strategy-cache-path strategy)
section))
number strategy section
(current-buffer) unseen)
(elmo-delete-cr-buffer)
- (when (elmo-fetch-strategy-save-cache strategy)
+ (when (and (> (buffer-size) 0)
+ (elmo-fetch-strategy-save-cache strategy))
(elmo-file-cache-save
(elmo-fetch-strategy-cache-path strategy)
section))
;;; To override elmo-map-folder methods.
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-nmz-folder) unread-marks)
+ ((folder elmo-nmz-folder) unread-marks &optional mark-alist)
t)
(luna-define-method elmo-folder-list-importants-internal
;;; ELMO NNTP folder
(eval-and-compile
(luna-define-class elmo-nntp-folder (elmo-net-folder)
- (group))
+ (group temp-crosses reads))
(luna-define-internal-accessors 'elmo-nntp-folder))
(luna-define-method elmo-folder-initialize :around ((folder
Don't cache if nil.")
(defvar elmo-nntp-list-folders-cache nil)
-(defvar elmo-nntp-groups-hashtb nil)
+
(defvar elmo-nntp-groups-async nil)
(defvar elmo-nntp-header-fetch-chop-length 200)
(elmo-net-folder-server-internal folder)
(elmo-net-folder-port-internal folder)
(elmo-net-folder-stream-type-internal folder)))
- elmo-nntp-groups-hashtb))
+ elmo-newsgroups-hashtb))
(progn
(setq end-num (nth 2 entry))
(when(and killed-list
(luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
number strategy
&optional section outbuf
- unseen)
- (elmo-nntp-message-fetch folder number strategy section outbuf unseen))
+ unread)
+ (elmo-nntp-message-fetch folder number strategy section outbuf unread))
-(defun elmo-nntp-message-fetch (folder number strategy section outbuf unseen)
- (let ((session (elmo-nntp-get-session folder)))
+(defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
+ (let ((session (elmo-nntp-get-session folder))
+ newsgroups)
(with-current-buffer (elmo-network-session-buffer session)
(elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
(elmo-nntp-send-command session (format "article %s" number))
(goto-char (point-min))
(while (re-search-forward "^\\." nil t)
(replace-match "")
- (forward-line))))))))
+ (forward-line))
+ (elmo-nntp-setup-crosspost-buffer folder number)
+ (unless unread
+ (elmo-nntp-folder-update-crosspost-message-alist
+ folder (list number)))))))))
(defun elmo-nntp-post (hostname content-buf)
(let ((session (elmo-nntp-get-session
(user (aref key 2))
(port (aref key 3))
(type (aref key 4))
- (hashtb (or elmo-nntp-groups-hashtb
- (setq elmo-nntp-groups-hashtb
+ (hashtb (or elmo-newsgroups-hashtb
+ (setq elmo-newsgroups-hashtb
(elmo-make-hash count)))))
(save-excursion
(elmo-nntp-groups-read-response session cur count)
(replace-match "" t t))
(copy-to-buffer outbuf (point-min) (point-max)))))
-(defun elmo-nntp-make-groups-hashtb (groups &optional size)
- (let ((hashtb (or elmo-nntp-groups-hashtb
- (setq elmo-nntp-groups-hashtb
- (elmo-make-hash (or size (length groups)))))))
- (mapcar
- '(lambda (group)
- (or (elmo-get-hash-val group hashtb)
- (elmo-set-hash-val group nil hashtb)))
- groups)
- hashtb))
-
;; from nntp.el [Gnus]
(defsubst elmo-nntp-next-result-arrived-p ()
(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
elmo-nntp-use-cache)
-(luna-define-method elmo-folder-append-msgdb :around
- ((folder elmo-nntp-folder) append-msgdb)
- ;; IMPLEMENT ME: Process crosspost here instead of following.
- (luna-call-next-method))
+(luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder))
+ nil)
+
+(luna-define-method elmo-folder-writable-p ((folder elmo-nntp-folder))
+ nil)
+
+(defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
+ (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
+ ngs)
+ (if (not subscribe-only)
+ nglist
+ (dolist (ng nglist)
+ (if (intern-soft ng elmo-newsgroups-hashtb)
+ (setq ngs (cons ng ngs))))
+ ngs)))
+
+;;; Crosspost processing.
+
+;; 1. setup crosspost alist.
+;; 1.1. When message is fetched and is crossposted message,
+;; it is remembered in `temp-crosses' slot.
+;; temp-crosses slot is a list of cons cell:
+;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
+;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
+;; 1.3. In elmo-folder-mark-as-read, move crosspost entry
+;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
+
+;; 2. process crosspost alist.
+;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
+;; `elmo-crosspost-message-alist'.
+;; 2.2. remove crosspost entry for current newsgroup from
+;; `elmo-crosspost-message-alist'.
+;; 2.3. elmo-folder-list-unreads return unread message list according to
+;; `reads' slot.
+;; (There's a problem that if `elmo-folder-list-unreads'
+;; never executed, crosspost information is thrown away.)
+;; 2.4. In elmo-folder-close, `read' slot is cleared,
+
+(defun elmo-nntp-setup-crosspost-buffer (folder number)
+;; 1.1. When message is fetched and is crossposted message,
+;; it is remembered in `temp-crosses' slot.
+;; temp-crosses slot is a list of cons cell:
+;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
+ (let (newsgroups crosspost-newsgroups message-id)
+ (save-restriction
+ (std11-narrow-to-header)
+ (setq newsgroups (std11-fetch-field "newsgroups")
+ message-id (std11-msg-id-string
+ (car (std11-parse-msg-id-string
+ (std11-fetch-field "message-id"))))))
+ (when newsgroups
+ (when (setq crosspost-newsgroups
+ (delete
+ (elmo-nntp-folder-group-internal folder)
+ (elmo-nntp-parse-newsgroups newsgroups t)))
+ (unless (assq number
+ (elmo-nntp-folder-temp-crosses-internal folder))
+ (elmo-nntp-folder-set-temp-crosses-internal
+ folder
+ (cons (cons number (list message-id crosspost-newsgroups 'ng))
+ (elmo-nntp-folder-temp-crosses-internal folder))))))))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
+;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
+ (elmo-nntp-folder-set-temp-crosses-internal folder nil)
+ (elmo-nntp-folder-set-reads-internal folder nil)
+ )
+
+(defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
+;; 1.3. In elmo-folder-mark-as-read, move crosspost entry
+;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
+ (let (elem)
+ (dolist (number numbers)
+ (when (setq elem (assq number
+ (elmo-nntp-folder-temp-crosses-internal folder)))
+ (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
+ (setq elmo-crosspost-message-alist
+ (cons (cdr elem) elmo-crosspost-message-alist)))
+ (elmo-nntp-folder-set-temp-crosses-internal
+ folder
+ (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder)
+ numbers)
+ (elmo-nntp-folder-update-crosspost-message-alist folder numbers)
+ t)
+
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)
+ &optional
+ number-alist)
+ (elmo-nntp-folder-process-crosspost folder number-alist))
+
+(defun elmo-nntp-folder-process-crosspost (folder number-alist)
+;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
+;; `elmo-crosspost-message-alist'.
+;; 2.2. remove crosspost entry for current newsgroup from
+;; `elmo-crosspost-message-alist'.
+ (let (cross-deletes reads entity ngs)
+ (dolist (cross elmo-crosspost-message-alist)
+ (if number-alist
+ (when (setq entity (rassoc (nth 0 cross) number-alist))
+ (setq reads (cons (car entity) reads)))
+ (when (setq entity (elmo-msgdb-overview-get-entity
+ (nth 0 cross)
+ (elmo-folder-msgdb-internal folder)))
+ (setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
+ reads))))
+ (when entity
+ (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
+ (nth 1 cross)))
+ (setcar (cdr cross) ngs)
+ (setq cross-deletes (cons cross cross-deletes)))
+ (setq elmo-crosspost-message-alist-modified t)))
+ (dolist (dele cross-deletes)
+ (setq elmo-crosspost-message-alist (delq
+ dele
+ elmo-crosspost-message-alist)))
+ (elmo-nntp-folder-set-reads-internal folder reads)))
+
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-nntp-folder) unread-marks mark-alist)
+ ;; 2.3. elmo-folder-list-unreads return unread message list according to
+ ;; `reads' slot.
+ (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist
+ (elmo-folder-msgdb-internal folder)))))
+ (elmo-living-messages (delq nil
+ (mapcar
+ (lambda (x)
+ (if (member (nth 1 x) unread-marks)
+ (car x)))
+ mark-alist))
+ (elmo-nntp-folder-reads-internal folder))))
(require 'product)
(product-provide (provide 'elmo-nntp) (require 'elmo-version))
folder)))
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-pipe-folder) unread-marks)
+ ((folder elmo-pipe-folder) unread-marks &optional mark-alist)
(elmo-folder-list-unreads-internal (elmo-pipe-folder-dst-internal folder)
- unread-marks))
+ unread-marks mark-alist))
(luna-define-method elmo-folder-list-importants-internal
((folder elmo-pipe-folder) important-mark)
(static-if (fboundp 'unintern)
(list 'unintern string)))
-;; Make a hash table (default and minimum size is 1024).
(defun elmo-make-hash (&optional hashsize)
+ "Make a new hash table which have HASHSIZE size."
(make-vector
- (if hashsize (max (min (elmo-create-hash-size hashsize)
- elmo-hash-maximum-size) 1024) 1024) 0))
+ (if hashsize
+ (max
+ ;; Prime numbers as lengths tend to result in good
+ ;; hashing; lengths one less than a power of two are
+ ;; also good.
+ (min
+ (let ((i 1))
+ (while (< (- i 1) hashsize)
+ (setq i (* 2 i)))
+ (- i 1))
+ elmo-hash-maximum-size)
+ elmo-hash-minimum-size)
+ elmo-hash-minimum-size)
+ 0))
(defsubst elmo-mime-string (string)
"Normalize MIME encoded STRING."
(setq dest (cons (cons name body) dest))))
dest)))
-(defun elmo-create-hash-size (min)
- (let ((i 1))
- (while (< i min)
- (setq i (* 2 i)))
- i))
-
(defun elmo-safe-filename (folder)
(elmo-replace-in-string
(elmo-replace-in-string
(setq files (cdr files)))
(nconc (and (not root) (list file)) dirs)))
+(defun elmo-parse (string regexp &optional matchn)
+ (or matchn (setq matchn 1))
+ (let (list)
+ (store-match-data nil)
+ (while (string-match regexp string (match-end 0))
+ (setq list (cons (substring string (match-beginning matchn)
+ (match-end matchn)) list)))
+ (nreverse list)))
+
(require 'product)
(product-provide (provide 'elmo-util) (require 'elmo-version))
If server doesn't accept asynchronous commands, this variable should be
set as non-nil.")
-(defvar elmo-hash-maximum-size 4096
+(defvar elmo-hash-minimum-size 1023
+ "Minimum size of hash table.")
+
+(defvar elmo-hash-maximum-size 4095
"Maximum size of hash table.")
(defvar elmo-use-decoded-cache (featurep 'xemacs)
;;; internal
(defvar elmo-folder-type-alist nil)
+
+(defvar elmo-newsgroups-hashtb nil)
+
(elmo-define-error 'elmo-error "Error" 'error)
(elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error)
(elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error)
(defun elmo-folder-list-unreads (folder unread-marks)
"Return a list of unread message numbers contained in FOLDER.
UNREAD-MARKS is the unread marks."
- (let ((list (elmo-folder-list-unreads-internal folder unread-marks)))
+ (let ((list (elmo-folder-list-unreads-internal folder
+ unread-marks)))
(if (listp list)
list
;; Not available, use current mark.
;; Return t if the message list is not available.
)
-(luna-define-generic elmo-folder-list-unreads-internal (folder unread-marks)
+(luna-define-generic elmo-folder-list-unreads-internal (folder
+ unread-marks
+ &optional mark-alist)
;; Return a list of unread message numbers contained in FOLDER.
+ ;; If optional MARK-ALIST is set, it is used as mark-alist.
;; Return t if this feature is not available.
)
(luna-define-generic elmo-folder-creatable-p (folder)
"Returns non-nil when FOLDER is creatable.")
+(luna-define-generic elmo-folder-writable-p (folder)
+ "Returns non-nil when FOLDER is writable.")
+
(luna-define-generic elmo-folder-persistent-p (folder)
"Return non-nil when FOLDER is persistent.")
(luna-define-generic elmo-folder-create (folder)
"Create a FOLDER.")
-(luna-define-generic elmo-folder-message-appendable-p (folder)
- "Returns non-nil when FOLDER is appendable.")
-
(luna-define-generic elmo-message-deletable-p (folder number)
"Returns non-nil when the message in the FOLDER with NUMBER is deletable.")
same-number)
"Append messages from folder.
FOLDER is the ELMO folder structure.
-Make sure FOLDER is `message-appendable'.
-(Can be checked with `elmo-folder-message-appendable-p').
+Caller should make sure FOLDER is `writable'.
+(Can be checked with `elmo-folder-writable-p').
SRC-FOLDER is the source ELMO folder structure.
NUMBERS is the message numbers to be appended in the SRC-FOLDER.
UNREAD-MARKS is a list of unread mark string.
t)
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-folder) unread-marks)
+ ((folder elmo-folder) unread-marks &optional mark-alist)
t)
(luna-define-method elmo-folder-list-importants-internal
(luna-define-generic elmo-message-folder (folder number)
"Get primitive folder of the message.")
+(luna-define-generic elmo-folder-process-crosspost (folder
+ &optional
+ number-alist)
+ "Process crosspost for FOLDER.
+If NUMBER-ALIST is set, it is used as number-alist.
+Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
+
(luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
"Append APPEND-MSGDB to the current msgdb of the folder.")
(luna-define-method elmo-folder-mark-as-read ((folder elmo-folder) numbers)
t)
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)
+ &optional
+ number-alist)
+ ;; Do nothing.
+ )
+
(defun elmo-generic-folder-append-msgdb (folder append-msgdb)
- (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
- (all-alist (copy-sequence (append
- (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))
- number-alist)))
- (cur number-alist)
- pair
- to-be-deleted
- mark-alist)
- (while cur
- (setq all-alist (delq (car cur) all-alist))
- ;; same message id exists.
- (if (setq pair (rassoc (cdr (car cur)) all-alist))
- (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
- (setq cur (cdr cur)))
- (setq mark-alist (elmo-delete-if
- (function
- (lambda (x)
- (memq (car x) to-be-deleted)))
- (elmo-msgdb-get-mark-alist append-msgdb)))
- (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
- (elmo-folder-set-msgdb-internal folder
- (elmo-msgdb-append
- (elmo-folder-msgdb-internal folder)
- append-msgdb t))
- (length to-be-deleted)))
+ (if append-msgdb
+ (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
+ (all-alist (copy-sequence (append
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb-internal folder))
+ number-alist)))
+ (cur number-alist)
+ pair
+ to-be-deleted
+ mark-alist)
+ (while cur
+ (setq all-alist (delq (car cur) all-alist))
+ ;; same message id exists.
+ (if (setq pair (rassoc (cdr (car cur)) all-alist))
+ (setq to-be-deleted (nconc to-be-deleted (list (car pair)))))
+ (setq cur (cdr cur)))
+ ;; XXXX If caching is enabled, read-uncached mark should be set.
+ (setq mark-alist (elmo-delete-if
+ (function
+ (lambda (x)
+ (memq (car x) to-be-deleted)))
+ (elmo-msgdb-get-mark-alist append-msgdb)))
+ (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-append
+ (elmo-folder-msgdb-internal folder)
+ append-msgdb t))
+ (length to-be-deleted))
+ 0))
(luna-define-method elmo-folder-append-msgdb ((folder elmo-folder)
append-msgdb)
(and (eq (length (car diff)) 0)
(eq (length (cadr diff)) 0)))
(progn
- ;; NNTP:
(elmo-folder-update-number folder)
- nil ; no update
+ (elmo-folder-process-crosspost folder)
+ nil ; no update.
)
(if delete-list (elmo-msgdb-delete-msgs folder delete-list))
(when new-list
(elmo-folder-msgdb-path folder) nil)))
(setq before-append nil)
(setq crossed (elmo-folder-append-msgdb folder new-msgdb))
+ ;; process crosspost.
+ ;; Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).
+ (elmo-folder-process-crosspost folder)
(elmo-folder-set-message-modified-internal folder t)
- (elmo-folder-set-mark-modified-internal folder t))
- ;; return value.
- (list new-msgdb delete-list crossed)))
+ (elmo-folder-set-mark-modified-internal folder t)
+ ;; return value.
+ (list new-msgdb delete-list crossed))))
(quit
;; Resume to the original status.
(if before-append
(elmo-make-directory new-dir))
(rename-file old new)))))
-(defun elmo-crosspost-message-set (message-id folders &optional type)
- (if (assoc message-id elmo-crosspost-message-alist)
- (setcdr (assoc message-id elmo-crosspost-message-alist)
- (list folders type))
- (setq elmo-crosspost-message-alist
- (nconc elmo-crosspost-message-alist
- (list (list message-id folders type))))))
-
-(defun elmo-crosspost-message-delete (message-id folders)
- (let* ((id-fld (assoc message-id elmo-crosspost-message-alist))
- (folder-list (nth 1 id-fld)))
- (when id-fld
- (if (setq folder-list (elmo-list-delete folders folder-list))
- (setcar (cdr id-fld) folder-list)
- (setq elmo-crosspost-message-alist
- (delete id-fld elmo-crosspost-message-alist))))))
+(defun elmo-setup-subscribed-newsgroups (groups)
+ "Setup subscribed newsgroups.
+GROUPS is a list of newsgroup name string.
+Return a hashtable for newsgroups."
+ (let ((hashtb (or elmo-newsgroups-hashtb
+ (setq elmo-newsgroups-hashtb
+ (elmo-make-hash (length groups))))))
+ (dolist (group groups)
+ (or (elmo-get-hash-val group hashtb)
+ (elmo-set-hash-val group nil hashtb)))
+ hashtb))
+
+(defvar elmo-crosspost-message-alist-modified nil)
+(defun elmo-crosspost-message-alist-load ()
+ "Load crosspost message alist."
+ (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
+ (setq elmo-crosspost-message-alist-modified nil))
+
+(defun elmo-crosspost-message-alist-save ()
+ "Save crosspost message alist."
+ (when elmo-crosspost-message-alist-modified
+ (let ((alist elmo-crosspost-message-alist)
+ newsgroups)
+ (while alist
+ (setq newsgroups
+ (elmo-delete-if
+ '(lambda (x)
+ (not (intern-soft x elmo-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 elmo-crosspost-message-alist-modified nil))))
(defun elmo-folder-make-temp-dir (folder)
;; Make a temporary directory for FOLDER.
+2001-02-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-summary.el (wl-summary-edit-addresses): Use
+ `wl-summary-get-original-buffer'
+ (wl-summary-mark-as-unread): Don't call `wl-summary-set-crosspost'.
+ (wl-summary-jump-to-msg-by-message-id-via-nntp):
+ Use `elmo-nntp-parse-newsgroup' instead of `wl-parse-newsgroups'.
+ (wl-summary-get-newsgroups): Eliminated.
+ (wl-summary-set-crosspost): Ditto.
+ (wl-summary-is-crosspost-folder): Ditto.
+ (wl-crosspost-alist-load): Ditto.
+ (wl-crosspost-alist-save): Ditto.
+
+ * wl-folder.el (wl-folder-create-newsgroups-hashtb): Call
+ `elmo-setup-subscribed-newsgroups' instead of
+ `elmo-nntp-make-groups-hashtb'.
+ (wl-folder-suspend): Call `elmo-crosspost-message-alist-save'
+ instead of `wl-crosspost-alist-save'.
+
+ * wl-mime.el (wl-summary-burst): Use `elmo-folder-writable-p' instead
+ of `elmo-folder-message-appendable-p'.
+ (wl-mime-header-presentation-method): Eliminated.
+
+ * wl-message.el (wl-message-prev-page): Don't pass -1 to `recenter'.
+ (Error occurs in emacs21).
+
+ * wl-draft.el (wl-draft-queue-flush): Fix (fetch message to
+ the current buffer).
+
+ * wl.el (wl-save-status): Call `elmo-crosspost-message-alist-save'
+ instead of `wl-crosspost-alist-save'.
+ (wl-init): `elmo-crosspost-message-alist-load'
+ instead of `wl-crosspost-alist-load'
+
+ * wl-util.el (wl-parse): Eliminated (Renamed to `elmo-parse').
+ (wl-parse-newsgroups): Likewise.
+ (wl-biff-notify): Run `wl-biff-notify-hook'.
+
2001-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
* wl-e21.el (wl-highlight-folder-current-line): Call
(wl-draft-queue-info-operation (car msgs) 'load)
(elmo-message-fetch queue-folder
(car msgs)
- (elmo-make-fetch-strategy 'entire))
+ (elmo-make-fetch-strategy 'entire)
+ nil (current-buffer))
(condition-case err
(setq failure (funcall
wl-draft-queue-flush-send-func
(setq entities (wl-pop entity-stack))))
(and info (message "Creating newsgroups...done"))
(if (or newsgroups make-hashtb)
- (elmo-nntp-make-groups-hashtb newsgroups))))
+ (elmo-setup-subscribed-newsgroups newsgroups))))
(defun wl-folder-get-path (entity target-id &optional string)
(let ((entities (list entity))
(interactive)
(run-hooks 'wl-folder-suspend-hook)
(wl-folder-info-save)
- (wl-crosspost-alist-save)
+ (elmo-crosspost-message-alist-save)
(elmo-quit)
;(if (fboundp 'mmelmo-cleanup-entity-buffers)
;(mmelmo-cleanup-entity-buffers))
(progn
(wl-message-narrow-to-page -1)
(goto-char (point-max))
- (recenter -1))
+ (recenter))
(if (not (bobp))
(condition-case nil
(scroll-down lines)
(require 'mime-view)
(require 'mime-edit)
(require 'mime-play)
-(require 'mmelmo)
+(require 'elmo)
(eval-when-compile
(defalias-maybe 'Meadow-version 'ignore))
children message-entity content-type target)
(save-excursion
(setq target wl-summary-buffer-elmo-folder)
- (while (not (elmo-folder-message-appendable-p target))
+ (while (not (elmo-folder-writable-p target))
(setq target
(wl-summary-read-folder wl-default-folder "to extract to")))
(wl-summary-set-message-buffer-or-redisplay)
(setq overviews (cdr overviews)))
(message "Not all partials found.")))))
-(defun wl-mime-header-presentation-method (entity situation)
- (let ((mmelmo-sort-field-list wl-message-sort-field-list))
- (mime-insert-header entity
- wl-message-ignored-field-list
- wl-message-visible-field-list)
- (wl-highlight-headers)))
-
;;; Setup methods.
(defun wl-mime-setup ()
(set-alist 'mime-preview-quitting-method-alist
(if (null (wl-summary-message-number))
(message "No message.")
(save-excursion
- (wl-summary-set-message-buffer-or-redisplay)
(let* ((charset wl-summary-buffer-mime-charset)
(candidates
- (with-current-buffer (wl-message-get-original-buffer)
+ (with-current-buffer (wl-summary-get-original-buffer)
(wl-summary-edit-addresses-collect-candidate-fields
charset)))
address pair result)
(elmo-msgdb-set-mark-alist msgdb mark-alist)
(wl-summary-set-mark-modified))
(if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line nil nil t))
- (if (not notcrosses)
- (wl-summary-set-crosspost
- wl-summary-buffer-elmo-folder
- number)))
+ (wl-highlight-summary-current-line nil nil t)))
(if mark (message "Warning: Changing mark failed.")))))
(set-buffer-modified-p nil)
(if stat
(or user elmo-default-nntp-user)
(or port elmo-default-nntp-port)
(or type elmo-default-nntp-stream-type)))
- (setq newsgroups (wl-parse-newsgroups ret))
+ (setq newsgroups (elmo-nntp-parse-newsgroups ret))
(setq folder (concat "-" (car newsgroups)
(elmo-nntp-folder-postfix user server port type)))
(catch 'found
(wl-summary-set-message-buffer-or-redisplay)
(wl-message-get-original-buffer)))
-;; This function will be needless in the future.
-;; (After when Newsgroups: field is saved in msgdb)
-(defun wl-summary-get-newsgroups ()
- (let ((folder-list (elmo-folder-get-primitive-list
- wl-summary-buffer-elmo-folder))
- ng-list)
- (while folder-list
- (when (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
- (wl-append ng-list (list (elmo-nntp-folder-group-internal
- (car folder-list)))))
- (setq folder-list (cdr folder-list)))
- ng-list))
-
-;; This function will be moved to elmo in the future.
-;; (After when Newsgroups: field is saved in msgdb)
-(defun wl-summary-set-crosspost (folder number)
- (let (newsgroups)
- (when (eq (elmo-folder-type-internal folder) 'nntp)
- (with-current-buffer (wl-summary-get-original-buffer)
- (setq newsgroups (std11-field-body "newsgroups")))
- (when newsgroups
- (let* ((ng-list (wl-summary-get-newsgroups)) ;; for multi folder
- crosspost-newsgroups)
- (when (setq crosspost-newsgroups
- (elmo-list-delete ng-list
- (wl-parse-newsgroups newsgroups t)))
- (elmo-crosspost-message-set
- (elmo-message-field folder number 'message-id)
- crosspost-newsgroups)
- (setq wl-crosspost-alist-modified t)))))))
-
-(defun wl-summary-is-crosspost-folder (folder-list groups)
- "Returns newsgroup string list of FOLDER-LIST which are contained in GROUPS."
- (let (group crosses)
- (while folder-list
- (if (and (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
- (member (setq group (elmo-nntp-folder-group-internal
- (car folder-list))) groups))
- (wl-append crosses (list group)))
- (setq folder-list (cdr folder-list)))
- crosses))
-
-(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))))
-
(defun wl-summary-pack-number (&optional arg)
(interactive "P")
(elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
(list 'nconc val func)
(list 'setq val func)))
-(defun wl-parse (string regexp &optional matchn)
- (or matchn (setq matchn 1))
- (let (list)
- (store-match-data nil)
- (while (string-match regexp string (match-end 0))
- (setq list (cons (substring string (match-beginning matchn)
- (match-end matchn)) list)))
- (nreverse list)))
+(defalias 'wl-parse 'elmo-parse)
+(make-obsolete 'wl-parse 'elmo-parse)
(defun wl-delete-duplicates (list &optional all hack-addresses)
"Delete duplicate equivalent strings from the LIST.
(defalias 'wl-string 'elmo-string)
(make-obsolete 'wl-string 'elmo-string)
-(defun wl-parse-newsgroups (string &optional subscribe-only)
- (let* ((nglist (wl-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
- ret-val)
- (if (not subscribe-only)
- nglist
- (while nglist
- (if (intern-soft (car nglist) wl-folder-newsgroups-hashtb)
- (wl-append ret-val (list (car nglist))))
- (setq nglist (cdr nglist)))
- ret-val)))
-
;; Check if active region exists or not.
(if (boundp 'mark-active)
(defmacro wl-region-exists-p ()
(fset 'wl-biff-start 'ignore)))
(defsubst wl-biff-notify (new-mails notify-minibuf)
+ (if (and (not wl-modeline-biff-status) (> new-mails 0))
+ (run-hooks 'wl-biff-notify-hook))
(setq wl-modeline-biff-status (> new-mails 0))
(force-mode-line-update t)
(when notify-minibuf
(wl-refile-alist-save)
(wl-folder-info-save)
(and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
- (wl-crosspost-alist-save)
+ (elmo-crosspost-message-alist-save)
(message "Saving summary and folder status...done"))
(defun wl-exit ()
(wl-address-init)
(wl-draft-setup)
(wl-refile-alist-setup)
- (wl-crosspost-alist-load)
+ (elmo-crosspost-message-alist-load)
(if wl-use-semi
(progn
(require 'wl-mime)
projects / elisp / wanderlust.git / commitdiff