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 headers 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 (if (string-match "\\([^.]+\\)\\." name)
  44                           (list (elmo-match-string 1 name)
  45                                 (substring name (match-end 0)))
  46                         (list name))))
  47     (if (nth 0 server-group) ; server
  48         (elmo-shimbun-folder-set-shimbun-internal
  49          folder
  50          (shimbun-open (nth 0 server-group))))
  51     (if (nth 1 server-group)
  52         (elmo-shimbun-folder-set-group-internal
  53          folder
  54          (nth 1 server-group)))
  55     folder))
  56
  57 (luna-define-method elmo-folder-open-internal :before ((folder
  58                                                         elmo-shimbun-folder))
  59   (when (elmo-folder-plugged-p folder)
  60     (shimbun-open-group
  61      (elmo-shimbun-folder-shimbun-internal folder)
  62      (elmo-shimbun-folder-group-internal folder))
  63     (elmo-shimbun-folder-set-headers-internal
  64      folder (shimbun-headers
  65              (elmo-shimbun-folder-shimbun-internal folder)))
  66     (elmo-shimbun-folder-set-header-hash-internal
  67      folder
  68      (elmo-make-hash (length (elmo-shimbun-folder-headers-internal folder))))
  69     ;; Set up header hash.
  70     (dolist (header (elmo-shimbun-folder-headers-internal folder))
  71       (elmo-set-hash-val
  72        (shimbun-header-id header) header
  73        (elmo-shimbun-folder-header-hash-internal folder)))))
  74
  75 (luna-define-method elmo-folder-close-internal :after ((folder
  76                                                         elmo-shimbun-folder))
  77   (shimbun-close-group
  78    (elmo-shimbun-folder-shimbun-internal folder))
  79   (elmo-shimbun-folder-set-headers-internal
  80    folder nil)
  81   (elmo-shimbun-folder-set-header-hash-internal
  82    folder nil))
  83
  84 (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
  85   (elmo-plugged-p
  86    "shimbun"
  87    (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))
  88    nil nil
  89    (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))
  90
  91 (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
  92                                              plugged &optional add)
  93   (elmo-set-plugged plugged
  94                     "shimbun"
  95                     (shimbun-server-internal
  96                      (elmo-shimbun-folder-shimbun-internal folder))
  97                     nil nil nil
  98                     (shimbun-server-internal
  99                      (elmo-shimbun-folder-shimbun-internal folder))
 100                     add))
 101
 102 (luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
 103   (when (shimbun-current-group-internal
 104          (elmo-shimbun-folder-shimbun-internal folder))
 105     ;; Discard current headers information.
 106     (elmo-folder-close-internal folder)
 107     (elmo-folder-open-internal folder)))
 108
 109 (luna-define-method elmo-folder-expand-msgdb-path ((folder
 110                                                     elmo-shimbun-folder))
 111   (expand-file-name
 112    (concat (shimbun-server-internal
 113             (elmo-shimbun-folder-shimbun-internal folder))
 114            "/"
 115            (elmo-shimbun-folder-group-internal folder))
 116    (expand-file-name "shimbun" elmo-msgdb-dir)))
 117
 118 (defun elmo-shimbun-msgdb-create-entity (folder number)
 119   (let ((header (elmo-get-hash-val
 120                  (elmo-map-message-location folder number)
 121                  (elmo-shimbun-folder-header-hash-internal folder))))
 122     (when header
 123       (with-temp-buffer
 124         (shimbun-header-insert header)
 125         (elmo-msgdb-create-overview-from-buffer number)))))
 126
 127 (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
 128                                               numlist new-mark
 129                                               already-mark seen-mark
 130                                               important-mark
 131                                               seen-list)
 132   (let* (overview number-alist mark-alist entity
 133                   i percent num pair)
 134     (setq num (length numlist))
 135     (setq i 0)
 136     (message "Creating msgdb...")
 137     (while numlist
 138       (setq entity
 139             (elmo-shimbun-msgdb-create-entity
 140              folder (car numlist)))
 141       (when entity
 142         (setq overview
 143               (elmo-msgdb-append-element
 144                overview entity))
 145         (setq number-alist
 146               (elmo-msgdb-number-add number-alist
 147                                      (elmo-msgdb-overview-entity-get-number
 148                                       entity)
 149                                      (elmo-msgdb-overview-entity-get-id
 150                                       entity)))
 151         (setq mark-alist
 152               (elmo-msgdb-mark-append
 153                mark-alist
 154                (elmo-msgdb-overview-entity-get-number
 155                 entity)
 156                (or (elmo-msgdb-global-mark-get
 157                     (elmo-msgdb-overview-entity-get-id
 158                      entity))
 159                    new-mark))))
 160       (when (> num elmo-display-progress-threshold)
 161         (setq i (1+ i))
 162         (setq percent (/ (* i 100) num))
 163         (elmo-display-progress
 164          'elmo-folder-msgdb-create "Creating msgdb..."
 165          percent))
 166       (setq numlist (cdr numlist)))
 167     (message "Creating msgdb...done.")
 168     (elmo-msgdb-sort-by-date
 169      (list overview number-alist mark-alist))))
 170
 171 (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
 172   nil)
 173
 174 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
 175                                             location strategy &optional
 176                                             section outbuf unseen)
 177   (if outbuf
 178       (with-current-buffer outbuf
 179         (erase-buffer)
 180         (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
 181                          (elmo-get-hash-val
 182                           location
 183                           (elmo-shimbun-folder-header-hash-internal folder)))
 184         t)
 185     (with-temp-buffer
 186       (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
 187                        (elmo-get-hash-val
 188                         location
 189                         (elmo-shimbun-folder-header-hash-internal folder)))
 190       (buffer-string))))
 191
 192 (luna-define-method elmo-folder-list-messages-internal :around
 193   ((folder elmo-shimbun-folder) &optional nohide)
 194   (if (elmo-folder-plugged-p folder)
 195       (luna-call-next-method)
 196     t))
 197
 198 (luna-define-method elmo-map-folder-list-message-locations
 199   ((folder elmo-shimbun-folder))
 200   (mapcar
 201    (function shimbun-header-id)
 202    (elmo-shimbun-folder-headers-internal folder)))
 203
 204 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
 205                                                  &optional one-level)
 206   (unless (elmo-shimbun-folder-group-internal folder)
 207     (mapcar
 208      (lambda (x)
 209        (concat (elmo-folder-prefix-internal folder)
 210                (shimbun-server-internal
 211                 (elmo-shimbun-folder-shimbun-internal folder))
 212                "."
 213                x))
 214      (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal folder)))))
 215
 216 (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
 217   (if (elmo-shimbun-folder-group-internal folder)
 218       (progn
 219         (member
 220          (elmo-shimbun-folder-group-internal folder)
 221          (shimbun-groups-internal (elmo-shimbun-folder-shimbun-internal
 222                                    folder))))
 223     t))
 224
 225 (luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
 226                                         condition &optional from-msgs)
 227   nil)
 228
 229 ;;; To override elmo-map-folder methods.
 230 (luna-define-method elmo-folder-list-unreads-internal
 231   ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
 232   t)
 233
 234 (luna-define-method elmo-folder-list-importants-internal
 235   ((folder elmo-shimbun-folder) important-mark)
 236   t)
 237
 238 (luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
 239                                                   numbers)
 240   t)
 241
 242 (luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
 243                                                    numbers)
 244   t)
 245
 246 (luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
 247                                              numbers)
 248   t)
 249
 250 (luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
 251                                               numbers)
 252   t)
 253
 254 (require 'product)
 255 (product-provide (provide 'elmo-shimbun) (require 'elmo-version))
 256
 257 ;;; elmo-shimbun.el ends here