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.15 1995/04/18 16:48:08 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/Content-Type ()
 389   (save-excursion
 390     (save-restriction
 391       (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
 392                  (progn
 393                    (narrow-to-region
 394                     (point)
 395                     (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
 396                          (match-end 0))
 397                     )
 398                    (goto-char (point-min))
 399                    (re-search-forward mime/content-type-subtype-regexp nil t)
 400                    ))
 401             (let ((ctype
 402                    (downcase
 403                     (buffer-substring (match-beginning 0) (match-end 0))
 404                     ))
 405                   dest attribute value)
 406               (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
 407                           (re-search-forward mime/token-regexp nil t)
 408                           )
 409                 (setq attribute
 410                       (downcase
 411                        (buffer-substring (match-beginning 0) (match-end 0))
 412                        ))
 413                 (if (and (re-search-forward "=[ \t\n]*" nil t)
 414                          (re-search-forward mime/content-parameter-value-regexp
 415                                             nil t)
 416                          )
 417                     (setq dest
 418                           (put-alist attribute
 419                                      (message/strip-quoted-string
 420                                       (buffer-substring (match-beginning 0)
 421                                                         (match-end 0)))
 422                                      dest))
 423                   )
 424                 )
 425               (cons ctype dest)
 426               )))))
 427
 428 (defun mime/Content-Transfer-Encoding (&optional default-encoding)
 429   (save-excursion
 430     (save-restriction
 431       (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
 432                (re-search-forward mime/token-regexp nil t)
 433                )
 434           (downcase (buffer-substring (match-beginning 0) (match-end 0)))
 435         default-encoding)
 436       )))
 437
 438 (defun mime/get-subject (param)
 439   (save-excursion
 440     (save-restriction
 441       (let (ret)
 442         (or (and (setq ret (assoc "name" param))
 443                  (message/strip-quoted-string (cdr ret))
 444                  )
 445             (and (setq ret (assoc "x-name" param))
 446                  (message/strip-quoted-string (cdr ret))
 447                  )
 448             (progn
 449               (narrow-to-region (point-min)
 450                                 (or (and (search-forward "\n\n" nil t)
 451                                          (match-beginning 0)
 452                                          )
 453                                     (point-max)))
 454               (or
 455                (message/get-field-body "Content-Description")
 456                (message/get-field-body "Subject")
 457                ))
 458             ""))
 459       )))
 460
 461 (defun mime/get-name (param)
 462   (replace-as-filename (mime/get-subject param))
 463   )
 464
 465 (defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf)
 466   (let ((the-buf (current-buffer)) pcl dest)
 467     (setq buf
 468           (if (null buf)
 469               (current-buffer)
 470             (get-buffer buf)
 471             ))
 472     (if (null cinfo)
 473         (progn
 474           (switch-to-buffer buf)
 475           (setq cinfo mime::article/content-info)
 476           ))
 477     (if (null obuf)
 478         (setq obuf (concat "*Preview-" (buffer-name buf) "*"))
 479       )
 480     (setq pcl (mime::make-flat-content-list cinfo))
 481     (if (get-buffer obuf)
 482         (kill-buffer obuf)
 483       )
 484     (setq dest
 485           (mapcar
 486            (function
 487             (lambda (cell)
 488               (let ((beg (mime::content-info/point-min cell))
 489                     (end (mime::content-info/point-max cell))
 490                     (ctype (mime::content-info/type cell))
 491                     (params (mime::content-info/parameters cell))
 492                     cnum e nb ne subj str)
 493                 (setq cnum (mime::get-point-content-number beg cinfo))
 494                 (switch-to-buffer buf)
 495                 (setq e
 496                       (if (not
 497                            (member
 498                             ctype
 499                             mime-viewer/default-showing-Content-Type-list))
 500                           (save-excursion
 501                             (save-restriction
 502                               (goto-char beg)
 503                               (search-forward "\n\n" nil t)
 504                               (match-end 0)
 505                               ))
 506                         end))
 507                 (if (> e (point-max))
 508                     (setq e (point-max))
 509                   )
 510                 (setq str (buffer-substring beg e))
 511                 (switch-to-buffer obuf)
 512                 (setq nb (point))
 513                 (insert str)
 514                 (setq ne (point))
 515                 (prog1
 516                     (save-excursion
 517                       (save-restriction
 518                         (narrow-to-region nb ne)
 519                         (mime/decode-message-header)
 520                         (setq subj (mime/get-subject params))
 521                         (let ((f
 522                                (cdr
 523                                 (assoc ctype
 524                                        mime-viewer/content-filter-alist))))
 525                           (if (and f (fboundp f))
 526                               (funcall f ctype params)
 527                             ))
 528                         (funcall mime-viewer/content-header-filter-function
 529                                  cnum cinfo)
 530                         (goto-char nb)
 531                         (funcall mime-viewer/content-subject-function
 532                                  cnum subj ctype params)
 533                         (setq ne (point-max))
 534                         (mime::make-preview-content-info nb (- ne 1)
 535                                                          buf cell)
 536                         ))
 537                   (goto-char ne)
 538                   )
 539                 ))) pcl))
 540     (set-buffer-modified-p nil)
 541     (setq buffer-read-only t)
 542     (switch-to-buffer the-buf)
 543     (list obuf dest)
 544     ))
 545
 546
 547 ;;; @ content information
 548 ;;;
 549
 550 (defun mime::get-point-content-number (p &optional cinfo)
 551   (if (null cinfo)
 552       (setq cinfo mime::article/content-info)
 553     )
 554   (let ((b (mime::content-info/point-min cinfo))
 555         (e (mime::content-info/point-max cinfo))
 556         (c (mime::content-info/children cinfo))
 557         )
 558     (if (and (<= b p)(<= p e))
 559         (or (let (co ret (sn 0))
 560               (catch 'tag
 561                 (while c
 562                   (setq co (car c))
 563                   (setq ret (mime::get-point-content-number p co))
 564                   (cond ((eq ret t) (throw 'tag (list sn)))
 565                         (ret (throw 'tag (cons sn ret)))
 566                         )
 567                   (setq c (cdr c))
 568                   (setq sn (+ sn 1))
 569                   )))
 570             t))))
 571
 572 (defun mime::article/get-content-region (cn &optional cinfo)
 573   (if (null cinfo)
 574       (setq cinfo mime::article/content-info)
 575     )
 576   (if (eq cn t)
 577       cinfo
 578     (let ((sn (car cn)))
 579       (if (null sn)
 580           cinfo
 581         (let ((rc (nth sn (mime::content-info/children cinfo))))
 582           (if rc
 583               (mime::article/get-content-region (cdr cn) rc)
 584             ))
 585         ))))
 586
 587 (defun mime::make-flat-content-list (&optional cinfo)
 588   (if (null cinfo)
 589       (setq cinfo mime::article/content-info)
 590     )
 591   (let ((dest (list cinfo))
 592         (rcl (mime::content-info/children cinfo))
 593         )
 594     (while rcl
 595       (setq dest (nconc dest (mime::make-flat-content-list (car rcl))))
 596       (setq rcl (cdr rcl))
 597       )
 598     dest))
 599
 600 (defun mime::point-preview-content (p &optional pcl)
 601   (if (null pcl)
 602       (setq pcl mime::preview/content-list)
 603     )
 604   (catch 'tag
 605     (let ((r pcl) cell)
 606       (while r
 607         (setq cell (car r))
 608         (if (and (<= (mime::preview-content-info/point-min cell) p)
 609                  (<= p (mime::preview-content-info/point-max cell))
 610                  )
 611             (throw 'tag cell)
 612           )
 613         (setq r (cdr r))
 614         ))
 615     (car (last pcl))
 616     ))
 617
 618
 619 ;;; @ decoder
 620 ;;;
 621
 622 (defun mime/Quoted-Printable-decode-region (beg end)
 623   (interactive "*r")
 624   (save-excursion
 625     (save-restriction
 626       (narrow-to-region beg end)
 627       (goto-char (point-min))
 628       (while (re-search-forward "=\n" nil t)
 629         (replace-match "")
 630         )
 631       (goto-char (point-min))
 632       (let (b e str)
 633         (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
 634           (setq b (match-beginning 0))
 635           (setq e (match-end 0))
 636           (setq str (buffer-substring b e))
 637           (delete-region b e)
 638           (insert (mime/Quoted-Printable-decode-string str))
 639           ))
 640       )))
 641
 642 (defun mime/Base64-decode-region (beg end)
 643   (interactive "*r")
 644   (save-excursion
 645     (save-restriction
 646       (narrow-to-region beg end)
 647       (goto-char (point-min))
 648       (while (search-forward "\n" nil t)
 649         (replace-match "")
 650         )
 651       (let ((str (buffer-substring (point-min)(point-max))))
 652         (delete-region (point-min)(point-max))
 653         (insert (mime/base64-decode-string str))
 654         ))))
 655
 656 (defun mime/make-method-args (cal format)
 657   (mapcar (function
 658            (lambda (arg)
 659              (if (stringp arg)
 660                  arg
 661                (let ((ret (cdr (assoc (eval arg) cal))))
 662                  (if ret
 663                      ret
 664                    "")
 665                  ))
 666              ))
 667           format))
 668
 669 (defun mime/start-external-method-region (beg end cal)
 670   (save-excursion
 671     (save-restriction
 672       (narrow-to-region beg end)
 673       (goto-char beg)
 674       (let ((method (cdr (assoc 'method cal)))
 675             (name (mime/get-name cal))
 676             )
 677         (if method
 678             (let ((file (make-temp-name
 679                          (expand-file-name "TM" mime/tmp-dir)))
 680                   b args)
 681               (if (nth 1 method)
 682                   (setq b beg)
 683                 (search-forward "\n\n" nil t)
 684                 (setq b (match-end 0))
 685                 )
 686               (goto-char b)
 687               (write-region b end file)
 688               (setq cal (put-alist
 689                          'name (replace-as-filename name) cal))
 690               (setq cal (put-alist 'file file cal))
 691               (setq args (nconc
 692                           (list (car method)
 693                                 mime/output-buffer-name (car method)
 694                                 )
 695                           (mime/make-method-args cal (cdr (cdr method)))
 696                           ))
 697               (apply (function start-process) args)
 698               (mime/show-output-buffer)
 699               ))
 700         ))))
 701
 702 (defun mime/decode-message/partial-region (beg end cal)
 703   (goto-char beg)
 704   (let* ((root-dir (expand-file-name
 705                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 706          (id (cdr (assoc "id" cal)))
 707          (number (cdr (assoc "number" cal)))
 708          (total (cdr (assoc "total" cal)))
 709          (the-buf (current-buffer))
 710          file
 711          (mother mime::article/preview-buffer))
 712     (if (not (file-exists-p root-dir))
 713         (make-directory root-dir)
 714       )
 715     (setq id (replace-as-filename id))
 716     (setq root-dir (concat root-dir "/" id))
 717     (if (not (file-exists-p root-dir))
 718         (make-directory root-dir)
 719       )
 720     (setq file (concat root-dir "/FULL"))
 721     (if (not (file-exists-p file))
 722         (progn
 723           (re-search-forward "^$")
 724           (goto-char (+ (match-end 0) 1))
 725           (setq file (concat root-dir "/" number))
 726           (write-region (point) (point-max) file)
 727           (if (get-buffer "*MIME-temp*")
 728               (kill-buffer "*MIME-temp*")
 729             )
 730           (switch-to-buffer "*MIME-temp*")
 731           (let ((i 1)
 732                 (max (string-to-int total))
 733                 )
 734             (catch 'tag
 735               (while (<= i max)
 736                 (setq file (concat root-dir "/" (int-to-string i)))
 737                 (if (not (file-exists-p file))
 738                     (progn
 739                       (switch-to-buffer the-buf)
 740                       (throw 'tag nil)
 741                       ))
 742                 (insert-file-contents file)
 743                 (goto-char (point-max))
 744                 (setq i (+ i 1))
 745                 )
 746               (delete-other-windows)
 747               (write-file (concat root-dir "/FULL"))
 748               (setq major-mode 'mime/show-message-mode)
 749               (mime/viewer-mode mother)
 750               (pop-to-buffer (current-buffer))
 751               ))
 752           )
 753       (progn
 754         (delete-other-windows)
 755         (find-file file)
 756         (setq major-mode 'mime/show-message-mode)
 757         (mime/viewer-mode mother)
 758         (pop-to-buffer (current-buffer))
 759         ))
 760     ))
 761
 762 (defun mime/get-content-decoding-alist (al)
 763   (get-unified-alist mime/content-decoding-condition al)
 764   )
 765
 766 (defun mime::article/decode-content-region (cinfo)
 767   (interactive "*r")
 768   (let ((beg (mime::content-info/point-min cinfo))
 769         (end (mime::content-info/point-max cinfo))
 770         (ctype (mime::content-info/type cinfo))
 771         (params (mime::content-info/parameters cinfo))
 772         (encoding (mime::content-info/encoding cinfo))
 773         )
 774     (if ctype
 775         (let (method cal ret)
 776           (setq cal (append (list (cons 'type ctype)
 777                                   (cons 'encoding encoding)
 778                                   (cons 'major-mode major-mode)
 779                                   )
 780                             params))
 781           (if mime-viewer/decoding-mode
 782               (setq cal (cons
 783                          (cons 'mode mime-viewer/decoding-mode)
 784                          cal))
 785             )
 786           (setq ret (mime/get-content-decoding-alist cal))
 787           (setq method (cdr (assoc 'method ret)))
 788           (cond ((and (symbolp method)
 789                       (fboundp method))
 790                  (funcall method beg end ret)
 791                  )
 792                 ((and (listp method)(stringp (car method)))
 793                  (mime/start-external-method-region beg end ret)
 794                  )
 795                 (t (mime/show-output-buffer
 796                     "No method are specified for %s\n" ctype)
 797                    ))
 798           ))
 799     ))
 800
 801 (defun mime/show-output-buffer (&rest forms)
 802   (let ((the-buf (current-buffer)))
 803     (if (null (get-buffer-window mime/output-buffer-name))
 804         (split-window-vertically (/ (* (window-height) 3) 4))
 805       )
 806     (pop-to-buffer mime/output-buffer-name)
 807     (goto-char (point-max))
 808     (if forms
 809         (insert (apply (function format) forms))
 810       )
 811     (pop-to-buffer the-buf)
 812     ))
 813
 814
 815 ;;; @ content filter
 816 ;;;
 817
 818 (defun mime-viewer/filter-text/plain (ctype params)
 819   (save-excursion
 820     (save-restriction
 821       (let ((charset (cdr (assoc "charset" params)))
 822             (encoding
 823              (save-excursion
 824                (save-restriction
 825                  (goto-char (point-min))
 826                  (narrow-to-region (point-min)
 827                                    (or (and (search-forward "\n\n" nil t)
 828                                             (match-beginning 0))
 829                                        (point-max)))
 830                  (goto-char (point-min))
 831                  (mime/Content-Transfer-Encoding "7bit")
 832                  )))
 833             (beg (point-min)) (end (point-max))
 834             )
 835         (goto-char (point-min))
 836         (if (search-forward "\n\n" nil t)
 837             (setq beg (match-end 0))
 838           )
 839         (if (cond ((string= encoding "quoted-printable")
 840                    (mime/Quoted-Printable-decode-region beg end)
 841                    t)
 842                   ((string= encoding "base64")
 843                    (mime/Base64-decode-region beg end)
 844                    t))
 845             (mime/code-convert-region-to-emacs beg (point-max) charset)
 846           )
 847         ))))
 848
 849
 850 ;;; @ MIME viewer mode
 851 ;;;
 852
 853 (defvar mime/viewer-mode-map nil)
 854 (if (null mime/viewer-mode-map)
 855     (progn
 856       (setq mime/viewer-mode-map (make-keymap))
 857       (suppress-keymap mime/viewer-mode-map)
 858       (define-key mime/viewer-mode-map
 859         "u"        (function mime-viewer/up-content))
 860       (define-key mime/viewer-mode-map
 861         "p"        (function mime-viewer/previous-content))
 862       (define-key mime/viewer-mode-map
 863         "n"        (function mime-viewer/next-content))
 864       (define-key mime/viewer-mode-map
 865         " "        (function mime-viewer/scroll-up-content))
 866       (define-key mime/viewer-mode-map
 867         "\M- "     (function mime-viewer/scroll-down-content))
 868       (define-key mime/viewer-mode-map
 869         "\177"     (function mime-viewer/scroll-down-content))
 870       (define-key mime/viewer-mode-map
 871         "\C-m"     (function mime-viewer/next-line-content))
 872       (define-key mime/viewer-mode-map
 873         "\C-\M-m"  (function mime-viewer/previous-line-content))
 874       (define-key mime/viewer-mode-map
 875         "v"        (function mime-viewer/play-content))
 876       (define-key mime/viewer-mode-map
 877         "e"        (function mime-viewer/extract-content))
 878       (define-key mime/viewer-mode-map
 879         "\C-c\C-p" (function mime-viewer/print-content))
 880       (define-key mime/viewer-mode-map
 881         "q"        (function mime-viewer/quit))
 882       (define-key mime/viewer-mode-map
 883         "\C-c\C-x" (function mime-viewer/kill-buffer))
 884       ))
 885
 886 (defun mime/viewer-mode (&optional mother ctl encoding)
 887   "Major mode for viewing MIME message.
 888
 889 u       Move to upper content
 890 p       Move to previous content
 891 n       Move to next content
 892 SPC     Scroll up
 893 M-SPC   Scroll down
 894 DEL     Scroll down
 895 RET     Move to next line
 896 M-RET   Move to previous line
 897 v       Decode the content as `play mode'
 898 e       Decode the content as `extract mode'
 899 C-c C-p Decode the content as `print mode'
 900 q       Quit
 901 "
 902   (interactive)
 903   (let ((buf (get-buffer mime/output-buffer-name))
 904         (the-buf (current-buffer))
 905         )
 906     (if buf
 907         (progn
 908           (switch-to-buffer buf)
 909           (erase-buffer)
 910           (switch-to-buffer the-buf)
 911           )))
 912   (let ((ret (mime-viewer/parse-message ctl encoding))
 913         (mode major-mode))
 914     (switch-to-buffer (car ret))
 915     (setq major-mode 'mime/viewer-mode)
 916     (setq mode-name "MIME-View")
 917     (make-variable-buffer-local 'mime::preview/original-major-mode)
 918     (setq mime::preview/original-major-mode
 919           (if mother
 920               (progn
 921                 (make-variable-buffer-local
 922                  'mime/show-mode-old-window-configuration)
 923                 (setq mime/show-mode-old-window-configuration
 924                       (current-window-configuration))
 925                 (make-variable-buffer-local 'mime/mother-buffer)
 926                 (setq mime/mother-buffer mother)
 927                 'mime/show-message-mode)
 928             mode))
 929     (use-local-map mime/viewer-mode-map)
 930     (make-variable-buffer-local 'mime::preview/content-list)
 931     (setq mime::preview/content-list (nth 1 ret))
 932     (goto-char
 933      (let ((ce (mime::preview-content-info/point-max
 934                 (car mime::preview/content-list)
 935                 ))
 936            e)
 937        (goto-char (point-min))
 938        (search-forward "\n\n" nil t)
 939        (setq e (match-end 0))
 940        (if (<= e ce)
 941            e
 942          ce)))
 943     (run-hooks 'mime/viewer-mode-hook)
 944     ))
 945
 946 (defun mime::preview/decode-content ()
 947   (interactive)
 948   (let ((pc (mime::point-preview-content (point))))
 949     (if pc
 950         (let ((the-buf (current-buffer)))
 951           (switch-to-buffer (mime::preview-content-info/buffer pc))
 952           (mime::article/decode-content-region
 953            (mime::preview-content-info/content-info pc))
 954           (if (eq (current-buffer)
 955                   (mime::preview-content-info/buffer pc))
 956               (switch-to-buffer the-buf)
 957             )
 958           ))))
 959
 960 (defun mime-viewer/play-content ()
 961   (interactive)
 962   (let ((mime-viewer/decoding-mode "play"))
 963     (mime::preview/decode-content)
 964     ))
 965
 966 (defun mime-viewer/extract-content ()
 967   (interactive)
 968   (let ((mime-viewer/decoding-mode "extract"))
 969     (mime::preview/decode-content)
 970     ))
 971
 972 (defun mime-viewer/print-content ()
 973   (interactive)
 974   (let ((mime-viewer/decoding-mode "print"))
 975     (mime::preview/decode-content)
 976     ))
 977
 978 (defun mime-viewer/up-content ()
 979   (interactive)
 980   (let ((pc (mime::point-preview-content (point))) cinfo
 981         (the-buf (current-buffer))
 982         cn r)
 983     (switch-to-buffer (mime::preview-content-info/buffer pc))
 984     (setq cinfo (mime::preview-content-info/content-info pc))
 985     (setq cn (mime::get-point-content-number
 986               (mime::content-info/point-min cinfo)))
 987     (if (eq cn t)
 988         (mime-viewer/quit the-buf
 989                           (mime::preview-content-info/buffer pc)
 990                           )
 991       (setq r (mime::article/get-content-region (butlast cn)))
 992       (switch-to-buffer the-buf)
 993       (catch 'tag
 994         (let ((rpcl mime::preview/content-list) cell)
 995           (while rpcl
 996             (setq cell (car rpcl))
 997             (if (eq r (mime::preview-content-info/content-info cell))
 998                 (progn
 999                   (goto-char (mime::preview-content-info/point-min cell))
1000                   (throw 'tag nil)
1001                   ))
1002             (setq rpcl (cdr rpcl))
1003             )))
1004       )))
1005
1006 (defun mime-viewer/previous-content ()
1007   (interactive)
1008   (let* ((pcl mime::preview/content-list)
1009          (p (point))
1010          (i (- (length pcl) 1))
1011          beg)
1012     (catch 'tag
1013       (while (>= i 0)
1014         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
1015         (if (> p beg)
1016             (throw 'tag (goto-char beg))
1017           )
1018         (setq i (- i 1))
1019         ))
1020     ))
1021
1022 (defun mime-viewer/next-content ()
1023   (interactive)
1024   (let ((pcl mime::preview/content-list)
1025         (p (point))
1026         beg)
1027     (catch 'tag
1028       (while pcl
1029         (setq beg (mime::preview-content-info/point-min (car pcl)))
1030         (if (< p beg)
1031             (throw 'tag (goto-char beg))
1032           )
1033         (setq pcl (cdr pcl))
1034         ))
1035     ))
1036
1037 (defun mime-viewer/scroll-up-content (&optional h)
1038   (interactive)
1039   (if (null h)
1040       (setq h (- (window-height) 1))
1041     )
1042   (let ((pcl mime::preview/content-list)
1043         (p (point))
1044         np beg)
1045     (setq np
1046           (or (catch 'tag
1047                 (while pcl
1048                   (setq beg (mime::preview-content-info/point-min (car pcl)))
1049                   (if (< p beg)
1050                       (throw 'tag beg)
1051                     )
1052                   (setq pcl (cdr pcl))
1053                   ))
1054               (point-max)))
1055     (forward-line h)
1056     (if (> (point) np)
1057         (goto-char np)
1058       )))
1059
1060 (defun mime-viewer/scroll-down-content (&optional h)
1061   (interactive)
1062   (if (null h)
1063       (setq h (- (window-height) 1))
1064     )
1065   (let ((pcl mime::preview/content-list)
1066         (p (point))
1067         pp beg)
1068     (setq pp
1069           (or (let ((i (- (length pcl) 1)))
1070                 (catch 'tag
1071                   (while (> i 0)
1072                     (setq beg (mime::preview-content-info/point-min
1073                                (nth i pcl)))
1074                     (if (> p beg)
1075                         (throw 'tag beg)
1076                       )
1077                     (setq i (- i 1))
1078                     )))
1079               (point-min)))
1080     (forward-line (- h))
1081     (if (< (point) pp)
1082         (goto-char pp)
1083       )))
1084
1085 (defun mime-viewer/next-line-content ()
1086   (interactive)
1087   (mime-viewer/scroll-up-content 1)
1088   )
1089
1090 (defun mime-viewer/previous-line-content ()
1091   (interactive)
1092   (mime-viewer/scroll-down-content 1)
1093   )
1094
1095 (defun mime-viewer/quit (&optional the-buf buf)
1096   (interactive)
1097   (if (null the-buf)
1098       (setq the-buf (current-buffer))
1099     )
1100   (if (null buf)
1101       (setq buf (mime::preview-content-info/buffer
1102                  (mime::point-preview-content (point))))
1103     )
1104   (let ((r (progn
1105              (switch-to-buffer buf)
1106              (assoc major-mode mime-viewer/quitting-method-alist)
1107              )))
1108     (if r
1109         (progn
1110           (switch-to-buffer the-buf)
1111           (funcall (cdr r))
1112           ))
1113     ))
1114
1115 (defun mime-viewer/kill-buffer ()
1116   (interactive)
1117   (kill-buffer (current-buffer))
1118   )
1119
1120 (fset 'mime/view-mode 'mime/viewer-mode)
1121
1122 (run-hooks 'tm-view-load-hook)