clisp-cvs digest, Vol 1 #1236 - 16 msgs

[<cli...@li...>]

Send clisp-cvs mailing list submissions to
	cli...@li...

To subscribe or unsubscribe via the World Wide Web, visit
	https://lists.sourceforge.net/lists/listinfo/clisp-cvs
or, via email, send a message with subject or body 'help' to
	cli...@li...

You can reach the person managing the list at
	cli...@li...

When replying, please edit your Subject line so it is more specific
than "Re: Contents of clisp-cvs digest..."


CLISP CVS commits for today

Today's Topics:

   1. clisp/modules/syscalls test.tst,1.12,1.13 (Sam Steingold)
   2. clisp/src ChangeLog,1.4888,1.4889 (Sam Steingold)
   3. clisp/modules/syscalls test.tst,1.13,1.14 (Sam Steingold)
   4. clisp/src ChangeLog,1.4889,1.4890 (Sam Steingold)
   5. clisp/modules/syscalls test.tst,1.14,1.15 (Sam Steingold)
   6. clisp/src ChangeLog,1.4890,1.4891 (Sam Steingold)
   7. clisp/modules/syscalls test.tst,1.15,1.16 (Sam Steingold)
   8. clisp/doc CLOS-guide.txt,1.2,1.3 (Sam Steingold)
   9. clisp/doc LISP-tutorial.txt,1.1.1.1,1.2 (Sam Steingold)
  10. clisp/modules/clx/new-clx clx.f,2.49,2.50 (Sam Steingold)
  11. clisp/src ChangeLog,1.4891,1.4892 (Sam Steingold)
  12. clisp/modules/clx/new-clx/demos sokoban.lisp,1.6,1.7 (Sam Steingold)
  13. clisp/src ChangeLog,1.4892,1.4893 (Sam Steingold)
  14. clisp/modules/clx/new-clx clx.f,2.50,2.51 (Sam Steingold)
  15. clisp/doc Makefile,1.74,1.75 (Sam Steingold)
  16. clisp/modules/postgresql sql.lisp,1.4,1.5 postgresql.xml,1.3,1.4 postgresql.lisp,1.13,1.14 (Sam Steingold)

--__--__--

Message: 1
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/syscalls test.tst,1.12,1.13
Date: Tue, 13 Sep 2005 03:47:01 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1467/modules/syscalls

Modified Files:
	test.tst 
Log Message:
SHOW the results for FILE-OWNER


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- test.tst	9 Sep 2005 18:53:48 -0000	1.12
+++ test.tst	13 Sep 2005 03:46:59 -0000	1.13
@@ -64,11 +64,11 @@
 
 (os:stat-vfs-p (show (os:stat-vfs *tmp2*))) T
 
-(string= #+win32 (ext:string-concat (ext:getenv "USERDOMAIN") "\\"
-                                    (ext:getenv "USERNAME"))
-         #+unix (ext:getenv "USER")
-         #-(or unix win32) ERROR
-         (os:file-owner *tmp1*))
+(string= (show #+win32 (ext:string-concat (ext:getenv "USERDOMAIN") "\\"
+                                          (ext:getenv "USERNAME"))
+               #+unix (ext:getenv "USER")
+               #-(or unix win32) ERROR)
+         (show (os:file-owner *tmp1*)))
 T
 
 (progn (close *tmp1*) (close *tmp2*) T) T



--__--__--

Message: 2
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src ChangeLog,1.4888,1.4889
Date: Tue, 13 Sep 2005 03:47:01 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1467/src

Modified Files:
	ChangeLog 
Log Message:
SHOW the results for FILE-OWNER


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.4888
retrieving revision 1.4889
diff -u -d -r1.4888 -r1.4889
--- ChangeLog	12 Sep 2005 20:56:35 -0000	1.4888
+++ ChangeLog	13 Sep 2005 03:46:58 -0000	1.4889
@@ -1,5 +1,9 @@
 2005-09-12  Sam Steingold  <sd...@gn...>
 
+	* modules/syscalls/test.tst: SHOW the results for FILE-OWNER
+
+2005-09-12  Sam Steingold  <sd...@gn...>
+
 	* modules/clx/new-clx/clx.f (%DISPLAY-XID): wrap XAllocID in X_CALL
 	(image_put_and_destroy): wrapper for XPutImage & XDestroyImage
 	(handle_image_z, PUT-IMAGE): use it



--__--__--

Message: 3
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/syscalls test.tst,1.13,1.14
Date: Tue, 13 Sep 2005 03:56:43 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2825/modules/syscalls

Modified Files:
	test.tst 
Log Message:
physical-memory: guard against broken unixes, like FreeBSD 4.10-BETA


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- test.tst	13 Sep 2005 03:46:59 -0000	1.13
+++ test.tst	13 Sep 2005 03:56:41 -0000	1.14
@@ -104,7 +104,14 @@
 (os:memory-status-p (show (os:memory-status)))
 T
 
