tm-view.el

   1 ;;;
   2 ;;; A MIME viewer for GNU Emacs
   3 ;;;
   4 ;;; by Morioka Tomohiko, 1994/07/13
   5 ;;;
   6
   7 (provide 'tm-view)
   8
   9
  10 ;;; @ require modules
  11 ;;;
  12
  13 (require 'tl-str)
  14 (require 'tl-list)
  15 (require 'tl-header)
  16 (require 'tiny-mime)
  17 (require 'tm-misc)
  18
  19
  20 ;;; @ version
  21 ;;;
  22
  23 (defconst mime-viewer/RCS-ID
  24   "$Id: tm-view.el,v 6.16 1995/04/19 04:43:09 morioka Exp $")
  25
  26 (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
  27 (defconst mime/viewer-version mime-viewer/version)
  28
  29
  30 ;;; @ constants
  31 ;;;
  32
  33 (defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
  34 (defconst mime/token-regexp
  35   (concat "[^" mime/tspecials "]*"))
  36 (defconst mime/content-type-subtype-regexp
  37   (concat mime/token-regexp "/" mime/token-regexp))
  38 (defconst mime/content-parameter-value-regexp
  39   (concat "\\("
  40           message/quoted-string-regexp
  41           "\\|[^; \t\n]*\\)"))
  42
  43 (defconst mime/output-buffer-name "*MIME-out*")
  44 (defconst mime/decoding-buffer-name "*MIME-decoding*")
  45
  46
  47 ;;; @ variables
  48 ;;;
  49
  50 (defvar mime/content-decoding-condition
  51 ;;(setq mime/content-decoding-condition
  52   '(((type . "text/plain")
  53      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
  54     ;;((type . "text/x-latex")
  55     ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
  56     ((type . "audio/basic")
  57      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
  58     ((type . "image/gif")
  59      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  60     ((type . "image/jpeg")
  61      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  62     ((type . "image/tiff")
  63      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  64     ((type . "image/x-tiff")
  65      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  66     ((type . "image/x-xbm")
  67      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  68     ((type . "image/x-pic")
  69      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  70     ((type . "video/mpeg")
  71      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
  72     ((type . "application/octet-stream")
  73      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
  74     ;;((type . "message/external-body")
  75     ;; (method "xterm" nil
  76     ;;         "-e" "showexternal"
  77     ;;         'file '"access-type" '"name" '"site" '"directory"))
  78     ((type . "message/partial")
  79      (method . mime/decode-message/partial-region))
  80     ((method "metamail" t
  81              "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
  82     ))
  83
  84 (defvar mime-viewer/content-filter-alist
  85   '(("text/plain" . mime-viewer/filter-text/plain)))
  86
  87 (defvar mime-viewer/content-subject-function
  88   (function
  89    (lambda (cnum subj ctype params)
  90      (insert
  91       (format "[%s %s (%s)]\n"
  92               (if (listp cnum)
  93                   (mapconcat (function
  94                               (lambda (num)
  95                                 (format "%s" (+ num 1))
  96                                 ))
  97                              cnum ".")
  98                 "0")
  99               subj ctype))
 100      )))
 101
 102 (defvar mime-viewer/content-header-filter-function
 103   (function mime-viewer/default-content-header-filter-function))
 104
 105 (defvar mime-viewer/childrens-header-showing-Content-Type-list
 106   '("message/rfc822"))
 107
 108 (defvar mime-viewer/ignored-field-list
 109   '("Received"))
 110
 111 (defun mime-viewer/default-content-header-filter-function (cnum cinfo)
 112   (if (and (listp cnum)
 113            (not (member
 114                  (mime::content-info/type
 115                   (mime::article/get-content-region (butlast cnum) cinfo)
 116                   )
 117                  mime-viewer/childrens-header-showing-Content-Type-list)
 118                 ))
 119       (delete-region (goto-char (point-min))
 120                      (or (and (re-search-forward "^$" nil t)
 121                               (match-end 0))
 122                          (point-max))
 123                      )
 124     (save-excursion
 125       (save-restriction
 126         (narrow-to-region (goto-char (point-min))
 127                           (or (and (re-search-forward "^$" nil t)
 128                                    (match-end 0))
 129                               (point-max))
 130                           )
 131         (mapcar (function
 132                  (lambda (field)
 133                    (goto-char (point-min))
 134                    (while (and (re-search-forward
 135                                 (concat "^" (regexp-quote field) ":")
 136                                 nil t)
 137                                (progn
 138                                  (delete-region
 139                                   (match-beginning 0)
 140                                   (and
 141                                    (re-search-forward
 142                                     (concat message/field-body-regexp "\n")
 143                                     nil t)
 144                                    (match-end 0)
 145                                    ))
 146                                  t))
 147                      )
 148                    )) mime-viewer/ignored-field-list)
 149         ))))
 150
 151 (defvar mime-viewer/default-showing-Content-Type-list
 152   '("text/plain" "text/richtext" "text/enriched"
 153     "text/x-latex" "application/x-latex"
 154     "application/octet-stream" nil))
 155
 156 (defvar mime-viewer/decoding-mode "play" "MIME body decoding mode")
 157
 158
 159 ;;; @@ quitting
 160 ;;;
 161
 162 (defun mime::viewer/quitting-method-for-gnus4 ()
 163   (mime-viewer/kill-buffer)
 164   (delete-other-windows)
 165   (gnus-article-show-summary)
 166   )
 167
 168 (defun mime::viewer/quitting-method-for-rmail ()
 169   (mime-viewer/kill-buffer)
 170   (rmail-summary)
 171   (delete-other-windows)
 172   )
 173
 174 (defun mime::viewer/quitting-method-for-mh-e ()
 175   (let ((win (get-buffer-window
 176               mime/output-buffer-name))
 177         (buf
 178          (mime::preview-content-info/buffer
 179           (car mime::preview/content-list)))
 180         )
 181     (if win
 182         (delete-window win)
 183       )
 184     (mime-viewer/kill-buffer)
 185     (pop-to-buffer
 186      (let ((name (buffer-name buf)))
 187        (string-match "show-" name)
 188        (substring name (match-end 0))
 189        ))
 190     ;; patch for mh-narrow.el
 191     ;; by YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
 192     (if (and (featurep 'mh-narrow)
 193              (fboundp 'mh-narrow-to-page))
 194         (save-excursion
 195           (set-buffer mh-show-buffer)
 196           (mh-narrow-to-page)))
 197     ;; end of patch
 198     ))
 199
 200 (defvar mime-viewer/quitting-method-alist
 201   '((gnus-article-mode . mime::viewer/quitting-method-for-gnus4)
 202     (rmail-mode        . mime::viewer/quitting-method-for-rmail)
 203     (mh-show-mode      . mime::viewer/quitting-method-for-mh-e)
 204     (mime/show-message-mode
 205      . (lambda ()
 206          (set-window-configuration
 207           mime/show-mode-old-window-configuration)
 208          (let ((mother mime/mother-buffer))
 209            (kill-buffer
 210             (mime::preview-content-info/buffer
 211              (car mime::preview/content-list)))
 212            (mime-viewer/kill-buffer)
 213            (pop-to-buffer mother)
 214            (goto-char (point-min))
 215            (mime-viewer/up-content)
 216            )))
 217     ))
 218
 219
 220 ;;; @ data structure
 221 ;;;
 222
 223 ;;; @@ content-info
 224 ;;;
 225
 226 (defun mime::make-content-info (beg end ctype params encoding children)
 227   (vector beg end ctype params encoding children)
 228   )
 229
 230 (defun mime::content-info/point-min (cinfo)
 231   (elt cinfo 0)
 232   )
 233
 234 (defun mime::content-info/point-max (cinfo)
 235   (elt cinfo 1)
 236   )
 237
 238 (defun mime::content-info/type (cinfo)
 239   (elt cinfo 2)
 240   )
 241
 242 (defun mime::content-info/parameters (cinfo)
 243   (elt cinfo 3)
 244   )
 245
 246 (defun mime::content-info/encoding (cinfo)
 247   (elt cinfo 4)
 248   )
 249
 250 (defun mime::content-info/children (cinfo)
 251   (elt cinfo 5)
 252   )
 253
 254 ;;; @@ preview-content-info
 255 ;;;
 256
 257 (defun mime::make-preview-content-info (beg end buf cinfo)
 258   (vector beg end buf cinfo)
 259   )
 260
 261 (defun mime::preview-content-info/point-min (pcinfo)
 262   (elt pcinfo 0)
 263   )
 264
 265 (defun mime::preview-content-info/point-max (pcinfo)
 266   (elt pcinfo 1)
 267   )
 268
 269 (defun mime::preview-content-info/buffer (pcinfo)
 270   (elt pcinfo 2)
 271   )
 272
 273 (defun mime::preview-content-info/content-info (pcinfo)
 274   (elt pcinfo 3)
 275   )
 276
 277
 278 ;;; @ buffer local variables
 279 ;;;
 280
 281 (defvar mime::article/content-info)
 282 (defvar mime::article/preview-buffer)
 283
 284 (defvar mime::preview/content-list nil)
 285 (defvar mime::preview/original-major-mode nil)
 286
 287
 288 ;;; @ parser
 289 ;;;
 290
 291 (defun mime-viewer/parse-message (&optional ctl encoding)
 292   (make-variable-buffer-local 'mime::article/content-info)
 293   (setq mime::article/content-info (mime-viewer/parse ctl encoding))
 294   (let ((ret (mime-viewer/make-preview-buffer)))
 295     (make-variable-buffer-local 'mime::article/preview-buffer)
 296     (setq mime::article/preview-buffer (car ret))
 297     ret))
 298
 299 (defun mime-viewer/parse (&optional ctl encoding)
 300   (save-excursion
 301     (save-restriction
 302       (if (null ctl)
 303           (setq ctl (progn
 304                       (goto-char (point-min))
 305                       (mime/Content-Type)
 306                       ))
 307         )
 308       (if (null encoding)
 309           (setq encoding (progn
 310                            (goto-char (point-min))
 311                            (mime/Content-Transfer-Encoding)
 312                            ))
 313         )
 314       (let ((ctype (car ctl))
 315             (params (cdr ctl))
 316             )
 317         (if (stringp ctype)
 318             (setq ctype (downcase ctype))
 319           )
 320         (if (stringp encoding)
 321             (setq encoding (downcase encoding))
 322           )
 323         (let ((boundary (assoc "boundary" params)))
 324           (search-forward "\n\n" nil t)
 325           (cond (boundary
 326                  (setq boundary
 327                        (message/strip-quoted-string (cdr boundary)))
 328                  (mime-viewer/parse-multipart
 329                   (match-end 0)
 330                   (progn
 331                     (search-forward (concat "--" boundary "--\n") nil t)
 332                     (match-beginning 0)
 333                     )
 334                   boundary ctype params encoding)
 335                  )
 336                 ((string= ctype "message/rfc822")
 337                  (mime::make-content-info
 338                   (point-min) (point-max)
 339                   ctype params encoding
 340                   (save-excursion
 341                     (save-restriction
 342                       (narrow-to-region (match-end 0) (point-max))
 343                       (list (mime-viewer/parse))
 344                       ))
 345                   )
 346                  )
 347                 (t
 348                  (mime::make-content-info (point-min) (point-max)
 349                                           ctype params encoding nil)
 350                  ))
 351           )))))
 352
 353 (defun mime-viewer/parse-multipart (beg end boundary ctype params encoding)
 354   (let ((sep (concat "^--" boundary "$"))
 355         cb ce ct ret ncb children)
 356     (save-excursion
 357       (save-restriction
 358         (narrow-to-region beg end)
 359         (goto-char (point-min))
 360         (search-forward (concat "--" boundary "\n") nil t)
 361         (setq cb (match-end 0))
 362         (while (re-search-forward sep nil t)
 363           (setq ce (match-beginning 0))
 364           (setq ncb (match-end 0))
 365           (save-excursion
 366             (save-restriction
 367               (narrow-to-region cb ce)
 368               (setq ret (mime-viewer/parse))
 369               ))
 370           (setq children (nconc children (list ret)))
 371           (goto-char (mime::content-info/point-max ret))
 372           (search-forward (concat "--" boundary "\n") nil t)
 373           (goto-char (setq cb (match-end 0)))
 374           )
 375         (setq ce (point-max))
 376         (save-excursion
 377           (save-restriction
 378             (narrow-to-region cb ce)
 379             (setq ret (mime-viewer/parse))
 380             ))
 381         (setq children (nconc children (list ret)))
 382         ))
 383     (setq beg (point-min))
 384     (goto-char beg)
 385     (mime::make-content-info beg end ctype params encoding children)
 386     ))
 387
 388 (defun mime::parse-parameter (str)
 389   (let ((ret (message::parse "\;" str)))
 390     (if ret
 391         (if (setq ret
 392                   (message::parse mime/token-regexp
 393                                   (message::parsed/rest ret)))
 394             (let ((parameter (downcase (message::parsed/matched ret))))
 395               (if (setq ret (message::parse "=" (message::parsed/rest ret)))
 396                   (if (setq ret
 397                             (message::parse
 398                              mime/content-parameter-value-regexp
 399                              (message::parsed/rest ret)))
 400                       (message::make-parsed
 401                        (cons parameter
 402                              (message/strip-quoted-string
 403                               (message::parsed/matched ret))
 404                              )
 405                        (message::parsed/rest ret)
 406                        )
 407                     )))))))
 408
 409 (defun mime::parse-field-body/Content-Type (str)
 410   (let ((ret (message::parse mime/content-type-subtype-regexp str)))
 411     (if ret
 412         (let ((ctype (downcase (message::parsed/matched ret)))
 413               dest)
 414           (while (progn
 415                    (setq str (message::parsed/rest ret))
 416                    (setq ret (mime::parse-parameter str))
 417                    )
 418             (setq dest (cons (message::parsed/matched ret) dest))
 419             )
 420           (if (string-match "^[ \t]*$" str)
 421               (cons ctype (reverse dest))
 422             )))))
 423
 424 (defun mime/Content-Type ()
 425   (let ((str (message/get-field-body "Content-Type")))
 426     (if str
 427         (mime::parse-field-body/Content-Type
 428          (message/unfolding-string str))
 429       )))
 430
 431 (defun mime/Content-Transfer-Encoding (&optional default-encoding)
 432   (save-excursion
 433     (save-restriction
 434       (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
 435                (re-search-forward mime/token-regexp nil t)
 436                )
 437           (downcase (buffer-substring (match-beginning 0) (match-end 0)))
 438         default-encoding)
 439       )))
 440
 441 (defun mime/get-subject (param)
 442   (save-excursion
 443     (save-restriction
 444       (let (ret)
 445         (or (and (setq ret (assoc "name" param))
 446                  (message/strip-quoted-string (cdr ret))
 447                  )
 448             (and (setq ret (assoc "x-name" param))
 449                  (message/strip-quoted-string (cdr ret))
 450                  )
 451             (progn
 452               (narrow-to-region (point-min)
 453                                 (or (and (search-forward "\n\n" nil t)
 454                                          (match-beginning 0)
 455                                          )
 456                                     (point-max)))
 457               (or
 458                (message/get-field-body "Content-Description")
 459                (message/get-field-body "Subject")
 460                ))
 461             ""))
 462       )))
 463
 464 (defun mime/get-name (param)
 465   (replace-as-filename (mime/get-subject param))
 466   )
 467
 468 (defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf)
 469   (let ((the-buf (current-buffer)) pcl dest)
 470     (setq buf
 471           (if (null buf)
 472               (current-buffer)
 473             (get-buffer buf)
 474             ))
 475     (if (null cinfo)
 476         (progn
 477           (switch-to-buffer buf)
 478           (setq cinfo mime::article/content-info)
 479           ))
 480     (if (null obuf)
 481         (setq obuf (concat "*Preview-" (buffer-name buf) "*"))
 482       )
 483     (setq pcl (mime::make-flat-content-list cinfo))
 484     (if (get-buffer obuf)
 485         (kill-buffer obuf)
 486       )
 487     (setq dest
 488           (mapcar
 489            (function
 490             (lambda (cell)
 491               (let ((beg (mime::content-info/point-min cell))
 492                     (end (mime::content-info/point-max cell))
 493                     (ctype (mime::content-info/type cell))
 494                     (params (mime::content-info/parameters cell))
 495                     cnum e nb ne subj str)
 496                 (setq cnum (mime::get-point-content-number beg cinfo))
 497                 (switch-to-buffer buf)
 498                 (setq e
 499                       (if (not
 500                            (member
 501                             ctype
 502                             mime-viewer/default-showing-Content-Type-list))
 503                           (save-excursion
 504                             (save-restriction
 505                               (goto-char beg)
 506                               (search-forward "\n\n" nil t)
 507                               (match-end 0)
 508                               ))
 509                         end))
 510                 (if (> e (point-max))
 511                     (setq e (point-max))
 512                   )
 513                 (setq str (buffer-substring beg e))
 514                 (switch-to-buffer obuf)
 515                 (setq nb (point))
 516                 (insert str)
 517                 (setq ne (point))
 518                 (prog1
 519                     (save-excursion
 520                       (save-restriction
 521                         (narrow-to-region nb ne)
 522                         (mime/decode-message-header)
 523                         (setq subj (mime/get-subject params))
 524                         (let ((f
 525                                (cdr
 526                                 (assoc ctype
 527                                        mime-viewer/content-filter-alist))))
 528                           (if (and f (fboundp f))
 529                               (funcall f ctype params)
 530                             ))
 531                         (funcall mime-viewer/content-header-filter-function
 532                                  cnum cinfo)
 533                         (goto-char nb)
 534                         (funcall mime-viewer/content-subject-function
 535                                  cnum subj ctype params)
 536                         (setq ne (point-max))
 537                         (mime::make-preview-content-info nb (- ne 1)
 538                                                          buf cell)
 539                         ))
 540                   (goto-char ne)
 541                   )
 542                 ))) pcl))
 543     (set-buffer-modified-p nil)
 544     (setq buffer-read-only t)
 545     (switch-to-buffer the-buf)
 546     (list obuf dest)
 547     ))
 548
 549
 550 ;;; @ content information
 551 ;;;
 552
 553 (defun mime::get-point-content-number (p &optional cinfo)
 554   (if (null cinfo)
 555       (setq cinfo mime::article/content-info)
 556     )
 557   (let ((b (mime::content-info/point-min cinfo))
 558         (e (mime::content-info/point-max cinfo))
 559         (c (mime::content-info/children cinfo))
 560         )
 561     (if (and (<= b p)(<= p e))
 562         (or (let (co ret (sn 0))
 563               (catch 'tag
 564                 (while c
 565                   (setq co (car c))
 566                   (setq ret (mime::get-point-content-number p co))
 567                   (cond ((eq ret t) (throw 'tag (list sn)))
 568                         (ret (throw 'tag (cons sn ret)))
 569                         )
 570                   (setq c (cdr c))
 571                   (setq sn (+ sn 1))
 572                   )))
 573             t))))
 574
 575 (defun mime::article/get-content-region (cn &optional cinfo)
 576   (if (null cinfo)
 577       (setq cinfo mime::article/content-info)
 578     )
 579   (if (eq cn t)
 580       cinfo
 581     (let ((sn (car cn)))
 582       (if (null sn)
 583           cinfo
 584         (let ((rc (nth sn (mime::content-info/children cinfo))))
 585           (if rc
 586               (mime::article/get-content-region (cdr cn) rc)
 587             ))
 588         ))))
 589
 590 (defun mime::make-flat-content-list (&optional cinfo)
 591   (if (null cinfo)
 592       (setq cinfo mime::article/content-info)
 593     )
 594   (let ((dest (list cinfo))
 595         (rcl (mime::content-info/children cinfo))
 596         )
 597     (while rcl
 598       (setq dest (nconc dest (mime::make-flat-content-list (car rcl))))
 599       (setq rcl (cdr rcl))
 600       )
 601     dest))
 602
 603 (defun mime::point-preview-content (p &optional pcl)
 604   (if (null pcl)
 605       (setq pcl mime::preview/content-list)
 606     )
 607   (catch 'tag
 608     (let ((r pcl) cell)
 609       (while r
 610         (setq cell (car r))
 611         (if (and (<= (mime::preview-content-info/point-min cell) p)
 612                  (<= p (mime::preview-content-info/point-max cell))
 613                  )
 614             (throw 'tag cell)
 615           )
 616         (setq r (cdr r))
 617         ))
 618     (car (last pcl))
 619     ))
 620
 621
 622 ;;; @ decoder
 623 ;;;
 624
 625 (defun mime/Quoted-Printable-decode-region (beg end)
 626   (interactive "*r")
 627   (save-excursion
 628     (save-restriction
 629       (narrow-to-region beg end)
 630       (goto-char (point-min))
 631       (while (re-search-forward "=\n" nil t)
 632         (replace-match "")
 633         )
 634       (goto-char (point-min))
 635       (let (b e str)
 636         (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
 637           (setq b (match-beginning 0))
 638           (setq e (match-end 0))
 639           (setq str (buffer-substring b e))
 640           (delete-region b e)
 641           (insert (mime/Quoted-Printable-decode-string str))
 642           ))
 643       )))
 644
 645 (defun mime/Base64-decode-region (beg end)
 646   (interactive "*r")
 647   (save-excursion
 648     (save-restriction
 649       (narrow-to-region beg end)
 650       (goto-char (point-min))
 651       (while (search-forward "\n" nil t)
 652         (replace-match "")
 653         )
 654       (let ((str (buffer-substring (point-min)(point-max))))
 655         (delete-region (point-min)(point-max))
 656         (insert (mime/base64-decode-string str))
 657         ))))
 658
 659 (defun mime/make-method-args (cal format)
 660   (mapcar (function
 661            (lambda (arg)
 662              (if (stringp arg)
 663                  arg
 664                (let ((ret (cdr (assoc (eval arg) cal))))
 665                  (if ret
 666                      ret
 667                    "")
 668                  ))
 669              ))
 670           format))
 671
 672 (defun mime/start-external-method-region (beg end cal)
 673   (save-excursion
 674     (save-restriction
 675       (narrow-to-region beg end)
 676       (goto-char beg)
 677       (let ((method (cdr (assoc 'method cal)))
 678             (name (mime/get-name cal))
 679             )
 680         (if method
 681             (let ((file (make-temp-name
 682                          (expand-file-name "TM" mime/tmp-dir)))
 683                   b args)
 684               (if (nth 1 method)
 685                   (setq b beg)
 686                 (search-forward "\n\n" nil t)
 687                 (setq b (match-end 0))
 688                 )
 689               (goto-char b)
 690               (write-region b end file)
 691               (setq cal (put-alist
 692                          'name (replace-as-filename name) cal))
 693               (setq cal (put-alist 'file file cal))
 694               (setq args (nconc
 695                           (list (car method)
 696                                 mime/output-buffer-name (car method)
 697                                 )
 698                           (mime/make-method-args cal (cdr (cdr method)))
 699                           ))
 700               (apply (function start-process) args)
 701               (mime/show-output-buffer)
 702               ))
 703         ))))
 704
 705 (defun mime/decode-message/partial-region (beg end cal)
 706   (goto-char beg)
 707   (let* ((root-dir (expand-file-name
 708                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 709          (id (cdr (assoc "id" cal)))
 710          (number (cdr (assoc "number" cal)))
 711          (total (cdr (assoc "total" cal)))
 712          (the-buf (current-buffer))
 713          file
 714          (mother mime::article/preview-buffer))
 715     (if (not (file-exists-p root-dir))
 716         (make-directory root-dir)
 717       )
 718     (setq id (replace-as-filename id))
 719     (setq root-dir (concat root-dir "/" id))
 720     (if (not (file-exists-p root-dir))
 721         (make-directory root-dir)
 722       )
 723     (setq file (concat root-dir "/FULL"))
 724     (if (not (file-exists-p file))
 725         (progn
 726           (re-search-forward "^$")
 727           (goto-char (+ (match-end 0) 1))
 728           (setq file (concat root-dir "/" number))
 729           (write-region (point) (point-max) file)
 730           (if (get-buffer "*MIME-temp*")
 731               (kill-buffer "*MIME-temp*")
 732             )
 733           (switch-to-buffer "*MIME-temp*")
 734           (let ((i 1)
 735                 (max (string-to-int total))
 736                 )
 737             (catch 'tag
 738               (while (<= i max)
 739                 (setq file (concat root-dir "/" (int-to-string i)))
 740                 (if (not (file-exists-p file))
 741                     (progn
 742                       (switch-to-buffer the-buf)
 743                       (throw 'tag nil)
 744                       ))
 745                 (insert-file-contents file)
 746                 (goto-char (point-max))
 747                 (setq i (+ i 1))
 748                 )
 749               (delete-other-windows)
 750               (write-file (concat root-dir "/FULL"))
 751               (setq major-mode 'mime/show-message-mode)
 752               (mime/viewer-mode mother)
 753               (pop-to-buffer (current-buffer))
 754               ))
 755           )
 756       (progn
 757         (delete-other-windows)
 758         (find-file file)
 759         (setq major-mode 'mime/show-message-mode)
 760         (mime/viewer-mode mother)
 761         (pop-to-buffer (current-buffer))
 762         ))
 763     ))
 764
 765 (defun mime/get-content-decoding-alist (al)
 766   (get-unified-alist mime/content-decoding-condition al)
 767   )
 768
 769 (defun mime::article/decode-content-region (cinfo)
 770   (interactive "*r")
 771   (let ((beg (mime::content-info/point-min cinfo))
 772         (end (mime::content-info/point-max cinfo))
 773         (ctype (mime::content-info/type cinfo))
 774         (params (mime::content-info/parameters cinfo))
 775         (encoding (mime::content-info/encoding cinfo))
 776         )
 777     (if ctype
 778         (let (method cal ret)
 779           (setq cal (append (list (cons 'type ctype)
 780                                   (cons 'encoding encoding)
 781                                   (cons 'major-mode major-mode)
 782                                   )
 783                             params))
 784           (if mime-viewer/decoding-mode
 785               (setq cal (cons
 786                          (cons 'mode mime-viewer/decoding-mode)
 787                          cal))
 788             )
 789           (setq ret (mime/get-content-decoding-alist cal))
 790           (setq method (cdr (assoc 'method ret)))
 791           (cond ((and (symbolp method)
 792                       (fboundp method))
 793                  (funcall method beg end ret)
 794                  )
 795                 ((and (listp method)(stringp (car method)))
 796                  (mime/start-external-method-region beg end ret)
 797                  )
 798                 (t (mime/show-output-buffer
 799                     "No method are specified for %s\n" ctype)
 800                    ))
 801           ))
 802     ))
 803
 804 (defun mime/show-output-buffer (&rest forms)
 805   (let ((the-buf (current-buffer)))
 806     (if (null (get-buffer-window mime/output-buffer-name))
 807         (split-window-vertically (/ (* (window-height) 3) 4))
 808       )
 809     (pop-to-buffer mime/output-buffer-name)
 810     (goto-char (point-max))
 811     (if forms
 812         (insert (apply (function format) forms))
 813       )
 814     (pop-to-buffer the-buf)
 815     ))
 816
 817
 818 ;;; @ content filter
 819 ;;;
 820
 821 (defun mime-viewer/filter-text/plain (ctype params)
 822   (save-excursion
 823     (save-restriction
 824       (let ((charset (cdr (assoc "charset" params)))
 825             (encoding
 826              (save-excursion
 827                (save-restriction
 828                  (goto-char (point-min))
 829                  (narrow-to-region (point-min)
 830                                    (or (and (search-forward "\n\n" nil t)
 831                                             (match-beginning 0))
 832                                        (point-max)))
 833                  (goto-char (point-min))
 834                  (mime/Content-Transfer-Encoding "7bit")
 835                  )))
 836             (beg (point-min)) (end (point-max))
 837             )
 838         (goto-char (point-min))
 839         (if (search-forward "\n\n" nil t)
 840             (setq beg (match-end 0))
 841           )
 842         (if (cond ((string= encoding "quoted-printable")
 843                    (mime/Quoted-Printable-decode-region beg end)
 844                    t)
 845                   ((string= encoding "base64")
 846                    (mime/Base64-decode-region beg end)
 847                    t))
 848             (mime/code-convert-region-to-emacs beg (point-max) charset)
 849           )
 850         ))))
 851
 852
 853 ;;; @ MIME viewer mode
 854 ;;;
 855
 856 (defvar mime/viewer-mode-map nil)
 857 (if (null mime/viewer-mode-map)
 858     (progn
 859       (setq mime/viewer-mode-map (make-keymap))
 860       (suppress-keymap mime/viewer-mode-map)
 861       (define-key mime/viewer-mode-map
 862         "u"        (function mime-viewer/up-content))
 863       (define-key mime/viewer-mode-map
 864         "p"        (function mime-viewer/previous-content))
 865       (define-key mime/viewer-mode-map
 866         "n"        (function mime-viewer/next-content))
 867       (define-key mime/viewer-mode-map
 868         " "        (function mime-viewer/scroll-up-content))
 869       (define-key mime/viewer-mode-map
 870         "\M- "     (function mime-viewer/scroll-down-content))
 871       (define-key mime/viewer-mode-map
 872         "\177"     (function mime-viewer/scroll-down-content))
 873       (define-key mime/viewer-mode-map
 874         "\C-m"     (function mime-viewer/next-line-content))
 875       (define-key mime/viewer-mode-map
 876         "\C-\M-m"  (function mime-viewer/previous-line-content))
 877       (define-key mime/viewer-mode-map
 878         "v"        (function mime-viewer/play-content))
 879       (define-key mime/viewer-mode-map
 880         "e"        (function mime-viewer/extract-content))
 881       (define-key mime/viewer-mode-map
 882         "\C-c\C-p" (function mime-viewer/print-content))
 883       (define-key mime/viewer-mode-map
 884         "q"        (function mime-viewer/quit))
 885       (define-key mime/viewer-mode-map
 886         "\C-c\C-x" (function mime-viewer/kill-buffer))
 887       ))
 888
 889 (defun mime/viewer-mode (&optional mother ctl encoding)
 890   "Major mode for viewing MIME message.
 891
 892 u       Move to upper content
 893 p       Move to previous content
 894 n       Move to next content
 895 SPC     Scroll up
 896 M-SPC   Scroll down
 897 DEL     Scroll down
 898 RET     Move to next line
 899 M-RET   Move to previous line
 900 v       Decode the content as `play mode'
 901 e       Decode the content as `extract mode'
 902 C-c C-p Decode the content as `print mode'
 903 q       Quit
 904 "
 905   (interactive)
 906   (let ((buf (get-buffer mime/output-buffer-name))
 907         (the-buf (current-buffer))
 908         )
 909     (if buf
 910         (progn
 911           (switch-to-buffer buf)
 912           (erase-buffer)
 913           (switch-to-buffer the-buf)
 914           )))
 915   (let ((ret (mime-viewer/parse-message ctl encoding))
 916         (mode major-mode))
 917     (switch-to-buffer (car ret))
 918     (setq major-mode 'mime/viewer-mode)
 919     (setq mode-name "MIME-View")
 920     (make-variable-buffer-local 'mime::preview/original-major-mode)
 921     (setq mime::preview/original-major-mode
 922           (if mother
 923               (progn
 924                 (make-variable-buffer-local
 925                  'mime/show-mode-old-window-configuration)
 926                 (setq mime/show-mode-old-window-configuration
 927                       (current-window-configuration))
 928                 (make-variable-buffer-local 'mime/mother-buffer)
 929                 (setq mime/mother-buffer mother)
 930                 'mime/show-message-mode)
 931             mode))
 932     (use-local-map mime/viewer-mode-map)
 933     (make-variable-buffer-local 'mime::preview/content-list)
 934     (setq mime::preview/content-list (nth 1 ret))
 935     (goto-char
 936      (let ((ce (mime::preview-content-info/point-max
 937                 (car mime::preview/content-list)
 938                 ))
 939            e)
 940        (goto-char (point-min))
 941        (search-forward "\n\n" nil t)
 942        (setq e (match-end 0))
 943        (if (<= e ce)
 944            e
 945          ce)))
 946     (run-hooks 'mime/viewer-mode-hook)
 947     ))
 948
 949 (defun mime::preview/decode-content ()
 950   (interactive)
 951   (let ((pc (mime::point-preview-content (point))))
 952     (if pc
 953         (let ((the-buf (current-buffer)))
 954           (switch-to-buffer (mime::preview-content-info/buffer pc))
 955           (mime::article/decode-content-region
 956            (mime::preview-content-info/content-info pc))
 957           (if (eq (current-buffer)
 958                   (mime::preview-content-info/buffer pc))
 959               (switch-to-buffer the-buf)
 960             )
 961           ))))
 962
 963 (defun mime-viewer/play-content ()
 964   (interactive)
 965   (let ((mime-viewer/decoding-mode "play"))
 966     (mime::preview/decode-content)
 967     ))
 968
 969 (defun mime-viewer/extract-content ()
 970   (interactive)
 971   (let ((mime-viewer/decoding-mode "extract"))
 972     (mime::preview/decode-content)
 973     ))
 974
 975 (defun mime-viewer/print-content ()
 976   (interactive)
 977   (let ((mime-viewer/decoding-mode "print"))
 978     (mime::preview/decode-content)
 979     ))
 980
 981 (defun mime-viewer/up-content ()
 982   (interactive)
 983   (let ((pc (mime::point-preview-content (point))) cinfo
 984         (the-buf (current-buffer))
 985         cn r)
 986     (switch-to-buffer (mime::preview-content-info/buffer pc))
 987     (setq cinfo (mime::preview-content-info/content-info pc))
 988     (setq cn (mime::get-point-content-number
 989               (mime::content-info/point-min cinfo)))
 990     (if (eq cn t)
 991         (mime-viewer/quit the-buf
 992                           (mime::preview-content-info/buffer pc)
 993                           )
 994       (setq r (mime::article/get-content-region (butlast cn)))
 995       (switch-to-buffer the-buf)
 996       (catch 'tag
 997         (let ((rpcl mime::preview/content-list) cell)
 998           (while rpcl
 999             (setq cell (car rpcl))
1000             (if (eq r (mime::preview-content-info/content-info cell))
1001                 (progn
1002                   (goto-char (mime::preview-content-info/point-min cell))
1003                   (throw 'tag nil)
1004                   ))
1005             (setq rpcl (cdr rpcl))
1006             )))
1007       )))
1008
1009 (defun mime-viewer/previous-content ()
1010   (interactive)
1011   (let* ((pcl mime::preview/content-list)
1012          (p (point))
1013          (i (- (length pcl) 1))
1014          beg)
1015     (catch 'tag
1016       (while (>= i 0)
1017         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
1018         (if (> p beg)
1019             (throw 'tag (goto-char beg))
1020           )
1021         (setq i (- i 1))
1022         ))
1023     ))
1024
1025 (defun mime-viewer/next-content ()
1026   (interactive)
1027   (let ((pcl mime::preview/content-list)
1028         (p (point))
1029         beg)
1030     (catch 'tag
1031       (while pcl
1032         (setq beg (mime::preview-content-info/point-min (car pcl)))
1033         (if (< p beg)
1034             (throw 'tag (goto-char beg))
1035           )
1036         (setq pcl (cdr pcl))
1037         ))
1038     ))
1039
1040 (defun mime-viewer/scroll-up-content (&optional h)
1041   (interactive)
1042   (if (null h)
1043       (setq h (- (window-height) 1))
1044     )
1045   (let ((pcl mime::preview/content-list)
1046         (p (point))
1047         np beg)
1048     (setq np
1049           (or (catch 'tag
1050                 (while pcl
1051                   (setq beg (mime::preview-content-info/point-min (car pcl)))
1052                   (if (< p beg)
1053                       (throw 'tag beg)
1054                     )
1055                   (setq pcl (cdr pcl))
1056                   ))
1057               (point-max)))
1058     (forward-line h)
1059     (if (> (point) np)
1060         (goto-char np)
1061       )))
1062
1063 (defun mime-viewer/scroll-down-content (&optional h)
1064   (interactive)
1065   (if (null h)
1066       (setq h (- (window-height) 1))
1067     )
1068   (let ((pcl mime::preview/content-list)
1069         (p (point))
1070         pp beg)
1071     (setq pp
1072           (or (let ((i (- (length pcl) 1)))
1073                 (catch 'tag
1074                   (while (> i 0)
1075                     (setq beg (mime::preview-content-info/point-min
1076                                (nth i pcl)))
1077                     (if (> p beg)
1078                         (throw 'tag beg)
1079                       )
1080                     (setq i (- i 1))
1081                     )))
1082               (point-min)))
1083     (forward-line (- h))
1084     (if (< (point) pp)
1085         (goto-char pp)
1086       )))
1087
1088 (defun mime-viewer/next-line-content ()
1089   (interactive)
1090   (mime-viewer/scroll-up-content 1)
1091   )
1092
1093 (defun mime-viewer/previous-line-content ()
1094   (interactive)
1095   (mime-viewer/scroll-down-content 1)
1096   )
1097
1098 (defun mime-viewer/quit (&optional the-buf buf)
1099   (interactive)
1100   (if (null the-buf)
1101       (setq the-buf (current-buffer))
1102     )
1103   (if (null buf)
1104       (setq buf (mime::preview-content-info/buffer
1105                  (mime::point-preview-content (point))))
1106     )
1107   (let ((r (progn
1108              (switch-to-buffer buf)
1109              (assoc major-mode mime-viewer/quitting-method-alist)
1110              )))
1111     (if r
1112         (progn
1113           (switch-to-buffer the-buf)
1114           (funcall (cdr r))
1115           ))
1116     ))
1117
1118 (defun mime-viewer/kill-buffer ()
1119   (interactive)
1120   (kill-buffer (current-buffer))
1121   )
1122
1123 (fset 'mime/view-mode 'mime/viewer-mode)
1124
1125 (run-hooks 'tm-view-load-hook)