Merge from emacs--devo--0
[gnus] / lisp / nnmairix.el
index 1a9fe4f..6ed5868 100644 (file)
@@ -6,20 +6,20 @@
 ;; Keywords: mail searching
 ;; Version: 0.5
 
-;; This file is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -42,7 +42,7 @@
 ;; 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:
 ;; * Support of more back ends (nnmh, nnfolder, nnmbox...)?
 ;; * Maybe use an active file instead of group parameters?
 ;; * Use "-a" when updating groups which are not newly created
+
 ;;; Changelog:
 ;;
 ;; 02/06/2008 - version 0.5
-;; 
+;;
 ;;    * New function: nnmairix-goto-original-article. Uses the
 ;;      registry or the mail file path for determining original group.
-;; 
+;;
 ;;    * Deal with empty Xref header
 ;;
 ;;    * Changed summary mode keybindings since the old ones were
 ;; 18/11/2007 - version 0.3
 ;;
 ;;    * Fixed bugs when dealing with nnml and native servers
-;;     
+;;
 ;;    * Make variables customizable
 ;;
 ;; 10/10/2007 - version 0.2
@@ -215,19 +215,19 @@ server for each nnmairix search group.  The name on the back end
 server will be this prefix plus a random number.  You can delete
 unused nnmairix groups on the back end using
 `nnmairix-purge-old-groups'."
-  :version "23.0"
+  :version "23.1"
   :type 'string
   :group 'nnmairix)
 
 (defcustom nnmairix-mairix-output-buffer "*mairix output*"
   "Buffer used for mairix output."
-  :version "23.0"
+  :version "23.1"
   :type 'string
   :group 'nnmairix)
 
 (defcustom nnmairix-customize-query-buffer "*mairix query*"
   "Name of the buffer for customizing Mairix queries."
-  :version "23.0"
+  :version "23.1"
   :type 'string
   :group 'nnmairix)
 
@@ -236,13 +236,13 @@ unused nnmairix groups on the back end using
 The default is '-F' and '-Q' for making updates faster.  You
 should call mairix without these options from time to
 time (e.g. via cron job)."
-  :version "23.0"
+  :version "23.1"
   :type '(repeat string)
   :group 'nnmairix)
 
 (defcustom nnmairix-mairix-synchronous-update nil
   "Set this to t if you want Emacs to wait for mairix updating the database."
-  :version "23.0"
+  :version "23.1"
   :type 'boolean
   :group 'nnmairix)
 
@@ -252,7 +252,7 @@ When using nnml as backend, mairix might produce holes in the
 article numbers which will produce wrong article counts by
 Gnus.  This option controls whether nnmairix should rename the
 files consecutively."
-  :version "23.0"
+  :version "23.1"
   :type 'boolean
   :group 'nnmairix)
 
@@ -268,7 +268,7 @@ fields in interactive query customization.  The header specifies
 which header contents should be inserted into the editable field
 when creating a Mairix query based on the current message (can be
 nil for disabling this)."
-  :version "23.0"
+  :version "23.1"
   :type '(repeat (list
                  (choice :tag "Field"
                          (const :tag "none" nil)
@@ -285,7 +285,7 @@ nil for disabling this)."
   (lambda () (select-window (get-largest-window)))
   "Function for selecting the window for customizing the mairix query.
 The default chooses the largest window in the current frame."
-  :version "23.0"
+  :version "23.1"
   :type 'function
   :group 'nnmairix)
 
@@ -336,12 +336,12 @@ temporary searches, e.g. nnmairix-search.")
 
 ;;; === Internal variables
 
-(defvar nnmairix-group-regexp
+(defconst nnmairix-group-regexp
   (format "%s-\\(.*\\)-[0-9]+" nnmairix-group-prefix)
   "Regexp for mairix groups on back end.")
 
-(defvar nnmairix-valid-backends '(nnimap nnml nnmaildir)
-  "Back ends (hopefully...) supported by nnmairix.
+(defconst nnmairix-valid-backends '(nnimap nnml nnmaildir)
+  "Backends supported by nnmairix.
 Other backends might or might not work.")
 
 (defvar nnmairix-last-server nil
@@ -351,7 +351,7 @@ Other backends might or might not work.")
   "Current server.")
 
 ;;; === Gnus backend functions
-  
+
 (nnoo-define-basics nnmairix)
 
 (gnus-declare-backend "nnmairix" 'mail 'address)
@@ -432,7 +432,8 @@ Other backends might or might not work.")
         "request-scan" folder nnmairix-backend-server)
        (if fast
            t
-         (nnmairix-request-group-with-article-number-correction folder qualgroup)))
+         (nnmairix-request-group-with-article-number-correction
+          folder qualgroup)))
        ((and (= rval 1)
             (save-excursion (set-buffer nnmairix-mairix-output-buffer)
                             (goto-char (point-min))
@@ -536,7 +537,7 @@ Other backends might or might not work.")
        t)
     nil))
 
-                
+
 (nnoo-define-skeleton nnmairix)
 
 
@@ -677,7 +678,7 @@ All necessary information will be queried from the user."
            (gnus-group-set-parameter group 'query query)
            (nnmairix-update-and-clear-marks group)))
       (error "This is no nnmairix group"))))
-                 
+
 
 (defun nnmairix-group-toggle-threads-this-group (&optional threads)
   "Toggle threads parameter for this group.
@@ -698,7 +699,7 @@ If THREADS is a negative number, set it to nil."
            (message "Threads deacitavted for group %s" group))
          (nnmairix-update-and-clear-marks group))
       (error "This is no nnmairix group"))))
-        
+
 
 (defun nnmairix-search (query &optional server threads)
   "Sends QUERY to nnmairix backend SERVER, using default its search group.
@@ -883,9 +884,9 @@ search in raw mode."
        ;; registry was not available or did not find article
        ;; so we search again with mairix in raw mode to get filename
        (nnmairix-open-server server)
-       (setq rval 
-             (nnmairix-call-mairix-binary-raw 
-              (split-string nnmairix-mairix-command) 
+       (setq rval
+             (nnmairix-call-mairix-binary-raw
+              (split-string nnmairix-mairix-command)
               (list (concat "m:" mid))))
        (if (zerop rval)
            ;; determine original group(s) from filename
@@ -897,12 +898,12 @@ search in raw mode."
                      allgroups)
                (forward-line 1))
              (if (> (length allgroups) 1)
-                 (setq group 
-                       (completing-read 
-                        "Message exists in more than one group. Choose: " 
+                 (setq group
+                       (completing-read
+                        "Message exists in more than one group. Choose: "
                         allgroups nil t))
                (setq group (car allgroups))))
-         (error "Mairix could not find original article. See buffer %s for details" 
+         (error "Mairix could not find original article. See buffer %s for details"
                 nnmairix-mairix-output-buffer))))
     (if group
        ;; show article in summary buffer
@@ -919,10 +920,10 @@ search in raw mode."
     (setq maildirflag (string-match ".+\\..+\\..+" filename))
     (when maildirflag
       (setq path
-           (replace-regexp-in-string 
+           (replace-regexp-in-string
             ".*\\(/cur\\|/new\\|/tmp\\)$" "" path t t 1)))
     ;; we first check nnml and nnmaildir servers
-    (setq 
+    (setq
      group
      (catch 'found
        (dolist (cur gnus-opened-servers)
@@ -931,12 +932,12 @@ search in raw mode."
                   (and maildirflag
                        (eq (caar cur) 'nnmaildir)))
           ;; get base path from server
-          (if maildirflag 
-              (setq serverbase (cadr (assoc 'directory (car cur))))               
+          (if maildirflag
+              (setq serverbase (cadr (assoc 'directory (car cur))))
             (setq serverbase (cadr (assoc 'nnml-directory (car cur))))
             (when (not serverbase)
               (setq serverbase nnml-directory)))
-          (setq serverbase (file-name-as-directory 
+          (setq serverbase (file-name-as-directory
                             (expand-file-name serverbase)))
           (when (string-match (concat serverbase "\\(.*\\)") path)
             ;; looks good - rest of the path should be the group
@@ -961,14 +962,14 @@ search in raw mode."
        (setq group (replace-match "/" t t group)))
       (dolist (cur gnus-opened-servers)
        (when (eq (caar cur) 'nnimap)
-         (when (gnus-group-entry 
+         (when (gnus-group-entry
                 (gnus-group-prefixed-name group (car cur)))
-           (push 
+           (push
             (gnus-group-prefixed-name group (car cur))
             allgroups))))
       (if (> (length allgroups) 1)
-         (setq group (completing-read 
-                      "Group %s exists on more than one IMAP server. Choose: " 
+         (setq group (completing-read
+                      "Group %s exists on more than one IMAP server. Choose: "
                       allgroups nil t))
        (setq group (car allgroups))))
     group))
@@ -979,8 +980,7 @@ search in raw mode."
 (defun nnmairix-request-group-with-article-number-correction (folder qualgroup)
   "Request FOLDER on backend for nnmairix QUALGROUP and article number correction."
   (save-excursion
-    (nnmairix-call-backend
-     "request-group" folder nnmairix-backend-server)
+    (nnmairix-call-backend "request-group" folder nnmairix-backend-server)
     (set-buffer nnmairix-mairix-output-buffer)
     (goto-char (point-min))
     (re-search-forward "^Matched.*messages")
@@ -1174,25 +1174,24 @@ MAIRIXGROUP.  NUMC contains values for article number correction."
       (set-buffer nntp-server-buffer)
       (goto-char (point-min))
       (nnheader-message 7 "nnmairix: Rewriting headers...")
-      (mapcar
-       (function
-       (lambda (article)
-         (when (or (looking-at (number-to-string article))
-                   (nnheader-find-nov-line article))
-           (setq cur (nnheader-parse-nov))
-           (when corr
-                 (setq article (+ (mail-header-number cur) numc))
-                 (mail-header-set-number cur article))
-           (setq xref (mail-header-xref cur))
-           (when (and (stringp xref)
-                      (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
-             (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
-             (mail-header-set-xref cur xref))
-           (set-buffer buf)
-           (nnheader-insert-nov cur)
-           (set-buffer nntp-server-buffer)
-           (when (not (eobp))
-             (forward-line 1)))))
+      (mapc
+       (lambda (article)
+         (when (or (looking-at (number-to-string article))
+                   (nnheader-find-nov-line article))
+           (setq cur (nnheader-parse-nov))
+           (when corr
+             (setq article (+ (mail-header-number cur) numc))
+             (mail-header-set-number cur article))
+           (setq xref (mail-header-xref cur))
+           (when (and (stringp xref)
+                      (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
+             (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
+             (mail-header-set-xref cur xref))
+           (set-buffer buf)
+           (nnheader-insert-nov cur)
+           (set-buffer nntp-server-buffer)
+           (when (not (eobp))
+             (forward-line 1))))
        articles)
       (nnheader-message 7 "nnmairix: Rewriting headers... done")
       (kill-buffer nntp-server-buffer)
@@ -1283,7 +1282,7 @@ group."
          (when (gnus-group-jump-to-group group)
            (gnus-group-get-new-news-this-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."
@@ -1318,7 +1317,7 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
     (gnus-summary-exit))
   (pop-to-buffer gnus-group-buffer)
   (gnus-group-jump-to-group group)
-  (gnus-summary-read-group group 1 t)  
+  (gnus-summary-read-group group 1 t)
   (gnus-summary-refer-article mid)
   (gnus-summary-limit-to-headers (format "message-id: <%s>" mid))
   (gnus-summary-select-article)
@@ -1349,13 +1348,13 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
       (mapcar
        (function
        (lambda (field)
-         (list (caddr field)
+         (list (car (cddr field))
                (if (car field)
                    (nnmairix-replace-illegal-chars
                     (gnus-fetch-field (car field)))
                  nil))))
        nnmairix-widget-fields-list))))
-  
+
 
 (defun nnmairix-widget-search (&optional mvalues)
   "Create mairix query interactively using graphical widgets.
@@ -1433,7 +1432,7 @@ If WITHVALUES is t, query is based on current article."
     (dolist (cur nnmairix-widget-fields-list)
       ;; See if checkbox is checked
       (when (widget-value
-            (cadr (assoc (concat "c" (caddr cur)) widgets)))
+            (cadr (assoc (concat "c" (car (cddr cur))) widgets)))
        ;; create query for the field
        (push
         (concat
@@ -1441,7 +1440,7 @@ If WITHVALUES is t, query is based on current article."
          ":"
          (nnmairix-replace-illegal-chars
           (widget-value
-          (cadr (assoc (concat "e" (caddr cur)) widgets)))))
+          (cadr (assoc (concat "e" (car (cddr cur))) widgets)))))
         query)))
     ;; Flags
     (when (member 'flags nnmairix-widget-other)
@@ -1505,7 +1504,7 @@ VALUES may contain values for editable fields from current article."
     (mapc
      (function
       (lambda (field)
-       (setq field (caddr field))
+       (setq field (car (cddr field)))
        (setq ret
              (nconc
               (list