(mime-view-move-to-previous): New implementation.
[elisp/semi.git] / mime-view.el
index 3608857..a803070 100644 (file)
@@ -6,7 +6,7 @@
 ;; Created: 1994/7/13
 ;;     Renamed: 1994/8/31 from tm-body.el
 ;;     Renamed: 1997/02/19 from tm-view.el
-;; Version: $Revision: 0.47 $
+;; Version: $Revision: 0.56 $
 ;; Keywords: MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
@@ -40,7 +40,7 @@
 ;;;
 
 (defconst mime-view-RCS-ID
-  "$Id: mime-view.el,v 0.47 1997-03-17 13:59:03 morioka Exp $")
+  "$Id: mime-view.el,v 0.56 1997-03-17 15:59:51 morioka Exp $")
 
 (defconst mime-view-version (get-version-string mime-view-RCS-ID))
 
@@ -167,15 +167,9 @@ Each elements are regexp of field-name. [mime-view.el]")
          (apply (function regexp-or) mime-view-ignored-field-list)
          ":"))
 
-(defvar mime-view-visible-field-list
-  '("Dnas.*" "Message-Id")
+(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
   "All fields that match this list will be displayed in MIME preview buffer.
-Each elements are regexp of field-name. [mime-view.el]")
-
-(defvar mime-view-visible-field-regexp
-  (concat "^"
-         (apply (function regexp-or) mime-view-visible-field-list)
-         ":"))
+Each elements are regexp of field-name.")
 
 (defvar mime-view-redisplay nil)
 
@@ -290,28 +284,25 @@ Please redefine this function if you want to change default setting."
 ;;; @@ content header filter
 ;;;
 
-(defun mime-preview/cut-header ()
+(defsubst mime-view-cut-header ()
   (goto-char (point-min))
-  (while (and
-         (re-search-forward mime-view-ignored-field-regexp nil t)
-         (let* ((beg (match-beginning 0))
-                (end (match-end 0))
-                (name (buffer-substring beg end))
-                )
-           (if (not (string-match mime-view-visible-field-regexp name))
-               (delete-region
-                beg
-                (save-excursion
-                  (and
-                   (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
-                   (match-beginning 0)
-                   )))
-             )
-           t)))
-  )
+  (while (re-search-forward mime-view-ignored-field-regexp nil t)
+    (let* ((beg (match-beginning 0))
+          (end (match-end 0))
+          (name (buffer-substring beg end))
+          )
+      (or (member-if (function
+                     (lambda (regexp)
+                       (string-match regexp name)
+                       )) mime-view-visible-field-list)
+         (delete-region beg
+                        (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
+                            (match-beginning 0)
+                          (point-max)))
+         ))))
 
 (defun mime-view-default-content-header-filter ()
-  (mime-preview/cut-header)
+  (mime-view-cut-header)
   (eword-decode-header)
   )
 
@@ -371,8 +362,9 @@ Please redefine this function if you want to change default setting."
 ;;;
 
 (defvar mime-view-quitting-method-alist
-  '((mime/show-message-mode
-     . mime-view-quitting-method-for-mime/show-message-mode)))
+  '((mime-show-message-mode
+     . mime-view-quitting-method-for-mime-show-message-mode))
+  "Alist of major-mode vs. quitting-method of mime-view.")
 
 (defvar mime-view-over-to-previous-method-alist nil)
 (defvar mime-view-over-to-next-method-alist nil)
@@ -479,7 +471,7 @@ The compressed face will be piped to this command.")
     (let ((drest dest))
       (while pcl
        (setcar drest
-               (mime-preview/display-content (car pcl) cinfo the-buf obuf))
+               (mime-view-display-entity (car pcl) cinfo the-buf obuf))
        (setq pcl (cdr pcl)
              drest (cdr drest))
        ))
@@ -489,7 +481,8 @@ The compressed face will be piped to this command.")
     (list obuf dest)
     ))
 