-(listp (show (multiple-value-list (os:physical-memory))))
+(let ((sysconf #+unix (show (os:sysconf)) #-unix nil))
+  ;; guard against broken unixes, like FreeBSD 4.10-BETA
+  (if #+unix (and (get sysconf :PAGESIZE)
+                  (get sysconf :PHYS-PAGES)
+                  (get sysconf :AVPHYS-PAGES))
+      #-unix T
+      (listp (show (multiple-value-list (os:physical-memory))))
+      T))
 T
 
 ;; test file locking



--__--__--

Message: 4
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src ChangeLog,1.4889,1.4890
Date: Tue, 13 Sep 2005 03:56:43 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2825/src

Modified Files:
	ChangeLog 
Log Message:
physical-memory: guard against broken unixes, like FreeBSD 4.10-BETA


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.4889
retrieving revision 1.4890
diff -u -d -r1.4889 -r1.4890
--- ChangeLog	13 Sep 2005 03:46:58 -0000	1.4889
+++ ChangeLog	13 Sep 2005 03:56:41 -0000	1.4890
@@ -1,6 +1,7 @@
 2005-09-12  Sam Steingold  <sd...@gn...>
 
 	* modules/syscalls/test.tst: SHOW the results for FILE-OWNER
+	physical-memory: guard against broken unixes, like FreeBSD 4.10-BETA
 
 2005-09-12  Sam Steingold  <sd...@gn...>
 



--__--__--

Message: 5
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/syscalls test.tst,1.14,1.15
Date: Tue, 13 Sep 2005 04:00:34 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3366/modules/syscalls

Modified Files:
	test.tst 
Log Message:
stat-vfs: FreeBSD lacks this too


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- test.tst	13 Sep 2005 03:56:41 -0000	1.14
+++ test.tst	13 Sep 2005 04:00:32 -0000	1.15
@@ -62,7 +62,9 @@
 #+win32 #o0700
 #-(or unix win32) ERROR
 
-(os:stat-vfs-p (show (os:stat-vfs *tmp2*))) T
+(and (fboundp 'os:stat-vfs)
+     (not (os:stat-vfs-p (show (os:stat-vfs *tmp2*)))))
+NIL
 
 (string= (show #+win32 (ext:string-concat (ext:getenv "USERDOMAIN") "\\"
                                           (ext:getenv "USERNAME"))



--__--__--

Message: 6
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src ChangeLog,1.4890,1.4891
Date: Tue, 13 Sep 2005 04:00:34 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3366/src

Modified Files:
	ChangeLog 
Log Message:
stat-vfs: FreeBSD lacks this too


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.4890
retrieving revision 1.4891
diff -u -d -r1.4890 -r1.4891
--- ChangeLog	13 Sep 2005 03:56:41 -0000	1.4890
+++ ChangeLog	13 Sep 2005 04:00:32 -0000	1.4891
@@ -2,6 +2,7 @@
 
 	* modules/syscalls/test.tst: SHOW the results for FILE-OWNER
 	physical-memory: guard against broken unixes, like FreeBSD 4.10-BETA
+	stat-vfs: FreeBSD lacks this too
 
 2005-09-12  Sam Steingold  <sd...@gn...>
 



--__--__--

Message: 7
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/syscalls test.tst,1.15,1.16
Date: Tue, 13 Sep 2005 12:59:31 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11295/modules/syscalls

Modified Files:
	test.tst 
Log Message:
typo: get->getf


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- test.tst	13 Sep 2005 04:00:32 -0000	1.15
+++ test.tst	13 Sep 2005 12:59:29 -0000	1.16
@@ -108,9 +108,9 @@
 
 (let ((sysconf #+unix (show (os:sysconf)) #-unix nil))
   ;; guard against broken unixes, like FreeBSD 4.10-BETA
-  (if #+unix (and (get sysconf :PAGESIZE)
-                  (get sysconf :PHYS-PAGES)
-                  (get sysconf :AVPHYS-PAGES))
+  (if #+unix (and (getf sysconf :PAGESIZE)
+                  (getf sysconf :PHYS-PAGES)
+                  (getf sysconf :AVPHYS-PAGES))
       #-unix T
       (listp (show (multiple-value-list (os:physical-memory))))
       T))



--__--__--

Message: 8
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/doc CLOS-guide.txt,1.2,1.3
Date: Tue, 13 Sep 2005 13:28:47 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/doc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18150/doc

Modified Files:
	CLOS-guide.txt 
Log Message:
CLISP has MOP


Index: CLOS-guide.txt
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/CLOS-guide.txt,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- CLOS-guide.txt	20 Aug 1999 15:36:40 -0000	1.2
+++ CLOS-guide.txt	13 Sep 2005 13:28:45 -0000	1.3
@@ -26,8 +26,7 @@
 
    (DEFCLASS class-name (superclass-name*)
      (slot-description*)
-     class-option*
-   )
+     class-option*)
 
 For simple things, forget about class options.
 
@@ -47,8 +46,7 @@
 
    (defstruct person
      (name 'bill)
-     (age 10)
-   )
+     (age 10))
 
 DEFSTRUCT would automatically define slots with expressions to
 compute default initial values, access-functions like PERSON-NAME
@@ -62,12 +60,10 @@
    (defclass person ()
      ((name :accessor person-name
             :initform 'bill
-            :initarg :name
-      )
+            :initarg :name)
       (age :accessor person-age
            :initform 10
-           :initarg :age
-   ) ))
+           :initarg :age)))
 
 Note that DEFCLASS lets you control what things are called.  For
 instance, you don't have to call the accessor PERSON-NAME.  You could
