← Back to branch summary

~ubuntu-branches/ubuntu/saucy/wl/saucy-proposed

« back to all changes in this revision

Viewing changes to elmo/elmo-nntp.el

  • Committer: Bazaar Package Importer
  • Author(s): Takuo KITAME
  • Date: 2002-02-20 21:51:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020220215116-htmbfdwsdr25nnhm
Tags: upstream-2.8.1
Import upstream version 2.8.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
elmo/elmo-nntp.el
 
1
;;; elmo-nntp.el --- NNTP Interface for ELMO.
 
2
 
 
3
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
4
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
 
5
;; Copyright (C) 1999,2000      Kenichi OKADA <okada@opaopa.org>
 
6
 
 
7
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 
8
;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
 
9
;;      Kenichi OKADA <okada@opaopa.org>
 
10
;; Keywords: mail, net news
 
11
 
 
12
;; This file is part of ELMO (Elisp Library for Message Orchestration).
 
13
 
 
14
;; This program is free software; you can redistribute it and/or modify
 
15
;; it under the terms of the GNU General Public License as published by
 
16
;; the Free Software Foundation; either version 2, or (at your option)
 
17
;; any later version.
 
18
;;
 
19
;; This program is distributed in the hope that it will be useful,
 
20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
21
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
22
;; GNU General Public License for more details.
 
23
;;
 
24
;; You should have received a copy of the GNU General Public License
 
25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
26
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 
27
;; Boston, MA 02111-1307, USA.
 
28
;;
 
29
 
 
30
;;; Commentary:
 
31
;;
 
32
 
 
33
;;; Code:
 
34
;;
 
