X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=0b2d19a4ae6be1aacddd1cab03d61dd68183e92e;hb=e3697d7a1aa5dd7b573c5ff3f320ed03fd6614bd;hp=108b28495cbe9fc491a6c2711cbff7e31bfce2e2;hpb=c24ae6d35282d7b2451761f46e5c87f11f85a38e;p=elisp%2Fflim.git diff --git a/eword-decode.el b/eword-decode.el index 108b284..0b2d19a 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -1,10 +1,10 @@ ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99,2000,01,03 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko -;; TANAKA Akira +;; MORIOKA Tomohiko +;; TANAKA Akira ;; Created: 1995/10/03 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. ;; Renamed: 1993/06/03 to tiny-mime.el by MORIOKA Tomohiko @@ -38,15 +38,11 @@ (eval-when-compile (require 'cl)) ; list*, pop -(defgroup eword-decode nil - "Encoded-word decoding" - :group 'mime) -(defcustom eword-max-size-to-decode 1000 - "*Max size to decode header field." - :group 'eword-decode - :type '(choice (integer :tag "Limit (bytes)") - (const :tag "Don't limit" nil))) +;;; @ Variables +;;; + +;; User options are defined in mime-def.el. ;;; @ MIME encoded-word definition @@ -59,13 +55,19 @@ (eval-when-compile (concat (regexp-quote "=?") "\\(" - mime-charset-regexp + mime-charset-regexp ; 1 "\\)" + "\\(" + (regexp-quote "*") + mime-language-regexp ; 2 + "\\)?" (regexp-quote "?") - "\\([BbQq]\\)" + "\\(" + mime-encoding-regexp ; 3 + "\\)" (regexp-quote "?") "\\(" - eword-encoded-text-regexp + eword-encoded-text-regexp ; 4 "\\)" (regexp-quote "?=")))) ) @@ -152,8 +154,8 @@ decode the charset included in it, it is not decoded." start-column &optional max-column start) - (if (and eword-max-size-to-decode - (> (length string) eword-max-size-to-decode)) + (if (and mime-field-decoding-max-size + (> (length string) mime-field-decoding-max-size)) string (or max-column (setq max-column fill-column)) @@ -228,7 +230,7 @@ such as a version of Net$cape)." "\\(\n?[ \t]\\)+" "\\(" eword-encoded-word-regexp "\\)") nil t) - (replace-match "\\1\\6") + (replace-match "\\1\\7") (goto-char (point-min)) ) (while (re-search-forward eword-encoded-word-regexp nil t) @@ -505,8 +507,8 @@ If SEPARATOR is not nil, it is used as header separator." )) code-conversion)) -;; (define-obsolete-function-alias 'eword-decode-header -;; 'mime-decode-header-in-buffer) +(defalias 'eword-decode-header 'mime-decode-header-in-buffer) +(make-obsolete 'eword-decode-header 'mime-decode-header-in-buffer) ;;; @ encoded-word decoder @@ -526,64 +528,66 @@ If SEPARATOR is not nil, it is used as header separator." word)) (defun eword-decode-encoded-word (word &optional must-unfold) - "Decode WORD if it is an encoded-word. - -If your emacs implementation can not decode the charset of WORD, it -returns WORD. Similarly the encoded-word is broken, it returns WORD. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-word (generated by bad manner MUA such -as a version of Net$cape)." - (or (if (string-match eword-encoded-word-regexp word) - (let ((charset - (substring word (match-beginning 1) (match-end 1)) - ) - (encoding - (upcase - (substring word (match-beginning 2) (match-end 2)) - )) - (text - (substring word (match-beginning 3) (match-end 3)) - )) - (condition-case err - (eword-decode-encoded-text charset encoding text must-unfold) - (error - (funcall eword-decode-encoded-word-error-handler word err) - )) - )) + "Decode WORD as an encoded-word. + +If charset is unknown or unsupported, return WORD. +If encoding is unknown, or some error occurs while decoding, +`eword-decode-encoded-word-error-handler' is called with WORD and an +error condition. + +If MUST-UNFOLD is non-nil, unfold decoded WORD." + (or (and (string-match eword-encoded-word-regexp word) + (condition-case err + (eword-decode-encoded-text + ;; charset + (substring word (match-beginning 1)(match-end 1)) + ;; language + (when (match-beginning 2) + (intern + (downcase + (substring word (1+ (match-beginning 2))(match-end 2))))) + ;; encoding + (upcase + (substring word (match-beginning 3)(match-end 3))) + ;; encoded-text + (substring word (match-beginning 4)(match-end 4)) + must-unfold) + (error + (funcall eword-decode-encoded-word-error-handler word err)))) word)) ;;; @ encoded-text decoder ;;; -(defun eword-decode-encoded-text (charset encoding string +(defun eword-decode-encoded-text (charset language encoding string &optional must-unfold) "Decode STRING as an encoded-text. If your emacs implementation can not decode CHARSET, it returns nil. +If LANGUAGE is non-nil, it is put to `mime-language' text-property. If ENCODING is not \"B\" or \"Q\", it occurs error. So you should write error-handling code if you don't want break by errors. If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even if there are in decoded encoded-text (generated by bad manner MUA such as a version of Net$cape)." - (let ((cs (mime-charset-to-coding-system charset))) - (if cs - (let ((dest (encoded-text-decode-string string encoding))) - (when dest - (setq dest (decode-mime-charset-string dest charset)) - (if must-unfold - (mapconcat (function - (lambda (chr) - (cond ((eq chr ?\n) "") - ((eq chr ?\t) " ") - (t (char-to-string chr))) - )) - (std11-unfold-string dest) - "") - dest)))))) + (when (mime-charset-to-coding-system charset) + (let ((dest (encoded-text-decode-string string encoding))) + (when dest + (setq dest (decode-mime-charset-string dest charset)) + (when must-unfold + (mapconcat + (function + (lambda (chr) + (cond ((eq chr ?\n) "") + ((eq chr ?\t) " ") + (t (char-to-string chr))))) + (std11-unfold-string dest) "")) + (when language + (put-text-property 0 (length dest) 'mime-language language dest)) + dest)))) ;;; @ lexical analyze @@ -594,7 +598,7 @@ as a version of Net$cape)." "*Max position of eword-lexical-analyze-cache. It is max size of eword-lexical-analyze-cache - 1.") -(defcustom eword-lexical-analyzer +(defvar mime-header-lexical-analyzer '(eword-analyze-quoted-string eword-analyze-domain-literal eword-analyze-comment @@ -614,21 +618,20 @@ format. Previous function is preferred to next function. If a function returns nil, next function is used. Otherwise the return value will -be the result." - :group 'eword-decode - :type '(repeat function)) +be the result.") (defun eword-analyze-quoted-string (string start &optional must-unfold) - (let ((p (std11-check-enclosure string ?\" ?\" nil start))) - (if p - (cons (cons 'quoted-string - (decode-mime-charset-string - (std11-strip-quoted-pair - (substring string (1+ start) (1- p))) - default-mime-charset)) - ;;(substring string p)) - p) - ))) + (let ((p (std11-check-enclosure string ?\" ?\" nil start)) + ret) + (when p + (setq ret (decode-mime-charset-string + (std11-strip-quoted-pair + (substring string (1+ start) (1- p))) + default-mime-charset)) + (if mime-header-accept-quoted-encoded-words + (setq ret (eword-decode-string ret))) + (cons (cons 'quoted-string ret) + p)))) (defun eword-analyze-domain-literal (string start &optional must-unfold) (std11-analyze-domain-literal string start)) @@ -747,7 +750,7 @@ be the result." dest ret) (while (< start len) (setq ret - (let ((rest eword-lexical-analyzer) + (let ((rest mime-header-lexical-analyzer) func r) (while (and (setq func (car rest)) (null @@ -755,7 +758,7 @@ be the result." ) (setq rest (cdr rest))) (or r - (list (cons 'error (substring string start)) (1+ len))) + (cons (cons 'error (substring string start)) (1+ len))) )) (setq dest (cons (car ret) dest) start (cdr ret))