* elmo-msgdb.el (elmo-msgdb-get-message-id-from-buffer): Added
[elisp/wanderlust.git] / elmo / elmo-nntp.el
index 4bbf723..9990cae 100644 (file)
@@ -254,7 +254,8 @@ Don't cache if nil.")
 
 (luna-define-method elmo-network-initialize-session ((session
                                                      elmo-nntp-session))
-  (let ((process (elmo-network-session-process-internal session)))
+  (let ((process (elmo-network-session-process-internal session))
+       response)
     (set-process-filter (elmo-network-session-process-internal session)
                        'elmo-nntp-process-filter)
     (with-current-buffer (elmo-network-session-buffer session)
@@ -263,11 +264,12 @@ Don't cache if nil.")
       (while (and (memq (process-status process) '(open run))
                  (goto-char (point-max))
                  (forward-line -1)
-                 (not (looking-at "20[01]")))
+                 (not (looking-at "^[2-5][0-9][0-9]")))
        (accept-process-output process 1))
       (setq elmo-nntp-read-point (point))
-      (or (elmo-nntp-read-response session t)
-         (error "Cannot open network"))
+      (setq response (elmo-nntp-read-response session t t))
+      (unless (car response)
+         (signal 'elmo-open-error (list (cdr response))))
       (if elmo-nntp-send-mode-reader
          (elmo-nntp-send-mode-reader session))
       (when (eq (elmo-network-stream-type-symbol
@@ -308,7 +310,7 @@ Don't cache if nil.")
 (defun elmo-nntp-send-mode-reader (session)
   (elmo-nntp-send-command session "mode reader")
   (if (null (elmo-nntp-read-response session t))
-      (error "Mode reader failed")))
+      (message "Mode reader failed")))
 
 (defun elmo-nntp-send-command (session command &optional noerase)
   (with-current-buffer (elmo-network-session-buffer session)
@@ -321,7 +323,7 @@ Don't cache if nil.")
     (process-send-string (elmo-network-session-process-internal
                          session) "\r\n")))
 
-(defun elmo-nntp-read-response (session &optional not-command)
+(defun elmo-nntp-read-response (session &optional not-command error-msg)
   (with-current-buffer (elmo-network-session-buffer session)
     (let ((process (elmo-network-session-process-internal session))
          (case-fold-search nil)
@@ -356,7 +358,9 @@ Don't cache if nil.")
                      (concat response "\n" response-string)
                    response-string)))
          (setq elmo-nntp-read-point match-end)))
-      response)))
+      (if error-msg
+         (cons response response-string)
+       response))))
 
 (defun elmo-nntp-read-raw-response (session)
   (with-current-buffer (elmo-network-session-buffer session)
@@ -389,7 +393,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))))
+    t))
 
 (defun elmo-nntp-select-group (session group &optional force)
   (let (response)
@@ -404,7 +409,7 @@ Don't cache if nil.")
                                                      (and response group))
        response))))
 
-(defun elmo-nntp-list-folders-get-cache (folder buf)
+(defun elmo-nntp-list-folders-get-cache (group server buf)
   (when (and elmo-nntp-list-folders-use-cache
             elmo-nntp-list-folders-cache
             (string-match (concat "^"
@@ -412,18 +417,24 @@ Don't cache if nil.")
                                    (or
                                     (nth 1 elmo-nntp-list-folders-cache)
                                     "")))
-                          (or folder "")))
+                          (or group ""))
+            (string-match (concat "^"
+                                  (regexp-quote
+                                   (or
+                                    (nth 2 elmo-nntp-list-folders-cache)
+                                    "")))
+                          (or server "")))
     (let* ((cache-time (car elmo-nntp-list-folders-cache)))
       (unless (elmo-time-expire cache-time
                                elmo-nntp-list-folders-use-cache)
        (save-excursion
          (set-buffer buf)
          (erase-buffer)
-         (insert (nth 2 elmo-nntp-list-folders-cache))
+         (insert (nth 3 elmo-nntp-list-folders-cache))
          (goto-char (point-min))
-         (or (string= folder "")
-             (and folder
-                  (keep-lines (concat "^" (regexp-quote folder) "\\."))))
+         (or (string= group "")
+             (and group
+                  (keep-lines (concat "^" (regexp-quote group) "\\."))))
          t
          )))))
 
