(elmo-nntp-server-command-index): Add entry `xhdr'.
[elisp/wanderlust.git] / elmo / elmo-nntp.el
index 9494d76..894e571 100644 (file)
@@ -32,6 +32,7 @@
 
 ;;; Code:
 ;;
+(eval-when-compile (require 'cl))
 
 (require 'elmo-vars)
 (require 'elmo-util)
@@ -176,7 +177,8 @@ Don't cache if nil.")
 
 (defconst elmo-nntp-server-command-index '((xover . 0)
                                           (listgroup . 1)
-                                          (list-active . 2)))
+                                          (list-active . 2)
+                                          (xhdr . 3)))
 
 (defmacro elmo-nntp-get-server-command (session)
   (` (assoc (cons (elmo-network-session-server-internal (, session))
@@ -417,7 +419,8 @@ Don't cache if nil.")
       (with-current-buffer outbuf
        (erase-buffer)
        (insert-buffer-substring (elmo-network-session-buffer session)
-                                start (- end 3))))
+                                start (- end 3))
+       (elmo-delete-cr-buffer)))
     t))
 
 (defun elmo-nntp-select-group (session group &optional force)
@@ -465,9 +468,7 @@ Don't cache if nil.")
 (defsubst elmo-nntp-catchup-msgdb (msgdb max-number)
   (let ((numbers (elmo-msgdb-list-messages msgdb))
        msgdb-max)
-    (setq msgdb-max (if numbers
-                       (car (sort numbers '>))
-                     0))
+    (setq msgdb-max (if numbers (apply #'max numbers) 0))
     (when (and msgdb-max
               max-number
               (< msgdb-max max-number))
@@ -506,9 +507,9 @@ Don't cache if nil.")
                            (not (string= (elmo-nntp-folder-group-internal
                                           folder) "")))
                       (concat " active"
-                              (format " %s.*"
-                                      (elmo-nntp-folder-group-internal folder)
-                                      "")))))
+                              (format
+                               " %s.*"
+                               (elmo-nntp-folder-group-internal folder))))))
          (if (elmo-nntp-read-response session t)
              (if (null (setq response (elmo-nntp-read-contents session)))
                  (error "NNTP List folders failed")
@@ -548,14 +549,14 @@ Don't cache if nil.")
            (progn
              (setq regexp
                    (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
-                           (if (and
-                                (elmo-nntp-folder-group-internal folder)
-                                (null (string=
-                                       (elmo-nntp-folder-group-internal
-                                        folder) "")))
+                           (if (and (elmo-nntp-folder-group-internal folder)
+                                    (null (string=
+                                           (elmo-nntp-folder-group-internal
+                                            folder) "")))
                                (concat (elmo-nntp-folder-group-internal
                                         folder)
-                                       "\\.") "")))
+                                       "\\.")
+                             "")))
              (while (looking-at regexp)
                (setq top-ng (elmo-match-buffer 1))
                (if (string= (elmo-match-buffer 2) " ")
@@ -625,18 +626,7 @@ Don't cache if nil.")
            ret-val)))
 
 (defun elmo-nntp-make-msglist (beg-str end-str)
-  (elmo-set-work-buf
-   (let ((beg-num (string-to-int beg-str))
-        (end-num (string-to-int end-str))
-        i)
-     (setq i beg-num)
-     (insert "(")
-     (while (<= i end-num)
-       (insert (format "%s " i))
-       (setq i (1+ i)))
-     (insert ")")
-     (goto-char (point-min))
-     (read (current-buffer)))))
+  (elmo-make-number-list (string-to-int beg-str) (string-to-int end-str)))
 
 (luna-define-method elmo-folder-list-messages-plugged ((folder
                                                        elmo-nntp-folder)
@@ -769,6 +759,7 @@ Don't cache if nil.")
              (setq extra (cons (cons ext field) extra))))
          (setq extras (cdr extras)))
        (setq entity (elmo-msgdb-make-message-entity
+                     (elmo-msgdb-message-entity-handler new-msgdb)
                      :message-id (aref ov-entity 4)
                      :number     num
                      :references (elmo-msgdb-get-last-message-id
@@ -900,9 +891,7 @@ Don't cache if nil.")
          (setq max-number
                (nth 1 (read (concat "(" (elmo-nntp-read-contents
                                          session) ")"))))
-         (setq msgdb-max (if numbers
-                             (car (sort numbers '>))
-                           0))
+         (setq msgdb-max (if numbers (apply #'max numbers) 0))
          (when (and msgdb-max
                     max-number
                     (< msgdb-max max-number))
@@ -938,7 +927,7 @@ Don't cache if nil.")
          ret-list ret-val beg)
       (set-buffer tmp-buffer)
       (erase-buffer)
-      (elmo-set-buffer-multibyte nil)
+      (set-buffer-multibyte nil)
       (insert string)
       (goto-char (point-min))
       (setq beg (point))
@@ -972,8 +961,8 @@ Don't cache if nil.")
       (with-current-buffer (elmo-network-session-buffer session)
        (std11-field-body "Newsgroups")))))
 
-(luna-define-method elmo-message-fetch-with-cache-process :around
-  ((folder elmo-nntp-folder) number strategy &optional section unread)
+(luna-define-method elmo-message-fetch :around
+  ((folder elmo-nntp-folder) number strategy &optional unread section)
   (when (luna-call-next-method)
     (elmo-nntp-setup-crosspost-buffer folder number)
     (unless unread
@@ -1072,22 +1061,15 @@ Don't cache if nil.")
 
 (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
                                                 numbers)
-  (elmo-nntp-folder-delete-messages folder numbers))
-
-(defun elmo-nntp-folder-delete-messages (folder numbers)
-  (let ((killed-list (elmo-folder-killed-list-internal folder)))
-    (dolist (number numbers)
-      (setq killed-list
-           (elmo-msgdb-set-as-killed killed-list number)))
-    (elmo-folder-set-killed-list-internal folder killed-list))
+  (elmo-folder-kill-messages folder numbers)
   t)
 
 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder))
   (let ((session (elmo-nntp-get-session folder)))
-         (elmo-nntp-send-command
-          session
-          (format "group %s"
-                  (elmo-nntp-folder-group-internal folder)))
+    (elmo-nntp-send-command
+     session
+     (format "group %s"
+            (elmo-nntp-folder-group-internal folder)))
     (elmo-nntp-read-response session)))
 
 (defun elmo-nntp-retrieve-field (spec field from-msgs)
@@ -1388,10 +1370,8 @@ Returns a list of cons cells like (NUMBER . VALUE)"
        (elmo-display-progress
         'elmo-nntp-retrieve-headers "Getting headers..." 100))
       (message "Getting headers...done")
-      ;; Remove all "\r"'s.
-      (goto-char (point-min))
-      (while (search-forward "\r\n" nil t)
-       (replace-match "\n"))
+      ;; Replace all CRLF with LF.
+      (elmo-delete-cr-buffer)
       (copy-to-buffer outbuf (point-min) (point-max)))))
 
 ;; end of from Gnus
@@ -1400,7 +1380,7 @@ Returns a list of cons cells like (NUMBER . VALUE)"
   (save-excursion
     (let ((new-msgdb (elmo-make-msgdb))
          beg entity i num message-id)
-      (elmo-set-buffer-multibyte nil)
+      (set-buffer-multibyte nil)
       (goto-char (point-min))
       (setq i 0)
       (message "Creating msgdb...")
@@ -1417,7 +1397,8 @@ Returns a list of cons cells like (NUMBER . VALUE)"
            (save-restriction
              (narrow-to-region beg (point))
              (setq entity
-                   (elmo-msgdb-create-overview-from-buffer num))
+                   (elmo-msgdb-create-message-entity-from-buffer
+                    (elmo-msgdb-message-entity-handler new-msgdb) num))
              (when entity
                (setq message-id
                      (elmo-message-entity-field entity 'message-id))
@@ -1515,11 +1496,19 @@ Returns a list of cons cells like (NUMBER . VALUE)"
         folder
         (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
 
-(luna-define-method elmo-folder-flag-as-read :before ((folder
-                                                      elmo-nntp-folder)
-                                                     numbers
-                                                     &optional is-local)
-  (elmo-nntp-folder-update-crosspost-message-alist folder numbers))
+(luna-define-method elmo-folder-set-flag :before ((folder elmo-nntp-folder)
+                                                 numbers
+                                                 flag
+                                                 &optional is-local)
+  (when (eq flag 'read)
+    (elmo-nntp-folder-update-crosspost-message-alist folder numbers)))
+
+(luna-define-method elmo-folder-unset-flag :before ((folder elmo-nntp-folder)
+                                                   numbers
+                                                   flag
+                                                   &optional is-local)
+  (when (eq flag 'unread)
+    (elmo-nntp-folder-update-crosspost-message-alist folder numbers)))
 
 (defsubst elmo-nntp-folder-process-crosspost (folder)
 ;;    2.1. At elmo-folder-process-crosspost, setup `reads' slot from
@@ -1545,12 +1534,19 @@ Returns a list of cons cells like (NUMBER . VALUE)"
 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder))
   (elmo-nntp-folder-process-crosspost folder))
 
-(luna-define-method elmo-folder-list-unreads :around ((folder
-                                                      elmo-nntp-folder))
+(luna-define-method elmo-folder-list-flagged :around ((folder elmo-nntp-folder)
+                                                     flag &optional in-msgdb)
   ;;    2.3. elmo-folder-list-unreads return unread message list according to
   ;;         `reads' slot.
-  (elmo-living-messages (luna-call-next-method)
-                       (elmo-nntp-folder-reads-internal folder)))
+  (let ((msgs (luna-call-next-method)))
+    (if in-msgdb
+       msgs
+      (case flag
+       (unread
+        (elmo-living-messages msgs (elmo-nntp-folder-reads-internal folder)))
+       ;; Should consider read, digest and any flag?
+       (otherwise
+        msgs)))))
 
 (require 'product)
 (product-provide (provide 'elmo-nntp) (require 'elmo-version))