Import Debian changes 3a1-4.2debian/3a1-4.2

slib (3a1-4.2) unstable; urgency=low

  * Non-maintainer upload.
  * Add guile.init.local for use within the build dir, since otherwise we
    have an (earlier unnoticed) circular build-dep due to a difference
    between scm and guile.

slib (3a1-4.1) unstable; urgency=low

  * Non-maintainer upload.
  * Build-depend on guile-1.6 instead of scm, since the new version of
    scm is wedged in unstable (closes: #281809).

slib (3a1-4) unstable; urgency=low

  * Also check for expected creation on slibcat. (Closes: #240096)

slib (3a1-3) unstable; urgency=low

  * Also check for /usr/share/guile/1.6/slib before installing for guile
    1.6. (Closes: #239267)

slib (3a1-2) unstable; urgency=low

  * Add format.scm back into slib until gnucash stops using it.
  * Call guile-1.6 new-catalog (Closes: #238231)

slib (3a1-1) unstable; urgency=low

  * New upstream release
  * Remove Info section from doc-base file (Closes: #186950)
  * Remove period from end of description (linda, lintian)
  * html gen fixed upstream (Closes: #111778)

slib (2d4-2) unstable; urgency=low

  * Fix url for upstream source (Closes: #144981)
  * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
  * Add build depends.

slib (2d4-1) unstable; urgency=low

  * New upstream.

slib (2d3-1) unstable; urgency=low

  * New upstream.
  * Remove texi2html call in debian/rules.  Now done upstream.  Add make
    html instead.
  * Changes to rules and doc-base to conform to upstream html gen
  * Clean up upstream makefile to make sure it cleans up after itself.

1 files changed, 130 insertions, 123 deletions

diff --git a/yasyn.scm b/yasyn.scm
index d711cc2..2c91523 100644
--- a/yasyn.scm
+++ b/yasyn.scm
@@ -4,91 +4,23 @@
 ;;; This code is in the public domain.
 
 (require 'object)
+(require 'object->string)
 
+;; (define yasos:make-instance 'bogus)
 (define yasos:instance?     object?)
-;; Removed (define yasos:make-instance 'bogus)  ;;
-;; Removed (define-syntax YASOS:INSTANCE-DISPATCHER  ;; alias so compiler can inline for speed
-;;   (syntax-rules () ((yasos:instance-dispatcher inst) (cdr inst))))
-;; DEFINE-OPERATION
-
-(define-syntax define-operation
-  (syntax-rules ()
-    ((define-operation (<name> <inst> <arg> ...) <exp1> <exp2> ...)
-     ;;=>
-     (define <name> (make-generic-method
-		     (lambda (<inst> <arg> ...) <exp1> <exp2> ...))))
-
-    ((define-operation (<name> <inst> <arg> ...) ) ;; no body
-     ;;=>
-     (define-operation (<name> <inst> <arg> ...)
-       (slib:error "Operation not handled"
-		   '<name>
-		   (format #f (if (yasos:instance? <inst>) "#<INSTANCE>" "~s")
-			   <inst>))))))
-
-;; DEFINE-PREDICATE
 
-(define-syntax define-predicate
-  (syntax-rules ()
-    ((define-predicate <name>)
-     ;;=>
-     (define <name> (make-generic-predicate)))))
-
-;; OBJECT
-
-(define-syntax object
-  (syntax-rules ()
-    ((object ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
-    ;;=>
-     (let ((self (make-object)))
-       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
-       ...
-       self))))
-
-;; OBJECT with MULTIPLE INHERITANCE  {First Found Rule}
-
-(define-syntax object-with-ancestors
-  (syntax-rules ()
-    ((object-with-ancestors ( (<ancestor1> <init1>) ... )
-			    ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
-    ;;=>
-     (let* ((<ancestor1> <init1>)
-	    ...
-	    (self (make-object <ancestor1> ...)))
-       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
-       ...
-       self))))
-
-;; OPERATE-AS  {a.k.a. send-to-super}
-
-; used in operations/methods
-
-(define-syntax operate-as
-  (syntax-rules ()
-   ((operate-as <component> <op> <composit> <arg> ...) ;; What is <composit> ???
-   ;;=>
-    ((get-method <component> <op>) <composit> <arg> ...))))
-
-
-
-;; SET & SETTER
-
-
-(define-syntax set
-  (syntax-rules ()
-    ((set (<access> <index> ...) <newval>)
-     ((yasos:setter <access>) <index> ... <newval>)
-    )
-    ((set <var> <newval>)
-     (set! <var> <newval>)
-    )
-) )
-
-
-(define yasos:add-setter	'bogus)
-(define yasos:remove-setter-for 'bogus)
-
-(define yasos:setter
+(define (pormat dest arg)
+  (define obj (if (yasos:instance? arg) "#<INSTANCE>" arg))
+  (cond ((eqv? dest #t) (display obj))
+	(dest (display obj dest))
+	((yasos:instance? arg) obj)
+	(else (object->string arg))))
+
+;@
+(define add-setter	'bogus)
+(define remove-setter-for 'bogus)
+;@
+(define setter
   (let ( (known-setters (list (cons car set-car!)
 			      (cons cdr set-cdr!)
 			      (cons vector-ref vector-set!)
@@ -97,15 +29,15 @@
 	 (added-setters '())
        )
 
-    (set! yasos:add-setter
+    (set! add-setter
       (lambda (getter setter)
 	(set! added-setters (cons (cons getter setter) added-setters)))
     )
-    (set! yasos:remove-setter-for
+    (set! remove-setter-for
       (lambda (getter)
 	(cond
 	  ((null? added-setters)
-	   (slib:error "REMOVE-SETTER-FOR: Unknown getter" getter)
+	   (slib:error 'remove-setter-for 'unknown-getter getter)
 	  )
 	  ((eq? getter (caar added-setters))
 	   (set! added-setters (cdr added-setters))
@@ -113,7 +45,7 @@
 	  (else
 	    (let loop ((x added-setters) (y (cdr added-setters)))
 	      (cond
-		((null? y) (slib:error "REMOVE-SETTER-FOR: Unknown getter"
+		((null? y) (slib:error 'remove-setter-for 'unknown-getter
 				       getter))
 		((eq? getter (caar y)) (set-cdr! x (cdr y)))
 		(else (loop (cdr x) (cdr y)))
@@ -129,8 +61,6 @@
       self)
 ) )
 
-
-
 (define (yasos:make-access-operation <name>)
   (letrec ( (setter-dispatch
 	       (lambda (inst . args)
@@ -149,7 +79,7 @@
 			   (get-method inst self))
 		      => (lambda (method) (apply method (cons inst args)))
 		     )
-		     (else (slib:error "Operation not handled" <name> inst))
+		     (else (slib:error 'operation-not-handled <name> inst))
 		)  )
 	    )
 	  )
@@ -157,47 +87,124 @@
 	  self
 ) )
 
-(define-syntax define-access-operation
+;;---------------------
+;; general operations
+;;---------------------
+
+;;; if an instance does not have a PRINT operation..
+
+;;(define-operation (yasos:print obj port) (pormat port obj) )
+;@
+(define print
+  (make-generic-method
+   (lambda (obj!2 port!2)
+     (pormat port!2 obj!2))))
+
+;;; default behavior
+
+;;(define-operation (yasos:size obj)
+;;  (cond ((vector? obj) (vector-length obj))
+;;        ((list?   obj) (length obj))
+;;        ((pair?   obj) 2)
+;;        ((string? obj) (string-length obj))
+;;        ((char?   obj) 1)
+;;        (else (slib:error "Operation not supported: size" obj))))
+;@
+(define size
+  (make-generic-method
+   (lambda (obj!2)
+     (cond ((vector? obj!2) (vector-length obj!2))
+	   ((list? obj!2) (length obj!2))
+	   ((pair? obj!2) 2)
+	   ((string? obj!2) (string-length obj!2))
+	   ((char? obj!2) 1)
+	   (else (slib:error 'size "Operation not supported" obj!2))))))
+
+;;; internal aliases:
+;;(define yasos:size size)
+(define yasos:setter setter)
+
+;; (define-syntax YASOS:INSTANCE-DISPATCHER
+;;   ;; alias so compiler can inline for speed
+;;   (syntax-rules () ((yasos:instance-dispatcher inst) (cdr inst))))
+
+;; DEFINE-OPERATION
+;@
+(define-syntax define-operation
   (syntax-rules ()
-    ((define-access-operation <name>)
-     ;=>
-     (define <name> (yasos:make-access-operation '<name>))
-) ) )
+    ((define-operation (<name> <inst> <arg> ...) <exp1> <exp2> ...)
+     ;;=>
+     (define <name> (make-generic-method
+		     (lambda (<inst> <arg> ...) <exp1> <exp2> ...))))
 
+    ((define-operation (<name> <inst> <arg> ...) ) ;; no body
+     ;;=>
+     (define-operation (<name> <inst> <arg> ...)
+       (slib:error 'operation-not-handled
+		   '<name>
+		   (if (yasos:instance? <inst>) "#<INSTANCE>" <inst>))))))
 
+;; DEFINE-PREDICATE
+;@
+(define-syntax define-predicate
+  (syntax-rules ()
+    ((define-predicate <name>)
+     ;;=>
+     (define <name> (make-generic-predicate)))))
 
-;;---------------------
-;; general operations
-;;---------------------
+;; OBJECT
+;@
+(define-syntax object
+  (syntax-rules ()
+    ((object ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
+    ;;=>
+     (let ((self (make-object)))
+       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
+       ...
+       self))))
 
-(define-operation (yasos:print obj port)
-  (format port
-	  ;; if an instance does not have a PRINT operation..
-	  (if (yasos:instance? obj) "#<INSTANCE>" "~s")
-	  obj
-) )
+;; OBJECT with MULTIPLE INHERITANCE  {First Found Rule}
+;@
+(define-syntax object-with-ancestors
+  (syntax-rules ()
+    ((object-with-ancestors ( (<ancestor1> <init1>) ... )
+			    ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
+    ;;=>
+     (let* ((<ancestor1> <init1>)
+	    ...
+	    (self (make-object <ancestor1> ...)))
+       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
+       ...
+       self))))
 
-(define-operation (yasos:size obj)
-  ;; default behavior
-  (cond
-    ((vector? obj) (vector-length obj))
-    ((list?   obj) (length obj))
-    ((pair?   obj) 2)
-    ((string? obj) (string-length obj))
-    ((char?   obj) 1)
-    (else
-      (slib:error "Operation not supported: size" obj))
-) )
+;; OPERATE-AS  {a.k.a. send-to-super}
+
+; used in operations/methods
+;@
+(define-syntax operate-as
+  (syntax-rules ()
+   ((operate-as <component> <op> <composit> <arg> ...) ;; What is <composit> ???
+   ;;=>
+    ((get-method <component> <op>) <composit> <arg> ...))))
 
-(require 'format)
 
-;;; exports:
 
-(define print yasos:print)		; print also in debug.scm
-(define size yasos:size)
-(define add-setter yasos:add-setter)
-(define remove-setter-for yasos:remove-setter-for)
-(define setter yasos:setter)
+;; SET & SETTER
 
-(provide 'oop)				;in case we were loaded this way.
-(provide 'yasos)
+;@
+(define-syntax set
+  (syntax-rules ()
+    ((set (<access> <index> ...) <newval>)
+     ((yasos:setter <access>) <index> ... <newval>)
+    )
+    ((set <var> <newval>)
+     (set! <var> <newval>)
+    )
+) )
+;@
+(define-syntax define-access-operation
+  (syntax-rules ()
+    ((define-access-operation <name>)
+     ;=>
+     (define <name> (yasos:make-access-operation '<name>))
+) ) )