[Emacs-diffs] scratch/gnus-search 221b872 12/12: WIP on Mairix server

[Eric Abrahamsen]

branch: scratch/gnus-search
commit 221b872978e163d1fd7ff29fe113c20520fee9f4
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    WIP on Mairix server
---
 lisp/gnus/gnus-search.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 121 insertions(+)

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index f4554b3..836b9da 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -338,6 +338,60 @@ This variable can also be set per-server."
   :type 'boolean
   :group 'gnus-search)
 
+(defcustom gnus-search-mairix-program "mairix"
+  "Name of mairix search executable.
+
+This variable can also be set per-server."
+  :version "26.3"
+  :type 'string
+  :group 'gnus-search)
+
+(defcustom gnus-search-mairix-configuration-file
+  (expand-file-name "~/.mairixrc")
+  "Configuration file for mairix.
+
+This variable can also be set per-server."
+  :version "26.3"
+  :type 'file
+  :group 'gnus-search)
+
+(defcustom gnus-search-mairix-additional-switches '()
+  "A list of strings, to be given as additional arguments to mairix.
+
+Note that this should be a list.  I.e., do NOT use the following:
+    (setq gnus-search-mairix-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+    (setq gnu-search-mairix-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+  :version "26.3"
+  :type '(repeat string)
+  :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+This variable can also be set per-server."
+  :version "26.3"
+  :type 'regexp
+  :group 'gnus-search)
+
+(defcustom gnus-search-mairix-raw-queries-p nil
+  "If t, all Mairix engines will only accept raw search query
+  strings."
+  :version "26.3"
+  :type 'boolean
+  :group 'gnus-search)
+
+(defcustom gnus-search-imap-raw-queries-p nil
+  "If t, all IMAP engines will only accept raw search query
+  strings."
+  :version "26.3"
+  :type 'boolean
+  :group 'gnus-search)
+
 ;; Options for search language parsing.
 
 (defcustom gnus-search-expandable-keys
@@ -961,6 +1015,27 @@ quirks.")
 (eieio-oset-default 'gnus-search-mairix 'raw-queries-p
                    gnus-search-mairix-raw-queries-p)
 
+(defclass gnus-search-mairix (gnus-search-indexed)
+  ((config-file
+    :initarg :config-file
+    :type string
+    :custom file)))
+
+(eieio-oset-default 'gnus-search-mairix 'program
+                   gnus-search-mairix-program)
+
+(eieio-oset-default 'gnus-search-mairix 'switches
+                   gnus-search-mairix-additional-switches)
+
+(eieio-oset-default 'gnus-search-mairix 'prefix
+                   gnus-search-mairix-remove-prefix)
+
+(eieio-oset-default 'gnus-search-mairix 'config-file
+                   gnus-search-mairix-configuration-file)
+
+(eieio-oset-default 'gnus-search-mairix 'raw-queries-p
+                   gnus-search-mairix-raw-queries-p)
+
 (defclass gnus-search-namazu (gnus-search-indexed)
   ((index-dir
     :initarg :index-dir
@@ -1663,6 +1738,52 @@ absolute filepaths to standard out."
            (gnus-search-add-result dirnam artno "" prefix server artlist)))))
     artlist))
 
+;;; Mairix interface
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+                                                 (qstring string)
+                                                 &optional _groups)
+  (with-slots (switches config-file) engine
+    `("--rcfile" ,config-file
+      "-r" ; "raw": output filepaths, don't create a directory.
+      ,@switches
+      ,qstring                         ; the query, in mairix format
+      )))
+
+(cl-defmethod gnus-search-indexed-massage-output ((engine gnus-search-mairix)
+                                                 server &optional groups)
+  ;; The results are output in the format of:
+  ;; absolute-path-name
+  (let ((article-pattern (if (string-match "\\`nnmaildir:"
+                                          (gnus-group-server server))
+                            ":[0-9]+"
+                          "^[0-9]+$"))
+       (prefix (slot-value engine 'prefix))
+       (group-regexp (when groups
+                       (regexp-opt
+                        (mapcar
+                         (lambda (x) (gnus-group-real-name x))
+                         groups))))
+       artno dirnam filenam artlist)
+    (goto-char (point-min))
+    (while (not (eobp))
+      (setq filenam (buffer-substring-no-properties (line-beginning-position)
+                                                    (line-end-position))
+            artno (file-name-nondirectory filenam)
+            dirnam (file-name-directory filenam))
+      (forward-line 1)
+
+      ;; don't match directories
+      (when (string-match article-pattern artno)
+       (when (not (null dirnam))
+
+         ;; maybe limit results to matching groups.
+         (when (or (not groups)
+                   (string-match-p group-regexp dirnam))
+           (gnus-search-add-result dirnam artno "" prefix server artlist)))))
+    artlist))
+
+
 ;;; Find-grep interface
 
 (cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)