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

   1 ;;; mew-scan.el --- Scanning messages for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Oct  2, 1996
   5 ;; Revised: Aug 31, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-scan-version "mew-scan.el version 0.28")
  10
  11 (require 'mew)
  12
  13 (defvar mew-summary-inbox-position (make-marker))
  14
  15 (defun mew-summary-get (&optional arg)
  16   "Get +inbox asynchronously."
  17   (interactive "P")
  18   (let ((inbox (mew-inbox-folder)))
  19     (if (get-buffer inbox)
  20         (switch-to-buffer inbox)
  21       (mew-summary-folder-create inbox))
  22     (if (and mew-summary-trace-directory (mew-folder-localp inbox))
  23         (cd (mew-expand-folder inbox)))
  24     (mew-summary-folder-cache-manage inbox)
  25     (if (and mew-summary-cache-use (mew-summary-folder-dir-newp))
  26         (progn
  27           ;; scan the gap
  28           (or arg (goto-char (point-max)))
  29           (mew-summary-scan-body mew-prog-imls
  30                                  'mew-summary-mode
  31                                  inbox
  32                                  mew-cs-scan
  33                                  (mew-input-range
  34                                   inbox mew-range-auto-alist mew-ask-range))
  35           ;; wait for asynchronous process
  36           (if mew-xemacs-p
  37               (while mew-summary-buffer-process
  38                 (accept-process-output)
  39                 (sit-for 0.1));; to flush
  40             (while mew-summary-buffer-process (sit-for 1)))))
  41     (set-marker mew-summary-inbox-position (point) (current-buffer))
  42     ;; for C-xC-x
  43     (or arg (goto-char (point-max)))
  44     (mew-summary-scan-body mew-prog-imget
  45                            'mew-summary-mode
  46                            inbox
  47                            mew-cs-scan)))
  48
  49 (defun mew-summary-exchange-point ()
  50   "Exchange the current point and the marker."
  51   (interactive)
  52   (mew-summary-only
  53    (and (equal (buffer-name) (mew-inbox-folder)) ;; xxx
  54         (marker-position mew-summary-inbox-position)
  55         (goto-char (marker-position mew-summary-inbox-position)))))
  56
  57 (defun mew-summary-ls (&optional arg jump)
  58   "List this folder asynchronously."
  59   (interactive "P")
  60   (mew-summary-only
  61    (let* ((folder (buffer-name))
  62           (askp mew-ask-range)
  63           (alist mew-range-auto-alist)
  64           scanp range lines)
  65      (mew-summary-folder-cache-manage folder)
  66      ;; check scanp before (mew-mark-clean)
  67      (cond
  68       ((interactive-p)
  69        (setq alist mew-range-interactive-alist)
  70        (setq askp t)
  71        (setq scanp t))
  72       ((and mew-summary-cache-use mew-summary-imap-cache
  73             (not (member folder mew-summary-imap-nocache-folders))
  74             (mew-folder-imapp folder)
  75             (file-exists-p (mew-expand-folder folder mew-summary-cache-file)))
  76        (setq scanp t))
  77       ((mew-folder-remotep folder) ;; xxx
  78        (setq alist mew-range-interactive-alist)
  79        (setq askp t)
  80        (setq scanp t))
  81       ((and mew-summary-cache-use (mew-summary-folder-dir-newp))
  82        (setq scanp t)))
  83      ;;
  84      (mew-mark-clean)
  85      (set-buffer-modified-p nil)
  86      (if (or jump (mew-folder-imapp folder)) (goto-char (point-max)))
  87      (mew-buffers-setup folder)
  88      (if (not scanp)
  89          (or arg (goto-char (point-max)))
  90        (setq range (mew-input-range folder alist askp))
  91        (or arg (goto-char (point-max)))
  92        (if (equal (car range) "all")
  93            (setq lines (mew-summary-mark-collect3 mew-mark-review)))
  94        (mew-summary-scan-body mew-prog-imls
  95                               'mew-summary-mode
  96                               folder
  97                               mew-cs-scan
  98                               range
  99                               nil
 100                               nil
 101                               lines)))))
 102
 103 ;;
 104 ;; Scan
 105 ;;
 106
 107 (defun mew-summary-scan-body (prog mode folder read &optional range folders grep reviews)
 108   (save-excursion
 109     (set-buffer (get-buffer-create folder))
 110     (if (not (mew-summary-exclusive-p))
 111         ()
 112       (condition-case nil
 113           (let ((process-connection-type mew-connection-type1))
 114             (buffer-disable-undo (current-buffer))
 115             (if (not (equal major-mode mode)) (funcall mode))
 116             (mew-window-configure (current-buffer) 'summary)
 117             (mew-current-set 'message nil)
 118             (mew-current-set 'part nil)
 119             (mew-current-set 'cache nil)
 120             (setq mew-summary-buffer-direction 'down)
 121             (mew-decode-syntax-delete)
 122             (cond
 123              ((string-match mew-prog-imget prog)
 124               (if (string= mew-config-imget mew-config-default)
 125                   (message "Getting %s ..." folder)
 126                 (message "Getting %s (%s)..." folder mew-config-imget)))
 127              ((string-match mew-prog-imls prog)
 128               (message "Listing %s ..." folder)
 129               (if (or (equal 'erase (car (cdr range)))
 130                       (equal mode 'mew-virtual-mode))
 131                   (mew-erase-buffer))))
 132             (setq mew-summary-buffer-start-point (point))
 133             (setq mew-summary-buffer-string nil) ;; just in case
 134             (setq mew-summary-buffer-config mew-config-imget)
 135             (setq mew-summary-buffer-error nil)
 136             (setq mew-summary-buffer-wrong-pws nil)
 137             (mew-pioalet
 138              read mew-cs-pick mew-cs-pick
 139              (setq mew-summary-buffer-process
 140                    (apply (function start-process)
 141                           prog;; name
 142                           (current-buffer)
 143                           prog;; program
 144                           (format "--width=%d" (if mew-summary-scan-width
 145                                                    mew-summary-scan-width
 146                                                  (if (< (window-width) 80)
 147                                                      80
 148                                                    (window-width))))
 149                           (format "--mimedecodequoted=%s" (if mew-decode-quoted
 150                                                               "yes" "no"))
 151                           (append mew-prog-im-arg ;; xxx
 152                                   (cond
 153                                    ((string-match mew-prog-imget prog)
 154                                     (append
 155                                      (list (concat "--config="
 156                                                    mew-summary-buffer-config)
 157                                            "--scaninboxonly=yes")
 158                                      mew-prog-imget-arg-list))
 159                                    ((string-match mew-prog-imls prog)
 160                                     (cond
 161                                      ((equal mode 'mew-summary-mode)
 162                                       (append
 163                                        (list (format "--thread=%s"
 164                                                      (if (mew-folder-newsp folder)
 165                                                          "yes" "no")))
 166                                        (list (concat "--src=" folder))
 167                                        mew-prog-imls-arg-list
 168                                        (if (listp (car range))
 169                                            (car range)
 170                                          (list (car range)))))
 171                                      ((equal mode 'mew-virtual-mode)
 172                                       (list
 173                                        (concat "--src=" (mew-join "," folders))
 174                                        (concat "--grep=" grep))))))))))
 175             (mew-set-process-cs mew-summary-buffer-process read mew-cs-dummy)
 176             (set-process-filter mew-summary-buffer-process
 177                                 'mew-summary-scan-filter)
 178             (set-process-sentinel mew-summary-buffer-process
 179                                   'mew-summary-scan-sentinel)
 180             (setq mew-summary-buffer-reviews reviews)
 181             (process-kill-without-query mew-summary-buffer-process))
 182         (quit
 183          (set-process-sentinel mew-summary-buffer-process nil)
 184          (setq mew-summary-buffer-start-point nil)
 185          (setq mew-summary-buffer-process nil)
 186          (setq mew-summary-buffer-string nil)
 187          (setq mew-summary-buffer-reviews nil))))))
 188
 189 (defun mew-summary-scan-passwd (src)
 190   (let ((prompt "Enter password"))
 191     (if mew-use-imget-assoc
 192         (setq prompt (format "%s (%s)" prompt src))
 193       (if (not (equal mew-summary-buffer-config mew-config-default))
 194           (setq prompt (format "%s (%s)" prompt mew-summary-buffer-config))))
 195     (setq prompt (concat prompt " : "))
 196     (if mew-use-cached-passwd
 197         (mew-input-passwd prompt src)
 198       (mew-input-passwd prompt))))
 199
 200 (defmacro mew-summary-scan-filter-skip ()
 201   '(setq mew-summary-buffer-string
 202          (concat
 203           (substring mew-summary-buffer-string 0 (match-beginning 0))
 204           (substring mew-summary-buffer-string (match-end 0)))))
 205
 206 (defun mew-summary-scan-filter (process string)
 207   (let* ((after-change-function nil) ;; XEmacs - obsolete variable, ignore warnings.
 208          (after-change-functions nil)
 209          (obuf (current-buffer))
 210          (opos (point))
 211          (omax (point-max))
 212          (prog (process-name process))
 213          (regex-wrong-pw
 214           (format "^%s: ERROR: invalid password (\\([^\)]+\\))[^\n]*\n"
 215                   prog))
 216          (regex-err
 217           (format "^%s: ERROR: \\([^\n]*\\)\n" prog))
 218          (regex-imget-greeting "^imget: Getting new messages[^\n]*\n")
 219          (regex-passwd "^Password (\\([^\)]+\\))")
 220          wpw)
 221     ;; save-excursion is not usefule because sometime we want to
 222     ;; move the cursor forward.
 223     (set-buffer (process-buffer process)) ;; necessary
 224     (setq mew-summary-buffer-string (concat mew-summary-buffer-string string))
 225     (if (string-match regex-wrong-pw mew-summary-buffer-string)
 226         (progn
 227           (setq wpw (mew-match 1 mew-summary-buffer-string))
 228           (mew-passwd-set-passwd wpw nil)
 229           (setq mew-summary-buffer-wrong-pws
 230                 (cons wpw mew-summary-buffer-wrong-pws))
 231           (mew-summary-scan-filter-skip)))
 232     (if (string-match regex-err mew-summary-buffer-string)
 233         (progn
 234           (setq mew-summary-buffer-error
 235                 (mew-match 1 mew-summary-buffer-string))
 236           (mew-summary-scan-filter-skip)))
 237     (if (string-match regex-passwd mew-summary-buffer-string)
 238         (progn
 239           (process-send-string
 240            process
 241            (format "%s\n" (mew-summary-scan-passwd
 242                            (mew-match 1 mew-summary-buffer-string))))
 243           (setq mew-summary-buffer-string "")))
 244     (if (string-match regex-imget-greeting mew-summary-buffer-string)
 245         (mew-summary-scan-filter-skip))
 246     (while (string-match "^ *[0-9]+.*\n" mew-summary-buffer-string)
 247       (goto-char (point-max))
 248       ;; the cursor moves forward!
 249       (mew-elet
 250        (insert (mew-match 0 mew-summary-buffer-string)))
 251       (setq mew-summary-buffer-string
 252             (substring mew-summary-buffer-string (match-end 0))))
 253     (if (or (equal opos mew-summary-buffer-start-point)
 254             (not (equal opos omax)))
 255         ;; move the cursor to the original position.
 256         (goto-char opos))
 257     (set-buffer obuf)))
 258
 259 (defun mew-summary-scan-sentinel (process event)
 260   (let ((prog (process-name process))
 261         folder)
 262     (save-excursion
 263       (set-buffer (process-buffer process)) ;; necessary
 264       (setq folder (buffer-name))
 265       (cond
 266        (mew-summary-buffer-wrong-pws
 267         (cond
 268          (mew-use-imget-assoc
 269           (message "Password is wrong (%s)!"
 270                    (mapconcat (function identity)
 271                               mew-summary-buffer-wrong-pws
 272                               ",")))
 273          ((not (equal mew-summary-buffer-config mew-config-default))
 274           (message "Password is wrong (%s)!" mew-summary-buffer-config))
 275          (t
 276           (message "Password is wrong!"))))
 277        ;; must be here
 278        (mew-summary-buffer-error
 279         (message "%s" mew-summary-buffer-error))
 280        (t
 281         (mew-elet
 282          (let ((reviews mew-summary-buffer-reviews))
 283            (goto-char (point-max))
 284            (keep-lines (concat mew-summary-message-regex))
 285            ;; save cache only when success
 286            (while reviews
 287              (goto-line (car reviews))
 288              (mew-summary-mark-as mew-mark-review)
 289              (setq reviews (cdr reviews)))
 290            (mew-summary-folder-cache-save folder)
 291            (mew-highlight-mark-region
 292             mew-summary-buffer-start-point (point-max))
 293            (cond
 294             ((string-match mew-prog-imget prog)
 295              ;; the last messages are examined. this is not friendly
 296              ;; to imget's assoc. But imget's assoc itself is awkward.
 297              (cond
 298               ((string-match (format "^%s: no \\(new \\)?message" prog)
 299                              mew-summary-buffer-string)
 300                (message "No new message"))
 301               ((string-match (format "^%s: \\([0-9]+\\) message" prog)
 302                              mew-summary-buffer-string)
 303                (message "%s message(s)"
 304                         (mew-match 1 mew-summary-buffer-string)))
 305               (t
 306                (message "Getting %s ... done" folder))))
 307             ((string-match mew-prog-imls prog)
 308              (message "Listing %s ... done" folder)))))))
 309       (set-buffer-modified-p nil)
 310       (setq mew-summary-buffer-start-point nil)
 311       (setq mew-summary-buffer-process nil)
 312       (setq mew-summary-buffer-string nil)
 313       (setq mew-summary-buffer-config nil)
 314       (setq mew-summary-buffer-error nil)
 315       (setq mew-summary-buffer-wrong-pws nil)
 316       (setq mew-summary-buffer-reviews nil)
 317       (cond
 318        ((string-match mew-prog-imget prog)
 319         ;; On PPP environment, executing "imget" lets the dial be up.
 320         ;; So, it's a good idea to flush queue at this time
 321         ;; if messages to be sent exist.
 322         (if (and mew-auto-flush-queue (mew-flushable-p))
 323             (let ((mew-ask-flush-queue nil))
 324               (sit-for 1)               ; wait
 325               (mew-summary-flush-queue)))))
 326       (cond
 327        ((string-match mew-prog-imget prog)
 328         (run-hooks 'mew-summary-inc-sentinel-hook))
 329        ((string-match mew-prog-imls prog)
 330         (run-hooks 'mew-summary-scan-sentinel-hook))))))
 331
 332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333 ;;;
 334 ;;; process control
 335 ;;; mew-summary-buffer-process is a key to see if exclusive
 336 ;;
 337
 338 (defun mew-summary-exclusive-p ()
 339   (cond
 340    ((eq mew-summary-buffer-process t)
 341     (message "Try again later.")
 342     nil) ;; not exclusive
 343    ((processp mew-summary-buffer-process)
 344     (message "%s is running. Try again later."
 345              (process-name mew-summary-buffer-process))
 346     nil) ;; not exclusive
 347    (t t))) ;; exclusive
 348
 349 (defun mew-summary-kill-subprocess ()
 350   "\\<mew-summary-mode-map>
 351 Kill a process in Summary mode such as 'imget' and 'imls'.
 352 Sometime a process accidentally remains in Summary mode.
 353 In this situation, you cannot execute '\\[mew-summary-get]', '\\[mew-summary-ls]', nor '\\[mew-summary-exec]'.
 354 Use this command to solve this problem."
 355   (interactive)
 356   (unwind-protect
 357       (if (null (processp mew-summary-buffer-process))
 358           (message "No process to kill. This buffer is unlocked anyway.")
 359         (message "%s was killed" (process-name mew-summary-buffer-process))
 360         (kill-process mew-summary-buffer-process))
 361     (setq mew-summary-buffer-process nil)))
 362
 363 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 364 ;;;
 365 ;;; Summary file cache
 366 ;;;
 367
 368 (defun mew-summary-compare-times (type)
 369   (let* ((dir (file-chase-links (mew-expand-folder (buffer-name))))
 370          (tdir (if mew-touch-folder-p
 371                    (mew-file-get-time
 372                     (expand-file-name mew-summary-touch-file
 373                                       (mew-expand-folder dir)))
 374                  (mew-file-get-time dir)))
 375          (cache (expand-file-name mew-summary-cache-file dir))
 376          (tcache (mew-file-get-time cache))
 377          (tbuf mew-summary-buffer-folder-cache-time)
 378          t1 t2)
 379     (cond
 380      ((eq type 'dir-cache)
 381       (setq t1 tdir)
 382       (setq t2 tcache))
 383      ((eq type 'cache-buf)
 384       (setq t1 tcache)
 385       (setq t2 tbuf)))
 386     (cond
 387      ((null t1) nil)
 388      ((null t2) t) ;; do update
 389      ((> (nth 0 t1) (nth 0 t2)) t)
 390      ((= (nth 0 t1) (nth 0 t2))
 391       (if (> (nth 1 t1) (nth 1 t2)) t nil)) ;; nil if equal
 392      (t nil))))
 393
 394 (defmacro mew-summary-folder-dir-newp ()
 395   '(mew-summary-compare-times 'dir-cache))
 396
 397 (defmacro mew-summary-folder-cache-newp ()
 398   '(mew-summary-compare-times 'cache-buf))
 399
 400 (defmacro mew-summary-folder-cache-updatep (folder)
 401   (` (and mew-summary-cache-use
 402           (or (mew-folder-localp (, folder))
 403               (and mew-use-imap mew-summary-imap-cache
 404                    (not (member (, folder) mew-summary-imap-nocache-folders))
 405                    (mew-folder-imapp (, folder)))))))
 406
 407 (defun mew-summary-folder-cache-manage (folder)
 408   (switch-to-buffer folder)
 409   (if (mew-summary-folder-cache-updatep folder)
 410       (let ((cache (mew-expand-folder folder mew-summary-cache-file)))
 411         (if (and (file-exists-p cache)
 412                  (or (mew-summary-folder-cache-newp) (mew-folder-imapp folder)))
 413             (mew-elet
 414              (mew-erase-buffer)
 415              (mew-frwlet
 416               mew-cs-scan mew-cs-dummy
 417               (insert-file-contents cache))
 418              (setq mew-summary-buffer-folder-cache-time
 419                    (mew-file-get-time cache))
 420              (mew-summary-batch-unmark (list mew-mark-refile) nil)
 421              (mew-highlight-mark-region (point-min) (point-max))
 422              (set-buffer-modified-p nil)))))
 423   (if (not (equal major-mode 'mew-summary-mode)) (mew-summary-mode)))
 424
 425 (defun mew-summary-folder-cache-save (folder)
 426   (if (mew-summary-folder-cache-updatep folder)
 427       (let ((cache (mew-expand-folder (buffer-name) mew-summary-cache-file)))
 428         (if (file-writable-p cache)
 429             (save-restriction
 430               (widen)
 431               (if (mew-decode-syntax-p)
 432                   (let ((cbuf (current-buffer))
 433                         (min (point-min))
 434                         (max (point-max))
 435                         (beg (mew-decode-syntax-begin))
 436                         (end (mew-decode-syntax-end)))
 437                     (mew-set-buffer-tmp)
 438                     (insert-buffer-substring cbuf min beg)
 439                     (insert-buffer-substring cbuf end max)
 440                     (mew-frwlet
 441                      mew-cs-dummy mew-cs-scan
 442                      (write-region (point-min) (point-max) cache nil 'no-msg))
 443                     (set-buffer cbuf))
 444                 (mew-frwlet
 445                  mew-cs-dummy mew-cs-scan
 446                  (write-region (point-min) (point-max) cache nil 'no-msg)))
 447               (setq mew-summary-buffer-folder-cache-time
 448                     (mew-file-get-time cache)))))))
 449
 450 (provide 'mew-scan)
 451
 452 ;;
 453 ;; Config for imget
 454 ;;
 455
 456 (defun mew-summary-config-imget ()
 457   "Set the config value for imget."
 458   (interactive)
 459   (setq mew-config-imget (mew-input-config mew-config-imget)))
 460
 461 ;;; Copyright Notice:
 462
 463 ;; Copyright (C) 1996, 1997, 1998, 1999 Mew developing team.
 464 ;; All rights reserved.
 465
 466 ;; Redistribution and use in source and binary forms, with or without
 467 ;; modification, are permitted provided that the following conditions
 468 ;; are met:
 469 ;;
 470 ;; 1. Redistributions of source code must retain the above copyright
 471 ;;    notice, this list of conditions and the following disclaimer.
 472 ;; 2. Redistributions in binary form must reproduce the above copyright
 473 ;;    notice, this list of conditions and the following disclaimer in the
 474 ;;    documentation and/or other materials provided with the distribution.
 475 ;; 3. Neither the name of the team nor the names of its contributors
 476 ;;    may be used to endorse or promote products derived from this software
 477 ;;    without specific prior written permission.
 478 ;;
 479 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 480 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 481 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 482 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 483 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 484 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 485 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 486 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 487 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 488 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 489 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 490
 491 ;;; mew-scan.el ends here