@@ -109,8 +105,7 @@
 for everything.  For instance, you might want to define
 
   (defun make-person (name age)
-    (make-instance 'person :name name :age age)
-  )
+    (make-instance 'person :name name :age age))
 
 if you wanted the name and age to be required, positional parameters,
 rather than keyword parameters.
@@ -118,19 +113,19 @@
 The accessor functions can be used to get and set slot values:
 
    <cl> (setq p1 (make-instance 'person :name 'jill :age 100))
-   #<person @ #x7bf826> 
+   #<person @ #x7bf826>
 
    <cl> (person-name p1)
-   jill 
+   jill
 
    <cl> (person-age p1)
-   100 
+   100
 
    <cl> (setf (person-age p1) 101)
-   101 
+   101
 
    <cl> (person-age p1)
-   101 
+   101
 
 Note that when you use DEFCLASS, the instances are printed using
 the #<...> notation, rather than as #s(person :name jill :age 100).
@@ -140,19 +135,19 @@
 Slots can also be accessed by name using (SLOT-VALUE instance slot-name):
 
    <cl> (slot-value p1 'name)
-   jill 
+   jill
 
    <cl> (setf (slot-value p1 'name) 'jillian)
-   jillian 
+   jillian
 
    <cl> (person-name p1)
-   jillian 
+   jillian
 
 You can find out various things about an instance by calling
 DESCRIBE:
 
    <cl> (describe p1)
-   #<person @ #x7bf826> is an instance of class 
+   #<person @ #x7bf826> is an instance of class
         #<clos:standard-class person @ #x7ad8ae>:
    The following slots have :INSTANCE allocation:
    age     101
@@ -190,20 +185,17 @@
 
    <cl> (defclass teacher (person)
           ((subject :accessor teacher-subject
-                    :initarg :subject
-        ) ))
-   #<clos:standard-class teacher @ #x7cf796> 
+                    :initarg :subject)))
+   #<clos:standard-class teacher @ #x7cf796>
 
    <cl> (defclass maths-teacher (teacher)
-          ((subject :initform "Mathematics"))
-        )
-   #<clos:standard-class maths-teacher @ #x7d94be> 
+          ((subject :initform "Mathematics")))
+   #<clos:standard-class maths-teacher @ #x7d94be>
 
    <cl> (setq p2 (make-instance 'maths-teacher
                     :name 'john
-                    :age 34
-        )        )
-   #<maths-teacher @ #x7dcc66> 
+                    :age 34))
+   #<maths-teacher @ #x7dcc66>
 
    <cl> (describe p2)
    #<maths-teacher @ #x7dcc66> is an instance of
@@ -282,8 +274,7 @@
 defined by:
 
    (DEFMETHOD generic-function-name specialized-lambda-list
-     form*
-   )
+     form*)
 
 This may look fairly cryptic, but compare it to DEFUN described in
 a similar way:
@@ -308,15 +299,13 @@
 not defined by DEFCLASS.  For example:
 
    (defmethod change-subject ((teach teacher) new-subject)
-     (setf (teacher-subject teach) new-subject)
-   )
+     (setf (teacher-subject teach) new-subject))
 
 Here the new-subject could be any object.  If you want to restrict
 it, you might do something like:
 
    (defmethod change-subject ((teach teacher) (new-subject string))
-     (setf (teacher-subject teach) new-subject)
-   )
+     (setf (teacher-subject teach) new-subject))
 
 Or you could define classes of subjects.
 
@@ -335,21 +324,18 @@
 are considered from left to right.
 
    (defmethod test ((x number) (y number))
-     '(num num)
-   )
+     '(num num))
 
    (defmethod test ((i integer) (y number))
-     '(int num)
-   )
+     '(int num))
 
    (defmethod test ((x number) (j integer))
-     '(num int)
-   )
+     '(num int))
 
    (test 1 1)      =>  (int num), not (num int)
-   (test 1 1/2)    =>  (int num) 
-   (test 1/2 1)    =>  (num int) 
-   (test 1/2 1/2)  =>  (num num) 
+   (test 1 1/2)    =>  (int num)
+   (test 1/2 1)    =>  (num int)
+   (test 1/2 1/2)  =>  (num num)
 
 
 6. Method combination.
