cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-pick.el

   1 ;;; mew-pick.el --- Picking up messages for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Oct  2, 1996
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-pick-version "mew-pick.el version 0.17")
  10
  11 (require 'mew)
  12
  13 (defvar mew-pick-macro-alist nil)
  14
  15 (defun mew-summary-search ()
  16   "Pick messages according to a pick pattern which you input,
  17 then list them up."
  18   (interactive)
  19   (mew-summary-only
  20    (let ((folder (mew-input-folder (buffer-name)))
  21          (pattern nil)
  22          (range nil))
  23      (if (null (file-directory-p (mew-expand-folder folder)))
  24          (message "No such folder %s" folder)
  25        (setq pattern (mew-input-pick-pattern))
  26        (message "Picking messages in %s ..." folder)
  27        (setq range (mew-summary-pick folder pattern))
  28        (message "Picking messages in %s ... done" folder)
  29        (if (get-buffer folder)
  30            (switch-to-buffer folder)
  31          (mew-summary-folder-create folder))
  32        (if range (mew-summary-scan-body mew-prog-imls
  33                                         'mew-summary-mode
  34                                         folder
  35                                         mew-cs-scan
  36                                         (list range 'erase)))))))
  37
  38 (defun mew-summary-search-mark (&optional arg)
  39   "Pick messages according to a pick pattern which you input,
  40 then put the '*' mark onto them. If called with \"\\[universal-argument]\", target is
  41 the messages in the region."
  42   (interactive "P")
  43   (mew-summary-only
  44    (if arg
  45        (mew-summary-search-mark-region (region-beginning) (region-end))
  46      (mew-summary-search-mark-region (point-min) (point-max)))))
  47
  48 (defun mew-summary-search-mark-region (r1 r2)
  49   (interactive "r")
  50   (if (equal (point-min) (point-max))
  51       (message "No messages in this buffer.")
  52     (let ((folder (buffer-name))
  53           pattern first last range)
  54       (setq pattern (mew-input-pick-pattern))
  55       (message "Picking messages in %s ..." folder)
  56       (goto-char r1)
  57       (if (eobp)
  58           () ;; r1 <= r2, so if r1 = (point-max) then no messages.
  59         (setq first (mew-summary-message-number))
  60         (goto-char r2)
  61         (if (eobp)
  62             (progn
  63               (forward-line -1)
  64               (setq r2 (point))))
  65         (setq last (mew-summary-message-number))
  66         (setq range (mew-summary-pick folder pattern (concat first "-" last))))
  67       (message "Picking messages in %s ... done" folder)
  68       (if (null range)
  69           (message "No message to be marked.")
  70         (message "Marking messages ... ")
  71         (goto-char r1)
  72         (while (and range (< (point) r2))
  73           (if (re-search-forward (format "^[ ]*%s[^0-9]" (car range)) nil t)
  74               (if (not (mew-summary-marked-p))
  75                   (mew-summary-mark-as mew-mark-review)))
  76           (setq range (cdr range)))
  77         (beginning-of-line)
  78         (set-buffer-modified-p nil)
  79         (message "Marking messages ... done")))))
  80
  81 (defun mew-pick-define-macro (str1 str2)
  82   (interactive (list
  83                 (read-string "pick pattern: ")
  84                 (read-string "macro body: ")))
  85   ;; macro-pattern is a string including no #, or
  86   ;; a string in a form FIELD=#1 #2 #3...#n.
  87   ;; #1 can be replaced by #.
  88   (let ((args nil) (body nil))
  89     (while (string-match "\\(#[0-9]*\\)[, ]*" str1)
  90       (setq args (cons (intern (mew-match 1 str1)) args))
  91       (setq str1 (concat (substring str1 0
  92                                     (match-beginning 0))
  93                          (substring str1
  94                                     (match-end 0)))))
  95     (while (string-match "#[0-9]*" str2)
  96       (setq body
  97             (cons (substring str2 0 (match-beginning 0)) body))
  98       (setq body
  99             (cons (intern (mew-match 0 str2)) body))
 100       (setq str2
 101             (substring str2 (match-end 0))))
 102     (setq body (cons str2 body))
 103     (let ((asc (assoc str1 mew-pick-macro-alist))
 104           (value (cons (nreverse args) (nreverse body))))
 105       (if asc
 106           (setcdr asc value)
 107         (setq mew-pick-macro-alist
 108           (cons (cons str1 value) mew-pick-macro-alist))))
 109     ))
 110
 111 (defun mew-pick-macro-expand (name args)
 112   (let ((asc (assoc name mew-pick-macro-alist)))
 113     (if (not asc)
 114         name
 115       (let ((alist nil)
 116             (args2 (nth 1 asc))
 117             (body (nthcdr 2 asc))
 118             (body-copy nil))
 119         (while (and args args2)
 120           (setq alist (cons (cons (car args2) (car args)) alist))
 121           (setq args (cdr args))
 122           (setq args2 (cdr args2))
 123           )
 124         (while body
 125           (if (stringp (car body))
 126               (setq body-copy (cons (car body) body-copy))
 127             (let ((assq (assq (car body) alist)))
 128               (if assq
 129                   (setq body-copy (cons (cdr assq) body-copy)))))
 130           (setq body (cdr body)))
 131         (concat "("
 132                 (mew-pick-macro-expand-string
 133                  (apply 'concat (nreverse body-copy)))
 134                 ")")))))
 135
 136 (defun mew-pick-macro-expand-string (str)
 137   (if (string= str "")
 138       ""
 139     (let ((first (string-to-char str))
 140           (eq-flag nil))
 141       (if (memq first '(?\( ?\! ?\& ?\| ?= ? ?\)))
 142           (concat (char-to-string first)
 143                   (mew-pick-macro-expand-string (substring str 1)))
 144         (let ((key nil) (rest nil))
 145           (if (string-match "=\\| \\|)\\|&\\||" str)
 146               (if (string= (mew-match 0 str) "=")
 147                   (progn
 148                     (setq eq-flag t)
 149                     (setq key (substring str 0 (match-end 0)))
 150                     (setq rest (substring str (match-end 0))))
 151                 (setq key (substring str 0 (match-beginning 0)))
 152                 (setq rest (substring str (match-beginning 0))))
 153             (setq key str)
 154             (setq rest ""))
 155           (let ((asc (assoc key mew-pick-macro-alist)))
 156             (cond (asc
 157                    (let ((args (nth 1 asc)) (vals nil))
 158                      (while args
 159                        (if (string-match ",\\| \\|)\\|&\\||" rest)
 160                            (progn
 161                              (setq vals
 162                                    (cons
 163                                     (substring rest 0
 164                                                (match-beginning 0))
 165                                     vals))
 166                              (setq rest
 167                                    (substring rest
 168                                               (match-beginning
 169                                                0))))
 170                          (setq vals
 171                                (cons rest vals))
 172                          (setq rest ""))
 173                        (setq args (cdr args)))
 174                      (concat
 175                       (mew-pick-macro-expand key (nreverse vals))
 176                       (mew-pick-macro-expand-string rest))))
 177                   (eq-flag
 178                    (let ((val ""))
 179                      (if (string-match " \\|)\\|&\\||" rest)
 180                          (progn
 181                            (setq val (substring rest 0 (match-beginning 0)))
 182                            (setq rest (substring rest (match-beginning
 183                                                        0))))
 184                        (setq val rest)
 185                        (setq rest ""))
 186                      (concat key val
 187                              (mew-pick-macro-expand-string rest))))
 188                   (t
 189                    (concat key
 190                            (mew-pick-macro-expand-string rest))
 191                    ))))))))
 192
 193 (defun mew-pick-canonicalize-pattern (string)
 194   (let ((i 0))
 195     (while (string-match "[ \t]*\\([|&]+\\)[ \t]*" string i)
 196       (setq string (concat (substring string 0 (match-beginning 0))
 197                            " "
 198                            (mew-match 1 string)
 199                            " "
 200                            (substring string (match-end 0) nil)))
 201       (setq i (+ (match-beginning 0) 3)))
 202     string))
 203
 204 (defun mew-summary-pick (folder pattern &optional range)
 205   (let (arg msgs)
 206     (setq range (or range "all"))
 207     (save-excursion
 208       (mew-set-buffer-tmp)
 209       ;; input(result) from pick is line-based stream...
 210       (cond
 211        ((equal pattern mew-pick-duplicate-msgid)
 212         (setq arg "--dupchecktarget=message-id"))
 213        ((equal pattern mew-pick-duplicate-subj-msgid)
 214         (setq arg "--dupchecktarget=message-id+subject"))
 215        (t
 216         (setq arg (format "--expression=%s" pattern))))
 217       (mew-pioalet
 218        mew-cs-autoconv mew-cs-pick mew-cs-pick
 219        (mew-im-call-process nil mew-prog-imgrep
 220                             (format "--src=%s" folder) arg range))
 221       (goto-char (point-min))
 222       (if (search-forward "imgrep: no message" nil t)
 223           (progn
 224             (message "No such messages")
 225             nil)
 226         (goto-char (point-min))
 227         (if (search-forward "imgrep: " nil t)
 228             (progn
 229               (message "Illegal pattern")
 230               nil))
 231         (while (not (eobp))
 232           (if (looking-at "^[0-9]+$")
 233               (setq msgs (cons (mew-match 0) msgs)))
 234           (forward-line))
 235         (nreverse msgs)))))
 236
 237 (provide 'mew-pick)
 238
 239 ;;; Copyright Notice:
 240
 241 ;; Copyright (C) 1996, 1997, 1998, 1999 Mew developing team.
 242 ;; All rights reserved.
 243
 244 ;; Redistribution and use in source and binary forms, with or without
 245 ;; modification, are permitted provided that the following conditions
 246 ;; are met:
 247 ;;
 248 ;; 1. Redistributions of source code must retain the above copyright
 249 ;;    notice, this list of conditions and the following disclaimer.
 250 ;; 2. Redistributions in binary form must reproduce the above copyright
 251 ;;    notice, this list of conditions and the following disclaimer in the
 252 ;;    documentation and/or other materials provided with the distribution.
 253 ;; 3. Neither the name of the team nor the names of its contributors
 254 ;;    may be used to endorse or promote products derived from this software
 255 ;;    without specific prior written permission.
 256 ;;
 257 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 258 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 259 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 260 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 261 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 262 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 263 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 264 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 265 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 266 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 267 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 268
 269 ;;; mew-pick.el ends here