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