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

   1 ;;; mew-summary.el --- Summary mode for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Oct  2, 1996
   5 ;; Revised: Sep  3, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-summary-version "mew-summary.el version 0.40")
  10
  11 (require 'mew)
  12 (if mew-xemacs-p (require 'easymenu))
  13
  14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15 ;;;
  16 ;;; User customize variables
  17 ;;;
  18
  19 (defvar mew-summary-mode-map nil)
  20
  21 (defvar mew-summary-mode-menu-spec
  22   '("Mew"
  23     ["Show" mew-summary-show t]
  24     ["Next part" mew-summary-display-down t]
  25     ["Previous part" mew-summary-display-up t]
  26     ["Top" mew-summary-jump-top t]
  27     ["Bottom" mew-summary-jump-bottom t]
  28     ["Jump" mew-summary-jump-message t]
  29     "----"
  30     ["Delete" mew-summary-delete (equal major-mode 'mew-summary-mode)]
  31     ["Refile" mew-summary-refile (equal major-mode 'mew-summary-mode)]
  32     ["Mark multi" mew-summary-mark-multi t]
  33     ["Mark review" mew-summary-mark-review t]
  34     ["Sort marked msgs" mew-summary-mark-sort t]
  35     ["Undo" mew-summary-undo t]
  36     ["Undo all" mew-summary-undo-all t]
  37     ["Execute" mew-summary-exec (equal major-mode 'mew-summary-mode)]
  38     ["Suspend" mew-summary-suspend t]
  39     ["Quit" mew-summary-quit t]
  40     "----"
  41     ("Manipulate folder"
  42      ["Get" mew-summary-get t]
  43      ["List" mew-summary-ls (equal major-mode 'mew-summary-mode)]
  44      ["Pack" mew-summary-pack (equal major-mode 'mew-summary-mode)]
  45      ["Sort" mew-summary-sort (equal major-mode 'mew-summary-mode)]
  46      ["Burst" mew-summary-burst t]
  47      ["Go to folder" mew-summary-goto-folder t]
  48      )
  49     ("Manipulate file"
  50      ["Save" mew-summary-save t]
  51      ["Convert to local character set" mew-summary-convert-local-cs t]
  52      ["Display X-Face" mew-summary-x-face t]
  53      )
  54     ("Write/Reply/Forward"
  55      ["Write a message" mew-summary-send t]
  56      ["Reedit" mew-summary-reedit t]
  57      ["Reply" mew-summary-reply t]
  58      ["Reply with citation" mew-summary-reply-with-citation t]
  59      ["Forward" mew-summary-forward t]
  60      ["Multi forward" mew-summary-multi-forward t]
  61      )
  62     ("Select"
  63      ["Search then Mark" mew-summary-search-mark
  64       (equal major-mode 'mew-summary-mode)]
  65      ["Search" mew-summary-search (equal major-mode 'mew-summary-mode)]
  66      ["Virtual mode" mew-summary-virtual (equal major-mode 'mew-summary-mode)]
  67      )
  68     ("Misc"
  69      ["Clean +trash" mew-summary-clean-trash t]
  70      ["Recenter" mew-summary-recenter t]
  71      ["Uudecode" mew-summary-uudecode t]
  72      ["Unshar" mew-summary-unshar t]
  73      ["Multi burst" mew-summary-burst-multi t]
  74      ["Print" mew-summary-print t]
  75      ["Pipe message" mew-summary-pipe-message t]
  76      ["Isearch forward" mew-summary-isearch-forward t]
  77      ["Isearch backward" mew-summary-isearch-backward t]
  78      ["Toggle disp msg" mew-summary-toggle-disp-msg t]
  79      ["Config for imget" mew-summary-config-imget t]
  80      ["PGP public key fetch" mew-pgp-fetch-key t]
  81      ["Kill Sub-Process"
  82       mew-summary-kill-subprocess
  83       (and (processp mew-summary-buffer-process)
  84            (equal major-mode 'mew-summary-mode))]
  85      )))
  86
  87 (if mew-summary-mode-map
  88     ()
  89   (setq mew-summary-mode-map (make-sparse-keymap))
  90   (define-key mew-summary-mode-map " "    'mew-summary-show)
  91   (define-key mew-summary-mode-map "."    'mew-summary-display-command)
  92   (define-key mew-summary-mode-map ","    'mew-summary-display-asis)
  93   (define-key mew-summary-mode-map "<"    'mew-summary-jump-top)
  94   (define-key mew-summary-mode-map ">"    'mew-summary-jump-bottom)
  95   (define-key mew-summary-mode-map "\177" 'mew-summary-prev-page)
  96   (define-key mew-summary-mode-map "\r"   'mew-summary-scroll-up)
  97   (define-key mew-summary-mode-map "-"    'mew-summary-scroll-down)
  98   (define-key mew-summary-mode-map "\e\r" 'mew-summary-scroll-down)
  99   (define-key mew-summary-mode-map "g"    'mew-summary-goto-folder)
 100   (define-key mew-summary-mode-map "j"    'mew-summary-jump-message)
 101   (define-key mew-summary-mode-map "i"    'mew-summary-get)
 102   (define-key mew-summary-mode-map "a"    'mew-summary-reply)
 103   (define-key mew-summary-mode-map "A"    'mew-summary-reply-with-citation)
 104   (define-key mew-summary-mode-map "D"    'mew-summary-clean-trash)
 105   (define-key mew-summary-mode-map "E"    'mew-summary-reedit)
 106   (define-key mew-summary-mode-map "\ee"  'mew-summary-edit-again)
 107   (define-key mew-summary-mode-map "f"    'mew-summary-forward)
 108   (define-key mew-summary-mode-map "F"    'mew-summary-multi-forward)
 109   (define-key mew-summary-mode-map "r"    'mew-summary-resend)
 110   (define-key mew-summary-mode-map "@"    'mew-summary-multi)
 111   (define-key mew-summary-mode-map "*"    'mew-summary-review)
 112   (define-key mew-summary-mode-map "y"    'mew-summary-save)
 113   (define-key mew-summary-mode-map "u"    'mew-summary-undo)
 114   (define-key mew-summary-mode-map "U"    'mew-summary-undo-all)
 115   (define-key mew-summary-mode-map "n"    'mew-summary-display-down)
 116   (define-key mew-summary-mode-map "p"    'mew-summary-display-up)
 117   (define-key mew-summary-mode-map "N"    'mew-summary-display-review-down)
 118   (define-key mew-summary-mode-map "P"    'mew-summary-display-review-up)
 119   (define-key mew-summary-mode-map "w"    'mew-summary-send)
 120   (define-key mew-summary-mode-map "B"    'mew-summary-burst)
 121   (define-key mew-summary-mode-map "J"    'mew-summary-join)
 122   (define-key mew-summary-mode-map "Z"    'mew-status-update)
 123   (define-key mew-summary-mode-map "#"    'mew-summary-print)
 124   (define-key mew-summary-mode-map "|"    'mew-summary-pipe-message)
 125   (define-key mew-summary-mode-map "q"    'mew-summary-suspend)
 126   (define-key mew-summary-mode-map "Q"    'mew-summary-quit)
 127   (define-key mew-summary-mode-map "C"    'mew-summary-config-imget)
 128   (define-key mew-summary-mode-map "\C-c\C-a" 'mew-summary-addrbook-add)
 129   (define-key mew-summary-mode-map "\C-c\C-c" 'mew-summary-flush-queue)
 130   (define-key mew-summary-mode-map "\C-c\C-e" 'mew-summary-execute-external)
 131   (define-key mew-summary-mode-map "\C-c\C-f" 'mew-pgp-fetch-key)
 132   (define-key mew-summary-mode-map "\C-c\C-v" 'mew-pgp-select)
 133   (define-key mew-summary-mode-map "\C-c\C-i" 'mew-summary-insert)
 134   (define-key mew-summary-mode-map "\C-c\C-s" 'mew-summary-isearch-forward)
 135   (define-key mew-summary-mode-map "\C-c\C-r" 'mew-summary-isearch-backward)
 136   (define-key mew-summary-mode-map "\C-c\C-o"
 137     'mew-summary-jump-to-draft-buffer)
 138   (define-key mew-summary-mode-map "\el"  'mew-summary-recenter)
 139   (define-key mew-summary-mode-map "\et"  'mew-summary-uudecode)
 140   (define-key mew-summary-mode-map "\es"  'mew-summary-unshar)
 141   (define-key mew-summary-mode-map "\eb"  'mew-summary-burst-multi)
 142   (define-key mew-summary-mode-map "v"    'mew-summary-toggle-disp-msg)
 143   (define-key mew-summary-mode-map "\C-c\C-l" 'mew-summary-convert-local-cs)
 144   (define-key mew-summary-mode-map "\C-c\C-p" 'mew-summary-decode-pgp)
 145   (define-key mew-summary-mode-map "\C-c\C-x" 'mew-summary-x-face)
 146   (define-key mew-summary-mode-map "\C-c\C-q" 'mew-kill-buffer)
 147   (define-key mew-summary-mode-map "\C-c\C-k" 'mew-summary-kill-subprocess)
 148   (define-key mew-summary-mode-map "m"    (make-sparse-keymap))
 149   (define-key mew-summary-mode-map "m@"   'mew-summary-mark-multi)
 150   (define-key mew-summary-mode-map "m*"   'mew-summary-mark-review)
 151   (define-key mew-summary-mode-map "ms"   'mew-summary-mark-swap)
 152   (define-key mew-summary-mode-map "mr"   'mew-summary-mark-regexp)
 153   (define-key mew-summary-mode-map "ma"   'mew-summary-mark-all)
 154   (define-key mew-summary-mode-map "mu"   'mew-summary-mark-undo-all)
 155   ;;
 156   ;; not provided in Virtual mode
 157   ;;
 158   (define-key mew-summary-mode-map "!"    'mew-summary-refile-again)
 159   (define-key mew-summary-mode-map "o"    'mew-summary-refile)
 160   (define-key mew-summary-mode-map "O"    'mew-summary-pack)
 161   (define-key mew-summary-mode-map "s"    'mew-summary-ls)
 162   (define-key mew-summary-mode-map "S"    'mew-summary-sort)
 163   (define-key mew-summary-mode-map "d"    'mew-summary-delete)
 164   (define-key mew-summary-mode-map "x"    'mew-summary-exec)
 165   (define-key mew-summary-mode-map "X"    'mew-summary-exec-current)
 166   (define-key mew-summary-mode-map "V"    'mew-summary-virtual)
 167   (define-key mew-summary-mode-map "/"    'mew-summary-search)
 168   (define-key mew-summary-mode-map "?"    'mew-summary-search-mark)
 169   (define-key mew-summary-mode-map "mo"   'mew-summary-mark-refile)
 170   (define-key mew-summary-mode-map "md"   'mew-summary-mark-delete)
 171   (define-key mew-summary-mode-map "mS"   'mew-summary-mark-sort)
 172   (define-key mew-summary-mode-map "\C-c\C-b" 'mew-summary-exchange-point)
 173   (define-key mew-summary-mode-map "\eo"  'mew-summary-auto-refile)
 174   ;;
 175   (if mew-xemacs-p
 176       (define-key mew-summary-mode-map 'button2 'mew-summary-mouse-show)
 177     (define-key mew-summary-mode-map [mouse-2] 'mew-summary-mouse-show)
 178     (easy-menu-define
 179      mew-summary-mode-menu
 180      mew-summary-mode-map
 181      "Menu used in Summary mode."
 182      mew-summary-mode-menu-spec))
 183   )
 184
 185 (defvar mew-summary-mode-toolbar-menu
 186   '("Mew Part Commands"
 187     ["Save" mew-summary-save t]
 188     ["Reply" mew-summary-reply t]
 189     ))
 190
 191 (defvar mew-summary-mode-popup-menu nil)
 192
 193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 194 ;;;
 195 ;;; Variables
 196 ;;;
 197
 198 (defvar mew-last-shell-command "")
 199
 200 (defvar mew-summary-message-regex "^ *\\([0-9]+\\)")
 201
 202 (defvar mew-summary-edit-again-regex
 203   "----- Original message follows -----\\|----- Unsent message follows -----")
 204
 205 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 206 ;;;
 207 ;;; Macros
 208 ;;;
 209
 210 (defmacro mew-summary-msg-or-part (&rest body)
 211   (` (cond
 212       ((eobp) (message "No message"))
 213       ((not (or (mew-summary-message-number) (mew-syntax-number)))
 214        (message "No message"))
 215       (t
 216        (,@ body)))))
 217
 218 (defmacro mew-summary-msg (&rest body)
 219   (` (cond
 220       ((eobp) (message "No message"))
 221       ((mew-syntax-number)
 222        (message "Please use this command on a message, not a part"))
 223       (t
 224        (,@ body)))))
 225
 226 (defmacro mew-summary-part (&rest body)
 227   (` (cond
 228       ((eobp) (message "No part"))
 229       ((mew-summary-message-number)
 230        (message "Please use this command on a part, not a message"))
 231       (t
 232        (,@ body)))))
 233
 234 (defmacro mew-summary-multi-msgs (&rest body)
 235   (` (let* ((FLD-MSGS (mew-summary-mark-collect2 mew-mark-multi))
 236             (FLD-MSG-LIST FLD-MSGS) ;; may be used in body
 237             FILES ;; may be used in body
 238             fld-msg)
 239        (cond
 240         ((null FLD-MSGS)
 241          (message "No %s marks" (char-to-string mew-mark-multi)))
 242         (t
 243          ;; a little bit complicated because of Virtual mode
 244          (while FLD-MSGS
 245            (setq fld-msg (car FLD-MSGS))
 246            (setq FLD-MSGS (cdr FLD-MSGS))
 247            (setq FILES (cons (mew-expand-folder-get-msg (car fld-msg) (cdr fld-msg))
 248                              FILES)))
 249          (setq FILES (nreverse FILES))
 250          (,@ body))))))
 251
 252 (defmacro mew-summary-prepare-draft (&rest body)
 253   (` (progn
 254        (unwind-protect
 255            (let ((find-file-hooks nil)
 256                  (inhibit-quit t))
 257              (,@ body)
 258              ;; XEmacs doesn't draw attachments unless sit for 0...
 259              (sit-for 0)
 260              ;; XEmacs doesn't draw toolbar, so...
 261              (if (and mew-icon-p
 262                       (specifier-instance default-toolbar-visible-p))
 263                  (progn
 264                    (set-specifier default-toolbar-visible-p nil)
 265                    (set-specifier default-toolbar-visible-p t))))
 266          (save-buffer)) ;; to make sure not to use this draft again
 267        (mew-touch-folder mew-draft-folder)
 268        (message "Draft is prepared"))))
 269
 270 (defmacro mew-summary-only (&rest body)
 271   (` (if (not (equal major-mode 'mew-summary-mode))
 272          (message "This command can be used in Summary mode only")
 273        (,@ body))))
 274
 275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 276 ;;;
 277 ;;; Summary mode
 278 ;;;
 279
 280 (defun mew-summary-mode ()
 281   "\\<mew-summary-mode-map>
 282 Mew Summary mode:: major mode to visualize messages in a folder.
 283
 284 The keys that are defined for both Summary mode and Virtual mode are:
 285
 286 \\[mew-summary-show]    Read through messages. That is, display a message, scroll it,
 287         and move-then-display another message.
 288         See 'mew-summary-show-direction' to set 'up, 'down,
 289         'next(current direction) or 'stop. Default is 'down.
 290 \\[mew-summary-prev-page]       Back-scroll this message. Unnecessary header fields are hidden
 291         over the window. Type '\\[mew-summary-prev-page]' to see them when a message is displayed.
 292 \\[mew-summary-display-command] If the size of a message exceeds 'mew-file-max-size', MIME
 293         analysis is skipped then the beginning of the raw message is
 294         displayed. When you failed to decrypted a cipher message, it
 295         is cached and is displayed as a broken message.
 296         In such cases, type '\\[mew-summary-display-command]' to force MIME analysis.
 297 \\[mew-summary-display-asis]    Display this message in the raw format(i.e. without MIME analysis).
 298
 299 \\[mew-summary-scroll-up]       Make this message scroll up with one line.
 300 \\[mew-summary-scroll-down]     Make this message scroll down with one line.
 301
 302 \\[mew-summary-display-down]    Move to below then display. Targets includes parts, messages
 303         marked with '*', and non-marked messages. When called with '\\[universal-argument]',
 304         parts are skipped.
 305 \\[mew-summary-display-up]      Move to above then display. Targets includes parts, messages
 306         marked with '*', and non-marked messages. When called with '\\[universal-argument]',
 307         parts are skipped.
 308 \\[mew-summary-jump-message]    Jump to a message according to the number which you input.
 309 \\[mew-summary-jump-top]        Go to the beginning of this Summary mode.
 310 \\[mew-summary-jump-bottom]     Go to the end of this Summary mode.
 311
 312 \\[mew-summary-get]     Get +inbox asynchronously.
 313 \\[mew-summary-ls]      List this folder asynchronously.
 314 \\[mew-summary-goto-folder]     Go to the folder which you input.
 315
 316 \\[mew-summary-send]    Write a message. A new draft is prepared in Draft mode.
 317 \\[mew-summary-reply]   Answer to this message. A new draft is prepared in Draft mode.
 318         Mew automatically decides To: and Cc:.
 319 \\[mew-summary-reply-with-citation]     Answer to this message. A new draft is prepared in Draft mode.
 320         Mew automatically decides To: and Cc: and cites the body.
 321 \\[mew-summary-forward] Forward this message to a third person. A new draft is prepared in
 322         Draft mode and this message is automatically attached.
 323 \\[mew-summary-multi-forward]   Forward messages marked with '@' to a third person. A new draft
 324         is prepared in Draft mode and this message is automatically
 325         attached.
 326
 327 \\[mew-summary-reedit]  Edit this message again to retry sending. Or edit this
 328         rfc822 part typically included MIME-encapsulated error message.
 329         In the +draft folder, it just edits the message. Otherwise,
 330         copy the message to the +draft folder, then edit.
 331 \\[mew-summary-edit-again]      Edit an old fashioned error message in which the original message
 332         is encapsulated after after strings defined in
 333         'mew-summary-edit-again-regex'
 334         (e.g. \"----- Original message follows -----\").
 335
 336 \\[mew-summary-review]  Put the review the '*' mark on this message.
 337         Use '\\[mew-summary-display-review-down]' or '\\[mew-summary-display-review-up]' to jump to a message marked with '*'.
 338         It can overlay '@'. The cursor stays always.
 339         See also '\\[mew-summary-mark-refile]', '\\[mew-summary-mark-delete]', '\\[mew-summary-mark-regexp]', and '\\[mew-summary-mark-all]'.
 340 \\[mew-summary-display-review-down]     Jump to the message marked with '*' below.
 341 \\[mew-summary-display-review-up]       Jump to the message marked with '*' above.
 342
 343 \\[mew-summary-multi]   Put the multi the '@' mark on this message for '\\[mew-summary-multi-forward]', '\\[mew-summary-unshar]',
 344         '\\[mew-summary-uudecode]', '\\[mew-summary-burst-multi]'. It can overlay the '*' mark.
 345         The cursor stays always.
 346 \\[mew-summary-unshar]  Apply 'unshar' on messages marked with '@'.
 347 \\[mew-summary-uudecode]        Apply 'uudecode' on messages marked with '@'.
 348 \\[mew-summary-burst-multi]     De-capsulate messages embedded in the messages marked with '@'.
 349 \\[mew-summary-join]    Concat Message/Partial fragments marked with '@' to an original
 350         message.
 351
 352 \\[mew-summary-undo]    Cancel the mark on this message.
 353 \\[mew-summary-undo-all]        Cancel all marks according to what you input.
 354
 355 \\[mew-summary-mark-regexp]     Put the '*' mark onto Mall messages matched to a regular expression.
 356 \\[mew-summary-mark-all]        Put the '*' mark onto all messages which are not marked.
 357 \\[mew-summary-mark-review]     Change the '@' mark into the '*' mark.
 358 \\[mew-summary-mark-multi]      Change the '*' mark into the '@' mark.
 359 \\[mew-summary-mark-undo-all]   Unmark all message marked with 'o' or 'D'.
 360 \\[mew-summary-mark-swap]       Swap the '@' mark and the '*' mark.
 361
 362 \\[mew-summary-delete]  Put the delete mark(default is 'D') on this message.
 363         This can overlay other marks. When it overlays, the cursor stays
 364         on the message. If it marks newly, displays the next message.
 365         To know what kind of action will be taken, see 'mew-msg-rm-policy'.
 366 \\[mew-summary-clean-trash]     Really remove all messages in the +trash folder.
 367
 368 \\[mew-summary-save]    Save any parts. If the target is a message, you are asked which
 369         you want to save, the entire message or its body. If the target is
 370         a non-message part, the part is saved (with line delimiter conversion
 371         if it is a text object).
 372 \\[mew-summary-toggle-disp-msg] Toggle 'Summary mode only' and 'Summary & Message mode'. If
 373         you choose 'Summary mode only', you can quickly put the delete
 374         marks since the next message is not displayed.
 375 \\[mew-summary-recenter]        Make the current line to the center of Summary mode.
 376
 377 \\[mew-summary-burst]   De-capsulate embedded messages in MIME format.
 378 \\[mew-status-update]   Read Addrbook and update its information. If executed with '\\[universal-argument]',
 379         information of folders is also updated in addition to that of
 380         Addrbook. If 'mew-use-folders-file-p' is 't', the list of
 381         folders is stored in '~/Mail/.folders'. The default value is 't'.
 382 \\[mew-summary-config-imget]    Set the config value for imget.
 383
 384 \\[mew-summary-suspend] Suspend Mew then switch to another buffer. All buffers of
 385         Mew retain, so you can resume with buffer operations.
 386 \\[mew-summary-quit]    Quit Mew. All buffers of Mew are erased.
 387 \\[mew-kill-buffer]     Kill this Summary mode.
 388
 389 \\[mew-summary-convert-local-cs]        Convert to character sets used locally.
 390 \\[mew-summary-decode-pgp]  Decrypting/verifying old-fashioned PGP messages.
 391 \\[mew-summary-x-face]  Display xface.
 392 \\[mew-pgp-fetch-key]   Fetch the PGP public key whose key ID appears in the X-Mew: field.
 393 \\[mew-pgp-select]      Select PGP version.
 394
 395 \\[mew-summary-addrbook-add]    Adding the value of From: in Message mode to Addrbook.
 396         When executed with '\\[universal-argument], it will add personal information.
 397         Otherwise, it will add an alias.
 398
 399 \\[mew-summary-kill-subprocess] Kill a process in Summary mode such as 'imget' and 'imls'.
 400         Sometime a process accidentally remains in Summary mode.
 401         In this situation, you cannot execute '\\[mew-summary-get]', '\\[mew-summary-ls]', nor '\\[mew-summary-exec]'.
 402         Use this command to solve this problem.
 403
 404 \\[mew-summary-isearch-forward] Incremental search forward in Message mode.
 405 \\[mew-summary-isearch-backward]        Incremental search backward in Message mode.
 406
 407 \\[mew-summary-print]   Print this message or this part.
 408 \\[mew-summary-pipe-message]    Send this message via pipe.
 409
 410 The following commands are provided for Summary mode only, not for
 411 Virtual mode.
 412
 413 \\[mew-summary-refile]  Put the refile mark(default is 'o') on this message.
 414         If already marked with 'o', it prints where this message
 415         will be refiled. This can overlay other marks. When it overlays,
 416         the cursor stays on the message. If it marks newly, displays
 417         the next message. If executed with '\\[universal-argument]', it displays how
 418         the refile rules work in Message mode.
 419 \\[mew-summary-refile-again]    Put a refile mark on this message according to the previous
 420         refile folder.
 421
 422 \\[mew-summary-exec]    Process marked messages. To cancel the '*' mark, use '\\[mew-summary-undo]' or '\\[mew-summary-undo-all]'.
 423 \\[mew-summary-exec-current]    Process the current marked messages.
 424
 425 \\[mew-summary-mark-refile]     Put the refile mark onto all messages marked with '*'.
 426         This is very convenient to refile all messages picked by '\\[mew-summary-search-mark]'.
 427 \\[mew-summary-mark-delete]     Put the delete mark onto all messages marked with '*'.
 428 \\[mew-summary-mark-sort]       Sort messages marked with '*'.
 429
 430 \\[mew-summary-search]  Pick messages according to a pick pattern which you input,
 431         then list them up.
 432 \\[mew-summary-search-mark]     Pick messages according to a pick pattern which you input,
 433         then put the '*' mark onto them.
 434 \\[mew-summary-virtual] Go to Virtual mode which gives a single view to picked messages
 435         from multiple folders. Enter a virtual folder name,
 436         comma-separated folders, and pick pattern.
 437
 438 \\[mew-summary-sort]    Sort messages and list them up again.
 439 \\[mew-summary-pack]    Pack messages and list them up again.
 440
 441 RANGE means as follows:
 442         all, update,
 443         <num1>-<num2>, <num>:+N, <num>:-N,
 444         first:N, prev:N, next:N, last:N
 445
 446 Use 'all' to flush the summary buffer. 'update' means the range
 447 between the last message included in Summary mode + 1 and the real last
 448 message on the folder.
 449
 450 PICK PATTERN is as follows:
 451 - field=string
 452         Match if the 'field' field contains the 'string' string.
 453         If you specify 'head', 'body' or 'all' as 'field', it means
 454         the entire header, the body, and the entire message, respectively.
 455 - <pattern1> & <pattern2>
 456         Match if <pattern1> AND <pattern2>.
 457 - <pattern1> | <pattern2>
 458         Match if <pattern1> OR <pattern2>.
 459 - ! <pattern>
 460         Match if not <pattern>.
 461 - ( <pattern> )
 462         Evaluate <pattern> first.
 463 "
 464   (interactive)
 465   (setq major-mode 'mew-summary-mode)
 466   (setq mode-name "Summary")
 467   (setq mode-line-buffer-identification mew-mode-line-id)
 468   (use-local-map mew-summary-mode-map)
 469   (setq buffer-read-only t)
 470   (setq truncate-lines t)
 471   (make-local-variable 'tab-width)
 472   (make-local-variable 'zmacs-regions)
 473   (setq zmacs-regions nil)
 474   (mew-summary-setup-mode-line)
 475   (mew-summary-setup-menu)
 476   (mew-summary-highlight-setup)
 477   (mew-highlight-cursor-line)
 478   (run-hooks 'mew-summary-mode-hook))
 479
 480 (defun mew-summary-setup-mode-line ()
 481   (let ((pos 0)
 482         (mlf mode-line-format))
 483     (if (member '(-3 . "%p") mlf)
 484         (progn
 485           (while (not (equal '(-3 . "%p") (car mlf)))
 486             (setq pos (1+ pos))
 487             (setq mlf (cdr mlf)))
 488           (setq mode-line-format
 489                 (let ((mlf (copy-sequence mode-line-format)))
 490                   (setcdr (nthcdr (1- pos) mlf)
 491                           '("[" mew-summary-buffer-left-msgs " more]" "-%-"))
 492                   mlf))))))
 493
 494 (defun mew-summary-reset-mode-line (buf)
 495   (save-excursion
 496     (set-buffer buf)
 497     (setq mew-summary-buffer-left-msgs  "-"))) ;; local variable
 498
 499 (defun mew-summary-mode-line (buf)
 500   (save-excursion
 501     (set-buffer buf)
 502     ;; if not running process in this buffer
 503     ;; display how many messages are unread
 504     (if (null mew-summary-buffer-process)
 505         (let ((left (count-lines (point) (point-max))))
 506           (if (eq major-mode 'mew-virtual-mode)
 507                (setq left (/ (1- left) 2))
 508             (setq left (1- left)))
 509           (if (equal left 0)
 510               (setq mew-summary-buffer-left-msgs  "-") ;; local variable
 511             (setq mew-summary-buffer-left-msgs (int-to-string left)))))))
 512
 513 (defun mew-summary-setup-menu ()
 514   (if mew-xemacs-p
 515       (progn
 516         (mew-summary-toolbar-update)
 517         (if (featurep 'scrollbar)
 518             (set-specifier scrollbar-height (cons (current-buffer) 0)))
 519         (set-buffer-menubar current-menubar)
 520         (if mew-summary-mode-popup-menu
 521             ()
 522           (easy-menu-define
 523            mew-summary-mode-popup-menu
 524            mew-summary-mode-map
 525            "Popup Menu used in Summary and Virtual mode."
 526            mew-summary-mode-menu-spec))
 527         (easy-menu-add mew-summary-mode-popup-menu)
 528         (add-submenu nil mew-summary-mode-menu-spec))))
 529
 530 (defun mew-summary-folder-name ()
 531   (cond
 532    ((equal major-mode 'mew-summary-mode)
 533     (buffer-name))
 534    ((equal major-mode 'mew-virtual-mode)
 535     (save-excursion
 536       (beginning-of-line)
 537       (if (not (mew-summary-message-number))
 538           (mew-summary-goto-message))
 539       (if (looking-at ".*\r \\([-+%=].*\\) \\(.*\\)$")
 540           (mew-match 1)
 541         nil)))
 542    (t nil)))
 543
 544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 545 ;;;
 546 ;;; Folder
 547 ;;;
 548
 549 (defun mew-summary-goto-folder (&optional arg fld)
 550   "Go to the folder which you input.
 551 If executed with '\\[universal-argument]', the cursor always goes to the bottom of
 552 Summary mode."
 553   (interactive "P")
 554   (let* ((folder (or fld (mew-input-folder (mew-inbox-folder))))
 555          (dir (mew-expand-folder folder)))
 556     (cond
 557      ((mew-folder-newsp folder)
 558       (mew-summary-goto-folder-subr folder arg))
 559      ((mew-folder-imapp folder)
 560       (if (and (not (file-directory-p dir))
 561                (y-or-n-p
 562                 (format
 563                  "Cache directory for %s does not exist. Create it? "
 564                  folder)))
 565           (let ((folders-file (expand-file-name mew-folders-file mew-mail-path)))
 566             (mew-make-directory dir)
 567             (if (and (mew-folder-setup folder) (file-writable-p folders-file))
 568                 (save-excursion
 569                   (mew-set-buffer-tmp)
 570                   (insert folder)
 571                   (insert "\n")
 572                   (write-region (point-min) (point-max)
 573                                 folders-file 'append 'no-msg))))
 574         (mew-folder-setup folder))
 575       (mew-summary-goto-folder-subr folder arg))
 576      ((mew-folder-virtualp folder)
 577       (if (get-buffer folder)
 578           (progn
 579             (mew-summary-goto-folder-subr folder arg)
 580             (mew-virtual-mode))
 581         (message "No such virtual folder: %s" folder)
 582         (mew-folder-delete folder)))
 583      (t ;; mail or local news
 584       (if (null dir)
 585           (message "Folder is wrong")
 586         (if (not (file-directory-p dir))
 587             (message "No such folder %s" folder)
 588           (mew-summary-goto-folder-subr folder arg)
 589           (if mew-summary-trace-directory (cd dir))))))))
 590
 591 (defun mew-summary-goto-folder-subr (folder arg)
 592   (let (new-folder)
 593     (if (get-buffer folder)
 594         (switch-to-buffer folder)
 595       (mew-summary-folder-create folder)
 596       (setq new-folder t))
 597     (if (eq major-mode 'mew-summary-mode)
 598         (mew-summary-ls t (or arg new-folder)))))
 599
 600 (defun mew-summary-folder-create (folder)
 601   (switch-to-buffer (get-buffer-create folder))
 602   (mew-summary-mode)
 603   (if (and mew-summary-cache-use (mew-folder-localp folder))
 604       (mew-elet
 605        (let ((cache (mew-expand-folder folder mew-summary-cache-file)))
 606          (if (file-exists-p cache)
 607              (mew-frwlet
 608               mew-cs-scan mew-cs-dummy
 609               (insert-file-contents cache)
 610               (setq mew-summary-buffer-folder-cache-time
 611                     (mew-file-get-time cache))
 612               (mew-highlight-mark-region (point-min) (point-max))))))))
 613
 614 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 615 ;;;
 616 ;;; show
 617 ;;;
 618
 619 (defun mew-summary-toggle-decode-quoted ()
 620   "Toggle whether or not decode quoted MIME encoded-word.
 621 (e.g \"=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=\")."
 622   (interactive)
 623   (cond
 624    (mew-decode-quoted
 625     (message "Don't decode quoted MIME encoded-word")
 626     (mew-summary-goto-message)
 627     (setq mew-decode-quoted nil))
 628    (t
 629     (message "Decode quoted MIME encoded-word")
 630     (setq mew-decode-quoted t)))
 631   (mew-cache-flush))
 632
 633 (defun mew-summary-cache-prefetch ()
 634   (if mew-cache-prefetch
 635       (let ((mew-inherit-prefetching t)
 636             folder next file)
 637         (save-excursion
 638           (sit-for 0) ;; need to display
 639           (mew-summary-goto-message)
 640           (cond
 641            ((eq mew-summary-buffer-direction 'up)
 642             (if (re-search-backward (mew-summary-regex) nil t)
 643                 (progn
 644                   (setq folder (mew-summary-folder-name))
 645                   (setq next (mew-summary-message-number)))))
 646            ((eq mew-summary-buffer-direction 'down)
 647             (if (mew-decode-syntax-end)
 648                 (goto-char (mew-decode-syntax-end))
 649               (forward-line))
 650             (if (re-search-forward (mew-summary-regex) nil t)
 651                 (progn
 652                   (setq folder (mew-summary-folder-name))
 653                   (setq next (mew-summary-message-number)))))))
 654         ;; should get the cursor back for display
 655         (save-excursion
 656           (if (not (and folder next))
 657               ()
 658             (cond
 659              ((mew-folder-newsp folder)
 660               (setq file (expand-file-name
 661                           next (expand-file-name (substring folder 1) mew-temp-dir))))
 662              ((mew-folder-imapp folder)
 663               (setq file (expand-file-name next (mew-imap-folder-dir folder mew-temp-dir))))
 664              (t
 665               (setq file (mew-expand-folder folder next))))
 666             (if (and (not (mew-cache-hit (cons folder next)))
 667                      (or (and mew-cache-prefetch-remote (mew-folder-remotep folder))
 668                          (and file (file-exists-p file)
 669                               (<= (mew-file-get-size file) mew-file-max-size))))
 670                 (mew-cache-message folder next)))))))
 671
 672 (defmacro mew-summary-show-postscript (prefetch)
 673   (` (progn
 674        (mew-summary-recenter)
 675        (mew-highlight-cursor-line)
 676        (if (, prefetch) (mew-summary-cache-prefetch))
 677        (set-buffer-modified-p nil))))
 678
 679 (defmacro mew-summary-display-after (direction)
 680   (` (cond
 681       ((eq (, direction) 'down)
 682        (mew-summary-display-down))
 683       ((eq (, direction) 'up)
 684        (mew-summary-display-up))
 685       ((eq (, direction) 'next)
 686        (mew-summary-display-next))
 687       (t ())))) ;; 'stop
 688
 689 (defun mew-summary-show ()
 690   "Read through messages. That is, display a message, scroll it,
 691 and move-then-display another message.
 692 See 'mew-summary-show-direction' to set 'up, 'down,
 693 'next(current direction) or 'stop. Default is 'down."
 694   (interactive)
 695   (mew-summary-msg-or-part
 696    (let* ((fld (mew-summary-folder-name))
 697           (msg (mew-summary-message-number))
 698           (fld-msg (cons fld msg))
 699           (ofld-msg (mew-current-get 'message))
 700           (part (mew-syntax-nums))
 701           (opart (mew-current-get 'part))
 702           (buf (buffer-name))
 703           (win (selected-window))
 704           (displayed (and (get-buffer (mew-buffer-message))
 705                           (get-buffer-window (mew-buffer-message))))
 706           next prefetch)
 707      (mew-summary-toggle-disp-msg 'on)
 708      (unwind-protect
 709          (progn
 710            (mew-window-configure buf 'message)
 711            ;; message buffer
 712            (cond
 713             (msg
 714              (if (or (null ofld-msg)
 715                      (not (equal fld-msg ofld-msg))
 716                      opart)
 717                  (progn
 718                    (mew-summary-display-message fld msg buf nil)
 719                    (setq prefetch t))
 720                (if (not displayed)
 721                    () ;; keep the page
 722                  (if (mew-message-next-page)
 723                      (setq next t)))))
 724             (part
 725              (if (or (null opart) (not (equal opart part)))
 726                  (mew-summary-display-part
 727                   (mew-cache-decode-syntax (mew-cache-hit ofld-msg)) part)
 728                (if (mew-message-next-page)
 729                    (setq next t))))))
 730        (select-window win)
 731        ;; summary buffer
 732        (mew-summary-show-postscript prefetch)
 733        (if next (mew-summary-display-after mew-summary-show-direction))))))
 734
 735 (defun mew-summary-toggle-disp-msg (&optional arg)
 736   "Toggle 'Summary mode only' and 'Summary & Message mode'. If
 737 you choose 'Summary mode only', you can quickly put the delete
 738         marks since the next message is not displayed."
 739   (interactive)
 740   (cond
 741    ((equal arg 'on)
 742     (setq mew-summary-buffer-disp-msg t))
 743    ((equal arg 'off)
 744     (setq mew-summary-buffer-disp-msg nil)
 745     (mew-summary-reset-mode-line (current-buffer)))
 746    (t
 747     (setq mew-summary-buffer-disp-msg (not mew-summary-buffer-disp-msg))
 748     (if mew-summary-buffer-disp-msg
 749         (mew-summary-display 'force)
 750       (mew-summary-goto-message)
 751       (mew-decode-syntax-delete)
 752       (mew-window-configure (current-buffer) 'summary)
 753       (mew-current-set 'message nil)
 754       (mew-summary-reset-mode-line (current-buffer))))))
 755
 756 (defun mew-summary-display-command (&optional arg)
 757   "\\<mew-summary-mode-map>
 758 If the size of a message exceeds 'mew-file-max-size', MIME
 759 analysis is skipped then the beginning of the raw message is
 760 displayed. When you failed to decrypted a cipher message, it
 761 is cached and is displayed as a broken message.
 762 In such cases, type '\\[mew-summary-display-command]' to force MIME analysis."
 763   (interactive "P")
 764   (if arg
 765       (mew-summary-display-asis)
 766     (mew-summary-display 'force)))
 767
 768 (defun mew-summary-display (force)
 769   "Display this message or this part. If already displayed, nothing
 770 changed. But if FORCE is t, the message or the part is re-displayed."
 771   (if (not (or force mew-summary-buffer-disp-msg))
 772       ()
 773     (mew-summary-msg-or-part
 774      (let* ((fld (mew-summary-folder-name))
 775             (msg (mew-summary-message-number))
 776             (fld-msg (cons fld msg))
 777             (ofld-msg (mew-current-get 'message))
 778             (part (mew-syntax-nums))
 779             (opart (mew-current-get 'part))
 780             (buf (buffer-name))
 781             (win (selected-window))
 782             prefetch)
 783        (unwind-protect
 784            (progn
 785              (mew-summary-toggle-disp-msg 'on)
 786              (mew-window-configure buf 'message)
 787              ;; messge buffer
 788              (cond
 789               (msg
 790                (if (or (null ofld-msg)
 791                        (not (equal fld-msg ofld-msg))
 792                        opart
 793                        force)
 794                    (progn
 795                      (mew-summary-display-message fld msg buf force)
 796                      (setq prefetch t))))
 797               (part
 798                (if (or (null opart) (not (equal opart part)) force)
 799                    (mew-summary-display-part
 800                     (mew-cache-decode-syntax (mew-cache-hit ofld-msg))
 801                     part)))))
 802          (select-window win)
 803          ;; summary buffer
 804          (mew-summary-show-postscript prefetch))))))
 805
 806 (defvar mew-message-overlay nil)
 807
 808 (defun mew-message-set-end-of ()
 809   (save-restriction
 810     (widen)
 811     (save-excursion
 812       (mew-elet
 813        (goto-char (point-max))
 814        (if (not (bolp)) (insert "\n"))
 815        (if (and mew-xemacs-p (extent-at (point) nil nil nil 'at))
 816            ;; to skip graphics
 817            (insert "\n"))
 818        (mew-message-clear-end-of)
 819        (if (or mew-end-of-message-string mew-end-of-part-string)
 820            (progn
 821              (mew-overlay-move mew-message-overlay (point-max) (point-max))
 822              (if (mew-decode-syntax-p)
 823                  (if (mew-summary-end-of-message-p)
 824                      (mew-message-set-end-of-message)
 825                    (mew-message-set-end-of-part))
 826                (mew-message-set-end-of-message))))))))
 827
 828 (defmacro mew-message-clear-end-of ()
 829   '(progn
 830      (if (not (mew-local-variable-p 'mew-message-overlay))
 831          (make-local-variable 'mew-message-overlay))
 832      (if (not (mew-overlay-p mew-message-overlay))
 833          (setq mew-message-overlay
 834                (mew-overlay-make (point-max) (point-max))))
 835      (mew-message-set-end-of-nil)))
 836
 837 (defmacro mew-summary-display-preamble ()
 838   '(progn
 839      (mew-message-clear-end-of)
 840      (mew-overlay-delete-buffer) ;; also delete extents
 841      (set-marker (mark-marker) nil) ;; kill mark for cite
 842      (mew-erase-buffer)))
 843
 844 (defmacro mew-summary-display-postscript ()
 845   '(progn
 846      (run-hooks 'mew-message-hook)
 847      (mew-message-set-end-of)
 848      (set-buffer-modified-p nil)))
 849
 850 (defun mew-summary-display-message (fld msg buf force)
 851   ;; message buffer
 852   (mew-elet
 853    (let ((zmacs-regions nil)
 854          (file (mew-expand-folder fld msg))
 855          toolarge hit)
 856      (mew-summary-display-preamble)
 857      ;;
 858      (mew-decode-syntax-delete)
 859      (mew-summary-mode-line buf) (set-buffer-modified-p nil)
 860      ;;
 861      (mew-current-set 'message (cons fld msg))
 862      (mew-current-set 'part nil)
 863      (mew-current-set 'cache nil)
 864      ;;
 865      (setq mew-decode-syntax nil)
 866      (if (not (or (mew-folder-remotep fld) (file-exists-p file)))
 867          (message "File does not exist.")
 868        (cond
 869         ((and (not mew-debug) (equal fld mew-draft-folder))
 870          (insert-file-contents file))
 871         ((and (not force) ;; not force, so don't cache if too large
 872               (not (mew-cache-hit (cons fld msg))) ;; use cache
 873               (setq toolarge
 874                     (and (mew-folder-localp fld)
 875                          (> (mew-file-get-size file) mew-file-max-size))))
 876          (mew-insert-message fld msg mew-cs-autoconv (1- mew-file-max-size))
 877          (condition-case nil
 878              (progn
 879                (mew-decode-rfc822-header)
 880                (mew-header-goto-end)
 881                (mew-header-arrange (point-min) (point))
 882                (setq mew-decode-syntax (mew-decode-syntax-rfc822))
 883                (if toolarge
 884                    (message
 885                     (substitute-command-keys
 886                      "Too large, this message was truncated. To see the entire message, type '\\<mew-summary-mode-map>\\[mew-summary-display-command]'"))))
 887            (error
 888             (if mew-decode-error
 889                 (message mew-decode-error)))))
 890         (t
 891          (setq hit (mew-cache-message fld msg force))
 892          (if (null hit)
 893              ()
 894            (mew-current-set 'cache hit)
 895            (setq mew-decode-syntax (mew-cache-decode-syntax hit))
 896            (setq mew-decode-error  (mew-cache-decode-error hit))
 897            (setq mew-syntax-multi-form (mew-cache-multi-form hit))
 898            (setq mew-syntax-icon-spec (mew-cache-icon-spec hit))
 899            (setq mew-syntax-privacy-result (mew-cache-privacy-result hit))
 900            (mew-decode-syntax-print buf mew-decode-syntax
 901                                     mew-syntax-multi-form
 902                                     mew-syntax-icon-spec)
 903            (mew-mime-message/rfc822 mew-decode-syntax)
 904            (if mew-decode-error
 905                (message "MIME decoding error: %s" mew-decode-error))))))
 906      (mew-summary-display-postscript))))
 907
 908 (defun mew-summary-display-part (fullpart nums &optional execute)
 909   ;; message buffer
 910   (mew-elet
 911    (let ((zmacs-regions nil))
 912      (mew-summary-display-preamble)
 913      (mew-mime-part fullpart nums execute)
 914      (mew-current-set 'part nums) ;; should be after funcall
 915      (mew-summary-display-postscript))))
 916
 917 (defun mew-summary-display-asis (&optional arg)
 918   "Display this message in the raw format(i.e. without MIME analysis).
 919 The beginning part of the message, whose size specified by
 920 'mew-file-max-size', is displayed. If called with '\\[universal-argument]', the
 921 entire message is displayed in the raw format."
 922   (interactive "P")
 923   (mew-summary-msg
 924    (let* ((fld (mew-summary-folder-name))
 925           (msg (mew-summary-message-number))
 926           (file (mew-expand-folder fld msg))
 927           (win (selected-window))
 928           size)
 929      (unwind-protect
 930          (progn
 931            (mew-summary-toggle-disp-msg 'on)
 932            (mew-decode-syntax-delete)
 933            (mew-window-configure (current-buffer) 'message)
 934            (set-buffer (mew-buffer-message))
 935            ;; messge buffer
 936            (mew-elet
 937             (let ((zmacs-regions nil))
 938               (mew-summary-display-preamble)
 939               (mew-current-set 'message (cons fld msg))
 940               (mew-current-set 'part nil)
 941               (mew-current-set 'cache nil)
 942               (if (and (mew-folder-localp fld)
 943                        (null arg)
 944                        (> (mew-file-get-size file) mew-file-max-size))
 945                   (setq size (1- mew-file-max-size)))
 946               (mew-insert-message fld msg mew-cs-autoconv size)
 947               (mew-message-set-end-of)
 948               (let ((mew-header-max-length nil)
 949                     (mew-header-max-depth nil))
 950                 (mew-decode-rfc822-header))
 951               (mew-header-goto-end)
 952               (mew-header-arrange (point-min) (point))
 953               (setq mew-decode-syntax (mew-decode-syntax-rfc822))
 954               (set-buffer-modified-p nil))))
 955        (select-window win)
 956        ;; summary buffer
 957        (mew-summary-show-postscript nil)))))
 958
 959 (defun mew-summary-execute-external ()
 960   "Execute an external command according to
 961 Content-Type:"
 962   (interactive)
 963   (mew-summary-part
 964    (let* ((ofld-msg (mew-current-get 'message))
 965           (nums (mew-syntax-nums))
 966           (buf (buffer-name)))
 967      (unwind-protect
 968          (progn
 969            (mew-summary-toggle-disp-msg 'on)
 970            (mew-window-configure buf 'message)
 971            ;; message buffer
 972            (mew-summary-display-part
 973             (mew-cache-decode-syntax (mew-cache-hit ofld-msg)) nums t))
 974        (mew-pop-to-buffer buf)))))
 975
 976 (defun mew-summary-recenter ()
 977   "Make the current line to the center of Summary mode."
 978   (interactive)
 979   (if (or mew-summary-recenter-p
 980           (interactive-p))
 981       (recenter (/ (- (window-height) 2) 2))))
 982
 983 (defun mew-summary-mouse-show (e)
 984   "Mouse version of 'mew-summary-show'."
 985   (interactive "e")
 986   (mouse-set-point e)
 987   (beginning-of-line)
 988   (mew-summary-show))
 989
 990 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 991 ;;;
 992 ;;; direction
 993 ;;;
 994
 995 (defun mew-summary-next ()
 996   (if (eq mew-summary-buffer-direction 'up)
 997       (mew-summary-up)
 998     (mew-summary-down)))
 999
1000 (defmacro mew-summary-regex ()
1001   '(concat mew-summary-message-regex
1002            "[ " (char-to-string mew-mark-review) "]\\|"
1003            mew-syntax-number-text-regex))
1004
1005 (defun mew-summary-down ()
1006   (forward-line)
1007   (cond
1008    ((re-search-forward (mew-summary-regex) nil t)
1009     (beginning-of-line)
1010     (setq mew-summary-buffer-direction 'down)
1011     t)
1012    (t
1013     (mew-decode-syntax-delete)
1014     (mew-current-set 'message nil)
1015     (forward-line -1)
1016     (mew-window-configure (current-buffer) 'summary)
1017     (mew-current-set 'message nil)
1018     (message "No more message")
1019     nil)))
1020
1021 (defun mew-summary-up ()
1022   (cond
1023    ((re-search-backward (mew-summary-regex) nil t)
1024     (setq mew-summary-buffer-direction 'up)
1025     t)
1026    (t
1027     (mew-decode-syntax-delete)
1028     (mew-window-configure (current-buffer) 'summary)
1029     (mew-current-set 'message nil)
1030     (message "No more message")
1031     nil)))
1032
1033 ;;
1034
1035 (defun mew-summary-display-next ()
1036   (if (mew-summary-next) (mew-summary-display nil)))
1037
1038 (defun mew-summary-display-up (&optional arg)
1039   "Move to above then display. Targets includes parts, messages
1040 marked with '*', and non-marked messages. When called with '\\[universal-argument]',
1041 parts are skipped."
1042   (interactive "P")
1043   (beginning-of-line)
1044   (if arg
1045       (progn
1046         (mew-summary-goto-message)
1047         (mew-decode-syntax-delete)))
1048   (if (mew-summary-up) (mew-summary-display nil)))
1049
1050 (defun mew-summary-display-down (&optional arg)
1051   "Move to below then display. Targets includes parts, messages
1052 marked with '*', and non-marked messages. When called with '\\[universal-argument]',
1053 parts are skipped."
1054   (interactive "P")
1055   (if arg
1056       (progn
1057         (mew-summary-goto-message)
1058         (mew-decode-syntax-delete)))
1059   (if (mew-summary-down) (mew-summary-display nil)))
1060
1061 ;;
1062
1063 (defun mew-summary-prev-page ()
1064   "\\<mew-summary-mode-map>
1065 Back-scroll this message. Unnecessary header fields are hidden
1066 over the window. Type '\\[mew-summary-prev-page]' to see them when a message is displayed."
1067   (interactive)
1068   (mew-summary-scroll-down 'fullpage))
1069
1070 (defun mew-summary-scroll-up ()
1071   "Make this message scroll up with one line."
1072   (interactive)
1073   (mew-summary-msg-or-part
1074    (let ((buf (current-buffer))
1075          (msg (mew-summary-message-number))
1076          (ofld-msg (mew-current-get 'message))
1077          (part (mew-syntax-nums))
1078          (opart (mew-current-get 'part)))
1079      (if (or (and msg (string= msg (cdr ofld-msg)) (null part) (null opart))
1080              (and part (equal part opart)))
1081          (unwind-protect
1082              (progn
1083                (mew-window-configure buf 'message)
1084                (mew-message-next-page 1))
1085            (mew-pop-to-buffer buf))
1086        (mew-summary-show)))))
1087
1088 (defun mew-summary-scroll-down (&optional fullpage)
1089   "Make this message scroll down with one line."
1090   (interactive)
1091   (mew-summary-msg-or-part
1092    (let ((buf (current-buffer))
1093          (msg (mew-summary-message-number))
1094          (ofld-msg (mew-current-get 'message))
1095          (part (mew-syntax-nums))
1096          (opart (mew-current-get 'part)))
1097      (if (or (and msg (string= msg (cdr ofld-msg)) (null part) (null opart))
1098              (and part (equal part opart)))
1099          (unwind-protect
1100              (progn
1101                (mew-window-configure buf 'message)
1102                (mew-message-prev-page (if fullpage nil 1)))
1103            (mew-pop-to-buffer buf))
1104        (mew-summary-show)))))
1105
1106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1107 ;;;
1108 ;;; to Draft mode
1109 ;;;
1110
1111 (defun mew-summary-send (&optional to cc subject)
1112   "Write a message. A new draft is prepared in Draft mode."
1113   (interactive)
1114   (let* ((draft (mew-folder-new-message mew-draft-folder))
1115          (attachdir (mew-attachdir draft)))
1116     (mew-current-set 'window (current-window-configuration))
1117     (mew-window-configure (current-buffer) 'draft)
1118     (mew-summary-prepare-draft
1119      (switch-to-buffer (find-file-noselect draft))
1120      (mew-draft-rename draft)
1121      (mew-delete-directory-recursively attachdir)
1122      (mew-draft-header subject nil to cc)
1123      (mew-draft-mode)
1124      (run-hooks 'mew-draft-mode-newdraft-hook))))
1125
1126 (defun mew-summary-reply (&optional onlytofrom)
1127   "Answer to this message. A new draft is prepared in Draft mode.
1128 Mew automatically decides To: and Cc:. Addresses on To: and Cc:
1129 are decided as follows:
1130
1131     If From: of the message to be replied is not from me:
1132         Reply-To: doesn't exist in the message to be replied
1133             Copy From: of the message to be replied to To: (1)
1134             Copy To: and Cc: of the message to be replied to Cc: (2)
1135         Reply-To: exists in the message to be replied
1136             Copy From: and Reply-To: of the message to be replied to To: (3)
1137             Copy To: and Cc: of the message to be replied to Cc: (4)
1138     If From: of a message to be replied is from me:
1139         Copy To: of the message to be replied to To: (5)
1140         Copy Cc: of the message to be replied to Cc: (6)
1141
1142 You can customize which fields are copied in the case (1)-(6) with the
1143 following variables:
1144
1145     (1) mew-noreplyto-to-list
1146     (2) mew-noreplyto-cc-list
1147     (3) mew-replyto-to-list
1148     (4) mew-replyto-cc-list
1149     (5) mew-fromme-to-list
1150     (6) mew-fromme-cc-list
1151
1152 If executed with '\\[universal-argument]', only From: of the message is copied to To:.
1153 "
1154   (interactive "P")
1155   (mew-summary-msg-or-part
1156    (mew-summary-toggle-disp-msg 'on)
1157    (mew-current-set 'window (current-window-configuration))
1158    (let* ((buf (buffer-name))
1159           (draft (mew-folder-new-message mew-draft-folder))
1160           (attachdir (mew-attachdir draft))
1161           from reply-to to cc newsgroups subject in-reply-to references
1162           cbuf encrypted fromme)
1163      (mew-summary-prepare-draft
1164       (if (get-buffer (mew-buffer-message))
1165           (delete-windows-on (mew-buffer-message)))
1166       (if (< (window-height) 25) (delete-other-windows))
1167       (let ((split-window-keep-point t))
1168         (split-window-vertically))
1169       (switch-to-buffer-other-window (find-file-noselect draft))
1170       (mew-draft-rename draft)
1171       (mew-delete-directory-recursively attachdir)
1172       (setq cbuf (current-buffer)) ;; draft
1173       (mew-pop-to-buffer buf)
1174       (mew-summary-display nil)
1175       ;; see also mew-draft-cite
1176       (set-buffer (or (save-excursion
1177                         (set-buffer (mew-buffer-message))
1178                         (if (mew-header-p) (current-buffer)))
1179                       ;; header exists only in cache if multipart
1180                       (mew-cache-hit (mew-current-get 'message))))
1181       (setq encrypted (mew-syntax-encrypted-p mew-decode-syntax))
1182       (save-restriction
1183         ;; if body contains ^L, header is not accessible.
1184         ;; mew-header-* can't widen essentially. So widen here.
1185         (widen)
1186         ;; now cache buffer
1187         (setq from (mew-header-parse-address mew-from:))
1188         (setq reply-to (mew-header-parse-address mew-reply-to:))
1189         (cond
1190          (onlytofrom (setq to from))
1191          ((mew-is-my-address (mew-get-my-address-regex-list) from)
1192           ;; This message was sent by me. So, maintain To: and Cc:.
1193           (setq fromme t)
1194           (setq to (mew-header-parse-address-list2 mew-fromme-to-list))
1195           (setq cc (mew-header-parse-address-list2 mew-fromme-cc-list))
1196           (if (null to) (setq to (or reply-to from)))) ;; don't use list
1197          (t
1198           (cond
1199            (reply-to
1200             (setq to (mew-header-parse-address-list2 mew-replyto-to-list))
1201             (setq cc (mew-header-parse-address-list2 mew-replyto-cc-list)))
1202            (t
1203             (setq to (mew-header-parse-address-list2 mew-noreplyto-to-list))
1204             (setq cc (mew-header-parse-address-list2 mew-noreplyto-cc-list)))))
1205          )
1206         (setq newsgroups (or (mew-header-get-value mew-followup-to:)
1207                              (mew-header-get-value mew-newsgroups:)))
1208         (if (and newsgroups (mew-case-equal newsgroups "poster"))
1209             (setq newsgroups nil))
1210         (setq subject (mew-header-get-value mew-subj:))
1211         (if (and subject (not (string-match mew-reply-regex subject)))
1212             (setq subject (concat mew-reply-string subject)))
1213         ;;
1214         ;; DRUMS says:
1215         ;;
1216         ;; If the original message contains a "Message-ID:" field, the
1217         ;; contents of that field body are copied into the body of an
1218         ;; "In-Reply-To:" field and into the body of a "References:"
1219         ;; field in the new message. If the original message contains a
1220         ;; "References:" field and/or an "In-Reply-To:" field already
1221         ;; (hence a reply to a reply), the contents of the old
1222         ;; "References:" field are copied to the "References:" field in
1223         ;; the new message, appending to it the contents of the old
1224         ;; "In-Reply-To:" field (if its message identifier was not
1225         ;; already in the "References:" field) and the contents of the
1226         ;; "Message-ID:" field of the original message. In this way, a
1227         ;; "thread" of conversation can be established.
1228         ;;
1229         ;;
1230         (let ((old-message-id  (mew-header-get-value mew-message-id:))
1231               (old-in-reply-to (mew-header-get-value mew-in-reply-to:))
1232               (old-references  (mew-header-get-value mew-references:))
1233               (regex "<[^>]+>")
1234               (start 0) tmp-ref skip)
1235           (if (and old-message-id (string-match regex old-message-id))
1236               (setq old-message-id (mew-match 0 old-message-id))
1237             (setq old-message-id nil))
1238           (if (and old-in-reply-to (string-match regex old-in-reply-to))
1239               (setq old-in-reply-to (mew-match 0 old-in-reply-to))
1240             (setq old-in-reply-to nil))
1241           (if (null old-message-id)
1242               () ;; we don't care even if old-references exist.
1243             (setq in-reply-to old-message-id)
1244             (if (null old-references)
1245                 (setq tmp-ref (if old-in-reply-to
1246                                   (list old-in-reply-to old-message-id)
1247                                 (list old-message-id)))
1248               (while (string-match "<[^>]+>" old-references start)
1249                 (setq start (match-end 0))
1250                 (setq tmp-ref (cons (mew-match 0 old-references) tmp-ref)))
1251               (if (and old-in-reply-to (not (member old-in-reply-to tmp-ref)))
1252                   (setq tmp-ref (cons old-in-reply-to tmp-ref)))
1253               (setq tmp-ref (nreverse (cons old-message-id tmp-ref))))
1254             (if (integerp mew-references-max-count)
1255                 (setq skip (- (length tmp-ref) mew-references-max-count)))
1256             (if (and (numberp skip) (> skip 0))
1257                 (setq tmp-ref (nthcdr skip tmp-ref)))
1258             (setq references (mew-join "\n\t" tmp-ref)))))
1259       ;;
1260       (mew-pop-to-buffer cbuf) ;; draft
1261       (mew-draft-header subject nil to cc newsgroups in-reply-to references
1262                         nil fromme)
1263       (if (eq mew-summary-reply-position 'body)
1264           (progn
1265             (goto-char (mew-header-end))
1266             (forward-line)))
1267       (mew-draft-mode encrypted)
1268       (run-hooks 'mew-draft-mode-newdraft-hook)))))
1269
1270 (defun mew-summary-reply-with-citation (&optional onlytofrom)
1271   "Answer to this message. A new draft is prepared in Draft mode.
1272 And this message is automatically cited. See also 'mew-summary-reply'."
1273   (interactive "P")
1274   (mew-summary-msg-or-part
1275    (let ((mew-summary-reply-position nil))
1276      (mew-summary-reply onlytofrom))
1277    ;; mew-draft-mode-hook may insert text.
1278    (save-excursion
1279      (goto-char (point-max))
1280      (run-hooks 'mew-before-cite-hook)
1281      (mew-draft-cite))
1282    ;; the cursor is after To:
1283    (cond
1284     ((eq mew-summary-reply-with-citation-position 'body)
1285      (goto-char (mew-header-end))
1286      (forward-line))
1287     ((eq mew-summary-reply-with-citation-position 'end)
1288      (goto-char (point-max))))))
1289
1290 (defun mew-summary-forward ()
1291   "Forward this message to a third person. A new draft is prepared in
1292 Draft mode and this message is automatically attached."
1293   (interactive)
1294   (mew-summary-msg-or-part
1295    (mew-current-set 'window (current-window-configuration))
1296    (let* ((buf (buffer-name))
1297           (draft (mew-folder-new-message mew-draft-folder))
1298           (draftdir (file-name-nondirectory draft))
1299           (attachdir (mew-attachdir draft))
1300           file subject fwsubject cbuf)
1301      (save-excursion
1302        (mew-summary-goto-message)
1303        (setq file (mew-expand-folder-get-msg (mew-summary-folder-name)
1304                                              (mew-summary-message-number))))
1305      (mew-summary-prepare-draft
1306       (delete-other-windows)
1307       (let ((split-window-keep-point t))
1308         (split-window-vertically))
1309       (switch-to-buffer-other-window (find-file-noselect draft))
1310       (mew-draft-rename draft)
1311       (mew-delete-directory-recursively attachdir)
1312       (setq cbuf (current-buffer)) ;; draft
1313       (mew-pop-to-buffer buf)
1314       (mew-summary-display 'force) ;; force to get Subject:
1315       ;;
1316       (set-buffer (or (save-excursion
1317                         (set-buffer (mew-buffer-message))
1318                         (if (mew-header-p) (current-buffer)))
1319                       ;; header exists only in cache if multipart
1320                       (mew-cache-hit (mew-current-get 'message))))
1321       (setq subject (mew-header-get-value mew-subj:))
1322       (if (and subject (not (string-match mew-forward-regex subject)))
1323           (setq fwsubject (concat mew-forward-string subject))
1324         (setq fwsubject subject))
1325       (mew-pop-to-buffer cbuf) ;;; draft
1326       ;;
1327       (mew-draft-header fwsubject 'nl)
1328       (mew-draft-mode)
1329       (run-hooks 'mew-draft-mode-newdraft-hook)
1330       (mew-draft-multi-copy draft (list file))
1331       (setq mew-encode-syntax (mew-encode-syntax-initial-multi draftdir 1))
1332       (save-excursion
1333         (mew-draft-prepare-attachments t))))))
1334
1335 (defun mew-summary-multi-forward ()
1336   "Forward messages marked with '@' to a third person. A new draft
1337 is prepared in Draft mode and this message is automatically
1338 attached."
1339   (interactive)
1340   (mew-summary-multi-msgs
1341    (mew-current-set 'window (current-window-configuration))
1342    (let* ((draft (mew-folder-new-message mew-draft-folder))
1343           (draftdir (file-name-nondirectory draft)))
1344      (mew-summary-prepare-draft
1345       (delete-other-windows)
1346       (let ((split-window-keep-point t))
1347         (split-window-vertically))
1348       (switch-to-buffer-other-window (find-file-noselect draft))
1349       (mew-draft-rename draft)
1350       (mew-draft-header nil 'nl)
1351       (mew-draft-mode)
1352       (run-hooks 'mew-draft-mode-newdraft-hook)
1353       (mew-draft-multi-copy draft FILES)
1354       (setq mew-encode-syntax
1355             (mew-encode-syntax-initial-multi draftdir (length FILES)))
1356       (save-excursion
1357         (mew-draft-prepare-attachments t))))))
1358
1359 (defun mew-draft-multi-copy (draft files)
1360   (let* ((attach (mew-draft-to-mime draft))
1361          (attachdir (mew-expand-folder attach)))
1362     (if (not (file-directory-p attachdir))
1363         (mew-make-directory attachdir))
1364     (while files
1365       (if mew-use-symbolic-link-for-forwarding
1366           (mew-symbolic-link (car files) (mew-folder-new-message attach))
1367         (copy-file (car files) (mew-folder-new-message attach)))
1368       (setq files (cdr files)))))
1369
1370 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1371 ;;;
1372 ;;; Edit again and Resend
1373 ;;;
1374
1375 (defun mew-summary-edit-message ()
1376   (let ((msg (mew-summary-message-number))
1377         (part (mew-syntax-nums))
1378         (cache (mew-current-get 'cache))
1379         syntax doit)
1380     (cond
1381      ((and part (null cache)))
1382      (msg
1383       (setq doit t))
1384      (part
1385       (setq syntax (mew-syntax-get-entry
1386                     (mew-cache-decode-syntax cache) part))
1387       (if (not (mew-case-equal
1388                 mew-ct-msg
1389                 (mew-syntax-get-value (mew-syntax-get-ct syntax) 'cap)))
1390           ()
1391         (setq doit t)
1392         (save-excursion
1393           (mew-summary-goto-message)
1394           (setq msg (mew-summary-message-number))))))
1395     (if (not doit)
1396         'mew-error
1397       (let* ((fld (mew-summary-folder-name))
1398              (newdraftp (not (equal fld mew-draft-folder)))
1399              draft attachdir)
1400         (mew-current-set 'window (current-window-configuration))
1401         (mew-window-configure (current-buffer) 'summary)
1402         (mew-summary-prepare-draft
1403          (if (or part newdraftp)
1404              (setq draft (mew-folder-new-message mew-draft-folder))
1405            (setq draft (mew-expand-folder-get-msg fld msg)))
1406          (setq attachdir (mew-attachdir draft))
1407          ;; prepare draft file
1408          (switch-to-buffer (find-file-noselect draft))
1409          (mew-draft-rename draft)
1410          (mew-delete-directory-recursively attachdir)
1411          (cond
1412           (part
1413            (insert-buffer-substring
1414             cache
1415             (mew-syntax-get-begin syntax)
1416             (mew-syntax-get-end (mew-syntax-get-part syntax))))
1417           (newdraftp
1418            ;; if fld equal mew-draft-folder, message already exists.
1419            (insert-file-contents (mew-expand-folder-get-msg fld msg))))))
1420       nil)))
1421
1422 (defun mew-summary-edit-header ()
1423   (mew-elet
1424    (mew-header-delete-lines mew-field-delete-common)
1425    (mew-header-delete-lines mew-field-delete-for-reediting)
1426    (mew-header-goto-end)
1427    (mew-draft-header-fill mew-fcc:      mew-fcc)
1428    (mew-draft-header-fill mew-dcc:      mew-dcc)
1429    (mew-draft-header-fill mew-from:     mew-from)
1430    (mew-draft-header-fill mew-reply-to: mew-reply-to)
1431    (mew-draft-header-fill mew-x-mailer: mew-x-mailer)
1432    (if (and mew-use-config-imget-for-draft
1433             (not (string-equal mew-config-imget mew-config-default)))
1434        (mew-draft-header-insert mew-config: mew-config-imget))
1435    (let ((ct (mew-addrstr-parse-value (mew-header-get-value mew-ct:))))
1436      (if (and ct (mew-case-equal mew-ct-txt ct))
1437          (let ((mew-header-max-length nil)
1438                (mew-header-max-depth nil))
1439            (mew-header-delete-lines (list mew-ct: mew-cte:))
1440            (mew-decode-rfc822-header 'no-property))))
1441    (mew-header-clear) ;; erase the old header separator
1442    (mew-header-prepared)
1443    (save-buffer)))
1444
1445 (defun mew-summary-resend ()
1446   "\\<mew-summary-mode-map>
1447 Resend this message with Resent-To:. It is strongly
1448 discouraged to use this command since beginners are always
1449 confused. Please use '\\[mew-summary-forward]' instead."
1450   (interactive)
1451   (mew-summary-msg-or-part
1452    (if (mew-summary-edit-message)
1453        (message "Can't resend here.")
1454      (mew-elet
1455       (goto-char (point-min))
1456       (mew-header-delete-lines mew-field-delete-common)
1457       (mew-header-delete-lines mew-field-delete-for-resending)
1458       (goto-char (point-min))
1459       (insert mew-resent-to: " \n") ;; MUST use insert.
1460       (mew-draft-header-fill mew-resent-from: mew-from)
1461       (mew-draft-header-fill mew-fcc:  mew-fcc)
1462       (mew-draft-header-fill mew-dcc:  mew-dcc)
1463       (mew-header-goto-end)
1464       (mew-header-clear) ;; erase the old header separator
1465       (mew-header-prepared))
1466      (save-buffer)
1467      (mew-draft-mode)
1468      (run-hooks 'mew-draft-mode-reedit-hook)
1469      ;; move the cursor after "Resent-To: "
1470      (goto-char (point-min))
1471      (end-of-line))))
1472
1473 (defun mew-summary-reedit ()
1474   "Edit this message again to retry sending. Or edit this
1475 rfc822 part typically included MIME-encapsulated error message.
1476 In a draft folder, it just edits the message. Otherwise,
1477 copy the message to draft folder, then edit.
1478 See also mew-summary-edit-again."
1479   (interactive)
1480   (mew-summary-msg-or-part
1481    (if (mew-summary-edit-message)
1482        (message "Can't reedit here.")
1483      (mew-summary-edit-header)
1484      (mew-draft-mode)
1485      (run-hooks 'mew-draft-mode-reedit-hook))))
1486
1487 (defun mew-summary-edit-again ()
1488   "Edit an old fashioned error message in which the original message
1489 is encapsulated after strings defined in 'mew-summary-edit-again-regex'
1490 An example is \"----- Original message follows -----\". See also
1491 mew-summary-reedit."
1492   (interactive)
1493   (mew-summary-msg
1494    (let ((msg (mew-summary-message-number)) ;; must get msg here
1495          (fld (mew-summary-folder-name))
1496          draft attachdir)
1497      (mew-current-set 'window (current-window-configuration))
1498      (mew-window-configure (current-buffer) 'summary)
1499      (mew-summary-prepare-draft
1500       (cond
1501        ((equal fld mew-draft-folder)
1502         (setq draft (mew-expand-folder mew-draft-folder msg))
1503         ;; the message already exists.
1504         (switch-to-buffer (find-file-noselect draft)))
1505        (t
1506         (setq draft (mew-folder-new-message mew-draft-folder))
1507         (switch-to-buffer (find-file-noselect draft))
1508         (insert-file-contents (mew-expand-folder-get-msg fld msg))))
1509       (setq attachdir (mew-attachdir draft))
1510       (mew-draft-rename draft)
1511       (mew-delete-directory-recursively attachdir)
1512       (goto-char (point-min))
1513       (if (re-search-forward mew-summary-edit-again-regex nil t)
1514           (progn
1515             (forward-line)
1516             ;; skip blank lines
1517             (while (looking-at "^$") (forward-line))
1518             (delete-region (point-min) (point))))
1519       (mew-summary-edit-header)
1520       (mew-draft-mode)
1521       (run-hooks 'mew-draft-mode-reedit-hook)))))
1522
1523 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1524 ;;;
1525 ;;; Packing
1526 ;;;
1527
1528 (defun mew-summary-pack ()
1529   "Pack messages and list them up again."
1530   (interactive)
1531   (mew-summary-only
1532    (let ((folder (buffer-name))
1533          lines)
1534      (if (not (mew-summary-exclusive-p))
1535          ()
1536        (mew-mark-clean)
1537        (if (and mew-ask-pack (not (y-or-n-p (format "Pack %s? " folder))))
1538            ()
1539          (setq lines (mew-summary-mark-collect3 mew-mark-review))
1540          (setq mew-summary-buffer-process t)
1541          (mew-im-call-process-no-output
1542           (concat "Packing " folder)
1543           mew-prog-impack
1544           (format "--src=%s" folder))
1545          (setq mew-summary-buffer-process nil)
1546          (mew-erase-buffer) ;; for update
1547          (mew-summary-scan-body mew-prog-imls
1548                                 'mew-summary-mode
1549                                 folder
1550                                 mew-cs-scan
1551                                 nil nil nil
1552                                 lines))))))
1553
1554 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1555 ;;;
1556 ;;; Good old days...
1557 ;;;
1558
1559 (defun mew-summary-unshar ()
1560   "Apply 'unshar' on messages marked with '@'."
1561   (interactive)
1562   (mew-summary-multi-msgs
1563    (if (not (y-or-n-p (format "Execute %s for these messages? "
1564                               mew-prog-unshar)))
1565        ()
1566      (let ((dir (mew-summary-input-directory-name)))
1567        (message "Executing %s ... " mew-prog-unshar)
1568        (save-excursion
1569          (mew-set-buffer-tmp dir)
1570          (apply (function call-process) mew-prog-unshar nil nil nil FILES))
1571        (message "Executing %s ... done" mew-prog-unshar)))))
1572
1573 (defun mew-summary-uudecode ()
1574   "Apply 'uudecode' on messages marked with '@'."
1575   (interactive)
1576   (mew-summary-multi-msgs
1577    (if (not (y-or-n-p (format "Execute %s for these messages? "
1578                               mew-prog-uumerge)))
1579        ()
1580      (let ((dir (mew-summary-input-directory-name))
1581            (tarfile nil)
1582            (case-fold-search nil))
1583        (save-excursion
1584          (mew-set-buffer-tmp dir)
1585          (message "Executing %s ..." mew-prog-uumerge)
1586          (apply (function call-process) mew-prog-uumerge nil t nil FILES)
1587          (message "Executing %s ... done" mew-prog-uumerge)
1588          (goto-char (point-min))
1589          (if (looking-at "^uumerge:")
1590              (message "Failed to executing %s" mew-prog-uumerge)
1591            (forward-line)
1592            (setq tarfile (mew-buffer-substring (point-min) (1- (point))))
1593            (setq tarfile
1594                  (mew-summary-prog-exec mew-prog-compress "-df" "Z" tarfile))
1595            (setq tarfile
1596                  (mew-summary-prog-exec mew-prog-gzip "-df" "gz" tarfile))
1597            (if (string-match "^\\(.*\\)\\.tar$" tarfile)
1598                (if (not (y-or-n-p (format "Execute %s for %s? "
1599                                           mew-prog-tar tarfile)))
1600                    ()
1601                  (message (format "Executing %s for %s ... "
1602                                   mew-prog-tar tarfile))
1603                  (call-process mew-prog-tar nil nil nil "-xf" tarfile)
1604                  (message (format "Executing %s for %s ... done"
1605                                   mew-prog-tar tarfile))))))))))
1606
1607 (defun mew-summary-prog-exec (prog opts suffix tarfile)
1608   (if (string-match (format "^\\(.*\\)\\.%s$" suffix) tarfile)
1609       (let ((data (match-data)))
1610         ;; save match data here for OS/2
1611         (unwind-protect
1612             (if (not (y-or-n-p (format "Execute %s for %s? " prog tarfile)))
1613                 tarfile
1614               (message (format "Executing %s for %s ... " prog tarfile))
1615               (call-process prog nil nil nil opts tarfile)
1616               (message (format "Executing %s for %s ... done" prog tarfile))
1617               (set-match-data data)
1618               (mew-match 1 tarfile))))
1619     tarfile))
1620
1621 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1622 ;;;
1623 ;;; These days...
1624 ;;;
1625
1626 (defun mew-summary-join ()
1627   "Concat Message/Partial fragments marked with '@' to an original
1628 message."
1629   (interactive)
1630   (mew-summary-multi-msgs
1631    (let ((folder (mew-input-folder (mew-inbox-folder))))
1632      (apply 'mew-im-call-process-no-output
1633        (format "Joining marked messages to %s ..." folder)
1634        mew-prog-imjoin (format "--dst=%s" folder) FILES)
1635      (message "Joining marked messages to %s ... done" folder))))
1636
1637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1638 ;;;
1639 ;;; Saving
1640 ;;;
1641
1642 (defun mew-summary-save (&optional askcs)
1643   "Save any parts. If the target is a message, you are asked which
1644 you want to save, the entire message or its body. If the target is
1645 a non-message part, the part is saved (with line delimiter conversion
1646 if it is a text object). When executed with '\\[universal-argument]', coding-system for
1647 a text object to be saved can be specified."
1648   (interactive "P")
1649   (mew-summary-display nil) ;; need to ensure to make a cache
1650   (let* ((fld (mew-summary-folder-name))
1651          (num (mew-syntax-number))
1652          (nums (mew-syntax-number-to-nums num))
1653          (cache (or (mew-current-get 'cache)
1654                     (mew-buffer-message)))
1655          (syntax (mew-syntax-get-entry (mew-cache-decode-syntax cache) nums))
1656          (action "Save")
1657          PLUS1P limit attr
1658          msg have-hdrp bodyp beg end cdpl file ctl cte
1659          error doit append-p)
1660     (save-excursion
1661       ;; First of all, we should determine which part the user want to
1662       ;; save due to the ambiguity.
1663       ;; "y" on Message/Rfc822
1664       ;;     - msg/txt      the entire msg or its body?
1665       ;;     - msg/mul/txt  the entire msg or its part 1?
1666       ;; We have to make use of mew-decode-syntax
1667       ;; in the cache buffer due to the PGP/MIME dilemma.
1668       ;; We need the correct LIMIT.
1669       (if (mew-syntax-message-p syntax)
1670           (let ((bodyname "the body") body bct plus1p)
1671             (setq body (mew-syntax-get-part syntax))
1672             (if (mew-syntax-multipart-p body)
1673                 (progn
1674                   (setq plus1p t)
1675                   (setq bodyname "the part 1 text")
1676                   (setq body (mew-syntax-get-entry body '(1)))))
1677             (setq bct (car (mew-syntax-get-ct body)))
1678             (if (mew-case-equal mew-ct-txt bct)
1679                 (if (y-or-n-p (format "Save the entire message (y) or %s (n) " bodyname))
1680                     (setq have-hdrp t)
1681                   (if plus1p
1682                       (setq nums (nreverse (cons 1 (nreverse nums))))
1683                     (setq bodyp t))
1684                   (setq PLUS1P (mew-syntax-get-privacy body)))
1685               (setq have-hdrp t))))
1686       ;; Now, let's analyze the message in the burst buffer.
1687       ;; This is lengthy, though, avoidable.
1688       (mew-summary-goto-message)
1689       (setq msg (mew-summary-message-number))
1690       (set-buffer (get-buffer-create mew-buffer-burst))
1691       (setq attr (mew-cache-attribute-get (mew-expand-folder fld msg)))
1692       (if PLUS1P
1693           (setq limit (1+ (length nums))) ;; VERY important for PGP/MIME
1694         (setq limit (length nums)))
1695       (setq mew-decode-DECODE nil)
1696       (if (and (equal mew-decode-LIMIT limit)
1697                (equal mew-cache-folder fld)
1698                (equal mew-cache-message-number msg)
1699                (equal mew-cache-attribute attr))
1700           ()
1701         (mew-erase-buffer)
1702         (mew-insert-message fld msg mew-cs-text-for-read nil)
1703         (setq mew-decode-LIMIT limit)
1704         (setq mew-cache-folder fld)
1705         (setq mew-cache-message-number msg)
1706         (setq mew-cache-attribute attr)
1707         (condition-case nil
1708             (setq mew-decode-syntax
1709                   (mew-decode-message (mew-decode-syntax-rfc822-head) 0))
1710           (error
1711            (setq error (concat "MIME decoding error: " mew-decode-error)))))
1712       (if error
1713           (message error)
1714         ;;
1715         (setq syntax (mew-syntax-get-entry mew-decode-syntax nums))
1716         (if bodyp (setq syntax (mew-syntax-get-part syntax)))
1717         ;;
1718         (setq beg (mew-syntax-get-begin syntax))
1719         (if (mew-syntax-message-p syntax)
1720             (setq end (mew-syntax-get-end (mew-syntax-get-part syntax)))
1721           (setq end (mew-syntax-get-end syntax)))
1722         (setq ctl (mew-syntax-get-ct syntax))
1723         (setq cte (mew-syntax-get-cte syntax))
1724         ;; file name
1725         (and syntax (setq cdpl (mew-syntax-get-cdp syntax)))
1726         (and (car cdpl)
1727              (setq file (mew-syntax-get-param cdpl "filename")))
1728         (and file (equal (mew-charset-guess-string file)
1729                          mew-error-charset-unknown)
1730              (setq file nil))
1731         (setq file (mew-summary-input-file-name nil file))
1732         ;;
1733         (if (not (file-exists-p file))
1734             (setq doit t)
1735           (if (null mew-file-append-p)
1736               (setq action "Overwrite")
1737             (setq action "Append")
1738             (setq append-p t))
1739           (if (y-or-n-p (format "File exists. %s it to %s? " action file))
1740               (setq doit t)))
1741         ;;
1742         (if (not doit)
1743             (message "Didn't save anything.")
1744           (let (linebasep tocs)
1745             (if (and askcs mew-mule-p)
1746                 (setq tocs (read-coding-system "Coding-system: ")))
1747             (mew-set-buffer-tmp)
1748             (insert-buffer-substring mew-buffer-burst beg end)
1749             (goto-char (point-min))
1750             (setq linebasep (mew-decode-mime-body ctl cte (or tocs t)))
1751             (if have-hdrp
1752                 (progn
1753                   (goto-char (point-min))
1754                   (mew-header-delete-lines mew-field-delete-common)
1755                   (mew-header-delete-lines mew-field-delete-for-saving)))
1756             (mew-frwlet
1757              mew-cs-dummy
1758              (if linebasep mew-cs-text-for-write mew-cs-binary)
1759              (write-region (point-min) (point-max) file append-p))))))))
1760
1761 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1762 ;;;
1763 ;;; Burst
1764 ;;;
1765
1766 (defun mew-summary-burst-body (fld msg folder)
1767   (save-excursion
1768     (let (entry multi mstr m n len)
1769       (set-buffer (get-buffer-create mew-buffer-burst))
1770       (mew-erase-buffer)
1771       (mew-insert-message fld msg mew-cs-text-for-read nil)
1772       (setq mew-decode-LIMIT 1)
1773       (setq mew-decode-DECODE nil)
1774       (setq mew-cache-message-number nil)
1775       (setq mew-cache-attribute nil)
1776       (condition-case nil
1777           (progn
1778             (setq mew-decode-syntax
1779                   (mew-decode-message (mew-decode-syntax-rfc822-head) 0))
1780             (setq multi (mew-syntax-get-part mew-decode-syntax))
1781             (if (not (mew-syntax-multipart-p multi))
1782                 (message "Can't burst")
1783               (if (not (mew-folder-check folder))
1784                   (error "%s is wrong. Nothing was processed." folder)
1785                 (setq mstr (mew-folder-new-message folder t))
1786                 (if (not (stringp mstr))
1787                     (error "Error in %s. Nothing was processed" folder)
1788                   (setq m (string-to-int mstr))
1789                   (setq len (- (length multi) mew-syntax-magic))
1790                   (setq n 1)
1791                   (while (<= n len)
1792                     (setq entry (mew-syntax-get-entry mew-decode-syntax
1793                                                       (list n)))
1794                     (if (not (mew-case-equal
1795                               (mew-syntax-get-value (mew-syntax-get-ct entry))
1796                               mew-ct-msg))
1797                         ()
1798                       (mew-frwlet
1799                        mew-cs-dummy mew-cs-text-for-write
1800                        (write-region
1801                         (mew-syntax-get-begin entry)
1802                         ;; This is RFC 822 message.
1803                         ;; So, body is a single text/plain.
1804                         (mew-syntax-get-end (mew-syntax-get-part entry))
1805                         (mew-expand-folder folder (int-to-string m))))
1806                       (setq m (1+ m)))
1807                     (setq n (1+ n)))
1808                   (list mstr (int-to-string (1- m)))))))
1809         (error
1810          (message "MIME decoding error: %s" mew-decode-error)
1811          nil)))))
1812
1813 (defun mew-summary-burst ()
1814   "De-capsulate messages embedded in this message."
1815   (interactive)
1816   (mew-summary-msg-or-part
1817    (let ((fld (mew-summary-folder-name))
1818          (folder (mew-input-folder (mew-inbox-folder)))
1819           msg ret)
1820      (save-excursion
1821        (mew-summary-goto-message)
1822        (setq msg (mew-summary-message-number)))
1823      (message "Bursting ... ")
1824      (setq ret (mew-summary-burst-body fld msg folder))
1825      (if (null ret)
1826          () ;; error
1827        (message "Bursting ... done")
1828        (mew-touch-folder folder)
1829        (if (y-or-n-p (format "Go to %s? " folder))
1830            (mew-summary-goto-folder t folder))
1831        (message "Messages from %s to %s were extracted in %s"
1832                 (nth 0 ret) (nth 1 ret) folder)))))
1833
1834 (defun mew-summary-burst-multi ()
1835   "De-capsulate messages embedded in the messages marked with '@'."
1836   (interactive)
1837   (mew-summary-multi-msgs
1838    (let ((folder (mew-input-folder (mew-inbox-folder)))
1839          (targets FLD-MSG-LIST))
1840      (message "Bursting ... ")
1841      (while targets
1842        (mew-summary-burst-body (car (car targets)) (cdr (car targets)) folder)
1843        (setq targets (cdr targets)))
1844      (message "Bursting ... done")
1845      (mew-touch-folder folder)
1846      (if (y-or-n-p (format "Go to %s? " folder))
1847          (mew-summary-goto-folder t folder)))))
1848
1849 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1850 ;;;
1851 ;;; Jumping
1852 ;;;
1853
1854 (defun mew-summary-jump-message (&optional msg)
1855   "Jump to a message according to the number which you input.
1856 If 'mew-summary-jump-message-then-display' is non-nil,
1857 the message is then displayed."
1858   (interactive)
1859   (let ((here (point)))
1860     (if (null msg) (setq msg (read-string "Message No. : " "")))
1861     (cond
1862      ((equal msg "") ())
1863      ((equal msg t) ;; xxx
1864       (goto-char (point-max))) ;; (forward-line -1)
1865      (t
1866       (goto-char (point-min))
1867       (if (re-search-forward (format "^[ ]*%s[^0-9]+" msg) nil t) ;; xxx regex?
1868           (progn
1869             (beginning-of-line)
1870             (if mew-summary-jump-message-then-display
1871                 (mew-summary-display nil)))
1872         (goto-char here))))))
1873
1874 (defun mew-summary-jump-to-draft-buffer ()
1875   "Jump to the newest draft if exists."
1876   (interactive)
1877   (let ((bufs (buffer-list))
1878         draft-bufs)
1879     (while bufs
1880       (if (string-match (concat "^" (regexp-quote mew-draft-folder))
1881                         (buffer-name (car bufs)))
1882           (setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
1883       (setq bufs (cdr bufs)))
1884     (cond
1885      ((null draft-bufs)
1886       (message "No draft buffer exist!"))
1887      (t
1888       (switch-to-buffer
1889        (car (sort draft-bufs (function (lambda (a b) (not (string< a b)))))))
1890       ))))
1891
1892 (defun mew-summary-jump-top ()
1893   "Go to the beginning of this Summary mode.
1894 If 'mew-summary-jump-top-then-display' is non-nil,
1895 the top message is then displayed."
1896   (interactive)
1897   (goto-char (point-min))
1898   (if mew-summary-jump-top-then-display
1899       (mew-summary-display nil)))
1900
1901 (defun mew-summary-jump-bottom ()
1902   "Go to the end of this Summary mode.
1903 If 'mew-summary-jump-bottom-then-display' is non-nil,
1904 the top message is then displayed."
1905   (interactive)
1906   (goto-char (point-max))
1907   (if (not (bobp)) (forward-line -1))
1908   (if mew-summary-jump-bottom-then-display
1909       (mew-summary-display nil)))
1910
1911 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1912 ;;;
1913 ;;; Searching
1914 ;;;
1915
1916 (defun mew-summary-isearch-forward ()
1917   "Incremental search forward in Message mode."
1918   (interactive)
1919   (let ((cwin (get-buffer-window (current-buffer)))
1920         (mwin (get-buffer-window (mew-buffer-message))))
1921     (if (not mwin)
1922         (message "No message is displayed.")
1923       (select-window mwin)
1924       (unwind-protect
1925           (isearch-forward)
1926         (select-window cwin)))))
1927
1928 (defun mew-summary-isearch-backward ()
1929   "Incremental search backward in Message mode."
1930   (interactive)
1931   (let ((cwin (get-buffer-window (current-buffer)))
1932         (mwin (get-buffer-window (mew-buffer-message))))
1933     (if (not mwin)
1934         (message "No message is displayed.")
1935       (select-window mwin)
1936       (unwind-protect
1937           (isearch-backward)
1938         (select-window cwin)))))
1939
1940 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1941 ;;;
1942 ;;; Pipe and Printing
1943 ;;;
1944
1945 (defun mew-summary-pipe-message (prefix command)
1946   "Send this message via pipe."
1947   (interactive
1948    (list current-prefix-arg
1949          (read-string "Shell command on message: " mew-last-shell-command)))
1950   (mew-summary-display 'force)
1951   (if (y-or-n-p "Send this message to pipe? ")
1952       (save-excursion
1953         (set-buffer (mew-buffer-message))
1954         (save-restriction
1955           (widen)
1956           (if (string= command "")
1957               (setq command mew-last-shell-command))
1958           (goto-char (point-min)) ; perhaps this line won't be necessary
1959           (if prefix
1960               (search-forward "\n\n"))
1961           (shell-command-on-region (point) (point-max) command nil)
1962           (setq mew-last-shell-command command)))))
1963
1964 (defun mew-summary-print ()
1965   "Print this message or this part."
1966   (interactive)
1967   (mew-summary-display 'force)
1968   (if (y-or-n-p "Print this message? ")
1969       (save-excursion
1970         (set-buffer (mew-buffer-message))
1971         (save-restriction
1972           (widen)
1973           (funcall mew-print-function)))))
1974
1975 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1976 ;;;
1977 ;;; Misc
1978 ;;;
1979
1980 (defun mew-summary-convert-local-cs (&optional arg)
1981   "Convert to character sets used locally. If executed with '\\[universal-argument]',
1982 coding-system is asked."
1983   (interactive "P")
1984   (mew-summary-msg-or-part
1985    (if mew-mule-p
1986        (save-excursion
1987          (set-buffer (mew-buffer-message))
1988          (let* ((code (and arg (read-coding-system "Coding-system: ")))
1989                 (win (get-buffer-window (current-buffer)))
1990                 (start (window-start win)))
1991            (widen)
1992            (if (mew-header-p)
1993                (progn
1994                  (goto-char (mew-header-end))
1995                  (forward-line))
1996              (goto-char (point-min)))
1997            (mew-elet
1998             (mew-cs-decode-region (point) (point-max)
1999                                   (or code mew-cs-rfc822-trans)))
2000            (set-window-start win start)
2001            (set-buffer-modified-p nil))))))
2002
2003 (defun mew-summary-x-face ()
2004   "Display xface."
2005   (interactive)
2006   (mew-summary-msg
2007    (save-excursion
2008      (let (xface)
2009        (set-buffer (mew-buffer-message))
2010        (if (null (setq xface (mew-header-get-value mew-x-face:)))
2011            ()
2012          (mew-set-buffer-tmp)
2013          (insert xface)
2014          (let ((filters mew-x-face-filter) file)
2015            (while filters
2016              ;; call-process-region is OK...
2017              (mew-plet
2018               (call-process-region (point-min) (point-max)
2019                                    (car filters)
2020                                    'delete t nil))
2021              (setq filters (cdr filters)))
2022            (setq file (mew-make-temp-name))
2023            ;; NEVER use call-process-region for privary reasons
2024            (mew-flet
2025             (write-region (point-min) (point-max) file nil 'no-msg))
2026            (mew-mime-start-process mew-x-face-prog mew-x-face-args file)))))))
2027
2028 (defun mew-flushable-p ()
2029   (and mew-queue-path
2030        (file-directory-p mew-queue-path)
2031        (directory-files mew-queue-path nil "^[0-9]+$" 'no-sort)))
2032
2033 (defun mew-summary-flush-queue ()
2034   "Flush the mail queue explicitly."
2035   (interactive)
2036   (if (not (mew-flushable-p))
2037       (message "Can't flush messages now")
2038     (if (or (not mew-ask-flush-queue) (y-or-n-p "Flush queue? "))
2039         (mew-im-call-process-no-output "Sending message" mew-prog-imput "-q"))))
2040
2041 (provide 'mew-summary)
2042
2043 ;;; Copyright Notice:
2044
2045 ;; Copyright (C) 1996, 1997, 1998, 1999 Mew developing team.
2046 ;; All rights reserved.
2047
2048 ;; Redistribution and use in source and binary forms, with or without
2049 ;; modification, are permitted provided that the following conditions
2050 ;; are met:
2051 ;;
2052 ;; 1. Redistributions of source code must retain the above copyright
2053 ;;    notice, this list of conditions and the following disclaimer.
2054 ;; 2. Redistributions in binary form must reproduce the above copyright
2055 ;;    notice, this list of conditions and the following disclaimer in the
2056 ;;    documentation and/or other materials provided with the distribution.
2057 ;; 3. Neither the name of the team nor the names of its contributors
2058 ;;    may be used to endorse or promote products derived from this software
2059 ;;    without specific prior written permission.
2060 ;;
2061 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
2062 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
2063 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
2064 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
2065 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
2066 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
2067 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
2068 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
2069 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
2070 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
2071 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2072
2073 ;;; mew-summary.el ends here