elmo/elmo-shimbun.el

   1 ;;; elmo-shimbun.el -- Shimbun interface for ELMO.
   2
   3 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31 (require 'elmo)
  32 (require 'elmo-map)
  33 (require 'shimbun)
  34
  35 (eval-and-compile
  36   (luna-define-class elmo-shimbun-folder
  37                      (elmo-map-folder) (shimbun header-hash group))
  38   (luna-define-internal-accessors 'elmo-shimbun-folder))
  39
  40 (luna-define-method elmo-folder-initialize ((folder
  41                                              elmo-shimbun-folder)
  42                                             name)
  43   (let ((server-group (split-string name "\\.")))
  44     (if (nth 0 server-group) ; server
  45         (elmo-shimbun-folder-set-shimbun-internal
  46          folder
  47          (shimbun-open (nth 0 server-group))))
  48     (if (nth 1 server-group)
  49         (elmo-shimbun-folder-set-group-internal
  50          folder
  51          (nth 1 server-group)))
  52     folder))
  53
  54 (luna-define-method elmo-folder-open-internal :before ((folder
  55                                                         elmo-shimbun-folder))
  56   (shimbun-open-group
  57    (elmo-shimbun-folder-shimbun-internal folder)
  58    (elmo-shimbun-folder-group-internal folder))
  59   (elmo-shimbun-folder-set-header-hash-internal
  60    folder
  61    (elmo-make-hash (length (shimbun-headers
  62                             (elmo-shimbun-folder-shimbun-internal folder)))))
  63   ;; Set up header hash.
  64   (dolist (header (shimbun-headers (elmo-shimbun-folder-shimbun-internal
  65                                     folder)))
  66     (elmo-set-hash-val
  67      (shimbun-header-id header) header
  68      (elmo-shimbun-folder-header-hash-internal folder))))
  69
  70 (luna-define-method elmo-folder-close-internal :after ((folder
  71                                                         elmo-shimbun-folder))
  72   (shimbun-close-group
  73    (elmo-shimbun-folder-shimbun-internal folder))
  74   (elmo-shimbun-folder-set-header-hash-internal
  75    folder nil))
  76
  77 (luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
  78   (shimbun-close-group
  79    (elmo-shimbun-folder-shimbun-internal folder))
  80   (shimbun-open-group
  81    (elmo-shimbun-folder-shimbun-internal folder)
  82    (elmo-shimbun-folder-group-internal folder)))
  83
  84 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  85                                                     elmo-shimbun-folder))
  86   (expand-file-name
  87    (concat (shimbun-server-internal
  88             (elmo-shimbun-folder-shimbun-internal folder))
  89            "/"
  90            (elmo-shimbun-folder-group-internal folder))
  91    (expand-file-name "shimbun" elmo-msgdb-dir)))
  92
  93 (defun elmo-shimbun-msgdb-create-entity (folder number)
  94   (with-temp-buffer
  95     (shimbun-header-insert
  96      (elmo-get-hash-val
  97       (elmo-map-message-location folder number)
  98       (elmo-shimbun-folder-header-hash-internal folder)))
  99     (elmo-msgdb-create-overview-from-buffer number)))
 100
 101 (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
 102                                               numlist new-mark
 103                                               already-mark seen-mark
 104                                               important-mark
 105                                               seen-list)
 106   (let* (overview number-alist mark-alist entity
 107                   i percent num pair)
 108     (setq num (length numlist))
 109     (setq i 0)
 110     (message "Creating msgdb...")
 111     (while numlist
 112       (setq entity
 113             (elmo-shimbun-msgdb-create-entity
 114              folder (car numlist)))
 115       (when entity
 116         (setq overview
 117               (elmo-msgdb-append-element
 118                overview entity))
 119         (setq number-alist
 120               (elmo-msgdb-number-add number-alist
 121                                      (elmo-msgdb-overview-entity-get-number
 122                                       entity)
 123                                      (elmo-msgdb-overview-entity-get-id
 124                                       entity)))
 125         (setq mark-alist
 126               (elmo-msgdb-mark-append
 127                mark-alist
 128                (elmo-msgdb-overview-entity-get-number
 129                 entity)
 130                (or (elmo-msgdb-global-mark-get
 131                     (elmo-msgdb-overview-entity-get-id
 132                      entity))
 133                    new-mark))))
 134       (when (> num elmo-display-progress-threshold)
 135         (setq i (1+ i))
 136         (setq percent (/ (* i 100) num))
 137         (elmo-display-progress
 138          'elmo-folder-msgdb-create "Creating msgdb..."
 139          percent))
 140       (setq numlist (cdr numlist)))
 141     (message "Creating msgdb...done.")
 142     (elmo-msgdb-sort-by-date
 143      (list overview number-alist mark-alist))))
 144
 145 (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
 146   nil)
 147
 148 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
 149                                             location strategy &optional
 150                                             section outbuf unseen)
 151   (if outbuf
 152       (with-current-buffer outbuf
 153         (erase-buffer)
 154         (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
 155                          (elmo-get-hash-val
 156                           location
 157                           (elmo-shimbun-folder-header-hash-internal folder)))
 158         t)
 159     (with-temp-buffer
 160       (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
 161                        (elmo-get-hash-val
 162                         location
 163                         (elmo-shimbun-folder-header-hash-internal folder)))
 164       (buffer-string))))
 165
 166 (luna-define-method elmo-map-folder-list-message-locations
 167   ((folder elmo-shimbun-folder))
 168   (mapcar
 169    (function shimbun-header-id)
 170    (shimbun-headers (elmo-shimbun-folder-shimbun-internal folder))))
 171
 172 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
 173                                                  &optional one-level)
 174   (unless (elmo-shimbun-folder-group-internal folder)
 175     (mapcar
 176      (lambda (x)
 177        (concat (elmo-folder-prefix-internal folder)
 178                (shimbun-server-internal
 179                 (elmo-shimbun-folder-shimbun-internal folder))
 180                "."
 181                x))
 182      (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal folder)))))
 183
 184 (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
 185   (if (elmo-shimbun-folder-group-internal folder)
 186       (progn
 187         (member
 188          (elmo-shimbun-folder-group-internal folder)
 189          (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal
 190                                    folder))))
 191     t))
 192
 193 (luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
 194                                         condition &optional from-msgs)
 195   nil)
 196
 197 ;;; To override elmo-map-folder methods.
 198 (luna-define-method elmo-folder-list-unreads-internal
 199   ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
 200   t)
 201
 202 (luna-define-method elmo-folder-list-importants-internal
 203   ((folder elmo-shimbun-folder) important-mark)
 204   t)
 205
 206 (luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
 207                                                   numbers)
 208   t)
 209
 210 (luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
 211                                                    numbers)
 212   t)
 213
 214 (luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
 215                                              numbers)
 216   t)
 217
 218 (luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
 219                                               numbers)
 220   t)
 221
 222 (require 'product)
 223 (product-provide (provide 'elmo-shimbun) (require 'elmo-version))
 224
 225 ;;; elmo-shimbun.el ends here