@@ -392,40 +378,34 @@
    (defclass food () ())
 
    (defmethod cook :before ((f food))
-     (print "A food is about to be cooked.")
-   )
+     (print "A food is about to be cooked."))
 
    (defmethod cook :after ((f food))
-     (print "A food has been cooked.")
-   )
+     (print "A food has been cooked."))
 
    (defclass pie (food)
-     ((filling :accessor pie-filling :initarg :filling :initform 'apple))
-   )
+     ((filling :accessor pie-filling :initarg :filling :initform 'apple)))
 
    (defmethod cook ((p pie))
      (print "Cooking a pie")
-     (setf (pie-filling p) (list 'cooked (pie-filling p)))
-   )
+     (setf (pie-filling p) (list 'cooked (pie-filling p))))
 
    (defmethod cook :before ((p pie))
-     (print "A pie is about to be cooked.")
-   )
+     (print "A pie is about to be cooked."))
 
    (defmethod cook :after ((p pie))
-     (print "A pie has been cooked.")
-   )
+     (print "A pie has been cooked."))
 
    (setq pie-1 (make-instance 'pie :filling 'apple))
 
 And now:
 
    <cl> (cook pie-1)
-   "A pie is about to be cooked." 
-   "A food is about to be cooked." 
-   "Cooking a pie" 
-   "A food has been cooked." 
-   "A pie has been cooked." 
+   "A pie is about to be cooked."
+   "A food is about to be cooked."
+   "Cooking a pie"
+   "A food has been cooked."
+   "A pie has been cooked."
    (cooked apple)
 
 
@@ -439,8 +419,7 @@
 Defining a class:
 
    (DEFCLASS class-name (superclass-name*)
-     (slot-description*)
-   )
+     (slot-description*))
 
 Slot descriptions:
 
@@ -457,8 +436,7 @@
 Method definitions:
 
    (DEFMETHOD generic-function-name [qualifier] specialized-lambda-list
-     form*
-   )
+     form*)
 
 where
 
@@ -479,11 +457,7 @@
    (CLASS-NAME class) -> symbol
 
    (CLASS-PRECEDENCE-LIST class) -> list of classes
-   [This is called (CLOS::CLASS-PRECEDENCE-LIST class) in CLISP.]
 
    (CLASS-DIRECT-SUPERCLASSES class) -> list of classes
-   [This is called (CLOS::CLASS-DIRECT-SUPERCLASSES class) in CLISP.]
 
    (CLASS-DIRECT-SUBCLASSES class) -> list of classes
-   [This isn't available in CLISP.]
-



--__--__--

Message: 9
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/doc LISP-tutorial.txt,1.1.1.1,1.2
Date: Tue, 13 Sep 2005 13:29:01 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/doc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18178/doc

Modified Files:
	LISP-tutorial.txt 
Log Message:
formatting


Index: LISP-tutorial.txt
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/LISP-tutorial.txt,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- LISP-tutorial.txt	22 Jul 1998 20:32:40 -0000	1.1.1.1
+++ LISP-tutorial.txt	13 Sep 2005 13:28:58 -0000	1.2
@@ -116,11 +116,11 @@
 is a complex. Here are some examples:
 
 > (+ 3 3/4)             ;type contagion
-15/4 
+15/4
 > (exp 1)               ;e
-2.7182817 
+2.7182817
 > (exp 3)               ;e*e*e
-20.085537 
+20.085537
 > (expt 3 4.2)          ;exponent with a base other than e
 100.90418
 > (+ 5 6 7 (* 8 9 10))  ;the fns +-*/ all accept multiple arguments
@@ -219,10 +219,9 @@
 > (foo 5 0)                     ;calling a function
 10
 > (defun fact (x)               ;a recursive function
-    (if (> x 0) 
+    (if (> x 0)
       (* x (fact (- x 1)))
-      1
-  ) )
+      1))
 FACT
 > (fact 5)
 120
@@ -235,8 +234,7 @@
 > (defun bar (x)                ;a function with multiple statements in
     (setq x (* x 3))            ;its body -- it will return the value
     (setq x (/ x 2))            ;returned by its final statement
-    (+ x 4)
-  )
+    (+ x 4))
 BAR
 > (bar 6)
 13
@@ -469,10 +467,8 @@
 
         (let ((var1 val1)
               (var2 val2)
-              ...
-             )
-          body
-        )
+              ...)
+          body)
 
 Let binds var1 to val1, var2 to val2, and so forth; then it executes
 the statements in its body. The body of a let follows exactly the same
@@ -480,12 +476,11 @@
 
 > (let ((a 3)) (+ a 1))
 4
-> (let ((a 2) 
+> (let ((a 2)
         (b 3)
         (c 0))
     (setq c (+ a b))
-    c
-  )
+    c)
 5
 > (setq c 4)
 4
@@ -501,8 +496,7 @@
 
 > (let ((x 1)
         (y (+ x 1)))
-    y
-  )
+    y)
 Error: Attempt to take the value of the unbound symbol X
 
 If the symbol x already has a global value, stranger happenings will
@@ -512,8 +506,7 @@
 7
 > (let ((x 1)
         (y (+ x 1)))
-    y
-  )
+    y)
 8
 
 The let* special form is just like let except that it allows values to
