Synch with `flim-1_14' (to be continued).

diff --git a/mel-b-ccl.el b/mel-b-ccl.el
index 32bd8c8..803df63 100644 (file)
--- a/mel-b-ccl.el
+++ b/mel-b-ccl.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1998,1999 Tanaka Akira
 
 
 ;; Copyright (C) 1998,1999 Tanaka Akira
 

-;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Author: Tanaka Akira <akr@m17n.org>

 ;; Created: 1998/9/17
 ;; Keywords: MIME, Base64
 
 ;; Created: 1998/9/17
 ;; Keywords: MIME, Base64
 

diff --git a/mel-q-ccl.el b/mel-q-ccl.el
index c15fed2..b9c70b7 100644 (file)
--- a/mel-q-ccl.el
+++ b/mel-q-ccl.el
@@ -961,7 +961,7 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 (unless (featurep 'xemacs)
   (defun q-encoding-ccl-encoded-length (string &optional mode)
     (let ((status [nil nil nil nil nil nil nil nil nil]))
 (unless (featurep 'xemacs)
   (defun q-encoding-ccl-encoded-length (string &optional mode)
     (let ((status [nil nil nil nil nil nil nil nil nil]))

-      (fillarray status nil)
+      (fillarray status nil)           ; XXX: Is this necessary?

       (ccl-execute-on-string
        (cond
        ((eq mode 'text) 'mel-ccl-count-uq)
       (ccl-execute-on-string
        (cond
        ((eq mode 'text) 'mel-ccl-count-uq)

diff --git a/mime-def.el b/mime-def.el
index 32b5a17..1da89bc 100644 (file)
--- a/mime-def.el
+++ b/mime-def.el
@@ -5,8 +5,7 @@
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: definition, MIME, multimedia, mail, news
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: definition, MIME, multimedia, mail, news
 

-;; This file is part of DEISUI (Deisui is an Entity Implementation for
-;; SEMI based User Interfaces).
+;; 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
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as

@@ -38,8 +37,7 @@
 
 (eval-and-compile
   (defconst mime-library-product ["CLIME" (1 14 0) "\e$B8^4VF2\e(B"]
 
 (eval-and-compile
   (defconst mime-library-product ["CLIME" (1 14 0) "\e$B8^4VF2\e(B"]

-    "Product name, version number and code name of MIME-library package.")
-  )
+    "Product name, version number and code name of MIME-library package."))

 
 (defmacro mime-product-name (product)
   (` (aref (, product) 0)))
 
 (defmacro mime-product-name (product)
   (` (aref (, product) 0)))

@@ -131,7 +129,7 @@
          base64-token-regexp
          base64-token-padding-regexp
          base64-token-padding-regexp
          base64-token-regexp
          base64-token-padding-regexp
          base64-token-padding-regexp

-          "\\)"))
+         "\\)"))

 
 ;; (defconst eword-B-encoding-and-encoded-text-regexp
 ;;   (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))
 
 ;; (defconst eword-B-encoding-and-encoded-text-regexp
 ;;   (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))

@@ -247,9 +245,8 @@ service."
                     (,@ rest)
                     (funcall (mel-find-function '(, name)
                                                 (, (car (last args))))
                     (,@ rest)
                     (funcall (mel-find-function '(, name)
                                                 (, (car (last args))))

-                             (,@ (luna-arglist-to-arguments (butlast args))))
-                    )))))
-       )))
+                             (,@ (luna-arglist-to-arguments
+                                  (butlast args))))))))))))

 
 (put 'mel-define-service 'lisp-indent-function 'defun)
 
 
 (put 'mel-define-service 'lisp-indent-function 'defun)
 

@@ -263,10 +260,8 @@ service."
          (while (and rest
                      (progn
                        (require (car rest))
          (while (and rest
                      (progn
                        (require (car rest))

-                       (null (setq f (intern-soft encoding ob-array)))
-                       ))
-           (setq rest (cdr rest))
-           )
+                       (null (setq f (intern-soft encoding ob-array)))))
+           (setq rest (cdr rest)))

          f))))
 
 (defsubst mel-copy-method (service src-backend dst-backend)
          f))))
 
 (defsubst mel-copy-method (service src-backend dst-backend)

@@ -276,9 +271,8 @@ service."
     (when f
       (setq sym (intern dst-backend oa))
       (or (fboundp sym)
     (when f
       (setq sym (intern dst-backend oa))
       (or (fboundp sym)

-         (fset sym (symbol-function f))
-         ))))
-       
+         (fset sym (symbol-function f))))))
+

 (defsubst mel-copy-backend (src-backend dst-backend)
   (let ((services mel-service-list))
     (while services
 (defsubst mel-copy-backend (src-backend dst-backend)
   (let ((services mel-service-list))
     (while services

@@ -292,8 +286,7 @@ Each parent must be backend name (string)."
   (cons 'progn
        (mapcar (function
                 (lambda (parent)
   (cons 'progn
        (mapcar (function
                 (lambda (parent)

-                  (` (mel-copy-backend (, parent) (, type)))
-                  ))
+                  (` (mel-copy-backend (, parent) (, type)))))

                parents)))
 
 (defmacro mel-define-method (name args &rest body)
                parents)))
 
 (defmacro mel-define-method (name args &rest body)

@@ -335,8 +328,7 @@ variable and (nth 1 (car (last ARGS))) is name of backend (encoding)."
         (class (nth 1 specializer)))
     (` (progn
         (define-function (, function)
         (class (nth 1 specializer)))
     (` (progn
         (define-function (, function)

-          (intern (, class) (, (intern (format "%s-obarray" name)))))
-        ))))
+          (intern (, class) (, (intern (format "%s-obarray" name)))))))))

 
 (defvar base64-dl-module
   (if (and (fboundp 'base64-encode-string)
 
 (defvar base64-dl-module
   (if (and (fboundp 'base64-encode-string)

@@ -345,8 +337,7 @@ variable and (nth 1 (car (last ARGS))) is name of backend (encoding)."
     (if (fboundp 'dynamic-link)
        (let ((path (expand-file-name "base64.so" exec-directory)))
          (and (file-exists-p path)
     (if (fboundp 'dynamic-link)
        (let ((path (expand-file-name "base64.so" exec-directory)))
          (and (file-exists-p path)

-              path)
-         ))))
+              path)))))

 
 
 ;;; @ end
 
 
 ;;; @ end

diff --git a/mmbuffer.el b/mmbuffer.el
index 97fc783..d1fef8d 100644 (file)
--- a/mmbuffer.el
+++ b/mmbuffer.el
@@ -35,8 +35,7 @@
                      body-start
                      body-end))
 
                      body-start
                      body-end))
 

-  (luna-define-internal-accessors 'mime-buffer-entity)
-  )
+  (luna-define-internal-accessors 'mime-buffer-entity))

 
 (luna-define-method initialize-instance :after ((entity mime-buffer-entity)
                                                &rest init-args)
 
 (luna-define-method initialize-instance :after ((entity mime-buffer-entity)
                                                &rest init-args)

@@ -64,8 +63,7 @@
          (setq header-end (point-min)
                body-start (point-min)))
        (mime-buffer-entity-set-header-end-internal entity header-end)
          (setq header-end (point-min)
                body-start (point-min)))
        (mime-buffer-entity-set-header-end-internal entity header-end)

-       (mime-buffer-entity-set-body-start-internal entity body-start)
-       )
+       (mime-buffer-entity-set-body-start-internal entity body-start))

       (or (mime-entity-content-type-internal entity)
          (save-restriction
            (narrow-to-region header-start header-end)
       (or (mime-entity-content-type-internal entity)
          (save-restriction
            (narrow-to-region header-start header-end)

@@ -73,15 +71,11 @@
             entity
             (let ((str (std11-fetch-field "Content-Type")))
               (if str
             entity
             (let ((str (std11-fetch-field "Content-Type")))
               (if str

-                  (mime-parse-Content-Type str)
-                )))
-           ))
-      ))
+                  (mime-parse-Content-Type str))))))))

   entity)
 
 (luna-define-method mime-entity-name ((entity mime-buffer-entity))
   entity)
 
 (luna-define-method mime-entity-name ((entity mime-buffer-entity))

-  (buffer-name (mime-buffer-entity-buffer-internal entity))
-  )
+  (buffer-name (mime-buffer-entity-buffer-internal entity)))

 
 
 ;;; @ entity
 
 
 ;;; @ entity

@@ -90,8 +84,7 @@
 (luna-define-method mime-insert-entity ((entity mime-buffer-entity))
   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
                           (mime-buffer-entity-header-start-internal entity)
 (luna-define-method mime-insert-entity ((entity mime-buffer-entity))
   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
                           (mime-buffer-entity-header-start-internal entity)

-                          (mime-buffer-entity-body-end-internal entity))
-  )
+                          (mime-buffer-entity-body-end-internal entity)))

 
 (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename)
   (save-excursion
 
 (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename)
   (save-excursion

@@ -99,8 +92,7 @@
     (write-region-as-raw-text-CRLF
      (mime-buffer-entity-header-start-internal entity)
      (mime-buffer-entity-body-end-internal entity)
     (write-region-as-raw-text-CRLF
      (mime-buffer-entity-header-start-internal entity)
      (mime-buffer-entity-body-end-internal entity)

-     filename)
-    ))
+     filename)))

 
 
 ;;; @ entity header
 
 
 ;;; @ entity header

@@ -119,8 +111,7 @@
 (luna-define-method mime-insert-entity-body ((entity mime-buffer-entity))
   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
                           (mime-buffer-entity-body-start-internal entity)
 (luna-define-method mime-insert-entity-body ((entity mime-buffer-entity))
   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
                           (mime-buffer-entity-body-start-internal entity)

-                          (mime-buffer-entity-body-end-internal entity))
-  )
+                          (mime-buffer-entity-body-end-internal entity)))

 
 (luna-define-method mime-write-entity-body ((entity mime-buffer-entity)
                                            filename)
 
 (luna-define-method mime-write-entity-body ((entity mime-buffer-entity)
                                            filename)

@@ -128,8 +119,7 @@
     (set-buffer (mime-buffer-entity-buffer-internal entity))
     (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
                            (mime-buffer-entity-body-end-internal entity)
     (set-buffer (mime-buffer-entity-buffer-internal entity))
     (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
                            (mime-buffer-entity-body-end-internal entity)

-                           filename)
-    ))
+                           filename)))

 
 
 ;;; @ entity content
 
 
 ;;; @ entity content

@@ -157,8 +147,7 @@
     (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
                               (mime-buffer-entity-body-end-internal entity)
                               filename
     (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
                               (mime-buffer-entity-body-end-internal entity)
                               filename

-                              (or (mime-entity-encoding entity) "7bit"))
-    ))
+                              (or (mime-entity-encoding entity) "7bit"))))

 
 
 ;;; @ header field
 
 
 ;;; @ header field

@@ -177,7 +166,7 @@
              (or (symbolp field-name)
                  (setq field-name
                        (intern (capitalize (capitalize field-name)))))
              (or (symbolp field-name)
                  (setq field-name
                        (intern (capitalize (capitalize field-name)))))

-             (mime-entity-set-original-header-internal
+             (mime-entity-set-original-header-internal

               entity
               (put-alist field-name ret
                          (mime-entity-original-header-internal entity)))
               entity
               (put-alist field-name ret
                          (mime-entity-original-header-internal entity)))

@@ -190,83 +179,71 @@
    (mime-buffer-entity-buffer-internal entity)
    (mime-buffer-entity-header-start-internal entity)
    (mime-buffer-entity-header-end-internal entity)
    (mime-buffer-entity-buffer-internal entity)
    (mime-buffer-entity-header-start-internal entity)
    (mime-buffer-entity-header-end-internal entity)

-   invisible-fields visible-fields)
-  )
+   invisible-fields visible-fields))

 
 
 ;;; @ header buffer
 ;;;
 
 ;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
 
 
 ;;; @ header buffer
 ;;;
 
 ;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-buffer-internal entity)
-;;   )
+;;   (mime-buffer-entity-buffer-internal entity))

 
 ;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))
 
 ;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))

-;;   (goto-char (mime-buffer-entity-header-start-internal entity))
-;;   )
+;;   (goto-char (mime-buffer-entity-header-start-internal entity)))

 
 ;; (luna-define-method mime-entity-header-start-point ((entity
 ;;                                                      mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-header-start-point ((entity
 ;;                                                      mime-buffer-entity))

-;;   (mime-buffer-entity-header-start-internal entity)
-;;   )
+;;   (mime-buffer-entity-header-start-internal entity))

 
 ;; (luna-define-method mime-entity-header-end-point ((entity
 ;;                                                    mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-header-end-point ((entity
 ;;                                                    mime-buffer-entity))

-;;   (mime-buffer-entity-header-end-internal entity)
-;;   )
+;;   (mime-buffer-entity-header-end-internal entity))

 
 
 ;;; @ body buffer
 ;;;
 
 ;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
 
 
 ;;; @ body buffer
 ;;;
 
 ;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-buffer-internal entity)
-;;   )
+;;   (mime-buffer-entity-buffer-internal entity))

 
 ;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))
 
 ;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))

-;;   (goto-char (mime-buffer-entity-body-start-internal entity))
-;;   )
+;;   (goto-char (mime-buffer-entity-body-start-internal entity)))

 
 ;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))
 
 ;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
 ;;   (set-buffer (mime-buffer-entity-buffer-internal entity))

-;;   (goto-char (mime-buffer-entity-body-end-internal entity))
-;;   )
+;;   (goto-char (mime-buffer-entity-body-end-internal entity)))

 
 ;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-body-start-internal entity)
-;;   )
+;;   (mime-buffer-entity-body-start-internal entity))

 
 ;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-body-end-internal entity)
-;;   )
+;;   (mime-buffer-entity-body-end-internal entity))

 
 
 ;;; @ buffer (obsolete)
 ;;;
 
 ;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
 
 
 ;;; @ buffer (obsolete)
 ;;;
 
 ;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-buffer-internal entity)
-;;   )
+;;   (mime-buffer-entity-buffer-internal entity))

 
 ;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-header-start-internal entity)
-;;   )
+;;   (mime-buffer-entity-header-start-internal entity))

 
 ;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
 
 ;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))

-;;   (mime-buffer-entity-body-end-internal entity)
-;;   )
+;;   (mime-buffer-entity-body-end-internal entity))

 
 
 ;;; @ children
 ;;;
 
 
 
 ;;; @ children
 ;;;
 

-(defun mmbuffer-parse-multipart (entity)
+(defun mmbuffer-parse-multipart (entity &optional representation-type)

   (with-current-buffer (mime-buffer-entity-buffer-internal entity)
   (with-current-buffer (mime-buffer-entity-buffer-internal entity)

-    (let* ((representation-type
-           (mime-entity-representation-type-internal entity))
-          (content-type (mime-entity-content-type-internal entity))
+    (or representation-type
+       (setq representation-type
+             (mime-entity-representation-type-internal entity)))
+    (let* ((content-type (mime-entity-content-type-internal entity))

           (dash-boundary
            (concat "--"
                    (mime-content-type-parameter content-type "boundary")))
           (dash-boundary
            (concat "--"
                    (mime-content-type-parameter content-type "boundary")))

@@ -276,8 +253,7 @@
           (dc-ctl
            (if (eq (mime-content-type-subtype content-type) 'digest)
                (make-mime-content-type 'message 'rfc822)
           (dc-ctl
            (if (eq (mime-content-type-subtype content-type) 'digest)
                (make-mime-content-type 'message 'rfc822)

-             (make-mime-content-type 'text 'plain)
-             ))
+             (make-mime-content-type 'text 'plain)))

           (body-start (mime-buffer-entity-body-start-internal entity))
           (body-end (mime-buffer-entity-body-end-internal entity)))
       (save-restriction
           (body-start (mime-buffer-entity-body-start-internal entity))
           (body-end (mime-buffer-entity-body-end-internal entity)))
       (save-restriction

@@ -300,27 +276,23 @@
                (save-restriction
                  (narrow-to-region cb ce)
                  (setq ret (mime-parse-message representation-type dc-ctl
                (save-restriction
                  (narrow-to-region cb ce)
                  (setq ret (mime-parse-message representation-type dc-ctl

-                                               entity (cons i node-id)))
-                 )
+                                               entity (cons i node-id))))

                (setq children (cons ret children))
                (goto-char (setq cb ncb))
                (setq children (cons ret children))
                (goto-char (setq cb ncb))

-               (setq i (1+ i))
-               )
+               (setq i (1+ i)))

              (setq ce (point-max))
              (save-restriction
                (narrow-to-region cb ce)
                (setq ret (mime-parse-message representation-type dc-ctl
              (setq ce (point-max))
              (save-restriction
                (narrow-to-region cb ce)
                (setq ret (mime-parse-message representation-type dc-ctl

-                                             entity (cons i node-id)))
-               )
+                                             entity (cons i node-id))))

              (setq children (cons ret children))
              (setq children (cons ret children))

-             (mime-entity-set-children-internal entity (nreverse children))
-             )
+             (mime-entity-set-children-internal entity (nreverse children)))

          (mime-entity-set-content-type-internal
           entity (make-mime-content-type 'message 'x-broken))
          (mime-entity-set-content-type-internal
           entity (make-mime-content-type 'message 'x-broken))

-         nil)
-       ))))
+         nil)))))

 
 

-(defun mmbuffer-parse-encapsulated (entity &optional external)
+(defun mmbuffer-parse-encapsulated (entity &optional external
+                                          representation-type)

   (mime-entity-set-children-internal
    entity
    (with-current-buffer (mime-buffer-entity-buffer-internal entity)
   (mime-entity-set-children-internal
    entity
    (with-current-buffer (mime-buffer-entity-buffer-internal entity)

@@ -332,7 +304,8 @@
                  (progn
                    (require 'mmexternal)
                    'mime-external-entity)
                  (progn
                    (require 'mmexternal)
                    'mime-external-entity)

-               (mime-entity-representation-type-internal entity))
+               (or representation-type
+                   (mime-entity-representation-type-internal entity)))

              nil
              entity (cons 0 (mime-entity-node-id-internal entity))))))))
 
              nil
              entity (cons 0 (mime-entity-node-id-internal entity))))))))
 

diff --git a/mmexternal.el b/mmexternal.el
index 04e5649..9da0773 100644 (file)
--- a/mmexternal.el
+++ b/mmexternal.el
@@ -24,6 +24,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'mmgeneric)

 (require 'mime)
 (require 'pces)
 
 (require 'mime)
 (require 'pces)
 

diff --git a/qmtp.el b/qmtp.el
index ef1a84d..feab66a 100644 (file)
--- a/qmtp.el
+++ b/qmtp.el
@@ -29,7 +29,7 @@
 
 ;; To send mail using QMTP instead of SMTP, do
 
 
 ;; To send mail using QMTP instead of SMTP, do
 

-;; (fset 'smtp-via-smtp 'qmtp-via-qmtp)
+;; (fset 'smtp-send-buffer 'qmtp-send-buffer)

 
 ;;; Code:
 
 
 ;;; Code:
 

diff --git a/smtp.el b/smtp.el
index 418028c..82dccb6 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -32,9 +32,10 @@
 ;;; Code:
 
 (require 'pces)
 ;;; Code:
 
 (require 'pces)

-(require 'pcustom)
+(require 'custom)

 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)

+(require 'luna)

 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
 
 (defgroup smtp nil
   "SMTP protocol for sending mail."

@@ -60,7 +61,7 @@ called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS."
 (defcustom smtp-service "smtp"
   "SMTP service port number.  \"smtp\" or 25."
   :type '(choice (integer :tag "25" 25)
 (defcustom smtp-service "smtp"
   "SMTP service port number.  \"smtp\" or 25."
   :type '(choice (integer :tag "25" 25)

-                 (string :tag "smtp" "smtp"))
+                (string :tag "smtp" "smtp"))

   :group 'smtp)
 
 (defcustom smtp-local-domain nil
   :group 'smtp)
 
 (defcustom smtp-local-domain nil

@@ -120,36 +121,32 @@ don't define this value."
 
 (defvar smtp-submit-package-function (function smtp-submit-package))
 
 
 (defvar smtp-submit-package-function (function smtp-submit-package))
 

-;;; @ SMTP package structure
+;;; @ SMTP package

 ;;; A package contains a mail message, an envelope sender address,
 ;;; and one or more envelope recipient addresses.  In ESMTP model
 ;;; the current sending package should be guaranteed to be accessible
 ;;; anywhere from the hook methods (or SMTP commands).
 
 ;;; A package contains a mail message, an envelope sender address,
 ;;; and one or more envelope recipient addresses.  In ESMTP model
 ;;; the current sending package should be guaranteed to be accessible
 ;;; anywhere from the hook methods (or SMTP commands).
 

-(defmacro smtp-package-sender (package)
-  "Return the sender of PACKAGE, a string."
-  (` (aref (, package) 0)))
-
-(defmacro smtp-package-recipients (package)
-  "Return the recipients of PACKAGE, a list of strings."
-  (` (aref (, package) 1)))
+(eval-and-compile
+  (luna-define-class smtp-package ()
+                    (sender
+                     recipients
+                     buffer))

 
 

-(defmacro smtp-package-buffer (package)
-  "Return the data of PACKAGE, a buffer."
-  (` (aref (, package) 2)))
+  (luna-define-internal-accessors 'smtp-package))

 
 

-(defmacro smtp-make-package (sender recipients buffer)
+(defun smtp-make-package (sender recipients buffer)

   "Create a new package structure.
 A package is a unit of SMTP message
 SENDER specifies the package sender, a string.
 RECIPIENTS is a list of recipients.
 BUFFER may be a buffer or a buffer name which contains mail message."
   "Create a new package structure.
 A package is a unit of SMTP message
 SENDER specifies the package sender, a string.
 RECIPIENTS is a list of recipients.
 BUFFER may be a buffer or a buffer name which contains mail message."

-  (` (vector (, sender) (, recipients) (, buffer))))
+  (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer))

 
 

-(defun smtp-package-buffer-size (package)
+(defun smtp-package-buffer-internal-size (package)

   "Return the size of PACKAGE, an integer."
   (save-excursion
   "Return the size of PACKAGE, an integer."
   (save-excursion

-    (set-buffer (smtp-package-buffer package))
+    (set-buffer (smtp-package-buffer-internal package))

     (let ((size
           (+ (buffer-size)
              ;; Add one byte for each change-of-line
     (let ((size
           (+ (buffer-size)
              ;; Add one byte for each change-of-line

@@ -165,49 +162,42 @@ BUFFER may be a buffer or a buffer name which contains mail message."
        (setq size (1+ size)))
       size)))
 
        (setq size (1+ size)))
       size)))
 

-;;; @ SMTP connection structure
+;;; @ SMTP connection

 ;;; We should consider the function `open-network-stream' is a emulation
 ;;; for another network stream.  They are likely to be implemented with an
 ;;; external program and the function `process-contact' returns the
 ;;; process id instead of `(HOST SERVICE)' pair.
 
 ;;; We should consider the function `open-network-stream' is a emulation
 ;;; for another network stream.  They are likely to be implemented with an
 ;;; external program and the function `process-contact' returns the
 ;;; process id instead of `(HOST SERVICE)' pair.
 

-(defmacro smtp-connection-process (connection)
-  "Return the subprocess-object of CONNECTION."
-  (` (aref (, connection) 0)))
-
-(defmacro smtp-connection-server (connection)
-  "Return the server of CONNECTION, a string."
-  (` (aref (, connection) 1)))
-
-(defmacro smtp-connection-service (connection)
-  "Return the service of CONNECTION, a string or an integer."
-  (` (aref (, connection) 2)))
-
-(defmacro smtp-connection-extensions (connection)
-  "Return the SMTP extensions of CONNECTION, a list of strings."
-  (` (aref (, connection) 3)))
+(eval-and-compile
+  (luna-define-class smtp-connection ()
+                    (process
+                     server
+                     service
+                     extensions
+                     encoder
+                     decoder))

 
 

-(defmacro smtp-connection-set-extensions (connection extensions)
-  "Set the SMTP extensions of CONNECTION.
-EXTENSIONS is a list of cons cells of the form \(EXTENSION . PARAMETERS).
-Where EXTENSION is a symbol and PARAMETERS is a list of strings."
-  (` (aset (, connection) 3 (, extensions))))
+  (luna-define-internal-accessors 'smtp-connection))

 
 

-(defmacro smtp-make-connection (process server service)
+(defun smtp-make-connection (process server service)

   "Create a new connection structure.
 PROCESS is an internal subprocess-object.  SERVER is name of the host
 to connect to.  SERVICE is name of the service desired."
   "Create a new connection structure.
 PROCESS is an internal subprocess-object.  SERVER is name of the host
 to connect to.  SERVICE is name of the service desired."

-  (` (vector (, process) (, server) (, service) nil)))
+  (luna-make-entity 'smtp-connection :process process :server server :service service))

 
 

-(defun smtp-connection-opened (connection)
-  "Say whether the CONNECTION to server has been opened."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-generic smtp-connection-opened (connection)
+  "Say whether the CONNECTION to server has been opened.")
+
+(luna-define-generic smtp-close-connection (connection)
+  "Close the CONNECTION to server.")
+
+(luna-define-method smtp-connection-opened ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))

     (if (memq (process-status process) '(open run))
        t)))
 
     (if (memq (process-status process) '(open run))
        t)))
 

-(defun smtp-close-connection (connection)
-  "Close the CONNECTION to server."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-method smtp-close-connection ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))

     (delete-process process)))
 
 (defun smtp-make-fqdn ()
     (delete-process process)))
 
 (defun smtp-make-fqdn ()

@@ -244,11 +234,12 @@ to connect to.  SERVICE is name of the service desired."
 Return a newly allocated connection-object.
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."
 Return a newly allocated connection-object.
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."

-  (let ((process
-        (as-binary-process
+  (let* ((coding-system-for-read  'binary)
+        (coding-system-for-write 'binary)
+        (process

          (funcall smtp-open-connection-function
          (funcall smtp-open-connection-function

-                  "SMTP" buffer  server service)))
-       connection)
+                  "SMTP" buffer  server service))
+        connection)

     (when process
       (setq connection (smtp-make-connection process server service))
       (set-process-filter process 'smtp-process-filter)
     (when process
       (setq connection (smtp-make-connection process server service))
       (set-process-filter process 'smtp-process-filter)

@@ -318,51 +309,43 @@ of the host to connect to.  SERVICE is name of the service desired."
   (let* ((connection
          (smtp-find-connection (current-buffer)))
         (response
   (let* ((connection
          (smtp-find-connection (current-buffer)))
         (response

-         (smtp-read-response
-          (smtp-connection-process connection))))
+         (smtp-read-response connection)))

     (if (/= (car response) 220)
        (smtp-response-error response))))
 
 (defun smtp-primitive-ehlo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
     (if (/= (car response) 220)
        (smtp-response-error response))))
 
 (defun smtp-primitive-ehlo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
         response)

-    (smtp-send-command process (format "EHLO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 250)
        (smtp-response-error response))
     (if (/= (car response) 250)
        (smtp-response-error response))

-    (smtp-connection-set-extensions
+    (smtp-connection-set-extensions-internal

      connection (mapcar
      connection (mapcar

-                (function
-                 (lambda (extension)
-                   (let ((extensions
-                          (split-string extension)))
-                     (setcar extensions
-                             (car (read-from-string
-                                   (downcase (car extensions)))))
-                     extensions)))
+                (lambda (extension)
+                  (let ((extensions
+                         (split-string extension)))
+                    (setcar extensions
+                            (car (read-from-string
+                                  (downcase (car extensions)))))
+                    extensions))

                 (cdr response)))))
 
 (defun smtp-primitive-helo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
                 (cdr response)))))
 
 (defun smtp-primitive-helo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
         response)

-    (smtp-send-command process (format "HELO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-auth (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-auth (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         (mechanisms
         (mechanisms

-         (cdr (assq 'auth (smtp-connection-extensions connection))))
+         (cdr (assq 'auth (smtp-connection-extensions-internal connection))))

         (sasl-mechanisms
          (or smtp-sasl-mechanisms sasl-mechanisms))
         (mechanism
         (sasl-mechanisms
          (or smtp-sasl-mechanisms sasl-mechanisms))
         (mechanism

@@ -374,20 +357,20 @@ of the host to connect to.  SERVICE is name of the service desired."
     (unless mechanism
       (error "No authentication mechanism available"))
     (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp"
     (unless mechanism
       (error "No authentication mechanism available"))
     (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp"

-                                  (smtp-connection-server connection)))
+                                  (smtp-connection-server-internal connection)))

     (if smtp-sasl-properties
        (sasl-client-set-properties client smtp-sasl-properties))
     (setq name (sasl-mechanism-name mechanism)
          ;; Retrieve the initial response
          step (sasl-next-step client nil))
     (smtp-send-command
     (if smtp-sasl-properties
        (sasl-client-set-properties client smtp-sasl-properties))
     (setq name (sasl-mechanism-name mechanism)
          ;; Retrieve the initial response
          step (sasl-next-step client nil))
     (smtp-send-command

-     process
+     connection

      (if (sasl-step-data step)
         (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t))
        (format "AUTH %s" name)))
     (catch 'done
       (while t
      (if (sasl-step-data step)
         (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t))
        (format "AUTH %s" name)))
     (catch 'done
       (while t

-       (setq response (smtp-read-response process))
+       (setq response (smtp-read-response connection))

        (when (= (car response) 235)
          ;; The authentication process is finished.
          (setq step (sasl-next-step client step))
        (when (= (car response) 235)
          ;; The authentication process is finished.
          (setq step (sasl-next-step client step))

@@ -399,97 +382,93 @@ of the host to connect to.  SERVICE is name of the service desired."
        (sasl-step-set-data step (base64-decode-string (nth 1 response)))
        (setq step (sasl-next-step client step))
        (smtp-send-command
        (sasl-step-set-data step (base64-decode-string (nth 1 response)))
        (setq step (sasl-next-step client step))
        (smtp-send-command

-        process (if (sasl-step-data step)
-                    (base64-encode-string (sasl-step-data step) t)
-                  ""))))))
+        connection
+        (if (sasl-step-data step)
+            (base64-encode-string (sasl-step-data step) t)
+          ""))))
+    ;;;    (smtp-connection-set-encoder-internal
+    ;;;     connection (sasl-client-encoder client))
+    ;;;    (smtp-connection-set-decoder-internal
+    ;;;     connection (sasl-client-decoder client))
+    ))

 
 (defun smtp-primitive-starttls (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
 
 (defun smtp-primitive-starttls (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
     ;; STARTTLS --- begin a TLS negotiation (RFC 2595)
         response)
     ;; STARTTLS --- begin a TLS negotiation (RFC 2595)

-    (smtp-send-command process "STARTTLS")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "STARTTLS")
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 220)
        (smtp-response-error response))
     (if (/= (car response) 220)
        (smtp-response-error response))

-    (starttls-negotiate process)))
+    (starttls-negotiate (smtp-connection-process-internal connection))))

 
 (defun smtp-primitive-mailfrom (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
 
 (defun smtp-primitive-mailfrom (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         (extensions
         (extensions

-         (smtp-connection-extensions
+         (smtp-connection-extensions-internal

           connection))
         (sender
           connection))
         (sender

-         (smtp-package-sender package))
+         (smtp-package-sender-internal package))

         extension
         response)
     ;; SIZE --- Message Size Declaration (RFC1870)
     (if (and smtp-use-size
             (assq 'size extensions))
         extension
         response)
     ;; SIZE --- Message Size Declaration (RFC1870)
     (if (and smtp-use-size
             (assq 'size extensions))

-       (setq extension (format "SIZE=%d" (smtp-package-buffer-size package))))
+       (setq extension (format "SIZE=%d" (smtp-package-buffer-internal-size package))))

     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
     (if (and smtp-use-8bitmime
             (assq '8bitmime extensions))
        (setq extension (concat extension " BODY=8BITMIME")))
     (smtp-send-command
     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
     (if (and smtp-use-8bitmime
             (assq '8bitmime extensions))
        (setq extension (concat extension " BODY=8BITMIME")))
     (smtp-send-command

-     process
+     connection

      (if extension
         (format "MAIL FROM:<%s> %s" sender extension)
        (format "MAIL FROM:<%s>" sender)))
      (if extension
         (format "MAIL FROM:<%s> %s" sender extension)
        (format "MAIL FROM:<%s>" sender)))

-    (setq response (smtp-read-response process))
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-rcptto (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-rcptto (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         (recipients
         (recipients

-         (smtp-package-recipients package))
+         (smtp-package-recipients-internal package))

         response)
     (while recipients
       (smtp-send-command
         response)
     (while recipients
       (smtp-send-command

-       process (format "RCPT TO:<%s>" (pop recipients)))
-      (setq response (smtp-read-response process))
+       connection (format "RCPT TO:<%s>" (pop recipients)))
+      (setq response (smtp-read-response connection))

       (unless (memq (car response) '(250 251))
        (smtp-response-error response)))))
 
 (defun smtp-primitive-data (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
       (unless (memq (car response) '(250 251))
        (smtp-response-error response)))))
 
 (defun smtp-primitive-data (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
         response)

-    (smtp-send-command process "DATA")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "DATA")
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 354)
        (smtp-response-error response))
     (save-excursion
     (if (/= (car response) 354)
        (smtp-response-error response))
     (save-excursion

-      (set-buffer (smtp-package-buffer package))
+      (set-buffer (smtp-package-buffer-internal package))

       (goto-char (point-min))
       (while (not (eobp))
        (smtp-send-data
       (goto-char (point-min))
       (while (not (eobp))
        (smtp-send-data

-        process (buffer-substring (point) (progn (end-of-line)(point))))
+        connection (buffer-substring (point) (progn (end-of-line)(point))))

        (beginning-of-line 2)))
        (beginning-of-line 2)))

-    (smtp-send-command process ".")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection ".")
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-quit (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-quit (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
         response)

-    (smtp-send-command process "QUIT")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "QUIT")
+    (setq response (smtp-read-response connection))

     (if (/= (car response) 221)
        (smtp-response-error response))))
 
     (if (/= (car response) 221)
        (smtp-response-error response))))
 

@@ -510,14 +489,20 @@ of the host to connect to.  SERVICE is name of the service desired."
 (defun smtp-response-error (response)
   (signal 'smtp-response-error response))
 
 (defun smtp-response-error (response)
   (signal 'smtp-response-error response))
 

-(defun smtp-read-response (process)
-  (let ((response-continue t)
+(defun smtp-read-response (connection)
+  (let ((decoder
+        (smtp-connection-decoder-internal connection))
+       (response-continue t)

        response)
     (while response-continue
       (goto-char smtp-read-point)
       (while (not (search-forward "\r\n" nil t))
        response)
     (while response-continue
       (goto-char smtp-read-point)
       (while (not (search-forward "\r\n" nil t))

-       (accept-process-output process)
+       (accept-process-output (smtp-connection-process-internal connection))

        (goto-char smtp-read-point))
        (goto-char smtp-read-point))

+      (if decoder
+         (let ((string (buffer-substring smtp-read-point (- (point) 2))))
+           (delete-region smtp-read-point (point))
+           (insert (funcall decoder string) "\r\n")))

       (setq response
            (nconc response
                   (list (buffer-substring
       (setq response
            (nconc response
                   (list (buffer-substring

@@ -531,21 +516,33 @@ of the host to connect to.  SERVICE is name of the service desired."
                response-continue nil)))
     response))
 
                response-continue nil)))
     response))
 

-(defun smtp-send-command (process command)
+(defun smtp-send-command (connection command)

   (save-excursion
   (save-excursion

-    (set-buffer (process-buffer process))
-    (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 (process data)
-  ;; 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"))
+    (let ((process
+          (smtp-connection-process-internal connection))
+         (encoder
+          (smtp-connection-encoder-internal connection)))
+      (set-buffer (process-buffer process))
+      (goto-char (point-max))
+      (setq command (concat command "\r\n"))
+      (insert command)
+      (setq smtp-read-point (point))
+      (if encoder
+         (setq command (funcall encoder command)))
+      (process-send-string process command))))
+
+(defun smtp-send-data (connection data)
+  (let ((process
+        (smtp-connection-process-internal connection))
+       (encoder
+        (smtp-connection-encoder-internal connection)))
+    ;; Escape "." at start of a line.
+    (if (eq (string-to-char data) ?.)
+       (setq data (concat "." data "\r\n"))
+      (setq data (concat data "\r\n")))
+    (if encoder
+       (setq data (funcall encoder data)))
+    (process-send-string process data)))

 
 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
   "Get address list suitable for smtp RCPT TO:<address>."
 
 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
   "Get address list suitable for smtp RCPT TO:<address>."

diff --git a/std11.el b/std11.el
index dc7bde5..e1276e5 100644 (file)
--- a/std11.el
+++ b/std11.el
@@ -1,8 +1,8 @@
 ;;; std11.el --- STD 11 functions for GNU Emacs
 
 ;;; std11.el --- STD 11 functions for GNU Emacs
 

-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.

 
 

-;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author:   MORIOKA Tomohiko <tomo@m17n.org>

 ;; Keywords: mail, news, RFC 822, STD 11
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).
 ;; Keywords: mail, news, RFC 822, STD 11
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).

@@ -435,8 +435,7 @@ be the result."
                (setq token (car lal))
                (or (std11-ignored-token-p token)
                    (if (and (setq token-value (cdr token))
                (setq token (car lal))
                (or (std11-ignored-token-p token)
                    (if (and (setq token-value (cdr token))

-                            (find-non-ascii-charset-string token-value)
-                            )
+                            (find-non-ascii-charset-string token-value))

                        (setq token nil)
                      )))
       (setq lal (cdr lal))
                        (setq token nil)
                      )))
       (setq lal (cdr lal))