#
PACKAGE = semi
-VERSION = 1.6.0
+VERSION = 1.7.0
SHELL = /bin/sh
MAKE = make
SEMI NEWS --- history of major-changes.
Copyright (C) 1998 Free Software Foundation, Inc.
+* Changes in SEMI 1.7
+
+** Header-presentation-method
+
+ Now MIME-View uses header-presentation-method instead of
+header-filter.
+
+ - abolish variable `mime-view-content-header-filter-alist'
+
+ - abolish function `mime-view-cut-header'
+
+ - Rename `mime-view-content-header-filter-hook' to
+ `mime-display-header-hook'
+
+
+** Abolish `mime-view-ignored-field-regexp'
+
+ Now mime-view uses `mime-view-ignored-field-list' directly in
+default header-presentation-method.
+
+
+** Abolish body filter support
+
+ Please use body-presentation-method.
+
+
+** Methods for MUAs
+
+ - Rename `mime-view-following-method-alist' to
+ `mime-preview-following-method-alist'
+
+ - Rename `mime-method-to-combine-message/partial-pieces' to
+ `mime-combine-message/partial-pieces-automatically'
+
+\f
* Changes in SEMI 1.6
** Abolish tm-compatible external method support
encryption.
+** New method to detect content of entity
+
+ Now MIME-View can detect content of entity for
+application/octet-stream in default setting.
+
+ It uses "file" command to detect. User can customize
+`mime-file-content-type-alist' to specify media-type for output of
+"file" command. It is an alist of "file" output patterns
+vs. corresponding media-types. Each element looks like (REGEXP TYPE
+SUBTYPE). REGEXP is pattern for "file" command output. TYPE is
+symbol to indicate primary type of media-type. SUBTYPE is symbol to
+indicate subtype of media-type.
+
+
** New interface to display message
- Function `mime-view-buffer'
nil. (Maybe non mule setting requires to modify emu. In addition,
it is better to use terminal-coding-system feature)
- SEMI requires APEL (8.7 or later) and FLIM (1.3.0 or later) package.
+ SEMI requires APEL (8.7 or later) and FLIM (1.4.0 or later) package.
Please install them before installing it. APEL package is available
at:
(setq semi-modules-to-compile
'(signature
- semi-def
- mime-parse mime-view mime-text mime-play mime-partial
- mime-edit
+ semi-def mime-view mime-text mime-play mime-partial mime-edit
semi-setup mail-mime-setup))
(setq semi-modules-not-to-compile nil)
;;;
(defconst mime-edit-version-string
- `,(concat (car mime-module-version) " "
- (mapconcat #'number-to-string (cddr mime-module-version) ".")
- " - \"" (cadr mime-module-version) "\""))
+ `,(concat (car mime-user-interface-version) " "
+ (mapconcat #'number-to-string
+ (cddr mime-user-interface-version) ".")
+ " - \"" (cadr mime-user-interface-version) "\""))
;;; @ variables
(highlight-headers (point-min) (re-search-forward "^$" nil t) t)
)
- (add-hook 'mime-view-content-header-filter-hook
+ (add-hook 'mime-display-header-hook
'mime-preview-x-face-function-use-highlight-headers)
)
;; X-Face
;;
(if (exec-installed-p uncompface-program exec-path)
- (add-hook 'mime-view-content-header-filter-hook
+ (add-hook 'mime-display-header-hook
'x-face-decode-message-header)
)
))
'mime-preview-condition
(list (cons 'type type)(cons 'subtype subtype)
'(body . visible)
- '(body-presentation-method . with-filter)
- (cons 'body-filter #'mime-preview-filter-for-image)
+ (cons 'body-presentation-method #'mime-display-image)
(cons 'image-format format))
)))))
'((image jpeg jpeg)
;;;
;; (for XEmacs 19.12 or later)
-(defun mime-preview-filter-for-image (situation)
- (let ((beg (point-min))
- (end (point-max)))
- (remove-text-properties beg end '(face nil))
- (message "Decoding image...")
- (mime-decode-region beg end (cdr (assq 'encoding situation)))
- (let ((gl (image-normalize (cdr (assq 'image-format situation))
- (buffer-string))))
- (delete-region (point-min)(point-max))
- (cond ((image-invalid-glyph-p gl)
- (setq gl nil)
- (message "Invalid glyph!")
- )
- ((eq (aref gl 0) 'xbm)
- (let ((xbm-file
- (make-temp-name
- (expand-file-name "tm" mime-temp-directory))))
+(defun mime-display-image (entity situation)
+ (message "Decoding image...")
+ (let ((gl (image-normalize (cdr (assq 'image-format situation))
+ (with-temp-buffer
+ (insert-buffer-substring
+ (mime-entity-buffer entity)
+ (mime-entity-body-start entity)
+ (mime-entity-body-end entity))
+ (mime-decode-region
+ (point-min)(point-max)
+ (mime-entity-encoding entity))
+ (buffer-string)))))
+ (cond ((image-invalid-glyph-p gl)
+ (setq gl nil)
+ (message "Invalid glyph!")
+ )
+ ((eq (aref gl 0) 'xbm)
+ (let ((xbm-file
+ (make-temp-name
+ (expand-file-name "tm" mime-temp-directory))))
+ (with-temp-buffer
(insert (aref gl 2))
(write-region (point-min)(point-max) xbm-file)
- (message "Decoding image...")
- (delete-region (point-min)(point-max))
- (bitmap-insert-xbm-file xbm-file)
- (delete-file xbm-file)
)
- (message "Decoding image... done")
+ (message "Decoding image...")
+ (bitmap-insert-xbm-file xbm-file)
+ (delete-file xbm-file)
)
- (t
- (setq gl (make-glyph gl))
- (let ((e (make-extent (point) (point))))
- (set-extent-end-glyph e gl)
- )
- (message "Decoding image... done")
- ))
- )
- (insert "\n")
- ))
-
-
-;;; @ content filter for Postscript
-;;;
-;; (for XEmacs 19.14 or later)
-
-;; (defvar mime-view-ps-to-gif-command "pstogif")
-
-;; (defun mime-preview-filter-for-application/postscript (ctype params encoding)
-;; (let* ((beg (point-min)) (end (point-max))
-;; (file-base
-;; (make-temp-name (expand-file-name "tm" mime-temp-directory)))
-;; (ps-file (concat file-base ".ps"))
-;; (gif-file (concat file-base ".gif"))
-;; )
-;; (remove-text-properties beg end '(face nil))
-;; (message "Decoding Postscript...")
-;; (mime-decode-region beg end encoding)
-;; (write-region (point-min)(point-max) ps-file)
-;; (message "Decoding Postscript...")
-;; (delete-region (point-min)(point-max))
-;; (call-process mime-view-ps-to-gif-command nil nil nil ps-file)
-;; (set-extent-end-glyph (make-extent (point) (point))
-;; (make-glyph (vector 'gif :file gif-file)))
-;; (message "Decoding Postscript... done")
-;; (delete-file ps-file)
-;; (delete-file gif-file)
-;; ))
-
-;; If you would like to display inline Postscript image, please
-;; activate following:
-
-;; (set-alist 'mime-view-content-filter-alist
-;; "application/postscript"
-;; (function mime-preview-filter-for-application/postscript))
-
-;; (if (featurep 'gif)
-;; (add-to-list
-;; 'mime-view-visible-media-type-list "application/postscript")
-;; )
+ (message "Decoding image... done")
+ )
+ (t
+ (setq gl (make-glyph gl))
+ (let ((e (make-extent (point) (point))))
+ (set-extent-end-glyph e gl)
+ )
+ (message "Decoding image... done")
+ ))
+ )
+ (insert "\n")
+ )
;;; @ end
(error "Fatal. Unsupported mode")
))))
-(defun mime-method-to-combine-message/partial-pieces (entity cal)
+(defun mime-combine-message/partial-pieces-automatically (entity cal)
"Internal method for mime-view to combine message/partial messages
automatically. This function refers variable
`mime-view-partial-message-method-alist' to select function to display
(if (or (file-exists-p full-file)
(not (y-or-n-p "Merge partials?"))
)
- (mime-method-to-store-message/partial entity cal)
+ (mime-store-message/partial-piece entity cal)
(let (the-id parameters)
(setq subject-id (std11-field-body "Subject"))
(if (string-match "[0-9\n]+" subject-id)
(while t
(mime-view-partial-message target)
(set-buffer article-buffer)
- (setq parameters
- (mime-entity-parameters mime-raw-message-info))
+ (setq parameters (mime-entity-parameters entity))
(setq the-id (cdr (assoc "id" parameters)))
- (if (string= the-id id)
- (progn
- (mime-method-to-store-message/partial
- mime-raw-message-info parameters)
- (if (file-exists-p full-file)
- (throw 'tag nil)
- )
- ))
+ (when (string= the-id id)
+ (mime-store-message/partial-piece entity parameters)
+ (if (file-exists-p full-file)
+ (throw 'tag nil)
+ ))
(if (not (progn
(set-buffer subject-buf)
(end-of-line)
;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
;; expired)
-;; PGP/MIME and PGP-kazu may be contrary to each other. You should
-;; decide which you support (Maybe you should not use PGP-kazu).
-
;;; Code:
(require 'mime-play)
+;;; @ Internal method for multipart/signed
+;;;
+;;; It is based on RFC 1847 (security-multipart).
+
+(defun mime-verify-multipart/signed (entity situation)
+ "Internal method to verify multipart/signed."
+ (mime-raw-play-entity
+ (nth 1 (mime-entity-children entity)) ; entity-info of signature
+ (cdr (assq 'mode situation)) ; play-mode
+ ))
+
+
;;; @ internal method for application/pgp
;;;
;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
-(defun mime-method-for-application/pgp (entity cal)
+(defun mime-view-application/pgp (entity situation)
(let* ((start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
(entity-number (mime-raw-point-to-entity-number start))
))
-;;; @ Internal method for multipart/signed
-;;;
-;;; It is based on RFC 1847 (security-multipart).
-
-(defun mime-method-to-verify-multipart/signed (entity cal)
- "Internal method to verify multipart/signed."
- (mime-raw-play-entity
- (nth 1 (mime-entity-children entity)) ; entity-info of signature
- (cdr (assq 'mode cal)) ; play-mode
- ))
-
-
;;; @ Internal method for application/pgp-signature
;;;
;;; It is based on RFC 2015 (PGP/MIME).
(t "Bad signature")))
))))
-(defun mime-method-to-verify-application/pgp-signature (entity cal)
+(defun mime-verify-application/pgp-signature (entity situation)
"Internal method to check PGP/MIME signature."
(let* ((start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
- (encoding (cdr (assq 'encoding cal)))
+ (encoding (cdr (assq 'encoding situation)))
(entity-node-id (mime-raw-point-to-entity-node-id start))
(mother-node-id (cdr entity-node-id))
(knum (car entity-node-id))
;;;
;;; It is based on RFC 2015 (PGP/MIME).
-(defun mime-method-to-decrypt-application/pgp-encrypted (entity cal)
+(defun mime-decrypt-application/pgp-encrypted (entity situation)
(let* ((entity-node-id (mime-entity-node-id entity))
(mother-node-id (cdr entity-node-id))
(knum (car entity-node-id))
(1+ knum)))
(oinfo (mime-raw-find-entity-from-node-id
(cons onum mother-node-id) mime-raw-message-info)))
- (mime-method-for-application/pgp oinfo cal)
+ (mime-view-application/pgp oinfo situation)
))
;;;
;;; It is based on RFC 2015 (PGP/MIME).
-(defun mime-method-to-add-application/pgp-keys (entity cal)
+(defun mime-add-application/pgp-keys (entity situation)
(let* ((start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
(entity-number (mime-raw-point-to-entity-number start))
(new-name (format "%s-%s" (buffer-name) entity-number))
- (encoding (cdr (assq 'encoding cal)))
+ (encoding (cdr (assq 'encoding situation)))
str)
(setq str (buffer-substring start end))
(switch-to-buffer new-name)
(narrow-to-region start end)
(goto-char start)
(let ((method (cdr (assoc 'method situation)))
- (name (expand-file-name (mime-raw-get-filename situation)
- mime-temp-directory)))
+ (name (mime-entity-safe-filename entity)))
+ (setq name
+ (if name
+ (expand-file-name name mime-temp-directory)
+ (make-temp-name
+ (expand-file-name "EMI" mime-temp-directory))
+ ))
(mime-write-decoded-region (mime-entity-body-start entity) end
name (cdr (assq 'encoding situation)))
(message "External method is starting...")
(remove-alist 'mime-mailcap-method-filename-alist process)
(message (format "%s %s" process event)))
-;; (defun mime-activate-external-method (entity cal)
-;; (save-excursion
-;; (save-restriction
-;; (let ((beg (mime-entity-point-min entity))
-;; (end (mime-entity-point-max entity)))
-;; (narrow-to-region beg end)
-;; (goto-char beg)
-;; (let ((method (cdr (assoc 'method cal)))
-;; (name (mime-raw-get-filename cal)))
-;; (if method
-;; (let ((file (make-temp-name
-;; (expand-file-name "TM" mime-temp-directory)))
-;; b args)
-;; (if (nth 1 method)
-;; (setq b beg)
-;; (setq b (mime-entity-body-start entity)))
-;; (goto-char b)
-;; (write-region b end file)
-;; (message "External method is starting...")
-;; (setq cal (put-alist
-;; 'name (replace-as-filename name) cal))
-;; (setq cal (put-alist 'file file cal))
-;; (setq args (nconc
-;; (list (car method)
-;; mime-echo-buffer-name (car method))
-;; (mime-make-external-method-args
-;; cal (cdr (cdr method)))
-;; ))
-;; (apply (function start-process) args)
-;; (mime-show-echo-buffer)
-;; ))
-;; )))))
-
-;; (defun mime-make-external-method-args (cal format)
-;; (mapcar (function
-;; (lambda (arg)
-;; (if (stringp arg)
-;; arg
-;; (let* ((item (eval arg))
-;; (ret (cdr (assoc item cal))))
-;; (or ret
-;; (if (eq item 'encoding)
-;; "7bit"
-;; ""))
-;; ))))
-;; format))
-
(defvar mime-echo-window-is-shared-with-bbdb t
"*If non-nil, mime-echo window is shared with BBDB window.")
(concat (regexp-* mime-view-file-name-char-regexp)
"\\(\\." mime-view-file-name-char-regexp "+\\)*"))
-(defun mime-raw-get-original-filename (param)
- (or (if (member (cdr (assq 'encoding param))
- mime-view-uuencode-encoding-name-list)
- (mime-raw-get-uu-filename))
- (let (ret)
- (or (if (or (and (setq ret (mime-read-Content-Disposition))
- (setq ret
- (assoc
- "filename"
- (mime-content-disposition-parameters ret)))
- )
- (setq ret (assoc "name" param))
- (setq ret (assoc "x-name" param))
- )
- (std11-strip-quoted-string (cdr ret))
- )
- (if (setq ret
- (std11-find-field-body '("Content-Description"
- "Subject")))
- (if (or (string-match mime-view-file-name-regexp-1 ret)
- (string-match mime-view-file-name-regexp-2 ret))
- (substring ret (match-beginning 0)(match-end 0))
- ))
- ))
- ))
-
-(defun mime-raw-get-filename (param)
- (replace-as-filename (mime-raw-get-original-filename param))
- )
+(defun mime-entity-safe-filename (entity)
+ (replace-as-filename
+ (or (mime-entity-filename entity)
+ (let ((ret (or (mime-entity-read-field entity 'Content-Description)
+ (mime-entity-read-field entity 'Subject))))
+ (if (or (string-match mime-view-file-name-regexp-1 ret)
+ (string-match mime-view-file-name-regexp-2 ret))
+ (substring ret (match-beginning 0)(match-end 0))
+ )))))
;;; @ file extraction
;;;
-(defun mime-method-to-save (entity cal)
+(defun mime-save-content (entity cal)
(let ((beg (mime-entity-point-min entity))
(end (mime-entity-point-max entity)))
(goto-char beg)
(let* ((name (save-restriction
(narrow-to-region beg end)
- (mime-raw-get-filename cal)
+ (mime-entity-safe-filename entity)
))
(encoding (or (cdr (assq 'encoding cal)) "7bit"))
(filename (if (and name (not (string-equal name "")))
TYPE is symbol to indicate primary type of media-type.
SUBTYPE is symbol to indicate subtype of media-type.")
-(defun mime-method-to-detect (entity situation)
+(defun mime-detect-content (entity situation)
(let ((beg (mime-entity-point-min entity))
(end (mime-entity-point-max entity)))
(goto-char beg)
(let* ((name (save-restriction
(narrow-to-region beg end)
- (mime-raw-get-filename situation)
+ (mime-entity-safe-filename entity)
))
(encoding (or (cdr (assq 'encoding situation)) "7bit"))
(filename (if (and name (not (string-equal name "")))
(pop-to-buffer mother)
))
-(defun mime-method-to-display-message/rfc822 (entity cal)
+(defun mime-view-message/rfc822 (entity cal)
(let* ((beg (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
(cnum (mime-raw-point-to-entity-number beg))
(write-region start end filename)
)))
-(defun mime-method-to-store-message/partial (entity cal)
+(defun mime-store-message/partial-piece (entity cal)
(goto-char (mime-entity-point-min entity))
(let* ((root-dir
(expand-file-name
(dired dir)
))
-(defun mime-method-to-display-message/external-ftp (entity cal)
+(defun mime-view-message/external-ftp (entity cal)
(let* ((site (cdr (assoc "site" cal)))
(directory (cdr (assoc "directory" cal)))
(name (cdr (assoc "name" cal)))
;;; @ rot13-47
;;;
-(defun mime-method-to-display-caesar (entity situation)
+(defun mime-view-caesar (entity situation)
"Internal method for mime-view to display ROT13-47-48 message."
(let* ((new-name (format "%s-%s" (buffer-name)
(mime-entity-number entity)))
;;; @ content filters for mime-text
;;;
-(defun mime-preview-text/plain (entity situation)
+(defun mime-display-text/plain (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(mime-text-insert-decoded-body entity)
(insert "\n")
)
(mime-text-add-url-buttons)
- (run-hooks 'mime-preview-text/plain-hook)
+ (run-hooks 'mime-display-text/plain-hook)
))
-(defun mime-preview-text/richtext (entity situation)
+(defun mime-display-text/richtext (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(mime-text-insert-decoded-body entity)
(richtext-decode beg (point-max))
)))
-(defun mime-preview-text/enriched (entity situation)
+(defun mime-display-text/enriched (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(mime-text-insert-decoded-body entity)
;;; Code:
(require 'std11)
-(require 'mel)
-(require 'eword-decode)
+(require 'mime-lib)
(require 'mime-parse)
(require 'semi-def)
(require 'calist)
;;;
(defconst mime-view-version-string
- `,(concat (car mime-module-version) " MIME-View "
- (mapconcat #'number-to-string (cddr mime-module-version) ".")
- " (" (cadr mime-module-version) ")"))
+ `,(concat (car mime-user-interface-version) " MIME-View "
+ (mapconcat #'number-to-string
+ (cddr mime-user-interface-version) ".")
+ " (" (cadr mime-user-interface-version) ")"))
;;; @ variables
(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
-(defun mime-raw-get-uu-filename ()
- (save-excursion
- (if (re-search-forward "^begin [0-9]+ " nil t)
- (if (looking-at ".+$")
- (buffer-substring (match-beginning 0)(match-end 0))
- ))))
-
-(defun mime-raw-get-subject (entity)
- (or (std11-find-field-body '("Content-Description" "Subject"))
+(defun mime-entity-uu-filename (entity)
+ (if (member (mime-entity-encoding entity)
+ mime-view-uuencode-encoding-name-list)
+ (save-excursion
+ (set-buffer (mime-entity-buffer entity))
+ (goto-char (mime-entity-body-start entity))
+ (if (re-search-forward "^begin [0-9]+ "
+ (mime-entity-body-end entity) t)
+ (if (looking-at ".+$")
+ (buffer-substring (match-beginning 0)(match-end 0))
+ )))))
+
+(defun mime-entity-filename (entity)
+ (or (mime-entity-uu-filename entity)
(let ((ret (mime-entity-content-disposition entity)))
(and ret
(setq ret (mime-content-disposition-filename ret))
)))
(std11-strip-quoted-string ret)
))
- (if (member (mime-entity-encoding entity)
- mime-view-uuencode-encoding-name-list)
- (mime-raw-get-uu-filename))
+ ))
+
+(defun mime-view-entity-title (entity)
+ (or (mime-entity-read-field entity 'Content-Description)
+ (mime-entity-read-field entity 'Subject)
+ (mime-entity-filename entity)
""))
;;; @@@ entity button generator
;;;
-(defun mime-view-insert-entity-button (entity subject)
+(defun mime-view-insert-entity-button (entity)
"Insert entity-button of ENTITY."
(let ((entity-node-id (mime-entity-node-id entity))
- (params (mime-entity-parameters entity)))
+ (params (mime-entity-parameters entity))
+ (subject (mime-view-entity-title entity)))
(mime-insert-button
(let ((access-type (assoc "access-type" params))
(num (or (cdr (assoc "x-part-number" params))
;;; @@ entity-header
;;;
-;;; @@@ entity header filter
-;;;
-
-(defvar mime-view-content-header-filter-alist nil)
-
-(defun mime-view-default-content-header-filter ()
- (mime-view-cut-header)
- (eword-decode-header)
- )
-
-;;; @@@ entity field cutter
-;;;
+(defvar mime-header-presentation-method-alist nil
+ "Alist of major mode vs. corresponding header-presentation-method functions.
+Each element looks like (SYMBOL . FUNCTION).
+SYMBOL must be major mode in raw-buffer or t. t means default.
+Interface of FUNCTION must be (ENTITY SITUATION).")
(defvar mime-view-ignored-field-list
'(".*Received" ".*Path" ".*Id" "References"
"All fields that match this list will be hidden in MIME preview buffer.
Each elements are regexp of field-name.")
-(defvar mime-view-ignored-field-regexp
- (concat "^"
- (apply (function regexp-or) mime-view-ignored-field-list)
- ":"))
-
(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.")
-(defun mime-view-cut-header ()
- (goto-char (point-min))
- (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))
- )
- (catch 'visible
- (let ((rest mime-view-visible-field-list))
- (while rest
- (if (string-match (car rest) name)
- (throw 'visible nil)
- )
- (setq rest (cdr rest))))
- (delete-region beg
- (save-excursion
- (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
- (match-beginning 0)
- (point-max))))
- ))))
-
;;; @@ entity-body
;;;
(ctree-set-calist-strictly
'mime-preview-condition
'((body . visible)
- (body-presentation-method . mime-preview-text/plain)))
+ (body-presentation-method . mime-display-text/plain)))
(ctree-set-calist-strictly
'mime-preview-condition
'((type . nil)
(body . visible)
- (body-presentation-method . mime-preview-text/plain)))
+ (body-presentation-method . mime-display-text/plain)))
(ctree-set-calist-strictly
'mime-preview-condition
'((type . text)(subtype . enriched)
(body . visible)
- (body-presentation-method . mime-preview-text/enriched)))
+ (body-presentation-method . mime-display-text/enriched)))
(ctree-set-calist-strictly
'mime-preview-condition
'((type . text)(subtype . richtext)
(body . visible)
- (body-presentation-method . mime-preview-text/richtext)))
+ (body-presentation-method . mime-display-text/richtext)))
(ctree-set-calist-strictly
'mime-preview-condition
'((type . text)(subtype . t)
(body . visible)
- (body-presentation-method . mime-preview-text/plain)))
+ (body-presentation-method . mime-display-text/plain)))
(ctree-set-calist-strictly
'mime-preview-condition
'((type . multipart)(subtype . alternative)
(body . visible)
- (body-presentation-method . mime-preview-multipart/alternative)))
+ (body-presentation-method . mime-display-multipart/alternative)))
(ctree-set-calist-strictly
'mime-preview-condition '((type . message)(subtype . partial)
(body-presentation-method
- . mime-preview-message/partial-button)))
+ . mime-display-message/partial-button)))
(ctree-set-calist-strictly
'mime-preview-condition '((type . message)(subtype . rfc822)
;;; @@@ entity presentation
;;;
-(autoload 'mime-preview-text/plain "mime-text")
-(autoload 'mime-preview-text/enriched "mime-text")
-(autoload 'mime-preview-text/richtext "mime-text")
+(autoload 'mime-display-text/plain "mime-text")
+(autoload 'mime-display-text/enriched "mime-text")
+(autoload 'mime-display-text/richtext "mime-text")
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
\[[ Please press `v' key in this buffer. ]]"
))
-(defun mime-preview-message/partial-button (&optional entity situation)
+(defun mime-display-message/partial-button (&optional entity situation)
(save-restriction
(goto-char (point-max))
(if (not (search-backward "\n\n" nil t))
#'mime-preview-play-current-entity)
))
-(defun mime-preview-multipart/mixed (entity situation)
+(defun mime-display-multipart/mixed (entity situation)
(let ((children (mime-entity-children entity))
(default-situation
(cdr (assq 'childrens-situation situation))))
(while children
- (mime-view-display-entity (car children)
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- mime-raw-message-info)
- (current-buffer)
- default-situation)
+ (mime-display-entity (car children) nil default-situation)
(setq children (cdr children))
)))
(item :tag "Default" t))
integer)))
-(defun mime-preview-multipart/alternative (entity situation)
+(defun mime-display-multipart/alternative (entity situation)
(let* ((children (mime-entity-children entity))
(default-situation
(cdr (assq 'childrens-situation situation)))
(while children
(let ((child (car children))
(situation (car situations)))
- (mime-view-display-entity child
- (save-excursion
- (set-buffer (mime-entity-buffer child))
- mime-raw-message-info)
- (current-buffer)
- default-situation
- (if (= i p)
- situation
- (del-alist 'body-presentation-method
- (copy-alist situation))))
+ (mime-display-entity child (if (= i p)
+ situation
+ (del-alist 'body-presentation-method
+ (copy-alist situation))))
)
(setq children (cdr children)
situations (cdr situations)
'mime-acting-condition
'((type . application)(subtype . octet-stream)
(mode . "play")
- (method . mime-method-to-detect)
+ (method . mime-detect-content)
))
(ctree-set-calist-with-default
'mime-acting-condition
'((mode . "extract")
- (method . mime-method-to-save)))
+ (method . mime-save-content)))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . text)(subtype . x-rot13-47)(mode . "play")
- (method . mime-method-to-display-caesar)
+ (method . mime-view-caesar)
))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . text)(subtype . x-rot13-47-48)(mode . "play")
- (method . mime-method-to-display-caesar)
+ (method . mime-view-caesar)
))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . message)(subtype . rfc822)(mode . "play")
- (method . mime-method-to-display-message/rfc822)
+ (method . mime-view-message/rfc822)
))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . message)(subtype . partial)(mode . "play")
- (method . mime-method-to-store-message/partial)
+ (method . mime-store-message/partial-piece)
))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . message)(subtype . external-body)
("access-type" . "anon-ftp")
- (method . mime-method-to-display-message/external-ftp)
+ (method . mime-view-message/external-ftp)
))
(ctree-set-calist-strictly
'mime-acting-condition
'((type . application)(subtype . octet-stream)
- (method . mime-method-to-save)
+ (method . mime-save-content)
))
;;; @ following method
;;;
-(defvar mime-view-following-method-alist nil
+(defvar mime-preview-following-method-alist nil
"Alist of major-mode vs. following-method of mime-view.")
(defvar mime-view-following-required-fields-list
;;; @ buffer setup
;;;
-(defun mime-view-display-entity (entity message-info obuf
- default-situation
- &optional situation)
+(defun mime-display-entity (entity &optional situation
+ default-situation preview-buffer)
+ (or preview-buffer
+ (setq preview-buffer (current-buffer)))
(let* ((raw-buffer (mime-entity-buffer entity))
(start (mime-entity-point-min entity))
- (end (mime-entity-point-max entity))
- original-major-mode end-of-header e nb ne subj)
+ e nb ne)
(set-buffer raw-buffer)
- (setq original-major-mode major-mode)
(goto-char start)
- (setq end-of-header (if (re-search-forward "^$" nil t)
- (1+ (match-end 0))
- end))
- (if (> end-of-header end)
- (setq end-of-header end)
- )
- (save-restriction
- (narrow-to-region start end)
- (setq subj (eword-decode-string (mime-raw-get-subject entity)))
- )
(or situation
(setq situation
(or (ctree-match-calist mime-preview-condition
(eq (cdr (assq 'entity-button situation)) 'invisible))
(header-is-visible
(eq (cdr (assq 'header situation)) 'visible))
+ (header-presentation-method
+ (or (cdr (assq 'header-presentation-method situation))
+ (cdr (assq major-mode mime-header-presentation-method-alist))))
(body-presentation-method
(cdr (assq 'body-presentation-method situation)))
(children (mime-entity-children entity)))
- (set-buffer obuf)
+ (set-buffer preview-buffer)
(setq nb (point))
(narrow-to-region nb nb)
(or button-is-invisible
(if (mime-view-entity-button-visible-p entity)
- (mime-view-insert-entity-button entity subj)
- ))
- (if header-is-visible
- (save-restriction
- (narrow-to-region (point)(point))
- (insert-buffer-substring raw-buffer start end-of-header)
- (let ((f (cdr (assq original-major-mode
- mime-view-content-header-filter-alist))))
- (if (functionp f)
- (funcall f)
- (mime-view-default-content-header-filter)
- ))
- (run-hooks 'mime-view-content-header-filter-hook)
+ (mime-view-insert-entity-button entity)
))
- (cond ((eq body-presentation-method 'with-filter)
- (let ((body-filter (cdr (assq 'body-filter situation))))
- (save-restriction
- (narrow-to-region (point-max)(point-max))
- (insert-buffer-substring raw-buffer end-of-header end)
- (funcall body-filter situation)
- )))
- (children)
- ((functionp body-presentation-method)
+ (when header-is-visible
+ (if header-presentation-method
+ (funcall header-presentation-method entity situation)
+ (mime-insert-decoded-header
+ entity
+ mime-view-ignored-field-list mime-view-visible-field-list
+ (save-excursion
+ (set-buffer raw-buffer)
+ (if (eq (cdr (assq major-mode mime-raw-representation-type-alist))
+ 'binary)
+ default-mime-charset)
+ )))
+ (goto-char (point-max))
+ (insert "\n")
+ (run-hooks 'mime-display-header-hook)
+ )
+ (cond (children)
+ ((functionp body-presentation-method)
(funcall body-presentation-method entity situation)
)
(t
(when button-is-invisible
(goto-char (point-max))
- (mime-view-insert-entity-button entity subj)
+ (mime-view-insert-entity-button entity)
)
(or header-is-visible
(progn
(if children
(if (functionp body-presentation-method)
(funcall body-presentation-method entity situation)
- (mime-preview-multipart/mixed entity situation)
+ (mime-display-multipart/mixed entity situation)
))
)))
(defvar mime-view-redisplay nil)
-(defun mime-view-display-message (message &optional preview-buffer
- mother default-keymap-or-function)
+(defun mime-display-message (message &optional preview-buffer
+ mother default-keymap-or-function)
(mime-maybe-hide-echo-buffer)
(let ((win-conf (current-window-configuration))
(raw-buffer (mime-entity-buffer message)))
(setq mime-preview-original-window-configuration win-conf)
(setq major-mode 'mime-view-mode)
(setq mode-name "MIME-View")
- (mime-view-display-entity message message
- preview-buffer
- '((entity-button . invisible)
- (header . visible)
- ))
+ (mime-display-entity message nil
+ '((entity-button . invisible)
+ (header . visible))
+ preview-buffer)
(mime-view-define-keymap default-keymap-or-function)
(let ((point
(next-single-property-change (point-min) 'mime-view-entity)))
(defun mime-view-buffer (&optional raw-buffer preview-buffer mother
default-keymap-or-function)
(interactive)
- (mime-view-display-message
+ (mime-display-message
(save-excursion
(if raw-buffer (set-buffer raw-buffer))
(mime-parse-message)
and decode current content as `play mode'
"
(interactive)
- (mime-view-display-message
+ (mime-display-message
(save-excursion
(if raw-buffer (set-buffer raw-buffer))
(or mime-view-redisplay
(defun mime-preview-follow-current-entity ()
"Write follow message to current entity.
It calls following-method selected from variable
-`mime-view-following-method-alist'."
+`mime-preview-following-method-alist'."
(interactive)
(let (entity)
(while (null (setq entity
))
(eword-decode-header)
)
- (let ((f (cdr (assq mode mime-view-following-method-alist))))
+ (let ((f (cdr (assq mode mime-preview-following-method-alist))))
(if (functionp f)
(funcall f new-buf)
(message
(eval-when-compile (require 'cl))
-(defconst mime-module-version '("SEMI" "Namerikawa" 1 6 0)
+(defconst mime-user-interface-version '("SEMI" "Mizuhashi" 1 7 0)
"Implementation name, version name and numbers of MIME-kernel package.")
(autoload 'mule-caesar-region "mule-caesar"
;;; @ Other Utility
;;;
-(defun call-after-loaded (module func &optional hook-name)
- "If MODULE is provided, then FUNC is called.
-Otherwise func is set to MODULE-load-hook.
-If optional argument HOOK-NAME is specified,
-it is used as hook to set."
- (if (featurep module)
- (funcall func)
- (or hook-name
- (setq hook-name (intern (concat (symbol-name module) "-load-hook")))
- )
- (add-hook hook-name func)
- ))
-
-
(defvar mime-condition-type-alist
'((preview . mime-preview-condition)
(action . mime-acting-condition)))
(require 'semi-def)
(require 'path-util)
+(defun call-after-loaded (module func &optional hook-name)
+ "If MODULE is provided, then FUNC is called.
+Otherwise func is set to MODULE-load-hook.
+If optional argument HOOK-NAME is specified,
+it is used as hook to set."
+ (if (featurep module)
+ (funcall func)
+ (or hook-name
+ (setq hook-name (intern (concat (symbol-name module) "-load-hook")))
+ )
+ (add-hook hook-name func)
+ ))
+
;; for image/* and X-Face
(defvar mime-setup-enable-inline-image
(message-button . visible)))
(mime-add-condition
'action '((type . application)(subtype . pgp)
- (method . mime-method-for-application/pgp))
+ (method . mime-view-application/pgp))
'strict "mime-pgp")
(mime-add-condition
'action '((type . text)(subtype . x-pgp)
- (method . mime-method-for-application/pgp)))
+ (method . mime-view-application/pgp)))
(mime-add-condition
'action '((type . multipart)(subtype . signed)
- (method . mime-method-to-verify-multipart/signed))
+ (method . mime-verify-multipart/signed))
'strict "mime-pgp")
(mime-add-condition
'action
'((type . application)(subtype . pgp-signature)
- (method . mime-method-to-verify-application/pgp-signature))
+ (method . mime-verify-application/pgp-signature))
'strict "mime-pgp")
(mime-add-condition
'action
'((type . application)(subtype . pgp-encrypted)
- (method . mime-method-to-decrypt-application/pgp-encrypted))
+ (method . mime-decrypt-application/pgp-encrypted))
'strict "mime-pgp")
(mime-add-condition
'action
'((type . application)(subtype . pgp-keys)
- (method . mime-method-to-add-application/pgp-keys))
+ (method . mime-add-application/pgp-keys))
'strict "mime-pgp")
))
)
projects / elisp / semi.git / commitdiff