@@ -523,23 +516,20 @@
 7
 > (let* ((x 1)
          (y (+ x 1)))
-    y
-  )
+    y)
 2
 
 The form
 
         (let* ((x a)
                (y b))
-          ...
-        ) 
+          ...)
 
 is equivalent to
 
         (let ((x a))
           (let ((y b))
-            ...
-        ) )
+            ...))
 
 
 
@@ -561,13 +551,13 @@
 global value.
 
 > (setq regular 5)
-5 
+5
 > (defun check-regular () regular)
-CHECK-REGULAR 
+CHECK-REGULAR
 > (check-regular)
-5 
+5
 > (let ((regular 6)) (check-regular))
-5 
+5
 
 In this example, the function check-special references a special (ie,
 dynamically scoped) variable. Since the call to check-special is
@@ -652,8 +642,7 @@
 > (defstruct foo
     bar
     baaz
-    quux
-  )
+    quux)
 FOO
 
 This example defines a data type called foo which is a structure
@@ -663,9 +652,9 @@
 object of type foo. Here is how to use these functions:
 
 > (make-foo)
-#s(FOO :BAR NIL :BAAZ NIL :QUUX NIL) 
+#s(FOO :BAR NIL :BAAZ NIL :QUUX NIL)
 > (make-foo :baaz 3)
-#s(FOO :BAR NIL :BAAZ 3 :QUUX NIL) 
+#s(FOO :BAR NIL :BAAZ 3 :QUUX NIL)
 > (foo-bar *)
 NIL
 > (foo-baaz **)
@@ -771,8 +760,7 @@
     (progn
       (setq a (+ b 7))
       (setq b (+ c 8)))
-    (setq b 4)
-  )
+    (setq b 4))
 13
 
 An if statement which lacks either a then or an else clause can be
@@ -792,8 +780,7 @@
 
 > (when t
     (setq a 5)
-    (+ a 6)
-  )
+    (+ a 6))
 11
 
 More complicated conditionals can be defined using the cond special
@@ -814,8 +801,7 @@
    ((evenp a) a)        ;if a is even return a
    ((> a 7) (/ a 2))    ;else if a is bigger than 7 return a/2
    ((< a 5) (- a 1))    ;else if a is smaller than 5 return a-1
-   (t 17)               ;else return 17
-  )
+   (t 17))              ;else return 17
 2
 
 If the action in the selected cond clause is missing, cond returns what
@@ -832,8 +818,7 @@
     (cond
      ((= x 1) steps)
      ((oddp x) (hotpo (+ 1 (* x 3)) (+ 1 steps)))
-     (t (hotpo (/ x 2) (+ 1 steps)))
-  ) )
+     (t (hotpo (/ x 2) (+ 1 steps)))))
 A
 > (hotpo 7 0)
 16
@@ -846,8 +831,7 @@
    (a 5)
    ((d e) 7)
    ((b f) 3)
-   (otherwise 9)
-  )
+   (otherwise 9))
 3
 
 The otherwise clause at the end means that if x is not a, b, d, e, or
@@ -863,25 +847,23 @@
 
 > (setq a 4)
 4
-> (loop 
+> (loop
    (setq a (+ a 1))
-   (when (> a 7) (return a))
-  )
+   (when (> a 7) (return a)))
 8
 > (loop
    (setq a (- a 1))
-   (when (< a 3) (return))
-  )
+   (when (< a 3) (return)))
 NIL
 
 The next simplest is dolist: dolist binds a variable to the elements of
 a list in order and stops when it hits the end of the list.
 
 > (dolist (x '(a b c)) (print x))
-A 
-B 
-C 
-NIL 
+A
+B
+C
+NIL
 
 Dolist always returns nil. Note that the value of x in the above
 example was never nil: the NIL below the C was the value that dolist
@@ -894,19 +876,18 @@
        (y 1 (* y 2)))
       ((> x 5) y)
     (print y)
-    (print 'working)
-  )
-1 
-WORKING 
-2 
-WORKING 
-4 
-WORKING 
-8 
-WORKING 
-16 
-WORKING 
-32 
+    (print 'working))
+1
+WORKING
+2
+WORKING
+4
+WORKING
+8
+WORKING
+16
+WORKING
+32
 
 The first part of a do specifies what variables to bind, what their
 initial values are, and how to update them. The second part specifies a
@@ -928,8 +909,7 @@
 
 > (defun foo (x)
     (return-from foo 3)
-    x
-  )
+    x)
 FOO
 > (foo 17)
 3
@@ -940,8 +920,7 @@
 
 > (block foo
     (return-from foo 7)
-    3
-  )
+    3)
 7
 
 The return special form can return from any block named nil. Loops are
@@ -949,8 +928,7 @@
 
 > (block nil
     (return 7)
-    3
-  )
+    3)
 7
 
 Another form which causes a nonlocal exit is the error form:
