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