tm-view.el

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