X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-view.el;h=dc97f26f63c5f96ca8f552bd67e928a309410b07;hb=8244ebc1b512ebb616865fbcaea450b0cce54145;hp=bd0d0a8ef2d0958ef3f0666c05c7e031e6aea42e;hpb=ac4443ef55190936e3a390644f0964b389e2582e;p=elisp%2Ftm.git diff --git a/tm-view.el b/tm-view.el index bd0d0a8..dc97f26 100644 --- a/tm-view.el +++ b/tm-view.el @@ -4,15 +4,15 @@ ;;; by Morioka Tomohiko, 1994/07/13 ;;; -(provide 'tm-view) - - ;;; @ require modules ;;; (require 'tl-str) (require 'tl-list) +(require 'tl-atype) +(require 'tl-misc) (require 'tl-header) +(require 'mel) (require 'tiny-mime) (require 'tm-misc) @@ -21,7 +21,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 6.15 1995/04/18 16:48:08 morioka Exp $") + "$Id: tm-view.el,v 6.76 1995/08/31 15:05:50 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -30,9 +30,6 @@ ;;; @ constants ;;; -(defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=") -(defconst mime/token-regexp - (concat "[^" mime/tspecials "]*")) (defconst mime/content-type-subtype-regexp (concat mime/token-regexp "/" mime/token-regexp)) (defconst mime/content-parameter-value-regexp @@ -48,7 +45,6 @@ ;;; (defvar mime/content-decoding-condition -;;(setq mime/content-decoding-condition '(((type . "text/plain") (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)) ;;((type . "text/x-latex") @@ -77,130 +73,201 @@ ;; 'file '"access-type" '"name" '"site" '"directory")) ((type . "message/partial") (method . mime/decode-message/partial-region)) + ((type . "message/rfc822") + (method "tm-file" nil 'file 'type 'encoding 'mode 'name)) ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play")) )) -(defvar mime-viewer/content-filter-alist - '(("text/plain" . mime-viewer/filter-text/plain))) - -(defvar mime-viewer/content-subject-function - (function - (lambda (cnum subj ctype params) - (insert - (format "[%s %s (%s)]\n" - (if (listp cnum) - (mapconcat (function - (lambda (num) - (format "%s" (+ num 1)) - )) - cnum ".") - "0") - subj ctype)) - ))) - -(defvar mime-viewer/content-header-filter-function - (function mime-viewer/default-content-header-filter-function)) - (defvar mime-viewer/childrens-header-showing-Content-Type-list '("message/rfc822")) +(defvar mime-viewer/default-showing-Content-Type-list + '("text/plain" "text/richtext" "text/enriched" + "text/x-latex" "application/x-latex" + "application/octet-stream" nil + "application/x-selection" "application/x-comment")) + +(defvar mime-viewer/content-subject-omitting-Content-Type-list + '("application/x-selection")) + +(defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode")) + (defvar mime-viewer/ignored-field-list - '("Received")) + '("Received" "Return-Path" "Replied" "Errors-To" + "Lines" "Sender" "Path" "Nntp-Posting-Host" + "Content-Type" "Precedence")) + +(defvar mime-viewer/ignored-field-regexp) + +(defvar mime-viewer/decoding-mode "play" "MIME body decoding mode") + +(defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]") + +(defvar mime-viewer/file-name-regexp-1 + (concat mime-viewer/file-name-char-regexp "+\\." + mime-viewer/file-name-char-regexp "+")) + +(defvar mime-viewer/file-name-regexp-2 + (concat (regexp-* mime-viewer/file-name-char-regexp) + "\\(\\." mime-viewer/file-name-char-regexp "+\\)*")) + +(defvar mime-viewer/announcement-for-message/partial + "[[ This is message/partial style split message. ]] +[[ Please press `v' key in this buffer. ]]") + + +;;; @@ predicate functions +;;; + +(defun mime-viewer/header-visible-p (cnum cinfo &optional ctype) + (or (eq cnum t) + (progn + (setq ctype + (mime::content-info/type + (mime-article/cnum-to-cinfo (butlast cnum) cinfo) + )) + (member ctype mime-viewer/childrens-header-showing-Content-Type-list) + ))) + +(defun mime-viewer/body-visible-p (cnum cinfo &optional ctype) + (let (ccinfo) + (or ctype + (setq ctype + (mime::content-info/type + (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + )) + ) + (and (member ctype mime-viewer/default-showing-Content-Type-list) + (if (string-equal ctype "application/octet-stream") + (progn + (or ccinfo + (setq ccinfo (mime-article/cnum-to-cinfo cnum cinfo)) + ) + (member (mime::content-info/encoding ccinfo) + '(nil "7bit" "8bit")) + ) + t)) + )) + -(defun mime-viewer/default-content-header-filter-function (cnum cinfo) +;;; @@ content subject +;;; + +(defun mime-viewer/insert-content-subject + (cnum cinfo ctype params subj) + (insert + (let ((access-type (assoc "access-type" params)) + (num (or (assoc-value "x-part-number" params) + (if (listp cnum) + (mapconcat (function + (lambda (num) + (format "%s" (+ num 1)) + )) + cnum ".") + "0")) + )) + (if access-type + (let ((server (assoc "server" params))) + (setq access-type (cdr access-type)) + (if server + (format "[%s %s ([%s] %s)]\n" num subj + access-type (cdr server)) + (let ((site (assoc-value "site" params)) + (dir (assoc-value "directory" params)) + ) + (format "[%s %s ([%s] %s:%s)]\n" num subj + access-type site dir) + ))) + (format "[%s %s (%s)]\n" num subj ctype) + )))) + +(defun mime-viewer/default-content-subject-function + (cnum cinfo ctype params subj) (if (and (listp cnum) (not (member - (mime::content-info/type - (mime::article/get-content-region (butlast cnum) cinfo) - ) - mime-viewer/childrens-header-showing-Content-Type-list) - )) - (delete-region (goto-char (point-min)) - (or (and (re-search-forward "^$" nil t) - (match-end 0)) - (point-max)) - ) - (save-excursion - (save-restriction - (narrow-to-region (goto-char (point-min)) - (or (and (re-search-forward "^$" nil t) - (match-end 0)) - (point-max)) - ) - (mapcar (function - (lambda (field) - (goto-char (point-min)) - (while (and (re-search-forward - (concat "^" (regexp-quote field) ":") - nil t) - (progn - (delete-region - (match-beginning 0) - (and - (re-search-forward - (concat message/field-body-regexp "\n") - nil t) - (match-end 0) - )) - t)) - ) - )) mime-viewer/ignored-field-list) - )))) + ctype + mime-viewer/content-subject-omitting-Content-Type-list)) + ) + (mime-viewer/insert-content-subject + cnum cinfo ctype params subj) + )) -(defvar mime-viewer/default-showing-Content-Type-list - '("text/plain" "text/richtext" "text/enriched" - "text/x-latex" "application/x-latex" - "application/octet-stream" nil)) +(defvar mime-viewer/content-subject-function + (function mime-viewer/default-content-subject-function)) -(defvar mime-viewer/decoding-mode "play" "MIME body decoding mode") +;;; @ content header filter +;;; + +(defun mime-viewer/default-content-header-filter () + (goto-char (point-min)) + (while (and (re-search-forward + (concat "^" mime-viewer/ignored-field-regexp ":") + nil t) + (progn + (delete-region + (match-beginning 0) + (save-excursion + (and + (re-search-forward "^\\([^ \t]\\|$\\)" nil t) + (match-beginning 0) + ))) + t))) + (mime/decode-message-header) + ) + +(defvar mime-viewer/content-header-filter-alist nil) -;;; @@ quitting + +;;; @@ content filter ;;; -(defun mime::viewer/quitting-method-for-gnus4 () - (mime-viewer/kill-buffer) - (delete-other-windows) - (gnus-article-show-summary) +(defvar mime-viewer/content-filter-alist + '(("text/plain" . mime-viewer/filter-text/plain) + (nil . mime-viewer/filter-text/plain))) + +(defun mime-viewer/default-content-filter (cnum cinfo ctype params subj) ) -(defun mime::viewer/quitting-method-for-rmail () + +;;; @@ content separator +;;; + +(defun mime-viewer/default-content-separator (cnum cinfo ctype params subj) + (if (and (not (mime-viewer/header-visible-p cnum cinfo ctype)) + (not (mime-viewer/body-visible-p cnum cinfo ctype)) + ) + (progn + (goto-char (point-max)) + (insert "\n") + ))) + + +;;; @@ buffer local variables +;;; + +(defvar mime::article/content-info nil) +(defvar mime::article/preview-buffer nil) + +(defvar mime::preview/article-buffer nil) +(defvar mime::preview/content-list nil) +(defvar mime::preview/original-major-mode nil) + + +;;; @@ quitting +;;; + +(defun mime-viewer/quitting-method-for-gnus4 () (mime-viewer/kill-buffer) - (rmail-summary) (delete-other-windows) - ) - -(defun mime::viewer/quitting-method-for-mh-e () - (let ((win (get-buffer-window - mime/output-buffer-name)) - (buf - (mime::preview-content-info/buffer - (car mime::preview/content-list))) - ) - (if win - (delete-window win) - ) - (mime-viewer/kill-buffer) - (pop-to-buffer - (let ((name (buffer-name buf))) - (string-match "show-" name) - (substring name (match-end 0)) - )) - ;; patch for mh-narrow.el - ;; by YAMAOKA Katsumi - (if (and (featurep 'mh-narrow) - (fboundp 'mh-narrow-to-page)) - (save-excursion - (set-buffer mh-show-buffer) - (mh-narrow-to-page))) - ;; end of patch + (gnus-article-show-summary) + (if (null gnus-have-all-headers) + (gnus-summary-select-article nil t) )) (defvar mime-viewer/quitting-method-alist - '((gnus-article-mode . mime::viewer/quitting-method-for-gnus4) - (rmail-mode . mime::viewer/quitting-method-for-rmail) - (mh-show-mode . mime::viewer/quitting-method-for-mh-e) + '((gnus-article-mode . mime-viewer/quitting-method-for-gnus4) (mime/show-message-mode . (lambda () (set-window-configuration @@ -217,72 +284,18 @@ )) -;;; @ data structure +;;; @ data structures ;;; ;;; @@ content-info ;;; - -(defun mime::make-content-info (beg end ctype params encoding children) - (vector beg end ctype params encoding children) - ) - -(defun mime::content-info/point-min (cinfo) - (elt cinfo 0) - ) - -(defun mime::content-info/point-max (cinfo) - (elt cinfo 1) - ) - -(defun mime::content-info/type (cinfo) - (elt cinfo 2) - ) - -(defun mime::content-info/parameters (cinfo) - (elt cinfo 3) - ) - -(defun mime::content-info/encoding (cinfo) - (elt cinfo 4) - ) - -(defun mime::content-info/children (cinfo) - (elt cinfo 5) - ) +(define-structure mime::content-info + point-min point-max type parameters encoding children) ;;; @@ preview-content-info ;;; - -(defun mime::make-preview-content-info (beg end buf cinfo) - (vector beg end buf cinfo) - ) - -(defun mime::preview-content-info/point-min (pcinfo) - (elt pcinfo 0) - ) - -(defun mime::preview-content-info/point-max (pcinfo) - (elt pcinfo 1) - ) - -(defun mime::preview-content-info/buffer (pcinfo) - (elt pcinfo 2) - ) - -(defun mime::preview-content-info/content-info (pcinfo) - (elt pcinfo 3) - ) - - -;;; @ buffer local variables -;;; - -(defvar mime::article/content-info) -(defvar mime::article/preview-buffer) - -(defvar mime::preview/content-list nil) -(defvar mime::preview/original-major-mode nil) +(define-structure mime::preview-content-info + point-min point-max buffer content-info) ;;; @ parser @@ -299,59 +312,58 @@ (defun mime-viewer/parse (&optional ctl encoding) (save-excursion (save-restriction - (if (null ctl) - (setq ctl (progn - (goto-char (point-min)) - (mime/Content-Type) - )) - ) - (if (null encoding) - (setq encoding (progn - (goto-char (point-min)) - (mime/Content-Transfer-Encoding) - )) - ) + (setq ctl (or (mime/Content-Type) + ctl)) + (setq encoding (or (mime/Content-Transfer-Encoding) + encoding)) (let ((ctype (car ctl)) (params (cdr ctl)) ) - (if (stringp ctype) - (setq ctype (downcase ctype)) - ) - (if (stringp encoding) - (setq encoding (downcase encoding)) - ) (let ((boundary (assoc "boundary" params))) + (goto-char (point-min)) (search-forward "\n\n" nil t) (cond (boundary - (setq boundary - (message/strip-quoted-string (cdr boundary))) - (mime-viewer/parse-multipart - (match-end 0) - (progn - (search-forward (concat "--" boundary "--\n") nil t) - (match-beginning 0) - ) - boundary ctype params encoding) - ) + (save-excursion + (save-restriction + (setq boundary + (message/strip-quoted-string (cdr boundary))) + (narrow-to-region + (point-min) + (if (re-search-forward + (concat "^--" (regexp-quote boundary) "--$") nil t) + (match-beginning 0) + (point-max) + )) + (mime-viewer/parse-multipart + (point-min) + (point-max) + boundary ctype params encoding) + ))) ((string= ctype "message/rfc822") - (mime::make-content-info + (mime::content-info/create (point-min) (point-max) ctype params encoding (save-excursion (save-restriction - (narrow-to-region (match-end 0) (point-max)) + (narrow-to-region (progn + (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (+ (match-end 0) 1) + (point-min) + )) + (point-max)) (list (mime-viewer/parse)) )) ) ) (t - (mime::make-content-info (point-min) (point-max) + (mime::content-info/create (point-min) (point-max) ctype params encoding nil) )) ))))) (defun mime-viewer/parse-multipart (beg end boundary ctype params encoding) - (let ((sep (concat "^--" boundary "$")) + (let ((sep (concat "^--" (regexp-quote boundary) "$")) cb ce ct ret ncb children) (save-excursion (save-restriction @@ -365,7 +377,13 @@ (save-excursion (save-restriction (narrow-to-region cb ce) - (setq ret (mime-viewer/parse)) + (setq ret (apply (function mime-viewer/parse) + (cond ((string= ctype "multipart/digest") + '(("message/rfc822") "7bit") + ) + (t '(("text/plain") "7bit")) + ) + )) )) (setq children (nconc children (list ret))) (goto-char (mime::content-info/point-max ret)) @@ -376,76 +394,103 @@ (save-excursion (save-restriction (narrow-to-region cb ce) - (setq ret (mime-viewer/parse)) + (setq ret (apply (function mime-viewer/parse) + (cond ((string= ctype "multipart/mixed") + '(("text/plain") "7bit") + ) + ((string= ctype "multipart/digest") + '(("message/rfc822") "7bit") + )) + )) )) (setq children (nconc children (list ret))) )) (setq beg (point-min)) (goto-char beg) - (mime::make-content-info beg end ctype params encoding children) + (mime::content-info/create beg end ctype params encoding children) )) -(defun mime/Content-Type () - (save-excursion - (save-restriction - (if (and (re-search-forward "^Content-Type:[ \t]*" nil t) - (progn - (narrow-to-region - (point) - (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t) - (match-end 0)) - ) - (goto-char (point-min)) - (re-search-forward mime/content-type-subtype-regexp nil t) - )) - (let ((ctype - (downcase - (buffer-substring (match-beginning 0) (match-end 0)) - )) - dest attribute value) - (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t) - (re-search-forward mime/token-regexp nil t) - ) - (setq attribute - (downcase - (buffer-substring (match-beginning 0) (match-end 0)) - )) - (if (and (re-search-forward "=[ \t\n]*" nil t) - (re-search-forward mime/content-parameter-value-regexp - nil t) - ) - (setq dest - (put-alist attribute - (message/strip-quoted-string - (buffer-substring (match-beginning 0) - (match-end 0))) - dest)) - ) - ) - (cons ctype dest) - ))))) +(defun mime::parse-parameter (str) + (let ((ret (message::parse "\;" str))) + (if ret + (if (setq ret + (message::parse mime/token-regexp + (message::parsed/rest ret))) + (let ((parameter (downcase (message::parsed/matched ret)))) + (if (setq ret (message::parse "=" (message::parsed/rest ret))) + (if (setq ret + (message::parse + mime/content-parameter-value-regexp + (message::parsed/rest ret))) + (message::make-parsed + (cons parameter + (message/strip-quoted-string + (message::parsed/matched ret)) + ) + (message::parsed/rest ret) + ) + ))))))) + +(defun mime::parse-field-body/Content-Type (str) + (let ((ret (message::parse mime/content-type-subtype-regexp str))) + (if ret + (let ((ctype (downcase (message::parsed/matched ret))) + dest) + (while (progn + (setq str (message::parsed/rest ret)) + (setq ret (mime::parse-parameter str)) + ) + (setq dest (cons (message::parsed/matched ret) dest)) + ) + (if (string-match "^[ \t]*$" str) + (cons ctype (reverse dest)) + ))))) + +(defun mime/Content-Type (&optional port) + "Read field-body of Content-Type field from PORT and parse it. +PORT must be buffer or string. If PORT is omitted, +it is regarded as current-buffer. [tm-view]" + (or port + (setq port (current-buffer)) + ) + (let ((str (if (get-buffer port) + (save-window-excursion + (switch-to-buffer port) + (message/get-field-body "Content-Type") + ) + port) + )) + (if str + (mime::parse-field-body/Content-Type + (message/unfolding-string str)) + ))) (defun mime/Content-Transfer-Encoding (&optional default-encoding) - (save-excursion - (save-restriction - (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t) - (re-search-forward mime/token-regexp nil t) - ) - (downcase (buffer-substring (match-beginning 0) (match-end 0))) - default-encoding) - ))) + (let ((str (message/get-field-body "Content-Transfer-Encoding"))) + (if str + (downcase str) + default-encoding) + )) -(defun mime/get-subject (param) - (save-excursion - (save-restriction - (let (ret) - (or (and (setq ret (assoc "name" param)) - (message/strip-quoted-string (cdr ret)) - ) - (and (setq ret (assoc "x-name" param)) - (message/strip-quoted-string (cdr ret)) - ) - (progn +(defun mime-viewer/get-subject (param) + (if (member (cdr (assq 'encoding param)) + mime-viewer/uuencode-encoding-name-list) + (save-excursion + (or (if (re-search-forward "^begin [0-9]+ " nil t) + (if (looking-at ".+$") + (buffer-substring (match-beginning 0)(match-end 0)) + )) + "")) + (let (ret) + (or (and (setq ret (assoc "name" param)) + (message/strip-quoted-string (cdr ret)) + ) + (and (setq ret (assoc "x-name" param)) + (message/strip-quoted-string (cdr ret)) + ) + + (save-excursion + (save-restriction (narrow-to-region (point-min) (or (and (search-forward "\n\n" nil t) (match-beginning 0) @@ -454,33 +499,50 @@ (or (message/get-field-body "Content-Description") (message/get-field-body "Subject") - )) - "")) - ))) + ))) + "")) + )) -(defun mime/get-name (param) - (replace-as-filename (mime/get-subject param)) - ) +(defun mime-viewer/get-name (param) + (let ((str (mime-viewer/get-subject param))) + (if (string-match " " str) + (if (or (string-match mime-viewer/file-name-regexp-1 str) + (string-match mime-viewer/file-name-regexp-2 str)) + (substring str (match-beginning 0)(match-end 0)) + ) + (replace-as-filename str) + ))) (defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf) - (let ((the-buf (current-buffer)) pcl dest) + (let ((the-buf (current-buffer)) + (mode major-mode) + pcl dest) (setq buf (if (null buf) (current-buffer) - (get-buffer buf) - )) - (if (null cinfo) - (progn - (switch-to-buffer buf) - (setq cinfo mime::article/content-info) - )) - (if (null obuf) + (prog1 + (get-buffer buf) + (switch-to-buffer buf) + ))) + (or cinfo + (setq cinfo mime::article/content-info) + ) + (or obuf (setq obuf (concat "*Preview-" (buffer-name buf) "*")) - ) + ) (setq pcl (mime::make-flat-content-list cinfo)) - (if (get-buffer obuf) - (kill-buffer obuf) - ) + (let ((bf (get-buffer obuf))) + (switch-to-buffer obuf) + (setq buffer-read-only nil) + (if bf + (erase-buffer) + )) + (make-variable-buffer-local 'mime::preview/article-buffer) + (setq mime::preview/article-buffer the-buf) + (make-variable-buffer-local 'mime::preview/original-major-mode) + (setq mime::preview/original-major-mode mode) + (setq major-mode 'mime/viewer-mode) + (setq mode-name "MIME-View") (setq dest (mapcar (function @@ -489,54 +551,108 @@ (end (mime::content-info/point-max cell)) (ctype (mime::content-info/type cell)) (params (mime::content-info/parameters cell)) - cnum e nb ne subj str) + (encoding (mime::content-info/encoding cell)) + he cnum e nb ne subj str) (setq cnum (mime::get-point-content-number beg cinfo)) - (switch-to-buffer buf) - (setq e - (if (not - (member - ctype - mime-viewer/default-showing-Content-Type-list)) - (save-excursion - (save-restriction - (goto-char beg) - (search-forward "\n\n" nil t) - (match-end 0) - )) - end)) - (if (> e (point-max)) - (setq e (point-max)) + (switch-to-buffer the-buf) + (setq he (save-excursion + (goto-char beg) + (re-search-forward "^$" nil t) + (+ (match-end 0) 1) + )) + (if (> he (point-max)) + (setq he (point-max)) ) - (setq str (buffer-substring beg e)) + (save-excursion + (save-restriction + (narrow-to-region beg he) + (setq subj (mime-viewer/get-subject params)) + )) (switch-to-buffer obuf) (setq nb (point)) - (insert str) - (setq ne (point)) + (narrow-to-region nb nb) + (switch-to-buffer the-buf) + (if (mime-viewer/header-visible-p cnum cinfo ctype) + (progn + (setq str (buffer-substring beg he)) + (switch-to-buffer obuf) + (insert str) + (let ((f (assq + mode + mime-viewer/content-header-filter-alist)) + ) + (if (and f (setq f (cdr f))) + (funcall f) + (mime-viewer/default-content-header-filter) + )) + (run-hooks 'mime-viewer/content-header-filter-hook) + (switch-to-buffer the-buf) + )) + (cond ((mime-viewer/body-visible-p cnum cinfo ctype) + (let (be) + (setq str (buffer-substring he end)) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (insert str) + (setq ne (point-max)) + (let ((f (or (assoc-value + ctype + mime-viewer/content-filter-alist) + ))) + (if (and f (fboundp f)) + (funcall f ctype params encoding) + (mime-viewer/default-content-filter + cnum cinfo ctype params subj) + )) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) + ((equal ctype "message/partial") + (let (be) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (insert + mime-viewer/announcement-for-message/partial) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) + ((and (eq cnum t) + (null (mime::content-info/children cinfo)) + ) + (let (be) + (switch-to-buffer obuf) + (save-restriction + (setq be (point-max)) + (narrow-to-region be be) + (mime-viewer/insert-content-subject + cnum cinfo ctype params subj) + (setq ne (point-max)) + ) + (switch-to-buffer the-buf) + )) + ) + (switch-to-buffer obuf) + (mime-viewer/default-content-separator + cnum cinfo ctype params subj) (prog1 - (save-excursion - (save-restriction - (narrow-to-region nb ne) - (mime/decode-message-header) - (setq subj (mime/get-subject params)) - (let ((f - (cdr - (assoc ctype - mime-viewer/content-filter-alist)))) - (if (and f (fboundp f)) - (funcall f ctype params) - )) - (funcall mime-viewer/content-header-filter-function - cnum cinfo) - (goto-char nb) - (funcall mime-viewer/content-subject-function - cnum subj ctype params) - (setq ne (point-max)) - (mime::make-preview-content-info nb (- ne 1) + (progn + (goto-char nb) + (funcall mime-viewer/content-subject-function + cnum cinfo ctype params subj) + (setq ne (point-max)) + (widen) + (mime::preview-content-info/create nb (- ne 1) buf cell) - )) + ) (goto-char ne) - ) - ))) pcl)) + )))) + pcl)) (set-buffer-modified-p nil) (setq buffer-read-only t) (switch-to-buffer the-buf) @@ -548,9 +664,9 @@ ;;; (defun mime::get-point-content-number (p &optional cinfo) - (if (null cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (let ((b (mime::content-info/point-min cinfo)) (e (mime::content-info/point-max cinfo)) (c (mime::content-info/children cinfo)) @@ -569,10 +685,10 @@ ))) t)))) -(defun mime::article/get-content-region (cn &optional cinfo) - (if (null cinfo) +(defun mime-article/cnum-to-cinfo (cn &optional cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (if (eq cn t) cinfo (let ((sn (car cn))) @@ -580,14 +696,14 @@ cinfo (let ((rc (nth sn (mime::content-info/children cinfo)))) (if rc - (mime::article/get-content-region (cdr cn) rc) + (mime-article/cnum-to-cinfo (cdr cn) rc) )) )))) (defun mime::make-flat-content-list (&optional cinfo) - (if (null cinfo) + (or cinfo (setq cinfo mime::article/content-info) - ) + ) (let ((dest (list cinfo)) (rcl (mime::content-info/children cinfo)) ) @@ -598,9 +714,9 @@ dest)) (defun mime::point-preview-content (p &optional pcl) - (if (null pcl) + (or pcl (setq pcl mime::preview/content-list) - ) + ) (catch 'tag (let ((r pcl) cell) (while r @@ -619,40 +735,6 @@ ;;; @ decoder ;;; -(defun mime/Quoted-Printable-decode-region (beg end) - (interactive "*r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "=\n" nil t) - (replace-match "") - ) - (goto-char (point-min)) - (let (b e str) - (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t) - (setq b (match-beginning 0)) - (setq e (match-end 0)) - (setq str (buffer-substring b e)) - (delete-region b e) - (insert (mime/Quoted-Printable-decode-string str)) - )) - ))) - -(defun mime/Base64-decode-region (beg end) - (interactive "*r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match "") - ) - (let ((str (buffer-substring (point-min)(point-max)))) - (delete-region (point-min)(point-max)) - (insert (mime/base64-decode-string str)) - )))) - (defun mime/make-method-args (cal format) (mapcar (function (lambda (arg) @@ -672,7 +754,7 @@ (narrow-to-region beg end) (goto-char beg) (let ((method (cdr (assoc 'method cal))) - (name (mime/get-name cal)) + (name (mime-viewer/get-name cal)) ) (if method (let ((file (make-temp-name @@ -680,8 +762,11 @@ b args) (if (nth 1 method) (setq b beg) - (search-forward "\n\n" nil t) - (setq b (match-end 0)) + (setq b + (if (re-search-forward "^$" nil t) + (+ (match-end 0) 1) + (point-min) + )) ) (goto-char b) (write-region b end file) @@ -764,7 +849,6 @@ ) (defun mime::article/decode-content-region (cinfo) - (interactive "*r") (let ((beg (mime::content-info/point-min cinfo)) (end (mime::content-info/point-max cinfo)) (ctype (mime::content-info/type cinfo)) @@ -815,36 +899,40 @@ ;;; @ content filter ;;; -(defun mime-viewer/filter-text/plain (ctype params) - (save-excursion - (save-restriction - (let ((charset (cdr (assoc "charset" params))) - (encoding - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point-min) - (or (and (search-forward "\n\n" nil t) - (match-beginning 0)) - (point-max))) - (goto-char (point-min)) - (mime/Content-Transfer-Encoding "7bit") - ))) - (beg (point-min)) (end (point-max)) - ) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (setq beg (match-end 0)) - ) - (if (cond ((string= encoding "quoted-printable") - (mime/Quoted-Printable-decode-region beg end) - t) - ((string= encoding "base64") - (mime/Base64-decode-region beg end) - t)) - (mime/code-convert-region-to-emacs beg (point-max) charset) - ) - )))) +(defvar mime-viewer/code-converter-alist nil) + +(defun mime-viewer/default-code-convert-region + (beg end charset &optional encoding) + (if (member encoding '("quoted-printable" "base64")) + (mime/code-convert-region-to-emacs beg (point-max) charset) + )) + +(defun mime-viewer/filter-text/plain (ctype params encoding) + (let ((charset (cdr (assoc "charset" params))) + (beg (point-min)) (end (point-max)) + ) + (goto-char (point-min)) + (cond ((string= encoding "quoted-printable") + (quoted-printable-decode-region beg end) + ) + ((string= encoding "base64") + (base64-decode-region beg end) + )) + (let* ((mode mime::preview/original-major-mode) + (m (assq mode mime-viewer/code-converter-alist)) + ) + (if (and m (fboundp (setq m (cdr m)))) + (funcall m beg (point-max) charset encoding) + (mime-viewer/default-code-convert-region beg (point-max) + charset encoding) + ))) + (goto-char (point-max)) + (if (not (eq (char-after (1- (point))) ?\n)) + (insert "\n") + ) + ;;(hide-sublevels 1) + (run-hooks 'mime-viewer/plain-text-preview-hook) + ) ;;; @ MIME viewer mode @@ -900,6 +988,11 @@ C-c C-p Decode the content as `print mode' q Quit " (interactive) + (setq mime-viewer/ignored-field-regexp + (concat "\\(" + (mapconcat (function regexp-quote) + mime-viewer/ignored-field-list "\\|") + "\\)")) (let ((buf (get-buffer mime/output-buffer-name)) (the-buf (current-buffer)) ) @@ -909,70 +1002,90 @@ q Quit (erase-buffer) (switch-to-buffer the-buf) ))) - (let ((ret (mime-viewer/parse-message ctl encoding)) - (mode major-mode)) - (switch-to-buffer (car ret)) - (setq major-mode 'mime/viewer-mode) - (setq mode-name "MIME-View") - (make-variable-buffer-local 'mime::preview/original-major-mode) - (setq mime::preview/original-major-mode - (if mother - (progn - (make-variable-buffer-local - 'mime/show-mode-old-window-configuration) - (setq mime/show-mode-old-window-configuration - (current-window-configuration)) - (make-variable-buffer-local 'mime/mother-buffer) - (setq mime/mother-buffer mother) - 'mime/show-message-mode) - mode)) - (use-local-map mime/viewer-mode-map) - (make-variable-buffer-local 'mime::preview/content-list) - (setq mime::preview/content-list (nth 1 ret)) - (goto-char - (let ((ce (mime::preview-content-info/point-max - (car mime::preview/content-list) - )) - e) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq e (match-end 0)) - (if (<= e ce) - e - ce))) - (run-hooks 'mime/viewer-mode-hook) - )) + (let ((ret (mime-viewer/parse-message ctl encoding))) + (prog1 + (switch-to-buffer (car ret)) + (if mother + (progn + (make-variable-buffer-local + 'mime/show-mode-old-window-configuration) + (setq mime/show-mode-old-window-configuration + (current-window-configuration)) + (make-variable-buffer-local 'mime/mother-buffer) + (setq mime/mother-buffer mother) + )) + (use-local-map mime/viewer-mode-map) + (make-variable-buffer-local 'mime::preview/content-list) + (setq mime::preview/content-list (nth 1 ret)) + (goto-char + (let ((ce (mime::preview-content-info/point-max + (car mime::preview/content-list) + )) + e) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (setq e (match-end 0)) + (if (<= e ce) + e + ce))) + (run-hooks 'mime/viewer-mode-hook) + ))) + +(defun mime-preview/point-content-number (point) + (save-window-excursion + (let ((pc (mime::point-preview-content (point))) + cinfo) + (switch-to-buffer (mime::preview-content-info/buffer pc)) + (setq cinfo (mime::preview-content-info/content-info pc)) + (mime::get-point-content-number (mime::content-info/point-min cinfo)) + ))) + +(defun mime-preview/cinfo-to-pcinfo (cinfo) + (let ((rpcl mime::preview/content-list) cell) + (catch 'tag + (while rpcl + (setq cell (car rpcl)) + (if (eq cinfo (mime::preview-content-info/content-info cell)) + (throw 'tag cell) + ) + (setq rpcl (cdr rpcl)) + )))) -(defun mime::preview/decode-content () +(defvar mime-preview/after-decoded-position nil) + +(defun mime-preview/decode-content () (interactive) (let ((pc (mime::point-preview-content (point)))) (if pc (let ((the-buf (current-buffer))) + (setq mime-preview/after-decoded-position (point)) (switch-to-buffer (mime::preview-content-info/buffer pc)) (mime::article/decode-content-region (mime::preview-content-info/content-info pc)) (if (eq (current-buffer) (mime::preview-content-info/buffer pc)) - (switch-to-buffer the-buf) - ) + (progn + (switch-to-buffer the-buf) + (goto-char mime-preview/after-decoded-position) + )) )))) (defun mime-viewer/play-content () (interactive) (let ((mime-viewer/decoding-mode "play")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/extract-content () (interactive) (let ((mime-viewer/decoding-mode "extract")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/print-content () (interactive) (let ((mime-viewer/decoding-mode "print")) - (mime::preview/decode-content) + (mime-preview/decode-content) )) (defun mime-viewer/up-content () @@ -988,7 +1101,7 @@ q Quit (mime-viewer/quit the-buf (mime::preview-content-info/buffer pc) ) - (setq r (mime::article/get-content-region (butlast cn))) + (setq r (mime-article/cnum-to-cinfo (butlast cn))) (switch-to-buffer the-buf) (catch 'tag (let ((rpcl mime::preview/content-list) cell) @@ -1036,9 +1149,9 @@ q Quit (defun mime-viewer/scroll-up-content (&optional h) (interactive) - (if (null h) + (or h (setq h (- (window-height) 1)) - ) + ) (let ((pcl mime::preview/content-list) (p (point)) np beg) @@ -1055,13 +1168,15 @@ q Quit (forward-line h) (if (> (point) np) (goto-char np) - ))) + ) + ;;(show-subtree) + )) (defun mime-viewer/scroll-down-content (&optional h) (interactive) - (if (null h) + (or h (setq h (- (window-height) 1)) - ) + ) (let ((pcl mime::preview/content-list) (p (point)) pp beg) @@ -1094,13 +1209,13 @@ q Quit (defun mime-viewer/quit (&optional the-buf buf) (interactive) - (if (null the-buf) + (or the-buf (setq the-buf (current-buffer)) - ) - (if (null buf) + ) + (or buf (setq buf (mime::preview-content-info/buffer (mime::point-preview-content (point)))) - ) + ) (let ((r (progn (switch-to-buffer buf) (assoc major-mode mime-viewer/quitting-method-alist) @@ -1117,6 +1232,10 @@ q Quit (kill-buffer (current-buffer)) ) -(fset 'mime/view-mode 'mime/viewer-mode) + +;;; @ end +;;; + +(provide 'tm-view) (run-hooks 'tm-view-load-hook)