tm-view.el

   1 ;;;
   2 ;;; tm-view.el --- interactive MIME viewer for GNU Emacs
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Keywords: mail, news, MIME, multimedia
   9 ;;;
  10 ;;; This file is part of tm (Tools for MIME).
  11 ;;;
  12
  13 (require 'tl-str)
  14 (require 'tl-list)
  15 (require 'tl-atype)
  16 (require 'tl-misc)
  17 (require 'tl-822)
  18 (require 'mel)
  19 (require 'tm-ew-d)
  20 (require 'tm-def)
  21 (require 'tm-parse)
  22
  23
  24 ;;; @ version
  25 ;;;
  26
  27 (defconst mime-viewer/RCS-ID
  28   "$Id: tm-view.el,v 7.21 1995/10/30 05:57:27 morioka Exp $")
  29
  30 (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
  31 (defconst mime/viewer-version mime-viewer/version)
  32
  33
  34 ;;; @ variables
  35 ;;;
  36
  37 (defvar mime/content-decoding-condition
  38   '(((type . "text/plain")
  39      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
  40     ;;((type . "text/x-latex")
  41     ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
  42     ((type . "audio/basic")
  43      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
  44     ((type . "image/gif")
  45      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  46     ((type . "image/jpeg")
  47      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  48     ((type . "image/tiff")
  49      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  50     ((type . "image/x-tiff")
  51      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  52     ((type . "image/x-xbm")
  53      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  54     ((type . "image/x-pic")
  55      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  56     ((type . "video/mpeg")
  57      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
  58     ((type . "application/octet-stream")
  59      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
  60     ;;((type . "message/external-body")
  61     ;; (method "xterm" nil
  62     ;;         "-e" "showexternal"
  63     ;;         'file '"access-type" '"name" '"site" '"directory"))
  64     ((type . "message/partial")
  65      (method . mime-article/decode-message/partial))
  66     ((method "metamail" t
  67              "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
  68     ((method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
  69      (mode . "extract"))
  70     ))
  71
  72 (defvar mime-viewer/childrens-header-showing-Content-Type-list
  73   '("message/rfc822" "message/news"))
  74
  75 (defvar mime-viewer/default-showing-Content-Type-list
  76   '("text/plain" "text/richtext" "text/enriched"
  77     "text/x-latex" "application/x-latex"
  78     "application/octet-stream" nil
  79     "application/pgp"
  80     "application/x-selection" "application/x-comment"))
  81
  82 (defvar mime-viewer/content-subject-omitting-Content-Type-list
  83   '("application/x-selection"))
  84
  85 (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode"))
  86
  87 (defvar mime-viewer/ignored-field-list
  88   '("Received" "Return-Path" "Replied" "Errors-To"
  89     "Lines" "Sender" "Path" "Nntp-Posting-Host"
  90     "Content-Type" "Precedence" "X-Face"))
  91
  92 (defvar mime-viewer/ignored-field-regexp)
  93
  94 (defvar mime-viewer/announcement-for-message/partial
  95   (if (and (>= emacs-major-version 19) window-system)
  96       "\
  97 \[[ This is message/partial style split message. ]]
  98 \[[ Please press `v' key in this buffer          ]]
  99 \[[ or click here by mouse button-2.             ]]"
 100     "\
 101 \[[ This is message/partial style split message. ]]
 102 \[[ Please press `v' key in this buffer.         ]]"
 103     ))
 104
 105
 106 ;;; @@ predicate functions
 107 ;;;
 108
 109 (defun mime-viewer/header-visible-p (rcnum cinfo &optional ctype)
 110   (or (null rcnum)
 111       (progn
 112         (setq ctype
 113               (mime::content-info/type
 114                (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)
 115                ))
 116         (member ctype mime-viewer/childrens-header-showing-Content-Type-list)
 117         )))
 118
 119 (defun mime-viewer/body-visible-p (rcnum cinfo &optional ctype)
 120   (let (ccinfo)
 121     (or ctype
 122         (setq ctype
 123               (mime::content-info/type
 124                (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 125                ))
 126         )
 127     (and (member ctype mime-viewer/default-showing-Content-Type-list)
 128          (if (string-equal ctype "application/octet-stream")
 129              (progn
 130                (or ccinfo
 131                    (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 132                    )
 133                (member (mime::content-info/encoding ccinfo)
 134                        '(nil "7bit" "8bit"))
 135                )
 136            t))
 137     ))
 138
 139
 140 ;;; @@ content subject
 141 ;;;
 142
 143 (defun mime-viewer/insert-content-subject
 144   (rcnum cinfo ctype params subj)
 145   (save-restriction
 146     (narrow-to-region (point)(point))
 147     (insert
 148      (let ((access-type (assoc "access-type" params))
 149            (num (or (assoc-value "x-part-number" params)
 150                     (if (consp rcnum)
 151                         (mapconcat (function
 152                                     (lambda (num)
 153                                       (format "%s" (1+ num))
 154                                       ))
 155                                    (reverse rcnum) ".")
 156                       "0"))
 157                 ))
 158        (if access-type
 159            (let ((server (assoc "server" params)))
 160              (setq access-type (cdr access-type))
 161              (if server
 162                  (format "[%s %s ([%s] %s)]\n" num subj
 163                          access-type (cdr server))
 164                (let ((site (assoc-value "site" params))
 165                      (dir (assoc-value "directory" params))
 166                      )
 167                  (format "[%s %s ([%s] %s:%s)]\n" num subj
 168                          access-type site dir)
 169                  )))
 170          (format "[%s %s (%s)]\n" num subj ctype)
 171          )))
 172     (tm:add-button (point-min)(1- (point-max))
 173                    (function mime-viewer/play-content))
 174     ))
 175
 176 (defun mime-viewer/default-content-subject-function
 177   (rcnum cinfo ctype params subj)
 178   (if (and (consp rcnum)
 179            (not (member
 180                  ctype
 181                  mime-viewer/content-subject-omitting-Content-Type-list))
 182            )
 183       (mime-viewer/insert-content-subject
 184        rcnum cinfo ctype params subj)
 185     ))
 186
 187 (defvar mime-viewer/content-subject-function
 188   (function mime-viewer/default-content-subject-function))
 189
 190
 191 ;;; @@ content header filter
 192 ;;;
 193
 194 (defun mime-viewer/default-content-header-filter ()
 195   (goto-char (point-min))
 196   (while (and (re-search-forward mime-viewer/ignored-field-regexp nil t)
 197               (progn
 198                 (delete-region
 199                  (match-beginning 0)
 200                  (save-excursion
 201                    (and
 202                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 203                     (match-beginning 0)
 204                     )))
 205                 t)))
 206   (mime/decode-message-header)
 207   )
 208
 209 (defvar mime-viewer/content-header-filter-alist nil)
 210
 211
 212 ;;; @@ content filter
 213 ;;;
 214
 215 (defvar mime-viewer/content-filter-alist
 216   '(("text/plain"      . mime-viewer/filter-text/plain)
 217     ("application/pgp" . mime-viewer/filter-text/plain)
 218     (nil . mime-viewer/filter-text/plain)))
 219
 220 (defun mime-viewer/default-content-filter (rcnum cinfo ctype params subj)
 221   )
 222
 223
 224 ;;; @@ content separator
 225 ;;;
 226
 227 (defun mime-viewer/default-content-separator (rcnum cinfo ctype params subj)
 228   (if (and (not (mime-viewer/header-visible-p rcnum cinfo ctype))
 229            (not (mime-viewer/body-visible-p rcnum cinfo ctype))
 230            )
 231       (progn
 232         (goto-char (point-max))
 233         (insert "\n")
 234         )))
 235
 236
 237 ;;; @@ buffer local variables
 238 ;;;
 239
 240 (defvar mime/show-mode-old-window-configuration nil)
 241 (defvar mime/mother-buffer nil)
 242
 243 (defvar mime::article/content-info nil)
 244 (defvar mime::article/preview-buffer nil)
 245
 246 (defvar mime::preview/article-buffer nil)
 247 (defvar mime::preview/content-list nil)
 248 (defvar mime::preview/original-major-mode nil)
 249
 250
 251 ;;; @@ quitting method
 252 ;;;
 253
 254 (defun mime-viewer/quitting-method-for-mime/show-message-mode ()
 255   (set-window-configuration mime/show-mode-old-window-configuration)
 256   (let ((mother mime/mother-buffer))
 257     (kill-buffer
 258      (mime::preview-content-info/buffer (car mime::preview/content-list)))
 259     (mime-viewer/kill-buffer)
 260     (pop-to-buffer mother)
 261     (goto-char (point-min))
 262     (mime-viewer/up-content)
 263     ))
 264
 265 (defvar mime-viewer/quitting-method-alist
 266   '((mime/show-message-mode
 267      . mime-viewer/quitting-method-for-mime/show-message-mode)))
 268
 269 (defvar mime-viewer/over-to-previous-method-alist nil)
 270 (defvar mime-viewer/over-to-next-method-alist nil)
 271
 272
 273 ;;; @@ X-Face
 274 ;;;
 275
 276 ;; hack from Gnus 5.0.4.
 277
 278 (defvar mime-viewer/x-face-command
 279   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
 280   "String to be executed to display an X-Face field.
 281 The command will be executed in a sub-shell asynchronously.
 282 The compressed face will be piped to this command.")
 283
 284 (defun mime-viewer/x-face-function ()
 285   "Function to display X-Face field. You can redefine to customize."
 286   ;; 1995/10/12 (c.f. tm-eng:130)
 287   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 288   (save-restriction
 289     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 290     ;; end
 291     (goto-char (point-min))
 292     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 293         (let ((beg (match-end 0))
 294               (end (rfc822/field-end))
 295               )
 296           (call-process-region beg end "sh" nil 0 nil
 297                                "-c" mime-viewer/x-face-command)
 298           ))))
 299
 300
 301 ;;; @ data structures
 302 ;;;
 303
 304 ;;; @@ preview-content-info
 305 ;;;
 306
 307 (define-structure mime::preview-content-info
 308   point-min point-max buffer content-info)
 309
 310
 311 ;;; @ buffer setup
 312 ;;;
 313
 314 (defun mime-viewer/setup-buffer (&optional ctl encoding ibuf obuf)
 315   (if ibuf
 316       (progn
 317         (get-buffer ibuf)
 318         (set-buffer ibuf)
 319         ))
 320   (make-variable-buffer-local 'mime::article/content-info)
 321   (setq mime::article/content-info (mime/parse-message ctl encoding))
 322   (let ((ret (mime-viewer/make-preview-buffer obuf)))
 323     (make-variable-buffer-local 'mime::article/preview-buffer)
 324     (setq mime::article/preview-buffer (car ret))
 325     ret))
 326
 327 (defun mime-viewer/make-preview-buffer (&optional obuf)
 328   (let ((cinfo mime::article/content-info)
 329         (the-buf (current-buffer))
 330         (mode major-mode)
 331         pcl dest)
 332     (or obuf
 333         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))
 334         )
 335     (setq pcl (mime/flatten-content-info cinfo))
 336     (let ((bf (get-buffer obuf)))
 337       (if bf
 338           (progn
 339             (set-buffer obuf)
 340             (setq buffer-read-only nil)
 341             (erase-buffer)
 342             )
 343         (setq bf (get-buffer-create obuf))
 344         (set-buffer obuf)
 345         ))
 346     (make-variable-buffer-local 'mime::preview/article-buffer)
 347     (setq mime::preview/article-buffer the-buf)
 348     (make-variable-buffer-local 'mime::preview/original-major-mode)
 349     (setq mime::preview/original-major-mode mode)
 350     (setq major-mode 'mime/viewer-mode)
 351     (setq mode-name "MIME-View")
 352     (setq dest
 353           (mapcar
 354            (function
 355             (lambda (content)
 356               (mime-viewer/display-content content cinfo the-buf obuf)
 357               ))
 358            pcl))
 359     (set-buffer-modified-p nil)
 360     (setq buffer-read-only t)
 361     (set-buffer the-buf)
 362     (list obuf dest)
 363     ))
 364
 365 (defun mime-viewer/display-content (content cinfo ibuf obuf)
 366   (let* ((beg (mime::content-info/point-min content))
 367          (end (mime::content-info/point-max content))
 368          (ctype (mime::content-info/type content))
 369          (params (mime::content-info/parameters content))
 370          (encoding (mime::content-info/encoding content))
 371          (rcnum (mime::content-info/rcnum content))
 372          he e nb ne subj)
 373     (set-buffer ibuf)
 374     (goto-char beg)
 375     (setq he (if (re-search-forward "^$" nil t)
 376                  (1+ (match-end 0))
 377                end))
 378     (if (> he end)
 379         (setq he end)
 380       )
 381     (save-restriction
 382       (narrow-to-region beg end)
 383       (setq subj
 384             (mime-eword/decode-string
 385              (mime-viewer/get-subject params encoding)))
 386       )
 387     (set-buffer obuf)
 388     (setq nb (point))
 389     (narrow-to-region nb nb)
 390     (funcall mime-viewer/content-subject-function
 391              rcnum cinfo ctype params subj)
 392     (set-buffer ibuf)
 393     (if (mime-viewer/header-visible-p rcnum cinfo ctype)
 394         (mime-viewer/display-header beg he obuf)
 395       )
 396     (cond ((mime-viewer/body-visible-p rcnum cinfo ctype)
 397            (mime-viewer/display-body he end obuf
 398                                      rcnum cinfo ctype params subj encoding)
 399            )
 400           ((equal ctype "message/partial")
 401            (mime-viewer/display-message/partial obuf)
 402            )
 403           ((and (null rcnum)
 404                 (null (mime::content-info/children cinfo))
 405                 )
 406            (set-buffer obuf)
 407            (goto-char (point-max))
 408            (mime-viewer/insert-content-subject rcnum cinfo ctype params subj)
 409            )
 410           (t (set-buffer obuf))
 411           )
 412     (mime-viewer/default-content-separator rcnum cinfo ctype params subj)
 413     (prog1
 414         (progn
 415           (setq ne (point-max))
 416           (widen)
 417           (mime::preview-content-info/create nb (1- ne) ibuf content)
 418           )
 419       (goto-char ne)
 420       )))
 421
 422 (defun mime-viewer/display-header (beg end obuf)
 423   (let ((str (buffer-substring beg end))
 424         (f (assq major-mode mime-viewer/content-header-filter-alist))
 425         )
 426     (save-excursion
 427       (set-buffer obuf)
 428       (save-restriction
 429         (narrow-to-region (point)(point))
 430         (insert str)
 431         (if (and f (setq f (cdr f)))
 432             (funcall f)
 433           (mime-viewer/default-content-header-filter)
 434           )
 435         (run-hooks 'mime-viewer/content-header-filter-hook)
 436         ))))
 437
 438 (defun mime-viewer/display-body (beg end obuf
 439                                      rcnum cinfo ctype params subj encoding)
 440   (let ((str (buffer-substring beg end))
 441         be)
 442     (set-buffer obuf)
 443     (save-restriction
 444       (setq be (point-max))
 445       (narrow-to-region be be)
 446       (insert str)
 447       (let ((f (assoc-value ctype mime-viewer/content-filter-alist)))
 448         (if (and f (fboundp f))
 449             (funcall f ctype params encoding)
 450           (mime-viewer/default-content-filter rcnum cinfo ctype params subj)
 451           ))
 452       )))
 453
 454 (defun mime-viewer/display-message/partial (obuf)
 455   (set-buffer obuf)
 456   (save-restriction
 457     (goto-char (point-max))
 458     (if (not (search-backward "\n\n" nil t))
 459         (insert "\n")
 460       )
 461     (let ((be (point-max)))
 462       (narrow-to-region be be)
 463       (insert mime-viewer/announcement-for-message/partial)
 464       (tm:add-button (point-min)(point-max)
 465                      (function mime-viewer/play-content))
 466       )))
 467
 468 (defun mime-viewer/get-subject (param &optional encoding)
 469   (if (member (or encoding
 470                   (cdr (assq 'encoding param))
 471                   )
 472               mime-viewer/uuencode-encoding-name-list)
 473       (save-excursion
 474         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 475                 (if (looking-at ".+$")
 476                     (buffer-substring (match-beginning 0)(match-end 0))
 477                   ))
 478             ""))
 479     (let (ret)
 480       (or (and (setq ret (assoc "name" param))
 481                (rfc822/strip-quoted-string (cdr ret))
 482                )
 483           (and (setq ret (assoc "x-name" param))
 484                (rfc822/strip-quoted-string (cdr ret))
 485                )
 486
 487           (save-excursion
 488             (save-restriction
 489               (goto-char (point-min))
 490               (narrow-to-region (point-min)
 491                                 (or (and (search-forward "\n\n" nil t)
 492                                          (match-beginning 0)
 493                                          )
 494                                     (point-max)))
 495               (or
 496                (rfc822/get-field-body "Content-Description")
 497                (rfc822/get-field-body "Subject")
 498                )))
 499           ""))
 500     ))
 501
 502
 503 ;;; @ content information
 504 ;;;
 505
 506 (defun mime-article/point-content-number (p &optional cinfo)
 507   (or cinfo
 508       (setq cinfo mime::article/content-info)
 509       )
 510   (let ((b (mime::content-info/point-min cinfo))
 511         (e (mime::content-info/point-max cinfo))
 512         (c (mime::content-info/children cinfo))
 513         )
 514     (if (and (<= b p)(<= p e))
 515         (or (let (co ret (sn 0))
 516               (catch 'tag
 517                 (while c
 518                   (setq co (car c))
 519                   (setq ret (mime-article/point-content-number p co))
 520                   (cond ((eq ret t) (throw 'tag (list sn)))
 521                         (ret (throw 'tag (cons sn ret)))
 522                         )
 523                   (setq c (cdr c))
 524                   (setq sn (1+ sn))
 525                   )))
 526             t))))
 527
 528 (defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
 529   (or cinfo
 530       (setq cinfo mime::article/content-info)
 531       )
 532   (some-element
 533    (function
 534     (lambda (ci)
 535       (equal (mime::content-info/rcnum ci) rcnum)
 536       ))
 537    (mime/flatten-content-info cinfo)
 538    ))
 539
 540 (defun mime-article/cnum-to-cinfo (cn &optional cinfo)
 541   (or cinfo
 542       (setq cinfo mime::article/content-info)
 543       )
 544   (if (eq cn t)
 545       cinfo
 546     (let ((sn (car cn)))
 547       (if (null sn)
 548           cinfo
 549         (let ((rc (nth sn (mime::content-info/children cinfo))))
 550           (if rc
 551               (mime-article/cnum-to-cinfo (cdr cn) rc)
 552             ))
 553         ))))
 554
 555 (defun mime/flatten-content-info (&optional cinfo)
 556   (or cinfo
 557       (setq cinfo mime::article/content-info)
 558       )
 559   (let ((dest (list cinfo))
 560         (rcl (mime::content-info/children cinfo))
 561         )
 562     (while rcl
 563       (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
 564       (setq rcl (cdr rcl))
 565       )
 566     dest))
 567
 568 (defun mime::point-preview-content (p &optional pcl)
 569   (or pcl
 570       (setq pcl mime::preview/content-list)
 571       )
 572   (catch 'tag
 573     (let ((r pcl) cell)
 574       (while r
 575         (setq cell (car r))
 576         (if (and (<= (mime::preview-content-info/point-min cell) p)
 577                  (<= p (mime::preview-content-info/point-max cell))
 578                  )
 579             (throw 'tag cell)
 580           )
 581         (setq r (cdr r))
 582         ))
 583     (car (last pcl))
 584     ))
 585
 586
 587 ;;; @ content filter
 588 ;;;
 589
 590 (defvar mime-viewer/code-converter-alist nil)
 591
 592 (defun mime-viewer/default-code-convert-region
 593   (beg end charset &optional encoding)
 594   (if (member encoding '("quoted-printable" "base64"))
 595       (mime/code-convert-region-to-emacs beg (point-max) charset)
 596     ))
 597
 598 (defun mime-viewer/filter-text/plain (ctype params encoding)
 599   (let ((charset (cdr (assoc "charset" params)))
 600         (beg (point-min)) (end (point-max))
 601         )
 602     (mime/decode-region encoding beg end)
 603     (let* ((mode mime::preview/original-major-mode)
 604            (m (assq mode mime-viewer/code-converter-alist))
 605            )
 606       (if (and m (fboundp (setq m (cdr m))))
 607           (funcall m beg (point-max) charset encoding)
 608         (mime-viewer/default-code-convert-region beg (point-max)
 609                                                  charset encoding)
 610         )))
 611   (goto-char (point-max))
 612   (if (not (eq (char-after (1- (point))) ?\n))
 613       (insert "\n")
 614     )
 615   (if browse-url-browser-function
 616       (progn
 617         (goto-char (point-min))
 618         (while (re-search-forward tm:URL-regexp nil t)
 619           (tm:add-button (match-beginning 0)(match-end 0)
 620                          (function tm:browse-url))
 621           )))
 622   (run-hooks 'mime-viewer/plain-text-preview-hook)
 623   )
 624
 625
 626 ;;; @ MIME viewer mode
 627 ;;;
 628
 629 (defvar mime/viewer-mode-map nil)
 630 (if (null mime/viewer-mode-map)
 631     (progn
 632       (setq mime/viewer-mode-map (make-keymap))
 633       (suppress-keymap mime/viewer-mode-map)
 634       (define-key mime/viewer-mode-map
 635         "u"        (function mime-viewer/up-content))
 636       (define-key mime/viewer-mode-map
 637         "p"        (function mime-viewer/previous-content))
 638       (define-key mime/viewer-mode-map
 639         "n"        (function mime-viewer/next-content))
 640       (define-key mime/viewer-mode-map
 641         " "        (function mime-viewer/scroll-up-content))
 642       (define-key mime/viewer-mode-map
 643         "\M- "     (function mime-viewer/scroll-down-content))
 644       (define-key mime/viewer-mode-map
 645         "\177"     (function mime-viewer/scroll-down-content))
 646       (define-key mime/viewer-mode-map
 647         "\C-m"     (function mime-viewer/next-line-content))
 648       (define-key mime/viewer-mode-map
 649         "\C-\M-m"  (function mime-viewer/previous-line-content))
 650       (define-key mime/viewer-mode-map
 651         "v"        (function mime-viewer/play-content))
 652       (define-key mime/viewer-mode-map
 653         "e"        (function mime-viewer/extract-content))
 654       (define-key mime/viewer-mode-map
 655         "\C-c\C-p" (function mime-viewer/print-content))
 656       (define-key mime/viewer-mode-map
 657         "f"        (function mime-viewer/display-x-face))
 658       (define-key mime/viewer-mode-map
 659         "q"        (function mime-viewer/quit))
 660       (define-key mime/viewer-mode-map
 661         "\C-c\C-x" (function mime-viewer/kill-buffer))
 662       (if mouse-button-2
 663           (define-key mime/viewer-mode-map
 664             mouse-button-2 (function tm:button-dispatcher))
 665         )
 666       ))
 667
 668 (defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf)
 669   "Major mode for viewing MIME message.
 670
 671 Here is a list of the standard keys for mime/viewer-mode.
 672
 673 key             feature
 674 ---             -------
 675
 676 u               Move to upper content
 677 p               Move to previous content
 678 n               Move to next content
 679 SPC             Scroll up or move to next content
 680 M-SPC           Scroll down or move to previous content
 681 DEL             Scroll down or move to previous content
 682 RET             Move to next line
 683 M-RET           Move to previous line
 684 v               Decode current content as `play mode'
 685 e               Decode current content as `extract mode'
 686 C-c C-p         Decode current content as `print mode'
 687 f               Display X-Face
 688 q               Quit
 689 button-2        Move to point under the mouse cursor
 690                 and decode current content as `play mode'
 691
 692
 693 Here are all the commands with their current binding,
 694 listed in key order:
 695
 696 \\{mime/viewer-mode-map}
 697 "
 698   (interactive)
 699   (setq mime-viewer/ignored-field-regexp
 700         (concat "^\\("
 701                 (mapconcat (function regexp-quote)
 702                            mime-viewer/ignored-field-list "\\|")
 703                 "\\):"))
 704   (let ((buf (get-buffer mime/output-buffer-name)))
 705     (if buf
 706         (save-excursion
 707           (set-buffer buf)
 708           (erase-buffer)
 709           )))
 710   (let ((ret (mime-viewer/setup-buffer ctl encoding ibuf obuf)))
 711     (prog1
 712         (switch-to-buffer (car ret))
 713       (if mother
 714           (progn
 715             (make-variable-buffer-local
 716              'mime/show-mode-old-window-configuration)
 717             (setq mime/show-mode-old-window-configuration
 718                   (current-window-configuration))
 719             (make-variable-buffer-local 'mime/mother-buffer)
 720             (setq mime/mother-buffer mother)
 721             ))
 722       (use-local-map mime/viewer-mode-map)
 723       (make-variable-buffer-local 'mime::preview/content-list)
 724       (setq mime::preview/content-list (nth 1 ret))
 725       (goto-char
 726        (let ((ce (mime::preview-content-info/point-max
 727                   (car mime::preview/content-list)
 728                   ))
 729              e)
 730          (goto-char (point-min))
 731          (search-forward "\n\n" nil t)
 732          (setq e (match-end 0))
 733          (if (<= e ce)
 734              e
 735            ce)))
 736       (run-hooks 'mime/viewer-mode-hook)
 737       )))
 738
 739 (defun mime-preview/point-content-number (point)
 740   (save-window-excursion
 741     (let ((pc (mime::point-preview-content (point)))
 742           cinfo)
 743       (switch-to-buffer (mime::preview-content-info/buffer pc))
 744       (setq cinfo (mime::preview-content-info/content-info pc))
 745       (mime-article/point-content-number (mime::content-info/point-min cinfo))
 746       )))
 747
 748 (defun mime-preview/cinfo-to-pcinfo (cinfo)
 749   (let ((rpcl mime::preview/content-list) cell)
 750     (catch 'tag
 751       (while rpcl
 752         (setq cell (car rpcl))
 753         (if (eq cinfo (mime::preview-content-info/content-info cell))
 754             (throw 'tag cell)
 755           )
 756         (setq rpcl (cdr rpcl))
 757         ))))
 758
 759 (autoload 'mime-preview/decode-content "tm-play")
 760
 761 (defvar mime-viewer/decoding-mode "play" "MIME body decoding mode")
 762
 763 (defun mime-viewer/play-content ()
 764   (interactive)
 765   (let ((mime-viewer/decoding-mode "play"))
 766     (mime-preview/decode-content)
 767     ))
 768
 769 (defun mime-viewer/extract-content ()
 770   (interactive)
 771   (let ((mime-viewer/decoding-mode "extract"))
 772     (mime-preview/decode-content)
 773     ))
 774
 775 (defun mime-viewer/print-content ()
 776   (interactive)
 777   (let ((mime-viewer/decoding-mode "print"))
 778     (mime-preview/decode-content)
 779     ))
 780
 781 (defun mime-viewer/display-x-face ()
 782   (interactive)
 783   (save-window-excursion
 784     (set-buffer mime::preview/article-buffer)
 785     (mime-viewer/x-face-function)
 786     ))
 787
 788 (defun mime-viewer/up-content ()
 789   (interactive)
 790   (let ((pc (mime::point-preview-content (point))) cinfo
 791         (the-buf (current-buffer))
 792         rcnum r)
 793     (switch-to-buffer (mime::preview-content-info/buffer pc))
 794     (setq cinfo (mime::preview-content-info/content-info pc))
 795     (setq rcnum (mime::content-info/rcnum cinfo))
 796     (if (null rcnum)
 797         (mime-viewer/quit the-buf
 798                           (mime::preview-content-info/buffer pc)
 799                           )
 800       (setq r (mime-article/rcnum-to-cinfo (cdr rcnum)))
 801       (switch-to-buffer the-buf)
 802       (catch 'tag
 803         (let ((rpcl mime::preview/content-list) cell)
 804           (while rpcl
 805             (setq cell (car rpcl))
 806             (if (eq r (mime::preview-content-info/content-info cell))
 807                 (progn
 808                   (goto-char (mime::preview-content-info/point-min cell))
 809                   (throw 'tag nil)
 810                   ))
 811             (setq rpcl (cdr rpcl))
 812             )))
 813       )))
 814
 815 (defun mime-viewer/previous-content ()
 816   (interactive)
 817   (let* ((pcl mime::preview/content-list)
 818          (p (point))
 819          (i (- (length pcl) 1))
 820          beg)
 821     (catch 'tag
 822       (while (>= i 0)
 823         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
 824         (if (> p beg)
 825             (throw 'tag (goto-char beg))
 826           )
 827         (setq i (- i 1))
 828         )
 829       (let ((f (assq mime::preview/original-major-mode
 830                      mime-viewer/over-to-previous-method-alist)))
 831         (if f
 832             (funcall (cdr f))
 833           ))
 834       )
 835     ))
 836
 837 (defun mime-viewer/next-content ()
 838   (interactive)
 839   (let ((pcl mime::preview/content-list)
 840         (p (point))
 841         beg)
 842     (catch 'tag
 843       (while pcl
 844         (setq beg (mime::preview-content-info/point-min (car pcl)))
 845         (if (< p beg)
 846             (throw 'tag (goto-char beg))
 847           )
 848         (setq pcl (cdr pcl))
 849         )
 850       (let ((f (assq mime::preview/original-major-mode
 851                      mime-viewer/over-to-next-method-alist)))
 852         (if f
 853             (funcall (cdr f))
 854           ))
 855       )
 856     ))
 857
 858 (defun mime-viewer/scroll-up-content (&optional h)
 859   (interactive)
 860   (or h
 861       (setq h (- (window-height) 1))
 862       )
 863   (let ((pcl mime::preview/content-list)
 864         (p (point))
 865         np beg)
 866     (setq np
 867           (or (catch 'tag
 868                 (while pcl
 869                   (setq beg (mime::preview-content-info/point-min (car pcl)))
 870                   (if (< p beg)
 871                       (throw 'tag beg)
 872                     )
 873                   (setq pcl (cdr pcl))
 874                   ))
 875               (point-max)))
 876     (forward-line h)
 877     (if (> (point) np)
 878         (goto-char np)
 879       )
 880     ;;(show-subtree)
 881     ))
 882
 883 (defun mime-viewer/scroll-down-content (&optional h)
 884   (interactive)
 885   (or h
 886       (setq h (- (window-height) 1))
 887       )
 888   (let ((pcl mime::preview/content-list)
 889         (p (point))
 890         pp beg)
 891     (setq pp
 892           (or (let ((i (- (length pcl) 1)))
 893                 (catch 'tag
 894                   (while (> i 0)
 895                     (setq beg (mime::preview-content-info/point-min
 896                                (nth i pcl)))
 897                     (if (> p beg)
 898                         (throw 'tag beg)
 899                       )
 900                     (setq i (- i 1))
 901                     )))
 902               (point-min)))
 903     (forward-line (- h))
 904     (if (< (point) pp)
 905         (goto-char pp)
 906       )))
 907
 908 (defun mime-viewer/next-line-content ()
 909   (interactive)
 910   (mime-viewer/scroll-up-content 1)
 911   )
 912
 913 (defun mime-viewer/previous-line-content ()
 914   (interactive)
 915   (mime-viewer/scroll-down-content 1)
 916   )
 917
 918 (defun mime-viewer/quit (&optional the-buf buf)
 919   (interactive)
 920   (or the-buf
 921       (setq the-buf (current-buffer))
 922       )
 923   (or buf
 924       (setq buf (mime::preview-content-info/buffer
 925                  (mime::point-preview-content (point))))
 926       )
 927   (let ((r (progn
 928              (switch-to-buffer buf)
 929              (assq major-mode mime-viewer/quitting-method-alist)
 930              )))
 931     (if r
 932         (progn
 933           (switch-to-buffer the-buf)
 934           (funcall (cdr r))
 935           ))
 936     ))
 937
 938 (defun mime-viewer/kill-buffer ()
 939   (interactive)
 940   (kill-buffer (current-buffer))
 941   )
 942
 943
 944 ;;; @ end
 945 ;;;
 946
 947 (provide 'tm-view)
 948
 949 (run-hooks 'tm-view-load-hook)