mime-view.el

   1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1994/7/13
   7 ;;      Renamed: 1994/8/31 from tm-body.el
   8 ;;      Renamed: 1997/02/19 from tm-view.el
   9 ;; Version: $Revision: 0.19 $
  10 ;; Keywords: MIME, multimedia, mail, news
  11
  12 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Code:
  30
  31 (require 'cl)
  32 (require 'std11)
  33 (require 'mel)
  34 (require 'eword-decode)
  35 (require 'mime-parse)
  36 (require 'mime-text)
  37
  38
  39 ;;; @ version
  40 ;;;
  41
  42 (defconst mime-view-RCS-ID
  43   "$Id: mime-view.el,v 0.19 1997-02-27 06:37:53 tmorioka Exp $")
  44
  45 (defconst mime-view-version (get-version-string mime-view-RCS-ID))
  46
  47
  48 ;;; @ variables
  49 ;;;
  50
  51 (defvar mime/content-decoding-condition
  52   '(((type . "text/plain")
  53      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)
  54      (mode "play" "print")
  55      )
  56     ((type . "text/html")
  57      (method "tm-html" nil 'file 'type 'encoding 'mode 'name)
  58      (mode . "play")
  59      )
  60     ((type . "text/x-rot13-47")
  61      (method . mime-article/decode-caesar)
  62      (mode . "play")
  63      )
  64     ((type . "audio/basic")
  65      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name)
  66      (mode . "play")
  67      )
  68
  69     ((type . "image/jpeg")
  70      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  71      (mode "play" "print")
  72      )
  73     ((type . "image/gif")
  74      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  75      (mode "play" "print")
  76      )
  77     ((type . "image/tiff")
  78      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  79      (mode "play" "print")
  80      )
  81     ((type . "image/x-tiff")
  82      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  83      (mode "play" "print")
  84      )
  85     ((type . "image/x-xbm")
  86      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  87      (mode "play" "print")
  88      )
  89     ((type . "image/x-pic")
  90      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  91      (mode "play" "print")
  92      )
  93     ((type . "image/x-mag")
  94      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  95      (mode "play" "print")
  96      )
  97
  98     ((type . "video/mpeg")
  99      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name)
 100      (mode . "play")
 101      )
 102
 103     ((type . "application/postscript")
 104      (method "tm-ps" nil 'file 'type 'encoding 'mode 'name)
 105      (mode "play" "print")
 106      )
 107     ((type . "application/octet-stream")
 108      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
 109      (mode "play" "print")
 110      )
 111
 112     ;;((type . "message/external-body")
 113     ;; (method "xterm" nil
 114     ;;         "-e" "showexternal"
 115     ;;         'file '"access-type" '"name" '"site" '"directory"))
 116     ((type . "message/rfc822")
 117      (method . mime-article/view-message/rfc822)
 118      (mode . "play")
 119      )
 120     ((type . "message/partial")
 121      (method . mime-article/decode-message/partial)
 122      (mode . "play")
 123      )
 124
 125     ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
 126      (mode . "play")
 127      )
 128     ((method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
 129      (mode . "extract")
 130      )
 131     ))
 132
 133 (defvar mime-view-childrens-header-showing-Content-Type-list
 134   '("message/rfc822" "message/news"))
 135
 136 (defvar mime-view-default-showing-Content-Type-list
 137   '("text/plain" nil "text/richtext" "text/enriched"
 138     "text/x-latex" "application/x-latex"
 139     "message/delivery-status"
 140     "application/pgp" "text/x-pgp"
 141     "application/octet-stream"
 142     "application/x-selection" "application/x-comment"))
 143
 144 (defvar mime-view-content-button-ignored-ctype-list
 145   '("application/x-selection"))
 146
 147 (defvar mime-view-content-button-visible-ctype-list
 148   '("application/pgp"))
 149
 150 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 151
 152 (defvar mime-view-ignored-field-list
 153   '(".*Received" ".*Path" ".*Id" "References"
 154     "Replied" "Errors-To"
 155     "Lines" "Sender" ".*Host" "Xref"
 156     "Content-Type" "Precedence"
 157     "Status" "X-VM-.*")
 158   "All fields that match this list will be hidden in MIME preview buffer.
 159 Each elements are regexp of field-name. [mime-view.el]")
 160
 161 (defvar mime-view-ignored-field-regexp
 162   (concat "^"
 163           (apply (function regexp-or) mime-view-ignored-field-list)
 164           ":"))
 165
 166 (defvar mime-view-visible-field-list
 167   '("Dnas.*" "Message-Id")
 168   "All fields that match this list will be displayed in MIME preview buffer.
 169 Each elements are regexp of field-name. [mime-view.el]")
 170
 171 (defvar mime-view-visible-field-regexp
 172   (concat "^"
 173           (apply (function regexp-or) mime-view-visible-field-list)
 174           ":"))
 175
 176 (defvar mime-view-redisplay nil)
 177
 178 (defvar mime-view-announcement-for-message/partial
 179   (if (and (>= emacs-major-version 19) window-system)
 180       "\
 181 \[[ This is message/partial style split message. ]]
 182 \[[ Please press `v' key in this buffer          ]]
 183 \[[ or click here by mouse button-2.             ]]"
 184     "\
 185 \[[ This is message/partial style split message. ]]
 186 \[[ Please press `v' key in this buffer.         ]]"
 187     ))
 188
 189
 190 ;;; @@ predicate functions
 191 ;;;
 192
 193 (defun mime-view-header-visible-p (rcnum cinfo &optional ctype)
 194   (or (null rcnum)
 195       (progn
 196         (setq ctype
 197               (mime::content-info/type
 198                (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)
 199                ))
 200         (member ctype mime-view-childrens-header-showing-Content-Type-list)
 201         )))
 202
 203 (defun mime-view-body-visible-p (rcnum cinfo &optional ctype)
 204   (let (ccinfo)
 205     (or ctype
 206         (setq ctype
 207               (mime::content-info/type
 208                (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 209                ))
 210         )
 211     (and (member ctype mime-view-default-showing-Content-Type-list)
 212          (if (string-equal ctype "application/octet-stream")
 213              (progn
 214                (or ccinfo
 215                    (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 216                    )
 217                (member (mime::content-info/encoding ccinfo)
 218                        '(nil "7bit" "8bit"))
 219                )
 220            t))
 221     ))
 222
 223
 224 ;;; @@ content button
 225 ;;;
 226
 227 (defun mime-preview/insert-content-button
 228   (rcnum cinfo ctype params subj encoding)
 229   (save-restriction
 230     (narrow-to-region (point)(point))
 231     (let ((access-type (assoc "access-type" params))
 232           (charset (assoc "charset" params))
 233           (num (or (cdr (assoc "x-part-number" params))
 234                    (if (consp rcnum)
 235                        (mapconcat (function
 236                                    (lambda (num)
 237                                      (format "%s" (1+ num))
 238                                      ))
 239                                   (reverse rcnum) ".")
 240                      "0"))
 241                ))
 242       (cond (access-type
 243              (let ((server (assoc "server" params)))
 244                (setq access-type (cdr access-type))
 245                (if server
 246                    (insert (format "[%s %s ([%s] %s)]\n" num subj
 247                                    access-type (cdr server)))
 248                  (let ((site (assoc-value "site" params))
 249                        (dir (assoc-value "directory" params))
 250                        )
 251                    (insert (format "[%s %s ([%s] %s:%s)]\n" num subj
 252                                    access-type site dir))
 253                    )))
 254              )
 255             (t
 256              (insert (concat "[" num " " subj))
 257              (let ((rest
 258                     (if (setq charset (cdr charset))
 259                         (if encoding
 260                             (format " <%s; %s (%s)>]\n"
 261                                     ctype charset encoding)
 262                           (format " <%s; %s>]\n" ctype charset)
 263                           )
 264                       (format " <%s>]\n" ctype)
 265                       )))
 266                (if (>= (+ (current-column)(length rest))(window-width))
 267                    (setq rest (concat "\n\t" rest))
 268                  )
 269                (insert rest)
 270                ))))
 271     (mime-add-button (point-min)(1- (point-max))
 272                      (function mime-view-play-content))
 273     ))
 274
 275 (defun mime-preview/default-content-button-function
 276   (rcnum cinfo ctype params subj encoding)
 277   (if (and (consp rcnum)
 278            (not (member
 279                  ctype
 280                  mime-view-content-button-ignored-ctype-list)))
 281       (mime-preview/insert-content-button
 282        rcnum cinfo ctype params subj encoding)
 283     ))
 284
 285 (defvar mime-preview/content-button-function
 286   (function mime-preview/default-content-button-function))
 287
 288
 289 ;;; @@ content header filter
 290 ;;;
 291
 292 (defun mime-preview/cut-header ()
 293   (goto-char (point-min))
 294   (while (and
 295           (re-search-forward mime-view-ignored-field-regexp nil t)
 296           (let* ((beg (match-beginning 0))
 297                  (end (match-end 0))
 298                  (name (buffer-substring beg end))
 299                  )
 300             (if (not (string-match mime-view-visible-field-regexp name))
 301                 (delete-region
 302                  beg
 303                  (save-excursion
 304                    (and
 305                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 306                     (match-beginning 0)
 307                     )))
 308               )
 309             t)))
 310   )
 311
 312 (defun mime-view-default-content-header-filter ()
 313   (mime-preview/cut-header)
 314   (eword-decode-header)
 315   )
 316
 317 (defvar mime-view-content-header-filter-alist nil)
 318
 319
 320 ;;; @@ content filter
 321 ;;;
 322
 323 (defvar mime-view-content-filter-alist
 324   '(("text/enriched" . mime-preview/filter-for-text/enriched)
 325     ("text/richtext" . mime-preview/filter-for-text/richtext)
 326     (t . mime-preview/filter-for-text/plain)
 327     ))
 328
 329
 330 ;;; @@ content separator
 331 ;;;
 332
 333 (defun mime-preview/default-content-separator (rcnum cinfo ctype params subj)
 334   (if (and (not (mime-view-header-visible-p rcnum cinfo ctype))
 335            (not (mime-view-body-visible-p rcnum cinfo ctype))
 336            )
 337       (progn
 338         (goto-char (point-max))
 339         (insert "\n")
 340         )))
 341
 342
 343 ;;; @@ buffer local variables
 344 ;;;
 345
 346 ;; for XEmacs
 347 (defvar mime::article/preview-buffer nil)
 348 (defvar mime::article/code-converter nil)
 349 (defvar mime::preview/article-buffer nil)
 350
 351 (make-variable-buffer-local 'mime::article/content-info)
 352 (make-variable-buffer-local 'mime::article/preview-buffer)
 353 (make-variable-buffer-local 'mime::article/code-converter)
 354
 355 (make-variable-buffer-local 'mime::preview/mother-buffer)
 356 (make-variable-buffer-local 'mime::preview/content-list)
 357 (make-variable-buffer-local 'mime::preview/article-buffer)
 358 (make-variable-buffer-local 'mime::preview/original-major-mode)
 359 (make-variable-buffer-local 'mime::preview/original-window-configuration)
 360
 361
 362 ;;; @@ quitting method
 363 ;;;
 364
 365 (defvar mime-view-quitting-method-alist
 366   '((mime/show-message-mode
 367      . mime-view-quitting-method-for-mime/show-message-mode)))
 368
 369 (defvar mime-view-over-to-previous-method-alist nil)
 370 (defvar mime-view-over-to-next-method-alist nil)
 371
 372 (defvar mime-view-show-summary-method nil)
 373
 374
 375 ;;; @@ following method
 376 ;;;
 377
 378 (defvar mime-view-following-method-alist nil)
 379
 380 (defvar mime-view-following-required-fields-list
 381   '("From"))
 382
 383
 384 ;;; @@ X-Face
 385 ;;;
 386
 387 ;; hack from Gnus 5.0.4.
 388
 389 (defvar mime-view-x-face-to-pbm-command
 390   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 391
 392 (defvar mime-view-x-face-command
 393   (concat mime-view-x-face-to-pbm-command
 394           " | xv -quit -")
 395   "String to be executed to display an X-Face field.
 396 The command will be executed in a sub-shell asynchronously.
 397 The compressed face will be piped to this command.")
 398
 399 (defun mime-view-x-face-function ()
 400   "Function to display X-Face field. You can redefine to customize."
 401   ;; 1995/10/12 (c.f. tm-eng:130)
 402   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 403   (save-restriction
 404     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 405     ;; end
 406     (goto-char (point-min))
 407     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 408         (let ((beg (match-end 0))
 409               (end (std11-field-end))
 410               )
 411           (call-process-region beg end "sh" nil 0 nil
 412                                "-c" mime-view-x-face-command)
 413           ))))
 414
 415
 416 ;;; @@ utility
 417 ;;;
 418
 419 (defun mime-preview/get-original-major-mode ()
 420   (if mime::preview/mother-buffer
 421       (save-excursion
 422         (set-buffer mime::preview/mother-buffer)
 423         (mime-preview/get-original-major-mode)
 424         )
 425     mime::preview/original-major-mode))
 426
 427
 428 ;;; @ data structures
 429 ;;;
 430
 431 ;;; @@ preview-content-info
 432 ;;;
 433
 434 (define-structure mime::preview-content-info
 435   point-min point-max buffer content-info)
 436
 437
 438 ;;; @ buffer setup
 439 ;;;
 440
 441 (defun mime-view-setup-buffer (&optional ctl encoding ibuf obuf)
 442   (if ibuf
 443       (progn
 444         (get-buffer ibuf)
 445         (set-buffer ibuf)
 446         ))
 447   (or mime-view-redisplay
 448       (setq mime::article/content-info (mime-parse-message ctl encoding))
 449       )
 450   (let ((ret (mime-view-make-preview-buffer obuf)))
 451     (setq mime::article/preview-buffer (car ret))
 452     ret))
 453
 454 (defun mime-view-make-preview-buffer (&optional obuf)
 455   (let* ((cinfo mime::article/content-info)
 456          (pcl (mime/flatten-content-info cinfo))
 457          (dest (make-list (length pcl) nil))
 458          (the-buf (current-buffer))
 459          (mode major-mode)
 460          )
 461     (or obuf
 462         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
 463     (set-buffer (get-buffer-create obuf))
 464     (setq buffer-read-only nil)
 465     (widen)
 466     (erase-buffer)
 467     (setq mime::preview/article-buffer the-buf)
 468     (setq mime::preview/original-major-mode mode)
 469     (setq major-mode 'mime-view-mode)
 470     (setq mode-name "MIME-View")
 471     (let ((drest dest))
 472       (while pcl
 473         (setcar drest
 474                 (mime-preview/display-content (car pcl) cinfo the-buf obuf))
 475         (setq pcl (cdr pcl)
 476               drest (cdr drest))
 477         ))
 478     (set-buffer-modified-p nil)
 479     (setq buffer-read-only t)
 480     (set-buffer the-buf)
 481     (list obuf dest)
 482     ))
 483
 484 (defun mime-preview/display-content (content cinfo ibuf obuf)
 485   (let* ((beg (mime::content-info/point-min content))
 486          (end (mime::content-info/point-max content))
 487          (ctype (mime::content-info/type content))
 488          (params (mime::content-info/parameters content))
 489          (encoding (mime::content-info/encoding content))
 490          (rcnum (mime::content-info/rcnum content))
 491          he e nb ne subj)
 492     (set-buffer ibuf)
 493     (goto-char beg)
 494     (setq he (if (re-search-forward "^$" nil t)
 495                  (1+ (match-end 0))
 496                end))
 497     (if (> he end)
 498         (setq he end)
 499       )
 500     (save-restriction
 501       (narrow-to-region beg end)
 502       (setq subj
 503             (eword-decode-string
 504              (mime-article/get-subject params encoding)))
 505       )
 506     (set-buffer obuf)
 507     (setq nb (point))
 508     (narrow-to-region nb nb)
 509     (funcall mime-preview/content-button-function
 510              rcnum cinfo ctype params subj encoding)
 511     (if (mime-view-header-visible-p rcnum cinfo ctype)
 512         (mime-preview/display-header beg he)
 513       )
 514     (if (and (null rcnum)
 515              (member
 516               ctype mime-view-content-button-visible-ctype-list))
 517         (save-excursion
 518           (goto-char (point-max))
 519           (mime-preview/insert-content-button
 520            rcnum cinfo ctype params subj encoding)
 521           ))
 522     (cond ((mime-view-body-visible-p rcnum cinfo ctype)
 523            (mime-preview/display-body he end
 524                                       rcnum cinfo ctype params subj encoding)
 525            )
 526           ((equal ctype "message/partial")
 527            (mime-preview/display-message/partial)
 528            )
 529           ((and (null rcnum)
 530                 (null (mime::content-info/children cinfo))
 531                 )
 532            (goto-char (point-max))
 533            (mime-preview/insert-content-button
 534             rcnum cinfo ctype params subj encoding)
 535            ))
 536     (mime-preview/default-content-separator rcnum cinfo ctype params subj)
 537     (prog1
 538         (progn
 539           (setq ne (point-max))
 540           (widen)
 541           (mime::preview-content-info/create nb (1- ne) ibuf content)
 542           )
 543       (goto-char ne)
 544       )))
 545
 546 (defun mime-preview/display-header (beg end)
 547   (save-restriction
 548     (narrow-to-region (point)(point))
 549     (insert-buffer-substring mime::preview/article-buffer beg end)
 550     (let ((f (cdr (assq mime::preview/original-major-mode
 551                         mime-view-content-header-filter-alist))))
 552       (if (functionp f)
 553           (funcall f)
 554         (mime-view-default-content-header-filter)
 555         ))
 556     (run-hooks 'mime-view-content-header-filter-hook)
 557     ))
 558
 559 (defun mime-preview/display-body (beg end
 560                                       rcnum cinfo ctype params subj encoding)
 561   (save-restriction
 562     (narrow-to-region (point-max)(point-max))
 563     (insert-buffer-substring mime::preview/article-buffer beg end)
 564     (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist)
 565                       (assq t mime-view-content-filter-alist)))))
 566       (and (functionp f)
 567            (funcall f ctype params encoding)
 568            )
 569       )))
 570
 571 (defun mime-preview/display-message/partial ()
 572   (save-restriction
 573     (goto-char (point-max))
 574     (if (not (search-backward "\n\n" nil t))
 575         (insert "\n")
 576       )
 577     (let ((be (point-max)))
 578       (narrow-to-region be be)
 579       (insert mime-view-announcement-for-message/partial)
 580       (mime-add-button (point-min)(point-max)
 581                        (function mime-view-play-content))
 582       )))
 583
 584 (defun mime-article/get-uu-filename (param &optional encoding)
 585   (if (member (or encoding
 586                   (cdr (assq 'encoding param))
 587                   )
 588               mime-view-uuencode-encoding-name-list)
 589       (save-excursion
 590         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 591                 (if (looking-at ".+$")
 592                     (buffer-substring (match-beginning 0)(match-end 0))
 593                   ))
 594             ""))
 595     ))
 596
 597 (defun mime-article/get-subject (param &optional encoding)
 598   (or (std11-find-field-body '("Content-Description" "Subject"))
 599       (let (ret)
 600         (if (or (and (setq ret (mime/Content-Disposition))
 601                      (setq ret (assoc "filename" (cdr ret)))
 602                      )
 603                 (setq ret (assoc "name" param))
 604                 (setq ret (assoc "x-name" param))
 605                 )
 606             (std11-strip-quoted-string (cdr ret))
 607           ))
 608       (mime-article/get-uu-filename param encoding)
 609       ""))
 610
 611
 612 ;;; @ content information
 613 ;;;
 614
 615 (defun mime-article/point-content-number (p &optional cinfo)
 616   (or cinfo
 617       (setq cinfo mime::article/content-info)
 618       )
 619   (let ((b (mime::content-info/point-min cinfo))
 620         (e (mime::content-info/point-max cinfo))
 621         (c (mime::content-info/children cinfo))
 622         )
 623     (if (and (<= b p)(<= p e))
 624         (or (let (co ret (sn 0))
 625               (catch 'tag
 626                 (while c
 627                   (setq co (car c))
 628                   (setq ret (mime-article/point-content-number p co))
 629                   (cond ((eq ret t) (throw 'tag (list sn)))
 630                         (ret (throw 'tag (cons sn ret)))
 631                         )
 632                   (setq c (cdr c))
 633                   (setq sn (1+ sn))
 634                   )))
 635             t))))
 636
 637 (defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
 638   (or cinfo
 639       (setq cinfo mime::article/content-info)
 640       )
 641   (find-if (function
 642             (lambda (ci)
 643               (equal (mime::content-info/rcnum ci) rcnum)
 644               ))
 645            (mime/flatten-content-info cinfo)
 646            ))
 647
 648 (defun mime-article/cnum-to-cinfo (cn &optional cinfo)
 649   (or cinfo
 650       (setq cinfo mime::article/content-info)
 651       )
 652   (if (eq cn t)
 653       cinfo
 654     (let ((sn (car cn)))
 655       (if (null sn)
 656           cinfo
 657         (let ((rc (nth sn (mime::content-info/children cinfo))))
 658           (if rc
 659               (mime-article/cnum-to-cinfo (cdr cn) rc)
 660             ))
 661         ))))
 662
 663 (defun mime/flatten-content-info (&optional cinfo)
 664   (or cinfo
 665       (setq cinfo mime::article/content-info)
 666       )
 667   (let ((dest (list cinfo))
 668         (rcl (mime::content-info/children cinfo))
 669         )
 670     (while rcl
 671       (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
 672       (setq rcl (cdr rcl))
 673       )
 674     dest))
 675
 676 (defun mime-preview/point-pcinfo (p &optional pcl)
 677   (or pcl
 678       (setq pcl mime::preview/content-list)
 679       )
 680   (catch 'tag
 681     (let ((r pcl) cell)
 682       (while r
 683         (setq cell (car r))
 684         (if (and (<= (mime::preview-content-info/point-min cell) p)
 685                  (<= p (mime::preview-content-info/point-max cell))
 686                  )
 687             (throw 'tag cell)
 688           )
 689         (setq r (cdr r))
 690         ))
 691     (car (last pcl))
 692     ))
 693
 694
 695 ;;; @ MIME viewer mode
 696 ;;;
 697
 698 (defconst mime-view-menu-title "MIME-View")
 699 (defconst mime-view-menu-list
 700   '((up          "Move to upper content"      mime-view-up-content)
 701     (previous    "Move to previous content"   mime-view-previous-content)
 702     (next        "Move to next content"       mime-view-next-content)
 703     (scroll-down "Scroll to previous content" mime-view-scroll-down-content)
 704     (scroll-up   "Scroll to next content"     mime-view-scroll-up-content)
 705     (play        "Play Content"               mime-view-play-content)
 706     (extract     "Extract Content"            mime-view-extract-content)
 707     (print       "Print"                      mime-view-print-content)
 708     (x-face      "Show X Face"                mime-view-display-x-face)
 709     )
 710   "Menu for MIME Viewer")
 711
 712 (if running-xemacs
 713     (progn
 714       (defvar mime-view-xemacs-popup-menu
 715         (cons mime-view-menu-title
 716               (mapcar (function
 717                        (lambda (item)
 718                          (vector (nth 1 item)(nth 2 item) t)
 719                          ))
 720                       mime-view-menu-list)))
 721       (defun mime-view-xemacs-popup-menu (event)
 722         "Popup the menu in the MIME Viewer buffer"
 723         (interactive "e")
 724         (select-window (event-window event))
 725         (set-buffer (event-buffer event))
 726         (popup-menu 'mime-view-xemacs-popup-menu))
 727       ))
 728
 729 (defun mime-view-define-keymap (&optional default)
 730   (let ((mime-view-mode-map (if (keymapp default)
 731                                 (copy-keymap default)
 732                               (make-sparse-keymap)
 733                               )))
 734     (define-key mime-view-mode-map
 735       "u"        (function mime-view-up-content))
 736     (define-key mime-view-mode-map
 737       "p"        (function mime-view-previous-content))
 738     (define-key mime-view-mode-map
 739       "n"        (function mime-view-next-content))
 740     (define-key mime-view-mode-map
 741       "\e\t"     (function mime-view-previous-content))
 742     (define-key mime-view-mode-map
 743       "\t"       (function mime-view-next-content))
 744     (define-key mime-view-mode-map
 745       " "        (function mime-view-scroll-up-content))
 746     (define-key mime-view-mode-map
 747       "\M- "     (function mime-view-scroll-down-content))
 748     (define-key mime-view-mode-map
 749       "\177"     (function mime-view-scroll-down-content))
 750     (define-key mime-view-mode-map
 751       "\C-m"     (function mime-view-next-line-content))
 752     (define-key mime-view-mode-map
 753       "\C-\M-m"  (function mime-view-previous-line-content))
 754     (define-key mime-view-mode-map
 755       "v"        (function mime-view-play-content))
 756     (define-key mime-view-mode-map
 757       "e"        (function mime-view-extract-content))
 758     (define-key mime-view-mode-map
 759       "\C-c\C-p" (function mime-view-print-content))
 760     (define-key mime-view-mode-map
 761       "a"        (function mime-view-follow-content))
 762     (define-key mime-view-mode-map
 763       "q"        (function mime-view-quit))
 764     (define-key mime-view-mode-map
 765       "h"        (function mime-view-show-summary))
 766     (define-key mime-view-mode-map
 767       "\C-c\C-x" (function mime-view-kill-buffer))
 768     (define-key mime-view-mode-map
 769       "<"        (function beginning-of-buffer))
 770     (define-key mime-view-mode-map
 771       ">"        (function end-of-buffer))
 772     (define-key mime-view-mode-map
 773       "?"        (function describe-mode))
 774     (if (functionp default)
 775         (setq mime-view-mode-map
 776               (append mime-view-mode-map (list (cons t default)))
 777               ))
 778     (if mouse-button-2
 779         (define-key mime-view-mode-map
 780           mouse-button-2 (function mime-button-dispatcher))
 781       )
 782     (cond (running-xemacs
 783            (define-key mime-view-mode-map
 784              mouse-button-3 (function mime-view-xemacs-popup-menu))
 785            )
 786           ((>= emacs-major-version 19)
 787            (define-key mime-view-mode-map [menu-bar mime-view]
 788              (cons mime-view-menu-title
 789                    (make-sparse-keymap mime-view-menu-title)))
 790            (mapcar (function
 791                     (lambda (item)
 792                       (define-key mime-view-mode-map
 793                         (vector 'menu-bar 'mime-view (car item))
 794                         (cons (nth 1 item)(nth 2 item))
 795                         )
 796                       ))
 797                    (reverse mime-view-menu-list)
 798                    )
 799            ))
 800     (use-local-map mime-view-mode-map)
 801     (run-hooks 'mime-view-define-keymap-hook)
 802     ))
 803
 804 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
 805                                  default-keymap-or-function)
 806   "Major mode for viewing MIME message.
 807
 808 Here is a list of the standard keys for mime-view-mode.
 809
 810 key             feature
 811 ---             -------
 812
 813 u               Move to upper content
 814 p or M-TAB      Move to previous content
 815 n or TAB        Move to next content
 816 SPC             Scroll up or move to next content
 817 M-SPC or DEL    Scroll down or move to previous content
 818 RET             Move to next line
 819 M-RET           Move to previous line
 820 v               Decode current content as `play mode'
 821 e               Decode current content as `extract mode'
 822 C-c C-p         Decode current content as `print mode'
 823 a               Followup to current content.
 824 x               Display X-Face
 825 q               Quit
 826 button-2        Move to point under the mouse cursor
 827                 and decode current content as `play mode'
 828 "
 829   (interactive)
 830   (let ((buf (get-buffer mime/output-buffer-name)))
 831     (if buf
 832         (save-excursion
 833           (set-buffer buf)
 834           (erase-buffer)
 835           )))
 836   (let ((ret (mime-view-setup-buffer ctl encoding ibuf obuf))
 837         (win-conf (current-window-configuration))
 838         )
 839     (prog1
 840         (switch-to-buffer (car ret))
 841       (setq mime::preview/original-window-configuration win-conf)
 842       (if mother
 843           (progn
 844             (setq mime::preview/mother-buffer mother)
 845             ))
 846       (mime-view-define-keymap default-keymap-or-function)
 847       (setq mime::preview/content-list (nth 1 ret))
 848       (goto-char
 849        (let ((ce (mime::preview-content-info/point-max
 850                   (car mime::preview/content-list)
 851                   ))
 852              e)
 853          (goto-char (point-min))
 854          (search-forward "\n\n" nil t)
 855          (setq e (match-end 0))
 856          (if (<= e ce)
 857              e
 858            ce)))
 859       (run-hooks 'mime-view-mode-hook)
 860       )))
 861
 862 (defun mime-preview/point-content-number (point)
 863   (save-window-excursion
 864     (let ((pc (mime-preview/point-pcinfo (point)))
 865           cinfo)
 866       (switch-to-buffer (mime::preview-content-info/buffer pc))
 867       (setq cinfo (mime::preview-content-info/content-info pc))
 868       (mime-article/point-content-number (mime::content-info/point-min cinfo))
 869       )))
 870
 871 (defun mime-preview/cinfo-to-pcinfo (cinfo)
 872   (let ((rpcl mime::preview/content-list) cell)
 873     (catch 'tag
 874       (while rpcl
 875         (setq cell (car rpcl))
 876         (if (eq cinfo (mime::preview-content-info/content-info cell))
 877             (throw 'tag cell)
 878           )
 879         (setq rpcl (cdr rpcl))
 880         ))))
 881
 882 (autoload 'mime-preview/decode-content "mime-play")
 883
 884 (defvar mime-view-decoding-mode "play" "MIME body decoding mode")
 885
 886 (defun mime-view-play-content ()
 887   (interactive)
 888   (let ((mime-view-decoding-mode "play"))
 889     (mime-preview/decode-content)
 890     ))
 891
 892 (defun mime-view-extract-content ()
 893   (interactive)
 894   (let ((mime-view-decoding-mode "extract"))
 895     (mime-preview/decode-content)
 896     ))
 897
 898 (defun mime-view-print-content ()
 899   (interactive)
 900   (let ((mime-view-decoding-mode "print"))
 901     (mime-preview/decode-content)
 902     ))
 903
 904 (defun mime-view-follow-content ()
 905   (interactive)
 906   (let ((root-cinfo
 907          (mime::preview-content-info/content-info
 908           (car mime::preview/content-list)))
 909         pc p-beg p-end cinfo rcnum)
 910     (let ((rest mime::preview/content-list)
 911           b e cell len rc)
 912       (if (catch 'tag
 913             (while (setq cell (car rest))
 914               (setq b (mime::preview-content-info/point-min cell)
 915                     e (mime::preview-content-info/point-max cell))
 916               (setq rest (cdr rest))
 917               (if (and (<= b (point))(<= (point) e))
 918                   (throw 'tag cell)
 919                 )
 920               ))
 921           (progn
 922             (setq pc cell
 923                   cinfo (mime::preview-content-info/content-info pc)
 924                   rcnum (mime::content-info/rcnum cinfo))
 925             (setq len (length rcnum))
 926             (setq p-beg (mime::preview-content-info/point-min pc)
 927                   p-end (mime::preview-content-info/point-max pc))
 928             (while (and (setq cell (car rest))
 929                         (progn
 930                           (setq rc
 931                                 (mime::content-info/rcnum
 932                                  (mime::preview-content-info/content-info
 933                                   cell)))
 934                           (equal rcnum
 935                                  (nthcdr (- (length rc) len) rc))
 936                           ))
 937               (setq p-end (mime::preview-content-info/point-max cell))
 938               (setq rest (cdr rest))
 939               ))))
 940     (if pc
 941         (let* ((mode (mime-preview/get-original-major-mode))
 942                (new-name (format "%s-%s" (buffer-name) (reverse rcnum)))
 943                new-buf
 944                (the-buf (current-buffer))
 945                (a-buf mime::preview/article-buffer)
 946                (hb (mime::content-info/point-min cinfo))
 947                (he (mime::content-info/point-max cinfo))
 948                fields from to cc reply-to subj mid f)
 949           (save-excursion
 950             (set-buffer (setq new-buf (get-buffer-create new-name)))
 951             (erase-buffer)
 952             (insert-buffer-substring the-buf p-beg p-end)
 953             (goto-char (point-min))
 954             (if (mime-view-header-visible-p rcnum root-cinfo)
 955                 (delete-region (goto-char (point-min))
 956                                (if (re-search-forward "^$" nil t)
 957                                    (match-end 0)
 958                                  (point-min)))
 959               )
 960             (goto-char (point-min))
 961             (insert "\n")
 962             (goto-char (point-min))
 963             (let ((rcnum (mime::content-info/rcnum cinfo)) ci str)
 964               (while (progn
 965                        (setq str
 966                              (save-excursion
 967                                (set-buffer a-buf)
 968                                (setq ci (mime-article/rcnum-to-cinfo rcnum))
 969                                (save-restriction
 970                                  (narrow-to-region
 971                                   (mime::content-info/point-min ci)
 972                                   (mime::content-info/point-max ci)
 973                                   )
 974                                  (std11-header-string-except
 975                                   (concat "^"
 976                                           (apply (function regexp-or) fields)
 977                                           ":") ""))))
 978                        (if (string-equal (mime::content-info/type ci)
 979                                          "message/rfc822")
 980                            nil
 981                          (if str
 982                              (insert str)
 983                            )
 984                          rcnum))
 985                 (setq fields (std11-collect-field-names)
 986                       rcnum (cdr rcnum))
 987                 )
 988               )
 989             (let ((rest mime-view-following-required-fields-list))
 990               (while rest
 991                 (let ((field-name (car rest)))
 992                   (or (std11-field-body field-name)
 993                       (insert
 994                        (format
 995                         (concat field-name
 996                                 ": "
 997                                 (save-excursion
 998                                   (set-buffer the-buf)
 999                                   (set-buffer mime::preview/mother-buffer)
1000                                   (set-buffer mime::preview/article-buffer)
1001                                   (std11-field-body field-name)
1002                                   )
1003                                 "\n")))
1004                       ))
1005                 (setq rest (cdr rest))
1006                 ))
1007             (eword-decode-header)
1008             )
1009           (let ((f (cdr (assq mode mime-view-following-method-alist))))
1010             (if (functionp f)
1011                 (funcall f new-buf)
1012               (message
1013                (format
1014                 "Sorry, following method for %s is not implemented yet."
1015                 mode))
1016               ))
1017           ))))
1018
1019 (defun mime-view-display-x-face ()
1020   (interactive)
1021   (save-window-excursion
1022     (set-buffer mime::preview/article-buffer)
1023     (mime-view-x-face-function)
1024     ))
1025
1026 (defun mime-view-up-content ()
1027   (interactive)
1028   (let* ((pc (mime-preview/point-pcinfo (point)))
1029          (cinfo (mime::preview-content-info/content-info pc))
1030          (rcnum (mime::content-info/rcnum cinfo))
1031          )
1032     (if rcnum
1033         (let ((r (save-excursion
1034                    (set-buffer (mime::preview-content-info/buffer pc))
1035                    (mime-article/rcnum-to-cinfo (cdr rcnum))
1036                    ))
1037               (rpcl mime::preview/content-list)
1038               cell)
1039           (while (and
1040                   (setq cell (car rpcl))
1041                   (not (eq r (mime::preview-content-info/content-info cell)))
1042                   )
1043             (setq rpcl (cdr rpcl))
1044             )
1045           (goto-char (mime::preview-content-info/point-min cell))
1046           )
1047       (mime-view-quit)
1048       )))
1049
1050 (defun mime-view-previous-content ()
1051   (interactive)
1052   (let* ((pcl mime::preview/content-list)
1053          (p (point))
1054          (i (- (length pcl) 1))
1055          beg)
1056     (catch 'tag
1057       (while (> i 0)
1058         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
1059         (if (> p beg)
1060             (throw 'tag (goto-char beg))
1061           )
1062         (setq i (- i 1))
1063         )
1064       (let ((f (assq mime::preview/original-major-mode
1065                      mime-view-over-to-previous-method-alist)))
1066         (if f
1067             (funcall (cdr f))
1068           ))
1069       )
1070     ))
1071
1072 (defun mime-view-next-content ()
1073   (interactive)
1074   (let ((pcl mime::preview/content-list)
1075         (p (point))
1076         beg)
1077     (catch 'tag
1078       (while pcl
1079         (setq beg (mime::preview-content-info/point-min (car pcl)))
1080         (if (< p beg)
1081             (throw 'tag (goto-char beg))
1082           )
1083         (setq pcl (cdr pcl))
1084         )
1085       (let ((f (assq mime::preview/original-major-mode
1086                      mime-view-over-to-next-method-alist)))
1087         (if f
1088             (funcall (cdr f))
1089           ))
1090       )
1091     ))
1092
1093 (defun mime-view-scroll-up-content (&optional h)
1094   (interactive)
1095   (or h
1096       (setq h (- (window-height) 1))
1097       )
1098   (if (= (point) (point-max))
1099       (let ((f (assq mime::preview/original-major-mode
1100                      mime-view-over-to-next-method-alist)))
1101         (if f
1102             (funcall (cdr f))
1103           ))
1104     (let ((pcl mime::preview/content-list)
1105           (p (point))
1106           np beg)
1107       (setq np
1108             (or (catch 'tag
1109                   (while pcl
1110                     (setq beg (mime::preview-content-info/point-min (car pcl)))
1111                     (if (< p beg)
1112                         (throw 'tag beg)
1113                       )
1114                     (setq pcl (cdr pcl))
1115                     ))
1116                 (point-max)))
1117       (forward-line h)
1118       (if (> (point) np)
1119           (goto-char np)
1120         )
1121       ;;(show-subtree)
1122       ))
1123   )
1124
1125 (defun mime-view-scroll-down-content (&optional h)
1126   (interactive)
1127   (or h
1128       (setq h (- (window-height) 1))
1129       )
1130   (if (= (point) (point-min))
1131       (let ((f (assq mime::preview/original-major-mode
1132                      mime-view-over-to-previous-method-alist)))
1133         (if f
1134             (funcall (cdr f))
1135           ))
1136     (let ((pcl mime::preview/content-list)
1137           (p (point))
1138           pp beg)
1139       (setq pp
1140             (or (let ((i (- (length pcl) 1)))
1141                   (catch 'tag
1142                     (while (> i 0)
1143                       (setq beg (mime::preview-content-info/point-min
1144                                  (nth i pcl)))
1145                       (if (> p beg)
1146                           (throw 'tag beg)
1147                         )
1148                       (setq i (- i 1))
1149                       )))
1150                 (point-min)))
1151       (forward-line (- h))
1152       (if (< (point) pp)
1153           (goto-char pp)
1154         )))
1155   )
1156
1157 (defun mime-view-next-line-content ()
1158   (interactive)
1159   (mime-view-scroll-up-content 1)
1160   )
1161
1162 (defun mime-view-previous-line-content ()
1163   (interactive)
1164   (mime-view-scroll-down-content 1)
1165   )
1166
1167 (defun mime-view-quit ()
1168   (interactive)
1169   (let ((r (save-excursion
1170              (set-buffer (mime::preview-content-info/buffer
1171                           (mime-preview/point-pcinfo (point))))
1172              (assq major-mode mime-view-quitting-method-alist)
1173              )))
1174     (if r
1175         (funcall (cdr r))
1176       )))
1177
1178 (defun mime-view-show-summary ()
1179   (interactive)
1180   (let ((r (save-excursion
1181              (set-buffer
1182               (mime::preview-content-info/buffer
1183                (mime-preview/point-pcinfo (point)))
1184               )
1185              (assq major-mode mime-view-show-summary-method)
1186              )))
1187     (if r
1188         (funcall (cdr r))
1189       )))
1190
1191 (defun mime-view-kill-buffer ()
1192   (interactive)
1193   (kill-buffer (current-buffer))
1194   )
1195
1196
1197 ;;; @ end
1198 ;;;
1199
1200 (provide 'mime-view)
1201
1202 (run-hooks 'mime-view-load-hook)
1203
1204 ;;; mime-view.el ends here