35
 
 
36
(require 'elmo-vars)
 
37
(require 'elmo-util)
 
38
(require 'elmo-date)
 
39
(require 'elmo-msgdb)
 
40
(require 'elmo-cache)
 
41
(require 'elmo)
 
42
(require 'elmo-net)
 
43
 
 
44
(defvar elmo-nntp-overview-fetch-chop-length 200
 
45
 "*Number of overviews to fetch in one request in nntp.")
 
46
 
 
47
(defvar elmo-nntp-use-cache t
 
48
  "Use cache in nntp folder.")
 
49
 
 
50
(defvar elmo-nntp-max-number-precedes-list-active nil
 
51
  "Non-nil means max number of msgdb is set as the max number of `list active'.
 
52
(Needed for inn 2.3 or later?).")
 
53
 
 
54
(defvar elmo-nntp-group-coding-system nil
 
55
  "A coding system for newsgroup string.")
 
56
 
 
57
(defsubst elmo-nntp-encode-group-string (string)
 
58
  (if elmo-nntp-group-coding-system
 
59
      (encode-coding-string string elmo-nntp-group-coding-system)
 
60
    string))
 
61
 
 
62
(defsubst elmo-nntp-decode-group-string (string)
 
63
  (if elmo-nntp-group-coding-system
 
64
      (decode-coding-string string elmo-nntp-group-coding-system)
 
65
    string))
 
66
 
 
67
;;; ELMO NNTP folder
 
68
(eval-and-compile
 
69
  (luna-define-class elmo-nntp-folder (elmo-net-folder)
 
70
                     (group temp-crosses reads))
 
71
  (luna-define-internal-accessors 'elmo-nntp-folder))
 
72
 
 
73
(luna-define-method elmo-folder-initialize :around ((folder
 
74
                                                     elmo-nntp-folder)
 
75
                                                    name)
 
76
  (let ((elmo-network-stream-type-alist
 
77
         (if elmo-nntp-stream-type-alist
 
78
             (setq elmo-network-stream-type-alist
 
79
                   (append elmo-nntp-stream-type-alist
 
80
                           elmo-network-stream-type-alist))
 
81
           elmo-network-stream-type-alist))
 
82
        parse)
 
83
    (setq name (luna-call-next-method))
 
84
    (setq parse (elmo-parse-token name ":"))
 
85
    (elmo-nntp-folder-set-group-internal folder
 
86
                                         (elmo-nntp-encode-group-string
 
87
                                          (car parse)))
 
88
    (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
 
89
    (elmo-net-folder-set-user-internal folder
 
90
                                       (if (eq (length (car parse)) 0)
 
91
                                           elmo-nntp-default-user
 
92
                                         (car parse)))
 
93
    (unless (elmo-net-folder-server-internal folder)
 
94
      (elmo-net-folder-set-server-internal folder
 
95
                                           elmo-nntp-default-server))
 
96
    (unless (elmo-net-folder-port-internal folder)
 
97
      (elmo-net-folder-set-port-internal folder
 
98
                                         elmo-nntp-default-port))
 
99
    (unless (elmo-net-folder-stream-type-internal folder)
 
100
      (elmo-net-folder-set-stream-type-internal
 
101
       folder
 
102
       (elmo-get-network-stream-type
 
103
        elmo-nntp-default-stream-type)))
 
104
    folder))
 
105
 
 
106
(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
 
107
  (convert-standard-filename
 
108
   (expand-file-name
 
109
    (elmo-nntp-folder-group-internal folder)
 
110
    (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere")
 
111
                      (expand-file-name "nntp"
 
112
                                        elmo-msgdb-directory)))))
 
113
 
 
114
(luna-define-method elmo-folder-newsgroups ((folder elmo-nntp-folder))
 
115
  (list (elmo-nntp-folder-group-internal folder)))
 
116
 
 
117
;;; NNTP Session
 
118
(eval-and-compile
 
119
  (luna-define-class elmo-nntp-session (elmo-network-session)
 
120
                     (current-group))
 
121
  (luna-define-internal-accessors 'elmo-nntp-session))
 
122
 
 
123
;;
 
124
;; internal variables
 
125
;;
 
126
 
 
127
(defvar elmo-nntp-connection-cache nil
 
128
  "Cache of NNTP connection.")
 
129
;; buffer local variable
 
130
 
 
131
(defvar elmo-nntp-list-folders-use-cache 600
 
132
  "*Time to cache of list folders, as the number of seconds.
 
133
Don't cache if nil.")
 
134
 
 
135
(defvar elmo-nntp-list-folders-cache nil)
 
136
 
 
137
(defvar elmo-nntp-groups-async nil)
 
138
(defvar elmo-nntp-header-fetch-chop-length 200)
 
139
 
 
140
(defvar elmo-nntp-read-point 0)
 
141
 
 
142
(defvar elmo-nntp-send-mode-reader t)
 
143
 
 
144
(defvar elmo-nntp-opened-hook nil)
 
145
 
 
146
(defvar elmo-nntp-get-folders-securely nil)
 
147
 
 
148
(defvar elmo-nntp-default-use-xover t)
 
149
 
 
150
(defvar elmo-nntp-default-use-listgroup t)
 
151
 
 
152
(defvar elmo-nntp-default-use-list-active t)
 
153
 
 
154
(defvar elmo-nntp-default-use-xhdr t)
 
155
 
 
156
(defvar elmo-nntp-server-command-alist nil)
 
157
 
 
158
 
 
159
(defconst elmo-nntp-server-command-index '((xover . 0)
 
160
                                           (listgroup . 1)
 
161
                                           (list-active . 2)))
 
162
 
 
163
(defmacro elmo-nntp-get-server-command (session)
 
164
  (` (assoc (cons (elmo-network-session-server-internal (, session))
 
165
                  (elmo-network-session-port-internal (, session)))
 
166
            elmo-nntp-server-command-alist)))
 
167
 
 
168
(defmacro elmo-nntp-set-server-command (session com value)
 
169
  (` (let (entry)
 
170
       (unless (setq entry (cdr (elmo-nntp-get-server-command
 
171
                                 (, session))))
 
172
         (setq elmo-nntp-server-command-alist
 
173
               (nconc elmo-nntp-server-command-alist
 
174
                      (list (cons
 
175
                             (cons
 
176
                              (elmo-network-session-server-internal (, session))
 
177
                              (elmo-network-session-port-internal (, session)))
 
178
                             (setq entry
 
179
                                   (vector
 
180
                                    elmo-nntp-default-use-xover
 
181
                                    elmo-nntp-default-use-listgroup
 
182
                                    elmo-nntp-default-use-list-active
 
183
                                    elmo-nntp-default-use-xhdr)))))))
 
184
       (aset entry
 
185
             (cdr (assq (, com) elmo-nntp-server-command-index))
 
186
             (, value)))))
 
187
 
 
188
(defmacro elmo-nntp-xover-p (session)
 
189
  (` (let ((entry (elmo-nntp-get-server-command (, session))))
 
190
       (if entry
 
191
           (aref (cdr entry)
 
192
                 (cdr (assq 'xover elmo-nntp-server-command-index)))
 
193
         elmo-nntp-default-use-xover))))
 
194
 
 
195
(defmacro elmo-nntp-set-xover (session value)
 
196
  (` (elmo-nntp-set-server-command (, session) 'xover (, value))))
 
197
 
 
198
(defmacro elmo-nntp-listgroup-p (session)
 
199
  (` (let ((entry (elmo-nntp-get-server-command (, session))))
 
200
       (if entry
 
201
           (aref (cdr entry)
 
202
                 (cdr (assq 'listgroup elmo-nntp-server-command-index)))
 
203
         elmo-nntp-default-use-listgroup))))
 
204
 
 
205
(defmacro elmo-nntp-set-listgroup (session value)
 
206
  (` (elmo-nntp-set-server-command (, session) 'listgroup (, value))))
 
207
 
 
208
(defmacro elmo-nntp-list-active-p (session)
 
209
  (` (let ((entry (elmo-nntp-get-server-command (, session))))
 
210
       (if entry
 
211
           (aref (cdr entry)
 
212
                 (cdr (assq 'list-active elmo-nntp-server-command-index)))
 
213
         elmo-nntp-default-use-list-active))))
 
214
 
 
215
(defmacro elmo-nntp-set-list-active (session value)
 
216
  (` (elmo-nntp-set-server-command (, session) 'list-active (, value))))
 
217
 
 
218
(defmacro elmo-nntp-xhdr-p (session)
 
219
  (` (let ((entry (elmo-nntp-get-server-command (, session))))
 
220
       (if entry
 
221
           (aref (cdr entry)
 
222
                 (cdr (assq 'xhdr elmo-nntp-server-command-index)))
 
223
         elmo-nntp-default-use-xhdr))))
 
224
 
 
225
(defmacro elmo-nntp-set-xhdr (session value)
 
226
  (` (elmo-nntp-set-server-command (, session) 'xhdr (, value))))
 
227
 
 
228
(defsubst elmo-nntp-max-number-precedes-list-active-p ()
 
229
  elmo-nntp-max-number-precedes-list-active)
 
230
 
 
231
(defsubst elmo-nntp-folder-postfix (user server port type)
 
232
  (concat
 
233
   (and user (concat ":" user))
 
234
   (if (and server
 
235
            (null (string= server elmo-nntp-default-server)))
 
236
       (concat "@" server))
 
237
   (if (and port
 
238
            (null (eq port elmo-nntp-default-port)))
 
239
       (concat ":" (if (numberp port)
 
240
                       (int-to-string port) port)))
 
241
   (unless (eq (elmo-network-stream-type-symbol type)
 
242
               elmo-nntp-default-stream-type)
 
243
     (elmo-network-stream-type-spec-string type))))
 
244
 
 
245
(defun elmo-nntp-get-session (folder &optional if-exists)
 
246
  (elmo-network-get-session
 
247
   'elmo-nntp-session
 
248
   (concat
 
249
    (if (elmo-folder-biff-internal folder)
 
250
        "BIFF-")
 
251
    "NNTP")
 
252
   folder
 
253
   if-exists))
 
254
 
 
255
(luna-define-method elmo-network-initialize-session ((session
 
256
                                                      elmo-nntp-session))
 
257
  (let ((process (elmo-network-session-process-internal session)))
 
258
    (set-process-filter (elmo-network-session-process-internal session)
 
259
                        'elmo-nntp-process-filter)
 
260
    (with-current-buffer (elmo-network-session-buffer session)
 
261
      (setq elmo-nntp-read-point (point-min))
 
262
      ;; Skip garbage output from process before greeting.
 
263
      (while (and (memq (process-status process) '(open run))
 
264
                  (goto-char (point-max))
 
265
                  (forward-line -1)
 
266
                  (not (looking-at "^[2-5][0-9][0-9]")))
 
267
        (accept-process-output process 1))
 
268
      (setq elmo-nntp-read-point (point))
 
269
      (or (elmo-nntp-read-response session t)
 
270
          (error "Cannot open network"))
 
271
      (if elmo-nntp-send-mode-reader
 
272
          (elmo-nntp-send-mode-reader session))
 
273
      (when (eq (elmo-network-stream-type-symbol
 
274
                 (elmo-network-session-stream-type-internal session))
 
275
                'starttls)
 
276
        (elmo-nntp-send-command session "starttls")
 
277
        (or (elmo-nntp-read-response session)
 
278
            (error "Cannot open starttls session"))
 
279
        (starttls-negotiate process)))))
 
280
 
 
281
(luna-define-method elmo-network-authenticate-session ((session
 
282
                                                        elmo-nntp-session))
 
283
  (with-current-buffer (elmo-network-session-buffer session)
 
284
    (when (elmo-network-session-user-internal session)
 
285
      (elmo-nntp-send-command session
 
286
                              (format "authinfo user %s"
 
287
                                      (elmo-network-session-user-internal
 
288
                                       session)))
 
289
      (or (elmo-nntp-read-response session)
 
290
          (signal 'elmo-authenticate-error '(authinfo)))
 
291
      (elmo-nntp-send-command
 
292
       session
 
293
       (format "authinfo pass %s"
 
294
               (elmo-get-passwd (elmo-network-session-password-key session))))
 
295
      (or (elmo-nntp-read-response session)
 
296
          (signal 'elmo-authenticate-error '(authinfo))))))
 
297
 
 
298
(luna-define-method elmo-network-setup-session ((session
 
299
                                                 elmo-nntp-session))
 
300
  (run-hooks 'elmo-nntp-opened-hook))
 
301
 
 
302
(defun elmo-nntp-process-filter (process output)
 
303
  (save-excursion
 
304
    (set-buffer (process-buffer process))
 
305
    (goto-char (point-max))
 
306
    (insert output)))
 
307
 
 
308
(defun elmo-nntp-send-mode-reader (session)
 
309
  (elmo-nntp-send-command session "mode reader")
 
310
  (if (null (elmo-nntp-read-response session t))
 
311
      (error "Mode reader failed")))
 
312
 
 
313
(defun elmo-nntp-send-command (session command &optional noerase)
 
314
  (with-current-buffer (elmo-network-session-buffer session)
 
315
    (unless noerase
 
316
      (erase-buffer)
 
317
      (goto-char (point-min)))
 
318
    (setq elmo-nntp-read-point (point))
 
319
    (process-send-string (elmo-network-session-process-internal
 
320
                          session) command)
 
321
    (process-send-string (elmo-network-session-process-internal
 
322
                          session) "\r\n")))
 
323
 
 
324
(defun elmo-nntp-read-response (session &optional not-command)
 
325
  (with-current-buffer (elmo-network-session-buffer session)
 
326
    (let ((process (elmo-network-session-process-internal session))
 
327
          (case-fold-search nil)
 
328
          (response-string nil)
 
329
          (response-continue t)
 
330
          response match-end)
 
331
      (while response-continue
 
332
        (goto-char elmo-nntp-read-point)
 
333
        (while (not (search-forward "\r\n" nil t))
 
334
          (accept-process-output process)
 
335
          (goto-char elmo-nntp-read-point))
 
336
        (setq match-end (point))
 
337
        (setq response-string
 
338
              (buffer-substring elmo-nntp-read-point (- match-end 2)))
 
339
        (goto-char elmo-nntp-read-point)
 
340
        (if (looking-at "[234][0-9]+ .*$")
 
341
            (progn (setq response-continue nil)
 
342
                   (setq elmo-nntp-read-point match-end)
 
343
                   (setq response
 
344
                         (if response
 
345
                             (concat response "\n" response-string)
 
346
                           response-string)))
 
347
          (if (looking-at "[^234][0-9]+ .*$")
 
348
              (progn (setq response-continue nil)
 
349
                     (setq elmo-nntp-read-point match-end)
 
350
                     (setq response nil))
 
351
            (setq elmo-nntp-read-point match-end)
 
352
            (if not-command
 
353
                (setq response-continue nil))
 
354
            (setq response
 
355
                  (if response
 
356
                      (concat response "\n" response-string)
 
357
                    response-string)))
 
358
          (setq elmo-nntp-read-point match-end)))
 
359
      response)))
 
360
 
 
361
(defun elmo-nntp-read-raw-response (session)
 
362
  (with-current-buffer (elmo-network-session-buffer session)
 
363
    (goto-char elmo-nntp-read-point)
 
364
    (while (not (search-forward "\r\n" nil t))
 
365
      (accept-process-output (elmo-network-session-process-internal
 
366
                              session))
 
367
      (goto-char elmo-nntp-read-point))
 
368
    (buffer-substring elmo-nntp-read-point (- (point) 2))))
 
369
 
 
370
(defun elmo-nntp-read-contents (session)
 
371
  (with-current-buffer (elmo-network-session-buffer session)
 
372
    (goto-char elmo-nntp-read-point)
 
373
    (while (not (re-search-forward "^\\.\r\n" nil t))
 
374
      (accept-process-output (elmo-network-session-process-internal
 
375
                              session))
 
376
      (goto-char elmo-nntp-read-point))
 
377
    (elmo-delete-cr
 
378
     (buffer-substring elmo-nntp-read-point
 
379
                       (- (point) 3)))))
 
380
 
 
381
(defun elmo-nntp-read-body (session outbuf)
 
382
  (with-current-buffer (elmo-network-session-buffer session)
 
383
    (goto-char elmo-nntp-read-point)
 
384
    (while (not (re-search-forward "^\\.\r\n" nil t))
 
385
      (accept-process-output (elmo-network-session-process-internal session))
 
386
      (goto-char elmo-nntp-read-point))
 
387
    (let ((start elmo-nntp-read-point)
 
388
          (end  (point)))
 
389
      (with-current-buffer outbuf
 
390
        (erase-buffer)
 
391
        (insert-buffer-substring (elmo-network-session-buffer session)
 
392
                                 start (- end 3))))
 
393
    t))
 
394
 
 
395
(defun elmo-nntp-select-group (session group &optional force)
 
396
  (let (response)
 
397
    (when (or force
 
398
              (not (string= (elmo-nntp-session-current-group-internal session)
 
399
                            group)))
 
400
      (unwind-protect
 
401
          (progn
 
402
            (elmo-nntp-send-command session (format "group %s" group))
 
403
            (setq response (elmo-nntp-read-response session)))
 
404
        (elmo-nntp-session-set-current-group-internal session
 
405
                                                      (and response group))
 
406
        response))))
 
407
 
 
408
(defun elmo-nntp-list-folders-get-cache (folder buf)
 
409
  (when (and elmo-nntp-list-folders-use-cache
 
410
             elmo-nntp-list-folders-cache
 
411
             (string-match (concat "^"
 
412
                                   (regexp-quote
 
413
                                    (or
 
414
                                     (nth 1 elmo-nntp-list-folders-cache)
 
415
                                     "")))
 
416
                           (or folder "")))
 
417
    (let* ((cache-time (car elmo-nntp-list-folders-cache)))
 
418
      (unless (elmo-time-expire cache-time
 
419
                                elmo-nntp-list-folders-use-cache)
 
420
        (save-excursion
 
421
          (set-buffer buf)
 
422
          (erase-buffer)
 
423
          (insert (nth 2 elmo-nntp-list-folders-cache))
 
424
          (goto-char (point-min))
 
425
          (or (string= folder "")
 
426
              (and folder
 
427
                   (keep-lines (concat "^" (regexp-quote folder) "\\."))))
 
428
          t
 
429
          )))))
 
430
 
 
431
(defsubst elmo-nntp-catchup-msgdb (msgdb max-number)
 
432
  (let (msgdb-max number-alist)
 
433
    (setq number-alist (elmo-msgdb-get-number-alist msgdb))
 
434
    (setq msgdb-max (car (nth (max (- (length number-alist) 1) 0)
 
435
                              number-alist)))
 
436
    (if (or (not msgdb-max)
 
437
            (and msgdb-max max-number
 
438
                 (< msgdb-max max-number)))
 
439
        (elmo-msgdb-set-number-alist
 
440
         msgdb
 
441
         (nconc number-alist (list (cons max-number nil)))))))
 
442
 
 
443
(luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder)
 
444
                                                 &optional one-level)
 
445
  (elmo-nntp-folder-list-subfolders folder one-level))
 
446
 
 
447
(defun elmo-nntp-folder-list-subfolders (folder one-level)
 
448
  (let ((session (elmo-nntp-get-session folder))
 
449
        response ret-val top-ng append-serv use-list-active start)
 
450
    (with-temp-buffer
 
451
      (set-buffer-multibyte nil)
 
452
      (if (and (elmo-nntp-folder-group-internal folder)
 
453
               (elmo-nntp-select-group
 
454
                session
 
455
                (elmo-nntp-folder-group-internal folder)))
 
456
          ;; add top newsgroups
 
457
          (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
 
458
      (unless (setq response (elmo-nntp-list-folders-get-cache
 
459
                              (elmo-nntp-folder-group-internal folder)
 
460
                              (current-buffer)))
 
461
        (when (setq use-list-active (elmo-nntp-list-active-p session))
 
462
          (elmo-nntp-send-command
 
463
           session
 
464
           (concat "list"
 
465
                   (if (and (elmo-nntp-folder-group-internal folder)
 
466
                            (not (string= (elmo-nntp-folder-group-internal
 
467
                                           folder) "")))
 
468
                       (concat " active"
 
469
                               (format " %s.*"
 
470
                                       (elmo-nntp-folder-group-internal folder)
 
471
                                       "")))))
 
472
          (if (elmo-nntp-read-response session t)
 
473
              (if (null (setq response (elmo-nntp-read-contents session)))
 
474
                  (error "NNTP List folders failed")
 
475
                (when elmo-nntp-list-folders-use-cache
 
476
                  (setq elmo-nntp-list-folders-cache
 
477
                        (list (current-time)
 
478
                              (elmo-nntp-folder-group-internal folder)
 
479
                              response)))
 
480
                (erase-buffer)
 
481
                (insert response))
 
482
            (elmo-nntp-set-list-active session nil)
 
483
            (setq use-list-active nil)))
 
484
        (when (null use-list-active)
 
485
          (elmo-nntp-send-command session "list")
 
486
          (if (null (and (elmo-nntp-read-response session t)
 
487
                         (setq response (elmo-nntp-read-contents session))))
 
488
              (error "NNTP List folders failed"))
 
489
          (when elmo-nntp-list-folders-use-cache
 
490
            (setq elmo-nntp-list-folders-cache
 
491
                  (list (current-time) nil response)))
 
492
          (erase-buffer)
 
493
          (setq start nil)
 
494
          (while (string-match (concat "^"
 
495
                                       (regexp-quote
 
496
                                        (or
 
497
                                         (elmo-nntp-folder-group-internal
 
498
                                          folder)
 
499
                                         "")) ".*$")
 
500
                               response start)
 
501
            (insert (match-string 0 response) "\n")
 
502
            (setq start (match-end 0)))))
 
503
      (goto-char (point-min))
 
504
      (let ((len (count-lines (point-min) (point-max)))
 
505
            (i 0) regexp)
 
506
        (if one-level
 
507
            (progn
 
508
              (setq regexp
 
509
                    (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
 
510
                            (if (and
 
511
                                 (elmo-nntp-folder-group-internal folder)
 
512
                                 (null (string=
 
513
                                        (elmo-nntp-folder-group-internal
 
514
                                         folder) "")))
 
515
                                (concat (elmo-nntp-folder-group-internal
 
516
                                         folder)
 
517
                                        "\\.") "")))
 
518
              (while (looking-at regexp)
 
519
                (setq top-ng (elmo-match-buffer 1))
 
520
                (if (string= (elmo-match-buffer 2) " ")
 
521
                    (if (not (or (member top-ng ret-val)
 
522
                                 (assoc top-ng ret-val)))
 
523
                        (setq ret-val (nconc ret-val (list top-ng))))
 
524
                  (if (member top-ng ret-val)
 
525
                      (setq ret-val (delete top-ng ret-val)))
 
526
                  (if (not (assoc top-ng ret-val))
 
527
                      (setq ret-val (nconc ret-val (list (list top-ng))))))
 
528
                (when (> len elmo-display-progress-threshold)
 
529
                  (setq i (1+ i))
 
530
                  (if (or (zerop (% i 10)) (= i len))
 
531
                      (elmo-display-progress
 
532
                       'elmo-nntp-list-folders "Parsing active..."
 
533
                       (/ (* i 100) len))))
 
534
                (forward-line 1)))
 
535
          (while (re-search-forward "\\([^ ]+\\) .*\n" nil t)
 
536
            (setq ret-val (nconc ret-val
 
537
                                 (list (elmo-match-buffer 1))))
 
538
            (when (> len elmo-display-progress-threshold)
 
539
              (setq i (1+ i))
 
540
              (if (or (zerop (% i 10)) (= i len))
 
541
                  (elmo-display-progress
 
542
                   'elmo-nntp-list-folders "Parsing active..."
 
543
                   (/ (* i 100) len))))))
 
544
        (when (> len elmo-display-progress-threshold)
 
545
          (elmo-display-progress
 
546
           'elmo-nntp-list-folders "Parsing active..." 100))))
 
547
    (unless (string= (elmo-net-folder-server-internal folder)
 
548
                     elmo-nntp-default-server)
 
549
      (setq append-serv (concat "@" (elmo-net-folder-server-internal
 
550
                                     folder))))
 
551
    (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
 
552
      (setq append-serv (concat append-serv
 
553
                                ":" (int-to-string
 
554
                                     (elmo-net-folder-port-internal folder)))))
 
555
    (unless (eq (elmo-network-stream-type-symbol
 
556
                 (elmo-net-folder-stream-type-internal folder))
 
557
                elmo-nntp-default-stream-type)
 
558
      (setq append-serv
 
559
            (concat append-serv
 
560
                    (elmo-network-stream-type-spec-string
 
561
                     (elmo-net-folder-stream-type-internal folder)))))
 
562
    (mapcar '(lambda (fld)
 
563
               (if (consp fld)
 
564
                   (list (concat "-" (elmo-nntp-decode-group-string (car fld))
 
565
                                 (and (elmo-net-folder-user-internal folder)
 
566
                                      (concat
 
567
                                       ":"
 
568
                                       (elmo-net-folder-user-internal folder)))
 
569
                                 (and append-serv
 
570
                                      (concat append-serv))))
 
571
                 (concat "-" (elmo-nntp-decode-group-string fld)
 
572
                         (and (elmo-net-folder-user-internal folder)
 
573
                              (concat ":" (elmo-net-folder-user-internal
 
574
                                           folder)))
 
575
                         (and append-serv
 
576
                              (concat append-serv)))))
 
577
            ret-val)))
 
578
 
 
579
(defun elmo-nntp-make-msglist (beg-str end-str)
 
580
  (elmo-set-work-buf
 
581
   (let ((beg-num (string-to-int beg-str))
 
582
         (end-num (string-to-int end-str))
 
583
         i)
 
584
     (setq i beg-num)
 
585
     (insert "(")
 
586
     (while (<= i end-num)
 
587
       (insert (format "%s " i))
 
588
       (setq i (1+ i)))
 
589
     (insert ")")
 
590
     (goto-char (point-min))
 
591
     (read (current-buffer)))))
 
592
 
 
593
(luna-define-method elmo-folder-list-messages-internal ((folder
 
594
                                                         elmo-nntp-folder)
 
595
                                                        &optional nohide)
 
596
  (let ((session (elmo-nntp-get-session folder))
 
597
        (group   (elmo-nntp-folder-group-internal folder))
 
598
        response numbers use-listgroup)
 
599
    (save-excursion
 
600
      (when (setq use-listgroup (elmo-nntp-listgroup-p session))
 
601
        (elmo-nntp-send-command session
 
602
                                (format "listgroup %s" group))
 
603
        (if (not (elmo-nntp-read-response session t))
 
604
            (progn
 
605
              (elmo-nntp-set-listgroup session nil)
 
606
              (setq use-listgroup nil))
 
607
          (if (null (setq response (elmo-nntp-read-contents session)))
 
608
              (error "Fetching listgroup failed"))
 
609
          (setq numbers (elmo-string-to-list response))
 
610
          (elmo-nntp-session-set-current-group-internal session
 
611
                                                        group)))
 
612
      (unless use-listgroup
 
613
        (elmo-nntp-send-command session (format "group %s" group))
 
614
        (if (null (setq response (elmo-nntp-read-response session)))
 
615
            (error "Select group failed"))
 
616
        (when (and
 
617
               (string-match
 
618
                "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
 
619
                response)
 
620
               (> (string-to-int (elmo-match-string 1 response)) 0))
 
621
          (setq numbers (elmo-nntp-make-msglist
 
622
                         (elmo-match-string 2 response)
 
623
                         (elmo-match-string 3 response)))))
 
624
      numbers)))
 
625
 
 
626
(luna-define-method elmo-folder-status ((folder elmo-nntp-folder))
 
627
  (elmo-nntp-folder-status folder))
 
628
 
 
629
(defun elmo-nntp-folder-status (folder)
 
630
  (let ((killed-list (elmo-msgdb-killed-list-load
 
631
                      (elmo-folder-msgdb-path folder)))
 
632
        end-num entry)
 
633
    (if elmo-nntp-groups-async
 
634
        (if (setq entry
 
635
                  (elmo-get-hash-val
 
636
                   (concat (elmo-nntp-folder-group-internal folder)
 
637
                           (elmo-nntp-folder-postfix
 
638
                            (elmo-net-folder-user-internal folder)
 
639
                            (elmo-net-folder-server-internal folder)
 
640
                            (elmo-net-folder-port-internal folder)
 
641
                            (elmo-net-folder-stream-type-internal folder)))
 
642
                   elmo-newsgroups-hashtb))
 
643
            (progn
 
644
              (setq end-num (nth 2 entry))
 
645
              (when (and killed-list
 
646
                         (elmo-number-set-member end-num killed-list))
 
647
                ;; Max is killed.
 
648
                (setq end-num nil))
 
649
              (cons end-num (car entry)))
 
650
          (error "No such newsgroup \"%s\""
 
651
                 (elmo-nntp-folder-group-internal folder)))
 
652
      (let ((session (elmo-nntp-get-session folder))
 
653
            response e-num)
 
654
        (if (null session)
 
655
            (error "Connection failed"))
 
656
        (save-excursion
 
657
          (elmo-nntp-send-command session
 
658
                                  (format
 
659
                                   "group %s"
 
660
                                   (elmo-nntp-folder-group-internal folder)))
 
661
          (setq response (elmo-nntp-read-response session))
 
662
          (if (and response
 
663
                   (string-match
 
664
                    "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
 
665
                    response))
 
666
              (progn
 
667
                (setq end-num (string-to-int
 
668
                               (elmo-match-string 3 response)))
 
669
                (setq e-num (string-to-int
 
670
                             (elmo-match-string 1 response)))
 
671
                (when (and killed-list
 
672
                           (elmo-number-set-member end-num killed-list))
 
673
                  ;; Max is killed.
 
674
                  (setq end-num nil))
 
675
                (cons end-num e-num))
 
676
            (if (null response)
 
677
                (error "Selecting newsgroup \"%s\" failed"
 
678
                       (elmo-nntp-folder-group-internal folder))
 
679
              nil)))))))
 
680
 
 
681
(defconst elmo-nntp-overview-index
 
682
  '(("number" . 0)
 
683
    ("subject" . 1)
 
684
    ("from" . 2)
 
685
    ("date" . 3)
 
686
    ("message-id" . 4)
 
687
    ("references" . 5)
 
688
    ("size" . 6)
 
689
    ("lines" . 7)
 
690
    ("xref" . 8)))
 
691
 
 
692
(defun elmo-nntp-create-msgdb-from-overview-string (str
 
693
                                                    new-mark
 
694
                                                    already-mark
 
695
                                                    seen-mark
 
696
                                                    important-mark
 
697
                                                    seen-list
 
698
                                                    &optional numlist)
 
699
  (let (ov-list gmark message-id seen
 
700
        ov-entity overview number-alist mark-alist num
 
701
        extras extra ext field field-index)
 
702
    (setq ov-list (elmo-nntp-parse-overview-string str))
 
703
    (while ov-list
 
704
      (setq ov-entity (car ov-list))
 
705
;;; INN bug??
 
706
;;;   (if (or (> (setq num (string-to-int (aref ov-entity 0)))
 
707
;;;              99999)
 
708
;;;           (<= num 0))
 
709
;;;       (setq num 0))
 
710
;;;  (setq num (int-to-string num))
 
711
      (setq num (string-to-int (aref ov-entity 0)))
 
712
      (when (or (null numlist)
 
713
                (memq num numlist))
 
714
        (setq extras elmo-msgdb-extra-fields
 
715
              extra nil)
 
716
        (while extras
 
717
          (setq ext (downcase (car extras)))
 
718
          (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
 
719
            (when (> (length ov-entity) field-index)
 
720
              (setq field (aref ov-entity field-index))
 
721
              (when (eq field-index 8) ;; xref
 
722
                (setq field (elmo-msgdb-remove-field-string field)))
 
723
              (setq extra (cons (cons ext field) extra))))
 
724
          (setq extras (cdr extras)))
 
725
        (setq overview
 
726
              (elmo-msgdb-append-element
 
727
               overview
 
728
               (cons (aref ov-entity 4)
 
729
                     (vector num
 
730
                             (elmo-msgdb-get-last-message-id
 
731
                              (aref ov-entity 5))
 
732
                             ;; from
 
733
                             (elmo-mime-string (elmo-delete-char
 
734
                                                ?\"
 
735
                                                (or
 
736
                                                 (aref ov-entity 2)
 
737
                                                 elmo-no-from) 'uni))
 
738
                             ;; subject
 
739
                             (elmo-mime-string (or (aref ov-entity 1)
 
740
                                                   elmo-no-subject))
 
741
                             (aref ov-entity 3) ;date
 
742
                             nil ; to
 
743
                             nil ; cc
 
744
                             (string-to-int
 
745
                              (aref ov-entity 6)) ; size
 
746
                             extra ; extra-field-list
 
747
                             ))))
 
748
        (setq number-alist
 
749
              (elmo-msgdb-number-add number-alist num
 
750
                                     (aref ov-entity 4)))
 
751
        (setq message-id (aref ov-entity 4))
 
752
        (setq seen (member message-id seen-list))
 
753
        (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 
754
                            (if (elmo-file-cache-status
 
755
                                 (elmo-file-cache-get message-id))
 
756
                                (if seen
 
757
                                    nil
 
758
                                  already-mark)
 
759
                              (if seen
 
760
                                  (if elmo-nntp-use-cache
 
761
                                      seen-mark)
 
762
                                new-mark))))
 
763
            (setq mark-alist
 
764
                  (elmo-msgdb-mark-append mark-alist
 
765
                                          num gmark))))
 
766
      (setq ov-list (cdr ov-list)))
 
767
    (list overview number-alist mark-alist)))
 
768
 
 
769
(luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
 
770
                                              numbers new-mark already-mark
 
771
                                              seen-mark important-mark
 
772
                                              seen-list)
 
773
  (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark
 
774
                                 seen-mark important-mark
 
775
                                 seen-list))
 
776
 
 
777
(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark
 
778
                                             seen-mark important-mark
 
779
                                             seen-list)
 
780
  (let ((filter numbers)
 
781
        (session (elmo-nntp-get-session folder))
 
782
        beg-num end-num cur length
 
783
        ret-val ov-str use-xover dir)
 
784
    (elmo-nntp-select-group session (elmo-nntp-folder-group-internal
 
785
                                     folder))
 
786
    (when (setq use-xover (elmo-nntp-xover-p session))
 
787
      (setq beg-num (car numbers)
 
788
            cur beg-num
 
789
            end-num (nth (1- (length numbers)) numbers)
 
790
            length  (+ (- end-num beg-num) 1))
 
791
      (message "Getting overview...")
 
792
      (while (<= cur end-num)
 
793
        (elmo-nntp-send-command
 
794
         session
 
795
         (format
 
796
          "xover %s-%s"
 
797
          (int-to-string cur)
 
798
          (int-to-string
 
799
           (+ cur
 
800
              elmo-nntp-overview-fetch-chop-length))))
 
801
        (with-current-buffer (elmo-network-session-buffer session)
 
802
          (if ov-str
 
803
              (setq ret-val
 
804
                    (elmo-msgdb-append
 
805
                     ret-val
 
806
                     (elmo-nntp-create-msgdb-from-overview-string
 
807
                      ov-str
 
808
                      new-mark
 
809
                      already-mark
 
810
                      seen-mark
 
811
                      important-mark
 
812
                      seen-list
 
813
                      filter
 
814
                      )))))
 
815
        (if (null (elmo-nntp-read-response session t))
 
816
            (progn
 
817
              (setq cur end-num);; exit while loop
 
818
              (elmo-nntp-set-xover session nil)
 
819
              (setq use-xover nil))
 
820
          (if (null (setq ov-str (elmo-nntp-read-contents session)))
 
821
              (error "Fetching overview failed")))
 
822
        (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
 
823
        (when (> length elmo-display-progress-threshold)
 
824
          (elmo-display-progress
 
825
           'elmo-nntp-msgdb-create "Getting overview..."
 
826
           (/ (* (+ (- (min cur end-num)
 
827
                       beg-num) 1) 100) length))))
 
828
      (when (> length elmo-display-progress-threshold)
 
829
        (elmo-display-progress
 
830
         'elmo-nntp-msgdb-create "Getting overview..." 100)))
 
831
    (if (not use-xover)
 
832
        (setq ret-val (elmo-nntp-msgdb-create-by-header
 
833
                       session numbers
 
834
                       new-mark already-mark seen-mark seen-list))
 
835
      (with-current-buffer (elmo-network-session-buffer session)
 
836
        (if ov-str
 
837
            (setq ret-val
 
838
                  (elmo-msgdb-append
 
839
                   ret-val
 
840
                   (elmo-nntp-create-msgdb-from-overview-string
 
841
                    ov-str
 
842
                    new-mark
 
843
                    already-mark
 
844
                    seen-mark
 
845
                    important-mark
 
846
                    seen-list
 
847
                    filter))))))
 
848
    (elmo-folder-set-killed-list-internal
 
849
     folder
 
850
     (nconc
 
851
      (elmo-folder-killed-list-internal folder)
 
852
      (car (elmo-list-diff
 
853
            numbers
 
854
            (mapcar 'car
 
855
                    (elmo-msgdb-get-number-alist
 
856
                     ret-val))))))
 
857
    ;; If there are canceled messages, overviews are not obtained
 
858
    ;; to max-number(inn 2.3?).
 
859
    (when (and (elmo-nntp-max-number-precedes-list-active-p)
 
860
               (elmo-nntp-list-active-p session))
 
861
      (elmo-nntp-send-command session
 
862
                              (format "list active %s"
 
863
                                      (elmo-nntp-folder-group-internal
 
864
                                       folder)))
 
865
      (if (null (elmo-nntp-read-response session))
 
866
          (progn
 
867
            (elmo-nntp-set-list-active session nil)
 
868
            (error "NNTP list command failed")))
 
869
      (elmo-nntp-catchup-msgdb
 
870
       ret-val
 
871
       (nth 1 (read (concat "(" (elmo-nntp-read-contents
 
872
                                 session) ")")))))
 
873
    ret-val))
 
874
 
 
875
(luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder))
 
876
  (if (elmo-nntp-max-number-precedes-list-active-p)
 
877
      (let ((session (elmo-nntp-get-session folder))
 
878
            (number-alist (elmo-msgdb-get-number-alist
 
879
                           (elmo-folder-msgdb folder))))
 
880
        (if (elmo-nntp-list-active-p session)
 
881
            (let (msgdb-max max-number)
 
882
              ;; If there are canceled messages, overviews are not obtained
 
883
              ;; to max-number(inn 2.3?).
 
884
              (elmo-nntp-select-group session
 
885
                                      (elmo-nntp-folder-group-internal folder))
 
886
              (elmo-nntp-send-command session
 
887
                                      (format "list active %s"
 
888
                                              (elmo-nntp-folder-group-internal
 
889
                                               folder)))
 
890
              (if (null (elmo-nntp-read-response session))
 
891
                  (error "NNTP list command failed"))
 
892
              (setq max-number
 
893
                    (nth 1 (read (concat "(" (elmo-nntp-read-contents
 
894
                                              session) ")"))))
 
895
              (setq msgdb-max
 
896
                    (car (nth (max (- (length number-alist) 1) 0)
 
897
                              number-alist)))
 
898
              (if (or (and number-alist (not msgdb-max))
 
899
                      (and msgdb-max max-number
 
900
                           (< msgdb-max max-number)))
 
901
                  (elmo-msgdb-set-number-alist
 
902
                   (elmo-folder-msgdb folder)
 
903
                   (nconc number-alist
 
904
                          (list (cons max-number nil))))))))))
 
905
 
 
906
(defun elmo-nntp-msgdb-create-by-header (session numbers
 
907
                                                 new-mark already-mark
 
908
                                                 seen-mark seen-list)
 
909
  (with-temp-buffer
 
910
    (elmo-nntp-retrieve-headers session (current-buffer) numbers)
 
911
    (elmo-nntp-msgdb-create-message
 
912
     (length numbers) new-mark already-mark seen-mark seen-list)))
 
913
 
 
914
(defun elmo-nntp-parse-xhdr-response (string)
 
915
  (let (response)
 
916
    (with-temp-buffer
 
917
      (insert string)
 
918
      (goto-char (point-min))
 
919
      (while (not (eobp))
 
920
        (if (looking-at "^\\([0-9]+\\) \\(.*\\)$")
 
921
            (setq response (cons (cons (string-to-int (elmo-match-buffer 1))
 
922
                                       (elmo-match-buffer 2))
 
923
                                 response)))
 
924
        (forward-line 1)))
 
925
    (nreverse response)))
 
926
 
 
927
(defun elmo-nntp-parse-overview-string (string)
 
928
  (save-excursion
 
929
    (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))
 
930
          ret-list ret-val beg)
 
931
      (set-buffer tmp-buffer)
 
932
      (erase-buffer)
 
933
      (elmo-set-buffer-multibyte nil)
 
934
      (insert string)
 
935
      (goto-char (point-min))
 
936
      (setq beg (point))
 
937
      (while (not (eobp))
 
938
        (end-of-line)
 
939
        (setq ret-list (save-match-data
 
940
                         (apply 'vector (split-string
 
941
                                         (buffer-substring beg (point))
 
942
                                         "\t"))))
 
943
        (beginning-of-line)
 
944
        (forward-line 1)
 
945
        (setq beg (point))
 
946
        (setq ret-val (nconc ret-val (list ret-list))))
 
947
;;;   (kill-buffer tmp-buffer)
 
948
      ret-val)))
 
949
 
 
950
(defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port type)
 
951
  "Get nntp header string."
 
952
  (save-excursion
 
953
    (let ((session (elmo-nntp-get-session
 
954
                    (luna-make-entity
 
955
                     'elmo-nntp-folder
 
956
                     :user user
 
957
                     :server server
 
958
                     :port port
 
959
                     :stream-type type))))
 
960
      (elmo-nntp-send-command session
 
961
                              (format "head %s" msgid))
 
962
      (if (elmo-nntp-read-response session)
 
963
          (elmo-nntp-read-contents session))
 
964
      (with-current-buffer (elmo-network-session-buffer session)
 
965
        (std11-field-body "Newsgroups")))))
 
966
 
 
967
(luna-define-method elmo-message-fetch-with-cache-process :around
 
968
  ((folder elmo-nntp-folder) number strategy &optional section unread)
 
969
  (when (luna-call-next-method)
 
970
    (elmo-nntp-setup-crosspost-buffer folder number)
 
971
    (unless unread
 
972
      (elmo-nntp-folder-update-crosspost-message-alist
 
973
       folder (list number)))
 
974
    t))
 
975
 
 
976
(luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
 
977
                                                number strategy
 
978
                                                &optional section outbuf
 
979
                                                unread)
 
980
  (elmo-nntp-message-fetch folder number strategy section outbuf unread))
 
981
 
 
982
(defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
 
983
  (let ((session (elmo-nntp-get-session folder))
 
984
        newsgroups)
 
985
    (with-current-buffer (elmo-network-session-buffer session)
 
986
      (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
 
987
      (elmo-nntp-send-command session (format "article %s" number))
 
988
      (if (null (elmo-nntp-read-response session t))
 
989
          (progn
 
990
            (with-current-buffer outbuf (erase-buffer))
 
991
            (message "Fetching message failed")
 
992
            nil)
 
993
        (prog1 (elmo-nntp-read-body session outbuf)
 
994
          (with-current-buffer outbuf
 
995
            (goto-char (point-min))
 
996
            (while (re-search-forward "^\\." nil t)
 
997
              (replace-match "")
 
998
              (forward-line))
 
999
            (elmo-nntp-setup-crosspost-buffer folder number)
 
1000
            (unless unread
 
1001
              (elmo-nntp-folder-update-crosspost-message-alist
 
1002
               folder (list number)))))))))
 
1003
 
 
1004
(defun elmo-nntp-post (hostname content-buf)
 
1005
  (let ((session (elmo-nntp-get-session
 
1006
                  (luna-make-entity
 
1007
                   'elmo-nntp-folder
 
1008
                   :user elmo-nntp-default-user
 
1009
                   :server hostname
 
1010
                   :port elmo-nntp-default-port
 
1011
                   :stream-type
 
1012
                   (elmo-get-network-stream-type
 
1013
                    elmo-nntp-default-stream-type))))
 
1014
        response has-message-id)
 
1015
    (save-excursion
 
1016
      (set-buffer content-buf)
 
1017
      (goto-char (point-min))
 
1018
      (if (search-forward mail-header-separator nil t)
 
1019
          (delete-region (match-beginning 0)(match-end 0)))
 
1020
      (setq has-message-id (std11-field-body "message-id"))
 
1021
      (elmo-nntp-send-command session "post")
 
1022
      (if (string-match "^340" (setq response
 
1023
                                     (elmo-nntp-read-raw-response session)))
 
1024
          (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
 
1025
              (unless has-message-id
 
1026
                (goto-char (point-min))
 
1027
                (insert (concat "Message-ID: "
 
1028
                                (elmo-match-string 1 response)
 
1029
                                "\n"))))
 
1030
        (error "POST failed"))
 
1031
      (run-hooks 'elmo-nntp-post-pre-hook)
 
1032
      (elmo-nntp-send-buffer session content-buf)
 
1033
      (elmo-nntp-send-command session ".")
 
1034
;;;   (elmo-nntp-read-response buffer process t)
 
1035
      (if (not (string-match
 
1036
                "^2" (setq response (elmo-nntp-read-raw-response
 
1037
                                     session))))
 
1038
          (error (concat "NNTP error: " response))))))
 
1039
 
 
1040
(defsubst elmo-nntp-send-data-line (session line)
 
1041
  "Send LINE to SESSION."
 
1042
  ;; Escape "." at start of a line
 
1043
  (if (eq (string-to-char line) ?.)
 
1044
      (process-send-string (elmo-network-session-process-internal
 
1045
                            session) "."))
 
1046
  (process-send-string (elmo-network-session-process-internal
 
1047
                        session) line)
 
1048
  (process-send-string (elmo-network-session-process-internal
 
1049
                        session) "\r\n"))
 
1050
 
 
1051
(defun elmo-nntp-send-buffer (session databuf)
 
1052
  "Send data content of DATABUF to SESSION."
 
1053
  (let ((data-continue t)
 
1054
        line bol)
 
1055
    (with-current-buffer databuf
 
1056
      (goto-char (point-min))
 
1057
      (while data-continue
 
1058
        (beginning-of-line)
 
1059
        (setq bol (point))
 
1060
        (end-of-line)
 
1061
        (setq line (buffer-substring bol (point)))
 
1062
        (unless (eq (forward-line 1) 0) (setq data-continue nil))
 
1063
        (elmo-nntp-send-data-line session line)))))
 
1064
 
 
1065
(luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
 
1066
                                                 numbers)
 
1067
  (elmo-nntp-folder-delete-messages folder numbers))
 
1068
 
 
1069
(defun elmo-nntp-folder-delete-messages (folder numbers)
 
1070
  (let ((killed-list (elmo-folder-killed-list-internal folder)))
 
1071
    (dolist (number numbers)
 
1072
      (setq killed-list
 
1073
            (elmo-msgdb-set-as-killed killed-list number)))
 
1074
    (elmo-folder-set-killed-list-internal folder killed-list))
 
1075
  t)
 
1076
 
 
1077
(luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder))
 
1078
  (let ((session (elmo-nntp-get-session folder)))
 
1079
    (if (elmo-folder-plugged-p folder)
 
1080
        (progn
 
1081
          (elmo-nntp-send-command
 
1082
           session
 
1083
           (format "group %s"
 
1084
                   (elmo-nntp-folder-group-internal folder)))
 
1085
          (elmo-nntp-read-response session))
 
1086
      t)))
 
1087
 
 
1088
(defun elmo-nntp-retrieve-field (spec field from-msgs)
 
1089
  "Retrieve FIELD values from FROM-MSGS.
 
1090
Returns a list of cons cells like (NUMBER . VALUE)"
 
1091
  (let ((session (elmo-nntp-get-session spec)))
 
1092
    (if (elmo-nntp-xhdr-p session)
 
1093
        (progn
 
1094
          (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
 
1095
          (elmo-nntp-send-command session
 
1096
                                  (format "xhdr %s %s"
 
1097
                                          field
 
1098
                                          (if from-msgs
 
1099
                                              (format
 
1100
                                               "%d-%d"
 
1101
                                               (car from-msgs)
 
1102
                                               (nth
 
1103
                                                (max
 
1104
                                                 (- (length from-msgs) 1) 0)
 
1105
                                                from-msgs))
 
1106
                                            "0-")))
 
1107
          (if (elmo-nntp-read-response session t)
 
1108
              (elmo-nntp-parse-xhdr-response
 
1109
               (elmo-nntp-read-contents session))
 
1110
            (elmo-nntp-set-xhdr session nil)
 
1111
            (error "NNTP XHDR command failed"))))))
 
1112
 
 
1113
(defun elmo-nntp-search-primitive (spec condition &optional from-msgs)
 
1114
  (let ((search-key (elmo-filter-key condition)))
 
1115
    (cond
 
1116
     ((string= "last" search-key)
 
1117
      (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
 
1118
        (nthcdr (max (- (length numbers)
 
1119
                        (string-to-int (elmo-filter-value condition)))
 
1120
                     0)
 
1121
                numbers)))
 
1122
     ((string= "first" search-key)
 
1123
      (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
 
1124
             (rest (nthcdr (string-to-int (elmo-filter-value condition) )
 
1125
                           numbers)))
 
1126
        (mapcar '(lambda (x) (delete x numbers)) rest)
 
1127
        numbers))
 
1128
     ((or (string= "since" search-key)
 
1129
          (string= "before" search-key))
 
1130
      (let* ((specified-date (elmo-date-make-sortable-string
 
1131
                              (elmo-date-get-datevec (elmo-filter-value
 
1132
                                                      condition))))
 
1133
             (since (string= "since" search-key))
 
1134
             field-date  result)
 
1135
        (if (eq (elmo-filter-type condition) 'unmatch)
 
1136
            (setq since (not since)))
 
1137
        (setq result
 
1138
              (delq nil
 
1139
                    (mapcar
 
1140
                     (lambda (pair)
 
1141
                       (setq field-date
 
1142
                             (elmo-date-make-sortable-string
 
1143
                              (timezone-fix-time
 
1144
                               (cdr pair)
 
1145
                               (current-time-zone) nil)))
 
1146
                       (if (if since
 
1147
                               (or (string= specified-date field-date)
 
1148
                                   (string< specified-date field-date))
 
1149
                             (string< field-date
 
1150
                                      specified-date))
 
1151
                           (car pair)))
 
1152
                     (elmo-nntp-retrieve-field spec "date" from-msgs))))
 
1153
        (if from-msgs
 
1154
            (elmo-list-filter from-msgs result)
 
1155
          result)))
 
1156
     (t
 
1157
      (let ((val (elmo-filter-value condition))
 
1158
            (negative (eq (elmo-filter-type condition) 'unmatch))
 
1159
            (case-fold-search t)
 
1160
            result)
 
1161
        (setq result
 
1162
              (delq nil
 
1163
                    (mapcar
 
1164
                     (lambda (pair)
 
1165
                       (if (string-match val
 
1166
                                         (eword-decode-string
 
1167
                                          (decode-mime-charset-string
 
1168
                                           (cdr pair) elmo-mime-charset)))
 
1169
                           (unless negative (car pair))
 
1170
                         (if negative (car pair))))
 
1171
                     (elmo-nntp-retrieve-field spec search-key
 
1172
                                               from-msgs))))
 
1173
        (if from-msgs
 
1174
            (elmo-list-filter from-msgs result)
 
1175
          result))))))
 
1176
 
 
1177
(luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
 
1178
                                        condition &optional from-msgs)
 
1179
  (let (result)
 
1180
    (cond
 
1181
     ((vectorp condition)
 
1182
      (setq result (elmo-nntp-search-primitive
 
1183
                    folder condition from-msgs)))
 
1184
     ((eq (car condition) 'and)
 
1185
      (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
 
1186
            result (elmo-list-filter result
 
1187
                                     (elmo-folder-search
 
1188
                                      folder (nth 2 condition)
 
1189
                                      from-msgs))))
 
1190
     ((eq (car condition) 'or)
 
1191
      (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
 
1192
            result (elmo-uniq-list
 
1193
                    (nconc result
 
1194
                           (elmo-folder-search folder (nth 2 condition)
 
1195
                                               from-msgs)))
 
1196
            result (sort result '<))))))
 
1197
 
 
1198
(defun elmo-nntp-get-folders-info-prepare (folder session-keys)
 
1199
  (condition-case ()
 
1200
      (let ((session (elmo-nntp-get-session folder))
 
1201
            key count)
 
1202
        (with-current-buffer (elmo-network-session-buffer session)
 
1203
          (unless (setq key (assoc session session-keys))
 
1204
            (erase-buffer)
 
1205
            (setq key (cons session
 
1206
                            (vector 0
 
1207
                                    (elmo-net-folder-server-internal folder)
 
1208
                                    (elmo-net-folder-user-internal folder)
 
1209
                                    (elmo-net-folder-port-internal folder)
 
1210
                                    (elmo-net-folder-stream-type-internal
 
1211
                                     folder))))
 
1212
            (setq session-keys (nconc session-keys (list key))))
 
1213
          (elmo-nntp-send-command session
 
1214
                                  (format "group %s"
 
1215
                                          (elmo-nntp-folder-group-internal
 
1216
                                           folder))
 
1217
                                  'noerase)
 
1218
          (if elmo-nntp-get-folders-securely
 
1219
              (accept-process-output
 
1220
               (elmo-network-session-process-internal session)
 
1221
               1))
 
1222
          (setq count (aref (cdr key) 0))
 
1223
          (aset (cdr key) 0 (1+ count))))
 
1224
    (error
 
1225
     (when elmo-auto-change-plugged
 
1226
       (sit-for 1))
 
1227
     nil))
 
1228
  session-keys)
 
1229
 
 
1230
(defun elmo-nntp-get-folders-info (session-keys)
 
1231
  (let ((sessions session-keys)
 
1232
        (cur (get-buffer-create " *ELMO NNTP Temp*")))
 
1233
    (while sessions
 
1234
      (let* ((session (caar sessions))
 
1235
             (key     (cdar sessions))
 
1236
             (count   (aref key 0))
 
1237
             (server  (aref key 1))
 
1238
             (user    (aref key 2))
 
1239
             (port    (aref key 3))
 
1240
             (type    (aref key 4))
 
1241
             (hashtb (or elmo-newsgroups-hashtb
 
1242
                         (setq elmo-newsgroups-hashtb
 
1243
                               (elmo-make-hash count)))))
 
1244
        (save-excursion
 
1245
          (elmo-nntp-groups-read-response session cur count)
 
1246
          (set-buffer cur)
 
1247
          (goto-char (point-min))
 
1248
          (let ((case-replace nil)
 
1249
                (postfix (elmo-nntp-folder-postfix user server port type)))
 
1250
            (if (not (string= postfix ""))
 
1251
                (save-excursion
 
1252
                  (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$"
 
1253
                                  (concat "\\1"
 
1254
                                          (elmo-replace-in-string
 
1255
                                           postfix
 
1256
                                           "\\\\" "\\\\\\\\\\\\\\\\"))))))
 
1257
          (let (len min max group)
 
1258
            (while (not (eobp))
 
1259
              (condition-case ()
 
1260
                  (when (= (following-char) ?2)
 
1261
                    (read cur)
 
1262
                    (setq len (read cur)
 
1263
                          min (read cur)
 
1264
                          max (read cur))
 
1265
                    (set (setq group (let ((obarray hashtb)) (read cur)))
 
1266
                         (list len min max)))
 
1267
                (error (and group (symbolp group) (set group nil))))
 
1268
              (forward-line 1))))
 
1269
        (setq sessions (cdr sessions))))
 
1270
    (kill-buffer cur)))
 
1271
 
 
1272
;; original is 'nntp-retrieve-groups [Gnus]
 
1273
(defun elmo-nntp-groups-read-response (session outbuf count)
 
1274
  (let* ((received 0)
 
1275
         (last-point (point-min)))
 
1276
    (with-current-buffer (elmo-network-session-buffer session)
 
1277
      (accept-process-output
 
1278
       (elmo-network-session-process-internal session) 1)
 
1279
      (discard-input)
 
1280
      ;; Wait for all replies.
 
1281
      (message "Getting folders info...")
 
1282
      (while (progn
 
1283
               (goto-char last-point)
 
1284
               ;; Count replies.
 
1285
               (while (re-search-forward "^[0-9]" nil t)
 
1286
                 (setq received
 
1287
                       (1+ received)))
 
1288
               (setq last-point (point))
 
1289
               (< received count))
 
1290
        (accept-process-output (elmo-network-session-process-internal session)
 
1291
                               1)
 
1292
        (discard-input)
 
1293
        (when (> count elmo-display-progress-threshold)
 
1294
          (if (or (zerop (% received 10)) (= received count))
 
1295
              (elmo-display-progress
 
1296
               'elmo-nntp-groups-read-response "Getting folders info..."
 
1297
               (/ (* received 100) count)))))
 
1298
      (when (> count elmo-display-progress-threshold)
 
1299
        (elmo-display-progress
 
1300
         'elmo-nntp-groups-read-response "Getting folders info..." 100))
 
1301
      ;; Wait for the reply from the final command.
 
1302
      (goto-char (point-max))
 
1303
      (re-search-backward "^[0-9]" nil t)
 
1304
      (when (looking-at "^[23]")
 
1305
        (while (progn
 
1306
                 (goto-char (point-max))
 
1307
                 (not (re-search-backward "\r?\n" (- (point) 3) t)))
 
1308
          (accept-process-output
 
1309
           (elmo-network-session-process-internal session) 1)
 
1310
          (discard-input)))
 
1311
      ;; Now all replies are received.  We remove CRs.
 
1312
      (goto-char (point-min))
 
1313
      (while (search-forward "\r" nil t)
 
1314
        (replace-match "" t t))
 
1315
      (copy-to-buffer outbuf (point-min) (point-max)))))
 
1316
 
 
1317
;; from nntp.el [Gnus]
 
1318
 
 
1319
(defsubst elmo-nntp-next-result-arrived-p ()
 
1320
  (cond
 
1321
   ((eq (following-char) ?2)
 
1322
    (if (re-search-forward "\n\\.\r?\n" nil t)
 
1323
        t
 
1324
      nil))
 
1325
   ((looking-at "[34]")
 
1326
    (if (search-forward "\n" nil t)
 
1327
        t
 
1328
      nil))
 
1329
   (t
 
1330
    nil)))
 
1331
 
 
1332
(defun elmo-nntp-retrieve-headers (session outbuf articles)
 
1333
  "Retrieve the headers of ARTICLES."
 
1334
  (with-current-buffer (elmo-network-session-buffer session)
 
1335
    (erase-buffer)
 
1336
    (let ((number (length articles))
 
1337
          (count 0)
 
1338
          (received 0)
 
1339
          (last-point (point-min))
 
1340
          article)
 
1341
      ;; Send HEAD commands.
 
1342
      (while (setq article (pop articles))
 
1343
        (elmo-nntp-send-command session
 
1344
                                (format "head %s" article)
 
1345
                                'noerase)
 
1346
        (setq count (1+ count))
 
1347
        ;; Every 200 requests we have to read the stream in
 
1348
        ;; order to avoid deadlocks.
 
1349
        (when (or (null articles)       ;All requests have been sent.
 
1350
                  (zerop (% count elmo-nntp-header-fetch-chop-length)))
 
1351
          (accept-process-output
 
1352
           (elmo-network-session-process-internal session) 1)
 
1353
          (discard-input)
 
1354
          (while (progn
 
1355
                   (goto-char last-point)
 
1356
                   ;; Count replies.
 
1357
                   (while (elmo-nntp-next-result-arrived-p)
 
1358
                     (setq last-point (point))
 
1359
                     (setq received (1+ received)))
 
1360
                   (< received count))
 
1361
            (when (> number elmo-display-progress-threshold)
 
1362
              (if (or (zerop (% received 20)) (= received number))
 
1363
                  (elmo-display-progress
 
1364
                   'elmo-nntp-retrieve-headers "Getting headers..."
 
1365
                   (/ (* received 100) number))))
 
1366
            (accept-process-output
 
1367
             (elmo-network-session-process-internal session) 1)
 
1368
            (discard-input))))
 
1369
      (when (> number elmo-display-progress-threshold)
 
1370
        (elmo-display-progress
 
1371
         'elmo-nntp-retrieve-headers "Getting headers..." 100))
 
1372
      (message "Getting headers...done")
 
1373
      ;; Remove all "\r"'s.
 
1374
      (goto-char (point-min))
 
1375
      (while (search-forward "\r\n" nil t)
 
1376
        (replace-match "\n"))
 
1377
      (copy-to-buffer outbuf (point-min) (point-max)))))
 
1378
 
 
1379
;; end of from Gnus
 
1380
 
 
1381
(defun elmo-nntp-msgdb-create-message (len new-mark
 
1382
                                           already-mark seen-mark seen-list)
 
1383
  (save-excursion
 
1384
    (let (beg overview number-alist mark-alist
 
1385
              entity i num gmark seen message-id)
 
1386
      (elmo-set-buffer-multibyte nil)
 
1387
      (goto-char (point-min))
 
1388
      (setq i 0)
 
1389
      (message "Creating msgdb...")
 
1390
      (while (not (eobp))
 
1391
        (setq beg (save-excursion (forward-line 1) (point)))
 
1392
        (setq num
 
1393
              (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
 
1394
                   (string-to-int
 
1395
                    (elmo-match-buffer 1))))
 
1396
        (elmo-nntp-next-result-arrived-p)
 
1397
        (when num
 
1398
          (save-excursion
 
1399
            (forward-line -1)
 
1400
            (save-restriction
 
1401
              (narrow-to-region beg (point))
 
1402
              (setq entity
 
1403
                    (elmo-msgdb-create-overview-from-buffer num))
 
1404
              (when entity
 
1405
                (setq overview
 
1406
                      (elmo-msgdb-append-element
 
1407
                       overview entity))
 
1408
                (setq number-alist
 
1409
                      (elmo-msgdb-number-add
 
1410
                       number-alist
 
1411
                       (elmo-msgdb-overview-entity-get-number entity)
 
1412
                       (car entity)))
 
1413
                (setq message-id (car entity))
 
1414
                (setq seen (member message-id seen-list))
 
1415
                (if (setq gmark
 
1416
                          (or (elmo-msgdb-global-mark-get message-id)
 
1417
                              (if (elmo-file-cache-status
 
1418
                                   (elmo-file-cache-get message-id))
 
1419
                                  (if seen
 
1420
                                      nil
 
1421
                                    already-mark)
 
1422
                                (if seen
 
1423
                                    (if elmo-nntp-use-cache
 
1424
                                        seen-mark)
 
1425
                                  new-mark))))
 
1426
                    (setq mark-alist
 
1427
                          (elmo-msgdb-mark-append
 
1428
                           mark-alist
 
1429
                           num gmark)))
 
1430
                ))))
 
1431
        (when (> len elmo-display-progress-threshold)
 
1432
          (setq i (1+ i))
 
1433
          (if (or (zerop (% i 20)) (= i len))
 
1434
              (elmo-display-progress
 
1435
               'elmo-nntp-msgdb-create-message "Creating msgdb..."
 
1436
               (/ (* i 100) len)))))
 
1437
      (when (> len elmo-display-progress-threshold)
 
1438
        (elmo-display-progress
 
1439
         'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
 
1440
      (list overview number-alist mark-alist))))
 
1441
 
 
1442
(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
 
1443
  elmo-nntp-use-cache)
 
1444
 
 
1445
(luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder))
 
1446
  nil)
 
1447
 
 
1448
(defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
 
1449
  (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
 
1450
        ngs)
 
1451
    (if (not subscribe-only)
 
1452
        nglist
 
1453
      (dolist (ng nglist)
 
1454
        (if (intern-soft ng elmo-newsgroups-hashtb)
 
1455
            (setq ngs (cons ng ngs))))
 
1456
      ngs)))
 
1457
 
 
1458
;;; Crosspost processing.
 
1459
 
 
1460
;; 1. setup crosspost alist.
 
1461
;;    1.1. When message is fetched and is crossposted message,
 
1462
;;         it is remembered in `temp-crosses' slot.
 
1463
;;         temp-crosses slot is a list of cons cell:
 
1464
;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
 
1465
;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
 
1466
;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
 
1467
;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
 
1468
 
 
1469
;; 2. process crosspost alist.
 
1470
;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
 
1471
;;         `elmo-crosspost-message-alist'.
 
1472
;;    2.2. remove crosspost entry for current newsgroup from
 
1473
;;         `elmo-crosspost-message-alist'.
 
1474
;;    2.3. elmo-folder-list-unreads return unread message list according to
 
1475
;;         `reads' slot.
 
1476
;;         (There's a problem that if `elmo-folder-list-unreads'
 
1477
;;           never executed, crosspost information is thrown away.)
 
1478
;;    2.4. In elmo-folder-close, `read' slot is cleared,
 
1479
 
 
1480
(defun elmo-nntp-setup-crosspost-buffer (folder number)
 
1481
;;    1.1. When message is fetched and is crossposted message,
 
1482
;;         it is remembered in `temp-crosses' slot.
 
1483
;;         temp-crosses slot is a list of cons cell:
 
1484
;;         (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
 
1485
  (let (newsgroups crosspost-newsgroups message-id)
 
1486
    (save-restriction
 
1487
      (std11-narrow-to-header)
 
1488
      (setq newsgroups (std11-fetch-field "newsgroups")
 
1489
            message-id (std11-msg-id-string
 
1490
                        (car (std11-parse-msg-id-string
 
1491
                              (std11-fetch-field "message-id"))))))
 
1492
    (when newsgroups
 
1493
      (when (setq crosspost-newsgroups
 
1494
                  (delete
 
1495
                   (elmo-nntp-folder-group-internal folder)
 
1496
                   (elmo-nntp-parse-newsgroups newsgroups t)))
 
1497
        (unless (assq number
 
1498
                      (elmo-nntp-folder-temp-crosses-internal folder))
 
1499
          (elmo-nntp-folder-set-temp-crosses-internal
 
1500
           folder
 
1501
           (cons (cons number (list message-id crosspost-newsgroups 'ng))
 
1502
                 (elmo-nntp-folder-temp-crosses-internal folder))))))))
 
1503
 
 
1504
(luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
 
1505
;;    1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
 
1506
  (elmo-nntp-folder-set-temp-crosses-internal folder nil)
 
1507
  (elmo-nntp-folder-set-reads-internal folder nil)
 
1508
  )
 
1509
 
 
1510
(defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
 
1511
;;    1.3. In elmo-folder-mark-as-read, move crosspost entry
 
1512
;;         from `temp-crosses' slot to `elmo-crosspost-message-alist'.
 
1513
  (let (elem)
 
1514
    (dolist (number numbers)
 
1515
      (when (setq elem (assq number
 
1516
                             (elmo-nntp-folder-temp-crosses-internal folder)))
 
1517
        (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
 
1518
          (setq elmo-crosspost-message-alist
 
1519
                (cons (cdr elem) elmo-crosspost-message-alist)))
 
1520
        (elmo-nntp-folder-set-temp-crosses-internal
 
1521
         folder
 
1522
         (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
 
1523
 
 
1524
(luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder)
 
1525
                                              numbers)
 
1526
  (elmo-nntp-folder-update-crosspost-message-alist folder numbers)
 
1527
  t)
 
1528
 
 
1529
(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)
 
1530
                                                   &optional
 
1531
                                                   number-alist)
 
1532
  (elmo-nntp-folder-process-crosspost folder number-alist))
 
1533
 
 
1534
(defun elmo-nntp-folder-process-crosspost (folder number-alist)
 
1535
;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
 
1536
;;         `elmo-crosspost-message-alist'.
 
1537
;;    2.2. remove crosspost entry for current newsgroup from
 
1538
;;         `elmo-crosspost-message-alist'.
 
1539
  (let (cross-deletes reads entity ngs)
 
1540
    (dolist (cross elmo-crosspost-message-alist)
 
1541
      (if number-alist
 
1542
          (when (setq entity (rassoc (nth 0 cross) number-alist))
 
1543
            (setq reads (cons (car entity) reads)))
 
1544
        (when (setq entity (elmo-msgdb-overview-get-entity
 
1545
                            (nth 0 cross)
 
1546
                            (elmo-folder-msgdb folder)))
 
1547
          (setq reads (cons (elmo-msgdb-overview-entity-get-number entity)
 
1548
                            reads))))
 
1549
      (when entity
 
1550
        (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
 
1551
                              (nth 1 cross)))
 
1552
            (setcar (cdr cross) ngs)
 
1553
          (setq cross-deletes (cons cross cross-deletes)))
 
1554
        (setq elmo-crosspost-message-alist-modified t)))
 
1555
    (dolist (dele cross-deletes)
 
1556
      (setq elmo-crosspost-message-alist (delq
 
1557
                                          dele
 
1558
                                          elmo-crosspost-message-alist)))
 
1559
    (elmo-nntp-folder-set-reads-internal folder reads)))
 
1560
 
 
1561
(luna-define-method elmo-folder-list-unreads-internal
 
1562
  ((folder elmo-nntp-folder) unread-marks mark-alist)
 
1563
  ;;    2.3. elmo-folder-list-unreads return unread message list according to
 
1564
  ;;         `reads' slot.
 
1565
  (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist
 
1566
                                    (elmo-folder-msgdb folder)))))
 
1567
    (elmo-living-messages (delq nil
 
1568
                                (mapcar
 
1569
                                 (lambda (x)
 
1570
                                   (if (member (nth 1 x) unread-marks)
 
1571
                                       (car x)))
 
1572
                                 mark-alist))
 
1573
                          (elmo-nntp-folder-reads-internal folder))))
 
1574
 
 
1575
(require 'product)
 
1576
(product-provide (provide 'elmo-nntp) (require 'elmo-version))
 
1577
 
 
1578
;;; elmo-nntp.el ends here