[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-pick.el

[Bill Wohler]

Index: emacs/lisp/mh-e/mh-pick.el
diff -c emacs/lisp/mh-e/mh-pick.el:1.1 emacs/lisp/mh-e/mh-pick.el:1.2
*** emacs/lisp/mh-e/mh-pick.el:1.1      Sat Jan 25 21:38:37 2003
--- emacs/lisp/mh-e/mh-pick.el  Mon Feb  3 15:55:30 2003
***************
*** 30,36 ****
  
  ;;; Change Log:
  
! ;; $Id: mh-pick.el,v 1.1 2003/01/26 02:38:37 wohler Exp $
  
  ;;; Code:
  
--- 30,36 ----
  
  ;;; Change Log:
  
! ;; $Id: mh-pick.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
  
  ;;; Code:
  
***************
*** 44,71 ****
    "Keymap for searching folder.")
  
  (defvar mh-searching-folder nil)        ;Folder this pick is searching.
  
  ;;;###mh-autoload
! (defun mh-search-folder (folder)
    "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."))))
  
  (defun mh-make-pick-template ()
    "Initialize the current buffer with a template for a pick pattern."
!   (erase-buffer)
    (insert "From: \n"
            "To: \n"
            "Cc: \n"
--- 44,77 ----
    "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 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'.
! 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."
!   (let ((inhibit-read-only t)) (erase-buffer))
    (insert "From: \n"
            "To: \n"
            "Cc: \n"
***************
*** 74,93 ****
            "---------\n")
    (mh-pick-mode)
    (goto-char (point-min))
!   (end-of-line))
  
  ;;; 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]))
  
  
  ;;; Help Messages
  ;;; Group messages logically, more or less.
  (defvar mh-pick-mode-help-messages
    '((nil
!      "Search messages:  \\[mh-do-pick-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.
--- 80,108 ----
            "---------\n")
    (mh-pick-mode)
    (goto-char (point-min))
!   (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-pick-do-search t]))
  
  
  ;;; Help Messages
  ;;; Group messages logically, more or less.
  (defvar mh-pick-mode-help-messages
    '((nil
!      "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,117 ****
  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.
  
  The value of `mh-pick-mode-hook' is a list of functions to be called,
  with no arguments, upon entry to this mode.
--- 126,132 ----
  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-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,126 ****
  \\{mh-pick-mode-map}"
  
    (make-local-variable 'mh-searching-folder)
!   (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))
  
--- 134,142 ----
  \\{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)
    (setq mh-help-messages mh-pick-mode-help-messages)
    (run-hooks 'mh-pick-mode-hook))
  
***************
*** 128,168 ****
  (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'."
    (interactive)
!   (let ((pattern-buffer (buffer-name))
!         (searching-buffer mh-searching-folder)
!         range
!         msgs
!         (pattern nil)
!         (new-buffer nil))
      (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))))
              (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
      (message "Searching...done")
!     (if new-buffer
!         (mh-scan-folder searching-buffer msgs)
!       (switch-to-buffer searching-buffer))
      (mh-add-msgs-to-seq msgs 'search)
      (delete-other-windows)))
  
  (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
--- 144,201 ----
  (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-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 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 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 (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,211 ****
        (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))))
  
  
  
--- 214,279 ----
        (setq msgs (nreverse msgs))       ;put in ascending order
        msgs)))
  
! (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,219 ****
  ;;; 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-f\C-b"        mh-to-field
    "\C-c\C-f\C-c"        mh-to-field
    "\C-c\C-f\C-d"        mh-to-field
--- 281,289 ----
  ;;; 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-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