diff lisp/mh-e/mh-pick.el @ 49578:b35587af8747

Upgraded to MH-E version 7.2. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

--- a/lisp/mh-e/mh-pick.el	Mon Feb 03 16:39:05 2003 +0000
+++ b/lisp/mh-e/mh-pick.el	Mon Feb 03 20:55:30 2003 +0000
@@ -30,7 +30,7 @@
 
 ;;; Change Log:
 
-;; $Id: mh-pick.el,v 1.10 2003/01/08 23:21:16 wohler Exp $
+;; $Id: mh-pick.el,v 1.30 2003/01/27 04:16:47 wohler Exp $
 
 ;;; Code:
 
@@ -44,28 +44,34 @@
   "Keymap for searching folder.")
 
 (defvar mh-searching-folder nil)        ;Folder this pick is searching.
+(defvar mh-searching-function nil)
 
 ;;;###mh-autoload
-(defun mh-search-folder (folder)
+(defun mh-search-folder (folder window-config)
   "Search FOLDER for messages matching a pattern.
 This function uses the MH command `pick' to do the work.
-Add the messages found to the sequence named `search'."
-  (interactive (list (mh-prompt-for-folder "Search"
-                                           mh-current-folder
-                                           t)))
-  (switch-to-buffer-other-window "pick-pattern")
-  (if (or (zerop (buffer-size))
-          (not (y-or-n-p "Reuse pattern? ")))
-      (mh-make-pick-template)
-    (message ""))
-  (setq mh-searching-folder folder)
-  (message "%s" (substitute-command-keys
-                 (concat "Type \\[mh-do-pick-search] to search messages, "
-                         "\\[mh-help] for help."))))
+Add the messages found to the sequence named `search'.
+Argument WINDOW-CONFIG is the current window configuration and is used when
+the search folder is dismissed."
+  (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t)
+                     (current-window-configuration)))
+  (let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
+    (switch-to-buffer-other-window "search-pattern")
+    (if (or (zerop (buffer-size))
+            (not (y-or-n-p "Reuse pattern? ")))
+        (mh-make-pick-template)
+      (message ""))
+    (setq mh-searching-function 'mh-pick-do-search
+          mh-searching-folder pick-folder
+          mh-current-folder folder
+          mh-previous-window-config window-config)
+    (message "%s" (substitute-command-keys
+                   (concat "Type \\[mh-do-search] to search messages, "
+                           "\\[mh-help] for help.")))))
 
 (defun mh-make-pick-template ()
   "Initialize the current buffer with a template for a pick pattern."
-  (erase-buffer)
+  (let ((inhibit-read-only t)) (erase-buffer))
   (insert "From: \n"
           "To: \n"
           "Cc: \n"
@@ -74,20 +80,29 @@
           "---------\n")
   (mh-pick-mode)
   (goto-char (point-min))
-  (end-of-line))
+  (dotimes (i 5)
+    (add-text-properties (point) (1+ (point)) '(front-sticky t))
+    (add-text-properties (- (line-end-position) 2) (1- (line-end-position))
+                         '(rear-nonsticky t))
+    (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+    (forward-line))
+  (add-text-properties (point) (1+ (point)) '(front-sticky t))
+  (add-text-properties (point) (1- (line-end-position)) '(read-only t))
+  (goto-char (point-max)))
 
 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
 (easy-menu-define
   mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
   '("Pick"
-    ["Execute the Search"       mh-do-pick-search t]))
+    ["Execute the Search"       mh-pick-do-search t]))
 
 
 ;;; Help Messages
 ;;; Group messages logically, more or less.
 (defvar mh-pick-mode-help-messages
   '((nil
-     "Search messages:  \\[mh-do-pick-search]\n"
+     "Search messages using pick:  \\[mh-pick-do-search]\n"
+     "Search messages using index:  \\[mh-index-do-search]\n"
      "Move to a field by typing C-c C-f C-<field>\n"
      "where <field> is the first letter of the desired field."))
   "Key binding cheat sheet.
@@ -111,7 +126,7 @@
 entire message, supply the pattern in the \"body\" of the template.
 Each non-empty field must be matched for a message to be selected.
 To effect a logical \"or\", use \\[mh-search-folder] multiple times.
-When you have finished, type  \\[mh-do-pick-search]  to do the search.
+When you have finished, type  \\[mh-pick-do-search]  to do the search.
 
 The value of `mh-pick-mode-hook' is a list of functions to be called,
 with no arguments, upon entry to this mode.
@@ -119,8 +134,9 @@
 \\{mh-pick-mode-map}"
 
   (make-local-variable 'mh-searching-folder)
+  (make-local-variable 'mh-searching-function)
+  (make-local-variable 'mh-help-messages)
   (easy-menu-add mh-pick-menu)
-  (make-local-variable 'mh-help-messages)
   (setq mh-help-messages mh-pick-mode-help-messages)
   (run-hooks 'mh-pick-mode-hook))
 
@@ -128,41 +144,58 @@
 (defun mh-do-pick-search ()
   "Find messages that match the qualifications in the current pattern buffer.
 Messages are searched for in the folder named in `mh-searching-folder'.
+Add the messages found to the sequence named `search'.
+
+This is a deprecated function and `mh-pick-do-search' should be used instead."
+  (interactive)
+  (mh-pick-do-search))
+
+;;;###mh-autoload
+(defun mh-pick-do-search ()
+  "Find messages that match the qualifications in the current pattern buffer.
+Messages are searched for in the folder named in `mh-searching-folder'.
 Add the messages found to the sequence named `search'."
   (interactive)
-  (let ((pattern-buffer (buffer-name))
-        (searching-buffer mh-searching-folder)
-        range
-        msgs
-        (pattern nil)
-        (new-buffer nil))
+  (let ((pattern-list (mh-pick-parse-search-buffer))
+        (folder mh-searching-folder)
+        (new-buffer-flag nil)
+        (window-config mh-previous-window-config)
+        range pick-args msgs)
+    (unless pattern-list
+      (error "No search pattern specified"))
     (save-excursion
-      (cond ((get-buffer searching-buffer)
-             (set-buffer searching-buffer)
-             (setq range (list (format "%d-%d"
-                                       mh-first-msg-num mh-last-msg-num))))
+      (cond ((get-buffer folder)
+             (set-buffer folder)
+             (setq range (if (and mh-first-msg-num mh-last-msg-num)
+                             (format "%d-%d" mh-first-msg-num mh-last-msg-num)
+                           "all")))
             (t
-             (mh-make-folder searching-buffer)
-             (setq range '("all"))
-             (setq new-buffer t))))
-    (message "Searching...")
-    (goto-char (point-min))
-    (while (and range
-                (setq pattern (mh-next-pick-field pattern-buffer)))
-      (setq msgs (mh-seq-from-command searching-buffer
-                                      'search
-                                      (mh-list-to-string
-                                       (list "pick" pattern searching-buffer
-                                             "-list"
-                                             (mh-coalesce-msg-list range)))))
-      (setq range msgs))                ;restrict the pick range for next pass
+             (mh-make-folder folder)
+             (setq range "all")
+             (setq new-buffer-flag t))))
+    (setq pick-args (mh-pick-regexp-builder pattern-list))
+    (when pick-args
+      (setq msgs (mh-seq-from-command folder 'search
+                                      `("pick" ,folder ,range ,@pick-args))))
     (message "Searching...done")
-    (if new-buffer
-        (mh-scan-folder searching-buffer msgs)
-      (switch-to-buffer searching-buffer))
+    (if (not new-buffer-flag)
+        (switch-to-buffer folder)
+      (mh-scan-folder folder msgs)
+      (setq mh-previous-window-config window-config))
     (mh-add-msgs-to-seq msgs 'search)
     (delete-other-windows)))
 
+;;;###mh-autoload
+(defun mh-do-search ()
+  "Use the default searching function.
+If \\[mh-search-folder] was used to create the search pattern then pick is used
+to search the folder. Otherwise if \\[mh-index-search] was used then the
+indexing program specified in `mh-index-program' is used."
+  (interactive)
+  (if (symbolp mh-searching-function)
+      (funcall mh-searching-function)
+    (error "No searching function defined")))
+
 (defun mh-seq-from-command (folder seq command)
   "In FOLDER, make a sequence named SEQ by executing COMMAND.
 COMMAND is a list.  The first element is a program name
@@ -181,31 +214,66 @@
       (setq msgs (nreverse msgs))       ;put in ascending order
       msgs)))
 
-(defun mh-next-pick-field (buffer)
-  "Return the next piece of a pick argument extracted from BUFFER.
-Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
-or nil if no pieces remain."
-  (set-buffer buffer)
-  (let ((case-fold-search t))
-    (cond ((eobp)
-           nil)
-          ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
-                              nil t)
-           (let* ((component
-                   (format "--%s"
-                           (downcase (buffer-substring (match-beginning 1)
-                                                       (match-end 1)))))
-                  (pat (buffer-substring (match-beginning 2) (match-end 2))))
-             (forward-line 1)
-             (list component pat)))
-          ((re-search-forward "^-*$" nil t)
-           (forward-char 1)
-           (let ((body (buffer-substring (point) (point-max))))
-             (if (and (> (length body) 0) (not (equal body "\n")))
-                 (list "-search" body)
-               nil)))
-          (t
-           nil))))
+(defun mh-pick-parse-search-buffer ()
+  "Parse the search buffer contents.
+The function returns a alist. The car of each element is either the header name
+to search in or nil to search the whole message. The cdr of the element is the
+pattern to search."
+  (save-excursion
+    (let ((pattern-list ())
+          (in-body-flag nil)
+          start begin)
+      (goto-char (point-min))
+      (while (not (eobp))
+        (if (search-forward "--------" (line-end-position) t)
+            (setq in-body-flag t)
+          (beginning-of-line)
+          (setq begin (point))
+          (setq start (if in-body-flag
+                          (point)
+                        (search-forward ":" (line-end-position) t)
+                        (point)))
+          (push (cons (and (not in-body-flag)
+                           (intern (downcase
+                                    (buffer-substring-no-properties
+                                     begin (1- start)))))
+                      (mh-index-parse-search-regexp
+                       (buffer-substring-no-properties
+                        start (line-end-position))))
+                pattern-list))
+        (forward-line))
+      pattern-list)))
+
+
+
+;; Functions specific to how pick works...
+(defun mh-pick-construct-regexp (expr component)
+  "Construct pick compatible expression corresponding to EXPR.
+COMPONENT is the component to search."
+  (cond ((atom expr) (list component expr))
+        ((eq (car expr) 'and)
+         `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-and"
+           ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
+        ((eq (car expr) 'or)
+         `("-lbrace" ,@(mh-pick-construct-regexp (cadr expr) component) "-or"
+           ,@(mh-pick-construct-regexp (caddr expr) component) "-rbrace"))
+        ((eq (car expr) 'not)
+         `("-lbrace" "-not" ,@(mh-pick-construct-regexp (cadr expr) component)
+           "-rbrace"))
+        (t (error "Unknown operator '%s' seen" (car expr)))))
+
+(defun mh-pick-regexp-builder (pattern-list)
+  "Generate pick search expression from PATTERN-LIST."
+  (let ((result ()))
+    (dolist (pattern pattern-list)
+      (when (cdr pattern)
+        (setq result `(,@result "-and" "-lbrace"
+                       ,@(mh-pick-construct-regexp
+                          (cdr pattern) (if (car pattern)
+                                            (format "-%s" (car pattern))
+                                          "-search"))
+                       "-rbrace"))))
+    (cdr result)))
 
 
 
@@ -213,7 +281,9 @@
 ;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
 (gnus-define-keys  mh-pick-mode-map
   "\C-c?"               mh-help
-  "\C-c\C-c"            mh-do-pick-search
+  "\C-c\C-i"            mh-index-do-search
+  "\C-c\C-p"            mh-pick-do-search
+  "\C-c\C-c"            mh-do-search
   "\C-c\C-f\C-b"        mh-to-field
   "\C-c\C-f\C-c"        mh-to-field
   "\C-c\C-f\C-d"        mh-to-field