-(defun mime-preview/display-content (content cinfo ibuf obuf)
+(defun mime-view-display-entity (content cinfo ibuf obuf)
+  "Display entity from content-info CONTENT."
   (let* ((beg (mime::content-info/point-min content))
         (end (mime::content-info/point-max content))
         (ctype (mime::content-info/type content))
@@ -545,6 +538,8 @@ The compressed face will be piped to this command.")
        (progn
          (setq ne (point-max))
          (widen)
+         (put-text-property nb ne 'mime-view-raw-buffer ibuf)
+         (put-text-property nb ne 'mime-view-cinfo content)
          (mime::preview-content-info/create nb (1- ne) ibuf content)
          )
       (goto-char ne)
@@ -704,8 +699,8 @@ The compressed face will be piped to this command.")
 
 (defconst mime-view-menu-title "MIME-View")
 (defconst mime-view-menu-list
-  '((up                 "Move to upper content"      mime-view-up-content)
-    (previous   "Move to previous content"   mime-view-previous-content)
+  '((up                 "Move to upper content"      mime-view-move-to-upper)
+    (previous   "Move to previous content"   mime-view-move-to-previous)
     (next       "Move to next content"       mime-view-next-content)
     (scroll-down "Scroll to previous content" mime-view-scroll-down-content)
     (scroll-up  "Scroll to next content"     mime-view-scroll-up-content)
@@ -742,13 +737,13 @@ The compressed face will be piped to this command.")
                              (make-sparse-keymap)
                              )))
     (define-key mime-view-mode-map
-      "u"        (function mime-view-up-content))
+      "u"        (function mime-view-move-to-upper))
     (define-key mime-view-mode-map
-      "p"        (function mime-view-previous-content))
+      "p"        (function mime-view-move-to-previous))
     (define-key mime-view-mode-map
       "n"        (function mime-view-next-content))
     (define-key mime-view-mode-map
-      "\e\t"     (function mime-view-previous-content))
+      "\e\t"     (function mime-view-move-to-previous))
     (define-key mime-view-mode-map
       "\t"       (function mime-view-next-content))
     (define-key mime-view-mode-map
@@ -1029,51 +1024,46 @@ It decodes current entity to call internal or external method as
     (mime-view-x-face-function)
     ))
 
-(defun mime-view-up-content ()
+(defun mime-view-move-to-upper ()
+  "Move to upper entity.
+If there is no upper entity, call function `mime-view-quit'."
   (interactive)
-  (let* ((pc (mime-preview/point-pcinfo (point)))
-        (cinfo (mime::preview-content-info/content-info pc))
-        (rcnum (mime::content-info/rcnum cinfo))
-        )
-    (if rcnum
-       (let ((r (save-excursion
-                  (set-buffer (mime::preview-content-info/buffer pc))
-                   (mime-article/rcnum-to-cinfo (cdr rcnum))
-                  ))
-             (rpcl mime::preview/content-list)
-             cell)
-         (while (and
-                 (setq cell (car rpcl))
-                 (not (eq r (mime::preview-content-info/content-info cell)))
-                 )
-           (setq rpcl (cdr rpcl))
+  (let (cinfo)
+    (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo)))
+      (backward-char)
+      )
+    (let ((r (mime-article/rcnum-to-cinfo
+             (cdr (mime::content-info/rcnum cinfo))
+             (get-text-property 1 'mime-view-cinfo)))
+         point)
+      (catch 'tag
+       (while (setq point (previous-single-property-change
+                           (point) 'mime-view-cinfo))
+         (goto-char point)
+         (if (eq r (get-text-property (point) 'mime-view-cinfo))
+             (throw 'tag t)
            )
-         (goto-char (mime::preview-content-info/point-min cell))
          )
-      (mime-view-quit)
-      )))
+       (mime-view-quit)
+       ))))
 
-(defun mime-view-previous-content ()
+(defun mime-view-move-to-previous ()
+  "Move to previous entity.
+If there is no previous entity, it calls function registered in
+variable `mime-view-over-to-previous-method-alist'."
   (interactive)
-  (let* ((pcl mime::preview/content-list)
-        (p (point))
-        (i (- (length pcl) 1))
-        beg)
-    (catch 'tag
-      (while (> i 0)
-       (setq beg (mime::preview-content-info/point-min (nth i pcl)))
-       (if (> p beg)
-           (throw 'tag (goto-char beg))
-         )
-       (setq i (- i 1))
-       )
+  (while (null (get-text-property (point) 'mime-view-cinfo))
+    (backward-char)
+    )
+  (let ((point (previous-single-property-change (point) 'mime-view-cinfo)))
+    (if point
+       (goto-char point)
       (let ((f (assq mime::preview/original-major-mode
                     mime-view-over-to-previous-method-alist)))
        (if f
            (funcall (cdr f))
          ))
-      )
-    ))
+      )))
 
 (defun mime-view-next-content ()
   (interactive)