@@ -445,6 +456,7 @@ Don't cache if nil.")
 
 (defun elmo-nntp-folder-list-subfolders (folder one-level)
   (let ((session (elmo-nntp-get-session folder))
+       (case-fold-search nil)
        response ret-val top-ng append-serv use-list-active start)
     (with-temp-buffer
       (set-buffer-multibyte nil)
@@ -456,6 +468,7 @@ Don't cache if nil.")
          (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
       (unless (setq response (elmo-nntp-list-folders-get-cache
                              (elmo-nntp-folder-group-internal folder)
+                             (elmo-net-folder-server-internal folder)
                              (current-buffer)))
        (when (setq use-list-active (elmo-nntp-list-active-p session))
          (elmo-nntp-send-command
@@ -475,6 +488,7 @@ Don't cache if nil.")
                  (setq elmo-nntp-list-folders-cache
                        (list (current-time)
                              (elmo-nntp-folder-group-internal folder)
+                             (elmo-net-folder-server-internal folder)
                              response)))
                (erase-buffer)
                (insert response))
@@ -487,7 +501,7 @@ Don't cache if nil.")
              (error "NNTP List folders failed"))
          (when elmo-nntp-list-folders-use-cache
            (setq elmo-nntp-list-folders-cache
-                 (list (current-time) nil response)))
+                 (list (current-time) nil nil response)))
          (erase-buffer)
          (setq start nil)
          (while (string-match (concat "^"
@@ -589,9 +603,9 @@ Don't cache if nil.")
      (goto-char (point-min))
      (read (current-buffer)))))
 
-(luna-define-method elmo-folder-list-messages-internal ((folder
-                                                        elmo-nntp-folder)
-                                                       &optional nohide)
+(luna-define-method elmo-folder-list-messages-plugged ((folder
+                                                       elmo-nntp-folder)
+                                                      &optional nohide)
   (let ((session (elmo-nntp-get-session folder))
        (group   (elmo-nntp-folder-group-internal folder))
        response numbers use-listgroup)
@@ -689,10 +703,6 @@ Don't cache if nil.")
     ("xref" . 8)))
 
 (defun elmo-nntp-create-msgdb-from-overview-string (str
-                                                   new-mark
-                                                   already-mark
-                                                   seen-mark
-                                                   important-mark
                                                    seen-list
                                                    &optional numlist)
   (let (ov-list gmark message-id seen
@@ -754,11 +764,11 @@ Don't cache if nil.")
                                 (elmo-file-cache-get message-id))
                                (if seen
                                    nil
-                                 already-mark)
+                                 elmo-msgdb-unread-cached-mark)
                              (if seen
                                  (if elmo-nntp-use-cache
-                                     seen-mark)
-                               new-mark))))
+                                     elmo-msgdb-read-uncached-mark)
+                               elmo-msgdb-new-mark))))
            (setq mark-alist
                  (elmo-msgdb-mark-append mark-alist
                                          num gmark))))
@@ -766,16 +776,10 @@ Don't cache if nil.")
     (list overview number-alist mark-alist)))
 
 (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
-                                             numbers new-mark already-mark
-                                             seen-mark important-mark
-                                             seen-list)
-  (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark
-                                seen-mark important-mark
-                                seen-list))
-
-(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark
-                                            seen-mark important-mark
-                                            seen-list)
+                                             numbers seen-list)
+  (elmo-nntp-folder-msgdb-create folder numbers seen-list))
+
+(defun elmo-nntp-folder-msgdb-create (folder numbers seen-list)
   (let ((filter numbers)
        (session (elmo-nntp-get-session folder))
        beg-num end-num cur length
@@ -804,10 +808,6 @@ Don't cache if nil.")
                     ret-val
                     (elmo-nntp-create-msgdb-from-overview-string
                      ov-str
-                     new-mark
-                     already-mark
-                     seen-mark
-                     important-mark
                      seen-list
                      filter
                      )))))
@@ -829,8 +829,7 @@ Don't cache if nil.")
         'elmo-nntp-msgdb-create "Getting overview..." 100)))
     (if (not use-xover)
        (setq ret-val (elmo-nntp-msgdb-create-by-header
-                      session numbers
-                      new-mark already-mark seen-mark seen-list))
+                      session numbers seen-list))
       (with-current-buffer (elmo-network-session-buffer session)
        (if ov-str
            (setq ret-val
@@ -838,10 +837,6 @@ Don't cache if nil.")
                   ret-val
                   (elmo-nntp-create-msgdb-from-overview-string
                    ov-str
-                   new-mark
-                   already-mark
-                   seen-mark
-                   important-mark
                    seen-list
                    filter))))))
     (elmo-folder-set-killed-list-internal
@@ -902,13 +897,11 @@ Don't cache if nil.")
                   (nconc number-alist
                          (list (cons max-number nil))))))))))
 
