From eeecdad997c633f810028c741e9562554e6f105d Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 3 Nov 2002 20:10:48 +0000 Subject: [PATCH 1/1] r3287: *** empty log message *** --- debian/control | 2 +- hyperobject.asd | 4 +++- hyperobject.lisp | 48 +++++++++++++++++++++++------------------------- package.lisp | 4 ++-- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/debian/control b/debian/control index 7d76bfb..e22b2f4 100644 --- a/debian/control +++ b/debian/control @@ -7,7 +7,7 @@ Standards-Version: 3.5.7.1 Package: cl-hyperobject Architecture: all -Depends: ${shlibs:Depends}, common-lisp-controller +Depends: ${shlibs:Depends}, common-lisp-controller, cl-kmrcl Description: Common Lisp library for hyperobject This package contains a library for creating and display hyperobjects. Hyperobjects contain references to subobjects as well as to linked diff --git a/hyperobject.asd b/hyperobject.asd index 50063cd..b75e9a7 100644 --- a/hyperobject.asd +++ b/hyperobject.asd @@ -7,13 +7,14 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: hyperobject.asd,v 1.1 2002/11/03 19:59:10 kevin Exp $ +;;;; $Id: hyperobject.asd,v 1.2 2002/11/03 20:10:48 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; ************************************************************************* (in-package :asdf) +#+(or allegro lispworks cmu sbcl scl) (defsystem :hyperobject :perform (load-op :after (op hyperobject) (pushnew :hyperobject cl:*features*)) @@ -23,6 +24,7 @@ :depends-on (:kmrcl)) +#+(or allegro lispworks cmu sbcl scl) (when (ignore-errors (find-class 'load-compiled-op)) (defmethod perform :after ((op load-compiled-op) (c (eql (find-system :hyperobject)))) diff --git a/hyperobject.lisp b/hyperobject.lisp index 37f27eb..0e34dcd 100644 --- a/hyperobject.lisp +++ b/hyperobject.lisp @@ -11,7 +11,7 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id: hyperobject.lisp,v 1.1 2002/11/03 19:59:10 kevin Exp $ +;;;; $Id: hyperobject.lisp,v 1.2 2002/11/03 20:06:19 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -26,20 +26,18 @@ ;; Utilities -(defun my-class-of (obj) +(defun kmr-class-of (obj) #-(or cmu sbcl) (class-of obj) #+sbcl (sb-pcl:class-of obj) #+cmu (pcl:class-of obj)) -(defun my-class-name (obj) +(defun kmr-class-name (obj) #-(or cmu sbcl) (class-name obj) #+sbcl (sb-pcl:class-name obj) #+cmu (pcl:class-name obj)) -(defun xml-cdata (str) - (concatenate 'string "")) +;; Main class -;; (defclass ho-class (#-(or cmu sbcl) standard-class #+cmu pcl::standard-class #+sbcl sb-pcl::standard-class) @@ -163,7 +161,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (value-func '()) (xmlvalue-func '()) (classname (class-name cl)) - (package (symbol-package (my-class-name cl))) + (package (symbol-package (kmr-class-name cl))) (ref-fields (slot-value cl 'ref-fields))) (declare (ignore classname)) (dolist (f (slot-value cl 'fields)) @@ -261,56 +259,56 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (defun ho-class-fmtstr-text (obj) - (slot-value (my-class-of obj) 'fmtstr-text)) + (slot-value (kmr-class-of obj) 'fmtstr-text)) (defun ho-class-fmtstr-html (obj) - (slot-value (my-class-of obj) 'fmtstr-html)) + (slot-value (kmr-class-of obj) 'fmtstr-html)) (defun ho-class-fmtstr-xml (obj) - (slot-value (my-class-of obj) 'fmtstr-xml)) + (slot-value (kmr-class-of obj) 'fmtstr-xml)) (defun ho-class-fmtstr-text-labels (obj) - (slot-value (my-class-of obj) 'fmtstr-text-labels)) + (slot-value (kmr-class-of obj) 'fmtstr-text-labels)) (defun ho-class-fmtstr-html-labels (obj) - (slot-value (my-class-of obj) 'fmtstr-html-labels)) + (slot-value (kmr-class-of obj) 'fmtstr-html-labels)) (defun ho-class-fmtstr-xml-labels (obj) - (slot-value (my-class-of obj) 'fmtstr-xml-labels)) + (slot-value (kmr-class-of obj) 'fmtstr-xml-labels)) (defun ho-class-value-func (obj) - (slot-value (my-class-of obj) 'value-func)) + (slot-value (kmr-class-of obj) 'value-func)) (defun ho-class-xmlvalue-func (obj) - (slot-value (my-class-of obj) 'xmlvalue-func)) + (slot-value (kmr-class-of obj) 'xmlvalue-func)) (eval-when (:compile-toplevel :load-toplevel :execute) (defun ho-class-title (obj) - (awhen (slot-value (my-class-of obj) 'title) + (awhen (slot-value (kmr-class-of obj) 'title) (if (consp it) (car it) it)))) (defun ho-class-subobjects-lists (obj) - (slot-value (my-class-of obj) 'subobjects-lists)) + (slot-value (kmr-class-of obj) 'subobjects-lists)) (defun ho-class-ref-fields (obj) - (slot-value (my-class-of obj) 'ref-fields)) + (slot-value (kmr-class-of obj) 'ref-fields)) (defun ho-class-fields (obj) - (slot-value (my-class-of obj) 'fields)) + (slot-value (kmr-class-of obj) 'fields)) (defun ho-class-fmtstr-html-ref (obj) - (slot-value (my-class-of obj) 'fmtstr-html-ref)) + (slot-value (kmr-class-of obj) 'fmtstr-html-ref)) (defun ho-class-fmtstr-xml-ref (obj) - (slot-value (my-class-of obj) 'fmtstr-xml-ref)) + (slot-value (kmr-class-of obj) 'fmtstr-xml-ref)) (defun ho-class-fmtstr-html-ref-labels (obj) - (slot-value (my-class-of obj) 'fmtstr-html-ref-labels)) + (slot-value (kmr-class-of obj) 'fmtstr-html-ref-labels)) (defun ho-class-fmtstr-xml-ref-labels (obj) - (slot-value (my-class-of obj) 'fmtstr-xml-ref-labels)) + (slot-value (kmr-class-of obj) 'fmtstr-xml-ref-labels)) ;;; Class name functions @@ -319,7 +317,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (string-downcase (subseq name 1))) (defmethod ho-class-stdname ((cl standard-object)) - (string-downcase (subseq (my-class-name (my-class-of cl)) 1))) + (string-downcase (subseq (kmr-class-name (kmr-class-of cl)) 1))) ;;;; Generic Print functions @@ -412,7 +410,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)") (defun class-name-of (obj) - (string-downcase (my-class-name (my-class-of obj)))) + (string-downcase (kmr-class-name (kmr-class-of obj)))) (defun htmlformat-list-start-value-func (x nitems) (values (ho-class-title x) nitems (class-name-of x))) diff --git a/package.lisp b/package.lisp index 18acce7..0c23053 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.1 2002/11/03 19:59:10 kevin Exp $ +;;;; $Id: package.lisp,v 1.2 2002/11/03 20:06:19 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -17,7 +17,7 @@ (in-package :cl-user) (defpackage #:hyperobject - (:use #:common-lisp) + (:use #:common-lisp #:kmrcl) (:export #:ml-class #:ml-class-title -- 2.34.1