@@ -1012,8 +990,7 @@
 > (do ((x '(1 2 3 4 5) (cdr x))
        (y nil))
       ((null x) (reverse y))
-    (push (+ (car x) 2) y)
-  )
+    (push (+ (car x) 2) y))
 (3 4 5 6 7)
 > (mapcar #'(lambda (x) (+ x 2)) '(1 2 3 4 5))
 (3 4 5 6 7)



--__--__--

Message: 10
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/clx/new-clx clx.f,2.49,2.50
Date: Tue, 13 Sep 2005 14:26:19 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/clx/new-clx
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1097/modules/clx/new-clx

Modified Files:
	clx.f 
Log Message:
(PUT-IMAGE): do not call XSync() -- callers should call DISPLAY-FORCE-OUTPUT


Index: clx.f
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v
retrieving revision 2.49
retrieving revision 2.50
diff -u -d -r2.49 -r2.50
--- clx.f	12 Sep 2005 21:03:36 -0000	2.49
+++ clx.f	13 Sep 2005 14:26:17 -0000	2.50
@@ -4077,6 +4077,7 @@
 #define DUMP_IMAGE(im)
 #endif
 
+/* make sure to call DISPLAY-FORCE-OUTPUT after this function! */
 DEFUN(XLIB:PUT-IMAGE, drawable gcontext image \
       &key SRC-X SRC-Y X Y WIDTH HEIGHT BITMAP-P)
 { /* This is a *VERY* silly implementation.
@@ -4142,10 +4143,7 @@
     dprintf(("\n;; put-image: IMAGE-X -> %dx%d+%d+%d",w,h,x,y));
     DUMP_IMAGE(&im);
 
-    begin_x_call();
-    XPutImage (dpy, drawable, gcontext, &im, src_x, src_y, x,y,w,h);
-    XSync (dpy, 0);
-    end_x_call();
+    X_CALL(XPutImage(dpy,drawable,gcontext,&im,src_x,src_y,x,y,w,h));
 
     goto raus;
   } else {



--__--__--

Message: 11
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src ChangeLog,1.4891,1.4892
Date: Tue, 13 Sep 2005 14:26:19 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1097/src

Modified Files:
	ChangeLog 
Log Message:
(PUT-IMAGE): do not call XSync() -- callers should call DISPLAY-FORCE-OUTPUT


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.4891
retrieving revision 1.4892
diff -u -d -r1.4891 -r1.4892
--- ChangeLog	13 Sep 2005 04:00:32 -0000	1.4891
+++ ChangeLog	13 Sep 2005 14:26:16 -0000	1.4892
@@ -1,3 +1,9 @@
+2005-09-13  "Dr. Werner Fink"  <we...@su...>
+
+	* modules/clx/new-clx/demos/sokoban.lisp (find-outers):
+	call DISPLAY-FORCE-OUTPUT
+	* modules/clx/new-clx/clx.f (PUT-IMAGE): do not call XSync()
+
 2005-09-12  Sam Steingold  <sd...@gn...>
 
 	* modules/syscalls/test.tst: SHOW the results for FILE-OWNER



--__--__--

Message: 12
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/clx/new-clx/demos sokoban.lisp,1.6,1.7
Date: Tue, 13 Sep 2005 14:26:19 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/clx/new-clx/demos
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1097/modules/clx/new-clx/demos

Modified Files:
	sokoban.lisp 
Log Message:
(PUT-IMAGE): do not call XSync() -- callers should call DISPLAY-FORCE-OUTPUT


Index: sokoban.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/demos/sokoban.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- sokoban.lisp	8 Dec 2002 19:45:15 -0000	1.6
+++ sokoban.lisp	13 Sep 2005 14:26:17 -0000	1.7
@@ -132,7 +132,8 @@
               (push (list (* x 40) (* y 40) 40 40) *rects*))))
         (setf (xlib:drawable-width *window*)  (* 40 (1+ maxx))
               (xlib:drawable-height *window*) (* 40 (1+ maxy)))
-        (xlib:shape-combine *window* *rects*)) )))
+        (xlib:shape-combine *window* *rects*))))
+  (xlib:display-force-output *display*))
 
 (defun init-field (&optional (level *level*))
   "Does all initialisation work needed when going to a different level."



--__--__--

Message: 13
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src ChangeLog,1.4892,1.4893
Date: Tue, 13 Sep 2005 15:15:30 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13330/src

Modified Files:
	ChangeLog 
Log Message:
(x_open_display): install error handlers here before
XOpenDisplay() to catch errors there too
(OPEN-DISPLAY): do not install error handlers


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.4892
retrieving revision 1.4893
diff -u -d -r1.4892 -r1.4893
--- ChangeLog	13 Sep 2005 14:26:16 -0000	1.4892
+++ ChangeLog	13 Sep 2005 15:15:27 -0000	1.4893
@@ -3,6 +3,9 @@
 	* modules/clx/new-clx/demos/sokoban.lisp (find-outers):
 	call DISPLAY-FORCE-OUTPUT
 	* modules/clx/new-clx/clx.f (PUT-IMAGE): do not call XSync()
+	(x_open_display): install error handlers here before
+	XOpenDisplay() to catch errors there too
+	(OPEN-DISPLAY): do not install error handlers
 
 2005-09-12  Sam Steingold  <sd...@gn...>
 



--__--__--

Message: 14
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/clx/new-clx clx.f,2.50,2.51
Date: Tue, 13 Sep 2005 15:15:30 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/clx/new-clx
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13330/modules/clx/new-clx

Modified Files:
	clx.f 
Log Message:
(x_open_display): install error handlers here before
XOpenDisplay() to catch errors there too
(OPEN-DISPLAY): do not install error handlers


Index: clx.f
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v
retrieving revision 2.50
retrieving revision 2.51
diff -u -d -r2.50 -r2.51
--- clx.f	13 Sep 2005 14:26:17 -0000	2.50
+++ clx.f	13 Sep 2005 15:15:28 -0000	2.51
@@ -1614,6 +1614,8 @@
  *  Chapter 2   Displays
  * ----------------------------------------------------------------------- */
 
+int xlib_error_handler (Display*, XErrorEvent*);
+int xlib_io_error_handler (Display*);
 static Display *x_open_display (char* display_name, int display_number) {
   Display *dpy;
 
@@ -1632,6 +1634,9 @@
     DYNAMIC_ARRAY (cname, char, len + 5);
 
     begin_x_call();
+    /* install the error handlers before XOpenDisplay to catch errors there */
+    XSetErrorHandler (xlib_error_handler);
+    XSetIOErrorHandler (xlib_io_error_handler);
     if (strchr(display_name,':'))
       strcpy(cname, display_name);
     else
@@ -1650,8 +1655,6 @@
   return dpy;
 }
 
-int xlib_error_handler (Display*, XErrorEvent*);
-int xlib_io_error_handler (Display*);
 DEFUN(XLIB:OPEN-DISPLAY, &rest args)
 { /* (XLIB:OPEN-DISPLAY host &key :display &allow-other-keys) */
   char *display_name = NULL;    /* the host to connect to */
@@ -1684,12 +1687,6 @@
                   { dpy = x_open_display(displayz,display_number); });
   } else dpy = x_open_display(NULL,display_number);
 
-  /* Now link in the error handler: */
-  begin_x_call();
-  XSetErrorHandler (xlib_error_handler);
-  XSetIOErrorHandler (xlib_io_error_handler);
-  end_x_call();
-
 # if !defined(RELY_ON_WRITING_TO_SUBPROCESS)
   disable_sigpipe();
 # endif



--__--__--

Message: 15
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/doc Makefile,1.74,1.75
Date: Tue, 13 Sep 2005 15:57:04 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/doc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23621/doc

Modified Files:
	Makefile 
Log Message:
check clisp.xml before impnotes.xml


Index: Makefile
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/Makefile,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- Makefile	4 Aug 2005 21:59:36 -0000	1.74
+++ Makefile	13 Sep 2005 15:57:02 -0000	1.75
@@ -147,8 +147,8 @@
 	$(FILLIN) $< > $@
 
 check: impnotes.xml $(IMPNOTES) clisp.xml
-	$(NSGMLS) -s -e -g -c$(XMLSOC) impnotes.xml
 	$(NSGMLS) -s -e -g -c$(XMLSOC) clisp.xml
+	$(NSGMLS) -s -e -g -c$(XMLSOC) impnotes.xml
 	xmllint --noout --valid --postvalid --timing --noent clisp.xml
 	xmllint --noout --valid --postvalid --timing --noent impnotes.xml
 



--__--__--

Message: 16
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/modules/postgresql sql.lisp,1.4,1.5 postgresql.xml,1.3,1.4 postgresql.lisp,1.13,1.14
Date: Tue, 13 Sep 2005 17:01:11 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/modules/postgresql
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8823/modules/postgresql

Modified Files:
	sql.lisp postgresql.xml postgresql.lisp 
Log Message:
(*sql-log*): init to NIL to avoid saving a closed terminal stream into the image
(with-sql-connection): accept :LOG and bind *sql-log*
("SQL"): make DEFVAR exporting


Index: postgresql.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/postgresql/postgresql.xml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- postgresql.xml	5 Apr 2005 21:32:38 -0000	1.3
+++ postgresql.xml	13 Sep 2005 17:01:09 -0000	1.4
@@ -22,25 +22,32 @@
 <para>Additionally, some higher level functionality is available:</para>
 
 <variablelist>
-<varlistentry><term><code>(sql:pq-finish &conn-r;)</code></term>
+<varlistentry id="sql:pq-finish"><term><code>(sql:pq-finish
+   &conn-r;)</code></term>
  <listitem><simpara><function>PQfinish</function> the &conn-r; and mark
    it as invalid</simpara></listitem></varlistentry>
-<varlistentry><term><code>(sql:pq-clear &res-r;)</code></term>
+<varlistentry id="sql:pq-clear"><term><code>(sql:pq-clear
+   &res-r;)</code></term>
  <listitem><simpara><function>PQclear</function> the &res-r; and mark
    it as invalid</simpara></listitem></varlistentry>
 <varlistentry><term><code>(sql:sql-error &conn-r; &res-r; &fmt-r;
    &rest-amp; &args-r;)</code></term>
  <listitem><simpara>finalize &conn-r; and &res-r; and &signal; an
    appropriate &error-t;</simpara></listitem></varlistentry>
-<varlistentry><term><code>(sql:sql-connect &key-amp; host port options
-   tty name login password)</code></term>
+<varlistentry id="sql:sql-connect"><term><code>(sql:sql-connect
+   &key-amp; host port options tty name login password)</code></term>
  <listitem><simpara>call <function>PQsetdbLogin</function> and return
    the &conn-r;</simpara></listitem></varlistentry>
-<varlistentry><term><code>(sql:with-sql-connection (var &rest-amp;
-   &option-r;s) &body-amp; &body-r;)</code></term>
- <listitem><simpara>call <function>sql:sql-connect</function>, execute
-   &body-r;, call <function>sql:pq-finish</function>
-</simpara></listitem></varlistentry>
+<varlistentry id="sql:with-sql-connection"><term><code>(sql:with-sql-connection
+   (var &rest-amp; &option-r;s &key-amp; log &allow-other-keys-amp;)
+   &body-amp; &body-r;)</code></term>
+ <listitem><orderedlist><listitem><simpara>bind <varname>*sql-log*</varname>
+     to the <replaceable>log</replaceable> argument</simpara></listitem>
+   <listitem><simpara>call
+     <function>sql:sql-connect</function></simpara></listitem>
+   <listitem><simpara>execute &body-r;</simpara></listitem>
+   <listitem><simpara>call <function>sql:pq-finish</function>
+</simpara></listitem></orderedlist></listitem></varlistentry>
 <varlistentry><term><code>(sql:sql-transaction &conn-r; &command-r;
    status &optional-amp; (clear-p &t;))</code></term>
  <listitem><simpara>execute the &command-r; via &conn-r;;
@@ -53,11 +60,11 @@
  <listitem><simpara>execure the &body-r; on the &res-r; of &command-r;,
    then <function>sql:pq-clear</function> the &res-r;
 </simpara></listitem></varlistentry>
-<varlistentry><term><code>sql:*sql-log*</code></term>
+<varlistentry id="sql:sql-log"><term><code>sql:*sql-log*</code></term>
  <listitem><simpara>when non-&nil;, should be a &stream-t;;
    <function>sql:sql-connect</function>
-   and <function>sql:sql-transaction</function> will write to it
-   (initially set to &standard-output-var;)
+   and <function>sql:sql-transaction</function>
+   will write to it (initially set to &nil;)
 </simpara></listitem></varlistentry></variablelist>
 
 <warning><para>Since <code>PQfinish</code> and <code>PQclear</code>

Index: sql.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/postgresql/sql.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- sql.lisp	5 Apr 2005 21:32:38 -0000	1.4
+++ sql.lisp	13 Sep 2005 17:01:09 -0000	1.5
@@ -18,7 +18,7 @@
 ;;; Helper Functions
 ;;;
 
-(defvar *sql-log* *standard-output*)
+(defvar *sql-log* nil)
 
 (define-condition sql-error (error)
   ((type :type symbol :reader sql-type :initarg :type)
@@ -58,11 +58,13 @@
               (PQtty conn) (PQoptions conn)))
     conn))
 
