;;; 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 <enami@sys.ptg.sony.co.jp>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; 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: 1.6 $
;; 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
"Encoded-word decoding"
:group 'mime)
-
-;;; @ version
-;;;
-
-(defconst eword-decode-RCS-ID
- "$Id: eword-decode.el,v 1.6 1998-02-17 12:48:20 morioka Exp $")
-(defconst eword-decode-version (get-version-string eword-decode-RCS-ID))
+(defconst eword-decode-version
+ `,(mapconcat #'number-to-string (cddr mime-module-version) "."))
;;; @ MIME encoded-word definition
code-conversion
default-mime-charset))))
(if default-charset
- (let (beg end field-name len)
+ (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)
(let ((body (buffer-substring p end))
(default-mime-charset default-charset))
(delete-region p end)
- (insert (eword-decode-structured-field-body
+ (insert (eword-decode-and-fold-structured-field
body (1+ len)))
))
(t
"*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
(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
(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))
(cons (cons 'atom dest) string)
)))
-(defun eword-analyze-atom (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
(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)
- (eword-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))
)
(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.
such as a version of Net$cape)."
(if start-column
;; fold with max-column
- (let ((c start-column)
- (tokens (eword-lexical-analyze string must-unfold))
- (result ""))
- (or max-column
- (setq max-column fill-column))
- (while tokens
- (let* ((token (car tokens))
- (type (car token)))
- (setq tokens (cdr tokens))
- (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)))
- ))))
- result)
+ (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)
projects / elisp / semi.git / blobdiff