-(defun elmo-nntp-msgdb-create-by-header (session numbers
-                                                new-mark already-mark
-                                                seen-mark seen-list)
+(defun elmo-nntp-msgdb-create-by-header (session numbers seen-list)
   (with-temp-buffer
     (elmo-nntp-retrieve-headers session (current-buffer) numbers)
     (elmo-nntp-msgdb-create-message
-     (length numbers) new-mark already-mark seen-mark seen-list)))
+     (length numbers) seen-list)))
 
 (defun elmo-nntp-parse-xhdr-response (string)
   (let (response)
@@ -963,12 +956,14 @@ 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 :after
+(luna-define-method elmo-message-fetch-with-cache-process :around
   ((folder elmo-nntp-folder) number strategy &optional section unread)
-  (elmo-nntp-setup-crosspost-buffer folder number)
-  (unless unread
-    (elmo-nntp-folder-update-crosspost-message-alist
-     folder (list number))))
+  (when (luna-call-next-method)
+    (elmo-nntp-setup-crosspost-buffer folder number)
+    (unless unread
+      (elmo-nntp-folder-update-crosspost-message-alist
+       folder (list number)))
+    t))
 
 (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
                                                number strategy
@@ -1071,16 +1066,13 @@ Don't cache if nil.")
     (elmo-folder-set-killed-list-internal folder killed-list))
   t)
 
-(luna-define-method elmo-folder-exists-p ((folder elmo-nntp-folder))
+(luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder))
   (let ((session (elmo-nntp-get-session folder)))
-    (if (elmo-folder-plugged-p folder)
-       (progn
          (elmo-nntp-send-command
           session
           (format "group %s"
                   (elmo-nntp-folder-group-internal folder)))
-         (elmo-nntp-read-response session))
-      t)))
+    (elmo-nntp-read-response session)))
 
 (defun elmo-nntp-retrieve-field (spec field from-msgs)
   "Retrieve FIELD values from FROM-MSGS.
@@ -1124,27 +1116,27 @@ Returns a list of cons cells like (NUMBER . VALUE)"
        numbers))
      ((or (string= "since" search-key)
          (string= "before" search-key))
-      (let* ((key-date (elmo-date-get-datevec (elmo-filter-value condition)))
-            (key-datestr (elmo-date-make-sortable-string key-date))
+      (let* ((specified-date (elmo-date-make-sortable-string
+                             (elmo-date-get-datevec (elmo-filter-value
+                                                     condition))))
             (since (string= "since" search-key))
-            result)
+            field-date  result)
        (if (eq (elmo-filter-type condition) 'unmatch)
            (setq since (not since)))
        (setq result
              (delq nil
                    (mapcar
                     (lambda (pair)
+                      (setq field-date
+                            (elmo-date-make-sortable-string
+                             (timezone-fix-time
+                              (cdr pair)
+                              (current-time-zone) nil)))
                       (if (if since
-                              (string< key-datestr
-                                       (elmo-date-make-sortable-string
-                                        (timezone-fix-time
-                                         (cdr pair)
-                                         (current-time-zone) nil)))
-                            (not (string< key-datestr
-                                          (elmo-date-make-sortable-string
-                                           (timezone-fix-time
-                                            (cdr pair)
-                                            (current-time-zone) nil)))))
+                              (or (string= specified-date field-date)
+                                  (string< specified-date field-date))
+                            (string< field-date
+                                     specified-date))
                           (car pair)))
                     (elmo-nntp-retrieve-field spec "date" from-msgs))))
        (if from-msgs
@@ -1171,27 +1163,37 @@ Returns a list of cons cells like (NUMBER . VALUE)"
            (elmo-list-filter from-msgs result)
          result))))))
 
