Give a better error message in the "go offline" case.
[gnus] / lisp / nnmairix.el
index 10a9660..26d95b2 100644 (file)
@@ -1,6 +1,6 @@
 ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
 
-;; Copyright (C) 2007, 2008  Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: David Engster <dengste@eml.cc>
 ;; Keywords: mail searching
@@ -23,9 +23,6 @@
 
 ;;; Commentary:
 
-;; THIS IS BETA SOFTWARE! This back end should not mess up or
-;; even delete your mails, but having a backup is always a good idea.
-
 ;; This is a back end for using the mairix search engine with
 ;; Gnus.  Mairix is a tool for searching words in locally stored
 ;; mail.  Mairix is very fast which allows using it efficiently for
 ;;
 ;; Mairix is written by Richard Curnow.  More information can be found at
 ;; http://www.rpcurnow.force9.co.uk/mairix/
-;;
-;; For details about setting up mairix&Gnus&nnmairix.el, look at the
-;; emacswiki:
-;;
-;; http://www.emacswiki.org/cgi-bin/wiki/GnusMairix
-;;
-;; The newest version of nnmairix.el can be found at
-;;
-;; http://www.emacswiki.org/cgi-bin/emacs/nnmairix.el
-
-;; For impatient people, here's the setup in a nutshell:
-;;
-;; This back end requires an installed mairix binary which is
-;; configured to index your mail folder.  You don't have to specify a
-;; search folder (but it does no harm, either).  Visit the man page of
-;; mairix and mairixrc for details.
-;;
-;; Put nnmairix.el into your search path and "(require 'nnmarix)" into
-;; your .gnus.  Then call nnmairix-create-default-group (or 'G b
-;; c'). This function will ask for all necessary information to create
-;; a mairix server in Gnus with the default search folder.  This
-;; default search folder will be used for all temporary searches: call
-;; nnmairix-search ('G b s') and enter a mairix query (like
-;; f:test@example.com). To create a mairix group for one specific
-;; search query, use 'G b g'.  See the emacswiki or the source for more
-;; information.
 
 ;; Commentary on the code: nnmairix sits between Gnus and the "real"
 ;; back end which handles the mail (currently nnml, nnimap and
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))       ;For (pop (cdr ogroup)).
+
 (require 'nnoo)
 (require 'gnus-group)
 (require 'gnus-sum)
 (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
 (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)
 
+;; ;;;###autoload
+;; (defun nnmairix-initalize (&optional force)
+;;   (interactive "P")
+;;   (if (not (or (file-readable-p "~/.mairixrc")
+;;            force))
+;;       (message "No file `~/.mairixrc', skipping nnmairix setup")
+;;     (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
+;;     (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)))
 
 ;; Customizable stuff
 
@@ -443,7 +424,7 @@ Other back ends might or might not work.")
   (setq nnmairix-current-server server)
   (nnoo-change-server 'nnmairix server definitions))
 
-(deffoo nnmairix-request-group (group &optional server fast)
+(deffoo nnmairix-request-group (group &optional server fast info)
   ;; Call mairix and request group on back end server
   (when server (nnmairix-open-server server))
   (let* ((qualgroup (if server
@@ -464,8 +445,7 @@ Other back ends might or might not work.")
       nil)
      ((not query)
       ;; No query -> return empty group
-      (save-excursion
-       (set-buffer nntp-server-buffer)
+      (with-current-buffer nntp-server-buffer
        (erase-buffer)
        (insert (concat "211 0 1 0 " group))
        t))
@@ -512,7 +492,7 @@ Other back ends might or might not work.")
        (when (eq nnmairix-backend 'nnml)
          (when nnmairix-rename-files-for-nnml
            (nnmairix-rename-files-consecutively mfolder))
-         (nnml-generate-nov-databases-directory mfolder))
+         (nnml-generate-nov-databases-directory mfolder nil t))
        (nnmairix-call-backend
         "request-scan" folder nnmairix-backend-server)
        (if (and fast allowfast)
@@ -520,9 +500,9 @@ Other back ends might or might not work.")
          (nnmairix-request-group-with-article-number-correction
           folder qualgroup)))
        ((and (= rval 1)
-            (save-excursion (set-buffer nnmairix-mairix-output-buffer)
-                            (goto-char (point-min))
-                            (looking-at "^Matched 0 messages")))
+            (with-current-buffer nnmairix-mairix-output-buffer
+              (goto-char (point-min))
+              (looking-at "^Matched 0 messages")))
        ;; No messages found -> return empty group
        (nnheader-message 5 "Mairix: No matches found.")
        (set-buffer nntp-server-buffer)
@@ -575,8 +555,13 @@ Other back ends might or might not work.")
            (mapcar
             (lambda (arg) (- arg numcorr))
             articles)))
-    (setq rval (nnmairix-call-backend
-               "retrieve-headers" articles folder nnmairix-backend-server fetch-old))
+    (setq rval
+         (if (eq nnmairix-backend 'nnimap)
+             (let ((gnus-nov-is-evil t))
+               (nnmairix-call-backend
+                "retrieve-headers" articles folder nnmairix-backend-server fetch-old))
+           (nnmairix-call-backend
+            "retrieve-headers" articles folder nnmairix-backend-server fetch-old)))
     (when (eq rval 'nov)
       (nnmairix-replace-group-and-numbers articles folder group numcorr)
       rval)))
@@ -598,8 +583,7 @@ Other back ends might or might not work.")
   (when server (nnmairix-open-server server))
   (if (nnmairix-call-backend "request-list" nnmairix-backend-server)
       (let (cpoint cur qualgroup folder)
-       (save-excursion
-         (set-buffer nntp-server-buffer)
+       (with-current-buffer nntp-server-buffer
          (goto-char (point-min))
          (setq cpoint (point))
          (while (re-search-forward nnmairix-group-regexp (point-max) t)
@@ -619,6 +603,12 @@ Other back ends might or might not work.")
        t)
     nil))
 
+;; Silence byte-compiler.
+(defvar gnus-registry-install)
+(autoload 'gnus-registry-fetch-group "gnus-registry")
+(autoload 'gnus-registry-fetch-groups "gnus-registry")
+(autoload 'gnus-registry-add-group "gnus-registry")
+
 (deffoo nnmairix-request-set-mark (group actions &optional server)
   (when server
     (nnmairix-open-server server))
@@ -707,13 +697,14 @@ Other back ends might or might not work.")
       (when (or (eq nnmairix-propagate-marks-upon-close t)
                (and (eq nnmairix-propagate-marks-upon-close 'ask)
                     (y-or-n-p "Propagate marks to original articles? ")))
-      (save-excursion
-       (set-buffer gnus-group-buffer)
+      (with-current-buffer gnus-group-buffer
        (nnmairix-propagate-marks)
        ;; update mairix group
        (gnus-group-jump-to-group qualgroup)
        (gnus-group-get-new-news-this-group))))))
 
+(autoload 'nnimap-request-update-info-internal "nnimap")
+
 (deffoo nnmairix-request-update-info (group info &optional server)
 ;; propagate info from underlying IMAP folder to nnmairix group
 ;; This is currently experimental and must be explicitly activated
@@ -859,7 +850,7 @@ All necessary information will be queried from the user."
   (interactive)
   (let* ((name (read-string "Name of the mairix server: "))
        (server (completing-read "Back end server (TAB for completion): "
-                                (nnmairix-get-valid-servers)))
+                                (nnmairix-get-valid-servers) nil 1))
        (mairix (read-string "Command to call mairix: " "mairix"))
        (defaultgroup (read-string "Default search group: "))
        (backend (symbol-name (car (gnus-server-to-method server))))
@@ -1004,8 +995,7 @@ with m:msgid of the current article and enabled threads."
     (if server
        (if (gnus-buffer-live-p gnus-article-buffer)
            (progn
-             (save-excursion
-               (set-buffer gnus-article-buffer)
+             (with-current-buffer gnus-article-buffer
                (gnus-summary-toggle-header 1)
                (setq mid (message-fetch-field "Message-ID")))
              (while (string-match "[<>]" mid)
@@ -1027,8 +1017,7 @@ f:current_from."
     (if server
        (if (gnus-buffer-live-p gnus-article-buffer)
            (progn
-             (save-excursion
-               (set-buffer gnus-article-buffer)
+             (with-current-buffer gnus-article-buffer
                (gnus-summary-toggle-header 1)
                (setq from (cadr (gnus-extract-address-components
                                  (gnus-fetch-field "From"))))
@@ -1052,8 +1041,7 @@ before deleting a group on the back end.  SERVER specifies nnmairix server."
        (when (nnmairix-call-backend
               "request-list" nnmairix-backend-server)
          (let (cur qualgroup folder)
-           (save-excursion
-             (set-buffer nntp-server-buffer)
+           (with-current-buffer nntp-server-buffer
              (goto-char (point-min))
              (while (re-search-forward nnmairix-group-regexp (point-max) t)
                (setq cur (match-string 0)
@@ -1108,13 +1096,9 @@ with `nnmairix-mairix-update-options'."
          (set-process-sentinel (apply 'start-process args)
                                'nnmairix-sentinel-mairix-update-finished))))))
 
-;; Silence byte-compiler.
-(defvar gnus-registry-install)
-(autoload 'gnus-registry-fetch-group "gnus-registry")
-
 (defun nnmairix-group-delete-recreate-this-group ()
   "Deletes and recreates group on the back end.
-You can use this function on nnmairix groups which continously
+You can use this function on nnmairix groups which continuously
 show wrong article counts."
   (interactive)
   (let* ((group (gnus-group-group-name))
@@ -1162,8 +1146,7 @@ nnmairix server. Only marks from current session will be set."
                (push (list (car ogroup) (list (list number) (nth 1 mid-marks) (nth 2 mid-marks)))
                      number-cache)))))
        ;; now we set the marks
-       (save-excursion
-         (set-buffer gnus-group-buffer)
+       (with-current-buffer gnus-group-buffer
          (nnheader-message 5 "nnmairix: Propagating marks...")
          (dolist (cur number-cache)
            (setq method (gnus-find-method-for-group (car cur)))
@@ -1209,7 +1192,8 @@ If UPDATEDB is t, database for SERVERNAME will be updated first."
          (unless (and skipdefault
                       (string= (car cur) default))
            (gnus-group-jump-to-group (car cur))
-           (gnus-group-get-new-news-this-group)))))))
+           (gnus-group-mark-group 1)))
+       (gnus-group-get-new-news-this-group)))))
 
 (defun nnmairix-remove-tick-mark-original-article ()
   "Remove tick mark from original article.
@@ -1281,9 +1265,8 @@ Marks propagation has to be enabled for this to work."
   "Call mairix binary with COMMAND, using FOLDER and SEARCHQUERY.
 If THREADS is non-nil, enable full threads."
   (let ((args (cons (car command) '(nil t nil))))
-    (save-excursion
-      (set-buffer
-       (get-buffer-create nnmairix-mairix-output-buffer))
+    (with-current-buffer
+       (get-buffer-create nnmairix-mairix-output-buffer)
       (erase-buffer)
       (when (> (length command) 1)
        (setq args (append args (cdr command))))
@@ -1300,9 +1283,8 @@ If THREADS is non-nil, enable full threads."
 (defun nnmairix-call-mairix-binary-raw (command query)
   "Call mairix binary with COMMAND and QUERY in raw mode."
   (let ((args (cons (car command) '(nil t nil))))
-    (save-excursion
-      (set-buffer
-       (get-buffer-create nnmairix-mairix-output-buffer))
+    (with-current-buffer
+       (get-buffer-create nnmairix-mairix-output-buffer)
       (erase-buffer)
       (when (> (length command) 1)
         (setq args (append args (cdr command))))
@@ -1439,8 +1421,7 @@ MAIRIXGROUP.  NUMC contains values for article number correction."
        (corr (not (zerop numc)))
        (name (buffer-name nntp-server-buffer))
        header cur xref)
-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf
       (erase-buffer)
       (set-buffer nntp-server-buffer)
       (goto-char (point-min))
@@ -1530,8 +1511,8 @@ group."
                                   folder t nnmairix-backend-server)
            (nnmairix-call-backend "request-create-group"
                                   folder nnmairix-backend-server))
-       (error "Nnmairix-delete-recreate with\
- non-mairix group!! - check folder parameter")))))
+       (error "`nnmairix-delete-recreate-group' called on \
+non-mairix group.  Check folder parameter")))))
 
 (defun nnmairix-update-and-clear-marks (group &optional method)
   "Update group and clear all marks from GROUP using METHOD."
@@ -1546,7 +1527,7 @@ group."
        (save-excursion
          (nnmairix-open-server (nth 1 method))
          (set-buffer gnus-group-buffer)
-;;       (gnus-group-set-parameter group 'propmarks nil)
+         ;; (gnus-group-set-parameter group 'propmarks nil)
          (setq info (gnus-get-info group))
          ;; Clear active and info
          (gnus-set-active group nil)
@@ -1560,7 +1541,7 @@ group."
              (gnus-group-set-parameter group 'numcorr corr)))
          (gnus-group-jump-to-group group)
          (gnus-group-get-new-news-this-group))
-      (error "Nnmairix-update-and-clear-marks - Called with non-nnmairix group"))))
+      (error "`nnmairix-update-and-clear-marks' called with non-nnmairix group"))))
 
 (defun nnmairix-sentinel-mairix-update-finished (proc status)
   "Sentinel for mairix update process PROC with STATUS."
@@ -1594,9 +1575,9 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
 DESCRIPTION will be shown to the user with the activation
 status.  If PAR is a positive number, the group parameter will be
 set to t and to nil otherwise."
-  (let*  ((method (gnus-find-method-for-group group))
-         (par (or par
-                  (not (gnus-group-get-parameter group parameter)))))
+  (let* ((method (gnus-find-method-for-group group))
+        (par (or par
+                 (not (gnus-group-get-parameter group parameter)))))
     (if (eq (car method) 'nnmairix)
        (progn
          (when (numberp par)
@@ -1609,7 +1590,6 @@ set to t and to nil otherwise."
       (error "This is no nnmairix group")
       nil)))
 
-
 ;; Search for original article helper functions
 
 (defun nnmairix-goto-original-article (&optional no-registry)
@@ -1631,8 +1611,7 @@ search in raw mode."
   (let ((server (nth 1 gnus-current-select-method))
        mid rval group allgroups)
     ;; get message id
-    (save-excursion
-      (set-buffer gnus-article-buffer)
+    (with-current-buffer gnus-article-buffer
       (gnus-summary-toggle-header 1)
       (setq mid (message-fetch-field "Message-ID"))
       ;; first check the registry (if available)
@@ -1679,12 +1658,16 @@ SERVER."
   (nnmairix-open-server server)
   (while (string-match "[<>]" mid)
     (setq mid (replace-match "" t t mid)))
+  ;; mairix somehow does not like '$' in message-id
+  (when (string-match "\\$" mid)
+    (setq mid (concat mid "=")))
+  (while (string-match "\\$" mid)
+    (setq mid (replace-match "=," t t mid)))
   (let (allgroups)
     (if (zerop (nnmairix-call-mairix-binary-raw
                (split-string nnmairix-mairix-command)
                (list (concat "m:" mid))))
-       (save-excursion
-         (set-buffer nnmairix-mairix-output-buffer)
+       (with-current-buffer nnmairix-mairix-output-buffer
          (goto-char (point-min))
          (while (re-search-forward "^/.*$" nil t)
            (push (nnmairix-get-group-from-file-path (match-string 0))
@@ -1759,6 +1742,7 @@ SERVER."
                       allgroups nil t))
        (setq group (car allgroups))))
     group))
+
 (defun nnmairix-show-original-article (group mid)
   "Switch to GROUP and display Article with message-id MID."
   (unless (string-match "^<" mid)
@@ -1824,8 +1808,6 @@ If VERSION is a string: must be contained in mairix version output."
                     (string-match "mairix \\([0-9\\.]+\\)" versionstring)
                     (match-string 1 versionstring))))))))
 
-
-
 ;; ==== Widget stuff
 
 (defvar nnmairix-widgets)
@@ -1994,7 +1976,6 @@ Fill in VALUES if based on an article."
       (nnmairix-widget-add "Threads" 'checkbox nil))
       (widget-insert " Show full threads\n\n")))
 
-
 (defun nnmairix-widget-build-editable-fields (values)
   "Build editable field widgets in `nnmairix-widget-fields-list'.
 VALUES may contain values for editable fields from current article."
@@ -2051,5 +2032,4 @@ VALUES may contain values for editable fields from current article."
 
 (provide 'nnmairix)
 
-;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94
 ;;; nnmairix.el ends here