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