[albert-cvs] CVS: albert/spres base.lisp,1.10,1.11

[Stig E S. <st...@us...>]

Update of /cvsroot/albert/albert/spres
In directory sc8-pr-cvs1:/tmp/cvs-serv31908/spres

Modified Files:
	base.lisp 
Log Message:
rearranged some code, also turned PUT and PUT-T into methods

Index: base.lisp
===================================================================
RCS file: /cvsroot/albert/albert/spres/base.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** base.lisp	27 Oct 2003 01:04:06 -0000	1.10
--- base.lisp	27 Oct 2003 16:44:45 -0000	1.11
***************
*** 19,27 ****
  (in-package :spres-impl)
  
! ;; abstract
  (defclass spres-format ()
    ((name :initarg :name :accessor format.name :initform nil)))
  
! 
  (defclass spres-document () 
    ((directory :initarg :directory
--- 19,27 ----
  (in-package :spres-impl)
  
! ;; abstract, add docs
  (defclass spres-format ()
    ((name :initarg :name :accessor format.name :initform nil)))
  
! ;; add docs
  (defclass spres-document () 
    ((directory :initarg :directory
***************
*** 53,57 ****
--- 53,61 ----
       ) )
  
+ ;; add docs
+ (defstruct idx-entry
+   name obj parent)
  
+ ;; add docs
  (defstruct file-info
    id
***************
*** 60,63 ****
--- 64,68 ----
    counter)
  
+ ;; add docs
  (defclass tree-node ()
    ((the-class :initform nil :initarg :the-class :accessor tnode.class)
***************
*** 85,121 ****
  
  
! ;;; generics..
  
  (defgeneric is-empty? (obj)
    (:documentation "Checks whether an object is empty"))
  
- (defmethod is-empty? (obj)
-   (warn "No IS-EMPTY? function written for ~a" (its-name obj))
-   t)
- 
  (defgeneric taggify (format type str)
    (:documentation "Tagifies/Formats given string according to format and type"))
  
- (defmethod taggify (format type str)
-   (declare (ignore str))
-   (warn "No support have been added for (taggify ~a ~a ..)" (its-name format) type)
-   "")
- 
  (defgeneric make-document (dir filename format lang)
    (:documentation "creates a document which is a subclass of spres-document"))
  
! (defmethod make-document (dir filename format lang)
!   (declare (ignore dir filename))
!   (warn "No support has been written for (MAKE-DOCUMENT dir filename ~a ~a)" 
! 	(its-name format) (its-name lang)))
! 
! (defgeneric present-document (doc)
!   (:documentation
!    "Presents a document"))
! 
! ;;(defmethod-with-warn present-document (doc))
! (defmethod present-document (doc)
!   (warn "No support have been written for (PRESENT-DOCUMENT ~a ..)" (its-name doc)))
! 
  
  ;; default method in object.lisp
--- 90,110 ----
  
  
! ;;; === start generics..
! 
! (defgeneric mergable-objs? (doc first-obj second-obj)
!   (:documentation "Decides whether two objects may be
! merged for presentation."))
  
  (defgeneric is-empty? (obj)
    (:documentation "Checks whether an object is empty"))
  
  (defgeneric taggify (format type str)
    (:documentation "Tagifies/Formats given string according to format and type"))
  
  (defgeneric make-document (dir filename format lang)
    (:documentation "creates a document which is a subclass of spres-document"))
  
! (defgeneric present-document (doc &key content-prefix content-suffix)
!   (:documentation "Presents a document"))
  
  ;; default method in object.lisp
***************
*** 137,183 ****
    (:documentation "returns a simple link as text where it makes sense"))
  
- (defmethod get-simple-link (doc dest desc &key hovertext)
-   (declare (ignore dest desc hovertext))
-   (warn "No support have been written for (GET-SIMPLE-LINK ~a ..)" 
- 	(its-name doc)))
- 
  (defgeneric make-obj-link (doc obj parent &key desc &allow-other-keys)
    (:documentation "Returns a link to the given object."))
  
- (defmethod make-obj-link (doc obj parent &key desc)
-   (declare (ignore doc obj parent desc))
-   (error "simple MAKE-OBJ-LINK not implemented."))
- 
- (defgeneric make-obj-id (doc obj parent &key &allow-other-keys)
-   (:documentation "Returns an id for the given object."))
- 
- (defmethod make-obj-id (doc obj parent &key)
-   (declare (ignore doc obj parent))
-   (error "simple MAKE-OBJ-ID not implemented."))
- 
- 
  (defgeneric get-simple-anchor (doc anchor-word)
    (:documentation "returns an anchor where appropriate"))
  
! (defmethod get-simple-anchor (doc word)
!   (declare (ignore word))
!   (warn "No support have been written for (GET-SIMPLE-ANCHOR ~a ..)" 
! 	(its-name doc)))
  
  (defgeneric get-newline (doc)
    (:documentation "returns a newline for given doc"))
  
- (defmethod get-newline (doc)
-     (warn "No support have been written for (GET-NEWLINE ~a ..)" 
- 	(its-name doc)))
- 
  (defgeneric generate-tag (doc tag end-tag?)
    (:documentation "generates some tag"))
  
- (defmethod generate-tag (doc tag end-tag?)
-   (declare (ignore tag end-tag?))
-   (warn "No support have been written for (GENERATE-TAG ~a ..)" 
- 	(its-name doc)))
- 
  (defgeneric present-table (doc objlist style)
    (:documentation "Makes a table of the objects in list in given style"))
--- 126,144 ----
    (:documentation "returns a simple link as text where it makes sense"))
  
  (defgeneric make-obj-link (doc obj parent &key desc &allow-other-keys)
    (:documentation "Returns a link to the given object."))
  
  (defgeneric get-simple-anchor (doc anchor-word)
    (:documentation "returns an anchor where appropriate"))
  
! (defgeneric make-obj-id (doc obj parent &key &allow-other-keys)
!   (:documentation "Returns an id for the given object."))
  
  (defgeneric get-newline (doc)
    (:documentation "returns a newline for given doc"))
  
  (defgeneric generate-tag (doc tag end-tag?)
    (:documentation "generates some tag"))
  
  (defgeneric present-table (doc objlist style)
    (:documentation "Makes a table of the objects in list in given style"))
***************
*** 186,200 ****
    (:documentation "recurses down and collects file-names"))
  
- (defmethod calculate-file-list (object table)
-   (declare (ignore table))
-   (warn "No CALCULATE-FILE-LIST written for ~a [~a]" (its-name object) object))
- 
  (defgeneric print-class-hierarcy (doc hierarchy indent)
    (:documentation "Prints a class hierarchy to the given document."))
  
- (defmethod print-class-hierarcy (doc hierarchy indent)
-   (declare (ignore doc hierarchy indent))
-   (error "PRINT-CLASS-HIERARCHY not implemented"))
- 
  (defgeneric get-suggested-file-name (object context)
    (:documentation "Asks an object what it wants to have as its
--- 147,153 ----
***************
*** 203,224 ****
  it wants."))
  
- (defmethod-with-warn get-suggested-file-name (object context))
- 
- 
  (defgeneric should-have-individual-file-p (object context)
    (:documentation "checks to see if the object should have
  an individual file"))
  
- (defmethod should-have-individual-file-p (object context)
-   (declare (ignore object context))
-   nil)
- 
  (defgeneric collect-indexable (obj)
    (:documentation "Collects all indexable contents of obj."))
  
- (defmethod collect-indexable (obj)
-   (albert-warn "spres> unhandled indexable-obj ~s" obj)
-   nil)
- 
  (defgeneric update-parent-status! (obj parent)
    (:documentation "Updates OBJ (with parent PARENT) recursively downwards
--- 156,166 ----
***************
*** 261,268 ****
  default should be used."))
  
- (defmethod docbook-page-title (doc object)
-   (declare (ignore doc object))
-   nil)
- 
  (defgeneric get-method-arguments (meth-obj prog-lang)
    (:documentation "Returns a string with arguments organised properly for
--- 203,206 ----
***************
*** 276,307 ****
  in WHERE (and WHERE's content). Recursive.  Returns a list of objects."))
  
! (defun put (doc &rest args)
    "convenient function when dumping output to a document"
-   (let ((str (document.content doc)))
  
!     (dolist (h args)
! ;;      (declare (type simple-base-string h))
!       (when h
! 	(etypecase h
! 	  (string (write-string h str))
! 	  (integer (format str "~d" h)))))
!     (force-output str)
! ;;    (terpri str)
!     ))
  
  
! (defun put-t (doc type &rest args)
    "puts tagged info to given document"
!   ;;  (warn "PUT-T called")
!   (let ((str (document.content doc)))
!     
!     (dolist (h args)
! ;;      (declare (type simple-base-string h))
!       (when (and h (length h))
! 	(write-string (the simple-base-string (taggify doc type h)) str)))
!     ;;(terpri str)
!     (force-output str)
!     ))
  
  
  (defmacro with-some-tag (doc tag &rest body)
--- 214,332 ----
  in WHERE (and WHERE's content). Recursive.  Returns a list of objects."))
  
! 
! ;;; === end generics
! 
! ;;; === start base defmethods
! 
! (defmethod is-empty? (obj)
!   (warn "No IS-EMPTY? function written for ~a" (its-name obj))
!   t)
! 
! (defmethod taggify (format type str)
!   (declare (ignore str))
!   (warn "No support have been added for (taggify ~a ~a ..)" (its-name format) type)
!   "")
! 
! 
! (defmethod make-document (dir filename format lang)
!   (declare (ignore dir filename))
!   (warn "No support has been written for (MAKE-DOCUMENT dir filename ~a ~a)" 
! 	(its-name format) (its-name lang)))
! 
! ;;(defmethod-with-warn present-document (doc))
! (defmethod present-document (doc &key content-prefix content-suffix)
!   (warn "No support have been written for (PRESENT-DOCUMENT ~a ..)" (its-name doc))
!   nil)
! 
! 
! (defmethod get-simple-link (doc dest desc &key hovertext)
!   (declare (ignore dest desc hovertext))
!   (warn "No support have been written for (GET-SIMPLE-LINK ~a ..)" 
! 	(its-name doc)))
! 
! 
! (defmethod make-obj-link (doc obj parent &key desc)
!   (declare (ignore doc obj parent desc))
!   (error "simple MAKE-OBJ-LINK not implemented."))
! 
! 
! (defmethod make-obj-id (doc obj parent &key)
!   (declare (ignore doc obj parent))
!   (error "simple MAKE-OBJ-ID not implemented."))
! 
! 
! 
! (defmethod get-simple-anchor (doc word)
!   (declare (ignore word))
!   (warn "No support have been written for (GET-SIMPLE-ANCHOR ~a ..)" 
! 	(its-name doc)))
! 
! 
! (defmethod get-newline (doc)
!     (warn "No support have been written for (GET-NEWLINE ~a ..)" 
! 	(its-name doc)))
! 
! 
! (defmethod generate-tag (doc tag end-tag?)
!   (declare (ignore tag end-tag?))
!   (warn "No support have been written for (GENERATE-TAG ~a ..)" 
! 	(its-name doc)))
! 
! (defmethod calculate-file-list (object table)
!   (declare (ignore table))
!   (warn "No CALCULATE-FILE-LIST written for ~a [~a]" (its-name object) object))
! 
! 
! (defmethod print-class-hierarcy (doc hierarchy indent)
!   (declare (ignore doc hierarchy indent))
!   (error "PRINT-CLASS-HIERARCHY not implemented"))
! 
! 
! (defmethod-with-warn get-suggested-file-name (object context))
! 
! 
! 
! (defmethod should-have-individual-file-p (object context)
!   (declare (ignore object context))
!   nil)
! 
! 
! (defmethod collect-indexable (obj)
!   (albert-warn "spres> unhandled indexable-obj ~s" obj)
!   nil)
! 
! 
! (defmethod docbook-page-title (doc object)
!   (declare (ignore doc object))
!   nil)
! 
! 
! (defmethod put ((str cl:stream) &rest args)
    "convenient function when dumping output to a document"
  
!   (dolist (h args)
!     (when h
!       (etypecase h
! 	(string (write-string h str))
! 	(integer (format str "~d" h)))))
!   (force-output str))
  
  
! (defmethod put ((doc spres-document) &rest args)
!   "convenient function when dumping output to a document"
!   (apply #'put (document.content doc) args))
! 
! (defmethod put-t ((str cl:stream) type &rest args)
    "puts tagged info to given document"
!    
!   (dolist (h args)
!     (when (and h (length h))
!       (write-string (the simple-base-string (taggify doc type h)) str)))
!   ;;(terpri str)
!   (force-output str))
  
+ 
+ (defmethod put-t ((doc spres-document) type &rest args)
+   (apply #'put-t (document.content doc) type args))
  
  (defmacro with-some-tag (doc tag &rest body)