From: Kevin M. Rosenberg Date: Sun, 6 Oct 2002 13:35:30 +0000 (+0000) Subject: r2950: *** empty log message *** X-Git-Tag: v1.96~340 X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=1245205caa5937842d5d13ec805e15fe0d6a88c2 r2950: *** empty log message *** --- diff --git a/attrib-class.lisp b/attrib-class.lisp index 215089f..05a0778 100644 --- a/attrib-class.lisp +++ b/attrib-class.lisp @@ -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)) ) @@ -106,19 +106,19 @@ (: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)) ||# diff --git a/ml-class.lisp b/ml-class.lisp index 740e610..59e2211 100644 --- a/ml-class.lisp +++ b/ml-class.lisp @@ -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 "")) (setq html-label-str (concatenate 'string "" namestr-lower " " value-fmt)) (setq xml-label-str (concatenate 'string " <" namestr-lower ">" value-fmt "")) - (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 "") - (gu:string-append fmtstr-xml-ref "<~~a>" value-fmt "") - (gu:string-append fmtstr-html-ref-labels "" namestr-lower " <~~a>" value-fmt "") - (gu:string-append fmtstr-xml-ref-labels " <~~a>" value-fmt "")) + (string-append fmtstr-html-ref "<~~a>" value-fmt "") + (string-append fmtstr-xml-ref "<~~a>" value-fmt "") + (string-append fmtstr-html-ref-labels "" namestr-lower " <~~a>" value-fmt "") + (string-append fmtstr-xml-ref-labels " <~~a>" value-fmt "")) (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>~a~p: ~%" :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))) diff --git a/telnet-server.lisp b/telnet-server.lisp index e3a403c..0a794a7 100644 --- a/telnet-server.lisp +++ b/telnet-server.lisp @@ -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))