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