From: teranisi Date: Mon, 2 Apr 2001 02:41:04 +0000 (+0000) Subject: * Added `shimbun' feature (EXPERIMENTAL). X-Git-Tag: wl-2_8-root^2~7 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=11e18a6988470910ad5c4606cbbfe8835507741b;p=elisp%2Fwanderlust.git * Added `shimbun' feature (EXPERIMENTAL). * Disconnected operation features are not supported yet. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index ef81e12..3605093 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,53 @@ +2001-03-12 Yuuichi Teranishi + + * 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 + + * elmo-msgdb.el (elmo-msgdb-delete-msgs): Changed argument from + `folder' to `msgdb'. + 2001-03-01 Yuuichi Teranishi * mmimap.el (mmimap-parse-parameters-from-list): Define as alias for diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el index 8980c03..0360a21 100644 --- a/elmo/elmo-dop.el +++ b/elmo/elmo-dop.el @@ -43,17 +43,29 @@ Automatically loaded/saved.") 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) @@ -82,65 +94,30 @@ even an operation concerns the unplugged folder." (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) @@ -162,403 +139,41 @@ even an operation concerns the unplugged folder." (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)) diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 9f161c4..b682b0c 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -129,7 +129,7 @@ (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 @@ -152,7 +152,7 @@ (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 diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index ae3f20c..de229cb 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -2295,7 +2295,8 @@ If optional argument REMOVE is non-nil, remove FLAG." 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 @@ -2306,7 +2307,8 @@ If optional argument REMOVE is non-nil, remove FLAG." (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))) @@ -2325,8 +2327,10 @@ If optional argument REMOVE is non-nil, remove FLAG." (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. diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el index 612e79c..6b74027 100644 --- a/elmo/elmo-map.el +++ b/elmo/elmo-map.el @@ -114,7 +114,7 @@ (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)) @@ -210,7 +210,9 @@ 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)) diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index 49c085c..30d0dc4 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -216,7 +216,7 @@ Return non-nil if not entire message was fetched." (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)) @@ -245,8 +245,7 @@ If second optional argument UNREAD is specified, message is displayed but 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 diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 2ff28cd..76e4a78 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -340,11 +340,11 @@ header separator." (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)) @@ -353,11 +353,6 @@ content of MSGDB is changed." 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 @@ -369,7 +364,7 @@ content of MSGDB is changed." (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) @@ -818,6 +813,18 @@ Header region is supposed to be narrowed." 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)) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index fbb5977..6039f46 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -175,7 +175,7 @@ (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)) @@ -187,7 +187,7 @@ (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 @@ -211,7 +211,7 @@ (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)) @@ -359,7 +359,7 @@ (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) @@ -393,7 +393,7 @@ (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) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index 9df58e1..022aeab 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -324,8 +324,7 @@ Returns a process object. if making session failed, returns nil." (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 @@ -450,7 +449,8 @@ Returns a process object. if making session failed, returns nil." (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)) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index f481f98..5beee54 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -889,7 +889,7 @@ Don't cache if nil.") (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 @@ -912,7 +912,7 @@ Don't cache if nil.") (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)))))))))) @@ -1623,7 +1623,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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 @@ -1643,7 +1643,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ;; 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) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el new file mode 100644 index 0000000..4205907 --- /dev/null +++ b/elmo/elmo-shimbun.el @@ -0,0 +1,209 @@ +;;; elmo-shimbun.el -- Shimbun interface for ELMO. + +;; Copyright (C) 2001 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index b451e6d..eef790b 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -254,6 +254,9 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") (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)) diff --git a/elmo/elmo.el b/elmo/elmo.el index 3ac0cee..1ef0b39 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -140,8 +140,16 @@ If optional argument NON-PERSISTENT is non-nil, folder is treated as (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).") @@ -486,7 +494,13 @@ Return newly created temporary directory name which contains temporary files.") ((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 @@ -525,11 +539,13 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (luna-define-generic elmo-folder-append-msgdb (folder append-msgdb) "Append APPEND-MSGDB to the current msgdb of the folder.") -(luna-define-method elmo-folder-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))) @@ -550,14 +566,14 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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) @@ -565,7 +581,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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)) @@ -696,8 +712,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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) @@ -852,7 +867,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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 @@ -865,7 +880,8 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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)) @@ -891,11 +907,6 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") 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. @@ -940,9 +951,9 @@ FIELD is a symbol of the field." (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) @@ -975,7 +986,7 @@ FIELD is a symbol of the field." (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 @@ -996,7 +1007,7 @@ FIELD is a symbol of the field." (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)) @@ -1055,13 +1066,13 @@ CROSSED is cross-posted message number." 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 @@ -1112,7 +1123,8 @@ CROSSED is cross-posted message number." (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 @@ -1120,7 +1132,7 @@ CROSSED is cross-posted message number." 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) @@ -1146,7 +1158,7 @@ CROSSED is cross-posted message number." "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) @@ -1252,7 +1264,8 @@ Return a hashtable for newsgroups." (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." @@ -1285,6 +1298,7 @@ Return a hashtable for newsgroups." (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)) diff --git a/elmo/sb-airs.el b/elmo/sb-airs.el new file mode 100644 index 0000000..c95c9b3 --- /dev/null +++ b/elmo/sb-airs.el @@ -0,0 +1,91 @@ +;;; sb-airs.el --- shimbun backend for lists.airs.net + +;; Author: Yuuichi Teranishi + +;; 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 "" 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 + "]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)" + 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 " *\\([^<]+\\)<") + (shimbun-mime-encode-string (match-string 1)) + "") + "" id "" 0 0 url) + headers))))) + headers)) + +(provide 'sb-airs) diff --git a/elmo/sb-asahi.el b/elmo/sb-asahi.el new file mode 100644 index 0000000..ec130c1 --- /dev/null +++ b/elmo/sb-asahi.el @@ -0,0 +1,104 @@ +;;; sb-asahi.el --- shimbun backend for asahi.com + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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\n") +(defvar shimbun-asahi-content-end "\n\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\n" nil t) + (delete-region (point-min) (point)) + (when (search-forward "\n\n" nil t) + (forward-line -1) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let (headers) + (while (re-search-forward + "^■ *" + 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 "
" 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 diff --git a/elmo/sb-bbdb-ml.el b/elmo/sb-bbdb-ml.el new file mode 100644 index 0000000..4c73461 --- /dev/null +++ b/elmo/sb-bbdb-ml.el @@ -0,0 +1,45 @@ +;;; sb-bbdb-ml.el --- shimbun backend for bbdb-ml + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 diff --git a/elmo/sb-cnet.el b/elmo/sb-cnet.el new file mode 100644 index 0000000..de1673b --- /dev/null +++ b/elmo/sb-cnet.el @@ -0,0 +1,75 @@ +;;; sb-cnet.el --- shimbun backend for cnet + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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\n") +(defvar shimbun-cnet-content-end "\n\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\n" nil t) + (let ((subject (buffer-substring (point) (point-at-eol))) + (point (point))) + (forward-line -2) + (when (looking-at "") + (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 diff --git a/elmo/sb-fml.el b/elmo/sb-fml.el new file mode 100644 index 0000000..feb7bd3 --- /dev/null +++ b/elmo/sb-fml.el @@ -0,0 +1,134 @@ +;;; sb-fml.el --- shimbun backend class for fml archiver. + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 "" 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 + "
  • Article .*
    Article \\([0-9]+\\) at \\([^<]*\\) Subject: \\([^<]*\\)
    From: \\([^<]*\\)
    " + 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 "" nil t) + (delete-region (point-min) (point)) + (throw 'stop nil)) + (if (search-forward "") + (progn + (beginning-of-line) + (delete-region (point) (point-max))) + (throw 'stop nil)) + (if (search-backward "") + (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 "\\(.*\\):" + nil t) + (setq field (match-string 2)) + (re-search-forward + (concat "") nil t) + (setq value-beg (point)) + (search-forward "" nil t) + (setq end (point))) + (setq value (buffer-substring value-beg + (progn (search-backward "") + (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 diff --git a/elmo/sb-lump.el b/elmo/sb-lump.el new file mode 100644 index 0000000..5e63051 --- /dev/null +++ b/elmo/sb-lump.el @@ -0,0 +1,72 @@ +;;; sb-lump.el --- shimbun backend class to check all groups at once + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 diff --git a/elmo/sb-mew.el b/elmo/sb-mew.el new file mode 100644 index 0000000..fa6b2e8 --- /dev/null +++ b/elmo/sb-mew.el @@ -0,0 +1,134 @@ +;;; sb-mew.el --- shimbun backend for mew.org + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 "]*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 "\\([^<]+\\)<") + (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 + "]*href=\"mail\\([0-9]+\\)\\.html\">\\[?Last Page\\]?" + 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 diff --git a/elmo/sb-mhonarc.el b/elmo/sb-mhonarc.el new file mode 100644 index 0000000..2cbf56e --- /dev/null +++ b/elmo/sb-mhonarc.el @@ -0,0 +1,113 @@ +;;; sb-mhonarc.el --- shimbun backend class for mhonarc + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; Code: + +(require 'shimbun) +(luna-define-class shimbun-mhonarc (shimbun) ()) + +(luna-define-method shimbun-make-contents ((shimbun shimbun-mhonarc) + header) + (if (search-forward "" 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\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 "\n" nil t) + (point))) + (when (search-forward "\n\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 diff --git a/elmo/sb-netbsd.el b/elmo/sb-netbsd.el new file mode 100644 index 0000000..5a1f76a --- /dev/null +++ b/elmo/sb-netbsd.el @@ -0,0 +1,93 @@ +;;; sb-netbsd.el --- shimbun backend for netbsd.org + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 + "" 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 + "]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)" + 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 " *\\([^<]+\\)<") + (shimbun-mime-encode-string (match-string 1)) + "") + "" id "" 0 0 url) + headers)))) + headers)) + +(provide 'sb-netbsd) + +;;; sb-netbsd.el ends here diff --git a/elmo/sb-sponichi.el b/elmo/sb-sponichi.el new file mode 100644 index 0000000..ff3fc3b --- /dev/null +++ b/elmo/sb-sponichi.el @@ -0,0 +1,93 @@ +;;; sb-sponichi.el --- shimbun backend for www.sponichi.co.jp + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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　") +(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 "ニュースインデックス" nil t) + (delete-region (point-min) (point)) + (when (search-forward "アドタグ" nil t) + (forward-line 2) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let ((case-fold-search t) + headers) + (while (re-search-forward + "^" + 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 "
    " 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 diff --git a/elmo/sb-text.el b/elmo/sb-text.el new file mode 100644 index 0000000..e35fad4 --- /dev/null +++ b/elmo/sb-text.el @@ -0,0 +1,62 @@ +;;; sb-text.el --- shimbun backend class for text content. + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 diff --git a/elmo/sb-wired.el b/elmo/sb-wired.el new file mode 100644 index 0000000..c6aaf45 --- /dev/null +++ b/elmo/sb-wired.el @@ -0,0 +1,89 @@ +;;; sb-wired.el --- shimbun backend for Wired Japan + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 + ".*\n") +(defvar shimbun-wired-content-end "
    \\[") + +(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 + "]*\">" + (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 "" 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 diff --git a/elmo/sb-xemacs.el b/elmo/sb-xemacs.el new file mode 100644 index 0000000..a5783f4 --- /dev/null +++ b/elmo/sb-xemacs.el @@ -0,0 +1,100 @@ +;;; sb-xemacs.el --- shimbun backend for xemacs.org + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 "\\[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 + "]*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 "\\([^<]+\\)<") + (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 diff --git a/elmo/sb-yomiuri.el b/elmo/sb-yomiuri.el new file mode 100644 index 0000000..5abf9b9 --- /dev/null +++ b/elmo/sb-yomiuri.el @@ -0,0 +1,116 @@ +;;; sb-yomiuri.el --- shimbun backend for www.yomiuri.co.jp + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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\n") +(defvar shimbun-yomiuri-content-end "\n\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\n" + (shimbun-current-group-internal shimbun)) nil t) + (setq start (point)) + (search-forward + (format "\n\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 + "]*>" + 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 "
    " nil t) (point))) + "<[^>]+>") + "")) + date) + (when (string-match "^◆" 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 diff --git a/elmo/sb-zdnet.el b/elmo/sb-zdnet.el new file mode 100644 index 0000000..ede58f1 --- /dev/null +++ b/elmo/sb-zdnet.el @@ -0,0 +1,84 @@ +;;; sb-zdnet.el --- shimbun backend for Zdnet Japan + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;;; 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 "\\(\\|\\)") +(defvar shimbun-zdnet-content-end "\\(\\|\\)") + +(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)) + (delete-region start (point)))) + (goto-char (point-min)) + (while (re-search-forward + "    " + 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 "" 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 diff --git a/elmo/shimbun.el b/elmo/shimbun.el new file mode 100644 index 0000000..ee53a54 --- /dev/null +++ b/elmo/shimbun.el @@ -0,0 +1,648 @@ +;;; shimbun.el --- interfacing with web newspapers -*- coding: junet; -*- + +;; Author: TSUCHIYA Masatoshi +;; Akihiro Arisawa +;; Yuuichi Teranishi + +;; 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 . + +;; 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^ + 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 "")) + "Regexp used in parsing ` +for a charset indication") + +(defconst shimbun-meta-charset-content-type-regexp + (eval-when-compile + (concat "")) + "Regexp used in parsing ` +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 "!)-_~}]:;',.?、。，．・：；？！゛゜´｀¨＾￣＿ヽヾゝゞ〃\ +仝々〆〇ー―‐／＼〜‖｜…‥’”）〕］｝〉》」』】°′″℃ぁぃぅぇぉ\ +っゃゅょゎァィゥェォッャュョヮヵヶ" nil)) + +(defconst shimbun-kinsoku-eol-list + (append "({[`‘“（〔［｛〈《「『【°′″§" 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 "

    " nil t) + (insert "\n\n")) + (goto-char (point-min)) + (while (search-forward "
    " 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) + (point-max)))) + (goto-char (point-min)) + (while (re-search-forward "<[^>]+>" nil t) + (replace-match "" t t)))) + +(provide 'shimbun) +;;; shimbun.el ends here. diff --git a/wl/ChangeLog b/wl/ChangeLog index 5d0a766..502c339 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,42 @@ +2001-04-02 Yuuichi Teranishi + + * 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 + + * 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 * wl-folder.el (wl-folder-write-current-folder): Support petname. diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 1a3eb72..8532318 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -586,6 +586,7 @@ Reply to author if WITH-ARG is non-nil." (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 @@ -599,8 +600,7 @@ Reply to author if WITH-ARG is non-nil." 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 @@ -1289,7 +1289,7 @@ If optional argument is non-nil, current draft buffer is killed" (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)) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index dab784a..ad3a99f 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -436,6 +436,7 @@ (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) diff --git a/wl/wl-expire.el b/wl/wl-expire.el index 240e1c6..dcfaf0c 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -109,7 +109,7 @@ (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"))) @@ -158,8 +158,9 @@ 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) @@ -212,7 +213,7 @@ If REFILE-LIST includes reserve mark message, so copy." (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..." @@ -473,7 +474,7 @@ Refile to archive folder followed message date." 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")) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index d7246e7..42035b1 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -1450,14 +1450,13 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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) @@ -2206,12 +2205,13 @@ Use `wl-subscribed-mailing-list'." (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) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 7126d25..a51d29c 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -180,7 +180,8 @@ By setting following-method as yank-content." (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) @@ -188,11 +189,10 @@ By setting following-method as yank-content." (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) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index ebbf027..425db42 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -45,7 +45,6 @@ (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 @@ -897,7 +896,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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) @@ -1283,48 +1282,24 @@ If ARG is non-nil, checking is omitted." (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 " ")) @@ -2095,14 +2070,11 @@ If ARG is non-nil, checking is omitted." (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 @@ -2186,7 +2158,7 @@ If ARG is non-nil, checking is omitted." (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) @@ -2297,44 +2269,6 @@ If ARG is non-nil, checking is omitted." (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)) @@ -2349,9 +2283,8 @@ If ARG is non-nil, checking is omitted." (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) @@ -2568,7 +2501,7 @@ If ARG, without confirm." (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 diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 0b5bd54..1523a47 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -2164,7 +2164,9 @@ a symbol `bitmap', `xbm' or `xpm' in order to force the image format." (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" diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 394fefe..05adf97 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -372,6 +372,7 @@ (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) diff --git a/wl/wl.el b/wl/wl.el index e54b8eb..003f025 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -118,14 +118,14 @@ (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)) @@ -651,50 +651,38 @@ Entering Plugged mode calls the value of `wl-plugged-mode-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) @@ -764,21 +752,32 @@ If ARG (prefix argument) is specified, folder checkings are skipped." (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