From: akr Date: Mon, 4 Jan 1999 20:52:21 +0000 (+0000) Subject: * Sync up to flim-1_12_1 from flim-1_11_3. X-Git-Tag: doodle-1_12_0 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=58422837b07923805a9a1c02c60e965027909ea4;p=elisp%2Fflim.git * Sync up to flim-1_12_1 from flim-1_11_3. * mime-def.el (mime-library-product): Bump up to FLAM-DOODLE 1.12.0. --- diff --git a/ChangeLog b/ChangeLog index 5139df9..9121382 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,12 @@ 1999-01-04 Tanaka Akira + * Sync up to flim-1_12_1 from flim-1_11_3. + + * mime-def.el (mime-library-product): Bump up to FLAM-DOODLE + 1.12.0. + +1999-01-04 Tanaka Akira + * ew-var.el (ew-decode-field-syntax-alist): Add `x-face-version', `x-pgp-sig-version', `x-pgp-key-info' and `x-info'. @@ -1268,9 +1275,201 @@ * eword-decode.el: Copied from AKEMI branch of SEMI. -1998-10-27 Tanaka Akira +1998-12-02 MORIOKA Tomohiko + + * FLIM: Version 1.12.1 (Nishinoky-Dò)-A released. + +1998-11-30 MORIOKA Tomohiko + + * smtpmail.el (smtpmail-send-it): Add autoload cookie; use + `smtpmail-do-bcc' instead of `smtp-do-bcc'; modify for interface + change of `smtp-via-smtp'. + (smtpmail-do-bcc): New function (moved and renamed from + `smtp-do-bcc' of smtp.el). + +1998-08-06 Katsumi Yamaoka + + * lisp/smtp.el: Do not insert empty line at the end of message. + +1998-06-18 Shuhei KOBAYASHI + + * lisp/smtp.el (smtp-use-8bitmime): New variable. + (smtp-debug-info): Internal variable, now. + (smtp-make-fqdn): Renamed from `smtp-fqdn'. + (smtp-via-smtp): New implementation. + (smtp-send-command): Treat "PASS" as usual. + (smtp-do-bcc): Removed. + +1998-11-30 MORIOKA Tomohiko + + * smtpmail.el: New module (copied from Semi-gnus 6.8). + + * smtp.el: New module (copied from Semi-gnus 6.8). + + * FLIM-ELS: Add smtp.el and smtpmail.el. + +1998-11-30 MORIOKA Tomohiko + + * mime-def.el: Abolish function `eliminate-top-spaces' because it + is not used in FLIM. + +1998-11-29 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-mailbox-to-rword-list): Fix + problem in `eword-encode-addresses-to-rword-list'. + +1998-11-26 MORIOKA Tomohiko + + * std11.el (std11-full-name-string): fixed. + + * std11.el (std11-comment-value-to-string): fixed. + +1998-11-25 MORIOKA Tomohiko + + * NEWS (Changes in FLIM 1.12): New section. + +1998-11-25 MORIOKA Tomohiko + + * std11.el (std11-comment-value-to-string): New function. + (std11-full-name-string): Use `std11-comment-value-to-string'. + + * eword-decode.el (eword-parse-comment): New function. + (eword-analyze-comment): New implementation; use + `eword-parse-comment'; change representation. + (eword-decode-token): Modify for representation change of comment. + + +1998-11-16 MORIOKA Tomohiko + + * FLIM: Version 1.12.0 (Amagatsuji) was released. + +1998-11-14 Tanaka Akira + + * mel-b-ccl.el (ccl-cascading-read): Check consistency. + +1998-11-13 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-body): Abolish + non-used local variable. + +1998-11-12 Tanaka Akira + + * mel-b-ccl.el (mel-ccl-decode-b): Check `ccl-cascading-read' to + select implementation. + +1998-11-12 Tanaka Akira + + * mel-q-ccl.el (mel-ccl-encode-quoted-printable-generic): workaround + for mule-2.3@19.34. + +1998-11-12 Tanaka Akira + + * mel.el (mel-b-builtin): New variable. + +1998-11-10 Tanaka Akira + + * FLIM-ELS: require 'pccl. + (flim-modules): Check CCL availability by broken facility. + +1998-11-08 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-body): New + implementation; abolish optional argument `must-unfold'; delete + DOC-string. + (eword-decode-and-unfold-structured-field-body): Renamed from + `eword-decode-and-unfold-structured-field'; delete DOC-string. + (eword-decode-and-fold-structured-field-body): Renamed from + `eword-decode-and-fold-structured-field'; abolish optional + argument `must-unfold'; delete DOC-string. + (eword-decode-unstructured-field-body): Abolish optional argument + `must-unfold'; delete DOC-string. + (eword-decode-and-unfold-unstructured-field-body): Renamed from + `eword-decode-and-unfold-unstructured-field'; delete DOC-string. + (eword-decode-unfolded-unstructured-field-body): New function. + +1998-11-08 MORIOKA Tomohiko + + * mmgeneric.el (mime-insert-header-from-buffer): Use + `mime-find-field-presentation-method' and + `mime-find-field-decoder-internal'. + + * eword-decode.el (mime-find-field-presentation-method): New + macro. + (mime-find-field-decoder-internal): New function. + (mime-find-field-decoder): New implementation (use + mime-find-field-decoder-internal). + (mime-decode-header-in-region): Use + `mime-find-field-presentation-method' and + `mime-find-field-decoder-internal'. + +1998-11-08 MORIOKA Tomohiko + + * mmgeneric.el (mime-insert-header-from-buffer): Rename + field-presentation-mode `folding' to `wide'. + + * eword-decode.el: Rename field-presentation-modes from `native', + `folding', `unfolding', `unfolding-xover' to `plain', `wide', + `summary', `nov'. + +1998-11-07 Tanaka Akira + + * eword-decode.el (mime-set-field-decoder): Add mode `unfolding-xover'. + (mime-find-field-decoder): Ditto. + +1998-11-04 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-phrase-route-addr-to-rword-list): + Don't delete the front spaces. + (eword-encode-addresses-to-rword-list): Don't supplement space; + use `nconc' instead of `append'. + (eword-encode-msg-id-to-rword-list): Supplement the front space; + use `nconc' instead of `append'. + +1998-11-02 Tanaka Akira + + * eword-decode.el (mime-field-decoder-cache): New variable. + (mime-find-field-decoder): Use `mime-field-decoder-cache'. + (mime-update-field-decoder-cache): New variable. + (mime-update-field-decoder-cache): New function. + (mime-decode-header-in-region): Use `mime-field-decoder-cache'. + + * mmgeneric.el (mime-insert-header-from-buffer): Use + `mime-field-decoder-cache'. + +1998-11-02 MORIOKA Tomohiko + + * eword-decode.el (mime-decode-header-in-region): New function. + (mime-decode-header-in-buffer): Use function + `mime-decode-header-in-region'. + +1998-10-28 MORIOKA Tomohiko + + * mmgeneric.el (mime-insert-header-from-buffer): Refer + `mime-field-decoder-alist' instead of hard-coding. + + * mime.el (mime-read-field): Use `mime-decode-field-body'. + + * eword-decode.el (eword-decode-and-unfold-structured-field): Add + optional dummy argument `start-column' and `max-column'. + (eword-decode-structured-field-body): Change interface. + (eword-decode-unstructured-field-body): Change interface to add + optional dummy argument `start-column' and `max-column'. + (eword-decode-and-unfold-unstructured-field): Add optional dummy + argument `start-column' and `max-column'. + (mime-field-decoder-alist): New variable; abolish user option + `eword-decode-ignored-field-list' and + `eword-decode-structured-field-list'. + (mime-set-field-decoder): New function. + (mime-find-field-decoder): New function. + (mime-decode-field-body): New function; abolish function + `eword-decode-field-body'. + (mime-decode-header-in-buffer): Renamed from + `eword-decode-header'; refer `mime-field-decoder-alist' instead of + hard-coding; add obsolete alias `eword-decode-header'. + +1998-10-28 MORIOKA Tomohiko - * eword-encode.el (eword-encode-field-body): Unfold `field-body'. + * mime-def.el: Avoid compile error when edebug is missing. 1998-10-28 MORIOKA Tomohiko diff --git a/DOODLE-VERSION b/DOODLE-VERSION index 81df983..6302e83 100644 --- a/DOODLE-VERSION +++ b/DOODLE-VERSION @@ -25,7 +25,7 @@ Order is not significant. 19 $B>.F&(B $B$"$:$-(B 2.5R3.5/5.0 FLAM-DOODLE 1.11.0 20 $BIrF:Cc(B $B$($S$A$c(B 5.0R4.0/11.0 FLAM-DOODLE 1.11.1 21 $B??GCc(B $B$3$2$A$c(B 10R3.0/2.0 diff --git a/FLIM-ELS b/FLIM-ELS index 3167bc4..7debfc9 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -29,7 +29,7 @@ ew-compat mime mime-parse mmgeneric mmbuffer mmcooked mailcap - )) + smtp smtpmail)) (unless (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string))) @@ -39,11 +39,8 @@ (setq flim-modules (cons 'mel-b-el flim-modules)) ) -(if (and (featurep 'mule) - (not (or (and (boundp 'MULE) MULE) - (and (featurep 'xemacs) (< emacs-major-version 21)) - ))) - (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules))) - ) +(require 'pccl) +(unless-broken ccl-usable + (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules)))) ;;; FLIM-ELS ends here diff --git a/Makefile b/Makefile index 1d5939d..fa488ba 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,8 @@ # PACKAGE = flim -VERSION = 1.11.3 +API = 1.12 +RELEASE = 1 TAR = tar RM = /bin/rm -f @@ -24,6 +25,9 @@ GOMI = *.elc \ *.pg *.pgs *.tp *.tps *.toc *.aux *.log FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog +VERSION = $(API).$(RELEASE) +ARC_DIR = /pub/GNU/elisp/flim/$(PACKAGE)-$(API) +SEMI_ARC_DIR = /pub/GNU/elisp/semi/semi-1.12-for-flim-$(API) elc: ew-parse.el $(EMACS) $(FLAGS) -l FLIM-MK -f compile-flim $(PREFIX) $(LISPDIR) \ @@ -46,23 +50,22 @@ clean: tar: cvs commit - sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) \ - | sed s/\\\\./_/ | sed s/\\\\./_/`; \ + sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \ cd /tmp; \ cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ export -d $(PACKAGE)-$(VERSION) \ - -r $(PACKAGE)-`echo $(VERSION) | sed s/\\\\./_/ | sed s/\\\\./_/` \ + -r $(PACKAGE)-`echo $(VERSION) | tr . _` \ flim' cd /tmp; $(RM) $(PACKAGE)-$(VERSION)/ftp.in ; \ $(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION) - sed "s/VERSION/$(VERSION)/" < ftp.in > ftp + sed "s/VERSION/$(VERSION)/" < ftp.in | sed "s/API/$(API)/" > ftp release: - -$(RM) /pub/GNU/elisp/flim/$(PACKAGE)-$(VERSION).tar.gz - mv /tmp/$(PACKAGE)-$(VERSION).tar.gz /pub/GNU/elisp/flim/ - cd /pub/GNU/elisp/semi/ ; \ - ln -s ../flim/$(PACKAGE)-$(VERSION).tar.gz . + -$(RM) $(ARC_DIR)/$(PACKAGE)-$(VERSION).tar.gz + mv /tmp/$(PACKAGE)-$(VERSION).tar.gz $(ARC_DIR) + cd $(SEMI_ARC_DIR) ; \ + ln -s ../../flim/flim-$(API)/$(PACKAGE)-$(VERSION).tar.gz . ew-parse.el: ew-parse.scm lalr-el.scm -scm -f lalr-el.scm -f ew-parse.scm > ew-parse.out @@ -73,4 +76,3 @@ check: # The file BENCHMARK is not a part of FLAM-DOODLE because it is so large. benchmark: $(EMACS) $(FLAGS_CURDIR) -l ./BENCHMARK -eval '(report)' - diff --git a/NEWS b/NEWS index 7662287..09922a3 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,41 @@ FLIM NEWS --- history of major-changes. Copyright (C) 1998 Free Software Foundation, Inc. +* Changes in FLIM 1.12 + +** Restructure of field decoding features + +Introduce backend mechanism of field-decoder and +field-presentation-method to restructure field decoding features. + +Field-decoder is registered into variable `mime-field-decoder-alist'. +Each decoding function uses decoding method found from variable +`mime-field-decoder-alist'. + +New function `mime-set-field-decoder' is added to register field +decoding method. + +New function `mime-find-field-presentation-method' is added to get +`field-presentation-method' object corresponding with specified +field-presentation-mode. Field-presentation-mode must be `plain', +`wide', `summary' or `nov'. + +New function `mime-find-field-decoder' is added to find field decoding +method corresponding with field-name and field-presentation-mode. + +New function `mime-decode-field-body' is added. It is general field +decoder. + + +** Function `mime-decode-header-in-buffer' + +Renamed from `eword-decode-header'. `eword-decode-header' is defined +as obsolete alias. + + +** New function `mime-decode-header-in-region' + + * Changes in FLIM 1.11 ** New function `mime-insert-text-content' diff --git a/ew-compat.el b/ew-compat.el index be59e96..eaa55e7 100644 --- a/ew-compat.el +++ b/ew-compat.el @@ -1,6 +1,9 @@ (require 'ew-dec) (require 'eword-decode) +(require 'ew-line) +(eval-when-compile (require 'cl)) + (defun ew-gnus-structured-field-decoder (string) (if (fboundp 'ew-decode-field) (let ((ew-ignore-76bytes-limit t) @@ -10,7 +13,7 @@ (error (message "gnus-structured-field-decoder error: %s" string) (decode-mime-charset-string string 'x-ctext)))) - (eword-decode-and-unfold-structured-field string))) + (eword-decode-and-unfold-structured-field-body string))) (defun ew-gnus-unstructured-field-decoder (string) (if (fboundp 'ew-decode-field) @@ -23,3 +26,65 @@ (decode-mime-charset-string string 'x-ctext)))) (eword-decode-unstructured-field-body (std11-unfold-string string) 'must-unfold))) +(defun ew-mime-update-field-decoder-cache (field mode) + (let ((fun (cond + ((eq mode 'plain) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-decode-field field-name field-body)))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'wide) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-crlf-refold + (ew-decode-field field-name field-body) + (length field-name) + (or max-column fill-column))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'summary) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'nov) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (require 'ew-var) + (let ((ew-ignore-76bytes-limit t)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res))))) + (t + nil)))) + (mime-update-field-decoder-cache field mode fun))) + +(setq mime-update-field-decoder-cache 'ew-mime-update-field-decoder-cache) diff --git a/eword-decode.el b/eword-decode.el index c5c722c..3c4837f 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -37,6 +37,9 @@ (require 'mime-def) (require 'ew-dec) +(require 'ew-line) + +(eval-when-compile (require 'cl)) (defgroup eword-decode nil "Encoded-word decoding" @@ -322,23 +325,30 @@ default-mime-charset." code-conversion must-unfold)) -(defun eword-decode-and-fold-structured-field - (string start-column &optional max-column must-unfold) - "Decode and fold (fill) STRING as structured field body. +(defun eword-decode-structured-field-body (string + &optional + start-column max-column) + (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) + (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) + (ew-crlf-to-lf decoded))) + +(defun eword-decode-and-unfold-structured-field-body (string + &optional + start-column + max-column) + "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. - -If MAX-COLUMN is omitted, `fill-column' is used. +decode the charset included in it, it is not decoded." + (let* ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) + (ew-crlf-to-lf (ew-crlf-unfold 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)." - (rotate-memo args-eword-decode-and-fold-structured-field - (list string start-column max-column must-unfold)) +(defun eword-decode-and-fold-structured-field-body (string + start-column + &optional max-column) (or max-column (setq max-column fill-column)) (let* ((field-name (make-string (1- start-column) ?X)) @@ -349,76 +359,22 @@ such as a version of Net$cape)." (setq decoded (ew-crlf-refold decoded start-column max-column))) (ew-crlf-to-lf decoded))) -(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." - (rotate-memo args-eword-decode-and-unfold-structured-field (list string)) - (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) - (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf (ew-crlf-unfold decoded)))) - -(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. - -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)." - (rotate-memo args-eword-decode-structured-field-body - (list string must-unfold start-column max-column)) - (if start-column - ;; fold with max-column - (eword-decode-and-fold-structured-field - string start-column max-column must-unfold) - ;; Don't fold - (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) - (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf decoded)))) - -(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. +(defun eword-decode-unstructured-field-body (string &optional start-column + max-column) + (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) + (ew-crlf-to-lf 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)." - (rotate-memo args-eword-decode-unstructured-field-body - (list string must-unfold)) +(defun eword-decode-and-unfold-unstructured-field-body (string + &optional start-column + max-column) (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) (ew-crlf-to-lf (ew-crlf-unfold decoded)))) -(defun eword-decode-and-unfold-unstructured-field (string) - "Decode and unfold STRING as unstructured 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." - (rotate-memo args-eword-decode-and-unfold-unstructured-field - (list string)) +(defun eword-decode-unfolded-unstructured-field-body (string + &optional start-column + max-column) (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf (ew-crlf-unfold decoded)))) + (ew-crlf-to-lf decoded))) ;;; @ for region @@ -454,59 +410,271 @@ default-mime-charset." (delete-region (point-min) (point-max)) (insert str))))) +(defun eword-decode-unfold () + (goto-char (point-min)) + (let (field beg end) + (while (re-search-forward std11-field-head-regexp nil t) + (setq beg (match-beginning 0) + end (std11-field-end)) + (setq field (buffer-substring beg end)) + (if (string-match eword-encoded-word-regexp field) + (save-restriction + (narrow-to-region (goto-char beg) end) + (while (re-search-forward "\n\\([ \t]\\)" nil t) + (replace-match (match-string 1)) + ) + (goto-char (point-max)) + )) + ))) ;;; @ for message header ;;; -(defcustom eword-decode-ignored-field-list - '(Newsgroups Path Lines Nntp-Posting-Host Received 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 - Mail-Followup-To - Mime-Version Content-Type Content-Transfer-Encoding - Content-Disposition User-Agent) - "*List of field-names to decode as structured field. -Each field name must be symbol." - :group 'eword-decode - :type '(repeat symbol)) +(defvar mime-field-decoder-alist nil) + +(defvar mime-field-decoder-cache nil) -(defun eword-decode-field-body - (field-body field-name &optional unfolded max-column) - "Decode FIELD-BODY as FIELD-NAME, and return the result. +(defvar mime-update-field-decoder-cache 'ew-mime-update-field-decoder-cache + "*Field decoder cache update function.") + +;;;###autoload +(defun mime-set-field-decoder (field &rest specs) + "Set decoder of FILED. +SPECS must be like `MODE1 DECODER1 MODE2 DECODER2 ...'. +Each mode must be `nil', `plain', `wide', `summary' or `nov'. +If mode is `nil', corresponding decoder is set up for every modes." + (when specs + (let ((mode (pop specs)) + (function (pop specs))) + (if mode + (progn + (let ((cell (assq mode mime-field-decoder-alist))) + (if cell + (setcdr cell (put-alist field function (cdr cell))) + (setq mime-field-decoder-alist + (cons (cons mode (list (cons field function))) + mime-field-decoder-alist)) + )) + (apply (function mime-set-field-decoder) field specs) + ) + (mime-set-field-decoder field + 'plain function + 'wide function + 'summary function + 'nov function) + )))) -If UNFOLDED is non-nil, it is assumed that FIELD-BODY is -already unfolded. +;;;###autoload +(defmacro mime-find-field-presentation-method (name) + "Return field-presentation-method from NAME. +NAME must be `plain', `wide', `summary' or `nov'." + (cond ((eq name nil) + `(or (assq 'summary mime-field-decoder-cache) + '(summary)) + ) + ((and (consp name) + (car name) + (consp (cdr name)) + (symbolp (car (cdr name))) + (null (cdr (cdr name)))) + `(or (assq ,name mime-field-decoder-cache) + (cons ,name nil)) + ) + (t + `(or (assq (or ,name 'summary) mime-field-decoder-cache) + (cons (or ,name 'summary) nil)) + ))) + +(defun mime-find-field-decoder-internal (field &optional mode) + "Return function to decode field-body of FIELD in MODE. +Optional argument MODE must be object of field-presentation-method." + (cdr (or (assq field (cdr mode)) + (prog1 + (funcall mime-update-field-decoder-cache + field (car mode)) + (setcdr mode + (cdr (assq (car mode) mime-field-decoder-cache))) + )))) + +;;;###autoload +(defun mime-find-field-decoder (field &optional mode) + "Return function to decode field-body of FIELD in MODE. +Optional argument MODE must be object or name of +field-presentation-method. Name of field-presentation-method must be +`plain', `wide', `summary' or `nov'. +Default value of MODE is `summary'." + (if (symbolp mode) + (let ((p (cdr (mime-find-field-presentation-method mode)))) + (if (and p (setq p (assq field p))) + (cdr p) + (cdr (funcall mime-update-field-decoder-cache + field (or mode 'summary))))) + (inline (mime-find-field-decoder-internal field mode)) + )) -If MAX-COLUMN is non-nil, the result is folded with MAX-COLUMN -or `fill-column' if MAX-COLUMN is t. -Otherwise, the result is unfolded. +;;;###autoload +(defun mime-update-field-decoder-cache (field mode &optional function) + "Update field decoder cache `mime-field-decoder-cache'." + (cond ((eq function 'identity) + (setq function nil) + ) + ((null function) + (let ((decoder-alist + (cdr (assq (or mode 'summary) mime-field-decoder-alist)))) + (setq function (cdr (or (assq field decoder-alist) + (assq t decoder-alist))))) + )) + (let ((cell (assq mode mime-field-decoder-cache)) + ret) + (if cell + (if (setq ret (assq field (cdr cell))) + (setcdr ret function) + (setcdr cell (cons (setq ret (cons field function)) (cdr cell)))) + (setq mime-field-decoder-cache + (cons (cons mode (list (setq ret (cons field function)))) + mime-field-decoder-cache))) + ret)) + +;; ignored fields +(mime-set-field-decoder 'Archive nil nil) +(mime-set-field-decoder 'Content-Md5 nil nil) +(mime-set-field-decoder 'Control nil nil) +(mime-set-field-decoder 'Date nil nil) +(mime-set-field-decoder 'Distribution nil nil) +(mime-set-field-decoder 'Followup-Host nil nil) +(mime-set-field-decoder 'Followup-To nil nil) +(mime-set-field-decoder 'Lines nil nil) +(mime-set-field-decoder 'Message-Id nil nil) +(mime-set-field-decoder 'Newsgroups nil nil) +(mime-set-field-decoder 'Nntp-Posting-Host nil nil) +(mime-set-field-decoder 'Path nil nil) +(mime-set-field-decoder 'Posted-And-Mailed nil nil) +(mime-set-field-decoder 'Received nil nil) +(mime-set-field-decoder 'Status nil nil) +(mime-set-field-decoder 'X-Face nil nil) +(mime-set-field-decoder 'X-Face-Version nil nil) +(mime-set-field-decoder 'X-Info nil nil) +(mime-set-field-decoder 'X-Pgp-Key-Info nil nil) +(mime-set-field-decoder 'X-Pgp-Sig nil nil) +(mime-set-field-decoder 'X-Pgp-Sig-Version nil nil) +(mime-set-field-decoder 'Xref nil nil) + +;; structured fields +(let ((fields + '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender + To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc + Mail-Followup-To + Mime-Version Content-Type Content-Transfer-Encoding + Content-Disposition User-Agent)) + field) + (while fields + (setq field (pop fields)) + (mime-set-field-decoder + field + 'plain #'eword-decode-structured-field-body + 'wide #'eword-decode-and-fold-structured-field-body + 'summary #'eword-decode-and-unfold-structured-field-body + 'nov #'eword-decode-and-unfold-structured-field-body) + )) -MIME encoded-word in FIELD-BODY is recognized according to -`eword-decode-ignored-field-list', -`eword-decode-structured-field-list' and FIELD-NAME. +;; unstructured fields (default) +(mime-set-field-decoder + t + 'plain #'eword-decode-unstructured-field-body + 'wide #'eword-decode-unstructured-field-body + 'summary #'eword-decode-and-unfold-unstructured-field-body + 'nov #'eword-decode-unfolded-unstructured-field-body) + +;;;###autoload +(defun ew-mime-update-field-decoder-cache (field mode) + (let ((fun (cond + ((eq mode 'plain) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-decode-field field-name field-body)))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'wide) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-crlf-refold + (ew-decode-field field-name field-body) + (length field-name) + (or max-column fill-column))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'summary) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'nov) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (require 'ew-var) + (let ((ew-ignore-76bytes-limit t)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res))))) + (t + nil)))) + (mime-update-field-decoder-cache field mode fun))) + +;;;###autoload +(defun mime-decode-field-body (field-body field-name + &optional mode max-column) + "Decode FIELD-BODY as FIELD-NAME in MODE, and return the result. +Optional argument MODE must be `plain', `wide', `summary' or `nov'. +Default mode is `summary'. + +If MODE is `wide' and MAX-COLUMN is non-nil, the result is folded with +MAX-COLUMN. Non MIME encoded-word part in FILED-BODY is decoded with `default-mime-charset'." + (unless mode (setq mode 'summary)) (if (symbolp field-name) (setq field-name (symbol-name field-name))) (let ((decoded - (if unfolded + (if (eq mode 'nov) (let ((ew-ignore-76bytes-limit t)) (ew-decode-field field-name (ew-lf-crlf-to-crlf field-body))) (ew-decode-field field-name (ew-lf-crlf-to-crlf field-body))))) - (if max-column + (if (and (eq mode 'wide) max-column) (setq decoded (ew-crlf-refold decoded (1+ (string-width field-name)) - (if (eq max-column t) fill-column max-column))) - (setq decoded (ew-crlf-unfold decoded))) + max-column)) + (if (not (eq mode 'plain)) + (setq decoded (ew-crlf-unfold decoded)))) (setq decoded (ew-crlf-to-lf decoded)) (add-text-properties 0 (length decoded) (list 'original-field-name field-name @@ -514,7 +682,53 @@ Non MIME encoded-word part in FILED-BODY is decoded with decoded) decoded)) -(defun eword-decode-header (&optional code-conversion separator) +;;;###autoload +(defun mime-decode-header-in-region (start end + &optional code-conversion) + "Decode MIME encoded-words in region between START and END. +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." + (interactive "*r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (let ((default-charset + (if code-conversion + (if (mime-charset-to-coding-system code-conversion) + code-conversion + default-mime-charset)))) + (if default-charset + (let ((mode-obj (mime-find-field-presentation-method 'wide)) + beg p end field-name-sym len field-decoder + field-name field-body) + (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-sym (intern (capitalize field-name)) + field-decoder (inline + (mime-find-field-decoder-internal + field-name-sm mode-obj))) + (when field-decoder + (setq end (std11-field-end) + field-body (buffer-substring p end)) + (let ((default-mime-charset default-charset)) + (delete-region p end) + (insert (funcall field-decoder field-body (1+ len))) + )) + (add-text-properties beg (min (1+ (point)) (point-max)) + (list 'original-field-name field-name + 'original-field-body field-body)) + )) + (eword-decode-region (point-min) (point-max) t) + ))))) + +;;;###autoload +(defun mime-decode-header-in-buffer (&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. @@ -522,59 +736,20 @@ Otherwise it decodes non-ASCII bit patterns as the default-mime-charset. If SEPARATOR is not nil, it is used as header separator." (interactive "*") - (rotate-memo args-eword-decode-header (list code-conversion)) - (unless code-conversion - (message "eword-decode-header is called without code-conversion") - (sit-for 2)) - (if (and code-conversion - (not (mime-charset-to-coding-system code-conversion))) - (setq code-conversion default-mime-charset)) - (save-excursion - (save-restriction - (std11-narrow-to-header separator) - (rotate-memo args-h-eword-decode-header (buffer-substring (point-min) (point-max))) - (if code-conversion - (let (beg p end field-name field-body decoded) - (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)) - end (std11-field-end) - field-body (ew-lf-crlf-to-crlf - (buffer-substring p end)) - decoded (ew-decode-field - field-name field-body)) - (unless (equal field-body decoded) - (setq decoded (ew-crlf-refold - decoded - (1+ (string-width field-name)) - fill-column))) - (delete-region p end) - (insert (ew-crlf-to-lf decoded)) - (add-text-properties beg (min (1+ (point)) (point-max)) - (list 'original-field-name field-name - 'original-field-body field-body)) - )) - (eword-decode-region (point-min) (point-max) t nil nil) - )))) - -(defun eword-decode-unfold () - (goto-char (point-min)) - (let (field beg end) - (while (re-search-forward std11-field-head-regexp nil t) - (setq beg (match-beginning 0) - end (std11-field-end)) - (setq field (buffer-substring beg end)) - (if (string-match eword-encoded-word-regexp field) - (save-restriction - (narrow-to-region (goto-char beg) end) - (while (re-search-forward "\n\\([ \t]\\)" nil t) - (replace-match (match-string 1)) - ) - (goto-char (point-max)) - )) - ))) + (mime-decode-header-in-region + (point-min) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\(" (regexp-quote (or separator "")) "\\)?$") + nil t) + (match-beginning 0) + (point-max) + )) + code-conversion)) + +(define-obsolete-function-alias 'eword-decode-header + 'mime-decode-header-in-buffer) ;;; @ encoded-word decoder @@ -717,6 +892,7 @@ be the result." (substring string p))) nil))) + (defun eword-analyze-spaces (string &optional must-unfold) (std11-analyze-spaces string)) diff --git a/eword-encode.el b/eword-encode.el index c87d5fa..80d2ee6 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -473,9 +473,9 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (let ((phrase (nth 1 phrase-route-addr)) (route (nth 2 phrase-route-addr)) dest) - (if (eq (car (car phrase)) 'spaces) - (setq phrase (cdr phrase)) - ) + ;; (if (eq (car (car phrase)) 'spaces) + ;; (setq phrase (cdr phrase)) + ;; ) (setq dest (eword-encode-phrase-to-rword-list phrase)) (if dest (setq dest (append dest '((" " nil nil)))) @@ -506,7 +506,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is '((" " nil nil) ("(" nil nil)) (eword-encode-split-string comment 'comment) - '((")" nil nil)) + (list '(")" nil nil)) ))) dest)) @@ -515,18 +515,19 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (if dest (while (setq addresses (cdr addresses)) (setq dest - (append dest - '(("," nil nil)) - '((" " nil nil)) - (eword-encode-mailbox-to-rword-list (car addresses)) - )) + (nconc dest + (list '("," nil nil)) + ;; (list '(" " nil nil)) + (eword-encode-mailbox-to-rword-list (car addresses)) + )) )) dest)) (defsubst eword-encode-msg-id-to-rword-list (msg-id) - (cons '("<" nil nil) - (append (eword-encode-addr-seq-to-rword-list (cdr msg-id)) - '((">" nil nil))))) + (cons '(" " nil nil) + (cons '("<" nil nil) + (nconc (eword-encode-addr-seq-to-rword-list (cdr msg-id)) + '((">" nil nil)))))) (defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to) (let (dest) diff --git a/ftp.in b/ftp.in index 80b8381..e79cb27 100644 --- a/ftp.in +++ b/ftp.in @@ -2,12 +2,12 @@ It is available from - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/flim/ + ftp://ftp.jaist.ac.jp/pub/GNU/elisp/flim/flim-API --[[message/external-body; access-type=anon-ftp; site="ftp.jaist.ac.jp"; - directory="/pub/GNU/elisp/flim"; + directory="/pub/GNU/elisp/flim/flim-API"; name="flim-VERSION.tar.gz"; mode=image]] Content-Type: application/octet-stream; diff --git a/mel-b-ccl.el b/mel-b-ccl.el index b01650c..e9e7f16 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -143,96 +143,145 @@ abcdefghijklmnopqrstuvwxyz\ ) -(define-ccl-program mel-ccl-decode-b - `(1 - (loop - (read r0 r1 r2 r3) - (r4 = r0 ,mel-ccl-decode-b-0-table) - (r5 = r1 ,mel-ccl-decode-b-1-table) - (r4 |= r5) - (r5 = r2 ,mel-ccl-decode-b-2-table) - (r4 |= r5) - (r5 = r3 ,mel-ccl-decode-b-3-table) - (r4 |= r5) - (if (r4 & ,(lognot (1- (lsh 1 24)))) - ((loop - (if (r4 & ,(lsh 1 24)) - ((r0 = r1) (r1 = r2) (r2 = r3) (read r3) - (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) - (r5 = r3 ,mel-ccl-decode-b-3-table) - (r4 |= r5) - (repeat)) - (break))) - (loop - (if (r4 & ,(lsh 1 25)) - ((r1 = r2) (r2 = r3) (read r3) - (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) - (r5 = r3 ,mel-ccl-decode-b-3-table) - (r4 |= r5) - (repeat)) - (break))) - (loop - (if (r2 != ?=) - (if (r4 & ,(lsh 1 26)) - ((r2 = r3) (read r3) - (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) - (r5 = r3 ,mel-ccl-decode-b-3-table) - (r4 |= r5) - (repeat)) - ((r6 = 0) - (break))) - ((r6 = 1) - (break)))) - (loop - (if (r3 != ?=) - (if (r4 & ,(lsh 1 27)) - ((read r3) - (r4 = r3 ,mel-ccl-decode-b-3-table) - (repeat)) - (break)) - ((r6 |= 2) - (break)))) - (r4 = r0 ,mel-ccl-decode-b-0-table) - (r5 = r1 ,mel-ccl-decode-b-1-table) - (r4 |= r5) - (branch - r6 - ;; BBBB - ((r5 = r2 ,mel-ccl-decode-b-2-table) +(check-broken-facility ccl-cascading-read) + +(if-broken ccl-cascading-read + (define-ccl-program mel-ccl-decode-b + `(1 + (loop + (loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (cond + ((or (eq v nil) (eq v t)) '(repeat)) + (t `((r0 = ,(lsh v 2)) (break))))) + mel-ccl-256-to-64-table))) + (loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (cond + ((or (eq v nil) (eq v t)) '(repeat)) + ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break))) + (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break))))) + mel-ccl-256-to-64-table))) + (loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (cond + ((eq v nil) '(repeat)) + ((eq v t) '(end)) + ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break))) + (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break))))) + mel-ccl-256-to-64-table))) + (loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (cond + ((eq v nil) '(repeat)) + ((eq v t) '(end)) + (t `((r0 |= ,v) (write r0) (break))))) + mel-ccl-256-to-64-table))) + (repeat)))) + (define-ccl-program mel-ccl-decode-b + `(1 + (loop + (read r0 r1 r2 r3) + (r4 = r0 ,mel-ccl-decode-b-0-table) + (r5 = r1 ,mel-ccl-decode-b-1-table) + (r4 |= r5) + (r5 = r2 ,mel-ccl-decode-b-2-table) + (r4 |= r5) + (r5 = r3 ,mel-ccl-decode-b-3-table) + (r4 |= r5) + (if (r4 & ,(lognot (1- (lsh 1 24)))) + ((loop + (if (r4 & ,(lsh 1 24)) + ((r0 = r1) (r1 = r2) (r2 = r3) (read r3) + (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) + (r5 = r3 ,mel-ccl-decode-b-3-table) + (r4 |= r5) + (repeat)) + (break))) + (loop + (if (r4 & ,(lsh 1 25)) + ((r1 = r2) (r2 = r3) (read r3) + (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) + (r5 = r3 ,mel-ccl-decode-b-3-table) + (r4 |= r5) + (repeat)) + (break))) + (loop + (if (r2 != ?=) + (if (r4 & ,(lsh 1 26)) + ((r2 = r3) (read r3) + (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) + (r5 = r3 ,mel-ccl-decode-b-3-table) + (r4 |= r5) + (repeat)) + ((r6 = 0) + (break))) + ((r6 = 1) + (break)))) + (loop + (if (r3 != ?=) + (if (r4 & ,(lsh 1 27)) + ((read r3) + (r4 = r3 ,mel-ccl-decode-b-3-table) + (repeat)) + (break)) + ((r6 |= 2) + (break)))) + (r4 = r0 ,mel-ccl-decode-b-0-table) + (r5 = r1 ,mel-ccl-decode-b-1-table) (r4 |= r5) - (r5 = r3 ,mel-ccl-decode-b-3-table) - (r4 |= r5) - (r4 >8= 0) - (write r7) - (r4 >8= 0) - (write r7) - (write-repeat r4)) - ;; error: BB=B - ((write (r4 & 255)) - (end)) - ;; BBB= - ((r5 = r2 ,mel-ccl-decode-b-2-table) - (r4 |= r5) - (r4 >8= 0) - (write r7) - (write (r4 & 255)) - (end) ; Excessive (end) is workaround for XEmacs 21.0. + (branch + r6 + ;; BBBB + ((r5 = r2 ,mel-ccl-decode-b-2-table) + (r4 |= r5) + (r5 = r3 ,mel-ccl-decode-b-3-table) + (r4 |= r5) + (r4 >8= 0) + (write r7) + (r4 >8= 0) + (write r7) + (write-repeat r4)) + ;; error: BB=B + ((write (r4 & 255)) + (end)) + ;; BBB= + ((r5 = r2 ,mel-ccl-decode-b-2-table) + (r4 |= r5) + (r4 >8= 0) + (write r7) + (write (r4 & 255)) + (end) ; Excessive (end) is workaround for XEmacs 21.0. ; Without this, "AAA=" is converted to "^@^@^@". - (end)) - ;; BB== - ((write (r4 & 255)) - (end)))) - ((r4 >8= 0) - (write r7) - (r4 >8= 0) - (write r7) - (write-repeat r4)))))) + (end)) + ;; BB== + ((write (r4 & 255)) + (end)))) + ((r4 >8= 0) + (write r7) + (r4 >8= 0) + (write r7) + (write-repeat r4)))))) + ) (eval-when-compile ;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK ;; is not executed. -(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline) +(defun mel-ccl-encode-base64-generic + (&optional quantums-per-line output-crlf terminate-with-newline) `(2 ((r3 = 0) (loop diff --git a/mel-q-ccl.el b/mel-q-ccl.el index 17b58be..116994e 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -496,7 +496,7 @@ abcdefghijklmnopqrstuvwxyz\ (write ,(if output-crlf "=\r\n" "=\n")) (write r0) (write "=0D") - (r0 = r1) + (r0 = (r1 + 0)) ; "+ 0" is workaround for mule 2.3@19.34. (break)) ;; r0:r3=ENC CR r1:noLF ((r6 = 6) @@ -505,7 +505,7 @@ abcdefghijklmnopqrstuvwxyz\ (write r0 ,mel-ccl-high-table) (write r0 ,mel-ccl-low-table) (write "=0D") - (r0 = r1) + (r0 = (r1 + 0)) (break)))) ;; r0:r3={RAW,ENC} r1:noCR ;; r0:r3={RAW,ENC} r1:noCRLF @@ -517,7 +517,7 @@ abcdefghijklmnopqrstuvwxyz\ (r5 = 0) (write ,(if output-crlf "=\r\n" "=\n")) (write r0) - (r0 = r1) + (r0 = (r1 + 0)) (break)) ;; r0:r3=ENC r1:noCR ;; r0:r3=ENC r1:noCRLF @@ -526,7 +526,7 @@ abcdefghijklmnopqrstuvwxyz\ (write ,(if output-crlf "=\r\n=" "=\n=")) (write r0 ,mel-ccl-high-table) (write r0 ,mel-ccl-low-table) - (r0 = r1) + (r0 = (r1 + 0)) (break))))))) (repeat))) ;; EOF @@ -712,7 +712,7 @@ abcdefghijklmnopqrstuvwxyz\ ((setq tmp (nth r0 mel-ccl-256-to-16-table)) ;; '=' [\t ]* r0:[0-9A-F] ;; upper nibble of hexadecimal digit found. - `((r1 = r0) + `((r1 = (r0 + 0)) (r0 = ,tmp))) (t ;; '=' [\t ]* r0:[^\r0-9A-F] @@ -744,7 +744,7 @@ abcdefghijklmnopqrstuvwxyz\ ;; invalid input -> ;; output "=" with hex digit and rescan from r2. (write ?=) - (r0 = r2) + (r0 = (r2 + 0)) (write-repeat r1))) (t ;; r0:[^\t\r -~] diff --git a/mel.el b/mel.el index ccfc072..c8764a9 100644 --- a/mel.el +++ b/mel.el @@ -96,8 +96,11 @@ Content-Transfer-Encoding for it." (mel-define-backend "binary" ("8bit")) -(when (and (fboundp 'base64-encode-string) - (subrp (symbol-function 'base64-encode-string))) +(defvar mel-b-builtin + (and (fboundp 'base64-encode-string) + (subrp (symbol-function 'base64-encode-string)))) + +(when mel-b-builtin (mel-define-backend "base64") (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-encode-string) diff --git a/mime-def.el b/mime-def.el index 209ecdb..8611505 100644 --- a/mime-def.el +++ b/mime-def.el @@ -27,7 +27,7 @@ (require 'mcharset) (eval-and-compile - (defconst mime-library-product ["FLAM-DOODLE" (1 11 2) "$B?? +;; Simon Leinen (ESMTP support) +;; Shuhei KOBAYASHI +;; Keywords: SMTP, mail + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mail-utils) ; pick up mail-strip-quoted-names + +(defgroup smtp nil + "SMTP protocol for sending mail." + :group 'mail) + +(defcustom smtp-default-server nil + "*Specify default SMTP server." + :type '(choice (const nil) string) + :group 'smtp) + +(defcustom smtp-server (or (getenv "SMTPSERVER") smtp-default-server) + "*The name of the host running SMTP server." + :type '(choice (const nil) string) + :group 'smtp) + +(defcustom smtp-service "smtp" + "*SMTP service port number. \"smtp\" or 25." + :type '(choice (integer :tag "25" 25) + (string :tag "smtp" "smtp")) + :group 'smtp) + +(defcustom smtp-use-8bitmime t + "*If non-nil, use ESMTP 8BITMIME if available." + :type 'boolean + :group 'smtp) + +(defcustom smtp-local-domain nil + "*Local domain name without a host name. +If the function (system-name) returns the full internet address, +don't define this value." + :type '(choice (const nil) string) + :group 'smtp) + +(defcustom smtp-coding-system 'binary + "*Coding-system for SMTP output." + :type 'coding-system + :group 'smtp) + +(defvar smtp-debug-info nil) +(defvar smtp-read-point nil) + +(defun smtp-make-fqdn () + "Return user's fully qualified domain name." + (let ((system-name (system-name))) + (cond + (smtp-local-domain + (concat system-name "." smtp-local-domain)) + ((string-match "[^.]\\.[^.]" system-name) + system-name) + (t + (error "Cannot generate valid FQDN. Set `smtp-local-domain' correctly."))))) + +(defun smtp-via-smtp (sender recipients smtp-text-buffer) + (let ((coding-system-for-read smtp-coding-system) + (coding-system-for-write smtp-coding-system) + process response extensions) + (save-excursion + (set-buffer + (get-buffer-create + (format "*trace of SMTP session to %s*" smtp-server))) + (erase-buffer) + (make-local-variable 'smtp-read-point) + (setq smtp-read-point (point-min)) + + (unwind-protect + (catch 'done + (setq process (open-network-stream "SMTP" + (current-buffer) + smtp-server smtp-service)) + (or process (throw 'done nil)) + + (set-process-filter process 'smtp-process-filter) + + ;; Greeting + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))) + + ;; EHLO + (smtp-send-command process + (format "EHLO %s" (smtp-make-fqdn))) + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (progn + ;; HELO + (smtp-send-command process + (format "HELO %s" (smtp-make-fqdn))) + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response))))) + (let ((extension-lines (cdr (cdr response)))) + (while extension-lines + (push (intern (downcase (substring (car extension-lines) 4))) + extensions) + (setq extension-lines (cdr extension-lines))))) + + ;; ONEX --- One message transaction only (sendmail extension?) + (if (or (memq 'onex extensions) + (memq 'xone extensions)) + (progn + (smtp-send-command process "ONEX") + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))))) + + ;; VERB --- Verbose (sendmail extension?) + (if (and smtp-debug-info + (or (memq 'verb extensions) + (memq 'xvrb extensions))) + (progn + (smtp-send-command process "VERB") + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))))) + + ;; XUSR --- Initial (user) submission (sendmail extension?) + (if (memq 'xusr extensions) + (progn + (smtp-send-command process "XUSR") + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))))) + + ;; MAIL FROM: + (smtp-send-command + process + (format "MAIL FROM:<%s>%s%s" + sender + ;; SIZE --- Message Size Declaration (RFC1870) + (if (memq 'size extensions) + (format " SIZE=%d" + (save-excursion + (set-buffer smtp-text-buffer) + (+ (- (point-max) (point-min)) + ;; Add one byte for each change-of-line + ;; because or CR-LF representation: + (count-lines (point-min) (point-max)) + ;; For some reason, an empty line is + ;; added to the message. Maybe this + ;; is a bug, but it can't hurt to add + ;; those two bytes anyway: + 2))) + "") + ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652) + (if (and (memq '8bitmime extensions) + smtp-use-8bitmime) + " BODY=8BITMIME" + ""))) + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))) + + ;; RCPT TO: + (while recipients + (smtp-send-command process + (format "RCPT TO:<%s>" (car recipients))) + (setq recipients (cdr recipients)) + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response))))) + + ;; DATA + (smtp-send-command process "DATA") + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))) + + ;; Mail contents + (smtp-send-data process smtp-text-buffer) + + ;; DATA end "." + (smtp-send-command process ".") + (setq response (smtp-read-response process)) + (if (or (null (car response)) + (not (integerp (car response))) + (>= (car response) 400)) + (throw 'done (car (cdr response)))) + + t) + + (if (and process + (eq (process-status process) 'open)) + (progn + ;; QUIT + (smtp-send-command process "QUIT") + (smtp-read-response process) + (delete-process process))))))) + +(defun smtp-process-filter (process output) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert output))) + +(defun smtp-read-response (process) + (let ((case-fold-search nil) + (response-strings nil) + (response-continue t) + (return-value '(nil ())) + match-end) + + (while response-continue + (goto-char smtp-read-point) + (while (not (search-forward "\r\n" nil t)) + (accept-process-output process) + (goto-char smtp-read-point)) + + (setq match-end (point)) + (setq response-strings + (cons (buffer-substring smtp-read-point (- match-end 2)) + response-strings)) + + (goto-char smtp-read-point) + (if (looking-at "[0-9]+ ") + (let ((begin (match-beginning 0)) + (end (match-end 0))) + (if smtp-debug-info + (message "%s" (car response-strings))) + + (setq smtp-read-point match-end) + + ;; ignore lines that start with "0" + (if (looking-at "0[0-9]+ ") + nil + (setq response-continue nil) + (setq return-value + (cons (string-to-int + (buffer-substring begin end)) + (nreverse response-strings))))) + + (if (looking-at "[0-9]+-") + (progn (if smtp-debug-info + (message "%s" (car response-strings))) + (setq smtp-read-point match-end) + (setq response-continue t)) + (progn + (setq smtp-read-point match-end) + (setq response-continue nil) + (setq return-value + (cons nil (nreverse response-strings))))))) + (setq smtp-read-point match-end) + return-value)) + +(defun smtp-send-command (process command) + (goto-char (point-max)) + (insert command "\r\n") + (setq smtp-read-point (point)) + (process-send-string process command) + (process-send-string process "\r\n")) + +(defun smtp-send-data-1 (process data) + (goto-char (point-max)) + (if smtp-debug-info + (insert data "\r\n")) + (setq smtp-read-point (point)) + ;; Escape "." at start of a line. + (if (eq (string-to-char data) ?.) + (process-send-string process ".")) + (process-send-string process data) + (process-send-string process "\r\n")) + +(defun smtp-send-data (process buffer) + (let ((data-continue t) + (sending-data nil) + this-line + this-line-end) + + (save-excursion + (set-buffer buffer) + (goto-char (point-min))) + + (while data-continue + (save-excursion + (set-buffer buffer) + (beginning-of-line) + (setq this-line (point)) + (end-of-line) + (setq this-line-end (point)) + (setq sending-data nil) + (setq sending-data (buffer-substring this-line this-line-end)) + (if (or (/= (forward-line 1) 0) (eobp)) + (setq data-continue nil))) + + (smtp-send-data-1 process sending-data)))) + +(defun smtp-deduce-address-list (smtp-text-buffer header-start header-end) + "Get address list suitable for smtp RCPT TO:
." + (let ((case-fold-search t) + (simple-address-list "") + this-line + this-line-end + addr-regexp + (smtp-address-buffer (generate-new-buffer " *smtp-mail*"))) + (unwind-protect + (save-excursion + ;; + (set-buffer smtp-address-buffer) + (erase-buffer) + (insert (save-excursion + (set-buffer smtp-text-buffer) + (buffer-substring-no-properties header-start header-end))) + (goto-char (point-min)) + ;; RESENT-* fields should stop processing of regular fields. + (save-excursion + (if (re-search-forward "^RESENT-TO:" header-end t) + (setq addr-regexp + "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)") + (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)"))) + + (while (re-search-forward addr-regexp header-end t) + (replace-match "") + (setq this-line (match-beginning 0)) + (forward-line 1) + ;; get any continuation lines. + (while (and (looking-at "^[ \t]+") (< (point) header-end)) + (forward-line 1)) + (setq this-line-end (point-marker)) + (setq simple-address-list + (concat simple-address-list " " + (mail-strip-quoted-names + (buffer-substring this-line this-line-end))))) + (erase-buffer) + (insert-string " ") + (insert-string simple-address-list) + (insert-string "\n") + ;; newline --> blank + (subst-char-in-region (point-min) (point-max) 10 ? t) + ;; comma --> blank + (subst-char-in-region (point-min) (point-max) ?, ? t) + ;; tab --> blank + (subst-char-in-region (point-min) (point-max) 9 ? t) + + (goto-char (point-min)) + ;; tidyness in case hook is not robust when it looks at this + (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) + + (goto-char (point-min)) + (let (recipient-address-list) + (while (re-search-forward " \\([^ ]+\\) " (point-max) t) + (backward-char 1) + (setq recipient-address-list + (cons (buffer-substring (match-beginning 1) (match-end 1)) + recipient-address-list))) + recipient-address-list)) + (kill-buffer smtp-address-buffer)))) + +(provide 'smtp) + +;;; smtp.el ends here diff --git a/smtpmail.el b/smtpmail.el new file mode 100644 index 0000000..807b4a7 --- /dev/null +++ b/smtpmail.el @@ -0,0 +1,305 @@ +;;; smtpmail.el --- SMTP interface for mail-mode + +;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc. + +;; Author: Tomoji Kagatani +;; Keywords: mail + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Send Mail to smtp host from smtpmail temp buffer. + +;; Please add these lines in your .emacs(_emacs). +;; +;;(setq send-mail-function 'smtpmail-send-it) +;;(setq smtp-default-server "YOUR SMTP HOST") +;;(setq smtp-service "smtp") +;;(setq smtp-local-domain "YOUR DOMAIN NAME") +;;(setq smtp-debug-info t) +;;(autoload 'smtpmail-send-it "smtpmail") +;;(setq user-full-name "YOUR NAME HERE") + +;; To queue mail, set smtpmail-queue-mail to t and use +;; smtpmail-send-queued-mail to send. + + +;;; Code: + +(require 'smtp) +(require 'sendmail) +(require 'time-stamp) + +;;; + +(defcustom smtpmail-queue-mail nil + "*Specify if mail is queued (if t) or sent immediately (if nil). +If queued, it is stored in the directory `smtpmail-queue-dir' +and sent with `smtpmail-send-queued-mail'." + :type 'boolean + :group 'smtp) + +(defcustom smtpmail-queue-dir "~/Mail/queued-mail/" + "*Directory where `smtpmail.el' stores queued mail." + :type 'directory + :group 'smtp) + +(defvar smtpmail-queue-index-file "index" + "File name of queued mail index, +This is relative to `smtpmail-queue-dir'.") + +(defvar smtpmail-queue-index (concat smtpmail-queue-dir + smtpmail-queue-index-file)) + +(defvar smtpmail-recipient-address-list nil) + + +;;; +;;; +;;; + +;;;###autoload +(defun smtpmail-send-it () + (require 'mail-utils) + (let ((errbuf (if mail-interactive + (generate-new-buffer " smtpmail errors") + 0)) + (tembuf (generate-new-buffer " smtpmail temp")) + (case-fold-search nil) + resend-to-addresses + delimline + (mailbuf (current-buffer))) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) +;; (sendmail-synch-aliases) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + (goto-char (point-min)) + (goto-char (point-min)) + (while (re-search-forward "^Resent-to:" delimline t) + (setq resend-to-addresses + (save-restriction + (narrow-to-region (point) + (save-excursion + (end-of-line) + (point))) + (append (mail-parse-comma-list) + resend-to-addresses)))) +;;; Apparently this causes a duplicate Sender. +;;; ;; If the From is different than current user, insert Sender. +;;; (goto-char (point-min)) +;;; (and (re-search-forward "^From:" delimline t) +;;; (progn +;;; (require 'mail-utils) +;;; (not (string-equal +;;; (mail-strip-quoted-names +;;; (save-restriction +;;; (narrow-to-region (point-min) delimline) +;;; (mail-fetch-field "From"))) +;;; (user-login-name)))) +;;; (progn +;;; (forward-line 1) +;;; (insert "Sender: " (user-login-name) "\n"))) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:[ \t]*\n" delimline t) + (replace-match "")) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (let* ((login user-mail-address) + (fullname (user-full-name))) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (insert fullname) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n"))))) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (if mail-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + ;; + ;; + ;; + (setq smtpmail-recipient-address-list + (or resend-to-addresses + (smtp-deduce-address-list tembuf (point-min) delimline))) + + (smtpmail-do-bcc delimline) + ; Send or queue + (if (not smtpmail-queue-mail) + (if smtpmail-recipient-address-list + (if (not (smtp-via-smtp user-mail-address + smtpmail-recipient-address-list + tembuf)) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + (let* ((file-data (concat + smtpmail-queue-dir + (time-stamp-strftime + "%02y%02m%02d-%02H%02M%02S"))) + (file-elisp (concat file-data ".el")) + (buffer-data (create-file-buffer file-data)) + (buffer-elisp (create-file-buffer file-elisp)) + (buffer-scratch "*queue-mail*")) + (save-excursion + (set-buffer buffer-data) + (erase-buffer) + (insert-buffer tembuf) + (write-file file-data) + (set-buffer buffer-elisp) + (erase-buffer) + (insert (concat + "(setq smtpmail-recipient-address-list '" + (prin1-to-string smtpmail-recipient-address-list) + ")\n")) + (write-file file-elisp) + (set-buffer (generate-new-buffer buffer-scratch)) + (insert (concat file-data "\n")) + (append-to-file (point-min) + (point-max) + smtpmail-queue-index) + ) + (kill-buffer buffer-scratch) + (kill-buffer buffer-data) + (kill-buffer buffer-elisp)))) + (kill-buffer tembuf) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + +(defun smtpmail-send-queued-mail () + "Send mail that was queued as a result of setting `smtpmail-queue-mail'." + (interactive) + ;;; Get index, get first mail, send it, get second mail, etc... + (let ((buffer-index (find-file-noselect smtpmail-queue-index)) + (file-msg "") + (tembuf nil)) + (save-excursion + (set-buffer buffer-index) + (beginning-of-buffer) + (while (not (eobp)) + (setq file-msg (buffer-substring (point) (save-excursion + (end-of-line) + (point)))) + (load file-msg) + (setq tembuf (find-file-noselect file-msg)) + (if smtpmail-recipient-address-list + (if (not (smtp-via-smtp user-mail-address + smtpmail-recipient-address-list tembuf)) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + (delete-file file-msg) + (delete-file (concat file-msg ".el")) + (kill-buffer tembuf) + (kill-line 1)) + (set-buffer buffer-index) + (save-buffer smtpmail-queue-index) + (kill-buffer buffer-index) + ))) + + +(defun smtpmail-do-bcc (header-end) + "Delete BCC: and their continuation lines from the header area. +There may be multiple BCC: lines, and each may have arbitrarily +many continuation lines." + (let ((case-fold-search t)) + (save-excursion + (goto-char (point-min)) + ;; iterate over all BCC: lines + (while (re-search-forward "^BCC:" header-end t) + (delete-region (match-beginning 0) (progn (forward-line 1) (point))) + ;; get rid of any continuation lines + (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) + (replace-match "")) + ) + ) ;; save-excursion + ) ;; let + ) + + +;;; + +(provide 'smtpmail) + +;;; smtpmail.el ends here diff --git a/std11.el b/std11.el index 616d3ad..112629c 100644 --- a/std11.el +++ b/std11.el @@ -5,7 +5,7 @@ ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 -;; This file is part of MU (Message Utilities). +;; This file is part of FLIM (Faithful Library about Internet Message). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -24,8 +24,8 @@ ;;; Code: -(autoload 'buffer-substring-no-properties "emu") -(autoload 'member "emu") +(or (fboundp 'buffer-substring-no-properties) + (require 'poe)) ;;; @ field @@ -737,9 +737,26 @@ represents addr-spec of RFC 822. [std11.el]" ) ))))) +(defun std11-comment-value-to-string (value) + (if (stringp value) + (std11-strip-quoted-pair value) + (let ((dest "")) + (while value + (setq dest + (concat dest + (if (stringp (car value)) + (car value) + (concat "(" + (std11-comment-value-to-string + (cdr (car value))) + ")") + )) + value (cdr value)) + ) + dest))) + (defun std11-full-name-string (address) - "Return string of full-name part from parsed ADDRESS of RFC 822. -\[std11.el]" + "Return string of full-name part from parsed ADDRESS of RFC 822." (cond ((eq (car address) 'group) (mapconcat (function (lambda (token) @@ -761,10 +778,10 @@ represents addr-spec of RFC 822. [std11.el]" (std11-strip-quoted-pair (cdr token)) ) ((eq type 'comment) - (concat - "(" - (std11-strip-quoted-pair (cdr token)) - ")") + (concat "(" + (std11-comment-value-to-string + (cdr token)) + ")") ) (t (cdr token) @@ -772,7 +789,7 @@ represents addr-spec of RFC 822. [std11.el]" (nth 1 addr) "")) ) (cond ((> (length phrase) 0) phrase) - (comment (std11-strip-quoted-pair comment)) + (comment (std11-comment-value-to-string comment)) ) ))))