cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-virtual-thread.el

   1 ;; -*- Mode: Emacs-Lisp -*-
   2 ;;  $Id: mew-virtual-thread.el,v 1.1 2000-05-23 08:31:16 steveb Exp $
   3 ;;
   4 ;; mew-virtual-thread.el --- "Virtual Thread mode for Mew, easy and safety :-)"
   5 ;;
   6 ;;                         "Hideyuki SHIRAI" <shirai@rdmg.mgcs.mei.co.jp>
   7 ;;                                            Created: <05/25/1999>
   8 ;;                                Revised: Time-stamp: <09/02/1999 11:08 shirai>
   9 ;;
  10 ;;; Usage
  11 ;;; 1. Put a below line on your ~/.emacs.
  12 ;; (eval-after-load "mew" '(require 'mew-virtual-thread))
  13 ;;
  14 ;;; 2. When type the "T" in summary-mode, list the threaded messages.
  15 ;;;    Selection of the messages has the four ways as described below.
  16 ;;;
  17 ;;;  2.1. without "C-u" and no "review mark".
  18 ;;;       => 'matched input REGEXP' messages.
  19 ;;;  2.2. without "C-u" and some "review mark".
  20 ;;;       => marked messages.
  21 ;;;  2.3. with "C-u" and the region.
  22 ;;;       => messages in the region.
  23 ;;;  2.4. with "C-u" and no region.
  24 ;;;       => messages after point.
  25 ;;;
  26 ;;; 3. When type the "T" in virtual-thread-mode with any marks,
  27 ;;;    The marks transfer to original folder.
  28 ;;;
  29
  30 (defconst mew-virtual-thread-version "mew-virtual-thread.el 0.16")
  31
  32 (eval-when-compile (require 'mew))
  33
  34 (defvar mew-virtual-thread-get-remote t
  35   "If non-nil, get remote folder's messages, before make a threaded summary buffer.")
  36
  37 (add-hook 'mew-summary-mode-hook
  38           '(lambda ()
  39              (define-key mew-summary-mode-map "T" 'mew-virtual-thread)))
  40
  41 (defun mew-virtual-thread (&optional arg)
  42   "\"Virtual Thread Mode\" execute."
  43   (interactive "P")
  44   (if (and (eq major-mode 'mew-virtual-mode)
  45            mew-virtual-thread-original-folder)
  46       (mew-virtual-thread-mark-transfer arg)
  47     (mew-summary-only
  48      (if (not (mew-summary-exclusive-p))
  49          ()
  50        (let* ((fld (buffer-name))
  51               (src fld)
  52               range beg end)
  53          (if (not arg)
  54              (progn
  55                (setq range (mew-summary-mark-collect
  56                             mew-mark-review (point-min) (point-max)))
  57                (if range
  58                    ()
  59                  (call-interactively 'mew-virtual-thread-mark-regexp)
  60                  (setq range (mew-summary-mark-collect
  61                               mew-mark-review (point-min) (point-max)))
  62                  (mew-summary-batch-unmark (list mew-mark-review) nil)))
  63            (if (or (and (boundp 'mark-active) mark-active)
  64                    (and (functionp 'region-exists-p) (region-exists-p)))
  65                (setq range (mew-virtual-thread-number
  66                             (min (region-beginning) (region-end))
  67                             (max (region-beginning) (region-end))))
  68              (setq range (mew-virtual-thread-number
  69                           (progn (beginning-of-line) (point)) (point-max)))))
  70          (or (listp range) (setq range (list range)))
  71          (if (and mew-virtual-thread-get-remote (mew-folder-remotep fld))
  72              (save-excursion
  73                (goto-char (point-min))
  74                (re-search-forward (concat "^ *" (car range)))
  75                (beginning-of-line)
  76                (mapcar (function
  77                         (lambda (msg)
  78                           (if (re-search-forward (concat "^ *" msg) nil t)
  79                               (beginning-of-line))
  80                           (mew-summary-im-start
  81                            mew-prog-imcat fld nil msg nil nil
  82                            mew-cs-text-for-read 'noinsert)))
  83                        range)
  84                (if (mew-folder-newsp fld)
  85                    (setq src (expand-file-name (substring fld 1) mew-temp-dir))
  86                  (setq src (mew-imap-folder-dir fld mew-temp-dir)))))
  87          (if range
  88              (mew-virtual-thread-scan
  89               fld src
  90               (mew-virtual-thread-range-conv range))
  91            (message "Can't make Virtual thread mode.")))))))
  92
  93 (defun mew-virtual-thread-mark-transfer (&optional arg)
  94   (interactive "P")
  95   (if (not (and (eq major-mode 'mew-virtual-mode)
  96                 mew-virtual-thread-original-folder))
  97       (message "This command can be used in Virtual Thread mode only.")
  98     (let ((review-msgs (mew-summary-mark-collect
  99                         mew-mark-review (point-min) (point-max)))
 100           (multi-msgs (mew-summary-mark-collect
 101                        mew-mark-multi (point-min) (point-max)))
 102           (orig-fld mew-virtual-thread-original-folder)
 103           (thread-buffer (get-buffer (current-buffer)))
 104           tmp-msgs)
 105       (setq review-msgs (mew-uniq-list
 106                          (sort (mapcar 'string-to-int review-msgs) '<)))
 107       (setq multi-msgs (mew-uniq-list
 108                         (sort (mapcar 'string-to-int multi-msgs) '<)))
 109       (setq tmp-msgs multi-msgs)
 110       (while tmp-msgs
 111         (if (memq (car tmp-msgs) review-msgs)
 112             (setq multi-msgs (delete (car tmp-msgs) multi-msgs)))
 113         (setq tmp-msgs (cdr tmp-msgs)))
 114       (if (not (or review-msgs multi-msgs))
 115           (message "No mark collect.")
 116         (if (null arg)
 117             (mew-kill-buffer))
 118         (mew-virtual-thread-goto-folder orig-fld)
 119         (save-excursion
 120           (and (or (mew-summary-mark-collect
 121                     mew-mark-review (point-min) (point-max))
 122                    (mew-summary-mark-collect
 123                     mew-mark-multi (point-min) (point-max)))
 124                (y-or-n-p (format "Unmark '%c', '%c' ? "
 125                                  mew-mark-review mew-mark-multi))
 126                (mew-summary-batch-unmark (list mew-mark-review mew-mark-multi) 'msg))
 127           (goto-char (point-min))
 128           (let (msg)
 129             (while (search-forward-regexp "^ *\\([1-9][0-9]*\\)" nil t)
 130               (setq msg (string-to-number (mew-match 1)))
 131               (if (and (not (mew-in-decode-syntax-p))
 132                        (not (mew-summary-marked-p)))
 133                   (cond
 134                    ((memq msg review-msgs)
 135                     (mew-summary-mark-as mew-mark-review))
 136                    ((memq msg multi-msgs)
 137                     (mew-summary-mark-as mew-mark-multi))))))
 138           (set-buffer-modified-p nil)
 139           (delete-other-windows)
 140           (if (null arg)
 141               ()
 142             (split-window-vertically)
 143             (mew-pop-to-buffer thread-buffer))
 144           (message "Mark transfer done."))))))
 145
 146 (defun mew-virtual-thread-mark-regexp (regex)
 147   (interactive "sVirtual Thread Regexp: ")
 148   (if (not (equal regex ""))
 149       (save-excursion
 150         (goto-char (point-min))
 151         (while (and (not (eobp))
 152                     (re-search-forward regex nil t))
 153           (if (or (mew-in-decode-syntax-p)
 154                   (mew-summary-marked-p))
 155               ()
 156             (mew-summary-mark-as mew-mark-review))
 157           (forward-line)))))
 158
 159 (defun mew-virtual-thread-number (beg end)
 160   (let (msgs)
 161     (save-excursion
 162       (goto-char beg)
 163       (while (re-search-forward "^ *\\([1-9][0-9]*\\)" end t)
 164         (if (or (mew-summary-marked-p) (mew-in-decode-syntax-p))
 165             ()
 166           (setq msgs (cons (mew-match 1) msgs)))))
 167     (nreverse msgs)))
 168
 169 (defun mew-virtual-thread-range-conv (range)
 170   (let (num snum enum ret)
 171     (message "Range conversion start...")
 172     (while range
 173       (setq num (string-to-number (car range)))
 174       (cond
 175        ((not snum)
 176         (setq snum num))
 177        ((and snum (not enum))
 178         (if (= num (1+ snum))
 179             (setq enum num)
 180           (setq ret (cons (number-to-string snum) ret))
 181           (setq snum num)))
 182        (t ;; (and snum enum)
 183         (if (= num (1+ enum))
 184             (setq enum num)
 185           (setq ret (cons (concat (number-to-string snum)
 186                                   "-"
 187                                   (number-to-string enum))
 188                           ret))
 189           (setq snum num)
 190           (setq enum nil))))
 191       ;; final message
 192       (if (null (setq range (cdr range)))
 193           (cond
 194            ((not enum)
 195             (if (= num (1+ snum))
 196                 (setq ret (cons (concat (number-to-string snum)
 197                                         "-"
 198                                         (number-to-string num))
 199                                 ret))
 200               (setq ret (cons (number-to-string num) ret))))
 201            (t ;; (enum)
 202             (setq ret (cons (concat (number-to-string snum)
 203                                     "-"
 204                                     (number-to-string enum))
 205                             ret))))))
 206     (nreverse ret)))
 207
 208 (defvar mew-virtual-thread-original-folder nil)
 209 (make-variable-buffer-local 'mew-virtual-thread-original-folder)
 210
 211 (defun mew-virtual-thread-scan (fld src range)
 212   (let ((vfld (if (mew-folder-remotep fld)
 213                   (concat "++" fld "-thread")
 214                 (concat "++" (substring fld 1) "-thread")))
 215         buf num)
 216     (setq buf (get-buffer-create vfld))
 217     (switch-to-buffer buf)
 218     (if (not (mew-summary-exclusive-p))
 219         ()
 220       (setq mew-virtual-thread-original-folder fld)
 221       (delete-other-windows)
 222       (if (eq major-mode 'mew-virtual-mode)
 223           ()
 224         (mew-virtual-mode)
 225         (mew-folder-setup (buffer-name))
 226         (mew-buffers-setup (buffer-name)))
 227       (setq buffer-read-only nil)
 228       (buffer-disable-undo)
 229       (goto-char (point-max))
 230       (condition-case nil
 231           (let ((process-connection-type mew-connection-type1))
 232             (message "Listing %s ..." vfld)
 233             (setq mew-summary-buffer-start-point (point))
 234             (setq mew-summary-buffer-string nil) ;; just in case
 235             (mew-piolet
 236              mew-cs-virtual mew-cs-dummy
 237              (setq mew-summary-buffer-process
 238                    (apply (function start-process)
 239                           mew-prog-imls ;; name
 240                           (current-buffer)
 241                           mew-prog-imls ;; program
 242                           (format "--width=%d" (if mew-summary-scan-width
 243                                                    mew-summary-scan-width
 244                                                  (if (< (window-width) 80)
 245                                                      80
 246                                                    (window-width))))
 247                           (format "--mimedecodequoted=%s" (if mew-decode-quoted
 248                                                               "yes" "no"))
 249                           (append mew-prog-im-arg
 250                                   (list
 251                                    "--thread=yes"
 252                                    (concat "--src=" src))
 253                                   (if (listp range)
 254                                       range
 255                                     (list range))))))
 256             (mew-set-process-cs mew-summary-buffer-process
 257                                 mew-cs-virtual mew-cs-dummy)
 258             (set-process-filter mew-summary-buffer-process
 259                                 'mew-virtual-thread-scan-filter)
 260             (set-process-sentinel mew-summary-buffer-process
 261                                   'mew-summary-scan-sentinel)
 262             (setq mew-summary-buffer-reviews nil)
 263             (process-kill-without-query mew-summary-buffer-process))
 264         (quit
 265          (set-process-sentinel mew-summary-buffer-process nil)
 266          (setq mew-summary-buffer-start-point nil)
 267          (setq mew-summary-buffer-process nil)
 268          (setq mew-summary-buffer-string nil)
 269          (setq mew-summary-buffer-reviews nil)))
 270       (setq buffer-read-only t)
 271       (set-buffer-modified-p nil))))
 272
 273 (defun mew-virtual-thread-scan-filter (process string)
 274   (let* ((after-change-function nil)
 275          (after-change-functions nil)
 276          (obuf (current-buffer))
 277          (opos (point))
 278          (omax (point-max))
 279          (prog (process-name process))
 280          (regex-wrong-pw
 281           (format "^%s: ERROR: invalid password (\\([^\)]+\\))[^\n]*\n"
 282                   prog))
 283          (regex-err
 284           (format "^%s: ERROR: [^\n]*\n" prog))
 285          (regex-passwd "^Password (\\([^\)]+\\))")
 286          wpw fld)
 287     ;; save-excursion is not usefule because sometime we want to
 288     ;; move the cursor forward.
 289     (set-buffer (process-buffer process)) ;; necessary
 290     (setq fld mew-virtual-thread-original-folder)
 291     (setq mew-summary-buffer-string
 292           (concat mew-summary-buffer-string string)) ;; nil can concat
 293     (if (string-match regex-wrong-pw mew-summary-buffer-string)
 294         (progn
 295           (setq wpw (mew-match 1 mew-summary-buffer-string))
 296           (mew-passwd-set-passwd wpw nil)
 297           (setq mew-summary-buffer-wrong-pws
 298                 (cons wpw mew-summary-buffer-wrong-pws))
 299           (mew-summary-scan-filter-skip)))
 300     (if (string-match regex-err mew-summary-buffer-string)
 301         (progn
 302           (setq mew-summary-buffer-wrong-pws
 303                 (cons 'mew-err mew-summary-buffer-wrong-pws))
 304           (mew-summary-scan-filter-skip)))
 305     (if (string-match regex-passwd mew-summary-buffer-string)
 306         (progn
 307           (process-send-string
 308            process
 309            (format "%s\n" (mew-summary-scan-passwd
 310                            (mew-match 1 mew-summary-buffer-string))))
 311           (setq mew-summary-buffer-string "")))
 312     ;; just for imls
 313     (while (string-match "^\\( *\\([0-9]+\\).*\\)\n" mew-summary-buffer-string)
 314       (goto-char (point-max))
 315       ;; the cursor moves forward!
 316       (let ((buffer-read-only nil))
 317         (insert (mew-match 1 mew-summary-buffer-string)
 318                 "\r " fld " " (mew-match 2 mew-summary-buffer-string)
 319                 "\n"))
 320       (setq mew-summary-buffer-string
 321             (substring mew-summary-buffer-string (match-end 0))))
 322     (if (or (equal opos mew-summary-buffer-start-point)
 323             (not (equal opos omax)))
 324         ;; move the cursor to the original position.
 325         (goto-char opos))
 326     (set-buffer obuf)))
 327
 328 (defun mew-virtual-thread-goto-folder (fld)
 329   (mew-summary-goto-folder nil fld)
 330   (while (processp mew-summary-buffer-process)
 331     (sit-for 1)
 332     (discard-input)))
 333
 334 (provide 'mew-virtual-thread)
 335
 336 ;; end here.