X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=99411175d9fb1830829d4dd005e04cfd63b4d297;hb=06eb250d23400232bbfa623237ef175abd4983e3;hp=47667094b51181eb3179cd3f49f87a2438dfb622;hpb=db904b7b8d65a72da5b2c22ac95aa309995ed2bc;p=elisp%2Fsemi.git diff --git a/eword-decode.el b/eword-decode.el index 4766709..9941117 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -10,7 +10,7 @@ ;; Renamed: 1993/06/03 to tiny-mime.el ;; Renamed: 1995/10/03 from tiny-mime.el (split off encoder) ;; Renamed: 1997/02/22 from tm-ew-d.el -;; Version: $Revision: 0.2 $ +;; Version: $Revision: 0.16 $ ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). @@ -32,18 +32,16 @@ ;;; Code: -(require 'emu) -(require 'std11) +(require 'std11-parse) (require 'mel) (require 'mime-def) -(require 'tl-str) ;;; @ version ;;; (defconst eword-decode-RCS-ID - "$Id: eword-decode.el,v 0.2 1997-02-24 02:19:57 tmorioka Exp $") + "$Id: eword-decode.el,v 0.16 1997-06-18 13:26:28 morioka Exp $") (defconst eword-decode-version (get-version-string eword-decode-RCS-ID)) @@ -65,6 +63,43 @@ (regexp-quote "?="))) +;;; @@ Base64 +;;; + +(defconst base64-token-regexp "[A-Za-z0-9+/]") +(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") + +(defconst eword-B-encoded-text-regexp + (concat "\\(\\(" + base64-token-regexp + base64-token-regexp + base64-token-regexp + base64-token-regexp + "\\)*" + base64-token-regexp + base64-token-regexp + base64-token-padding-regexp + base64-token-padding-regexp + "\\)")) + +;; (defconst eword-B-encoding-and-encoded-text-regexp +;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) + + +;;; @@ Quoted-Printable +;;; + +(defconst quoted-printable-hex-chars "0123456789ABCDEF") +(defconst quoted-printable-octet-regexp + (concat "=[" quoted-printable-hex-chars + "][" quoted-printable-hex-chars "]")) + +(defconst eword-Q-encoded-text-regexp + (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) +;; (defconst eword-Q-encoding-and-encoded-text-regexp +;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) + + ;;; @ for string ;;; @@ -132,27 +167,26 @@ such as a version of Net$cape)." (replace-match "\\1\\6") (goto-char (point-min)) ) - (let (charset encoding text) - (while (re-search-forward eword-encoded-word-regexp nil t) - (insert (eword-decode-encoded-word - (prog1 - (buffer-substring (match-beginning 0) (match-end 0)) - (delete-region (match-beginning 0) (match-end 0)) - ) must-unfold)) - )) + (while (re-search-forward eword-encoded-word-regexp nil t) + (insert (eword-decode-encoded-word + (prog1 + (buffer-substring (match-beginning 0) (match-end 0)) + (delete-region (match-beginning 0) (match-end 0)) + ) must-unfold)) + ) ))) ;;; @ for message header ;;; -(defun eword-decode-header () - "Decode MIME encoded-words in header fields." +(defun eword-decode-header (&optional separator) + "Decode MIME encoded-words in header fields. +If SEPARATOR is not nil, it is used as header separator." (interactive "*") (save-excursion (save-restriction - (narrow-to-region (goto-char (point-min)) - (progn (re-search-forward "^$" nil t) (point))) + (std11-narrow-to-header separator) (eword-decode-region (point-min) (point-max) t) ))) @@ -177,6 +211,8 @@ such as a version of Net$cape)." ;;; @ encoded-word decoder ;;; +(defvar eword-warning-face nil "Face used for invalid encoded-word.") + (defun eword-decode-encoded-word (word &optional must-unfold) "Decode WORD if it is an encoded-word. @@ -200,11 +236,12 @@ as a version of Net$cape)." (condition-case err (eword-decode-encoded-text charset encoding text must-unfold) (error - (and (tl:add-text-properties 0 (length word) - (and tm:warning-face - (list 'face tm:warning-face)) - word) - word))) + (and + (add-text-properties 0 (length word) + (and eword-warning-face + (list 'face eword-warning-face)) + word) + word))) )) word)) @@ -259,6 +296,164 @@ as a version of Net$cape)." )))))) +;;; @ lexical analyze +;;; + +(defvar eword-lexical-analyze-cache nil) +(defvar eword-lexical-analyze-cache-max 299 + "*Max position of eword-lexical-analyze-cache. +It is max size of eword-lexical-analyze-cache - 1.") + +(defun eword-analyze-quoted-string (string) + (let ((p (std11-check-enclosure string ?\" ?\"))) + (if p + (cons (cons 'quoted-string + (decode-mime-charset-string + (std11-strip-quoted-pair (substring string 1 (1- p))) + default-mime-charset)) + (substring string p)) + ))) + +(defun eword-analyze-comment (string &optional must-unfold) + (let ((p (std11-check-enclosure string ?\( ?\) t))) + (if p + (cons (cons 'comment + (eword-decode-string + (decode-mime-charset-string + (std11-strip-quoted-pair (substring string 1 (1- p))) + default-mime-charset) + must-unfold)) + (substring string p)) + ))) + +(defun eword-analyze-encoded-word (string &optional must-unfold) + (if (eq (string-match eword-encoded-word-regexp string) 0) + (let ((end (match-end 0)) + (dest (eword-decode-encoded-word (match-string 0 string) + must-unfold)) + ) + (setq string (substring string end)) + (while (eq (string-match `,(concat "[ \t\n]*\\(" + eword-encoded-word-regexp + "\\)") + string) + 0) + (setq end (match-end 0)) + (setq dest + (concat dest + (eword-decode-encoded-word (match-string 1 string) + must-unfold)) + string (substring string end)) + ) + (cons (cons 'atom dest) + (if (string= string "") + nil + string)) + ))) + +(defun eword-lexical-analyze-internal (string must-unfold) + (let (dest ret) + (while (not (string-equal string "")) + (setq ret + (or (eword-analyze-quoted-string string) + (std11-analyze-domain-literal string) + (eword-analyze-comment string must-unfold) + (std11-analyze-spaces string) + (std11-analyze-special string) + (eword-analyze-encoded-word string must-unfold) + (std11-analyze-atom string) + '((error) . "") + )) + (setq dest (cons (car ret) dest)) + (setq string (cdr ret)) + ) + (nreverse dest) + )) + +(defun eword-lexical-analyze (string &optional must-unfold) + "Return lexical analyzed list corresponding STRING. +It is like std11-lexical-analyze, but it decodes non us-ascii +characters encoded as encoded-words or invalid \"raw\" format. +\"Raw\" non us-ascii characters are regarded as variable +`default-mime-charset'." + (let ((key (copy-sequence string)) + ret) + (set-text-properties 0 (length key) nil key) + (if (setq ret (assoc key eword-lexical-analyze-cache)) + (cdr ret) + (setq ret (eword-lexical-analyze-internal key must-unfold)) + (setq eword-lexical-analyze-cache + (cons (cons key ret) + (last eword-lexical-analyze-cache + eword-lexical-analyze-cache-max))) + ret))) + +(defun eword-decode-structured-field-body (string &optional must-unfold) + "Decode non us-ascii characters in STRING as structured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (mapconcat (function + (lambda (token) + (let ((type (car token)) + (value (cdr token))) + (cond ((eq type 'quoted-string) + (std11-wrap-as-quoted-string value) + ) + ((eq type 'comment) + (concat "(" + (std11-wrap-as-quoted-pairs value '(?( ?))) + ")") + ) + (t + value))))) + (eword-lexical-analyze string must-unfold) + "")) + +(defun eword-decode-unstructured-field-body (string &optional must-unfold) + "Decode non us-ascii characters in STRING as unstructured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (eword-decode-string + (decode-mime-charset-string string default-mime-charset) + must-unfold)) + +(defun eword-extract-address-components (string) + "Extract full name and canonical address from STRING. +Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). +If no name can be extracted, FULL-NAME will be nil. +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'." + (let* ((structure (car (std11-parse-address + (eword-lexical-analyze + (std11-unfold-string string) 'must-unfold)))) + (phrase (std11-full-name-string structure)) + (address (std11-address-string structure)) + ) + (list phrase address) + )) + + ;;; @ end ;;;