From 73f5a654e2c8809a92952d966a478401b5aaaf10 Mon Sep 17 00:00:00 2001 From: ueno Date: Wed, 16 Aug 2000 01:59:12 +0000 Subject: [PATCH] Synch up with chao-1_14. --- ChangeLog | 23 ++++++++++++++++++ Makefile | 9 +++---- VERSION | 1 + ftp.in | 18 ++++++-------- luna.el | 73 ++++++++++++++++++++++++++++++++++++--------------------- mime.el | 2 +- mmexternal.el | 59 +++++++++++++++++++++++++--------------------- mmgeneric.el | 20 +++++++++------- 8 files changed, 126 insertions(+), 79 deletions(-) diff --git a/ChangeLog b/ChangeLog index fb1e27d..096f1bf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -33,6 +33,29 @@ * FLIM-ELS (flim-modules): Add `net-trans'. +2000-08-10 MORIOKA Tomohiko + + * mmgeneric.el: Enclose definition of class `mime-entity' and its + internal accessors by `eval-and-compile'. + + * luna.el: Define `luna-class-name' before it is used in macros. + + +2000-07-12 MORIOKA Tomohiko + + * FLIM-Chao: Version 1.14.1 (Rokujiz-Dò)-A released. + +2000-07-10 MORIOKA Tomohiko + + * mmexternal.el (initialize-instance): Deleted. + (mmexternal-require-file-name): New function. + (mmexternal-require-buffer): Use `mmexternal-require-file-name'. + +2000-06-30 MORIOKA Tomohiko + + * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a + string. + 2000-06-23 MORIOKA Tomohiko * mmexternal.el (initialize-instance): New method. diff --git a/Makefile b/Makefile index 373131e..2bd0536 100644 --- a/Makefile +++ b/Makefile @@ -2,9 +2,9 @@ # Makefile for FLIM. # -PACKAGE = chao +PACKAGE = flim-chao API = 1.14 -RELEASE = 0 +RELEASE = 1 TAR = tar RM = /bin/rm -f @@ -25,8 +25,9 @@ GOMI = *.elc \ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog VERSION = $(API).$(RELEASE) -ARC_DIR = /ftp/pub/mule/flim/flim-$(API) -SEMI_ARC_DIR = /ftp/pub/mule/semi/semi-1.14-for-flim-$(API) +ARC_DIR_PREFIX = /home/tomo/public_html/comp/emacsen/lisp +ARC_DIR = $(ARC_DIR_PREFIX)/flim/flim-$(API) +SEMI_ARC_DIR = $(ARC_DIR_PREFIX)/semi/semi-1.14-for-flim-$(API) elc: $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ diff --git a/VERSION b/VERSION index 6719e47..4e453c7 100644 --- a/VERSION +++ b/VERSION @@ -89,3 +89,4 @@ 1.13.0 JR Fujinomori JR $(BF#?9(B 1.14.0 Momoyama $(BEm;3(B 1.14.1 Rokujiz-Dò-A $(BO;COB"(B +------ Kohata $(BLZH((B diff --git a/ftp.in b/ftp.in index 1d17d2a..391fb8a 100644 --- a/ftp.in +++ b/ftp.in @@ -2,18 +2,14 @@ It is available from - ftp://ftp.m17n.org/pub/mule/flim/flim-API + http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/flim/flim-API/ -or - - ftp://ftp.etl.go.jp/pub/mule/flim/flim-API - ---[[message/external-body; - access-type=anon-ftp; - site="ftp.m17n.org"; - directory="/pub/mule/flim/flim-API"; - name="PACKAGE-VERSION.tar.gz"; - mode=image]] +--[[message/external-body; access-type=URL; + URL*0="http://"; + URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/"; + URL*2="comp/emacsen/lisp/"; + URL*3="flim/flim-API/"; + URL*4="PACKAGE-VERSION.tar.gz"]] Content-Type: application/octet-stream; name="PACKAGE-VERSION.tar.gz"; type=tar; diff --git a/luna.el b/luna.el index e66d265..48da490 100644 --- a/luna.el +++ b/luna.el @@ -1,7 +1,6 @@ ;;; luna.el --- tiny OOP system kernel -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: OOP @@ -36,6 +35,10 @@ (defconst :after ':after) (defconst :around ':around))) + +;;; @ class +;;; + (defmacro luna-find-class (name) "Return the luna-class of the given NAME." `(get ,name 'luna-class)) @@ -116,18 +119,6 @@ If SLOTS is specified, TYPE will be defined to have them." (defmacro luna-class-slot-index (class slot-name) `(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index)) -(defmacro luna-slot-index (entity slot-name) - `(luna-class-slot-index (luna-find-class (luna-class-name ,entity)) - ,slot-name)) - -(defsubst luna-slot-value (entity slot) - "Return the value of SLOT of ENTITY." - (aref entity (luna-slot-index entity slot))) - -(defsubst luna-set-slot-value (entity slot value) - "Store VALUE into SLOT of ENTITY." - (aset entity (luna-slot-index entity slot) value)) - (defmacro luna-define-method (name &rest definition) "Define NAME as a method function of a class. @@ -208,6 +199,35 @@ BODY is the body of method." (luna-class-find-parents-functions class service) ))) + +;;; @ instance (entity) +;;; + +(defmacro luna-class-name (entity) + "Return class-name of the ENTITY." + `(aref ,entity 0)) + +(defmacro luna-set-class-name (entity name) + `(aset ,entity 0 ,name)) + +(defmacro luna-get-obarray (entity) + `(aref ,entity 1)) + +(defmacro luna-set-obarray (entity obarray) + `(aset ,entity 1 ,obarray)) + +(defmacro luna-slot-index (entity slot-name) + `(luna-class-slot-index (luna-find-class (luna-class-name ,entity)) + ,slot-name)) + +(defsubst luna-slot-value (entity slot) + "Return the value of SLOT of ENTITY." + (aref entity (luna-slot-index entity slot))) + +(defsubst luna-set-slot-value (entity slot value) + "Store VALUE into SLOT of ENTITY." + (aset entity (luna-slot-index entity slot) value)) + (defmacro luna-find-functions (entity service) `(luna-class-find-functions (luna-find-class (luna-class-name ,entity)) ,service)) @@ -251,19 +271,6 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." t)))) luna-previous-return-value)) -(defmacro luna-class-name (entity) - "Return class-name of the ENTITY." - `(aref ,entity 0)) - -(defmacro luna-set-class-name (entity name) - `(aset ,entity 0 ,name)) - -(defmacro luna-get-obarray (entity) - `(aref ,entity 1)) - -(defmacro luna-set-obarray (entity obarray) - `(aset ,entity 1 ,obarray)) - (defun luna-make-entity (type &rest init-args) "Make instance of luna-class TYPE and return it. If INIT-ARGS is specified, it is used as initial values of the slots. @@ -275,6 +282,10 @@ It must be plist and each slot name must have prefix `:'." (apply #'luna-send v 'initialize-instance v init-args) )) + +;;; @ interface (generic function) +;;; + (defsubst luna-arglist-to-arguments (arglist) (let (dest) (while arglist @@ -301,6 +312,10 @@ ARGS is argument of and DOC is DOC-string." (put 'luna-define-generic 'lisp-indent-function 'defun) + +;;; @ accessor +;;; + (defun luna-define-internal-accessors (class-name) "Define internal accessors for an entity of CLASS-NAME." (let ((entity-class (luna-find-class class-name)) @@ -336,6 +351,10 @@ ARGS is argument of and DOC is DOC-string." ))) (luna-class-obarray entity-class)))) + +;;; @ standard object +;;; + (luna-define-class-function 'standard-object) (luna-define-method initialize-instance ((entity standard-object) diff --git a/mime.el b/mime.el index 0f9ea4a..328d599 100644 --- a/mime.el +++ b/mime.el @@ -321,7 +321,7 @@ If MESSAGE is specified, it is regarded as root entity." (prog1 field-name (setq field-name (symbol-name field-name))) - (capitalize (capitalize field-name))))) + (intern (capitalize (capitalize field-name)))))) (cond ((eq sym 'Content-Type) (mime-entity-content-type entity) ) diff --git a/mmexternal.el b/mmexternal.el index b7befaf..04e5649 100644 --- a/mmexternal.el +++ b/mmexternal.el @@ -38,44 +38,49 @@ ;; entity are in the body of the parent entity. ) -(luna-define-method initialize-instance :after ((entity mime-external-entity) - &rest init-args) - (or (mime-external-entity-body-file-internal entity) - (let* ((ct (mime-entity-content-type - (mime-entity-parent-internal entity))) - (access-type (mime-content-type-parameter ct "access-type"))) - (if (and access-type - (string= access-type "anon-ftp")) - (let ((site (mime-content-type-parameter ct "site")) - (directory (mime-content-type-parameter ct "directory")) - (name (mime-content-type-parameter ct "name"))) - (mime-external-entity-set-body-file-internal - entity - (expand-file-name - name - (concat "/anonymous@" site ":" directory))))))) - entity) - (luna-define-method mime-entity-name ((entity mime-external-entity)) (concat "child of " (mime-entity-name (mime-entity-parent-internal entity)))) +(defun mmexternal-require-file-name (entity) + (condition-case nil + (or (mime-external-entity-body-file-internal entity) + (let* ((ct (mime-entity-content-type + (mime-entity-parent-internal entity))) + (access-type + (mime-content-type-parameter ct "access-type"))) + (if (and access-type + (string= access-type "anon-ftp")) + (let ((site (mime-content-type-parameter ct "site")) + (directory + (mime-content-type-parameter ct "directory")) + (name (mime-content-type-parameter ct "name"))) + (mime-external-entity-set-body-file-internal + entity + (expand-file-name + name + (concat "/anonymous@" site ":" + (file-name-as-directory directory)))))))) + (error (message "Can't make file-name of external-body.")))) + (defun mmexternal-require-buffer (entity) (unless (and (mime-external-entity-body-buffer-internal entity) (buffer-live-p (mime-external-entity-body-buffer-internal entity))) (condition-case nil - (mime-external-entity-set-body-buffer-internal - entity - (with-current-buffer (get-buffer-create - (concat " *Body of " - (mime-entity-name entity) - "*")) - (insert-file-contents-as-binary - (mime-external-entity-body-file-internal entity)) - (current-buffer))) + (progn + (mmexternal-require-file-name entity) + (mime-external-entity-set-body-buffer-internal + entity + (with-current-buffer (get-buffer-create + (concat " *Body of " + (mime-entity-name entity) + "*")) + (insert-file-contents-as-binary + (mime-external-entity-body-file-internal entity)) + (current-buffer)))) (error (message "Can't get external-body."))))) diff --git a/mmgeneric.el b/mmgeneric.el index 84d481b..5bd9686 100644 --- a/mmgeneric.el +++ b/mmgeneric.el @@ -37,19 +37,21 @@ ;; (autoload 'mime-parse-external "mime-parse") (autoload 'mime-entity-content "mime") -(luna-define-class mime-entity () - (location - content-type children parent - node-id - content-disposition encoding - ;; for other fields - original-header parsed-header)) +(eval-and-compile + (luna-define-class mime-entity () + (location + content-type children parent + node-id + content-disposition encoding + ;; for other fields + original-header parsed-header)) + + (luna-define-internal-accessors 'mime-entity) + ) (defalias 'mime-entity-representation-type-internal 'luna-class-name) (defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name) -(luna-define-internal-accessors 'mime-entity) - (luna-define-method mime-entity-fetch-field ((entity mime-entity) field-name) (or (symbolp field-name) -- 1.7.10.4