;;;
-;;; tm-ew-d.el --- RFC 1522 based multilingual MIME message header
+;;; tm-ew-e.el --- RFC 1522 based multilingual MIME message header
;;; encoder for GNU Emacs
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
-;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
;;;
-;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Version: $Revision: 7.18 $
;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
;;;
+;;; This file is part of tm (Tools for MIME).
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with This program. If not, write to the Free Software
+;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Code:
(require 'mel)
(require 'tl-822)
;;;
(defconst tm-ew-e/RCS-ID
- "$Id: tm-ew-e.el,v 7.5 1995/10/24 00:18:39 morioka Exp $")
-(defconst mime/eword-encoder-version (get-version-string tm-ew-e/RCS-ID))
+ "$Id: tm-ew-e.el,v 7.18 1996/05/09 18:08:47 morioka Exp $")
+(defconst mime-eword/encoder-version (get-version-string tm-ew-e/RCS-ID))
;;; @ variables
(defvar mime/use-X-Nsubject nil)
+(defvar mime-eword/charset-encoding-alist
+ '(("US-ASCII" . nil)
+ ("ISO-8859-1" . "Q")
+ ("ISO-8859-2" . "Q")
+ ("ISO-8859-3" . "Q")
+ ("ISO-8859-4" . "Q")
+;;; ("ISO-8859-5" . "Q")
+ ("KOI8-R" . "Q")
+ ("ISO-8859-7" . "Q")
+ ("ISO-8859-8" . "Q")
+ ("ISO-8859-9" . "Q")
+ ("ISO-2022-JP" . "B")
+ ("ISO-2022-KR" . "B")
+ ("EUC-KR" . "B")
+ ("ISO-2022-JP-2" . "B")
+ ("ISO-2022-INT-1" . "B")
+ ))
+
;;; @ encoded-text encoder
;;;
))
(defun tm-eword::parse-lc-word (str)
- (let* ((rest (string-to-char-list str))
- (chr (car rest))
+ (let* ((chr (sref str 0))
(lc (tm-eword::char-type chr))
- (p (char-bytes chr))
+ (i (char-bytes chr))
+ (len (length str))
)
- (catch 'tag
- (while (setq rest (cdr rest))
- (setq chr (car rest))
- (if (not (eq lc (tm-eword::char-type chr)))
- (throw 'tag nil)
- )
- (setq p (+ p (char-bytes chr)))
- ))
- (cons (cons lc (substring str 0 p)) (substring str p))
+ (while (and (< i len)
+ (setq chr (sref str i))
+ (eq lc (tm-eword::char-type chr))
+ )
+ (setq i (+ i (char-bytes chr)))
+ )
+ (cons (cons lc (substring str 0 i)) (substring str i))
))
(defun tm-eword::split-to-lc-words (str)
;;; @ rule
;;;
-(defun mime/find-charset-rule (lcl)
+(defun tm-eword::find-charset-rule (lcl)
(if lcl
- (let ((ret (some-element
- (function
- (lambda (elt)
- (subsetp lcl (car elt))
- ))
- mime/lc-charset-rule-list)
- ))
- (if ret
- (cdr ret)
- mime/unknown-charset-rule)
- )
- '(nil nil)
- ))
+ (let* ((charset (mime/find-charset lcl))
+ (encoding
+ (cdr (assoc charset mime-eword/charset-encoding-alist))
+ ))
+ (list charset encoding)
+ )))
(defun tm-eword::words-to-ruled-words (wl)
(mapcar (function
(lambda (word)
- (cons (cdr word) (mime/find-charset-rule (car word)))
+ (cons (cdr word) (tm-eword::find-charset-rule (car word)))
))
wl))
ret)
(setq ret
(cond ((equal encoding "B")
- (setq string
- (mime/convert-string-from-emacs string charset))
+ (setq string (mime-charset-encode-string string charset))
(base64-length string)
)
((equal encoding "Q")
- (setq string
- (mime/convert-string-from-emacs string charset))
+ (setq string (mime-charset-encode-string string charset))
(q-encoding-length string)
)))
(if ret
)
(t
(setq string (car rword))
- (let* ((ls (reverse (string-to-char-list string)))
- (sl (length string))
- (p sl) str)
- (while (and ls
+ (let* ((sl (length string))
+ (p 0) np
+ (str "") nstr)
+ (while (and (< p len)
(progn
- (setq p (- p (char-bytes (car ls))))
- (setq str (substring string 0 p))
+ (setq np (+ p (char-bytes (sref string p))))
+ (setq nstr (substring string 0 np))
(setq ret (tm-eword::encoded-word-length
- (cons str (cdr rword))
+ (cons nstr (cdr rword))
))
- (setq str (cdr ret))
+ (setq nstr (cdr ret))
(setq len (+ (car ret) column))
- (> len 76)
+ (<= len 76)
))
- (setq ls (cdr ls))
- )
- (if ls
- (progn
- (setq rwl (cons (cons (substring string p) (cdr rword))
- (cdr rwl)))
- (setq string
- (tm-eword::encode-encoded-text
- (nth 1 rword) (nth 2 rword) str))
- (setq len (+ (length string) column))
- )
- (setq string "\n ")
- (setq len 1)
+ (setq str nstr
+ p np))
+ (if (string-equal str "")
+ (setq string "\n "
+ len 1)
+ (setq rwl (cons (cons (substring string p) (cdr rword))
+ (cdr rwl)))
+ (setq string
+ (tm-eword::encode-encoded-text
+ (nth 1 rword) (nth 2 rword) str))
+ (setq len (+ (length string) column))
)
)))
)
))
(defun tm-eword::encode-rwl (column rwl &optional mode)
- (let (ret dest)
+ (let (ret dest ps special str)
(while rwl
(setq ret (tm-eword::encode-string-1 column rwl mode))
- (setq dest (concat dest (car ret))
- column (nth 1 ret)
+ (setq str (car ret))
+ (if (eq (elt str 0) ?\n)
+ (if (eq special ?\()
+ (progn
+ (setq dest (concat dest "\n ("))
+ (setq ret (tm-eword::encode-string-1 2 rwl mode))
+ (setq str (car ret))
+ ))
+ (cond ((eq special 32)
+ (if (string= str "(")
+ (setq ps t)
+ (setq dest (concat dest " "))
+ (setq ps nil)
+ ))
+ ((eq special ?\()
+ (if ps
+ (progn
+ (setq dest (concat dest " ("))
+ (setq ps nil)
+ )
+ (setq dest (concat dest "("))
+ )
+ )))
+ (cond ((string= str " ")
+ (setq special 32)
+ )
+ ((string= str "(")
+ (setq special ?\()
+ )
+ (t
+ (setq special nil)
+ (setq dest (concat dest str))
+ ))
+ (setq column (nth 1 ret)
rwl (nth 2 ret))
)
(list dest column)
(setq dest
(append dest
(list
- (cons str (mime/find-charset-rule
+ (cons str (tm-eword::find-charset-rule
(find-charset-string str)))
)))
)
(defun mime/encode-field (str)
(setq str (rfc822/unfolding-string str))
(let ((ret (string-match rfc822/field-top-regexp str)))
- (if ret
- (let ((field-name (substring str 0 (match-end 1)))
- (field-body (eliminate-top-spaces
- (substring str (match-end 0))))
- fname)
- (concat field-name ": "
- (cond ((string= field-body "") "")
- ((member (setq fname (downcase field-name))
- '("reply-to" "from" "sender"
- "resent-reply-to" "resent-from"
- "resent-sender" "to" "resent-to"
- "cc" "resent-cc"
- "bcc" "resent-bcc" "dcc")
- )
- (car (tm-eword::encode-address-list
- (+ (length field-name) 1) field-body))
- )
- (t
- (catch 'tag
- (let ((r mime/no-encoding-header-fields) fn)
- (while r
- (setq fn (car r))
- (if (string= (downcase fn) fname)
- (throw 'tag field-body)
- )
- (setq r (cdr r))
- ))
- (car (tm-eword::encode-string
- (+ (length field-name) 1) field-body))
- ))
- ))
- )
- str)))
+ (or (if ret
+ (let ((field-name (substring str 0 (match-end 1)))
+ (field-body (eliminate-top-spaces
+ (substring str (match-end 0))))
+ fname)
+ (if (setq ret
+ (cond ((string= field-body "") "")
+ ((member (setq fname (downcase field-name))
+ '("reply-to" "from" "sender"
+ "resent-reply-to" "resent-from"
+ "resent-sender" "to" "resent-to"
+ "cc" "resent-cc"
+ "bcc" "resent-bcc" "dcc")
+ )
+ (car (tm-eword::encode-address-list
+ (+ (length field-name) 1) field-body))
+ )
+ (t
+ (catch 'tag
+ (let ((r mime/no-encoding-header-fields)
+ fn)
+ (while r
+ (setq fn (car r))
+ (if (string= (downcase fn) fname)
+ (throw 'tag field-body)
+ )
+ (setq r (cdr r))
+ ))
+ (car (tm-eword::encode-string
+ (+ (length field-name) 1) field-body))
+ ))
+ ))
+ (concat field-name ": " ret)
+ )))
+ (tm-eword::encode-string 0 str)
+ )))
(defun mime/exist-encoded-word-in-subject ()
(let ((str (rfc822/get-field-body "Subject")))
(save-excursion
(save-restriction
(narrow-to-region (goto-char (point-min))
- (progn
- (re-search-forward
- (concat
- "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (match-beginning 0)
- ))
+ (if (re-search-forward
+ (concat
+ "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (match-beginning 0)
+ (point-max)))
(goto-char (point-min))
(let (beg end field)
(while (re-search-forward rfc822/field-top-regexp nil t)
;;;
(provide 'tm-ew-e)
+
+;;; tm-ew-e.el ends here
projects / elisp / tm.git / blobdiff