-(luna-define-method elmo-folder-search ((folder elmo-nntp-folder)
-                                       condition &optional from-msgs)
+(defun elmo-nntp-search-internal (folder condition from-msgs)
   (let (result)
     (cond
      ((vectorp condition)
       (setq result (elmo-nntp-search-primitive
                    folder condition from-msgs)))
      ((eq (car condition) 'and)
-      (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
+      (setq result (elmo-nntp-search-internal folder
+                                             (nth 1 condition)
+                                             from-msgs)
            result (elmo-list-filter result
-                                    (elmo-folder-search
+                                    (elmo-nntp-search-internal
                                      folder (nth 2 condition)
                                      from-msgs))))
      ((eq (car condition) 'or)
-      (setq result (elmo-folder-search folder (nth 1 condition) from-msgs)
+      (setq result (elmo-nntp-search-internal folder
+                                             (nth 1 condition)
+                                             from-msgs)
            result (elmo-uniq-list
                    (nconc result
-                          (elmo-folder-search folder (nth 2 condition)
-                                              from-msgs)))
+                          (elmo-nntp-search-internal folder
+                                                     (nth 2 condition)
+                                                     from-msgs)))
            result (sort result '<))))))
 
+(luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
+                                               condition &optional from-msgs)
+  (if (elmo-folder-plugged-p folder)
+      (elmo-nntp-search-internal folder condition from-msgs)
+    (luna-call-next-method)))
+
 (defun elmo-nntp-get-folders-info-prepare (folder session-keys)
   (condition-case ()
       (let ((session (elmo-nntp-get-session folder))
@@ -1375,8 +1377,7 @@ Returns a list of cons cells like (NUMBER . VALUE)"
 
 ;; end of from Gnus
 
-(defun elmo-nntp-msgdb-create-message (len new-mark
-                                          already-mark seen-mark seen-list)
+(defun elmo-nntp-msgdb-create-message (len seen-list)
   (save-excursion
     (let (beg overview number-alist mark-alist
              entity i num gmark seen message-id)
@@ -1415,11 +1416,11 @@ Returns a list of cons cells like (NUMBER . VALUE)"
                                   (elmo-file-cache-get message-id))
                                  (if seen
                                      nil
-                                   already-mark)
+                                   elmo-msgdb-unread-cached-mark)
                                (if seen
                                    (if elmo-nntp-use-cache
-                                       seen-mark)
-                                 new-mark))))
+                                       elmo-msgdb-read-uncached-mark)
+                                 elmo-msgdb-new-mark))))
                    (setq mark-alist
                          (elmo-msgdb-mark-append
                           mark-alist
@@ -1439,9 +1440,6 @@ Returns a list of cons cells like (NUMBER . VALUE)"
 (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
   elmo-nntp-use-cache)
 
-(luna-define-method elmo-folder-creatable-p ((folder elmo-nntp-folder))
-  nil)
-
 (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
   (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
        ngs)
@@ -1518,10 +1516,11 @@ Returns a list of cons cells like (NUMBER . VALUE)"
         folder
         (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
 
-(luna-define-method elmo-folder-mark-as-read ((folder elmo-nntp-folder)
-                                             numbers)
-  (elmo-nntp-folder-update-crosspost-message-alist folder numbers)
-  t)
+(luna-define-method elmo-folder-mark-as-read :before ((folder
+                                                      elmo-nntp-folder)
+                                                     numbers
+                                                     &optional ignore-flags)
+  (elmo-nntp-folder-update-crosspost-message-alist folder numbers))
 
 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)
                                                   &optional
@@ -1555,19 +1554,12 @@ Returns a list of cons cells like (NUMBER . VALUE)"
                                          elmo-crosspost-message-alist)))
     (elmo-nntp-folder-set-reads-internal folder reads)))
 
-(luna-define-method elmo-folder-list-unreads-internal
-  ((folder elmo-nntp-folder) unread-marks mark-alist)
+(luna-define-method elmo-folder-list-unreads :around ((folder
+                                                      elmo-nntp-folder))
   ;;    2.3. elmo-folder-list-unreads return unread message list according to
   ;;         `reads' slot.
-  (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist
-                                   (elmo-folder-msgdb folder)))))
-    (elmo-living-messages (delq nil
-                               (mapcar
-                                (lambda (x)
-                                  (if (member (nth 1 x) unread-marks)
-                                      (car x)))
-                                mark-alist))
-                         (elmo-nntp-folder-reads-internal folder))))
+  (elmo-living-messages (luna-call-next-method)
+                       (elmo-nntp-folder-reads-internal folder)))
 
 (require 'product)
 (product-provide (provide 'elmo-nntp) (require 'elmo-version))