1;;; mh-pick --- make a search pattern and search for a message in mh-e 2;; Time-stamp: <93/08/22 22:56:53 gildea> 3 4;; Copyright 1993 Free Software Foundation, Inc. 5 6;; This file is part of mh-e. 7 8;; mh-e is free software; you can redistribute it and/or modify 9;; it under the terms of the GNU General Public License as published by 10;; the Free Software Foundation; either version 2, or (at your option) 11;; any later version. 12 13;; mh-e is distributed in the hope that it will be useful, 14;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16;; GNU General Public License for more details. 17 18;; You should have received a copy of the GNU General Public License 19;; along with mh-e; see the file COPYING. If not, write to 20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 21 22;;; Commentary: 23 24;; Internal support for mh-e package. 25 26;;; Code: 27 28(provide 'mh-pick) 29(require 'mh-e) 30 31(defvar mh-pick-mode-map (make-sparse-keymap) 32 "Keymap for searching folder.") 33 34(defvar mh-pick-mode-hook nil 35 "Invoked in `mh-pick-mode' on a new pattern.") 36 37(defvar mh-searching-folder nil 38 "Folder this pick is searching.") 39 40(defun mh-search-folder (folder) 41 "Search FOLDER for messages matching a pattern." 42 (interactive (list (mh-prompt-for-folder "Search" 43 mh-current-folder 44 t))) 45 (switch-to-buffer-other-window "pick-pattern") 46 (if (or (zerop (buffer-size)) 47 (not (y-or-n-p "Reuse pattern? "))) 48 (mh-make-pick-template) 49 (message "")) 50 (setq mh-searching-folder folder)) 51 52(defun mh-make-pick-template () 53 ;; Initialize the current buffer with a template for a pick pattern. 54 (erase-buffer) 55 (insert "From: \n" 56 "To: \n" 57 "Cc: \n" 58 "Date: \n" 59 "Subject: \n" 60 "---------\n") 61 (mh-pick-mode) 62 (goto-char (point-min)) 63 (end-of-line)) 64 65(put 'mh-pick-mode 'mode-class 'special) 66 67(defun mh-pick-mode () 68 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map> 69After each field name, enter the pattern to search for. To search 70the entire message, supply the pattern in the \"body\" of the template. 71When you have finished, type \\[mh-do-pick-search] to do the search. 72\\{mh-pick-mode-map} 73Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook 74if that value is non-nil." 75 (interactive) 76 (kill-all-local-variables) 77 (make-local-variable 'mh-searching-folder) 78 (use-local-map mh-pick-mode-map) 79 (setq major-mode 'mh-pick-mode) 80 (mh-set-mode-name "MH-Pick") 81 (run-hooks 'mh-pick-mode-hook)) 82 83 84(defun mh-do-pick-search () 85 "Find messages that match the qualifications in the current pattern buffer. 86Messages are searched for in the folder named in mh-searching-folder. 87Add messages found to the sequence named `search'." 88 (interactive) 89 (let ((pattern-buffer (buffer-name)) 90 (searching-buffer mh-searching-folder) 91 range msgs 92 (pattern nil) 93 (new-buffer nil)) 94 (save-excursion 95 (cond ((get-buffer searching-buffer) 96 (set-buffer searching-buffer) 97 (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num))) 98 (t 99 (mh-make-folder searching-buffer) 100 (setq range "all") 101 (setq new-buffer t)))) 102 (message "Searching...") 103 (goto-char (point-min)) 104 (while (setq pattern (mh-next-pick-field pattern-buffer)) 105 (setq msgs (mh-seq-from-command searching-buffer 106 'search 107 (nconc (cons "pick" pattern) 108 (list searching-buffer 109 range 110 "-sequence" "search" 111 "-list")))) 112 (setq range "search")) 113 (message "Searching...done") 114 (if new-buffer 115 (mh-scan-folder searching-buffer msgs) 116 (switch-to-buffer searching-buffer)) 117 (delete-other-windows) 118 (mh-notate-seq 'search ?% (1+ mh-cmd-note)))) 119 120 121(defun mh-seq-from-command (folder seq seq-command) 122 ;; In FOLDER, make a sequence named SEQ by executing COMMAND. 123 ;; COMMAND is a list. The first element is a program name 124 ;; and the subsequent elements are its arguments, all strings. 125 (let ((msg) 126 (msgs ()) 127 (case-fold-search t)) 128 (save-excursion 129 (save-window-excursion 130 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command)) 131 (while (setq msg (car (mh-read-msg-list))) 132 (setq msgs (cons msg msgs)) 133 (forward-line 1)))) 134 (set-buffer folder) 135 (setq msgs (nreverse msgs)) ; Put in ascending order 136 (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list)) 137 msgs))) 138 139 140(defun mh-next-pick-field (buffer) 141 ;; Return the next piece of a pick argument that can be extracted from the 142 ;; BUFFER. Returns nil if no pieces remain. 143 (set-buffer buffer) 144 (let ((case-fold-search t)) 145 (cond ((eobp) 146 nil) 147 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t) 148 (let* ((component 149 (format "--%s" 150 (downcase (buffer-substring (match-beginning 1) 151 (match-end 1))))) 152 (pat (buffer-substring (match-beginning 2) (match-end 2)))) 153 (forward-line 1) 154 (list component pat))) 155 ((re-search-forward "^-*$" nil t) 156 (forward-char 1) 157 (let ((body (buffer-substring (point) (point-max)))) 158 (if (and (> (length body) 0) (not (equal body "\n"))) 159 (list "-search" body) 160 nil))) 161 (t 162 nil)))) 163 164;;; Build the pick-mode keymap: 165 166(define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search) 167(define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field) 168(define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field) 169(define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field) 170(define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field) 171(define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field) 172(define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field) 173(define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field) 174(define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field) 175(define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field) 176(define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field) 177(define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom) 178