From 379e176e6a2e5dc4a9ccce49f8b0c7c3badf0edd Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Fri, 21 May 2004 08:33:14 +0000
Subject: [PATCH] get rid of some superfluous CALL-WITH-VALUES

---
 scheme/ldap.scm | 68 +++++++++++++++++++++----------------------------
 1 file changed, 29 insertions(+), 39 deletions(-)

diff --git a/scheme/ldap.scm b/scheme/ldap.scm
index e3bc989..c3d71a4 100644
--- a/scheme/ldap.scm
+++ b/scheme/ldap.scm
@@ -165,15 +165,7 @@
 		       (timeout-microseconds #f))
     (let ((scope-id (ldap-scope-arguments-id scope))
 	  (attr-list (ldap-attribute-list-kludge attribute-list)))
-      (call-with-values
-       (lambda ()
-	 (apply values 
-		(if (not timeout-seconds)
-		    (ldap-search-internal
-		     session base scope-id filter attr-list attributes-only?)
-		    (ldap-search-with-timeout-internal
-		     session base scope-id filter attr-list attributes-only?
-		     timeout-seconds (or timeout-microseconds 0)))))
+      (apply 
        (lambda (ret-code message)
 	 (let ((ret-obj 
 		(convert-ldap-return-code ret-code)))
@@ -184,13 +176,19 @@
 		     (begin
 		       (ddisplay "ldap-search new object " message)
 		       (add-to-weak-table! *object-table* pointer message)
-		       (ldap-session-weak-list-add! session message)
-		       (set-ldap-message-session! message session)
-		       (set-ldap-message-result! message #f)
-		       (add-finalizer! message ldap-message-freeing-finalizer)
-		       message)))
-	       (raise-ldap-condition ret-obj session))))))))
-
+			     (ldap-session-weak-list-add! session message)
+			     (set-ldap-message-session! message session)
+			     (set-ldap-message-result! message #f)
+			     (add-finalizer! message ldap-message-freeing-finalizer)
+			     message)))
+	       (raise-ldap-condition ret-obj session))))
+       (if (not timeout-seconds)
+	   (ldap-search-internal
+	    session base scope-id filter attr-list attributes-only?)
+	   (ldap-search-with-timeout-internal
+	    session base scope-id filter attr-list attributes-only?
+	    timeout-seconds (or timeout-microseconds 0)))))))
+    
 ;;; GET/SET session options
 
 (import-lambda-definition ldap-get-set-option-internal
@@ -199,31 +197,26 @@
 
 (define (set-ldap-session-option! session-option value . args)
   (let-optionals args ((session (current-ldap-session)))
-    (call-with-values
-     (lambda ()
-       (apply values
-	      (ldap-get-set-option-internal 
-	       session (ldap-session-option-value-id session-option) #t value)))
+    (apply 
      (lambda (call-successful? result)
        (if call-successful?
 	   result
 	   (raise 
 	    (condition (&ldap-session-option-error 
-			(code #f) (session session)))))))))
+			(code #f) (session session))))))
+     (ldap-get-set-option-internal 
+      session (ldap-session-option-value-id session-option) #t value))))
 
 (define (ldap-session-option session-option . args)
   (let-optionals args ((session (current-ldap-session)))
-    (call-with-values
-     (lambda ()
-       (apply values
-	      (ldap-get-set-option-internal
-	       session (ldap-session-option-value-id session-option) #f #f)))
+    (apply
      (lambda (call-successful? result)
        (if call-successful?
 	   result
-	   (raise
-	    (condition (&ldap-session-option-error 
-			(code #f) (session session)))))))))
+	   (raise (condition (&ldap-session-option-error 
+			      (code #f) (session session))))))
+     (ldap-get-set-option-internal
+      session (ldap-session-option-value-id session-option) #f #f))))
 
 ;;; 
 
@@ -338,10 +331,7 @@
 
 (define (ldap-first-attribute entry . args)
   (let-optionals args ((session (current-ldap-session)))
-    (call-with-values
-     (lambda ()
-       (apply values
-	      (ldap-first-attribute-internal session entry)))
+    (apply
      (lambda (attribute-name ber-element)
        (if attribute-name
 	   (cond
@@ -356,7 +346,8 @@
 	     (add-finalizer! ber-element ber-element-finalizer)
 	     (values attribute-name ber-element)))
 	   (raise-ldap-condition 
-	    (ldap-get-error-return-object session) session))))))
+	    (ldap-get-error-return-object session) session)))
+     (ldap-first-attribute-internal session entry))))
 
 (define (ldap-next-attribute entry ber-element . args)
   (let-optionals args ((session (current-ldap-session)))
@@ -368,16 +359,15 @@
 
 (define (ldap-all-attributes entry . args)
   (let-optionals args ((session (current-ldap-session)))
-    (call-with-values
-     (lambda ()
-       (ldap-first-attribute entry session))
+    (apply
      (lambda (first-attribute ber-element)
        (let loop ((next (ldap-next-attribute entry ber-element session))
 		  (attributes (list first-attribute)))
 	 (if next
 	     (loop (ldap-next-attribute entry ber-element session)
 		   (cons next attributes))
-	     attributes))))))
+	     attributes)))
+     (ldap-first-attribute entry session))))
 
 ;;;