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 (defcustom elmo-shimbun-check-interval 60
  36   "*Check interval for shimbun."
  37   :type 'integer
  38   :group 'elmo)
  39
  40 ;; Internal variable.
  41 ;; A list of elements like:
  42 ;; ("server.group" . [header-list header-hash last-check]).
  43 (defvar elmo-shimbun-headers-cache nil)
  44
  45 (eval-and-compile
  46   (luna-define-class elmo-shimbun-folder
  47                      (elmo-map-folder) (shimbun headers header-hash group))
  48   (luna-define-internal-accessors 'elmo-shimbun-folder))
  49
  50 (defsubst elmo-shimbun-headers-cache-header-list (entry)
  51   (aref entry 0))
  52
  53 (defsubst elmo-shimbun-headers-cache-set-header-list (entry list)
  54   (aset entry 0 list))
  55
  56 (defsubst elmo-shimbun-headers-cache-header-hash (entry)
  57   (aref entry 1))
  58
  59 (defsubst elmo-shimbun-headers-cache-set-header-hash (entry hash)
  60   (aset entry 1 hash))
  61
  62 (defsubst elmo-shimbun-headers-cache-last-check (entry)
  63   (aref entry 2))
  64
  65 (defsubst elmo-shimbun-headers-cache-set-last-check (entry time)
  66   (aset entry 2 time))
  67
  68 (defsubst elmo-shimbun-lapse-seconds (time)
  69   (let ((now (current-time)))
  70     (+ (* (- (car now) (car time)) 65536)
  71        (- (nth 1 now) (nth 1 time)))))
  72
  73 (defsubst elmo-shimbun-headers-cache-check-p (cache)
  74   (or (null (elmo-shimbun-headers-cache-last-check cache))
  75       (and (elmo-shimbun-headers-cache-last-check cache)
  76            (> (elmo-shimbun-lapse-seconds
  77                (elmo-shimbun-headers-cache-last-check cache))
  78               elmo-shimbun-check-interval))))
  79
  80 (defun elmo-shimbun-get-headers (folder)
  81   (shimbun-open-group
  82    (elmo-shimbun-folder-shimbun-internal folder)
  83    (elmo-shimbun-folder-group-internal folder))
  84   (let* ((shimbun (elmo-shimbun-folder-shimbun-internal folder))
  85          (key (concat (shimbun-server-internal shimbun)
  86                       "." (shimbun-current-group-internal shimbun)))
  87          (elmo-hash-minimum-size 0)
  88          entry headers hash done)
  89     (if (setq entry (cdr (assoc key elmo-shimbun-headers-cache)))
  90         (unless (elmo-shimbun-headers-cache-check-p entry)
  91           (elmo-shimbun-folder-set-headers-internal
  92            folder
  93            (elmo-shimbun-headers-cache-header-list entry))
  94           (elmo-shimbun-folder-set-header-hash-internal
  95            folder
  96            (elmo-shimbun-headers-cache-header-hash entry))
  97           (elmo-shimbun-headers-cache-header-list entry)
  98           (setq done t)))
  99     (unless done
 100       (setq headers
 101             (elmo-shimbun-folder-set-headers-internal
 102              folder (shimbun-headers
 103                      (elmo-shimbun-folder-shimbun-internal folder))))
 104       (setq hash
 105             (elmo-shimbun-folder-set-header-hash-internal
 106              folder
 107              (elmo-make-hash
 108               (length (elmo-shimbun-folder-headers-internal folder)))))
 109       ;; Set up header hash.
 110       (dolist (header (elmo-shimbun-folder-headers-internal folder))
 111         (elmo-set-hash-val
 112          (shimbun-header-id header) header
 113          (elmo-shimbun-folder-header-hash-internal folder)))
 114       (if entry
 115           (progn
 116             (elmo-shimbun-headers-cache-set-header-list entry headers)
 117             (elmo-shimbun-headers-cache-set-header-hash entry hash)
 118             (elmo-shimbun-headers-cache-set-last-check entry (current-time)))
 119         (setq elmo-shimbun-headers-cache
 120               (cons (cons key (vector headers hash (current-time)))
 121                     elmo-shimbun-headers-cache))))))
 122
 123 (luna-define-method elmo-folder-initialize ((folder
 124                                              elmo-shimbun-folder)
 125                                             name)
 126   (let ((server-group (if (string-match "\\([^.]+\\)\\." name)
 127                           (list (elmo-match-string 1 name)
 128                                 (substring name (match-end 0)))
 129                         (list name))))
 130     (if (nth 0 server-group) ; server
 131         (elmo-shimbun-folder-set-shimbun-internal
 132          folder
 133          (shimbun-open (nth 0 server-group))))
 134     (if (nth 1 server-group)
 135         (elmo-shimbun-folder-set-group-internal
 136          folder
 137          (nth 1 server-group)))
 138     folder))
 139
 140 (luna-define-method elmo-folder-open-internal :before ((folder
 141                                                         elmo-shimbun-folder))
 142   (when (elmo-folder-plugged-p folder)
 143     (elmo-shimbun-get-headers folder)))
 144
 145 (luna-define-method elmo-folder-close-internal :after ((folder
 146                                                         elmo-shimbun-folder))
 147   (shimbun-close-group
 148    (elmo-shimbun-folder-shimbun-internal folder))
 149   (elmo-shimbun-folder-set-headers-internal
 150    folder nil)
 151   (elmo-shimbun-folder-set-header-hash-internal
 152    folder nil))
 153
 154 (luna-define-method elmo-folder-plugged-p ((folder elmo-shimbun-folder))
 155   (elmo-plugged-p
 156    "shimbun"
 157    (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))
 158    nil nil
 159    (shimbun-server-internal (elmo-shimbun-folder-shimbun-internal folder))))
 160
 161 (luna-define-method elmo-folder-set-plugged ((folder elmo-shimbun-folder)
 162                                              plugged &optional add)
 163   (elmo-set-plugged plugged
 164                     "shimbun"
 165                     (shimbun-server-internal
 166                      (elmo-shimbun-folder-shimbun-internal folder))
 167                     nil nil nil
 168                     (shimbun-server-internal
 169                      (elmo-shimbun-folder-shimbun-internal folder))
 170                     add))
 171
 172 (luna-define-method elmo-folder-check :after ((folder elmo-shimbun-folder))
 173   (when (shimbun-current-group-internal
 174          (elmo-shimbun-folder-shimbun-internal folder))
 175     ;; Discard current headers information.
 176     (elmo-folder-close-internal folder)
 177     (elmo-folder-open-internal folder)))
 178
 179 (luna-define-method elmo-folder-expand-msgdb-path ((folder
 180                                                     elmo-shimbun-folder))
 181   (expand-file-name
 182    (concat (shimbun-server-internal
 183             (elmo-shimbun-folder-shimbun-internal folder))
 184            "/"
 185            (elmo-shimbun-folder-group-internal folder))
 186    (expand-file-name "shimbun" elmo-msgdb-dir)))
 187
 188 (defun elmo-shimbun-msgdb-create-entity (folder number)
 189   (let ((header (elmo-get-hash-val
 190                  (elmo-map-message-location folder number)
 191                  (elmo-shimbun-folder-header-hash-internal folder))))
 192     (when header
 193       (with-temp-buffer
 194         (shimbun-header-insert
 195          (elmo-shimbun-folder-shimbun-internal folder)
 196          header)
 197         (elmo-msgdb-create-overview-from-buffer number)))))
 198
 199 (luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
 200                                               numlist new-mark
 201                                               already-mark seen-mark
 202                                               important-mark
 203                                               seen-list)
 204   (let* (overview number-alist mark-alist entity
 205                   i percent num pair)
 206     (setq num (length numlist))
 207     (setq i 0)
 208     (message "Creating msgdb...")
 209     (while numlist
 210       (setq entity
 211             (elmo-shimbun-msgdb-create-entity
 212              folder (car numlist)))
 213       (when entity
 214         (setq overview
 215               (elmo-msgdb-append-element
 216                overview entity))
 217         (setq number-alist
 218               (elmo-msgdb-number-add number-alist
 219                                      (elmo-msgdb-overview-entity-get-number
 220                                       entity)
 221                                      (elmo-msgdb-overview-entity-get-id
 222                                       entity)))
 223         (setq mark-alist
 224               (elmo-msgdb-mark-append
 225                mark-alist
 226                (elmo-msgdb-overview-entity-get-number
 227                 entity)
 228                (or (elmo-msgdb-global-mark-get
 229                     (elmo-msgdb-overview-entity-get-id
 230                      entity))
 231                    new-mark))))
 232       (when (> num elmo-display-progress-threshold)
 233         (setq i (1+ i))
 234         (setq percent (/ (* i 100) num))
 235         (elmo-display-progress
 236          'elmo-folder-msgdb-create "Creating msgdb..."
 237          percent))
 238       (setq numlist (cdr numlist)))
 239     (message "Creating msgdb...done.")
 240     (elmo-msgdb-sort-by-date
 241      (list overview number-alist mark-alist))))
 242
 243 (luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
 244   nil)
 245
 246 (luna-define-method elmo-map-message-fetch ((folder elmo-shimbun-folder)
 247                                             location strategy
 248                                             &optional section unseen)
 249   (shimbun-article (elmo-shimbun-folder-shimbun-internal folder)
 250                    (elmo-get-hash-val
 251                     location
 252                     (elmo-shimbun-folder-header-hash-internal folder))))
 253
 254 (luna-define-method elmo-folder-list-messages-internal :around
 255   ((folder elmo-shimbun-folder) &optional nohide)
 256   (if (elmo-folder-plugged-p folder)
 257       (luna-call-next-method)
 258     t))
 259
 260 (luna-define-method elmo-map-folder-list-message-locations
 261   ((folder elmo-shimbun-folder))
 262   (mapcar
 263    (function shimbun-header-id)
 264    (elmo-shimbun-folder-headers-internal folder)))
 265
 266 (luna-define-method elmo-folder-list-subfolders ((folder elmo-shimbun-folder)
 267                                                  &optional one-level)
 268   (unless (elmo-shimbun-folder-group-internal folder)
 269     (mapcar
 270      (lambda (x)
 271        (concat (elmo-folder-prefix-internal folder)
 272                (shimbun-server-internal
 273                 (elmo-shimbun-folder-shimbun-internal folder))
 274                "."
 275                x))
 276      (shimbun-groups (elmo-shimbun-folder-shimbun-internal folder)))))
 277
 278 (luna-define-method elmo-folder-exists-p ((folder elmo-shimbun-folder))
 279   (if (elmo-shimbun-folder-group-internal folder)
 280       (progn
 281         (member
 282          (elmo-shimbun-folder-group-internal folder)
 283          (shimbun-groups (elmo-shimbun-folder-shimbun-internal
 284                           folder))))
 285     t))
 286
 287 (luna-define-method elmo-folder-search ((folder elmo-shimbun-folder)
 288                                         condition &optional from-msgs)
 289   nil)
 290
 291 ;;; To override elmo-map-folder methods.
 292 (luna-define-method elmo-folder-list-unreads-internal
 293   ((folder elmo-shimbun-folder) unread-marks &optional mark-alist)
 294   t)
 295
 296 (luna-define-method elmo-folder-unmark-important ((folder elmo-shimbun-folder)
 297                                                   numbers)
 298   t)
 299
 300 (luna-define-method elmo-folder-mark-as-important ((folder elmo-shimbun-folder)
 301                                                    numbers)
 302   t)
 303
 304 (luna-define-method elmo-folder-unmark-read ((folder elmo-shimbun-folder)
 305                                              numbers)
 306   t)
 307
 308 (luna-define-method elmo-folder-mark-as-read ((folder elmo-shimbun-folder)
 309                                               numbers)
 310   t)
 311
 312 (luna-define-method elmo-quit ((folder elmo-shimbun-folder))
 313   (setq elmo-shimbun-headers-cache nil))
 314
 315 (require 'product)
 316 (product-provide (provide 'elmo-shimbun) (require 'elmo-version))
 317
 318 ;;; elmo-shimbun.el ends here