From: okada Date: Sat, 1 Dec 2001 19:59:56 +0000 (+0000) Subject: * WL-ELS (ELMO-MODULES): Added 'elmo-sendlog' X-Git-Tag: wl-2_8-root~106 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=176969e96515838da31d9bac148b615910061942;p=elisp%2Fwanderlust.git * WL-ELS (ELMO-MODULES): Added 'elmo-sendlog' * elmo-sendlog.el: New file. * elmo-internal.el (elmo-internal-folder-list): Added 'sendlog. --- diff --git a/ChangeLog b/ChangeLog index c9ac03e..887bcda 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2001-12-02 Kenichi OKADA + + * WL-ELS (ELMO-MODULES): Added 'elmo-sendlog' + 2001-10-23 Yoichi NAKAYAMA * WL-MK (wl-info-lang): Change default value to ("ja" "en"). diff --git a/WL-ELS b/WL-ELS index 785548d..1cb8b44 100644 --- a/WL-ELS +++ b/WL-ELS @@ -20,7 +20,7 @@ elmo-localdir elmo-localnews elmo-map elmo-maildir elmo-multi elmo-filter elmo-archive elmo-pipe elmo-cache - elmo-internal elmo-mark + elmo-internal elmo-mark elmo-sendlog elmo-dop elmo-nmz )) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index ff16909..2663190 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,8 @@ +2001-12-02 Kenichi OKADA + + * elmo-sendlog.el: New file. + * elmo-internal.el (elmo-internal-folder-list): Added 'sendlog. + 2001-11-30 Yuuichi Teranishi * acap.el (acap-logging-out): New buffer local variable. diff --git a/elmo/elmo-internal.el b/elmo/elmo-internal.el index 54e6c22..5cd1fec 100644 --- a/elmo/elmo-internal.el +++ b/elmo/elmo-internal.el @@ -38,7 +38,7 @@ name) (elmo-internal-folder-initialize folder name)) -(defvar elmo-internal-folder-list '(mark cache)) +(defvar elmo-internal-folder-list '(mark cache sendlog)) (defun elmo-internal-folder-initialize (folder name) (let ((fsyms elmo-internal-folder-list) diff --git a/elmo/elmo-sendlog.el b/elmo/elmo-sendlog.el new file mode 100644 index 0000000..6a41196 --- /dev/null +++ b/elmo/elmo-sendlog.el @@ -0,0 +1,194 @@ +;;; elmo-sendlog.el --- Sendlog folder for ELMO. + +;; Copyright (C) 2001 Kenichi OKADA + +;; Author: Kenichi OKADA +;; 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-vars) +(require 'elmo-util) +(require 'elmo) +(require 'elmo-map) + +(defvar elmo-sendlog-filename "sendlog") +(defvar elmo-sendlog-buffer-name "*elmo-sendlog*") + +;;; ELMO sendlog folder +(eval-and-compile + (luna-define-class elmo-sendlog-folder (elmo-map-folder) (dir-name directory)) + (luna-define-internal-accessors 'elmo-sendlog-folder)) + +(luna-define-method elmo-folder-initialize ((folder elmo-sendlog-folder) + name) + folder) + +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-sendlog-folder)) + (expand-file-name "sendlog" + (expand-file-name "internal" + elmo-msgdb-dir))) + +(luna-define-method elmo-map-folder-list-message-locations + ((folder elmo-sendlog-folder)) + (elmo-sendlog-folder-list-message-locations folder)) + +(defun elmo-sendlog-folder-list-message-locations (folder) + (let ((filename (expand-file-name elmo-sendlog-filename + elmo-msgdb-dir)) + result) + (if (not (file-readable-p filename)) + nil + (elmo-set-work-buf + (as-binary-input-file + (insert-file-contents filename)) + (goto-char (point-min)) + (catch 'done + (while t + (re-search-forward "id=\\([^@]+@[^@]+\\)$" (point-at-eol) t) + (setq result (append result (list (match-string 1)))) + (if (eq (1+ (point-at-eol)) (point-max)) + (throw 'done nil) + (beginning-of-line 2)))))) + result)) + +(luna-define-method elmo-folder-message-file-p ((folder elmo-sendlog-folder)) + t) + +(luna-define-method elmo-message-file-name ((folder elmo-sendlog-folder) + number) + (elmo-file-cache-get-path + (elmo-map-message-location folder number))) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-sendlog-folder) + numbers new-mark + already-mark seen-mark + important-mark + seen-list) + (let ((i 0) + (len (length numbers)) + overview number-alist mark-alist entity message-id + num mark) + (message "Creating msgdb...") + (while numbers + (setq entity + (elmo-msgdb-create-overview-entity-from-file + (car numbers) (elmo-message-file-name folder (car numbers)))) + (if (null entity) + () + (setq num (elmo-msgdb-overview-entity-get-number entity)) + (setq overview + (elmo-msgdb-append-element + overview entity)) + (setq message-id (elmo-msgdb-overview-entity-get-id entity)) + (setq number-alist + (elmo-msgdb-number-add number-alist + num + message-id)) + (if (setq mark (or (elmo-msgdb-global-mark-get message-id) + (if (member message-id seen-list) nil new-mark))) + (setq mark-alist + (elmo-msgdb-mark-append + mark-alist + num mark))) + (when (> len elmo-display-progress-threshold) + (setq i (1+ i)) + (elmo-display-progress + 'elmo-sendlog-folder-msgdb-create "Creating msgdb..." + (/ (* i 100) len)))) + (setq numbers (cdr numbers))) + (message "Creating msgdb...done") + (list overview number-alist mark-alist))) + +(luna-define-method elmo-message-fetch-with-cache-process + ((folder elmo-sendlog-folder) number strategy &optional section unseen) + ;; disbable cache process + (elmo-message-fetch-internal folder number strategy section unseen)) + +(luna-define-method elmo-map-message-fetch ((folder elmo-sendlog-folder) + location strategy + &optional section unseen) + (insert-file-contents-as-binary + (elmo-file-cache-get-path location))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-sendlog-folder)) + nil) + +(luna-define-method elmo-folder-writable-p ((folder elmo-sendlog-folder)) + nil) + +(luna-define-method elmo-folder-exists-p ((folder elmo-sendlog-folder)) + t) + +(luna-define-method elmo-folder-search ((folder elmo-sendlog-folder) + condition &optional from-msgs) + (let* ((msgs (or from-msgs (elmo-folder-list-messages folder))) + (number-list msgs) + (i 0) + (num (length msgs)) + file + matched + case-fold-search) + (while msgs + (if (and (setq file (elmo-message-file-name folder (car msgs))) + (file-exists-p file) + (elmo-file-field-condition-match file + condition + (car msgs) + number-list)) + (setq matched (nconc matched (list (car msgs))))) + (elmo-display-progress + 'elmo-internal-folder-search "Searching..." + (/ (* (setq i (1+ i)) 100) num)) + (setq msgs (cdr msgs))) + matched)) + +(luna-define-method elmo-message-file-p ((folder elmo-sendlog-folder) number) + t) + +;;; To override elmo-map-folder methods. +(luna-define-method elmo-folder-list-unreads-internal + ((folder elmo-sendlog-folder) unread-marks &optional mark-alist) + t) + +(luna-define-method elmo-folder-unmark-important ((folder elmo-sendlog-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-important ((folder elmo-sendlog-folder) + numbers) + t) + +(luna-define-method elmo-folder-unmark-read ((folder elmo-sendlog-folder) + numbers) + t) + +(luna-define-method elmo-folder-mark-as-read ((folder elmo-sendlog-folder) + numbers) + t) + +(require 'product) +(product-provide (provide 'elmo-sendlog) (require 'elmo-version)) + +;;; elmo-sendlog.el ends here \ No newline at end of file