X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=3f5a4c76c353bde7e138ed8b9c2d1e78ed858ebf;hb=a9db562a8f35ef550db391c1f5e55b922b13acfd;hp=99411175d9fb1830829d4dd005e04cfd63b4d297;hpb=d7cdc86861cabc33f6e897462392c141b9e935f1;p=elisp%2Fsemi.git diff --git a/eword-decode.el b/eword-decode.el index 9941117..3f5a4c7 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -1,6 +1,6 @@ ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko @@ -10,10 +10,9 @@ ;; 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.16 $ ;; Keywords: encoded-word, MIME, multilingual, header, mail, news -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). +;; This file is part of SEMI (Spadework for Emacs MIME Interfaces). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -36,13 +35,12 @@ (require 'mel) (require 'mime-def) +(defgroup eword-decode nil + "Encoded-word decoding" + :group 'mime) -;;; @ version -;;; - -(defconst eword-decode-RCS-ID - "$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)) +(defconst eword-decode-version + `,(mapconcat #'number-to-string (cdr semi-version) ".")) ;;; @ MIME encoded-word definition @@ -180,15 +178,72 @@ such as a version of Net$cape)." ;;; @ for message header ;;; -(defun eword-decode-header (&optional separator) +(defcustom eword-decode-ignored-field-list + '(newsgroups path lines nntp-posting-host message-id date) + "*List of field-names to be ignored when decoding. +Each field name must be symbol." + :group 'eword-decode + :type '(repeat symbol)) + +(defcustom eword-decode-structured-field-list + '(reply-to resent-reply-to from resent-from sender resent-sender + to resent-to cc resent-cc bcc resent-bcc dcc + mime-version content-type content-transfer-encoding + content-disposition) + "*List of field-names to decode as structured field. +Each field name must be symbol." + :group 'eword-decode + :type '(repeat symbol)) + +(defun eword-decode-header (&optional code-conversion separator) "Decode MIME encoded-words in header fields. +If CODE-CONVERSION is nil, it decodes only encoded-words. If it is +mime-charset, it decodes non-ASCII bit patterns as the mime-charset. +Otherwise it decodes non-ASCII bit patterns as the +default-mime-charset. If SEPARATOR is not nil, it is used as header separator." (interactive "*") (save-excursion (save-restriction (std11-narrow-to-header separator) - (eword-decode-region (point-min) (point-max) t) - ))) + (let ((default-charset + (if code-conversion + (if (mime-charset-to-coding-system code-conversion) + code-conversion + default-mime-charset)))) + (if default-charset + (let (beg p end field-name len) + (goto-char (point-min)) + (while (re-search-forward std11-field-head-regexp nil t) + (setq beg (match-beginning 0) + p (match-end 0) + field-name (buffer-substring beg (1- p)) + len (string-width field-name) + field-name (intern (downcase field-name)) + end (std11-field-end)) + (cond ((memq field-name eword-decode-ignored-field-list) + ;; Don't decode + ) + ((memq field-name eword-decode-structured-field-list) + ;; Decode as structured field + (let ((body (buffer-substring p end)) + (default-mime-charset default-charset)) + (delete-region p end) + (insert (eword-decode-and-fold-structured-field + body (1+ len))) + )) + (t + ;; Decode as unstructured field + (save-restriction + (narrow-to-region beg (1+ end)) + (decode-mime-charset-region p end default-charset) + (goto-char p) + (if (re-search-forward eword-encoded-word-regexp + nil t) + (eword-decode-region beg (point-max) 'unfold)) + ))))) + (eword-decode-region (point-min) (point-max) t) + ))))) (defun eword-decode-unfold () (goto-char (point-min)) @@ -304,7 +359,30 @@ as a version of Net$cape)." "*Max position of eword-lexical-analyze-cache. It is max size of eword-lexical-analyze-cache - 1.") -(defun eword-analyze-quoted-string (string) +(defcustom eword-lexical-analyzers + '(eword-analyze-quoted-string + eword-analyze-domain-literal + eword-analyze-comment + eword-analyze-spaces + eword-analyze-special + eword-analyze-encoded-word + eword-analyze-atom) + "*List of functions to return result of lexical analyze. +Each function must have two arguments: STRING and MUST-UNFOLD. +STRING is the target string to be analyzed. +If MUST-UNFOLD is not nil, each function must unfold and eliminate +bare-CR and bare-LF from the result even if they are included in +content of the encoded-word. +Each function must return nil if it can not analyze STRING as its +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)) + +(defun eword-analyze-quoted-string (string &optional must-unfold) (let ((p (std11-check-enclosure string ?\" ?\"))) (if p (cons (cons 'quoted-string @@ -314,6 +392,9 @@ It is max size of eword-lexical-analyze-cache - 1.") (substring string p)) ))) +(defun eword-analyze-domain-literal (string &optional must-unfold) + (std11-analyze-domain-literal string)) + (defun eword-analyze-comment (string &optional must-unfold) (let ((p (std11-check-enclosure string ?\( ?\) t))) (if p @@ -326,6 +407,12 @@ It is max size of eword-lexical-analyze-cache - 1.") (substring string p)) ))) +(defun eword-analyze-spaces (string &optional must-unfold) + (std11-analyze-spaces string)) + +(defun eword-analyze-special (string &optional must-unfold) + (std11-analyze-special string)) + (defun eword-analyze-encoded-word (string &optional must-unfold) (if (eq (string-match eword-encoded-word-regexp string) 0) (let ((end (match-end 0)) @@ -345,25 +432,30 @@ It is max size of eword-lexical-analyze-cache - 1.") must-unfold)) string (substring string end)) ) - (cons (cons 'atom dest) - (if (string= string "") - nil - string)) + (cons (cons 'atom dest) string) ))) +(defun eword-analyze-atom (string &optional must-unfold) + (if (string-match std11-atom-regexp string) + (let ((end (match-end 0))) + (cons (cons 'atom (decode-mime-charset-string + (substring string 0 end) + default-mime-charset)) + (substring string end) + )))) + (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) . "") - )) + (let ((rest eword-lexical-analyzers) + func r) + (while (and (setq func (car rest)) + (null (setq r (funcall func string must-unfold))) + ) + (setq rest (cdr rest))) + (or r `((error . ,string) . "")) + )) (setq dest (cons (car ret) dest)) (setq string (cdr ret)) ) @@ -388,7 +480,82 @@ characters encoded as encoded-words or invalid \"raw\" format. eword-lexical-analyze-cache-max))) ret))) -(defun eword-decode-structured-field-body (string &optional must-unfold) +(defun eword-decode-token (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)))) + +(defun eword-decode-and-fold-structured-field + (string start-column &optional max-column must-unfold) + "Decode and fold (fill) STRING as structured field body. +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 MAX-COLUMN is omitted, `fill-column' is used. + +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)." + (or max-column + (setq max-column fill-column)) + (let ((c start-column) + (tokens (eword-lexical-analyze string must-unfold)) + (result "") + token) + (while (and (setq token (car tokens)) + (setq tokens (cdr tokens))) + (let* ((type (car token))) + (if (eq type 'spaces) + (let* ((next-token (car tokens)) + (next-str (eword-decode-token next-token)) + (next-len (string-width next-str)) + (next-c (+ c next-len 1))) + (if (< next-c max-column) + (setq result (concat result " " next-str) + c next-c) + (setq result (concat result "\n " next-str) + c (1+ next-len))) + (setq tokens (cdr tokens)) + ) + (let* ((str (eword-decode-token token))) + (setq result (concat result str) + c (+ c (string-width str))) + )))) + (if token + (concat result (eword-decode-token token)) + result))) + +(defun eword-decode-and-unfold-structured-field (string) + "Decode and unfold STRING as structured field body. +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." + (let ((tokens (eword-lexical-analyze string 'must-unfold)) + (result "")) + (while tokens + (let* ((token (car tokens)) + (type (car token))) + (setq tokens (cdr tokens)) + (setq result + (if (eq type 'spaces) + (concat result " ") + (concat result (eword-decode-token token)) + )))) + result)) + +(defun eword-decode-structured-field-body (string &optional must-unfold + start-column max-column) "Decode non us-ascii characters in STRING as structured field body. STRING is unfolded before decoding. @@ -402,22 +569,15 @@ 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) - "")) + (if start-column + ;; fold with max-column + (eword-decode-and-fold-structured-field + string start-column max-column must-unfold) + ;; Don't fold + (mapconcat (function eword-decode-token) + (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.