r2950: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 6 Oct 2002 13:35:30 +0000 (13:35 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 6 Oct 2002 13:35:30 +0000 (13:35 +0000)
attrib-class.lisp
ml-class.lisp
telnet-server.lisp

index 215089f03a0e3d3e868334005ec794294dfd98a2..05a0778492aa28061f71086fc58cdd6b5a621a5e 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: attrib-class.lisp,v 1.2 2002/10/06 13:30:17 kevin Exp $
+;;;; $Id: attrib-class.lisp,v 1.3 2002/10/06 13:35:30 kevin Exp $
 ;;;;
 ;;;; This file, part of Kmrcl, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -45,7 +45,7 @@
   (declare (ignorable slot))
   (apply
    #'make-instance 'attributes-esd 
-   :attributes (remove-duplicates (gu:mapappend #'attributes dsds))
+   :attributes (remove-duplicates (mapappend #'attributes dsds))
    (excl::compute-effective-slot-definition-initargs cl dsds))
   )
 
   (:metaclass kmrcl:attributes-class))
 (defparameter cr (make-instance 'credit-rating))
 
-(format t "~&date-set: ~a" (gu:slot-attribute cr 'level 'date-set))
-(setf (gu:slot-attribute cr 'level 'date-set) "12/15/1990")
-(format t "~&date-set: ~a" (gu:slot-attribute cr 'level 'date-set))
+(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
+(setf (slot-attribute cr 'level 'date-set) "12/15/1990")
+(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
   
 (defclass monitored-credit-rating (credit-rating)
   ((level :attributes (last-checked interval date-set))
    (cc :initarg :cc)
    (id :attributes (verified))
    )
-  (:metaclass gu:attributes-class))
+  (:metaclass attributes-class))
 (defparameter mcr (make-instance 'monitored-credit-rating))
 
-(setf (gu:slot-attribute mcr 'level 'date-set) "01/05/2002")
-(format t "~&date-set for mcr: ~a" (gu:slot-attribute mcr 'level 'date-set))
+(setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
+(format t "~&date-set for mcr: ~a" (slot-attribute mcr 'level 'date-set))
 
 ||#
index 740e610d9a1e935e9feb22592ea59ff5e1082ef9..59e2211a00511f829dc07b634fd2db7ddd102d37 100644 (file)
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: ml-class.lisp,v 1.2 2002/10/06 13:30:17 kevin Exp $
+;;;; $Id: ml-class.lisp,v 1.3 2002/10/06 13:35:30 kevin Exp $
 ;;;;
 ;;;; This file, part of Kmrcl, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -148,47 +148,47 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (if first-field
              (setq first-field nil)
            (progn
-             (gu:string-append fmtstr-text " ")
-             (gu:string-append fmtstr-html " ")
-             (gu:string-append fmtstr-xml " ")
-             (gu:string-append fmtstr-text-labels " ")
-             (gu:string-append fmtstr-html-labels " ")
-             (gu:string-append fmtstr-xml-labels " ")
-             (gu:string-append fmtstr-html-ref " ")
-             (gu:string-append fmtstr-xml-ref " ")
-             (gu:string-append fmtstr-html-ref-labels " ")
-             (gu:string-append fmtstr-xml-ref-labels " ")))
+             (string-append fmtstr-text " ")
+             (string-append fmtstr-html " ")
+             (string-append fmtstr-xml " ")
+             (string-append fmtstr-text-labels " ")
+             (string-append fmtstr-html-labels " ")
+             (string-append fmtstr-xml-labels " ")
+             (string-append fmtstr-html-ref " ")
+             (string-append fmtstr-xml-ref " ")
+             (string-append fmtstr-html-ref-labels " ")
+             (string-append fmtstr-xml-ref-labels " ")))
          
          (setq html-str value-fmt)
          (setq xml-str (concatenate 'string "<" namestr-lower ">" value-fmt "</" namestr-lower ">"))
          (setq html-label-str (concatenate 'string "<i>" namestr-lower "</i> " value-fmt))
          (setq xml-label-str (concatenate 'string "<label>" namestr-lower "</label> <" namestr-lower ">" value-fmt "</" namestr-lower ">"))
          
-         (gu:string-append fmtstr-text value-fmt)
-         (gu:string-append fmtstr-html html-str)
-         (gu:string-append fmtstr-xml xml-str)
-         (gu:string-append fmtstr-text-labels namestr-lower " " value-fmt)
-         (gu:string-append fmtstr-html-labels html-label-str)
-         (gu:string-append fmtstr-xml-labels xml-label-str)
+         (string-append fmtstr-text value-fmt)
+         (string-append fmtstr-html html-str)
+         (string-append fmtstr-xml xml-str)
+         (string-append fmtstr-text-labels namestr-lower " " value-fmt)
+         (string-append fmtstr-html-labels html-label-str)
+         (string-append fmtstr-xml-labels xml-label-str)
          
          (if (find name ref-fields :key #'car)
            (progn
-             (gu:string-append fmtstr-html-ref "<~~a>" value-fmt "</~~a>")
-             (gu:string-append fmtstr-xml-ref "<~~a>" value-fmt "</~~a>")
-             (gu:string-append fmtstr-html-ref-labels "<i>" namestr-lower "</i> <~~a>" value-fmt "</~~a>")
-             (gu:string-append fmtstr-xml-ref-labels "<label>" namestr-lower "</label> <~~a>" value-fmt "</~~a>"))
+             (string-append fmtstr-html-ref "<~~a>" value-fmt "</~~a>")
+             (string-append fmtstr-xml-ref "<~~a>" value-fmt "</~~a>")
+             (string-append fmtstr-html-ref-labels "<i>" namestr-lower "</i> <~~a>" value-fmt "</~~a>")
+             (string-append fmtstr-xml-ref-labels "<label>" namestr-lower "</label> <~~a>" value-fmt "</~~a>"))
            (progn
-             (gu:string-append fmtstr-html-ref html-str)
-             (gu:string-append fmtstr-xml-ref xml-str)
-             (gu:string-append fmtstr-html-ref-labels html-label-str)
-             (gu:string-append fmtstr-xml-ref-labels xml-label-str)))
+             (string-append fmtstr-html-ref html-str)
+             (string-append fmtstr-xml-ref xml-str)
+             (string-append fmtstr-html-ref-labels html-label-str)
+             (string-append fmtstr-xml-ref-labels xml-label-str)))
          
          (if formatter
              (setq plain-value-func 
-               (list `(,formatter (,(gu:concat-symbol-pkg 
+               (list `(,formatter (,(concat-symbol-pkg 
                                      :umlisp namestr) x))))
            (setq plain-value-func 
-             (list `(,(gu:concat-symbol-pkg 
+             (list `(,(concat-symbol-pkg 
                        :umlisp namestr) x))))
          (setq value-func (append value-func plain-value-func))
          
@@ -243,10 +243,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun ml-class-title (obj)
-  (gu:awhen (slot-value (class-of obj) 'title)
-           (if (consp gu:it)
-               (car gu:it)
-             gu:it))))
+  (awhen (slot-value (class-of obj) 'title)
+           (if (consp it)
+               (car it)
+             it))))
 
 (defun ml-class-subobjects-lists (obj)
   (slot-value (class-of obj) 'subobjects-lists))
@@ -393,7 +393,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 (defclass xmlformat (textformat) 
   ()
-  (:default-initargs :file-start-str "" ; (gu:std-xml-header)
+  (:default-initargs :file-start-str "" ; (std-xml-header)
     :list-start-indent  t
     :list-start-fmtstr "<~a><title>~a~p:</title> ~%"
     :list-start-value-func #'xmlformat-list-start-value-func
@@ -450,29 +450,29 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 (defmethod fmt-file-start ((fmt dataformat) (s stream)))
 
 (defmethod fmt-file-start ((fmt textformat) (s stream))
-  (gu:aif (file-start-str fmt)
-      (format s gu::it)))
+  (aif (file-start-str fmt)
+      (format s it)))
 
 (defmethod fmt-file-end ((fmt textformat) (s stream))
-  (gu:aif (file-end-str fmt)
-         (format s gu::it)))
+  (aif (file-end-str fmt)
+         (format s it)))
 
 ;;; List Start and Ends
 
 (defmethod fmt-list-start (x (fmt textformat) (s stream) &optional (indent 0) (num-items 1))
   (if (list-start-indent fmt)
-      (gu:indent-spaces indent s))
-  (gu:aif (list-start-fmtstr fmt)
-         (apply #'format s gu::it
+      (indent-spaces indent s))
+  (aif (list-start-fmtstr fmt)
+         (apply #'format s it
                 (multiple-value-list
                  (funcall (list-start-value-func fmt) x num-items)))))
 
 (defmethod fmt-list-end (x (fmt textformat) (s stream) &optional (indent 0) (num-items 1))
   (declare (ignore num-items))
   (if (list-end-indent fmt)
-      (gu:indent-spaces indent s))
-  (gu:aif (list-end-fmtstr fmt)
-         (apply #'format s gu::it
+      (indent-spaces indent s))
+  (aif (list-end-fmtstr fmt)
+         (apply #'format s it
                 (multiple-value-list
                  (funcall (list-end-value-func fmt) x)))))
 
@@ -480,17 +480,17 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 (defmethod fmt-obj-start (x (fmt textformat) (s stream) &optional (indent 0))
   (if (obj-start-indent fmt)
-      (gu:indent-spaces indent s))
-  (gu:aif (obj-start-fmtstr fmt)
-         (apply #'format s gu::it
+      (indent-spaces indent s))
+  (aif (obj-start-fmtstr fmt)
+         (apply #'format s it
                 (multiple-value-list
                  (funcall (obj-start-value-func fmt) x)))))
 
 (defmethod fmt-obj-end (x (fmt textformat) (s stream) &optional (indent 0))
   (if (obj-end-indent fmt)
-      (gu:indent-spaces indent s))
-  (gu:aif (obj-end-fmtstr fmt)
-         (apply #'format s gu::it
+      (indent-spaces indent s))
+  (aif (obj-end-fmtstr fmt)
+         (apply #'format s it
                 (multiple-value-list
                  (funcall (obj-end-value-func fmt) x)))))
   
@@ -504,7 +504,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (if refvars
              (let ((varstr ""))
                (dolist (var refvars)
-                 (gu:string-append varstr (format nil "~a~a=~a" 
+                 (string-append varstr (format nil "~a~a=~a" 
                                                (ampersand ref) (car var) (cadr var))))
                varstr)
            "")))
@@ -517,12 +517,12 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 (defmethod fmt-obj-data (x (fmt textformat) s
                         &optional (indent 0) (label nil) (refvars nil))
   (if (obj-data-indent fmt)
-      (gu:indent-spaces indent s))
+      (indent-spaces indent s))
   (if (link-ref fmt)
       (fmt-obj-data-with-ref x fmt s label refvars)
     (fmt-obj-data-plain x fmt s label))
-  (gu:aif (obj-data-end-fmtstr fmt)
-       (format s gu::it)))
+  (aif (obj-data-end-fmtstr fmt)
+       (format s it)))
 
 (defmethod fmt-obj-data-plain (x (fmt textformat) s label)
   (if label
@@ -580,12 +580,12 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 (defmethod load-all-subobjects (objs)
   "Load all subobjects if they have not already been loaded."
   (when objs
-    (let ((objlist (gu:mklist objs)))
+    (let ((objlist (mklist objs)))
       (dolist (obj objlist)
-        (gu:awhen (ml-class-subobjects-lists obj)  ;; access list of functions
-          (dolist (child-obj gu::it)   ;; for each child function
-            (gu:awhen (funcall (car child-obj) obj)
-              (load-all-subobjects gu:it))))))
+        (awhen (ml-class-subobjects-lists obj)  ;; access list of functions
+          (dolist (child-obj it)   ;; for each child function
+            (awhen (funcall (car child-obj) obj)
+              (load-all-subobjects it))))))
     objs))
 
 (defmethod output-ml-class (objs (fmt dataformat) (strm stream) 
@@ -593,7 +593,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                                      (indent 0) (subobjects nil) (refvars nil))
   "Display a single or list of ml-class instances and their subobjects"
   (when objs
-    (setq objs (gu:mklist objs))
+    (setq objs (mklist objs))
     (let ((nobjs (length objs)))
       (fmt-list-start (car objs) fmt strm indent nobjs)
       (dolist (obj objs)
@@ -601,10 +601,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
           (fmt-obj-start obj fmt strm indent)
           (fmt-obj-data obj fmt strm (1+ indent) label refvars)
           (if subobjects
-              (gu:awhen (ml-class-subobjects-lists obj)  ;; access list of functions
-                        (dolist (child-obj gu::it)   ;; for each child function
-                          (gu:awhen (funcall (car child-obj) obj) ;; access set of child objects
-                                    (output-ml-class gu::it fmt strm label 
+              (awhen (ml-class-subobjects-lists obj)  ;; access list of functions
+                        (dolist (child-obj it)   ;; for each child function
+                          (awhen (funcall (car child-obj) obj) ;; access set of child objects
+                                    (output-ml-class it fmt strm label 
                                                      english-only-function
                                                      (1+ indent) subobjects refvars)))))
           (fmt-obj-end obj fmt strm indent)))
index e3a403c2d0a8dd0b3510b68795a1a48f2d26e336..0a794a7ceb174b4ad1f62059901eaf9d34cfaa95 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: telnet-server.lisp,v 1.2 2002/10/06 13:30:17 kevin Exp $
+;;;; $Id: telnet-server.lisp,v 1.3 2002/10/06 13:35:30 kevin Exp $
 ;;;;
 ;;;; This file, part of Kmrcl, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -93,6 +93,6 @@
 (defun start-telnet-server (&optional (port *default-telnet-server-port*))
   (comm:start-up-server :service port
                        :process-name (format nil "telnet-~d" port)
-                       :function 'gu::make-telnet-stream))
+                       :function 'kmrcl::make-telnet-stream))