-(defmacro with-sql-connection ((conn &rest options) &body body)
-  `(let ((,conn (sql-connect ,@options)))
-    (unwind-protect (progn ,@body)
-      ;; close the connection to the database and cleanup
-      (pq-finish ,conn))))
+(defmacro with-sql-connection ((conn &rest options &key (log '*sql-log*)
+                                     &allow-other-keys) &body body)
+  `(let* ((*sql-log* ,log)
+          (,conn (sql-connect ,@(ext:remove-plist options :log))))
+     (unwind-protect (progn ,@body)
+       ;; close the connection to the database and cleanup
+       (pq-finish ,conn))))
 
 (defun sql-transaction (conn command status &optional (clear-p t))
   (let ((res (PQexec conn command)))

Index: postgresql.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/postgresql/postgresql.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- postgresql.lisp	21 Mar 2005 16:24:59 -0000	1.13
+++ postgresql.lisp	13 Sep 2005 17:01:09 -0000	1.14
@@ -9,7 +9,7 @@
   (:modern t)
   (:use "COMMON-LISP" "FFI")
   (:shadowing-import-from "EXPORTING"
-           #:defconstant #:defun #:defmacro
+           #:defconstant #:defun #:defmacro #:defvar
            #:def-c-type #:def-c-enum #:def-c-struct #:def-c-var #:def-call-out))
 
 (in-package "SQL")




--__--__--

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest