X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=a80307001bbdd58434d98e9ce52e7e4ddcbaae4f;hb=a13edb88d69c44f332531b07fd5e8f18dd33c6aa;hp=360885766105a1d68823d06a06c2d7db0da02029;hpb=fd310bdea0a8461608216542b62748aa34e87918;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 3608857..a803070 100644 --- a/mime-view.el +++ b/mime-view.el @@ -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)