* Disconnected operation features are not supported yet.
+2001-03-12 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo.el (elmo-folder-msgdb): Define as macro.
+ (elmo-folder-open): Added argument `load-msgdb'.
+ (elmo-generic-folder-open): Ditto.
+ (elmo-folder-encache): New function.
+
+ * elmo-dop.el (elmo-dop-queue): Moved from elmo-dop.el.
+
+ * elmo-net.el (elmo-message-fetch): Check the cache path is non-nil.
+
+ * elmo-msgdb.el (elmo-msgdb-delete-msgs):
+ Eliminated argument FOLDER and added argument MSGDB.
+ (elmo-dop-queue-load): Moved from elmo-dop.el.
+ (elmo-dop-queue-save): Ditto.
+
+ * elmo-map.el (elmo-map-folder-update-locations): Sort by number.
+
+ * elmo-imap4.el (elmo-folder-open): Added argument load-msgdb.
+
+ * elmo-filter.el (elmo-filter-folder-list-unreads-internal):
+ Use elmo-folder-msgdb instead of elmo-folder-msgdb-internal.
+ (elmo-filter-folder-list-importants-internal): Ditto.
+
+ * elmo-map.el (elmo-folder-pack-number): Ditto.
+
+ * elmo-mime.el (elmo-mime-message-display): Ditto.
+
+ * elmo.el (elmo-generic-folder-commit): Ditto.
+ (elmo-folder-list-unreads): Ditto.
+ (elmo-folder-list-importants): Ditto.
+ (elmo-generic-folder-commit): Ditto.
+ (elmo-message-set-mark): Ditto.
+ (elmo-generic-folder-append-msgdb): Ditto.
+ (elmo-folder-synchronize): Ditto.
+ (elmo-folder-messages): Ditto.
+ (elmo-init): Call elmo-dop-queue-load.
+ (elmo-folder-list-messages): Ditto.
+
+ * elmo-nntp.el (elmo-folder-update-number): Ditto.
+ (elmo-nntp-folder-process-crosspost): Ditto.
+ (elmo-folder-list-unreads-internal): Ditto.
+
+ * elmo-dop.el: Removed old functions.
+
+2001-03-05 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument from
+ `folder' to `msgdb'.
+
2001-03-01 Yuuichi Teranishi <teranisi@gohome.org>
* mmimap.el (mmimap-parse-parameters-from-list): Define as alias for
elmo-msgdb-dir))
"A folder for `elmo-folder-append-messages' disconnected operations.")
-(defun elmo-dop-queue-append (folder function arguments)
- (let ((operation (list (elmo-folder-name-internal folder)
- function arguments)))
- (unless (member operation elmo-dop-queue) ;; don't append same operation
- (setq elmo-dop-queue
- (append elmo-dop-queue
- (list operation)))
- (elmo-dop-queue-save))))
+(defmacro elmo-make-dop-queue (fname method arguments)
+ "Make a dop queue."
+ (` (vector (, fname) (, method) (, arguments))))
+
+(defmacro elmo-dop-queue-fname (queue)
+ "Return the folder name string of the QUEUE."
+ (` (aref (, queue) 0)))
+
+(defmacro elmo-dop-queue-method (queue)
+ "Return the method symbol of the QUEUE."
+ (` (aref (, queue) 1)))
+
+(defmacro elmo-dop-queue-arguments (queue)
+ "Return the arguments of the QUEUE."
+ (` (aref (, queue) 2)))
+
+(defun elmo-dop-queue-append (fname method arguments)
+ "Append to disconnected operation queue."
+ (let ((queue (elmo-make-dop-queue fname method arguments)))
+ (setq elmo-dop-queue (nconc elmo-dop-queue (list queue)))))
(defun elmo-dop-queue-flush (&optional force)
- "Flush Disconnected operations.
+ "Flush disconnected operations.
If optional argument FORCE is non-nil, try flushing all operation queues
even an operation concerns the unplugged folder."
(elmo-dop-queue-merge)
(setq i (+ 1 i))
(message "Flushing queue....%d/%d." i num)
(condition-case err
- (if (and (not force)
- (not (elmo-folder-plugged-p (nth 0 (car queue)))))
- (setq failure t)
- (setq folder (nth 0 (car queue))
- func (nth 1 (car queue)))
- (cond
- ((string= func "prefetch-msgs")
- (elmo-prefetch-msgs
- folder
- (nth 2 (car queue)))) ;argunemt
- ((string= func "append-operations")
- (elmo-dop-flush-pending-append-operations
- folder nil t))
- (t
- (elmo-call-func
- folder
- func
- (nth 2 (car queue)) ;argunemt
- ))))
+ (apply (elmo-dop-queue-method (car queue))
+ (elmo-dop-queue-fname (car queue))
+ (elmo-dop-queue-arguments queue))
(quit (setq failure t))
(error (setq failure err)))
(if failure
- ;; create-folder was failed.
- (when (and (string= func "create-folder-maybe")
- (elmo-y-or-n-p
- (format
- "Create folder %s failed. Abort creating? "
- folder)
- (not elmo-dop-flush-confirm) t))
- (elmo-dop-save-pending-messages folder)
- (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)))
+ ();
(setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
(setq performed (+ 1 performed)))
(setq queue (cdr queue)))
(message "%d/%d operation(s) are performed successfully."
performed num)
- (sit-for 1) ;
+ (sit-for 0) ;
(elmo-dop-queue-save)))
(if (elmo-y-or-n-p "Clear all pending operations? "
(not elmo-dop-flush-confirm) t)
- (let ((queue elmo-dop-queue))
- (while queue
- (if (string= (nth 1 (car queue)) "append-operations")
- (elmo-dop-append-list-save (nth 0 (car queue)) nil))
- (setq queue (cdr queue)))
+ (progn
(setq elmo-dop-queue nil)
(message "All pending operations are cleared.")
(elmo-dop-queue-save))
(message "")))
count)))
-(defconst elmo-dop-merge-funcs
- '("delete-msgids"
- "prefetch-msgs"
- "unmark-important"
- "mark-as-important"
- "mark-as-read"
- "mark-as-unread"))
-
+(defvar elmo-dop-merge-funcs nil)
(defun elmo-dop-queue-merge ()
(let ((queue elmo-dop-queue)
new-queue match-queue que)
(setq queue (cdr queue)))
(setq elmo-dop-queue new-queue)))
-(defun elmo-dop-queue-load ()
- (save-excursion
- (setq elmo-dop-queue
- (elmo-object-load
- (expand-file-name elmo-queue-filename
- elmo-msgdb-dir)))))
-
-(defun elmo-dop-queue-save ()
- (save-excursion
- (elmo-object-save
- (expand-file-name elmo-queue-filename
- elmo-msgdb-dir)
- elmo-dop-queue)))
-
-(defun elmo-dop-append-list-load (folder &optional resume)
- (elmo-object-load
- (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-folder-msgdb-path folder))))
-(defun elmo-dop-append-list-save (folder append-list &optional resume)
- (if append-list
- (elmo-object-save
- (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-folder-msgdb-path folder))
- append-list)
- (condition-case ()
- (delete-file (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-folder-msgdb-path folder)))
- (error))))
+;;; Execution is delayed.
-(defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
- "returns (new-appended . deleting-msgids)."
- (let (msgid deleting-msgids)
- (while numbers
- (setq msgid (cdr (assq (car numbers) alist)))
- (if (member msgid appended)
- (setq appended (delete msgid appended))
- (setq deleting-msgids (append deleting-msgids (list msgid))))
- (setq numbers (cdr numbers)))
- (cons appended deleting-msgids)))
-(defun elmo-dop-list-deleted (name number-alist)
- "List message numbers to be deleted on folder with NAME from NUMBER-ALIST."
- (elmo-dop-queue-load)
- (let ((queue elmo-dop-queue)
- numbers matches nalist)
- (while queue
- (if (and (string= (nth 0 (car queue)) name)
- (string= (nth 1 (car queue)) "delete-msgids"))
- (setq numbers
- (nconc numbers
- (delq nil (mapcar
- (lambda (x)
- (mapcar 'car
- (elmo-string-rassoc-all
- x number-alist)))
- (nth 2 (car queue)))))))
- (setq queue (cdr queue)))
- (elmo-uniq-list (elmo-flatten numbers))))
+;;; Offline append:
+;; If appended message is local file or cached, it is saved in
+;; .elmo/dop/1 2 3 4 ...
+;; then msgdb-path/append file is created and contain message number list.
+;; ex. (1 3 5)
-(defun elmo-dop-delete-msgs (folder msgs msgdb)
- (save-match-data
- (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
- appended-deleting)
- (while folder-numbers
- (if (eq (elmo-folder-get-type (car (car folder-numbers)))
- 'imap4)
- (if elmo-enable-disconnected-operation
- (progn
- (setq appended-deleting
- (elmo-dop-deleting-numbers-to-msgids
- (elmo-msgdb-get-number-alist msgdb)
- msgs ; virtual number
- (elmo-dop-append-list-load folder)))
- (if (cdr appended-deleting)
- (elmo-dop-queue-append
- (car (car folder-numbers)) ; real folder
- "delete-msgids" ;; for secure removal.
- (cdr appended-deleting)))
- (elmo-dop-append-list-save folder (car appended-deleting)))
- (error "Unplugged"))
- ;; not imap4 folder...delete now!
- (elmo-call-func (car (car folder-numbers)) "delete-msgs"
- (cdr (car folder-numbers))))
- (setq folder-numbers (cdr folder-numbers))))
- t))
+(defun elmo-folder-append-buffer-dop (folder unread &optional number)
+ )
-(defun elmo-dop-prefetch-msgs (folder msgs)
- (save-match-data
- (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
+(defun elmo-folder-delete-messages-dop (folder numbers)
+ )
-(defun elmo-dop-list-folder (folder &optional nohide)
- (if (or (memq (elmo-folder-get-type folder)
- '(imap4 nntp pop3 filter pipe))
- (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
- (if elmo-enable-disconnected-operation
- (let* ((path (elmo-msgdb-expand-path folder))
- (number-alist (elmo-msgdb-number-load path))
- (number-list (mapcar 'car number-alist))
- (append-list (elmo-dop-append-list-load folder))
- (append-num (length append-list))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load path)))
- alreadies
- max-num
- (i 0))
- (setq killed (nconc (elmo-dop-list-deleted folder number-alist)
- killed))
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
- (list (car append-list)))))
- (setq append-list (cdr append-list)))
- (setq append-num (- append-num (length alreadies)))
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0)
- number-list) 0))
- (while (< i append-num)
- (setq number-list
- (append number-list
- (list (+ max-num i 1))))
- (setq i (+ 1 i)))
- (elmo-living-messages number-list killed))
- (error "Unplugged"))
- ;; not imap4 folder...list folder
- (elmo-call-func folder "list-folder")))
+(defun elmo-folder-encache-dop (folder numbers)
+ )
-(defun elmo-dop-count-appended (folder)
- (length (elmo-dop-append-list-load folder)))
+(defun elmo-create-folder-dop (folder)
+ )
-(defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
- (let ((append-list (elmo-dop-append-list-load folder))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- matched)
- (if (eq (elmo-folder-get-type folder) 'imap4)
- (progn
-;;; (while append-list
-;;; (if (setq matched (car (rassoc (car append-list) number-alist)))
-;;; (setq msgs (delete matched msgs)))
-;;; (setq append-list (cdr append-list)))
- (if msgs
- (elmo-dop-queue-append folder func-name msgs)))
- ;; maildir... XXX hard coding.....
- (if (not (featurep 'elmo-maildir))
- (require 'maildir))
- (funcall (intern (format "elmo-maildir-%s" func-name))
- (elmo-folder-get-spec folder)
- msgs msgdb))))
-
-(defun elmo-dop-folder-status (folder)
+;;; Execute as subsutitute for plugged operation.
+(defun elmo-folder-status-dop (folder)
(let* ((number-alist (elmo-msgdb-number-load
(elmo-folder-msgdb-path folder)))
(number-list (mapcar 'car number-alist))
- (append-list (elmo-dop-append-list-load folder))
- (append-num (length append-list))
- alreadies
(i 0)
max-num)
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
- (list (car append-list)))))
- (setq append-list (cdr append-list)))
+ ;; number of messages which are queued as append should be added
+ ;; to max-num and length.
(setq max-num
(or (nth (max (- (length number-list) 1) 0) number-list)
0))
- (cons (- (+ max-num append-num) (length alreadies))
- (- (+ (length number-list) append-num) (length alreadies)))))
-
-(defun elmo-dop-max-of-folder (folder)
- (if (eq (elmo-folder-get-type folder) 'imap4)
- (if elmo-enable-disconnected-operation
- (let* ((number-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder)))
- (number-list (mapcar 'car number-alist))
- (append-list (elmo-dop-append-list-load folder))
- (append-num (length append-list))
- alreadies
- (i 0)
- max-num)
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
- (list (car append-list)))))
- (setq append-list (cdr append-list)))
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0) number-list)
- 0))
- (cons (- (+ max-num append-num) (length alreadies))
- (- (+ (length number-list) append-num) (length alreadies))))
- (error "Unplugged"))
- ;; not imap4 folder.
- (elmo-call-func folder "max-of-folder")))
-
-(defun elmo-dop-save-pending-messages (folder)
- (message (format "Saving queued message in %s..." elmo-lost+found-folder))
- (let* ((append-list (elmo-dop-append-list-load folder))
- file-string)
- (while append-list
- (when (setq file-string (elmo-get-file-string ; message string
- (elmo-cache-get-path
- (car append-list))))
- (elmo-append-msg elmo-lost+found-folder file-string)
- (elmo-dop-unlock-message (car append-list)))
- (setq append-list (cdr append-list))
- (elmo-dop-append-list-save folder nil)))
- (message (format "Saving queued message in %s...done"
- elmo-lost+found-folder)))
-
-(defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
- (message "Appending queued messages...")
- (let* ((append-list (or appends
- (elmo-dop-append-list-load folder)))
- (appendings append-list)
- (i 0)
- (num (length append-list))
- failure file-string)
- (when resume
- ;; Resume msgdb changed by elmo-dop-msgdb-create.
- (let* ((resumed-list (elmo-dop-append-list-load folder t))
- (number-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder)))
- (appendings append-list)
- pair dels)
- (while appendings
- (if (setq pair (rassoc (car appendings) number-alist))
- (setq resumed-list (append resumed-list
- (list (car appendings)))))
- (setq appendings (cdr appendings)))
- (elmo-dop-append-list-save folder resumed-list t)))
- (while appendings
- (let* ((seen-list (elmo-msgdb-seen-load
- (elmo-msgdb-expand-path folder))))
- (setq failure nil)
- (setq file-string (elmo-get-file-string ; message string
- (elmo-cache-get-path
- (car appendings))))
- (when file-string
- (condition-case ()
- (elmo-append-msg folder file-string (car appendings) nil
- (not (member (car appendings) seen-list)))
- (quit (setq failure t))
- (error (setq failure t)))
- (setq i (+ 1 i))
- (message (format "Appending queued messages...%d" i))
- (if failure
- (elmo-append-msg elmo-lost+found-folder
- file-string (car appendings) nil
- (not (member (car appendings) seen-list)))))
- (elmo-dop-unlock-message (car appendings))
- (setq appendings (cdr appendings))))
- ;; All pending append operation is flushed.
- (elmo-dop-append-list-save folder nil)
- (elmo-commit folder)
- (unless resume
- ;; delete '(folder "append-operations") in elmo-dop-queue.
- (let (elmo-dop-queue)
- (elmo-dop-queue-load)
- (setq elmo-dop-queue (delete (list folder "append-operations" nil)
- elmo-dop-queue))
- (elmo-dop-queue-save))))
- (message "Appending queued messages...done"))
-
-(defun elmo-dop-folder-exists-p (folder)
- (or (file-exists-p (elmo-msgdb-expand-path folder))
- (if (and elmo-enable-disconnected-operation
- (eq (elmo-folder-get-type folder) 'imap4))
- (file-exists-p (elmo-msgdb-expand-path folder))
- (elmo-call-func folder "folder-exists-p"))))
-
-(defun elmo-dop-create-folder (folder)
- (if (eq (elmo-folder-get-type folder) 'imap4)
- (if elmo-enable-disconnected-operation
- (elmo-dop-queue-append folder "create-folder-maybe" nil)
- (error "Unplugged"))
- (elmo-call-func folder "create-folder")))
-
-(defun elmo-dop-append-msg (folder string message-id &optional msg)
- (if elmo-enable-disconnected-operation
- (if message-id
- (progn
- (unless (elmo-cache-exists-p message-id)
- (elmo-set-work-buf
- (insert string)
- (elmo-cache-save message-id nil folder msg (current-buffer))))
- (let ((append-list (elmo-dop-append-list-load folder))
- (number-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder))))
- (when (and ; not in current folder.
- (not (rassoc message-id number-alist))
- (not (member message-id append-list)))
- (setq append-list
- (append append-list (list message-id)))
- (elmo-dop-lock-message message-id)
- (elmo-dop-append-list-save folder append-list)
- (elmo-dop-queue-append folder "append-operations" nil))
- t))
- nil)
- (error "Unplugged")))
-
-(defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
-
-(defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (if (or (eq (elmo-folder-get-type folder) 'imap4)
- (eq (elmo-folder-get-type folder) 'nntp))
- (if elmo-enable-disconnected-operation
- (let* ((num-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder)))
- (number-list (mapcar 'car num-alist))
- (ov (elmo-msgdb-overview-load
- (elmo-msgdb-expand-path folder)))
- (append-list (elmo-dop-append-list-load folder))
- (num (length numlist))
- (i 0)
- overview number-alist mark-alist msgid ov-entity
- max-num percent seen gmark)
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0) number-list)
- 0))
- (while numlist
- (if (setq msgid
- (nth (+ (length append-list)
- (- (car numlist) max-num 1 num))
- append-list))
- (progn
- (setq overview
- (elmo-msgdb-append-element
- overview
- (elmo-localdir-msgdb-create-overview-entity-from-file
- (car numlist)
- (elmo-cache-get-path msgid))))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (car numlist) msgid))
- (setq seen (member msgid seen-list))
- (if (setq gmark
- (or (elmo-msgdb-global-mark-get msgid)
- (if (elmo-cache-exists-p
- msgid
- folder
- (car number-alist))
- (if seen
- nil
- already-mark)
- (if seen
- seen-mark)
- new-mark)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist (car numlist) gmark))))
-
- (when (setq ov-entity (assoc
- (cdr (assq (car numlist) num-alist))
- ov))
- (setq overview
- (elmo-msgdb-append-element
- overview ov-entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (car numlist)
- (car ov-entity)))
- (setq seen (member ov-entity seen-list))
- (if (setq gmark
- (or (elmo-msgdb-global-mark-get (car ov-entity))
- (if (elmo-cache-exists-p
- msgid
- folder
- (car ov-entity))
- (if seen
- nil
- already-mark)
- (if seen
- seen-mark)
- new-mark)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist (car numlist) gmark)))))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (list overview number-alist mark-alist))
- (error "Unplugged"))
- ;; not imap4 folder...
- (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
- seen-mark important-mark seen-list)))
+ (cons max-num number-list)))
(require 'product)
(product-provide (provide 'elmo-dop) (require 'elmo-version))
(elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))
(elmo-list-filter
(mapcar 'car (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
unreads)))
(luna-define-method elmo-folder-list-unreads-internal
(elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))))
(elmo-list-filter
(mapcar 'car (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
importants)))
(luna-define-method elmo-folder-list-importants-internal
elmo-folder-diff-async-callback-data)
(elmo-imap4-server-diff-async folder))
-(luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder))
+(luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
+ &optional load-msgdb)
(if (elmo-folder-plugged-p folder)
(let (session mailbox msgdb response tag)
(condition-case err
(list "select "
(elmo-imap4-mailbox
mailbox))))
- (setq msgdb (elmo-msgdb-load folder))
+ (if load-msgdb
+ (setq msgdb (elmo-msgdb-load folder)))
(elmo-folder-set-killed-list-internal
folder
(elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
(and session
(elmo-imap4-session-set-current-mailbox-internal
session nil)))))
- (elmo-folder-set-msgdb-internal folder
- (or msgdb (elmo-msgdb-load folder))))
+ (if load-msgdb
+ (elmo-folder-set-msgdb-internal
+ folder
+ (or msgdb (elmo-msgdb-load folder)))))
(luna-call-next-method)))
;; elmo-folder-open-internal: do nothing.
(elmo-map-folder-location-hash-internal folder))))
(luna-define-method elmo-folder-pack-number ((folder elmo-map-folder))
- (let* ((msgdb (elmo-folder-msgdb-internal folder))
+ (let* ((msgdb (elmo-folder-msgdb folder))
(old-number-alist (elmo-msgdb-get-number-alist msgdb))
(old-overview (elmo-msgdb-get-overview msgdb))
(old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
pair
(elmo-map-folder-location-hash-internal
folder)))
- (setq location-alist (nconc location-alist new-alist))
+ (setq location-alist
+ (sort (nconc location-alist new-alist)
+ (lambda (x y) (< (car x) (car y)))))
(elmo-map-folder-set-location-alist-internal folder location-alist)))
(luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
(let (mime-display-header-hook ; Do nothing.
entity strategy)
(setq entity (elmo-msgdb-overview-get-entity number
- (elmo-folder-msgdb-internal
+ (elmo-folder-msgdb
folder)))
(setq strategy (elmo-find-fetch-strategy folder entity
ignore-cache))
keep it as unread.
Return non-nil if cache is used."
(let ((entity (elmo-msgdb-overview-get-entity number
- (elmo-folder-msgdb-internal
- folder)))
+ (elmo-folder-msgdb folder)))
mime-display-header-hook ; Do nothing.
cache-file strategy use-cache)
(setq cache-file (elmo-file-cache-get
(elmo-msgdb-search-internal-primitive
(nth 2 condition) entity number-list)))))
-(defun elmo-msgdb-delete-msgs (folder msgs)
- "Delete MSGS from msgdb for FOLDER.
+(defun elmo-msgdb-delete-msgs (msgdb msgs)
+ "Delete MSGS from MSGDB
content of MSGDB is changed."
(save-excursion
- (let* ((msgdb (elmo-folder-msgdb-internal folder))
+ (let* (;(msgdb (elmo-folder-msgdb folder))
(overview (car msgdb))
(number-alist (cadr msgdb))
(mark-alist (caddr msgdb))
ov-entity)
;; remove from current database.
(while msgs
- ;(setq message-id (cdr (assq (car msg-list) number-alist)))
- ;(if (and (not reserve-cache) message-id)
- ; (elmo-cache-delete message-id))
-;;; This is no good!!!!
-;;; (setq overview (delete (assoc message-id overview) overview))
(setq overview
(delq
(setq ov-entity
(delq (assq (car msgs) number-alist) number-alist))
(setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
(setq msgs (cdr msgs)))
- (elmo-folder-set-message-modified-internal folder t)
+ ;(elmo-folder-set-message-modified-internal folder t)
(setcar msgdb overview)
(setcar (cdr msgdb) number-alist)
(setcar (cddr msgdb) mark-alist)
elmo-msgdb-location-filename
dir) alist))
+(defun elmo-dop-queue-load ()
+ (setq elmo-dop-queue
+ (elmo-object-load
+ (expand-file-name elmo-queue-filename
+ elmo-msgdb-dir))))
+
+(defun elmo-dop-queue-save ()
+ (elmo-object-save
+ (expand-file-name elmo-queue-filename
+ elmo-msgdb-dir)
+ elmo-dop-queue))
+
(require 'product)
(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
(let ((number-alists (elmo-multi-split-number-alist
folder
(elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(cur-number 1))
(dolist (child (elmo-multi-folder-children-internal folder))
(elmo-folder-process-crosspost child (car number-alists))
(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))
+ (elmo-folder-msgdb folder))
number-alist)))
(cur number-alist)
to-be-deleted
(elmo-msgdb-set-mark-alist append-msgdb mark-alist)
(elmo-folder-set-msgdb-internal folder
(elmo-msgdb-append
- (elmo-folder-msgdb-internal folder)
+ (elmo-folder-msgdb folder)
append-msgdb t))
(length to-be-deleted))
0))
(mark-alists (elmo-multi-split-mark-alist
folder
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(cur-number 0)
unreads
all-unreads)
(mark-alists (elmo-multi-split-mark-alist
folder
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(cur-number 0)
importants
all-importants)
(luna-define-method elmo-folder-status-unplugged
((folder elmo-net-folder))
(if elmo-enable-disconnected-operation
- (progn
- (elmo-dop-folder-status folder))
+ () ; XXX FIXME. (elmo-folder-status-dop folder)
(error "Unplugged")))
(luna-define-method elmo-folder-list-messages-internal
(current-buffer) unseen)
(elmo-delete-cr-buffer)
(when (and (> (buffer-size) 0)
- (elmo-fetch-strategy-save-cache strategy))
+ (elmo-fetch-strategy-save-cache strategy)
+ (elmo-fetch-strategy-cache-path strategy))
(elmo-file-cache-save
(elmo-fetch-strategy-cache-path strategy)
section))
(if (elmo-nntp-max-number-precedes-list-active-p)
(let ((session (elmo-nntp-get-session folder))
(number-alist (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(if (elmo-nntp-list-active-p session)
(let (msgdb-max max-number)
;; If there are canceled messages, overviews are not obtained
(and msgdb-max max-number
(< msgdb-max max-number)))
(elmo-msgdb-set-number-alist
- (elmo-folder-msgdb-internal folder)
+ (elmo-folder-msgdb folder)
(nconc number-alist
(list (cons max-number nil))))))))))
(setq reads (cons (car entity) reads)))
(when (setq entity (elmo-msgdb-overview-get-entity
(nth 0 cross)
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
reads))))
(when entity
;; 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-folder-msgdb folder)))))
(elmo-living-messages (delq nil
(mapcar
(lambda (x)
--- /dev/null
+;;; elmo-shimbun.el -- Shimbun interface for ELMO.
+
+;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(require 'elmo)
+(require 'elmo-map)
+(require 'shimbun)
+
+(eval-and-compile
+ (luna-define-class elmo-shimbun-folder
+ (elmo-map-folder) (shimbun group))
+ (luna-define-internal-accessors 'elmo-shimbun-folder))
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-shimbun-folder)
+ name)
+ (let ((server-group (split-string name "\\.")))
+ (if (nth 0 server-group) ; server
+ (elmo-shimbun-folder-set-shimbun-internal
+ folder
+ (shimbun-open (nth 0 server-group))))
+ (if (nth 1 server-group)
+ (elmo-shimbun-folder-set-group-internal
+ folder
+ (nth 1 server-group)))
+ folder))
+
+(luna-define-method elmo-folder-open-internal :before ((folder
+ elmo-shimbun-folder))
+ (shimbun-open-group
+ (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-shimbun-folder-group-internal folder)))
+
+(luna-define-method elmo-folder-close-internal :after ((folder
+ elmo-shimbun-folder))
+ (shimbun-close-group
+ (elmo-shimbun-folder-shimbun-internal folder)))
+
+(luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
+ (shimbun-close-group
+ (elmo-shimbun-folder-shimbun-internal folder))
+ (shimbun-open-group
+ (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-shimbun-folder-group-internal folder)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-shimbun-folder))
+ (expand-file-name
+ (concat (shimbun-server-internal
+ (elmo-shimbun-folder-shimbun-internal folder))
+ "/"
+ (elmo-shimbun-folder-group-internal folder))
+ (expand-file-name "shimbun" elmo-msgdb-dir)))
+
+(defun elmo-shimbun-msgdb-create-entity (folder number)
+ (with-temp-buffer
+ (shimbun-header-insert
+ (shimbun-header
+ (elmo-shimbun-folder-shimbun-internal folder)
+ (elmo-map-message-location folder number)))
+ (elmo-msgdb-create-overview-from-buffer number)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
+ numlist new-mark
+ already-mark seen-mark
+ important-mark
+ seen-list)
+ (let* (overview number-alist mark-alist entity
+ i percent num pair)
+ (setq num (length numlist))
+ (setq i 0)
+ (message "Creating msgdb...")
+ (while numlist
+ (setq entity
+ (elmo-shimbun-msgdb-create-entity
+ folder (car numlist)))
+ (when entity
+ (setq overview
+ (elmo-msgdb-append-element
+ overview entity))
+ (setq number-alist
+ (elmo-msgdb-number-add number-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (elmo-msgdb-overview-entity-get-id
+ entity)))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ (or (elmo-msgdb-global-mark-get
+ (elmo-msgdb-overview-entity-get-id
+ entity))
+ new-mark))))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-folder-msgdb-create "Creating msgdb..."
+ percent))
+ (setq numlist (cdr numlist)))
+ (message "Creating msgdb...done.")
+ (elmo-msgdb-sort-by-date
+ (list overview number-alist mark-alist))))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
+ nil)
+
+(luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
+ location strategy &optional
+ section outbuf unseen)
+ (if outbuf
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
+ location)
+ t)
+ (with-temp-buffer
+ (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
+ location)
+ (buffer-string))))
+
+(luna-define-method elmo-map-folder-list-message-locations
+ ((folder elmo-shimbun-folder))
+ (mapcar
+ (function shimbun-header-id)
+ (shimbun-headers (elmo-shimbun-folder-shimbun-internal folder))))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
+ &optional one-level)
+ (unless (elmo-shimbun-folder-group-internal folder)
+ (mapcar
+ (lambda (x)
+ (concat (elmo-folder-prefix-internal folder)
+ (shimbun-server-internal
+ (elmo-shimbun-folder-shimbun-internal folder))
+ "."
+ x))
+ (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal folder)))))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
+ (if (elmo-shimbun-folder-group-internal folder)
+ (progn
+ (member
+ (elmo-shimbun-folder-group-internal folder)
+ (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal
+ folder))))
+ t))
+
+(luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
+ condition &optional from-msgs)
+ nil)
+
+;;; To override elmo-map-folder methods.
+(luna-define-method elmo-folder-list-unreads-internal
+ ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
+ t)
+
+(luna-define-method elmo-folder-list-importants-internal
+ ((folder elmo-shimbun-folder) important-mark)
+ t)
+
+(luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
+ numbers)
+ t)
+
+(luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
+ numbers)
+ t)
+
+(require 'product)
+(product-provide (provide 'elmo-shimbun) (require 'elmo-version))
+
+;;; elmo-shimbun.el ends here
\ No newline at end of file
(defvar elmo-inhibit-number-mapping nil
"Global switch to inhibit number mapping (e.g. Inhibit UIDL on POP3).")
+(defvar elmo-dop-queue nil
+ "Global variable for storing disconnected operation queues.")
+
(require 'product)
(product-provide (provide 'elmo-vars) (require 'elmo-version))
(save-match-data
(elmo-folder-send folder 'elmo-folder-initialize name))))
-(luna-define-generic elmo-folder-open (folder)
- "Open and setup (load saved status) FOLDER.")
+(defmacro elmo-folder-msgdb (folder)
+ "Return the msgdb of FOLDER (on-demand loading)."
+ (` (or (elmo-folder-msgdb-internal (, folder))
+ (elmo-folder-set-msgdb-internal (, folder)
+ (elmo-msgdb-load (, folder))))))
+
+(luna-define-generic elmo-folder-open (folder &optional load-msgdb)
+ "Open and setup (load saved status) FOLDER.
+If optional LOAD-MSGDB is non-nil, msgdb is loaded.
+(otherwise, msgdb is loaded on-demand)")
(luna-define-generic elmo-folder-open-internal (folder)
"Open FOLDER (without loading saved folder status).")
((folder elmo-folder) important-mark)
t)
+(defun elmo-folder-encache (folder numbers)
+ "Encache messages in the FOLDER with NUMBERS."
+ (dolist (number numbers)
+ (elmo-message-encache folder number)))
+
(defun elmo-message-encache (folder number)
+ "Encache message in the FOLDER with NUMBER."
(elmo-message-fetch
folder number
(elmo-make-fetch-strategy 'entire
(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-open ((folder elmo-folder))
- (elmo-generic-folder-open folder))
+(luna-define-method elmo-folder-open ((folder elmo-folder)
+ &optional load-msgdb)
+ (elmo-generic-folder-open folder load-msgdb))
-(defun elmo-generic-folder-open (folder)
- (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder))
+(defun elmo-generic-folder-open (folder load-msgdb)
+ (if load-msgdb
+ (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder)))
(elmo-folder-set-killed-list-internal
folder
(elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
(when (elmo-folder-message-modified-internal folder)
(elmo-msgdb-overview-save
(elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-overview (elmo-folder-msgdb-internal folder)))
+ (elmo-msgdb-get-overview (elmo-folder-msgdb folder)))
(elmo-msgdb-number-save
(elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-number-alist (elmo-folder-msgdb-internal folder)))
+ (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
(elmo-folder-set-info-max-by-numdb
folder
(elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(elmo-folder-set-message-modified-internal folder nil)
(elmo-msgdb-killed-list-save
(elmo-folder-msgdb-path folder)
(when (elmo-folder-mark-modified-internal folder)
(elmo-msgdb-mark-save
(elmo-folder-msgdb-path folder)
- (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder)))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
(elmo-folder-set-mark-modified-internal folder nil))))
(luna-define-method elmo-folder-close-internal ((folder elmo-folder))
(defsubst elmo-strict-folder-diff (folder)
"Return folder diff information strictly from FOLDER."
(let* ((dir (elmo-folder-msgdb-path folder))
- (nalist (or (elmo-folder-msgdb-internal folder)
- (elmo-msgdb-number-load dir)))
+ (nalist (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))
(in-db (sort (mapcar 'car nalist) '<))
(in-folder (elmo-folder-list-messages folder))
append-list delete-list diff)
(seen-list (elmo-msgdb-seen-load dir)))
(setq seen-list
(elmo-msgdb-add-msgs-to-seen-list
- msgs (elmo-folder-msgdb-internal src-folder)
+ msgs (elmo-folder-msgdb src-folder)
unread-marks seen-list))
(elmo-msgdb-seen-save dir seen-list))))
(when (and done
(if (not no-delete-info)
(message "Cleaning up src folder..."))
(if (and (elmo-folder-delete-messages src-folder succeeds)
- (elmo-msgdb-delete-msgs src-folder succeeds))
+ (elmo-msgdb-delete-msgs
+ (elmo-folder-msgdb src-folder) succeeds))
(setq result t)
(message "move: delete messages from %s failed."
(elmo-folder-name-internal src-folder))
folder
(elmo-folder-expand-msgdb-path folder))))
-(defun elmo-folder-msgdb (folder)
- "Return the msgdb of FOLDER (on-demand loading)."
- (or (elmo-folder-msgdb-internal folder)
- (elmo-msgdb-load folder)))
-
(defun elmo-message-mark (folder number)
"Get mark of the message.
FOLDER is the ELMO folder structure.
(defun elmo-message-set-mark (folder number mark)
"Set mark for the message in the FOLDER with NUMBER as MARK."
(elmo-msgdb-set-mark-alist
- (elmo-folder-msgdb-internal folder)
+ (elmo-folder-msgdb folder)
(elmo-msgdb-mark-set
- (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder))
+ (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))
number mark)))
(luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
(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))
+ (elmo-folder-msgdb folder))
number-alist)))
(cur number-alist)
pair
(elmo-msgdb-set-mark-alist append-msgdb mark-alist)
(elmo-folder-set-msgdb-internal folder
(elmo-msgdb-append
- (elmo-folder-msgdb-internal folder)
+ (elmo-folder-msgdb folder)
append-msgdb t))
(length to-be-deleted))
0))
number-alist mark-alist
old-msgdb diff diff-2 delete-list new-list new-msgdb mark
seen-list crossed after-append)
- (setq old-msgdb (elmo-folder-msgdb-internal folder))
+ (setq old-msgdb (elmo-folder-msgdb folder))
;; Load seen-list.
(setq seen-list (elmo-msgdb-seen-load (elmo-folder-msgdb-path folder)))
(setq number-alist (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(setq mark-alist (elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(if ignore-msgdb
(progn
(setq seen-list (nconc
(elmo-folder-process-crosspost folder)
nil ; no update.
)
- (if delete-list (elmo-msgdb-delete-msgs folder delete-list))
+ (if delete-list (elmo-msgdb-delete-msgs
+ (elmo-folder-msgdb folder) delete-list))
(when new-list
(setq new-msgdb (elmo-folder-msgdb-create
folder
new-mark unread-cached-mark
read-uncached-mark important-mark
seen-list))
- (elmo-msgdb-change-mark (elmo-folder-msgdb-internal folder)
+ (elmo-msgdb-change-mark (elmo-folder-msgdb folder)
new-mark unread-uncached-mark)
;; Clear seen-list.
(if (elmo-folder-persistent-p folder)
"Return number of messages in the FOLDER."
(length
(elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
;;;
(defun elmo-msgdb-search (folder condition msgdb)
(defun elmo-init ()
"Initialize ELMO module."
(elmo-crosspost-message-alist-load)
- (elmo-resque-obsolete-variables))
+ (elmo-resque-obsolete-variables)
+ (elmo-dop-queue-load))
(defun elmo-quit ()
"Quit and cleanup ELMO."
(elmo-define-folder ?. 'maildir)
(elmo-define-folder ?' 'internal)
(elmo-define-folder ?[ 'nmz)
+(elmo-define-folder ?@ 'shimbun)
(require 'product)
(product-provide (provide 'elmo) (require 'elmo-version))
--- /dev/null
+;;; sb-airs.el --- shimbun backend for lists.airs.net
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original was nnshimbun-airs.el on http://homepage2.nifty.com/strlcat/
+
+;;; Code:
+
+(require 'shimbun)
+
+(luna-define-class shimbun-airs (shimbun-mhonarc) ())
+
+(defconst shimbun-airs-group-path-alist
+ '(("semi-gnus-ja" . "semi-gnus/archive")
+ ("wl" . "wl/archive")))
+
+(defvar shimbun-airs-url "http://lists.airs.net/")
+(defvar shimbun-airs-groups (mapcar 'car shimbun-airs-group-path-alist))
+(defvar shimbun-airs-coding-system (static-if (boundp 'MULE)
+ '*euc-japan* 'euc-jp))
+
+(defmacro shimbun-airs-concat-url (shimbun url)
+ (` (concat (shimbun-url-internal (, shimbun))
+ (cdr (assoc (shimbun-current-group-internal (, shimbun))
+ shimbun-airs-group-path-alist))
+ "/"
+ (, url))))
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-airs))
+ (shimbun-airs-concat-url shimbun "index.html"))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-airs))
+ (let ((case-fold-search t) headers months)
+ (goto-char (point-min))
+ ;; Only first month...
+ (if (re-search-forward "<A HREF=\"\\([0-9]+\\)/\">" nil t)
+ (push (match-string 1) months))
+ (setq months (nreverse months))
+ (dolist (month months)
+ (erase-buffer)
+ (shimbun-retrieve-url
+ shimbun
+ (shimbun-airs-concat-url shimbun (concat month "/index.html"))
+ t)
+ (let (id url subject)
+ (goto-char (point-max))
+ (while (re-search-backward
+ "<A[^>]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)</A>"
+ nil t)
+ (setq url (shimbun-airs-concat-url
+ shimbun
+ (concat month "/" (match-string 1)))
+ id (format "<%s%05d%%%s>"
+ month
+ (string-to-number (match-string 2))
+ (shimbun-current-group-internal shimbun))
+ subject (match-string 3))
+ (save-excursion
+ (goto-char (match-end 0))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (if (looking-at "</STRONG> *<EM>\\([^<]+\\)<")
+ (shimbun-mime-encode-string (match-string 1))
+ "")
+ "" id "" 0 0 url)
+ headers)))))
+ headers))
+
+(provide 'sb-airs)
--- /dev/null
+;;; sb-asahi.el --- shimbun backend for asahi.com
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-text)
+(luna-define-class shimbun-asahi (shimbun shimbun-text) ())
+
+(defvar shimbun-asahi-url "http://spin.asahi.com/")
+(defvar shimbun-asahi-groups '("national" "business" "politics"
+ "international" "sports" "personal"
+ "feneral"))
+(defvar shimbun-asahi-coding-system (static-if (boundp 'MULE) '*sjis*
+ 'shift_jis))
+(defvar shimbun-asahi-from-address "webmaster@www.asahi.com")
+
+(defvar shimbun-asahi-content-start "\n<!-- Start of kiji -->\n")
+(defvar shimbun-asahi-content-end "\n<!-- End of kiji -->\n")
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-asahi))
+ (format "%sp%s.html"
+ (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun)))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-asahi))
+ (when (search-forward "\n<!-- Start of past -->\n" nil t)
+ (delete-region (point-min) (point))
+ (when (search-forward "\n<!-- End of past -->\n" nil t)
+ (forward-line -1)
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (let (headers)
+ (while (re-search-forward
+ "^
\e$B"#
\e(B<a href=\"\\(\\([0-9][0-9][0-9][0-9]\\)/past/\\([A-z]*[0-9]*\\)\\.html\\)\"> *"
+ nil t)
+ (let ((id (format "<%s%s%%%s>"
+ (match-string 2)
+ (match-string 3)
+ (shimbun-current-group-internal shimbun)))
+ (url (match-string 1)))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string
+ (mapconcat 'identity
+ (split-string
+ (buffer-substring
+ (match-end 0)
+ (progn (search-forward "<br>" nil t) (point)))
+ "\\(<[^>]+>\\|\r\\)")
+ ""))
+ (shimbun-from-address-internal shimbun)
+ "" id "" 0 0 (concat (shimbun-url-internal shimbun) url))
+ headers)))
+ (setq headers (nreverse headers))
+ (let ((i 0))
+ (while (and (nth i headers)
+ (re-search-forward
+ "^\\[\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\]"
+ nil t))
+ (let ((month (string-to-number (match-string 1)))
+ (date (decode-time (current-time))))
+ (shimbun-header-set-date
+ (nth i headers)
+ (shimbun-make-date-string
+ (if (and (eq 12 month) (eq 1 (nth 4 date)))
+ (1- (nth 5 date))
+ (nth 5 date))
+ month
+ (string-to-number (match-string 2))
+ (match-string 3))))
+ (setq i (1+ i))))
+ (nreverse headers)))))
+
+(provide 'sb-asahi)
+
+;;; sb-asahi.el ends here
--- /dev/null
+;;; sb-bbdb-ml.el --- shimbun backend for bbdb-ml
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-fml)
+
+(luna-define-class shimbun-bbdb-ml (shimbun-fml) ())
+
+(defvar shimbun-bbdb-ml-url "http://www.rc.tutrp.tut.ac.jp/bbdb-ml/")
+(defvar shimbun-bbdb-ml-groups '("bbdb-ml"))
+(defvar shimbun-bbdb-ml-coding-system (static-if (boundp 'MULE)
+ '*iso-2022-jp* 'iso-2022-jp))
+
+(provide 'sb-bbdb-ml)
+
+;;; sb-bbdb-ml.el ends here
--- /dev/null
+;;; sb-cnet.el --- shimbun backend for cnet
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+
+(luna-define-class shimbun-cnet (shimbun) ())
+
+(defvar shimbun-cnet-url "http://cnet.sphere.ne.jp/")
+(defvar shimbun-cnet-groups '("comp"))
+(defvar shimbun-cnet-coding-system (static-if (boundp 'MULE)
+ '*sjis* 'shift_jis))
+(defvar shimbun-cnet-from-address "cnet@sphere.ad.jp")
+(defvar shimbun-cnet-content-start "\n<!--KIJI-->\n")
+(defvar shimbun-cnet-content-end "\n<!--/KIJI-->\n")
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-cnet))
+ (format "%s/News/Oneweek/" (shimbun-url-internal shimbun)))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-cnet))
+ (let ((case-fold-search t) headers)
+ (while (search-forward "\n<!--*****\e$B8+=P$7\e(B*****-->\n" nil t)
+ (let ((subject (buffer-substring (point) (point-at-eol)))
+ (point (point)))
+ (forward-line -2)
+ (when (looking-at "<a href=\"/\\(News/\\([0-9][0-9][0-9][0-9]\\)/Item/\\([0-9][0-9]\\([0-9][0-9]\\)\\([0-9][0-9]\\)-[0-9]+\\).html\\)\">")
+ (let ((url (match-string 1))
+ (id (format "<%s%s%%%s>"
+ (match-string 2)
+ (match-string 3)
+ (shimbun-current-group-internal shimbun)))
+ (date (shimbun-make-date-string
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 4))
+ (string-to-number (match-string 5)))))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (shimbun-from-address-internal shimbun)
+ date id "" 0 0 (concat (shimbun-url-internal shimbun) url))
+ headers)))
+ (goto-char point)))
+ headers))
+
+(provide 'sb-cnet)
+
+;;; sb-cnet.el ends here
--- /dev/null
+;;; sb-fml.el --- shimbun backend class for fml archiver.
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+
+(luna-define-class shimbun-fml (shimbun) ())
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-fml))
+ (let ((case-fold-search t)
+ headers auxs aux)
+ (catch 'stop
+ ;; Only latest month.
+ (if (re-search-forward "<a href=\"\\([0-9]+\\(\\.week\\|\\.month\\)?\\)/index.html\">" nil t)
+ (setq auxs (append auxs (list (match-string 1)))))
+ (while auxs
+ (with-temp-buffer
+ (shimbun-retrieve-url
+ shimbun
+ (concat (shimbun-url-internal shimbun) (setq aux (car auxs)) "/"))
+ (subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (let ((case-fold-search t)
+ id url date subject from)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<LI><A HREF=\"\\([0-9]+\\.html\\)\">Article .*</A> <DIV><SPAN CLASS=article>Article <SPAN CLASS=article-value>\\([0-9]+\\)</SPAN></SPAN> at <SPAN CLASS=Date-value>\\([^<]*\\)</SPAN> <SPAN CLASS=Subject>Subject: <SPAN CLASS=Subject-value>\\([^<]*\\)</SPAN></SPAN></DIV><DIV><SPAN CLASS=From>From: <SPAN CLASS=From-value>\\([^<]*\\)</SPAN></SPAN></DIV>"
+ nil t)
+ (setq url (concat (shimbun-url-internal shimbun)
+ aux "/" (match-string 1))
+ id (format "<%s%05d%%%s>"
+ aux
+ (string-to-number (match-string 2))
+ (shimbun-current-group-internal shimbun))
+ date (match-string 3)
+ subject (match-string 4)
+ from (match-string 5))
+ (forward-line 1)
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ from date id "" 0 0 url)
+ headers)))
+ (setq auxs (cdr auxs))))
+ headers)))
+
+(luna-define-method shimbun-make-contents ((shimbun shimbun-fml) header)
+ (catch 'stop
+ (if (search-forward "<SPAN CLASS=mailheaders>" nil t)
+ (delete-region (point-min) (point))
+ (throw 'stop nil))
+ (if (search-forward "</PRE>")
+ (progn
+ (beginning-of-line)
+ (delete-region (point) (point-max)))
+ (throw 'stop nil))
+ (if (search-backward "</SPAN>")
+ (progn
+ (beginning-of-line)
+ (kill-line))
+ (throw 'stop nil))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (shimbun-decode-entities)
+ (goto-char (point-min))
+ (let ((header (shimbun-make-header))
+ field value start value-beg end)
+ (while (and (setq start (point))
+ (re-search-forward "<SPAN CLASS=\\(.*\\)>\\(.*\\)</SPAN>:"
+ nil t)
+ (setq field (match-string 2))
+ (re-search-forward
+ (concat "<SPAN CLASS=" (match-string 1) "-value>") nil t)
+ (setq value-beg (point))
+ (search-forward "</SPAN>" nil t)
+ (setq end (point)))
+ (setq value (buffer-substring value-beg
+ (progn (search-backward "</SPAN>")
+ (point))))
+ (delete-region start end)
+ (cond ((string= field "Date")
+ (shimbun-header-set-date header value))
+ ((string= field "From")
+ (shimbun-header-set-from header value))
+ ((string= field "Subject")
+ (shimbun-header-set-subject header value))
+ ((string= field "Message-Id")
+ (shimbun-header-set-id header value))
+ ((string= field "References")
+ (shimbun-header-set-references header value))
+ (t
+ (insert (concat field ": " value "\n")))))
+ (goto-char (point-min))
+ (shimbun-header-insert header))
+ (goto-char (point-max)))
+ ;; Processing body.
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (shimbun-remove-markup)
+ (shimbun-decode-entities)))
+ (encode-coding-string (buffer-string)
+ (mime-charset-to-coding-system "ISO-2022-JP")))
+
+(provide 'sb-fml)
+
+;;; sb-fml.el ends here
--- /dev/null
+;;; sb-lump.el --- shimbun backend class to check all groups at once
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(defvar shimbun-lump-check-interval 300)
+
+(eval-and-compile
+ (luna-define-class shimbun-lump (shimbun) (group-header-alist last-check))
+ (luna-define-internal-accessors 'shimbun-lump))
+
+(defun shimbun-lump-lapse-seconds (time)
+ (let ((now (current-time)))
+ (+ (* (- (car now) (car time)) 65536)
+ (- (nth 1 now) (nth 1 time)))))
+
+(defun shimbun-lump-check-p (shimbun)
+ (or (null (shimbun-lump-last-check-internal shimbun))
+ (and (shimbun-lump-last-check-internal shimbun)
+ (< (shimbun-lump-lapse-seconds
+ (shimbun-lump-last-check-internal shimbun))
+ shimbun-lump-check-interval))))
+
+(defun shimbun-lump-checked (shimbun)
+ (shimbun-lump-set-last-check-internal shimbun (current-time)))
+
+(luna-define-generic shimbun-get-group-header-alist (shimbun)
+ "Return an alist of group and header list.")
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-lump))
+ (when (shimbun-lump-check-p shimbun)
+ (shimbun-lump-set-group-header-alist-internal
+ shimbun (shimbun-get-group-header-alist shimbun))
+ (shimbun-lump-checked shimbun))
+ (cdr (assoc (shimbun-current-group-internal shimbun)
+ (shimbun-lump-group-header-alist-internal shimbun))))
+
+(luna-define-method shimbun-close :after ((shimbun shimbun-lump))
+ (shimbun-lump-set-group-header-alist-internal shimbun nil)
+ (shimbun-lump-set-last-check-internal shimbun nil))
+
+(provide 'sb-lump)
+
+;;; sb-lump.el ends here
--- /dev/null
+;;; sb-mew.el --- shimbun backend for mew.org
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-mhonarc)
+(luna-define-class shimbun-mew (shimbun-mhonarc) ())
+
+(defconst shimbun-mew-groups
+ '(("meadow-develop" "meadow-develop" nil t)
+ ("meadow-users-jp" "meadow-users-jp")
+ ("mule-win32" "mule-win32")
+ ("mew-win32" "mew-win32")
+ ("mew-dist" "mew-dist/3300" t)
+ ("mgp-users-jp" "mgp-users-jp/A" t t)))
+
+(luna-define-method initialize-instance :after ((shimbun shimbun-mew)
+ &rest init-args)
+ (shimbun-set-url-internal shimbun "http://www.mew.org/archive/")
+ (shimbun-set-groups-internal shimbun
+ (mapcar 'car shimbun-mew-groups))
+ (shimbun-set-coding-system-internal shimbun
+ (static-if (boundp 'MULE)
+ '*iso-2022-jp* 'iso-2022-jp))
+ shimbun)
+
+(defmacro shimbun-mew-concat-url (shimbun url)
+ (` (concat (shimbun-url-internal (, shimbun))
+ (nth 1 (assoc
+ (shimbun-current-group-internal (, shimbun))
+ shimbun-mew-groups))
+ "/"
+ (, url))))
+
+(defmacro shimbun-mew-reverse-order-p (shimbun)
+ (` (nth 2 (assoc (shimbun-current-group-internal (, shimbun))
+ shimbun-mew-groups))))
+
+(defmacro shimbun-mew-spew-p (shimbun)
+ (` (nth 3 (assoc (shimbun-current-group-internal (, shimbun))
+ shimbun-mew-groups))))
+
+(defsubst shimbun-mew-retrieve-xover (shimbun aux)
+ (erase-buffer)
+ (shimbun-retrieve-url
+ shimbun
+ (shimbun-mew-concat-url
+ shimbun
+ (if (= aux 1) "index.html" (format "mail%d.html" aux)))
+ t))
+
+(defconst shimbun-mew-regexp "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<")
+
+(defsubst shimbun-mew-extract-header-values (shimbun)
+ (let (url id subject)
+ (setq url (shimbun-mew-concat-url shimbun (match-string 1))
+ id (format "<%05d%%%s>"
+ (1- (string-to-number (match-string 2)))
+ (shimbun-current-group-internal shimbun))
+ subject (match-string 3))
+ (forward-line 1)
+ (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (if (looking-at "<EM>\\([^<]+\\)<")
+ (shimbun-mime-encode-string (match-string 1))
+ "")
+ "" id "" 0 0 url)))
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-mew))
+ (shimbun-mew-concat-url shimbun "index.html"))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-mew))
+ (shimbun-mew-get-headers shimbun))
+
+(defun shimbun-mew-get-headers (shimbun)
+ (let ((case-fold-search t)
+ headers)
+ (goto-char (point-min))
+ (when (re-search-forward
+ "<A[^>]*href=\"mail\\([0-9]+\\)\\.html\">\\[?Last Page\\]?</A>"
+ nil t)
+ (let ((limit 1));(string-to-number (match-string 1))))
+ (catch 'stop
+ (if (shimbun-mew-reverse-order-p shimbun)
+ (let ((aux 1))
+ (while (let (id url subject)
+ (while (re-search-forward shimbun-mew-regexp nil t)
+ (push (shimbun-mew-extract-header-values shimbun)
+ headers))
+ (< aux limit))
+ (shimbun-mew-retrieve-xover shimbun (setq aux (1+ aux)))))
+ (while (> limit 0)
+ (shimbun-mew-retrieve-xover shimbun limit)
+ (setq limit (1- limit))
+ (let (id url subject)
+ (goto-char (point-max))
+ (while (re-search-backward shimbun-mew-regexp nil t)
+ (push (shimbun-mew-extract-header-values shimbun)
+ headers)
+ (forward-line -2)))))
+ headers)))))
+
+(provide 'sb-mew)
+
+;;; sb-mew.el ends here
--- /dev/null
+;;; sb-mhonarc.el --- shimbun backend class for mhonarc
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(luna-define-class shimbun-mhonarc (shimbun) ())
+
+(luna-define-method shimbun-make-contents ((shimbun shimbun-mhonarc)
+ header)
+ (if (search-forward "<!--X-Head-End-->" nil t)
+ (progn
+ (forward-line 0)
+ ;; Processing headers.
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (shimbun-decode-entities)
+ (goto-char (point-min))
+ (while (search-forward "\n<!--X-" nil t)
+ (replace-match "\n"))
+ (goto-char (point-min))
+ (while (search-forward " -->\n" nil t)
+ (replace-match "\n"))
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " "))
+ (goto-char (point-min))
+ (let (buf refs)
+ (while (not (eobp))
+ (cond
+ ((looking-at "<!--")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "Subject: +")
+ (shimbun-header-set-subject header
+ (shimbun-header-field-value))
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "From: +")
+ (shimbun-header-set-from header (shimbun-header-field-value))
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "Date: +")
+ (shimbun-header-set-date header (shimbun-header-field-value))
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "Message-Id: +")
+ (shimbun-header-set-id header
+ (concat "<" (shimbun-header-field-value) ">"))
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "Reference: +")
+ (push (concat "<" (shimbun-header-field-value) ">") refs)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((looking-at "Content-Type: ")
+ (unless (search-forward "charset" (point-at-eol) t)
+ (end-of-line)
+ (insert "; charset=ISO-2022-JP"))
+ (forward-line 1))
+ (t (forward-line 1))))
+ (insert "MIME-Version: 1.0\n")
+ (if refs
+ (shimbun-header-set-references header
+ (mapconcat 'identity refs " ")))
+ (insert "\n")
+ (goto-char (point-min))
+ (shimbun-header-insert header))
+ (goto-char (point-max)))
+ ;; Processing body.
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (delete-region
+ (point)
+ (progn
+ (search-forward "\n<!--X-Body-of-Message-->\n" nil t)
+ (point)))
+ (when (search-forward "\n<!--X-Body-of-Message-End-->\n" nil t)
+ (forward-line -1)
+ (delete-region (point) (point-max)))
+ (shimbun-remove-markup)
+ (shimbun-decode-entities)))
+ (goto-char (point-min))
+ (shimbun-header-insert header)
+ (insert
+ "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n"))
+ (encode-coding-string (buffer-string)
+ (mime-charset-to-coding-system "ISO-2022-JP")))
+
+(provide 'sb-mhonarc)
+
+;;; sb-mhonarc.el ends here
--- /dev/null
+;;; sb-netbsd.el --- shimbun backend for netbsd.org
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-mhonarc)
+
+(luna-define-class shimbun-netbsd (shimbun-mhonarc) ())
+
+(defvar shimbun-netbsd-url "http://www.jp.netbsd.org/ja/JP/ml/")
+(defvar shimbun-netbsd-groups '("announce-ja" "junk-ja" "tech-misc-ja"
+ "tech-pkg-ja" "port-arm32-ja" "port-hpcmips-ja"
+ "port-mac68k-ja" "port-mips-ja"
+ "port-powerpc-ja" "hpcmips-changes-ja"
+ "members-ja" "admin-ja" "www-changes-ja"))
+(defvar shimbun-netbsd-coding-system (static-if (boundp 'MULE)
+ '*iso-2022-jp* 'iso-2022-jp))
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-netbsd))
+ (format "%s%s/index.html" (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun)))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-netbsd))
+ (let ((case-fold-search t) headers months)
+ (goto-char (point-min))
+ ;; Only latest month
+ (if (re-search-forward
+ "<A HREF=\"\\([0-9]+\\)/\\(threads.html\\)?\">" nil t)
+ (push (match-string 1) months))
+ (setq months (nreverse months))
+ (dolist (month months)
+ (erase-buffer)
+ (shimbun-retrieve-url
+ shimbun
+ (format "%s%s/%s/maillist.html"
+ (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun) month)
+ t)
+ (let (id url subject)
+ (while (re-search-forward
+ "<A[^>]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)</A>"
+ nil t)
+ (setq url (format "%s%s/%s/%s"
+ (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun)
+ month
+ (match-string 1))
+ id (format "<%s%05d%%%s>"
+ month
+ (string-to-number (match-string 2))
+ (shimbun-current-group-internal shimbun))
+ subject (match-string 3))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (if (looking-at "</STRONG> *<EM>\\([^<]+\\)<")
+ (shimbun-mime-encode-string (match-string 1))
+ "")
+ "" id "" 0 0 url)
+ headers))))
+ headers))
+
+(provide 'sb-netbsd)
+
+;;; sb-netbsd.el ends here
--- /dev/null
+;;; sb-sponichi.el --- shimbun backend for www.sponichi.co.jp
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-text)
+
+(luna-define-class shimbun-sponichi (shimbun shimbun-text) ())
+
+(defvar shimbun-sponichi-url "http://www.sponichi.co.jp/")
+(defvar shimbun-sponichi-groups '("baseball" "soccer" "usa" "others"
+ "society" "entertainment" "horseracing"))
+(defvar shimbun-sponichi-coding-system (static-if (boundp 'MULE)
+ '*sjis* 'shift_jis))
+(defvar shimbun-sponichi-from-address "webmaster@www.sponichi.co.jp")
+(defvar shimbun-sponichi-content-start "\n<span class=\"text\">\e$B!!\e(B")
+(defvar shimbun-sponichi-content-end "\n")
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-sponichi))
+ (format "%s%s/index.html"
+ (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun)))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-sponichi))
+ (when (search-forward "\e$B%K%e!<%9%$%s%G%C%/%9\e(B" nil t)
+ (delete-region (point-min) (point))
+ (when (search-forward "\e$B%"%I%?%0\e(B" nil t)
+ (forward-line 2)
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ headers)
+ (while (re-search-forward
+ "^<a href=\"/\\(\\([A-z]*\\)/kiji/\\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)\\.html\\)\">"
+ nil t)
+ (let ((url (match-string 1))
+ (id (format "<%s%s%s%s%%%s>"
+ (match-string 3)
+ (match-string 4)
+ (match-string 5)
+ (match-string 6)
+ (shimbun-current-group-internal shimbun)))
+ (date (shimbun-make-date-string
+ (string-to-number (match-string 3))
+ (string-to-number (match-string 4))
+ (string-to-number (match-string 5)))))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string
+ (mapconcat 'identity
+ (split-string
+ (buffer-substring
+ (match-end 0)
+ (progn (search-forward "<br>" nil t) (point)))
+ "<[^>]+>")
+ ""))
+ (shimbun-from-address-internal shimbun)
+ date id "" 0 0 (concat (shimbun-url-internal shimbun)
+ url))
+ headers)))
+ headers))))
+
+(provide 'sb-sponichi)
+
+;;; sb-sponichi.el ends here
--- /dev/null
+;;; sb-text.el --- shimbun backend class for text content.
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(luna-define-class shimbun-text (shimbun) ())
+
+(luna-define-method shimbun-make-contents ((shimbun shimbun-text)
+ header)
+ (let ((case-fold-search t) (html t) (start))
+ (when (and (re-search-forward (shimbun-content-start-internal shimbun)
+ nil t)
+ (setq start (point))
+ (re-search-forward (shimbun-content-end-internal shimbun)
+ nil t))
+ (delete-region (match-beginning 0) (point-max))
+ (delete-region (point-min) start)
+ (shimbun-shallow-rendering)
+ (setq html nil))
+ (goto-char (point-min))
+ (shimbun-header-insert header)
+ (insert "Content-Type: " (if html "text/html" "text/plain")
+ "; charset=ISO-2022-JP\nMIME-Version: 1.0\n")
+ (when (shimbun-x-face-internal shimbun)
+ (insert (shimbun-x-face-internal shimbun))
+ (unless (bolp)
+ (insert "\n")))
+ (insert "\n")
+ (encode-coding-string (buffer-string)
+ (mime-charset-to-coding-system "ISO-2022-JP"))))
+
+(provide 'sb-text)
+
+;;; sb-text.el ends here
--- /dev/null
+;;; sb-wired.el --- shimbun backend for Wired Japan
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-lump)
+
+(luna-define-class shimbun-wired (shimbun-lump) ())
+
+(defvar shimbun-wired-url "http://www.hotwired.co.jp/")
+(defvar shimbun-wired-groups '("business" "culture" "technology"))
+(defvar shimbun-wired-coding-system (static-if (boundp 'MULE)
+ '*euc-japan* 'euc-jp))
+(defvar shimbun-wired-from-address "webmaster@www.hotwired.co.jp")
+(defvar shimbun-wired-content-start
+ "<FONT color=\"#ff0000\" size=\"-1\">.*</FONT>\n")
+(defvar shimbun-wired-content-end "<DIV ALIGN=\"RIGHT\">\\[")
+
+(luna-define-method shimbun-get-group-header-alist ((shimbun shimbun-wired))
+ (let ((group-header-alist (mapcar (lambda (g) (cons g nil))
+ (shimbun-groups-internal shimbun)))
+ (case-fold-search t)
+ (regexp (format
+ "<a href=\"\\(%s\\|/\\)\\(news/news/\\(%s\\)/story/\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[0-9]+\\)\\.html\\)[^>]*\">"
+ (regexp-quote (shimbun-url-internal shimbun))
+ (shimbun-regexp-opt (shimbun-groups-internal shimbun)))))
+ (dolist (xover (list (concat (shimbun-url-internal shimbun)
+ "news/news/index.html")
+ (concat (shimbun-url-internal shimbun)
+ "news/news/last_seven.html")))
+ (erase-buffer)
+ (shimbun-retrieve-url shimbun xover t)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let* ((url (concat (shimbun-url-internal shimbun)
+ (match-string 2)))
+ (group (downcase (match-string 3)))
+ (id (format "<%s%%%s>" (match-string 4) group))
+ (date (shimbun-make-date-string
+ (string-to-number (match-string 5))
+ (string-to-number (match-string 6))
+ (string-to-number (match-string 7))))
+ (header (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string
+ (mapconcat 'identity
+ (split-string
+ (buffer-substring
+ (match-end 0)
+ (progn (search-forward "</b>" nil t) (point)))
+ "<[^>]+>")
+ ""))
+ (shimbun-from-address-internal shimbun)
+ date id "" 0 0 url))
+ (x (assoc group group-header-alist)))
+ (setcdr x (cons header (cdr x))))))
+ group-header-alist))
+
+(provide 'sb-wired)
+
+;;; sb-wired.el ends here
--- /dev/null
+;;; sb-xemacs.el --- shimbun backend for xemacs.org
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-mhonarc)
+
+(luna-define-class shimbun-xemacs (shimbun-mhonarc) ())
+
+(defvar shimbun-xemacs-url "http://list-archives.xemacs.org/")
+(defvar shimbun-xemacs-groups '("xemacs-announce"
+ "xemacs-beta-ja" "xemacs-beta"
+ "xemacs-build-reports" "xemacs-cvs"
+ "xemacs-mule" "xemacs-nt" "xemacs-patches"
+ "xemacs-users-ja" "xemacs"))
+(defvar shimbun-xemacs-coding-system (static-if (boundp 'MULE)
+ '*euc-japan* 'euc-jp))
+
+(defmacro shimbun-xemacs-concat-url (shimbun url)
+ (` (concat (shimbun-url-internal shimbun)
+ (shimbun-current-group-internal shimbun) "/" (, url))))
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-xemacs))
+ (shimbun-xemacs-concat-url shimbun nil))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-xemacs))
+ (let ((case-fold-search t)
+ headers auxs aux)
+ (catch 'stop
+ ;; Only latest month.
+ (if (re-search-forward
+ (concat "<A HREF=\"/" (shimbun-current-group-internal shimbun)
+ "/\\([12][0-9][0-9][0-9][0-1][0-9]\\)/\">\\[Index\\]")
+ nil t)
+ (setq auxs (append auxs (list (match-string 1)))))
+ (while auxs
+ (erase-buffer)
+ (shimbun-retrieve-url
+ shimbun
+ (shimbun-xemacs-concat-url shimbun
+ (concat (setq aux (car auxs)) "/")))
+ (let ((case-fold-search t)
+ id url subject)
+ (goto-char (point-max))
+ (while (re-search-backward
+ "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<"
+ nil t)
+ (setq url (shimbun-xemacs-concat-url
+ shimbun
+ (concat aux "/" (match-string 1)))
+ id (format "<%s%05d%%%s>"
+ aux
+ (string-to-number (match-string 2))
+ (shimbun-current-group-internal shimbun))
+ subject (match-string 3))
+ (forward-line 1)
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (if (looking-at "<td><em>\\([^<]+\\)<")
+ (match-string 1)
+ "")
+ "" id "" 0 0 url)
+ headers)
+ ;; (message "%s" id)
+ (forward-line -2)))
+ (setq auxs (cdr auxs))))
+ headers))
+
+(provide 'sb-xemacs)
+
+;;; sb-xemacs.el ends here
--- /dev/null
+;;; sb-yomiuri.el --- shimbun backend for www.yomiuri.co.jp
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(require 'sb-text)
+
+(luna-define-class shimbun-yomiuri (shimbun shimbun-text) ())
+
+(defvar shimbun-yomiuri-url "http://www.yomiuri.co.jp/")
+(defvar shimbun-yomiuri-groups '("shakai" "sports" "seiji" "keizai"
+ "kokusai" "fuho"))
+(defvar shimbun-yomiuri-coding-system (static-if (boundp 'MULE)
+ '*sjis* 'shift_jis))
+(defvar shimbun-yomiuri-from-address "webmaster@www.yomiuri.co.jp")
+(defvar shimbun-yomiuri-content-start "\n<!-- honbun start -->\n")
+(defvar shimbun-yomiuri-content-end "\n<!-- honbun end -->\n")
+
+(defvar shimbun-yomiuri-group-path-alist
+ '(("shakai" . "04")
+ ("sports" . "06")
+ ("seiji" . "01")
+ ("keizai" . "02")
+ ("kokusai" . "05")
+ ("fuho" . "zz")))
+
+(luna-define-method shimbun-index-url ((shimbun shimbun-yomiuri))
+ (concat (shimbun-url-internal shimbun)
+ (cdr (assoc (shimbun-current-group-internal shimbun)
+ shimbun-yomiuri-group-path-alist))
+ "/index.htm"))
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-yomiuri))
+ (let ((case-fold-search t)
+ start headers)
+ (goto-char (point-min))
+ (when (and (search-forward
+ (format "\n<!-- /news/list start -->\n"
+ (shimbun-current-group-internal shimbun)) nil t)
+ (setq start (point))
+ (search-forward
+ (format "\n<!-- /news/list end -->\n"
+ (shimbun-current-group-internal shimbun)) nil t))
+ (forward-line -1)
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char start)
+ (while (re-search-forward
+ "<a href=\"/\\([0-9]+\\)/\\(\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[A-z0-9]+\\)\\.htm\\)\"[^>]*>"
+ nil t)
+ (let ((url (concat (match-string 1) "/"
+ (match-string 2)))
+ (id (format "<%s%s%%%s>"
+ (match-string 1)
+ (match-string 3)
+ (shimbun-current-group-internal shimbun)))
+ (year (string-to-number (match-string 4)))
+ (month (string-to-number (match-string 5)))
+ (day (string-to-number (match-string 6)))
+ (subject (mapconcat
+ 'identity
+ (split-string
+ (buffer-substring
+ (match-end 0)
+ (progn (search-forward "<br>" nil t) (point)))
+ "<[^>]+>")
+ ""))
+ date)
+ (when (string-match "^\e$B"!\e(B" subject)
+ (setq subject (substring subject (match-end 0))))
+ (if (string-match "(\\([0-9][0-9]:[0-9][0-9]\\))$" subject)
+ (setq date (shimbun-make-date-string
+ year month day (match-string 1 subject))
+ subject (substring subject 0 (match-beginning 0)))
+ (setq date (shimbun-make-date-string year month day)))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string subject)
+ (shimbun-from-address-internal shimbun)
+ date id "" 0 0 (concat
+ (shimbun-url-internal shimbun)
+ url))
+ headers)))))
+ headers))
+
+(provide 'sb-yomiuri)
+
+;;; sb-yomiuri.el ends here
--- /dev/null
+;;; sb-zdnet.el --- shimbun backend for Zdnet Japan
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;;; Code:
+
+(require 'shimbun)
+(luna-define-class shimbun-zdnet (shimbun) ())
+
+(defvar shimbun-zdnet-url "http://www.zdnet.co.jp/news/")
+(defvar shimbun-zdnet-groups '("comp"))
+(defvar shimbun-zdnet-coding-system (static-if (boundp 'MULE)
+ '*sjis* 'shift_jis))
+(defvar shimbun-zdnet-from-address "zdnn@softbank.co.jp")
+(defvar shimbun-zdnet-content-start "\\(<!--BODY-->\\|<!--DATE-->\\)")
+(defvar shimbun-zdnet-content-end "\\(<!--BODYEND-->\\|<!--BYLINEEND-->\\)")
+
+(luna-define-method shimbun-get-headers ((shimbun shimbun-zdnet))
+ (let ((case-fold-search t) headers)
+ (goto-char (point-min))
+ (let (start)
+ (while (and (search-forward "<!--" nil t)
+ (setq start (- (point) 4))
+ (search-forward "-->" nil t))
+ (delete-region start (point))))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<a href=\"\\(/news/\\)?\\(\\([0-9][0-9]\\)\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([^\\.]+\\).html\\)\"><font size=\"4\"><strong>"
+ nil t)
+ (let ((year (+ 2000 (string-to-number (match-string 3))))
+ (month (string-to-number (match-string 4)))
+ (day (string-to-number (match-string 5)))
+ (id (format "<%s%s%s%s%%%s>"
+ (match-string 3)
+ (match-string 4)
+ (match-string 5)
+ (match-string 6)
+ (shimbun-current-group-internal shimbun)))
+ (url (match-string 2)))
+ (push (shimbun-make-header
+ 0
+ (shimbun-mime-encode-string
+ (mapconcat 'identity
+ (split-string
+ (buffer-substring
+ (match-end 0)
+ (progn (search-forward "</a>" nil t) (point)))
+ "<[^>]+>")
+ ""))
+ (shimbun-from-address-internal shimbun)
+ (shimbun-make-date-string year month day)
+ id "" 0 0 (concat (shimbun-url-internal shimbun) url))
+ headers)))
+ (nreverse headers)))
+
+(provide 'sb-zdnet)
+
+;;; sb-zdnet.el ends here
--- /dev/null
+;;; shimbun.el --- interfacing with web newspapers -*- coding: junet; -*-
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+;; Akihiro Arisawa <ari@atesoft.advantest.co.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Keywords: news
+
+;;; Copyright:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Original code was nnshimbun.el written by
+;; TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
+
+;; Shimbun API:
+;;
+;; shimbun-open
+;; shimbun-groups
+;; shimbun-open-group
+;; shimbun-close-group
+;; shimbun-headers
+;; shimbun-header
+;; shimbun-article
+;; shimbun-close
+
+;; Shimbun Header API:
+;;
+;; shimbun-header-subject
+;; shimbun-header-set-subject
+;; shimbun-header-from
+;; shimbun-header-set-from
+;; shimbun-header-date
+;; shimbun-header-set-date
+;; shimbun-header-id
+;; shimbun-header-set-id
+;; shimbun-header-references
+;; shimbun-header-set-references
+;; shimbun-header-chars
+;; shimbun-header-set-chars
+;; shimbun-header-lines
+;; shimbun-header-set-lines
+;; shimbun-header-xref
+;; shimbun-header-set-xref
+;; shimbun-header-extra
+;; shimbun-header-set-extra
+;; shimbun-header-insert
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
+
+(require 'mcharset)
+(require 'eword-encode)
+(require 'luna)
+(require 'std11)
+
+(eval-and-compile
+ (luna-define-class shimbun ()
+ (server current-group groups headers hash x-face
+ url coding-system from-address
+ content-start content-end))
+ (luna-define-internal-accessors 'shimbun))
+
+(defvar shimbun-x-face-alist
+ '(("asahi" .
+ (("default" .
+ "X-Face: +Oh!C!EFfmR$+Zw{dwWW]1e_>S0rnNCA*CX|bIy3rr^<Q#lf&~ADU:X!t5t>
+ gW5)Q]N{MmnL]suPpL|gFjV{S|]a-:)\\FR7GRf9uL:ue5_=;h{V%@()={u
+ Td@l?eXBppF%`6W%;h`#]2q+f*81n$Bh|t")))
+ ("cnet" .
+ (("default" .
+ "X-Face: 0p7.+XId>z%:!$ahe?x%+AEm37Abvn]n*GGh+>v=;[3`a{1l
+ qO[$,~3C3xU_ri>[JwJ!9l0~Y`b*eXAQ:*q=bBI_=ro*?]4:
+ |n>]ZiLZ2LEo^2nr('C<+`lO~/!R[lH'N'4X&%\\I}8T!wt")))
+ ("wired" .
+ (("default" .
+ "X-Face: \"yhMDxMBowCFKt;5Q$s_Wx)/'L][0@c\"#n2BwH{7mg]5^w1D]\"K^R
+ ]&fZ5xtt1Ynu6V;Cv(@BcZUf9IV$($6TZ`L)$,cegh`b:Uwy`8}#D
+ b-kyCsr_UMRz=,U|>-:&`05lXB4(;h{[&~={Imb-az7&U5?|&X_8c
+ ;#'L|f.P,]|\\50pgSVw_}byL+%m{TrS[\"Ew;dbskaBL[ipk2m4V")))
+ ("zdnet" .
+ (("default" .
+ "X-Face: 88Zbg!1nj{i#[*WdSZNrn1$Cdfat,zsG`P)OLo=U05q:RM#72\\p;3XZ
+ ~j|7T)QC7\"(A;~HrfP.D}o>Z.]=f)rOBz:A^G*M3Ea5JCB$a>BL/y!")))
+ ("default" .
+ (("default" .
+ "X-Face: Ygq$6P.,%Xt$U)DS)cRY@k$VkW!7(X'X'?U{{osjjFG\"E]hND;SPJ-J?O?R|a?L
+ g2$0rVng=O3Lt}?~IId8Jj&vP^3*o=LKUyk(`t%0c!;t6REk=JbpsEn9MrN7gZ%"))))
+ "Alist of server vs. alist of group vs. X-Face field. It looks like:
+
+\((\"asahi\" . ((\"national\" . \"X-face: ***\")
+ (\"business\" . \"X-Face: ***\")
+ ;;
+ ;;
+ (\"default\" . \"X-face: ***\")))
+ (\"sponichi\" . ((\"baseball\" . \"X-face: ***\")
+ (\"soccer\" . \"X-Face: ***\")
+ ;;
+ ;;
+ (\"default\" . \"X-face: ***\")))
+ ;;
+ (\"default\" . ((\"default\" . \"X-face: ***\")))")
+
+(defconst shimbun-meta-content-type-charset-regexp
+ (eval-when-compile
+ (concat "<meta[ \t]+http-equiv=\"?Content-type\"?[ \t]+content=\"\\([^;]+\\)"
+ ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+ ">"))
+ "Regexp used in parsing `<META HTTP-EQUIV=\"Content-Type\" content=\"...;charset=...\">
+for a charset indication")
+
+(defconst shimbun-meta-charset-content-type-regexp
+ (eval-when-compile
+ (concat "<meta[ \t]+content=\"\\([^;]+\\)"
+ ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+ "[ \t]+http-equiv=\"?Content-type\"?>"))
+ "Regexp used in parsing `<META content=\"...;charset=...\" HTTP-EQUIV=\"Content-Type\">
+for a charset indication")
+
+(defvar shimbun-hash-length 997
+ "Length of header hashtable.")
+
+(static-when (boundp 'MULE)
+ (unless (coding-system-p 'euc-japan)
+ (copy-coding-system '*euc-japan* 'euc-japan))
+ (unless (coding-system-p 'shift_jis)
+ (copy-coding-system '*sjis* 'shift_jis))
+ (eval-and-compile
+ (defalias-maybe 'coding-system-category 'get-code-mnemonic)))
+
+(static-if (and (ignore-errors (require 'w3m))
+ (fboundp 'w3m-retrieve))
+(progn
+(require 'w3m)
+(defun shimbun-retrieve-url (shimbun url &optional no-cache)
+ "Rertrieve URL contents and insert to current buffer."
+ (when (w3m-retrieve url nil no-cache)
+ (insert-buffer w3m-work-buffer-name))))
+;; Otherwise.
+(require 'url)
+(defun shimbun-retrieve-url (shimbun url &optional no-cache)
+ "Rertrieve URL contents and insert to current buffer."
+ (let ((buf (current-buffer))
+ (url-working-buffer url-working-buffer))
+ (let ((old-asynch (default-value 'url-be-asynchronous))
+ (old-caching (default-value 'url-automatic-caching))
+ (old-mode (default-value 'url-standalone-mode)))
+ (setq-default url-be-asynchronous nil)
+ (when no-cache
+ (setq-default url-automatic-caching nil)
+ (setq-default url-standalone-mode nil))
+ (unwind-protect
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (input-coding-system 'binary)
+ (output-coding-system 'binary)
+ (default-enable-multibyte-characters nil))
+ (set-buffer
+ (setq url-working-buffer
+ (cdr (url-retrieve url no-cache))))
+ (url-uncompress))
+ (setq-default url-be-asynchronous old-asynch)
+ (setq-default url-automatic-caching old-caching)
+ (setq-default url-standalone-mode old-mode)))
+ (let ((charset
+ (or (and (boundp 'url-current-mime-charset)
+ (symbol-value 'url-current-mime-charset))
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (if (or (re-search-forward
+ shimbun-meta-content-type-charset-regexp nil t)
+ (re-search-forward
+ shimbun-meta-charset-content-type-regexp nil t))
+ (buffer-substring-no-properties (match-beginning 2)
+ (match-end 2)))))))
+ (decode-coding-region
+ (point-min) (point-max)
+ (if charset
+ (let ((mime-charset-coding-system-alist
+ (append '((euc-jp . euc-japan)
+ (shift-jis . shift_jis)
+ (shift_jis . shift_jis)
+ (sjis . shift_jis)
+ (x-euc-jp . euc-japan)
+ (x-shift-jis . shift_jis)
+ (x-shift_jis . shift_jis)
+ (x-sjis . shift_jis))
+ mime-charset-coding-system-alist)))
+ (mime-charset-to-coding-system charset))
+ (let ((default (condition-case nil
+ (coding-system-category
+ (shimbun-coding-system-internal shimbun))
+ (error nil)))
+ (candidate (detect-coding-region (point-min) (point-max))))
+ (unless (listp candidate)
+ (setq candidate (list candidate)))
+ (catch 'coding
+ (dolist (coding candidate)
+ (if (eq default (coding-system-category coding))
+ (throw 'coding coding)))
+ (if (eq (coding-system-category 'binary)
+ (coding-system-category (car candidate)))
+ (shimbun-coding-system-internal shimbun)
+ (car candidate)))))))
+ (set-buffer-multibyte t)
+ (set-buffer buf)
+ (insert-buffer url-working-buffer)
+ (kill-buffer url-working-buffer)))
+;; End of shimbun-retrieve-url definition
+)
+
+;;; Implementation of Header API.
+(defun shimbun-make-header (&optional number subject from date id
+ references chars lines xref
+ extra)
+ (vector number subject from date id references chars lines xref extra))
+
+;;(defsubst shimbun-header-number (header)
+;; (aref header 0))
+
+(defsubst shimbun-header-field-value ()
+ (let ((pt (point)))
+ (prog1
+ (buffer-substring (match-end 0) (std11-field-end))
+ (goto-char pt))))
+
+(defsubst shimbun-header-subject (header)
+ (aref header 1))
+
+(defsubst shimbun-header-set-subject (header subject)
+ (aset header 1 subject))
+
+(defsubst shimbun-header-from (header)
+ (aref header 2))
+
+(defsubst shimbun-header-set-from (header from)
+ (aset header 2 from))
+
+(defsubst shimbun-header-date (header)
+ (aref header 3))
+
+(defsubst shimbun-header-set-date (header date)
+ (aset header 3 date))
+
+(defsubst shimbun-header-id (header)
+ (aref header 4))
+
+(defsubst shimbun-header-set-id (header id)
+ (aset header 4 id))
+
+(defsubst shimbun-header-references (header)
+ (aref header 5))
+
+(defsubst shimbun-header-set-references (header references)
+ (aset header 5 references))
+
+(defsubst shimbun-header-chars (header)
+ (aref header 6))
+
+(defsubst shimbun-header-set-chars (header chars)
+ (aset header 6 chars))
+
+(defsubst shimbun-header-lines (header)
+ (aref header 7))
+
+(defsubst shimbun-header-set-lines (header lines)
+ (aset header 7 lines))
+
+(defsubst shimbun-header-xref (header)
+ (aref header 8))
+
+(defsubst shimbun-header-set-xref (header xref)
+ (aset header 8 xref))
+
+(defsubst shimbun-header-extra (header)
+ (aref header 9))
+
+(defsubst shimbun-header-set-extra (header extra)
+ (aset header 9 extra))
+
+(defvar shimbun-hash-length 997
+ "Length of shimbun-hash.")
+
+(defun shimbun-header-insert (header)
+ (insert "Subject: " (or (shimbun-header-subject header) "(none)") "\n"
+ "From: " (or (shimbun-header-from header) "(nobody)") "\n"
+ "Date: " (or (shimbun-header-date header) "") "\n"
+ "Message-ID: " (shimbun-header-id header) "\n")
+ (let ((refs (shimbun-header-references header)))
+ (and refs
+ (string< "" refs)
+ (insert "References: " refs "\n")))
+ (insert "Lines: " (number-to-string (or (shimbun-header-lines header) 0))
+ "\n"
+ "Xref: " (or (shimbun-header-xref header) "") "\n"))
+
+;;; Implementation of Shimbun API.
+
+(defvar shimbun-attributes
+ '(url groups coding-system from-address content-start content-end))
+
+(defun shimbun-open (server)
+ "Open a shimbun for SERVER."
+ (require (intern (concat "sb-" server)))
+ (let (url groups coding-system from-address content-start content-end)
+ (dolist (attr shimbun-attributes)
+ (set attr
+ (symbol-value (intern-soft
+ (concat "shimbun-" server "-" (symbol-name attr))))))
+ (luna-make-entity (intern (concat "shimbun-" server))
+ :server server
+ :url url
+ :groups groups
+ :coding-system coding-system
+ :from-address from-address
+ :content-start content-start
+ :content-end content-end)))
+
+(defun shimbun-groups (shimbun)
+ "Return a list of groups which are available in the SHIMBUN."
+ (shimbun-groups-internal shimbun))
+
+(defun shimbun-open-group (shimbun group)
+ "Open a SHIMBUN GROUP."
+ (unless (shimbun-current-group-internal shimbun)
+; (condition-case nil
+ (if (member group (shimbun-groups-internal shimbun))
+ (progn
+ (shimbun-set-current-group-internal shimbun group)
+ (let ((x-faces (cdr (or (assoc (shimbun-server-internal shimbun)
+ shimbun-x-face-alist)
+ (assoc "default" shimbun-x-face-alist)))))
+ (shimbun-set-x-face-internal shimbun
+ (cdr (or (assoc group x-faces)
+ (assoc "default" x-faces)))))
+ (with-temp-buffer
+ (shimbun-retrieve-url shimbun (shimbun-index-url shimbun))
+ (shimbun-set-headers-internal shimbun
+ (shimbun-get-headers shimbun)))
+ (shimbun-set-hash-internal shimbun
+ (make-vector shimbun-hash-length 0))
+ (dolist (header (shimbun-headers-internal shimbun))
+ (set (intern (shimbun-header-id header)
+ (shimbun-hash-internal shimbun))
+ header)))
+ (error "Cannot open group %s" group))))
+; (error (shimbun-set-current-group-internal shimbun nil)))))
+
+(defun shimbun-close-group (shimbun)
+ "Close opened group of SHIMBUN."
+ (when (shimbun-current-group-internal shimbun)
+ (shimbun-set-current-group-internal shimbun nil)
+ (shimbun-set-headers-internal shimbun nil)
+ (shimbun-set-hash-internal shimbun nil)))
+
+(defun shimbun-headers (shimbun)
+ "Return a SHIMBUN header list."
+ (shimbun-headers-internal shimbun))
+
+(defun shimbun-header (shimbun id)
+ "Return a SHIMBUN header which corresponds to ID."
+ (when (shimbun-current-group-internal shimbun)
+ (let ((sym (intern-soft id (shimbun-hash-internal shimbun))))
+ (if (boundp sym)
+ (symbol-value sym)))))
+
+(defun shimbun-article (shimbun id &optional outbuf)
+ "Retrieve a SHIMBUN article which corresponds to ID to the OUTBUF.
+If OUTBUF is not specified, article is retrieved to the current buffer."
+ (when (shimbun-current-group-internal shimbun)
+ (let* ((header (shimbun-header shimbun id))
+ (xref (shimbun-header-xref header)))
+ (with-current-buffer (or outbuf (current-buffer))
+ (insert
+ (or (with-temp-buffer
+ (shimbun-retrieve-url shimbun xref)
+ (message "shimbun: Make contents...")
+ (goto-char (point-min))
+ (prog1 (shimbun-make-contents shimbun header)
+ (message "shimbun: Make contents...done")))
+ ""))))))
+
+(defsubst shimbun-make-html-contents (shimbun header)
+ (let (start)
+ (when (and (re-search-forward (shimbun-content-start-internal shimbun)
+ nil t)
+ (setq start (point))
+ (re-search-forward (shimbun-content-end-internal shimbun)
+ nil t))
+ (delete-region (match-beginning 0) (point-max))
+ (delete-region (point-min) start))
+ (goto-char (point-min))
+ (shimbun-header-insert header)
+ (insert "Content-Type: text/html; charset=ISO-2022-JP\n"
+ "MIME-Version: 1.0\n")
+ (when (shimbun-x-face-internal shimbun)
+ (insert (shimbun-x-face-internal shimbun))
+ (unless (bolp)
+ (insert "\n")))
+ (insert "\n")
+ (encode-coding-string (buffer-string)
+ (mime-charset-to-coding-system "ISO-2022-JP"))))
+
+(luna-define-generic shimbun-make-contents (shimbun header)
+ "Return a content string of SHIMBUN article using current buffer content.
+HEADER is a header structure obtained via `shimbun-get-headers'.")
+
+(luna-define-method shimbun-make-contents ((shimbun shimbun) header)
+ (shimbun-make-html-contents shimbun header))
+
+(luna-define-generic shimbun-index-url (shimbun)
+ "Return a index URL of SHIMBUN.")
+
+;; Default is same as base url.
+(luna-define-method shimbun-index-url ((shimbun shimbun))
+ (shimbun-url-internal shimbun))
+
+(luna-define-generic shimbun-get-headers (shimbun)
+ "Return a shimbun header list of SHIMBUN.")
+
+(luna-define-generic shimbun-close (shimbun)
+ "Close a SHIMBUN.")
+
+(luna-define-method shimbun-close ((shimbun shimbun))
+ (shimbun-close-group shimbun))
+
+;;; Misc Functions
+(defun shimbun-mime-encode-string (string)
+ (mapconcat
+ #'identity
+ (split-string (eword-encode-string
+ (shimbun-decode-entities-string string)) "\n")
+ ""))
+
+(defun shimbun-make-date-string (year month day &optional time)
+ (format "%02d %s %04d %s +0900"
+ day
+ (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
+ month)
+ (cond ((< year 69)
+ (+ year 2000))
+ ((< year 100)
+ (+ year 1900))
+ ((< year 1000) ; possible 3-digit years.
+ (+ year 1900))
+ (t year))
+ (or time "00:00")))
+
+(if (fboundp 'regexp-opt)
+ (defalias 'shimbun-regexp-opt 'regexp-opt)
+ (defun shimbun-regexp-opt (strings &optional paren)
+ "Return a regexp to match a string in STRINGS.
+Each string should be unique in STRINGS and should not contain any regexps,
+quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
+is enclosed by at least one regexp grouping construct."
+ (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" "")))
+ (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren))))
+;; Fast fill-region function
+
+(defvar shimbun-fill-column (min 80 (- (frame-width) 4)))
+
+(defconst shimbun-kinsoku-bol-list
+ (append "!)-_~}]:;',.?\e$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7\e(B\
+\e$B!8!9!:!;!<!=!>!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n$!$#$%$'$)\e(B\
+\e$B$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v\e(B" nil))
+
+(defconst shimbun-kinsoku-eol-list
+ (append "({[`\e$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x\e(B" nil))
+
+(defun shimbun-fill-line ()
+ (forward-line 0)
+ (let ((top (point)) chr)
+ (while (if (>= (move-to-column shimbun-fill-column)
+ shimbun-fill-column)
+ (not (progn
+ (if (memq (preceding-char) shimbun-kinsoku-eol-list)
+ (progn
+ (backward-char)
+ (while (memq (preceding-char) shimbun-kinsoku-eol-list)
+ (backward-char))
+ (insert "\n"))
+ (while (memq (setq chr (following-char)) shimbun-kinsoku-bol-list)
+ (forward-char))
+ (if (looking-at "\\s-+")
+ (or (eolp) (delete-region (point) (match-end 0)))
+ (or (> (char-width chr) 1)
+ (re-search-backward "\\<" top t)
+ (end-of-line)))
+ (or (eolp) (insert "\n"))))))
+ (setq top (point))))
+ (forward-line 1)
+ (not (eobp)))
+
+(defsubst shimbun-shallow-rendering ()
+ (goto-char (point-min))
+ (while (search-forward "<p>" nil t)
+ (insert "\n\n"))
+ (goto-char (point-min))
+ (while (search-forward "<br>" nil t)
+ (insert "\n"))
+ (shimbun-remove-markup)
+ (shimbun-decode-entities)
+ (goto-char (point-min))
+ (while (shimbun-fill-line))
+ (goto-char (point-min))
+ (when (skip-chars-forward "\n")
+ (delete-region (point-min) (point)))
+ (while (search-forward "\n\n" nil t)
+ (let ((p (point)))
+ (when (skip-chars-forward "\n")
+ (delete-region p (point)))))
+ (goto-char (point-max))
+ (when (skip-chars-backward "\n")
+ (delete-region (point) (point-max)))
+ (insert "\n"))
+
+;;; entity decoding (stolen from w3m.el)
+(eval-and-compile
+ (defconst shimbun-entity-alist ; html character entities and values
+ (eval-when-compile
+ (let ((basic-entity-alist
+ '(("nbsp" . " ")
+ ("gt" . ">")
+ ("lt" . "<")
+ ("amp" . "&")
+ ("quot" . "\"")
+ ("apos" . "'")))
+ (latin1-entity
+ '( ;("nbsp" . 160)
+ ("iexcl" . 161) ("cent" . 162) ("pound" . 163)
+ ("curren" . 164) ("yen" . 165) ("brvbar" . 166) ("sect" . 167)
+ ("uml" . 168) ("copy" . 169) ("ordf" . 170) ("laquo" . 171)
+ ("not" . 172) ("shy" . 173) ("reg" . 174) ("macr" . 175)
+ ("deg" . 176) ("plusmn" . 177) ("sup2" . 178) ("sup3" . 179)
+ ("acute" . 180) ("micro" . 181) ("para" . 182) ("middot" . 183)
+ ("cedil" . 184) ("sup1" . 185) ("ordm" . 186) ("raquo" . 187)
+ ("frac14" . 188) ("frac12" . 189) ("frac34" . 190) ("iquest" . 191)
+ ("Agrave" . 192) ("Aacute" . 193) ("Acirc" . 194) ("Atilde" . 195)
+ ("Auml" . 196) ("Aring" . 197) ("AElig" . 198) ("Ccedil" . 199)
+ ("Egrave" . 200) ("Eacute" . 201) ("Ecirc" . 202) ("Euml" . 203)
+ ("Igrave" . 204) ("Iacute" . 205) ("Icirc" . 206) ("Iuml" . 207)
+ ("ETH" . 208) ("Ntilde" . 209) ("Ograve" . 210) ("Oacute" . 211)
+ ("Ocirc" . 212) ("Otilde" . 213) ("Ouml" . 214) ("times" . 215)
+ ("Oslash" . 216) ("Ugrave" . 217) ("Uacute" . 218) ("Ucirc" . 219)
+ ("Uuml" . 220) ("Yacute" . 221) ("THORN" . 222) ("szlig" . 223)
+ ("agrave" . 224) ("aacute" . 225) ("acirc" . 226) ("atilde" . 227)
+ ("auml" . 228) ("aring" . 229) ("aelig" . 230) ("ccedil" . 231)
+ ("egrave" . 232) ("eacute" . 233) ("ecirc" . 234) ("euml" . 235)
+ ("igrave" . 236) ("iacute" . 237) ("icirc" . 238) ("iuml" . 239)
+ ("eth" . 240) ("ntilde" . 241) ("ograve" . 242) ("oacute" . 243)
+ ("ocirc" . 244) ("otilde" . 245) ("ouml" . 246) ("divide" . 247)
+ ("oslash" . 248) ("ugrave" . 249) ("uacute" . 250) ("ucirc" . 251)
+ ("uuml" . 252) ("yacute" . 253) ("thorn" . 254) ("yuml" . 255))))
+ (append basic-entity-alist
+ (mapcar
+ (function
+ (lambda (entity)
+ (cons (car entity)
+ (char-to-string
+ (make-char
+ (static-if (boundp 'MULE) lc-ltn1 'latin-iso8859-1)
+ (cdr entity))))))
+ latin1-entity))))))
+
+(defconst shimbun-entity-regexp
+ (eval-when-compile
+ (format "&\\(%s\\|#[0-9]+\\);?"
+ (if (fboundp 'regexp-opt)
+ (let ((fn (function regexp-opt)))
+ ;; Don't funcall directly for avoiding compile warning.
+ (funcall fn (mapcar (function car)
+ shimbun-entity-alist)))
+ (mapconcat (lambda (s)
+ (regexp-quote (car s)))
+ shimbun-entity-alist
+ "\\|")))))
+
+(defvar shimbun-entity-db nil) ; nil means un-initialized
+(defconst shimbun-entity-db-size 13) ; size of obarray
+
+(defun shimbun-entity-db-setup ()
+ ;; initialise entity database (obarray)
+ (setq shimbun-entity-db (make-vector shimbun-entity-db-size 0))
+ (dolist (elem shimbun-entity-alist)
+ (set (intern (car elem) shimbun-entity-db)
+ (cdr elem))))
+
+(defsubst shimbun-entity-value (name)
+ ;; initialise if need
+ (if (null shimbun-entity-db)
+ (shimbun-entity-db-setup))
+ ;; return value of specified entity, or empty string for unknown entity.
+ (or (symbol-value (intern-soft name shimbun-entity-db))
+ (if (not (char-equal (string-to-char name) ?#))
+ (concat "&" name) ; unknown entity
+ ;; case of immediate character (accept only 0x20 .. 0x7e)
+ (let ((char (string-to-int (substring name 1)))
+ sym)
+ ;; make character's representation with learning
+ (set (setq sym (intern name shimbun-entity-db))
+ (if (or (< char 32) (< 127 char))
+ "~" ; un-supported character
+ (char-to-string char)))))))
+
+(defun shimbun-decode-entities ()
+ "Decode entities in the current buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward shimbun-entity-regexp nil t)
+ (replace-match (shimbun-entity-value (match-string 1)) nil t))))
+
+(defun shimbun-decode-entities-string (string)
+ "Decode entities in the STRING."
+ (with-temp-buffer
+ (insert string)
+ (shimbun-decode-entities)
+ (buffer-string)))
+
+(defun shimbun-remove-markup ()
+ "Remove all HTML markup, leaving just plain text."
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (delete-region (match-beginning 0)
+ (or (search-forward "-->" nil t)
+ (point-max))))
+ (goto-char (point-min))
+ (while (re-search-forward "<[^>]+>" nil t)
+ (replace-match "" t t))))
+
+(provide 'shimbun)
+;;; shimbun.el ends here.
+2001-04-02 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-draft.el (wl-default-draft-cite): Use date field
+ on the citation buffer.
+
+ * wl-vars.el (wl-shimbun-folder-icon): New variable.
+
+ * wl-xmas.el (wl-folder-internal-icon-list): Added
+ `wl-folder-shimbun-image'.
+
+ * wl-e21.el (wl-folder-internal-icon-list): Added
+ `wl-folder-shimbun-image'.
+
+2001-03-31 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl.el (wl-init): Eliminated argument.
+ (wl): Rewrite.
+
+ * wl-summary.el (wl-summary-prefetch-msg): Use `elmo-message-encache'.
+ (wl-summary-sync-update): Use Use `elmo-folder-msgdb'
+ instead of `elmo-folder-msgdb-internal'.
+ (wl-summary-sync-update): Ditto.
+ (wl-summary-flush-pending-append-operations): Eliminated.
+ (wl-summary-delete-all-msgs): Set msgdb instead of folder.
+ (wl-summary-goto-folder-subr): Set load-msgdb argument of
+ `elmo-folder-open'.
+
+ * wl-mime.el (wl-summary-burst): Fixed.
+
+ * wl-folder.el (wl-folder-info-save): Check data type.
+
+ * wl-expire.el (wl-expire-delete): Set msgdb instead of folder.
+ (wl-expire-refile-with-copy-reserve-msg): Use `elmo-folder-msgdb'
+ instead of `elmo-folder-msgdb-internal'.
+ (wl-expire-hide): Ditto.
+
+
+ * wl-draft.el (wl-draft): Removed argument for `wl-init'.
+
2001-03-20 TAKAHASHI Kaoru <kaoru@kaisei.org>
* wl-folder.el (wl-folder-write-current-folder): Support petname.
(summary-buf wl-current-summary-buffer)
(message-buf (get-buffer (wl-current-message-buffer)))
from date cite-title num entity)
+ (setq date (std11-fetch-field "date"))
(if (and summary-buf
(buffer-live-p summary-buf)
message-buf
wl-message-buffer-cur-number))
(setq entity (elmo-msgdb-overview-get-entity
num (wl-summary-buffer-msgdb)))
- (setq from (elmo-msgdb-overview-entity-get-from entity))
- (setq date (elmo-msgdb-overview-entity-get-date entity)))
+ (setq from (elmo-msgdb-overview-entity-get-from entity)))
(setq cite-title (format "At %s,\n%s wrote:"
(or date "some time ago")
(wl-summary-from-func-internal
(require 'wl))
(unless wl-init
(wl-load-profile))
- (wl-init 'wl-draft) ;; returns immediately if already initialized.
+ (wl-init) ;; returns immediately if already initialized.
(if (interactive-p)
(setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name))))
(let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
(wl-folder-pipe-image . wl-pipe-folder-icon)
(wl-folder-maildir-image . wl-maildir-folder-icon)
(wl-folder-nmz-image . wl-nmz-folder-icon)
+ (wl-folder-shimbun-image . wl-shimbun-folder-icon)
(wl-folder-trash-empty-image . wl-empty-trash-folder-icon)
(wl-folder-draft-image . wl-draft-folder-icon)
(wl-folder-queue-image . wl-queue-folder-icon)
(if (elmo-folder-delete-messages folder
delete-list)
(progn
- (elmo-msgdb-delete-msgs folder
+ (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder)
delete-list)
(wl-expire-append-log folder delete-list nil 'delete)
(message "%s" (concat mess "done")))
If REFILE-LIST includes reserve mark message, so copy."
(when (not (string= (elmo-folder-name-internal folder) dst-folder))
(let ((msglist refile-list)
- (mark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb-internal folder)))
- (number-alist (elmo-msgdb-get-number-alist (elmo-folder-msgdb-internal folder)))
+ (mark-alist (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)))
+ (number-alist (elmo-msgdb-get-number-alist (elmo-folder-msgdb
+ folder)))
(dst-folder (wl-folder-get-elmo-folder dst-folder))
(ret-val t)
(copy-reserve-message)
(elmo-folder-delete-messages folder
refile-list))
(progn
- (elmo-msgdb-delete-msgs folder
+ (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder)
refile-list)
(wl-expire-append-log folder refile-list nil 'delete))))))
(let ((mes (format "Expiring (move %s) %s msgs..."
hide-list (elmo-msgdb-get-mark-alist msgdb))))
(let ((mess (format "Hiding %s msgs..." (length hide-list))))
(message mess)
- (elmo-msgdb-delete-msgs folder hide-list)
+ (elmo-msgdb-delete-msgs (elmo-folder-msgdb folder) hide-list)
(elmo-msgdb-append-to-killed-list folder hide-list)
(elmo-folder-commit folder)
(message (concat mess "done"))
(defun wl-folder (&optional arg)
(interactive "P")
(let (initialize)
-;;; (delete-other-windows)
(if (get-buffer wl-folder-buffer-name)
(switch-to-buffer wl-folder-buffer-name)
(switch-to-buffer (get-buffer-create wl-folder-buffer-name))
(set-buffer wl-folder-buffer-name)
(wl-folder-mode)
- (wl-folder-init)
(sit-for 0)
+ (wl-folder-init)
(let ((inhibit-read-only t)
(buffer-read-only nil))
(erase-buffer)
(when (and (setq info (elmo-folder-get-info
(wl-folder-get-elmo-folder entity)))
(not (equal info '(nil))))
- (wl-append info-alist (list (list (elmo-string entity)
- (list (nth 3 info) ;; max
- (nth 2 info) ;; length
- (nth 0 info) ;; new
- (nth 1 info)) ;; unread
- ))))))
+ (if (listp info)
+ (wl-append info-alist (list (list (elmo-string entity)
+ (list (nth 3 info) ;; max
+ (nth 2 info) ;; length
+ (nth 0 info) ;; new
+ (nth 1 info)) ;; unread
+ )))))))
(unless entities
(setq entities (wl-pop entity-stack))))
(elmo-msgdb-finfo-save info-alist)
(defun wl-summary-burst ()
""
(interactive)
- (let ((raw-buf (wl-message-get-original-buffer))
+ (let ((raw-buf (wl-summary-get-original-buffer))
+ (view-buf wl-message-buffer)
children message-entity content-type target)
(save-excursion
(setq target wl-summary-buffer-elmo-folder)
(setq target
(wl-summary-read-folder wl-default-folder "to extract to")))
(wl-summary-set-message-buffer-or-redisplay)
- (save-excursion
- (set-buffer (get-buffer wl-message-buffer))
+ (with-current-buffer view-buf
(setq message-entity (get-text-property (point-min) 'mime-view-entity)))
- (set-buffer raw-buf)
- (setq children (mime-entity-children message-entity))
+ (with-current-buffer raw-buf
+ (setq children (mime-entity-children message-entity)))
(when children
(message "Bursting...")
(wl-summary-burst-subr children target 0)
(condition-case nil (require 'timezone) (error nil))
(condition-case nil (require 'easymenu) (error nil))
(require 'elmo-date)
-(require 'elmo-dop)
(condition-case nil (require 'ps-print) (error nil))
(eval-when-compile
(wl-summary-set-message-modified)
(wl-summary-count-unread
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal wl-summary-buffer-elmo-folder)))
+ (elmo-folder-msgdb wl-summary-buffer-elmo-folder)))
(wl-summary-update-modeline)
(goto-char (point-max))
(forward-line -1)
(if force-read
(save-excursion
(save-match-data
- (if (and (null (elmo-folder-plugged-p
- wl-summary-buffer-elmo-folder))
- elmo-enable-disconnected-operation)
- (progn;; append-queue for offline
- (elmo-dop-prefetch-msgs
- wl-summary-buffer-elmo-folder (list number))
- (setq
- new-mark
- (cond
- ((string= mark
- wl-summary-unread-uncached-mark)
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-new-mark)
- (setq wl-summary-buffer-new-count
- (- wl-summary-buffer-new-count 1))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- ((or (null mark)
- (string= mark wl-summary-read-uncached-mark))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- (t mark))))
- ;; online
- (elmo-message-encache
- wl-summary-buffer-elmo-folder
- number)
- (setq new-mark
- (cond
- ((string= mark
- wl-summary-unread-uncached-mark)
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-new-mark)
- (setq wl-summary-buffer-new-count
- (- wl-summary-buffer-new-count 1))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-read-uncached-mark)
- nil)
- (t mark))))
+ ;; online
+ (elmo-message-encache
+ wl-summary-buffer-elmo-folder
+ number)
+ (setq new-mark
+ (cond
+ ((string= mark
+ wl-summary-unread-uncached-mark)
+ wl-summary-unread-cached-mark)
+ ((string= mark wl-summary-new-mark)
+ (setq wl-summary-buffer-new-count
+ (- wl-summary-buffer-new-count 1))
+ (setq wl-summary-buffer-unread-count
+ (+ wl-summary-buffer-unread-count 1))
+ wl-summary-unread-cached-mark)
+ ((string= mark wl-summary-read-uncached-mark)
+ nil)
+ (t mark)))
(setq mark-alist (elmo-msgdb-mark-set
mark-alist number new-mark))
(or new-mark (setq new-mark " "))
(setq i 0)
;; set these value for append-message-func
(setq overview (elmo-msgdb-get-overview
- (elmo-folder-msgdb-internal
- folder)))
+ (elmo-folder-msgdb folder)))
(setq number-alist (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal
- folder)))
+ (elmo-folder-msgdb folder)))
(setq mark-alist (elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal
- folder)))
+ (elmo-folder-msgdb folder)))
(setq wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
(while curp
(list 0
(wl-summary-count-unread
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder)))
+ (elmo-folder-msgdb folder)))
(elmo-folder-messages folder)))
(wl-summary-update-modeline)
(wl-summary-buffer-number-column-detect t)
(while dsts
(setq dsts (cdr dsts)))))
-(defun wl-summary-flush-pending-append-operations (&optional seen-list)
- "Execute append operations that are done while offline status."
- (when (and (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
- elmo-enable-disconnected-operation)
- (let* ((resumed-list (elmo-dop-append-list-load
- wl-summary-buffer-elmo-folder t))
- (append-list (elmo-dop-append-list-load
- wl-summary-buffer-elmo-folder))
- (appends (append resumed-list append-list))
- (number-alist (elmo-msgdb-get-number-alist
- (wl-summary-buffer-msgdb)))
- dels pair)
- (when appends
- (while appends
- (if (setq pair (rassoc (car appends) number-alist))
- (setq dels (append dels (list (car pair)))))
- (setq appends (cdr appends)))
- (when dels
- (setq seen-list
- (elmo-msgdb-add-msgs-to-seen-list
- dels
- (wl-summary-buffer-msgdb)
- (list wl-summary-unread-cached-mark
- wl-summary-unread-uncached-mark
- wl-summary-new-mark)
- seen-list))
- (message "Resuming summary status...")
- (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
- dels)
- (wl-summary-delete-messages-on-buffer dels)
- (message "Resuming summary status...done"))
- ;; delete resume-file
- (elmo-dop-append-list-save wl-summary-buffer-elmo-folder nil t)
- (when append-list
- (elmo-dop-flush-pending-append-operations
- wl-summary-buffer-elmo-folder append-list)))))
- seen-list)
-
(defun wl-summary-delete-all-msgs ()
(interactive)
(let ((cur-buf (current-buffer))
(message "Deleting...")
(elmo-folder-delete-messages
wl-summary-buffer-elmo-folder dels)
- (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
+ (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb)
dels)
-
;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
(wl-summary-set-message-modified)
(wl-summary-set-mark-modified)
(inhibit-read-only t)
(buffer-read-only nil))
;; Select folder
- (elmo-folder-open folder)
+ (elmo-folder-open folder 'load-msgdb)
;; For compatibility
(setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
(setq wl-summary-buffer-folder-name (elmo-folder-name-internal
(defvar wl-pipe-folder-icon "pipe.xpm"
"*Icon file for pipe folder.")
(defvar wl-nmz-folder-icon "nmz.xpm"
- "*Icon file for localdir folder.")
+ "*Icon file for namazu folder.")
+(defvar wl-shimbun-folder-icon "shimbun.xpm"
+ "*Icon file for shimbun folder.")
(defvar wl-maildir-folder-icon "maildir.xpm"
"*Icon file for maildir folder.")
(defvar wl-empty-trash-folder-icon "trash-e.xpm"
(wl-folder-pipe-glyph . wl-pipe-folder-icon)
(wl-folder-maildir-glyph . wl-maildir-folder-icon)
(wl-folder-nmz-glyph . wl-nmz-folder-icon)
+ (wl-folder-shimbun-glyph . wl-shimbun-folder-icon)
(wl-folder-trash-empty-glyph . wl-empty-trash-folder-icon)
(wl-folder-draft-glyph . wl-draft-folder-icon)
(wl-folder-queue-glyph . wl-queue-folder-icon)
(if (and wl-draft-enable-queuing
wl-auto-flush-queue)
(wl-draft-queue-flush))
- (when (and (eq major-mode 'wl-summary-mode)
- (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
- (let* ((msgdb-dir (elmo-folder-msgdb-path
- wl-summary-buffer-elmo-folder))
- (seen-list (elmo-msgdb-seen-load msgdb-dir)))
- (setq seen-list
- (wl-summary-flush-pending-append-operations seen-list))
- (elmo-msgdb-seen-save msgdb-dir seen-list)))
+;; (when (and (eq major-mode 'wl-summary-mode)
+;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
+;; (let* ((msgdb-dir (elmo-folder-msgdb-path
+;; wl-summary-buffer-elmo-folder))
+;; (seen-list (elmo-msgdb-seen-load msgdb-dir)))
+;; (setq seen-list
+;; (wl-summary-flush-pending-append-operations seen-list))
+;; (elmo-msgdb-seen-save msgdb-dir seen-list)))
(run-hooks 'wl-plugged-hook))
(wl-biff-stop)
(run-hooks 'wl-unplugged-hook))
(unless wl-on-nemacs
(remove-hook 'kill-emacs-hook 'wl-save-status))
t)
- (message "") ;; empty minibuffer.
+ (message "") ; empty minibuffer.
)
-(defun wl-init (&optional arg)
+(defun wl-init ()
(when (not wl-init)
(setq elmo-plugged wl-plugged)
- (let (succeed demo-buf)
- (if wl-demo
- (setq demo-buf (wl-demo)))
- (unless wl-on-nemacs
- (add-hook 'kill-emacs-hook 'wl-save-status))
- (unwind-protect
- (progn
- (wl-address-init)
- (wl-draft-setup)
- (wl-refile-alist-setup)
- (if wl-use-semi
- (progn
- (require 'wl-mime)
- (setq elmo-use-semi t))
- (require 'tm-wl)
- (setq elmo-use-semi nil))
- ;; defined above.
- (wl-mime-setup)
- (fset 'wl-summary-from-func-internal
- (symbol-value 'wl-summary-from-function))
- (fset 'wl-summary-subject-func-internal
- (symbol-value 'wl-summary-subject-function))
- (fset 'wl-summary-subject-filter-func-internal
- (symbol-value 'wl-summary-subject-filter-function))
- (setq elmo-no-from wl-summary-no-from-message)
- (setq elmo-no-subject wl-summary-no-subject-message)
- (setq succeed t)
- (progn
- (message "Checking environment...")
- (wl-check-environment arg)
- (message "Checking environment...done"))
- demo-buf)
- (if succeed
- (setq wl-init t))
- ;; This hook may contain the functions `wl-plugged-init-icons' and
- ;; `wl-biff-init-icons' for reasons of system internal to accord
- ;; facilities for the Emacs variants.
- (run-hooks 'wl-init-hook)))))
+ (unless wl-on-nemacs
+ (add-hook 'kill-emacs-hook 'wl-save-status))
+ (wl-address-init)
+ (wl-draft-setup)
+ (wl-refile-alist-setup)
+ (if wl-use-semi
+ (progn
+ (require 'wl-mime)
+ (setq elmo-use-semi t))
+ (require 'tm-wl)
+ (setq elmo-use-semi nil))
+ ;; defined above.
+ (wl-mime-setup)
+ (fset 'wl-summary-from-func-internal
+ (symbol-value 'wl-summary-from-function))
+ (fset 'wl-summary-subject-func-internal
+ (symbol-value 'wl-summary-subject-function))
+ (fset 'wl-summary-subject-filter-func-internal
+ (symbol-value 'wl-summary-subject-filter-function))
+ (setq elmo-no-from wl-summary-no-from-message)
+ (setq elmo-no-subject wl-summary-no-subject-message)
+ (setq wl-init t)
+ ;; This hook may contain the functions `wl-plugged-init-icons' and
+ ;; `wl-biff-init-icons' for reasons of system internal to accord
+ ;; facilities for the Emacs variants.
+ (run-hooks 'wl-init-hook)))
(defun wl-check-environment (no-check-folder)
(unless (featurep 'mime-setup)
(interactive "P")
(or wl-init (wl-load-profile))
(let (demo-buf)
- (unwind-protect
- (setq demo-buf (wl-init arg))
- (wl-plugged-init (wl-folder arg))
- (elmo-init)
- (unwind-protect
+ (setq demo-buf (wl-demo))
+ (wl-init)
+ (condition-case nil
+ (progn
+ (message "Checking environment...")
+ (wl-check-environment arg)
+ (message "Checking environment...done"))
+ (error)
+ (quit))
+ (condition-case obj
+ (progn
+ (wl-plugged-init (wl-folder arg))
+ (elmo-init)
(unless arg
(run-hooks 'wl-auto-check-folder-pre-hook)
(wl-folder-auto-check)
(run-hooks 'wl-auto-check-folder-hook))
- (unless arg (wl-biff-start))
- (if (buffer-live-p demo-buf)
- (kill-buffer demo-buf)))
- (if (buffer-live-p demo-buf)
- (kill-buffer demo-buf))
- (run-hooks 'wl-hook))))
+ (unless arg (wl-biff-start)))
+ (error
+ (if (buffer-live-p demo-buf)
+ (kill-buffer demo-buf))
+ (signal (car obj)(cdr obj)))
+ (quit))
+ (if (buffer-live-p demo-buf)
+ (kill-buffer demo-buf)))
+ (run-hooks 'wl-hook))
;; Define some autoload functions WL might use.
(eval-and-compile
projects / elisp / wanderlust.git / commitdiff