From emarsden at common-lisp.net  Tue Dec 26 14:19:19 2006
From: emarsden at common-lisp.net (emarsden)
Date: Tue, 26 Dec 2006 09:19:19 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/css
Message-ID: <20061226141919.0EB972F05A@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/css
In directory clnet:/tmp/cvs-serv20327

Modified Files:
	css-selector.lisp css-setup.lisp 
Log Message:
Trivial bugfixes.


--- /project/closure/cvsroot/closure/src/css/css-selector.lisp	2005/05/04 19:30:48	1.6
+++ /project/closure/cvsroot/closure/src/css/css-selector.lisp	2006/12/26 14:19:18	1.7
@@ -833,7 +833,7 @@
                                                  (subseq seq (+ p1 1) p2)))
                            (parse-style-sheet* seq (+ p2 1) nil)) )))))
             (t
-             (warn "Bad css syntax: " (as-string seq))
+             (warn "Bad css syntax: ~A" (as-string seq))
              nil)))))
 
 
--- /project/closure/cvsroot/closure/src/css/css-setup.lisp	2005/03/13 18:00:58	1.4
+++ /project/closure/cvsroot/closure/src/css/css-setup.lisp	2006/12/26 14:19:18	1.5
@@ -4,7 +4,7 @@
 ;;;   Created: 1998-06-18
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: css-setup.lisp,v 1.4 2005/03/13 18:00:58 gbaumann Exp $
+;;;       $Id: css-setup.lisp,v 1.5 2006/12/26 14:19:18 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1998-2002 by Gilbert Baumann
 
@@ -394,10 +394,8 @@
                            'new-interpret-length)
                      (round (* a dpi 12) 72))
                     (t
-                     (* a font-size))
-                    (t
-                     (round (* a dpi 12) 72))))
-	     (:ex 
+                     (* a font-size))))
+	     (:ex
               (cond ((and pt (not (realp font-size)))
                      (warn "In ~S: font-size not available -- fix your programm."
                            'new-interpret-length)
@@ -459,6 +457,9 @@
 
 
 ;; $Log: css-setup.lisp,v $
+;; Revision 1.5  2006/12/26 14:19:18  emarsden
+;; Trivial bugfixes.
+;;
 ;; Revision 1.4  2005/03/13 18:00:58  gbaumann
 ;; Gross license change
 ;;



From dlichteblau at common-lisp.net  Fri Dec 29 17:37:07 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 12:37:07 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061229173707.0474247143@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv12493

Modified Files:
	clim-gui.lisp 
Log Message:
Make closure start on Gtkairo:

	* src/gui/clim-gui.lisp (WRITE-STATUS, FOO, COM-REDRAW): Replace
        calls to xlib:display-finish-output with
        clim-backend:port-force-output.


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2005/08/25 15:14:14	1.22
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/29 17:37:07	1.23
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.22 2005/08/25 15:14:14 crhodes Exp $
+;;;       $Id: clim-gui.lisp,v 1.23 2006/12/29 17:37:07 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,13 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.23  2006/12/29 17:37:07  dlichteblau
+;; Make closure start on Gtkairo:
+;;
+;; 	* src/gui/clim-gui.lisp (WRITE-STATUS, FOO, COM-REDRAW): Replace
+;;         calls to xlib:display-finish-output with
+;;         clim-backend:port-force-output.
+;;
 ;; Revision 1.22  2005/08/25 15:14:14  crhodes
 ;; OpenMCL support (from Dave Murray aka JQS)
 ;;
@@ -514,7 +521,7 @@
 (defun write-status (string)
   (window-clear (find-pane-named *frame* 'status))
   (write-string string (find-pane-named *frame* 'status))
-  (xlib:display-finish-output (clim-clx::clx-port-display (find-port))))
+  (clim-backend:port-force-output (find-port)))
 
 (defun foo (url)
   (let ((*standard-output* *trace-output*))
@@ -561,9 +568,9 @@
                          (clim:change-space-requirements *pane* :width x2 :height y2)
                          ;; While we are at it, force a repaint
                          (handle-repaint *pane* (sheet-region (pane-viewport *pane*)))
-                         (xlib:display-finish-output (clim-clx::clx-port-display (find-port))))))))
+                         (clim-backend:port-force-output (find-port)))))))
                #+nil (write-status "Done.")))))
-       #+nil (xlib:display-finish-output (clim-clx::clx-port-display (find-port)))))))
+       #+nil (clim-backend:port-force-output (find-port))))))
 
 (defun reflow ()
   (let ((*standard-output* *trace-output*))
@@ -684,5 +691,5 @@
 (define-closure-command (com-redraw :name t :keystroke (#\r :control)) ()
   (let* ((*pane* (find-pane-named *frame* 'canvas)) )
     (handle-repaint *pane* (sheet-region (pane-viewport *pane*))))
-  (xlib:display-finish-output (clim-clx::clx-port-display (find-port))))
+  (clim-backend:port-force-output (find-port)))
 



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:23 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:23 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061229212923.5EAD4232D1@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv9505

Modified Files:
	closure.asd 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/closure.asd	2006/01/11 22:05:54	1.7
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/29 21:29:22	1.8
@@ -60,7 +60,7 @@
 			       (make-pathname :name nil :type nil
 					      :defaults *load-truename*))
     :default-component-class closure-source-file
-    :depends-on (:clim #+sbcl :sb-bsd-sockets)
+    :depends-on (:cxml :mcclim #+sbcl :sb-bsd-sockets)
     :components
     ((:file dependent
 	    :pathname
@@ -75,12 +75,10 @@
 	    #-(OR sbcl CLISP CMU ALLEGRO GCL OPENMCL) #.(error "Configure!"))
      (:file "package"
 	    :depends-on (dependent))
-     (:file "runes"
-	    :depends-on ("package" dependent))
      (:file "util"
-	    :depends-on ("package" dependent "runes"))
+	    :depends-on ("package" dependent))
      (:file "match"
-	    :depends-on ("package" dependent "runes" "util"))))
+	    :depends-on ("package" dependent "util"))))
 
 
 (asdf:defsystem closure
@@ -121,20 +119,6 @@
 			 (:file "css-support")))
 
 	       ;; Libraries
-	       
-	       (:module xml
-			:components
-			((:file "package")
-			 (:file "encodings"       :depends-on ("package"))
-			 (:file "encodings-data"  :depends-on ("package" "encodings"))
-			 (:file "sax-handler")
-			 (:file "dompack")
-			 (:file "dom-impl"        :depends-on ("dompack"))
-			 (:file "dom-builder"     :depends-on ("dom-impl" "sax-handler"))
-			 (:file "xml-stream"      :depends-on ("package"))
-			 (:file "xml-name-rune-p" :depends-on ("package"))
-			 (:file "xml-parse"       :depends-on ("package" "dompack" "sax-handler"))
-			 (:file "xml-canonic"     :depends-on ("package" "dompack" "xml-parse"))  ))
 
 	       ;; CLEX and LALR
 	       



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:23 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:23 -0500 (EST)
Subject: [closure-cvs] CVS closure/src
Message-ID: <20061229212923.EA1EB25003@common-lisp.net>

Update of /project/closure/cvsroot/closure/src
In directory clnet:/tmp/cvs-serv9505/src

Modified Files:
	defpack.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/defpack.lisp	2005/07/17 09:30:48	1.5
+++ /project/closure/cvsroot/closure/src/defpack.lisp	2006/12/29 21:29:23	1.6
@@ -28,7 +28,7 @@
 
 (defpackage :renderer
   (:nicknames :r2)
-  (:use :glisp)
+  (:use :glisp :runes)
   (:import-from :imagelib 
                 #:aimage
                 #:aimage-width
@@ -94,18 +94,18 @@
    ))
 
 (defpackage :ws/x11
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export
    #:aimage->ximage))
 
 (defpackage :gif
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export #:gif-stream->aimage))
 
 (defpackage :ws/charset
   ;;(:nicknames :charset)
   ;; Arg! CLISP now defines a package called "charset".
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export #:CHARSET
            #:CHARSET-DECODE
            #:CHARSET-ENCODE
@@ -118,7 +118,7 @@
 ;;zzz(defpackage :ws/estk (:use :glisp))     ;should die
 
 (defpackage :gui
-  (:use :glisp)
+  (:use :glisp :runes)
 
   (:import-from #:clim
    #:+nowhere+
@@ -197,7 +197,7 @@
    ))
 
 
-(defpackage :gtk-gui (:use :glisp))
+(defpackage :gtk-gui (:use :glisp :runes))
 
 (defpackage :closure
     (:use)
@@ -234,9 +234,4 @@
                 "DEVICE-FONT-UNDERLINE-THICKNESS"
                 ))
 
-(defpackage :clue-gui2 (:use #||:glue :clue||# :glisp))
-
-
-
-
-
+(defpackage :clue-gui2 (:use #||:glue :clue||# :glisp :runes))



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:25 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:25 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/css
Message-ID: <20061229212925.4A34732019@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/css
In directory clnet:/tmp/cvs-serv9505/src/css

Modified Files:
	css-parse.lisp css-selector.lisp css-support.lisp package.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/css/css-parse.lisp	2005/07/17 09:38:51	1.5
+++ /project/closure/cvsroot/closure/src/css/css-parse.lisp	2006/12/29 21:29:23	1.6
@@ -1145,7 +1145,16 @@
 (defmacro generate-slot-constants ()
   (generate-slot-constants-1))
 
+;;; Fixme! Some parts of the CSS parser use code integers rather than runes.
+;;; Here some dummy definitions to use in those cases:
+(defun white-space-hieroglyph-p (x)
+  (white-space-rune-p (code-rune x)))
+(defun hieroglyph= (a b)
+  (eql a b))
+(defun hieroglyph-equal (a b)
+  (equal a b))
+
 (defun find-value-parser (slot)
+  (unless (typep slot 'rod)
+    (setf slot (map 'rod #'code-rune slot)))
   (gethash (rod-downcase slot) *value-parsers*))
-
-
--- /project/closure/cvsroot/closure/src/css/css-selector.lisp	2006/12/26 14:19:18	1.7
+++ /project/closure/cvsroot/closure/src/css/css-selector.lisp	2006/12/29 21:29:24	1.8
@@ -272,22 +272,22 @@
              
           ((pclass)
            (cond ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "first-child") (cadr pred)))
+                       (rod-equal #"first-child" (cadr pred)))
                   (null (pt-predecessor element)))
                  ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "link") (cadr pred)))
+                       (rod-equal #"link" (cadr pred)))
                   (pseudo-class-matches-p :link element))
                  ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "first-line") (cadr pred)))
+                       (rod-equal #"first-line" (cadr pred)))
                   (pseudo-class-matches-p :first-line element))
                  ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "first-letter") (cadr pred)))
+                       (rod-equal #"first-letter" (cadr pred)))
                   (pseudo-class-matches-p :first-letter element))
                  ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "before") (cadr pred)))
+                       (rod-equal #"before" (cadr pred)))
                   (pseudo-class-matches-p :before element))
                  ((and (= (length (cdr pred)) 1)
-                       (rod-equal #.(map 'vector #'char-code "after") (cadr pred)))
+                       (rod-equal #"after" (cadr pred)))
                   (pseudo-class-matches-p :after element))
                  ;; lang fehlt.
                  (t
@@ -374,13 +374,13 @@
   ;; what should (rod-contains-p .. "" ..) yield?
   (dotimes (i (- (length haystack) (length needle) -1) nil)
     (when (and (or (= i 0)
-                   (white-space-rune-p (rune haystack (1- i))))
+                   (white-space-hieroglyph-p (hieroglyph haystack (1- i))))
                (or (= (+ i (length needle)) (length haystack))
-                   (white-space-rune-p (rune haystack (+ i (length needle))))))
+                   (white-space-hieroglyph-p (hieroglyph haystack (+ i (length needle))))))
       (when (dotimes (j (length needle) t)
               (unless (if case-sensitive-p
-                          (rune= (rune needle j) (rune haystack (+ i j)))
-                        (rune-equal (rune needle j) (rune haystack (+ i j))))
+                          (hieroglyph= (hieroglyph needle j) (hieroglyph haystack (+ i j)))
+                        (hieroglyph-equal (hieroglyph needle j) (hieroglyph haystack (+ i j))))
                 (return nil)))
         (return t)))))
 
@@ -392,7 +392,7 @@
              (rod= (subseq v 0 (length string)) string)
            (rod-equal (subseq v 0 (length string)) string))
          (or (= (length string) (length v))
-             (rune= (code-rune #.(char-code #\-)) (rune v (length string)))))))
+             (hieroglyph= (code-hieroglyph #.(char-code #\-)) (hieroglyph v (length string)))))))
 
 (defun skip-group (seq p &optional (level 0))
   (cond ((>= p (length seq))
@@ -825,8 +825,9 @@
                   (multiple-value-bind (sel-list condition)
                       (ignore-errors (parse-css2-selector-list seq p0 p1))
                     (cond (condition
-                           (warn "CSS selector list does not parse: `~A'."
-                                 (as-string (subseq seq p0 p1)))
+                           (warn "CSS selector list does not parse: `~A'.~% [~A]"
+                                 (as-string (subseq seq p0 p1))
+				 condition)
                            (setq sel-list nil)))
                     (nconc (multiplex-selectors sel-list
                                                 (parse-assignment-list
--- /project/closure/cvsroot/closure/src/css/css-support.lisp	2005/03/13 18:00:58	1.3
+++ /project/closure/cvsroot/closure/src/css/css-support.lisp	2006/12/29 21:29:24	1.4
@@ -39,7 +39,7 @@
 
 (defun intern-attribute-name (string)
   ;; XXX hack
-  (intern (string-upcase (map 'string (lambda (x) (or (code-char x) #\?)) string)) :keyword))
+  (intern (string-upcase (map 'string (lambda (x) (or (rune-char x) #\?)) string)) :keyword))
 
 (defun intern-gi (string)
   (intern-attribute-name string))
--- /project/closure/cvsroot/closure/src/css/package.lisp	2005/03/13 18:00:58	1.3
+++ /project/closure/cvsroot/closure/src/css/package.lisp	2006/12/29 21:29:24	1.4
@@ -28,7 +28,7 @@
 
 (in-package :CL-USER)
 (defpackage :css
-  (:use :glisp)
+  (:use :glisp :runes)
   ;;
   (:import-from "CLOSURE-PROTOCOL"
    ;; basic element protocol



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:26 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:26 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061229212926.473DD3301F@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv9505/src/glisp

Modified Files:
	package.lisp util.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/glisp/package.lisp	2005/03/13 18:01:15	1.4
+++ /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/29 21:29:25	1.5
@@ -285,35 +285,6 @@
       "LREDUCE*"
       "WITH-UNIQUE-NAMES"
     
-      ;; runes.lisp
-      "RUNE"
-      "ROD"
-      "SIMPLE-ROD"
-      "%RUNE"
-      "ROD-CAPITALIZE"
-      "CODE-RUNE"
-      "RUNE-CODE"
-      "RUNE-DOWNCASE"
-      "RUNE-UPCASE"
-      "ROD-DOWNCASE"
-      "ROD-UPCASE"
-      "WHITE-SPACE-RUNE-P"
-      "DIGIT-RUNE-P"
-      "RUNE="
-      "RUNE<="
-      "RUNE>="
-      "RUNE-EQUAL"
-      "RUNEP"
-      "SLOOPY-ROD-P"
-      "ROD="
-      "ROD-EQUAL"
-      "MAKE-ROD"
-      "CHAR-RUNE"
-      "RUNE-CHAR"
-      "ROD-STRING"
-      "STRING-ROD"
-      "ROD-SUBSEQ"
-    
       "G/MAKE-HASH-TABLE"
       "G/HASHGET"
       "G/CLRHASH"
--- /project/closure/cvsroot/closure/src/glisp/util.lisp	2005/03/13 18:01:16	1.4
+++ /project/closure/cvsroot/closure/src/glisp/util.lisp	2006/12/29 21:29:25	1.5
@@ -216,14 +216,16 @@
           (t (subseq string start)))))
 
 (defun sanify-rod (string &optional (begin? t) (end? t) (start 0))
-  (let ((i (position-if #'white-space-rune-p string :start start)))
+  (let ((i (position-if #'runes:white-space-rune-p string :start start)))
     (cond (i
-           (let ((j (position-if-not #'white-space-rune-p string :start i)))
+           (let ((j (position-if-not #'runes:white-space-rune-p
+				     string
+				     :start i)))
              (if j
-                 (concatenate 'rod (subseq string start i)
+                 (concatenate 'runes:rod (subseq string start i)
                               (if (and (= i start) begin?) '#() '#(32))
                               (sanify-rod string nil end? j))
-               (concatenate 'rod (subseq string start i)
+               (concatenate 'runes:rod (subseq string start i)
                             (if (not end?) '#(32) '#())))))
           (t (subseq string start)))))
 



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:27 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:27 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061229212927.3098E3A018@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv9505/src/gui

Modified Files:
	clue-gui.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2005/03/13 18:01:37	1.3
+++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/29 21:29:27	1.4
@@ -115,7 +115,7 @@
                       ((member mime-type (list (netlib:find-mime-type "text/html")))
                        (sgml::parse-html input charset))
                       ((member mime-type (list (netlib:find-mime-type "text/xml")))
-                       (xml::parse-stream input))
+                       (cxml:parse-stream input (cxml-dom:make-dom-builder) :recode nil))
 
                       ((or t
                            #+NIL
@@ -214,6 +214,10 @@
    (serial       :initarg :serial)
    (dumpee       :initarg :dumpee       :initform nil) ) )
 
+(defmethod runes::figure-encoding ((stream glisp:gstream))
+  ;; For HTML iso-8859-1 is the default
+  (values (cxml::find-encoding :iso-8859-1) nil))
+
 (defmethod g/read-byte ((stream pb-stream)  &optional (eof-error-p t) eof-value)
   (with-slots (nread ntotal proxee dumpee) stream
     (let ((res (g/read-byte proxee eof-error-p eof-value)))



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:28 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:28 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/html
Message-ID: <20061229212928.9FAE23A018@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/html
In directory clnet:/tmp/cvs-serv9505/src/html

Modified Files:
	html-style.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/html/html-style.lisp	2005/07/17 09:38:52	1.7
+++ /project/closure/cvsroot/closure/src/html/html-style.lisp	2006/12/29 21:29:28	1.8
@@ -94,7 +94,7 @@
 
 (defun pt-all-data (x)
   (cond ((member (element-gi x) '(:pcdata :comment))
-	 (map 'string (lambda (x) (or (code-char x) #\?))
+	 (map 'string (lambda (x) (or (rune-char x) #\?))
               (element-text x)))
 	((apply 'concatenate 'string
                 (mapcar #'pt-all-data (element-children x))))))
@@ -112,7 +112,7 @@
 (defun pt-attr/latin1 (pt attr &optional default)
   (let ((r (pt-attr/low pt attr)))
     (if r
-        (map 'string (lambda (x) (if (< x 256) (code-char x) #\?)) r)
+        (map 'string (lambda (x) (if (< (rune-code x) 256) (rune-char x) #\?)) r)
       default)))
 
 (defmethod closure-protocol:element-explicit-style (document (pt sgml::pt))
@@ -191,9 +191,6 @@
         (t
          (format nil "[invalid html-length: ~S]" value))))
 
-(defun rune->char (x)
-  (or (code-char x) #\?))
-
 (defun rod->string (x)
   (map 'simple-string (lambda (x) (or (code-char x) #\?)) x))
 
@@ -233,7 +230,7 @@
            (let ((val (some (lambda (key)
                               (and (= (length s) (length (symbol-name key)))
                                    (every (lambda (x y)
-                                            (char-equal (rune->char x) y))
+                                            (char-equal (rune-char x) y))
                                           s (symbol-name key))
                                    key))
                             keys)))



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:28 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:28 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/imagelib
Message-ID: <20061229212928.726DB4904C@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/imagelib
In directory clnet:/tmp/cvs-serv9505/src/imagelib

Modified Files:
	package.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/imagelib/package.lisp	2005/03/13 18:02:01	1.2
+++ /project/closure/cvsroot/closure/src/imagelib/package.lisp	2006/12/29 21:29:28	1.3
@@ -29,7 +29,7 @@
 (in-package :CL-USER)
 
 (defpackage :imagelib
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export
    #:aimage
    #:aimage-width



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:29 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:29 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/net
Message-ID: <20061229212929.1FF6150017@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/net
In directory clnet:/tmp/cvs-serv9505/src/net

Modified Files:
	package.lisp url.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/net/package.lisp	2005/03/13 18:02:19	1.2
+++ /project/closure/cvsroot/closure/src/net/package.lisp	2006/12/29 21:29:29	1.3
@@ -30,7 +30,7 @@
 
 (defpackage :ws/netlib
   (:nicknames :netlib)
-  (:use :glisp :url)
+  (:use :glisp :url :runes)
   (:export #:*options/connection-timeout*
            #:open-document
            #:with-open-document
--- /project/closure/cvsroot/closure/src/net/url.lisp	2005/03/13 18:02:19	1.5
+++ /project/closure/cvsroot/closure/src/net/url.lisp	2006/12/29 21:29:29	1.6
@@ -41,7 +41,7 @@
 ;(require :glisp)
 
 (defpackage :url
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export
    #:parse-url
    #:unparse-url
@@ -206,11 +206,7 @@
 (declaim (inline ascii-digit-char-p))
 
 (defun parse-url (input &key (plain-query-p t))
-  (cond ((sloopy-rod-p input)
-         ;; zzz use UTF-8
-         (parse-url (map 'string (lambda (x) (or (code-char x) #\?)) input) 
-                    :plain-query-p plain-query-p))
-        ((stringp input)
+  (cond ((stringp input)
          (let ((anchor nil)
                (protocol nil)
                (net-loc nil)
@@ -263,6 +259,10 @@
                            :path       (mapcar #'unescape-string path)
                            :query      (if plain-query-p query (parse-query query))
                            :anchor     (unescape-string anchor)) )))))
+         ((sloopy-rod-p input)
+	  ;; zzz use UTF-8
+	  (parse-url (map 'string (lambda (x) (or (rune-char x) #\?)) input) 
+		     :plain-query-p plain-query-p))
          ((eq input NIL)
           (warn "Saw NIL as input to URL:PARSE-URL; fix your program.")
           (parse-url "" :plain-query-p plain-query-p))



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:32 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:32 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/parse
Message-ID: <20061229212932.0149675024@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/parse
In directory clnet:/tmp/cvs-serv9505/src/parse

Modified Files:
	package.lisp sgml-dtd.lisp sgml-parse.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/parse/package.lisp	2005/03/13 18:02:40	1.3
+++ /project/closure/cvsroot/closure/src/parse/package.lisp	2006/12/29 21:29:30	1.4
@@ -29,7 +29,7 @@
 (in-package :CL-USER)
 
 (defpackage :sgml
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export #:SGML-PARSE 
            #:PPT 
            #:SGML-UNPARSE 
--- /project/closure/cvsroot/closure/src/parse/sgml-dtd.lisp	2005/03/13 18:02:40	1.4
+++ /project/closure/cvsroot/closure/src/parse/sgml-dtd.lisp	2006/12/29 21:29:30	1.5
@@ -367,7 +367,7 @@
 	((eq (car def) 'def-entity)
 	 (push (cons (second def) 
                      (resolve-entities-in-string 
-                      (map '(simple-array (unsigned-byte 16) (*)) #'char-code (third def))
+                      (string-rod (third def))
                       (dtd-entities dtd)))
 	       (dtd-entities dtd)))
 	((eq (car def) 'defelement)
@@ -835,4 +835,4 @@
 
 (defun undump-dtd (filename)
   (first (excl:fasl-read (open filename :element-type '(unsigned-byte 8)))))
-||#
\ No newline at end of file
+||#
--- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp	2005/03/13 18:02:40	1.4
+++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp	2006/12/29 21:29:30	1.5
@@ -240,36 +240,36 @@
 
 (defmacro a-read-byte (input)
   (let ((c (gensym)))
-    `(let ((,c (xml:read-rune ,input)))
+    `(let ((,c (runes:read-rune ,input)))
        (if (eq ,c :eof) nil ,c))))
 
 (defmacro a-peek-byte (input)
   (let ((c (gensym)))
-    `(let ((,c (xml:peek-rune ,input)))
+    `(let ((,c (runes:peek-rune ,input)))
        (if (eq ,c :eof) nil ,c))))
 
 (defmacro a-unread-byte (byte input)
-  `(xml:unread-rune ,byte ,input))
+  `(runes:unread-rune ,byte ,input))
 
 (defmacro a-stream-position (input)
-  `(xml:xstream-position ,input))
+  `(runes:xstream-position ,input))
 
 (defun make-a-stream (&key cl-stream)
-  (xml:make-xstream cl-stream :initial-speed 1 :speed 8192))
+  (runes:make-xstream cl-stream :initial-speed 1 :speed 8192))
 
-(defmethod xml::read-octets (sequence (stream glisp:gstream) start end)
+(defmethod runes::read-octets (sequence (stream glisp:gstream) start end)
   (glisp:g/read-byte-sequence sequence stream :start start :end end))
 
-(defmethod xml::xstream/close ((stream glisp:gstream))
+(defmethod runes::xstream/close ((stream glisp:gstream))
   (glisp:g/close stream))
 
 ;; a fake definition -- XXX non-reentrant!
 
 (defun a-stream-scratch (input)
-  (getf (xml::xstream-plist input) 'scratch-pad))
+  (getf (runes::xstream-plist input) 'scratch-pad))
 
 (defun (setf a-stream-scratch) (new-value input)
-  (setf (getf (xml::xstream-plist input) 'scratch-pad) new-value))
+  (setf (getf (runes::xstream-plist input) 'scratch-pad) new-value))
 
 ;;;; -------------------------------------------------------------------------
 ;;;;  Reporting Errors
@@ -295,8 +295,8 @@
     (when (>= level *parse-warn-level*)
       (unless *options/parser-silent-p*
         (let ((preample (format nil ";; Parser warning: ~11@<Line ~D,~> ~11@<column ~D~>: ~5A "
-                                (and input (ignore-errors (xml:xstream-line-number input)))
-                                (and input (ignore-errors (xml:xstream-column-number input)))
+                                (and input (ignore-errors (runes:xstream-line-number input)))
+                                (and input (ignore-errors (runes:xstream-column-number input)))
                                 (make-string level :initial-element #\*))))
           (fresh-line *trace-output*)
           (write-string preample *trace-output*)
@@ -351,7 +351,10 @@
     (declare (type fixnum sp se))
     (loop
       (let ((ch (a-read-byte input)))
-        (declare (type (or null (unsigned-byte 8)) ch))
+	;; FIXME: why was this declared as (u-b 8), not (u-b 16)?
+	;; a-read-byte returns a rune.
+;;; 	(declare (type (or null (unsigned-byte 8)) ch))
+        (declare (type (or null rune) ch))
         (cond ((null ch)                                ;eof
                (return))
               ((rune= ch #/<)                 ;end of pcdata
@@ -622,7 +625,8 @@
            (read-sloopy-value input))
           (t
            (read-tag-error input "Bad value '~A' seen"
-                           (or (code-char ch) (format nil "U+~4,'0X" ch)))))))
+                           (or (rune-char ch)
+			       (format nil "U+~4,'0X" (rune-code ch))))))))
 
 (defun read-literal (input dtd delim)
   (let* ((scratch (a-stream-scratch input))             ;scratch pad
@@ -633,7 +637,10 @@
     (declare (type fixnum sp se))
     (loop
       (let ((ch (a-read-byte input)))
-        (declare (type (or null (unsigned-byte 8)) ch))
+	;; FIXME: why was this declared as (u-b 8), not (u-b 16)?
+	;; a-read-byte returns a rune.
+;;; 	(declare (type (or null (unsigned-byte 8)) ch))
+        (declare (type (or null rune) ch))
         (cond ((null ch)                                ;eof
                (read-tag-error input "Eof in literal"))
               ((rune= ch delim)
@@ -1038,8 +1045,8 @@
                     (handle-meta-tag-in-parser input (caddr ausgabe))))
              ;; when the BODY tag is openend, switch the streams speed to full speed.
              (cond ((and (eq (cadr ausgabe) :body))
-                    (setf (xml::xstream-speed input)
-                      (length (xml::xstream-os-buffer input)))))
+                    (setf (runes::xstream-speed input)
+                      (length (runes::xstream-os-buffer input)))))
              (let ((n (sgml::make-pt/low 
                        :name (cadr ausgabe)
                        :attrs (caddr ausgabe)
@@ -1294,7 +1301,7 @@
 
 (defun parse-html (input &optional (charset :iso-8859-1))
   (let ((dtd cl-user::*html-dtd*))
-    (let ((input (xml:make-xstream input :initial-speed 1 :speed 128)))
+    (let ((input (runes:make-xstream input :initial-speed 1 :speed 128)))
       (setf (a-stream-scratch input)
         (make-array #.(* 2 *buf-size*) :element-type 'rune))
       (setup-code-vector input charset)
@@ -1583,9 +1590,9 @@
 ;;  
 
 (defun setup-code-vector (input charset)
-  (let ((enc (xml::find-encoding charset)))
+  (let ((enc (cxml::find-encoding charset)))
     (cond ((not (null enc))
-           (setf (xml:xstream-encoding input) enc))
+           (setf (runes:xstream-encoding input) enc))
           (t
            (parse-warn input 4 "There is no such encoding: ~S." charset)))))
 
@@ -1795,7 +1802,7 @@
 
 #||
     (format T "~&;; Parse error (line ~D column ~D): [~A] Saw ~A in ~A."
-            (xml:xstream-line-number input)
-            (xml:xstream-column-number input))
+            (runes:xstream-line-number input)
+            (runes:xstream-column-number input))
 
-||#
\ No newline at end of file
+||#



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:33 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:33 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/protocols
Message-ID: <20061229212933.41E54301F@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/protocols
In directory clnet:/tmp/cvs-serv9505/src/protocols

Modified Files:
	package.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/protocols/package.lisp	2005/03/13 18:03:05	1.3
+++ /project/closure/cvsroot/closure/src/protocols/package.lisp	2006/12/29 21:29:33	1.4
@@ -27,7 +27,7 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 (defpackage :CLOSURE-PROTOCOL
-    (:use :glisp)
+    (:use :glisp :runes)
   (:export
    ;; Basic Element Protocol
    #:element-p



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:43 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:43 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/renderer
Message-ID: <20061229212943.8CBCE232D2@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/renderer
In directory clnet:/tmp/cvs-serv9505/src/renderer

Modified Files:
	clim-draw.lisp list-item.lisp raux.lisp renderer.lisp 
	renderer2.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2005/07/11 15:57:56	1.4
+++ /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2006/12/29 21:29:34	1.5
@@ -4,7 +4,7 @@
 ;;;   Created: 2003-03-08
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-draw.lisp,v 1.4 2005/07/11 15:57:56 crhodes Exp $
+;;;       $Id: clim-draw.lisp,v 1.5 2006/12/29 21:29:34 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -197,7 +197,7 @@
     (let ((x 0))
       (loop for i from start to (1- end) do
             (let* ((rune (aref runes i)))
-              (if (white-space-rune-p rune) (setf rune 32))
+              (if (white-space-rune-p rune) (setf rune #/U+0020))
               (progn
                 (let ((cw (+ (if (white-space-rune-p rune)
                                  (+ (rune-width font rune) word-spacing)
@@ -236,12 +236,12 @@
                 (type css-font-desc $font))
        (let ((x 0)
              ($rune 0))
-         (declare (type rune $rune))
+         (declare (type fixnum $rune))
          (declare (type fixnum x))
          (loop for i #-GCL of-type #-GCL fixnum from ,start to (the fixnum (1- ,end)) do
                (locally
                    (declare (fixnum i))
-                 (setq $rune (aref (the rod ,runes) i))
+                 (setq $rune (rune-code (aref (the rod ,runes) i)))
                  (if (white-space-rune-p*/no-nl $rune)
                      (setf $rune 32))
                  (let (($cw 0))
@@ -278,10 +278,10 @@
       (let ((buffer-size (length buffer)))
         (prog1
             (iterate-over-runes
-             (lambda (rune index x cw)
+             (lambda (code index x cw)
                index
-               (let ((fid (css-font-desc-glyph-fid (text-style-font text-style) rune))
-                     (i   (css-font-desc-glyph-index (text-style-font text-style) rune)))
+               (let* ((fid (css-font-desc-glyph-fid (text-style-font text-style) code))
+		      (i   (css-font-desc-glyph-index (text-style-font text-style) code)))
                  (when (or (not (eq font fid))
                            (= bptr buffer-size))
                    ;; we have to spill
--- /project/closure/cvsroot/closure/src/renderer/list-item.lisp	2005/06/13 10:14:23	1.3
+++ /project/closure/cvsroot/closure/src/renderer/list-item.lisp	2006/12/29 21:29:38	1.4
@@ -112,19 +112,19 @@
     (:circle (coerce (vector (elt +list-style-type-glyphs/circle+ 0)) 'rod))
     (:square (coerce (vector (elt +list-style-type-glyphs/square+ 0)) 'rod))
     (:decimal
-     (map 'rod #'char-code 
+     (map 'rod #'char-rune 
           (format nil "~D." n)))
     (:lower-roman
-     (map 'rod #'char-code 
+     (map 'rod #'char-rune 
           (format nil "~(~@R~)." n)))
     (:upper-roman
-     (map 'rod #'char-code 
+     (map 'rod #'char-rune 
           (format nil "~:@(~@R~)." n)))
     (:lower-alpha
-     (map 'rod #'char-code 
+     (map 'rod #'char-rune 
           (format nil "~(~A~)." (integer->abc n))))
     (:upper-alpha
-     (map 'rod #'char-code 
+     (map 'rod #'char-rune 
           (format nil "~:@(~A~)." (integer->abc n))))
     (:none
      (map 'rod #'identity nil))))
--- /project/closure/cvsroot/closure/src/renderer/raux.lisp	2005/03/13 18:03:24	1.5
+++ /project/closure/cvsroot/closure/src/renderer/raux.lisp	2006/12/29 21:29:38	1.6
@@ -30,7 +30,7 @@
 
 (defun pt-data (x)
   (cond ((text-element-p x)
-	 (map 'string #'code-char (element-text x)))
+	 (map 'string #'rune-char (element-text x)))
 	((apply 'concatenate 'string
                 (mapcar #'pt-data (element-children x))))))
 
--- /project/closure/cvsroot/closure/src/renderer/renderer.lisp	2005/03/13 18:03:25	1.10
+++ /project/closure/cvsroot/closure/src/renderer/renderer.lisp	2006/12/29 21:29:39	1.11
@@ -4,7 +4,7 @@
 ;;;   Created: long ago
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: renderer.lisp,v 1.10 2005/03/13 18:03:25 gbaumann Exp $
+;;;       $Id: renderer.lisp,v 1.11 2006/12/29 21:29:39 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2002 by Gilbert Baumann
 
@@ -91,15 +91,15 @@
 
 (defvar +list-style-type-glyphs/disc+
     (list ;;u/black-circle u/bullet u/white-bullet u/white-circle
-          (char-code #\o)))
+          (char-rune #\o)))
 
 (defvar +list-style-type-glyphs/circle+
     (list ;;u/white-circle u/white-bullet u/bullet u/black-circle
-          (char-code #\*)))
+          (char-rune #\*)))
 
 (defvar +list-style-type-glyphs/square+
     (list ;;u/black-square u/white-square u/white-bullet u/bullet
-          (char-code #\-)))
+          (char-rune #\-)))
 
 
 ;;;;
@@ -117,7 +117,7 @@
 ;;; ---- Believed to be correct -----------------------------------------------
 
 (defsubst rune-width (font rune)
-  (css-font-desc-glyph-width font rune))
+  (css-font-desc-glyph-width font (rune-code rune)))
 
 (defun parse-url* (url)
   (cond ((url:url-p url) url)
--- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2006/11/06 19:43:01	1.15
+++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2006/12/29 21:29:39	1.16
@@ -4,7 +4,7 @@
 ;;;   Created: somewhen late 2002
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: renderer2.lisp,v 1.15 2006/11/06 19:43:01 thenriksen Exp $
+;;;       $Id: renderer2.lisp,v 1.16 2006/12/29 21:29:39 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -2261,8 +2261,8 @@
                        collect (table-column-maximum-width (table-column table i))))
            (min (reduce #'+ mins))
            (max (reduce #'+ maxs))
-           (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table))))
-      ;;
+           (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table)))) 
+     ;;
       (setf table.width
             (cond
               ;; | 2. If the 'table' or 'inline-table' element has 'width: auto', the
@@ -2761,12 +2761,13 @@
             before-markers)
     ;; first off the first thing must be a block-open
     (unless (eq (caar q) :open)
-      (error "Barf!"))
+      (error "Barf! (1)"))
     (push (my-setup-style (cadar q) (car ss) cbss) ss)
     ;;
     (setf mes (car ss))
     (unless (cooked-style-block-element-p (car ss))
-      (error "Barf!"))
+      (error "Barf! (2) -- Expected cooked-style-block-element, found ~A"
+	     (cooked-style-display (car ss))))
     (setf me (cadar q))
     (pop q)
 
@@ -2960,9 +2961,8 @@
 (defun make-black-chunk* (char style)
   (cons-black-chunk
    :style style
-   :data (map '(simple-array (unsigned-byte 16) (*))
-              #'identity
-              (list char))))
+   :data (map 'rod ;; war: (simple-array (unsigned-byte 16) (*))
+	   #'identity (list char))))
 
 ;;; first-letter pseudo elements
 
@@ -3072,7 +3072,7 @@
           for i fixnum from 0 do
           (cond
             ,@(AND (EQL :PRE WHITE-SPACE)
-                   (list `((= c 10)
+                   (list `((eql c #/U+0010)
                            (let ((ocontext context))
                              ,(OR LETTER-SPACING-APPLICABLE-P
                                   '(unless (= blacki i)
@@ -3152,10 +3152,10 @@
                                                    (reverse ncontext))
                                    :%here ,(IF LETTER-SPACING-APPLICABLE-P
                                                `(if (eql word-spacing :normal)
-                                                    (list (make-black-chunk* 32 (car ss)))
-                                                    (list (make-black-chunk* 32 (car ss))
+                                                    (list (make-black-chunk* #/U+0020 (car ss)))
+                                                    (list (make-black-chunk* #/U+0020 (car ss))
                                                           (make-kern-chunk word-spacing)))
-                                               `(list (make-black-chunk* 32 (car ss))))))
+                                               `(list (make-black-chunk* #/U+0020 (car ss))))))
                             #-NIL
                             (push (make-instance
                                    'disc-chunk
@@ -3169,30 +3169,30 @@
                                                    (reverse ncontext))
                                    :%here ,(IF LETTER-SPACING-APPLICABLE-P
                                                `(if (eql word-spacing :normal)
-                                                    (list (make-black-chunk* 32 (car ss)))
-                                                    (list (make-black-chunk* 32 (car ss))
+                                                    (list (make-black-chunk* #/U+0020 (car ss)))
+                                                    (list (make-black-chunk* #/U+0020 (car ss))
                                                           (make-kern-chunk word-spacing)))
-                                               `(list (make-black-chunk* 32 (car ss)))))
+                                               `(list (make-black-chunk* #/U+0020 (car ss)))))
                              res)))
                          ((:PRE)
                           `(progn
                             ,(IF LETTER-SPACING-APPLICABLE-P
                                  `(if (eql word-spacing :normal)
-                                   (push (make-black-chunk* 32 (car ss)) res)
+                                   (push (make-black-chunk* #/U+0020 (car ss)) res)
                                    (progn
-                                     (push (make-black-chunk* 32 (car ss)) res)
+                                     (push (make-black-chunk* #/U+0020 (car ss)) res)
                                      (push (make-kern-chunk word-spacing) res)))
-                                 `(push (make-black-chunk* 32 (car ss)) res) )
+                                 `(push (make-black-chunk* #/U+0020 (car ss)) res) )
                             (setf blacki (+ i 1))))
                          ((:NOWRAP)
                           `(progn
                             ,(IF LETTER-SPACING-APPLICABLE-P
                                  `(if (eql word-spacing :normal)
-                                   (push (make-black-chunk* 32 (car ss)) res)
+                                   (push (make-black-chunk* #/U+0020 (car ss)) res)
                                    (progn
-                                     (push (make-black-chunk* 32 (car ss)) res)
+                                     (push (make-black-chunk* #/U+0020 (car ss)) res)
                                      (push (make-kern-chunk word-spacing) res)))
-                                 `(push (make-black-chunk* 32 (car ss)) res) )))))))
+                                 `(push (make-black-chunk* #/U+0020 (car ss)) res) )))))))
 
             (t
              ,(AND LETTER-SPACING-APPLICABLE-P
@@ -4969,6 +4969,9 @@
 
 
 ;; $Log: renderer2.lisp,v $
+;; Revision 1.16  2006/12/29 21:29:39  dlichteblau
+;; Use CXML's rune implementation and XML parser.
+;;
 ;; Revision 1.15  2006/11/06 19:43:01  thenriksen
 ;; Remove compiler-killing evil character from comment.
 ;;



From dlichteblau at common-lisp.net  Fri Dec 29 21:29:49 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:29:49 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/util
Message-ID: <20061229212949.2B8464C0C8@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/util
In directory clnet:/tmp/cvs-serv9505/src/util

Modified Files:
	clex.lisp lalr.lisp xterm.lisp 
Log Message:

Use CXML's rune implementation and XML parser.


--- /project/closure/cvsroot/closure/src/util/clex.lisp	2005/03/13 18:03:57	1.3
+++ /project/closure/cvsroot/closure/src/util/clex.lisp	2006/12/29 21:29:44	1.4
@@ -27,7 +27,7 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 (defpackage :clex
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export
    #:deflexer #:backup #:begin #:initial #:bag))
 
--- /project/closure/cvsroot/closure/src/util/lalr.lisp	2002/07/22 02:27:19	1.1.1.1
+++ /project/closure/cvsroot/closure/src/util/lalr.lisp	2006/12/29 21:29:44	1.2
@@ -7,7 +7,7 @@
 ;;;  (c) 1988 Mark Johnson
 
 (defpackage :lalr
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export #:DEFINE-GRAMMAR))
 
 (in-package :LALR)
--- /project/closure/cvsroot/closure/src/util/xterm.lisp	2005/03/13 18:03:58	1.2
+++ /project/closure/cvsroot/closure/src/util/xterm.lisp	2006/12/29 21:29:44	1.3
@@ -28,7 +28,7 @@
 
 
 (defpackage :XTERM
-  (:use :glisp)
+  (:use :glisp :runes)
   (:export
    #:open-terminal
    ))



From dlichteblau at common-lisp.net  Fri Dec 29 21:49:49 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:49:49 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061229214949.6096939056@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv12843/src/glisp

Removed Files:
	runes.lisp 
Log Message:
remove old files





From dlichteblau at common-lisp.net  Fri Dec 29 21:49:49 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:49:49 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/xml
Message-ID: <20061229214949.D9B783E008@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/xml
In directory clnet:/tmp/cvs-serv12843/src/xml

Removed Files:
	dom-builder.lisp dom-impl.lisp dompack.lisp 
	encodings-data.lisp encodings.lisp package.lisp 
	sax-handler.lisp xml-canonic.lisp xml-name-rune-p.lisp 
	xml-parse.lisp xml-stream.lisp 
Log Message:
remove old files





From dlichteblau at common-lisp.net  Fri Dec 29 21:49:50 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 16:49:50 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/xml/sax-tests
Message-ID: <20061229214950.B206E47143@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/xml/sax-tests
In directory clnet:/tmp/cvs-serv12843/src/xml/sax-tests

Removed Files:
	event-collecting-handler.lisp package.lisp tests.lisp 
Log Message:
remove old files





From dlichteblau at common-lisp.net  Fri Dec 29 22:06:44 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 17:06:44 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061229220644.BCBAB1A0A4@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv15346

Modified Files:
	INSTALL 
Removed Files:
	BUILD closure.system 
Log Message:
Remove outdated system file and BUILD-script.  Update INSTALL accordingly.


--- /project/closure/cvsroot/closure/INSTALL	2005/03/13 16:57:06	1.2
+++ /project/closure/cvsroot/closure/INSTALL	2006/12/29 22:06:44	1.3
@@ -2,7 +2,7 @@
 
 Provide yourself with:
 
- 1. CMUCL
+ 1. CMUCL, SBCL, or another supported implementation
 
     [For what it is worth, I use 18d-pre]
 
@@ -14,13 +14,16 @@
 
     [Debian package gif2png]
 
+ 4. McCLIM, Closure XML, and their dependencies
 
-There is a script named BUILD. After executing it, if you are lucky
-this will leave you with a lisp.core which contains closure.
+    [ http://common-lisp.net/project/mcclim/
+      http://common-lisp.net/project/cxml/ ]
 
-Fire up the the newly build core:
 
-$ lisp -core lisp.core
+Compile closure using ASDF: Register closure.asd in your central
+registry and run:
+
+* (asdf:operate 'asdf:load-op :closure)
 
 Then start Closure:
 



From dlichteblau at common-lisp.net  Fri Dec 29 22:09:37 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Fri, 29 Dec 2006 17:09:37 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061229220937.B57A11A0A3@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv15548

Modified Files:
	INSTALL 
Log Message:
also mention the instructions on common-lisp.net


--- /project/closure/cvsroot/closure/INSTALL	2006/12/29 22:06:44	1.3
+++ /project/closure/cvsroot/closure/INSTALL	2006/12/29 22:09:37	1.4
@@ -1,5 +1,8 @@
 Preliminary Installation Instructions
 
+(See also: http://common-lisp.net/project/closure/quickstart.html)
+
+
 Provide yourself with:
 
  1. CMUCL, SBCL, or another supported implementation



From emarsden at common-lisp.net  Sat Dec 30 15:00:28 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:00:28 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061230150028.E123B140B1@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv10739/src/glisp

Modified Files:
	dep-sbcl.lisp 
Log Message:
Use character instead of base-char for GLISP strings (base-char is
only 7 bits wide in Unicode-enabled SBCL builds). 


--- /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2006/12/30 15:00:28	1.3
@@ -91,7 +91,7 @@
 ;;;;;;
 
 (defun glisp::g/make-string (length &rest options)
-  (apply #'make-array length :element-type 'base-char options))
+  (apply #'make-array length :element-type 'character options))
 
 
 



From emarsden at common-lisp.net  Sat Dec 30 15:07:31 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:07:31 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061230150731.657BB1A0AA@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv12658/src/gui

Modified Files:
	clim-gui.lisp 
Log Message:
Minor improvements to user interface:
  - enable double buffering
  - wait until page has been downloaded before erasing previous page
  - enable busy cursor while downloading and rendering


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/29 17:37:07	1.23
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/30 15:07:31	1.24
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.23 2006/12/29 17:37:07 dlichteblau Exp $
+;;;       $Id: clim-gui.lisp,v 1.24 2006/12/30 15:07:31 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,12 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.24  2006/12/30 15:07:31  emarsden
+;; Minor improvements to user interface:
+;;   - enable double buffering
+;;   - wait until page has been downloaded before erasing previous page
+;;   - enable busy cursor while downloading and rendering
+;;
 ;; Revision 1.23  2006/12/29 17:37:07  dlichteblau
 ;; Make closure start on Gtkairo:
 ;;
@@ -162,6 +168,8 @@
     :min-height 100
     :max-width 300
     :max-height 20000
+    :incremental-redisplay t
+    :double-buffering t
     :display-function 'aux-display
     :display-time :command-loop)
    (status :pointer-documentation
@@ -192,7 +200,7 @@
    (default
        (vertically ()
          (spacing (:thickness 5)
-                  (scrolling (:width 830 :height 600 :min-height 600 :max-height 20000
+                  (scrolling (:width 830 :height 600 :min-height 400 :max-height 20000
                               :scroll-bar :vertical)
                     canvas))
          (spacing (:thickness 5)
@@ -531,9 +539,9 @@
          (let* ((*package* (find-package :r2))
                 (*pane* (find-pane-named *frame* 'canvas))
                 (*medium* (sheet-medium *pane*)))
-           (window-clear *pane*)
            (progn ;; with-sheet-medium (*medium* *pane*)
              (let ((device (make-instance 'closure/clim-device::clim-device :medium *pane*)))
+               (setf (sheet-pointer-cursor *pane*) :busy)
                (setq url (r2::parse-url* url))
                (let ((request (clue-gui2::make-request :url url :method :get)))
                  (multiple-value-bind (io header) (clue-gui2::open-document-4 request)
@@ -554,6 +562,7 @@
                                 (make-instance 'r2::xml-style-document-language)))
                            (closure-protocol:*user-agent* nil)
                            (r2::*canvas-width* (bounding-rectangle-width (sheet-parent *pane*))))
+                       (window-clear *pane*)
                        (closure-protocol:render
                         closure-protocol:*document-language* 
                         doc
@@ -569,7 +578,8 @@
                          ;; While we are at it, force a repaint
                          (handle-repaint *pane* (sheet-region (pane-viewport *pane*)))
                          (clim-backend:port-force-output (find-port)))))))
-               #+nil (write-status "Done.")))))
+               (setf (sheet-pointer-cursor *pane*) :default)
+               (write-status "Done.")))))
        #+nil (clim-backend:port-force-output (find-port))))))
 
 (defun reflow ()



From emarsden at common-lisp.net  Sat Dec 30 15:08:09 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:08:09 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061230150809.1736E1C009@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv12732/src/gui

Modified Files:
	gui.lisp 
Log Message:
Cleanup debugging code.


--- /project/closure/cvsroot/closure/src/gui/gui.lisp	2005/07/17 09:30:52	1.7
+++ /project/closure/cvsroot/closure/src/gui/gui.lisp	2006/12/30 15:08:09	1.8
@@ -394,9 +394,6 @@
 ;;;;  profiling
 ;;;;
 
-(defparameter cl-user::*profile-closure-p* nil)
-(defparameter cl-user::*closure-dpi* 88)           ;this doesn't belong here
-
 (defclass prim-ht-view ()
   ((display-list        :initform nil)
    (active-pt           :initform nil)



From emarsden at common-lisp.net  Sat Dec 30 15:13:54 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:13:54 -0500 (EST)
Subject: [closure-cvs] CVS closure/src
Message-ID: <20061230151354.C121F21049@common-lisp.net>

Update of /project/closure/cvsroot/closure/src
In directory clnet:/tmp/cvs-serv12910/src

Modified Files:
	defpack.lisp 
Log Message:
- use CL from Closure packages
- minor rod fixes
- move PARSE-X11-COLOR from clim-user to ws/x11 package


--- /project/closure/cvsroot/closure/src/defpack.lisp	2006/12/29 21:29:23	1.6
+++ /project/closure/cvsroot/closure/src/defpack.lisp	2006/12/30 15:13:54	1.7
@@ -28,7 +28,7 @@
 
 (defpackage :renderer
   (:nicknames :r2)
-  (:use :glisp :runes)
+  (:use :glisp :runes :cl)
   (:import-from :imagelib 
                 #:aimage
                 #:aimage-width
@@ -94,18 +94,18 @@
    ))
 
 (defpackage :ws/x11
-  (:use :glisp :runes)
+  (:use :glisp :runes :cl)
   (:export
    #:aimage->ximage))
 
 (defpackage :gif
-  (:use :glisp :runes)
+  (:use :glisp :runes :cl)
   (:export #:gif-stream->aimage))
 
 (defpackage :ws/charset
   ;;(:nicknames :charset)
   ;; Arg! CLISP now defines a package called "charset".
-  (:use :glisp :runes)
+  (:use :glisp :runes :cl)
   (:export #:CHARSET
            #:CHARSET-DECODE
            #:CHARSET-ENCODE
@@ -118,7 +118,7 @@
 ;;zzz(defpackage :ws/estk (:use :glisp))     ;should die
 
 (defpackage :gui
-  (:use :glisp :runes)
+  (:use :glisp :runes :cl)
 
   (:import-from #:clim
    #:+nowhere+
@@ -208,9 +208,9 @@
      #:start
      #:stop))
 
-'(defpackage "WS/POSTSCRIPT"
-  (:nicknames "WS/PS")
-  (:use "GLISP")
+'(defpackage :ws/postscript
+  (:nicknames :ws/ps)
+  (:use :glisp :cl)
   (:export )
   (:import-from "R2"
                 "DEVICE-FONT-ASCENT"
@@ -234,4 +234,4 @@
                 "DEVICE-FONT-UNDERLINE-THICKNESS"
                 ))
 
-(defpackage :clue-gui2 (:use #||:glue :clue||# :glisp :runes))
+(defpackage :clue-gui2 (:use #||:glue :clue||# :glisp :runes :cl))



From emarsden at common-lisp.net  Sat Dec 30 15:13:55 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:13:55 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061230151355.050F62104A@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv12910/src/gui

Modified Files:
	clim-gui.lisp 
Log Message:
- use CL from Closure packages
- minor rod fixes
- move PARSE-X11-COLOR from clim-user to ws/x11 package


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/30 15:07:31	1.24
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/30 15:13:54	1.25
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.24 2006/12/30 15:07:31 emarsden Exp $
+;;;       $Id: clim-gui.lisp,v 1.25 2006/12/30 15:13:54 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,11 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.25  2006/12/30 15:13:54  emarsden
+;; - use CL from Closure packages
+;; - minor rod fixes
+;; - move PARSE-X11-COLOR from clim-user to ws/x11 package
+;;
 ;; Revision 1.24  2006/12/30 15:07:31  emarsden
 ;; Minor improvements to user interface:
 ;;   - enable double buffering
@@ -611,39 +616,6 @@
 (defvar *current-document*)
 (defvar *current-pt*)
 
-(defun parse-x11-color (string &aux sym r gb)
-  ;; ### pff this really needs to be more robust.
-  (cond ((and (= (length string) 4) (char= (char string 0) #\#))
-         (make-rgb-color
-          (/ (parse-integer string :start 1 :end 2 :radix 16) #xF)
-          (/ (parse-integer string :start 2 :end 3 :radix 16) #xF)
-          (/ (parse-integer string :start 3 :end 4 :radix 16) #xF)))
-        ((and (= (length string) 7) (char= (char string 0) #\#))
-         (make-rgb-color
-          (/ (parse-integer string :start 1 :end 3 :radix 16) #xFF)
-          (/ (parse-integer string :start 3 :end 5 :radix 16) #xFF)
-          (/ (parse-integer string :start 5 :end 7 :radix 16) #xFF)))
-        ((and (= (length string) 6) (every #'(lambda (x) (digit-char-p x 16)) string))
-         (let ((r (parse-integer (subseq string 0 2) :radix 16))
-               (g (parse-integer (subseq string 2 4) :radix 16))
-               (b (parse-integer (subseq string 4 6) :radix 16)))
-           (warn "Color malformed: ~S" string)
-           (and r g b 
-                (make-rgb-color (/ r 255) (/ g 255) (/ b 255)))))
-        ((and (= (length string) 13) (char= (char string 0) #\#))
-         (make-rgb-color
-          (/ (parse-integer string :start 1 :end 5 :radix 16) #xFFFF)
-          (/ (parse-integer string :start 5 :end 9 :radix 16) #xFFFF)
-          (/ (parse-integer string :start 9 :end 13 :radix 16) #xFFFF)))
-        ((and (setf sym (find-symbol (concatenate 'string "+" (string-upcase string) "+")
-                                     (find-package :clim)))
-              (boundp sym)
-              (clim:colorp (symbol-value sym)))
-         (symbol-value sym))
-        (t
-         (warn "~S: foo color: ~S." 'parse-x11-color string)
-         +red+)))
-
 ;;;; ----------------------------------------------------------------------------------------------------
 
 (define-presentation-translator url-from-string



From emarsden at common-lisp.net  Sat Dec 30 15:13:56 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sat, 30 Dec 2006 10:13:56 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/renderer
Message-ID: <20061230151356.2EEDB232B9@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/renderer
In directory clnet:/tmp/cvs-serv12910/src/renderer

Modified Files:
	clim-draw.lisp renderer2.lisp x11.lisp 
Log Message:
- use CL from Closure packages
- minor rod fixes
- move PARSE-X11-COLOR from clim-user to ws/x11 package


--- /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2006/12/29 21:29:34	1.5
+++ /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2006/12/30 15:13:55	1.6
@@ -4,7 +4,7 @@
 ;;;   Created: 2003-03-08
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-draw.lisp,v 1.5 2006/12/29 21:29:34 dlichteblau Exp $
+;;;       $Id: clim-draw.lisp,v 1.6 2006/12/30 15:13:55 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -34,7 +34,7 @@
 (defun css-color-ink (color)
   ;; xxx, we still sometimes wind up with bogus values here
   (if (stringp color)
-      (clim-user::parse-x11-color color)
+      (ws/x11::parse-x11-color color)
       clim:+black+))
 
 (defun 3d-light-color (base-color)
@@ -172,14 +172,14 @@
       (case deco
         (:underline
          (clim:draw-line* clim-user::*pane*
-          xx1 (+ yy 2) xx (+ yy 2) :ink (clim-user::parse-x11-color color)))
+          xx1 (+ yy 2) xx (+ yy 2) :ink (ws/x11::parse-x11-color color)))
         (:overline
          ;; xxx hack
          (clim:draw-line* clim-user::*pane*
-          xx1 (- yy 12) xx (- yy 12) :ink (clim-user::parse-x11-color color)))
+          xx1 (- yy 12) xx (- yy 12) :ink (ws/x11::parse-x11-color color)))
         (:line-through
          (clim:draw-line* clim-user::*pane*
-          xx1 (- yy 6) xx (- yy 6) :ink (clim-user::parse-x11-color color))) ))))
+          xx1 (- yy 6) xx (- yy 6) :ink (ws/x11::parse-x11-color color))) ))))
 
 ;;;; Runes
 
--- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2006/12/29 21:29:39	1.16
+++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2006/12/30 15:13:55	1.17
@@ -4,7 +4,7 @@
 ;;;   Created: somewhen late 2002
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: renderer2.lisp,v 1.16 2006/12/29 21:29:39 dlichteblau Exp $
+;;;       $Id: renderer2.lisp,v 1.17 2006/12/30 15:13:55 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -158,7 +158,9 @@
   (cond ((member name '(black-chunk))
          `(progn
            (defstruct (,name (:constructor
-                              ,(intern (format nil "CONS-~A" name))
+                              ,(intern
+                                (with-standard-io-syntax
+                                  (format nil "CONS-~A" name)))
                               (&key ,@(mapcar (lambda (slot)
                                                 (let ((slot (if (consp slot) (car slot) slot)))
                                                   slot))
@@ -182,27 +184,39 @@
                                         (list :initarg (intern (symbol-name slot) :keyword))
                                         ;; emarsden2003-03-12
                                         (unless (member :initform opts) (list :initform nil))
-                                        (list :accessor (intern (format nil "~A-~A" name slot)))))))
+                                        (list :accessor (intern
+                                                         (with-standard-io-syntax
+                                                           (format nil "~A-~A" name slot))))))))
                       slots))
            ;;
-           (defun ,(intern (format nil "CONS-~A" name))
+           (defun ,(intern
+                    (with-standard-io-syntax
+                      (format nil "CONS-~A" name)))
                (&rest args)
              (apply #'make-instance ',name args))
            ;;
-           (defun ,(intern (format nil "~A-P" name))
+           (defun , (intern
+                     (with-standard-io-syntax
+                       (format nil "~A-P" name)))
                (object)
              (typep object ',name))
            ;;
-           (defun ,(intern (format nil "~A-MODIF" name))
+           (defun ,(intern
+                    (with-standard-io-syntax
+                      (format nil "~A-MODIF" name)))
                (.object. &key ,@(mapcar (lambda (slot)
                                           (let ((slot (if (consp slot) (car slot) slot)))
-                                            (list slot nil (intern (format nil ".P.~A" slot)))))
+                                            (list slot nil (intern
+                                                            (with-standard-io-syntax
+                                                              (format nil ".P.~A" slot))))))
                                         slots))
              (make-instance ',name
                             ,@(mapcan (lambda (slot)
                                         (let ((slot (if (consp slot) (car slot) slot)))
                                           (list (intern (symbol-name slot) :keyword)
-                                                `(if ,(intern (format nil ".P.~A" slot))
+                                                `(if ,(intern
+                                                       (with-standard-io-syntax
+                                                         (format nil ".P.~A" slot)))
                                                   ,slot
                                                   (slot-value .object. ',slot)))))
                                       slots))))) ))
@@ -2212,7 +2226,7 @@
                                             (y1 (+ yy (loop for k below i sum (elt row-heights k)))))
                                        (clim:draw-line* clim-user::*pane*
                                                         x1 y1 x2 y1
-                                                        :ink (clim-user::parse-x11-color color)
+                                                        :ink (ws/x11::parse-x11-color color)
                                                         :line-thickness width)))))))
                    ;; vertical borders
                    (loop for i from 0 below (array-dimension vborders 0) do
@@ -2226,7 +2240,7 @@
                                           (x1 (+ x1 (loop for k below j sum (elt column-widths k)))))
                                      (clim:draw-line* clim-user::*pane*
                                                       x1 y1 x1 y2
-                                                      :ink (clim-user::parse-x11-color color)
+                                                      :ink (ws/x11::parse-x11-color color)
                                                       :line-thickness width)))))) )
                  ;; Kludge, in our book a table also has a baseline. We set it up manually, since
                  ;; we moved the rendered output of table cells.
@@ -3239,9 +3253,9 @@
     (:none
      rod)
     (:uppercase
-     (glisp::register-rod (map 'rod #'rune-upcase rod)))
+     (map 'rod #'rune-upcase rod))
     (:lowercase
-     (glisp::register-rod (map 'rod #'rune-downcase rod)))
+     (map 'rod #'rune-downcase rod))
     (:capitalize
      ;; more complicated
      (let ((res (make-rod (length rod))))
@@ -3249,8 +3263,8 @@
              for d across rod
              for i from 0 do
              (setf (rune res i)
-                   (cond ((glisp::rune-upper-case-letter-p c) d)
-                         ((glisp::rune-lower-case-letter-p c) (rune-downcase d))
+                   (cond ((runes::rune-upper-case-letter-p c) d)
+                         ((runes::rune-lower-case-letter-p c) (rune-downcase d))
                          (t                                   (rune-upcase d)))))
        res))))
 
@@ -4969,7 +4983,13 @@
 
 
 ;; $Log: renderer2.lisp,v $
+;; Revision 1.17  2006/12/30 15:13:55  emarsden
+;; - use CL from Closure packages
+;; - minor rod fixes
+;; - move PARSE-X11-COLOR from clim-user to ws/x11 package
+;;
 ;; Revision 1.16  2006/12/29 21:29:39  dlichteblau
+;;
 ;; Use CXML's rune implementation and XML parser.
 ;;
 ;; Revision 1.15  2006/11/06 19:43:01  thenriksen
--- /project/closure/cvsroot/closure/src/renderer/x11.lisp	2005/07/17 09:41:35	1.9
+++ /project/closure/cvsroot/closure/src/renderer/x11.lisp	2006/12/30 15:13:55	1.10
@@ -1354,4 +1354,38 @@
 ;; environment.
 
 
+(defun parse-x11-color (string &aux sym r gb)
+  ;; ### pff this really needs to be more robust.
+  (cond ((and (= (length string) 4) (char= (char string 0) #\#))
+         (clim:make-rgb-color
+          (/ (parse-integer string :start 1 :end 2 :radix 16) #xF)
+          (/ (parse-integer string :start 2 :end 3 :radix 16) #xF)
+          (/ (parse-integer string :start 3 :end 4 :radix 16) #xF)))
+        ((and (= (length string) 7) (char= (char string 0) #\#))
+         (clim:make-rgb-color
+          (/ (parse-integer string :start 1 :end 3 :radix 16) #xFF)
+          (/ (parse-integer string :start 3 :end 5 :radix 16) #xFF)
+          (/ (parse-integer string :start 5 :end 7 :radix 16) #xFF)))
+        ((and (= (length string) 6) (every #'(lambda (x) (digit-char-p x 16)) string))
+         (let ((r (parse-integer (subseq string 0 2) :radix 16))
+               (g (parse-integer (subseq string 2 4) :radix 16))
+               (b (parse-integer (subseq string 4 6) :radix 16)))
+           (warn "Malformed color specifier: ~S" string)
+           (and r g b 
+                (clim:make-rgb-color (/ r 255) (/ g 255) (/ b 255)))))
+        ((and (= (length string) 13) (char= (char string 0) #\#))
+         (clim:make-rgb-color
+          (/ (parse-integer string :start 1 :end 5 :radix 16) #xFFFF)
+          (/ (parse-integer string :start 5 :end 9 :radix 16) #xFFFF)
+          (/ (parse-integer string :start 9 :end 13 :radix 16) #xFFFF)))
+        ((and (setf sym (find-symbol (concatenate 'string "+" (string-upcase string) "+")
+                                     (find-package :clim)))
+              (boundp sym)
+              (clim:colorp (symbol-value sym)))
+         (symbol-value sym))
+        (t
+         (warn "Malformed color specifier: ~S" string)
+         clim:+red+)))
+
+
 ; LocalWords:  colormap RGB



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:18 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/css
Message-ID: <20061231114818.6EDD94D005@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/css
In directory clnet:/tmp/cvs-serv26809/src/css

Modified Files:
	package.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/css/package.lisp	2006/12/29 21:29:24	1.4
+++ /project/closure/cvsroot/closure/src/css/package.lisp	2006/12/31 11:48:18	1.5
@@ -28,7 +28,7 @@
 
 (in-package :CL-USER)
 (defpackage :css
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   ;;
   (:import-from "CLOSURE-PROTOCOL"
    ;; basic element protocol



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:18 -0500 (EST)
Subject: [closure-cvs] CVS closure/src
Message-ID: <20061231114818.454714D046@common-lisp.net>

Update of /project/closure/cvsroot/closure/src
In directory clnet:/tmp/cvs-serv26809/src

Modified Files:
	defpack.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/defpack.lisp	2006/12/30 15:13:54	1.7
+++ /project/closure/cvsroot/closure/src/defpack.lisp	2006/12/31 11:48:18	1.8
@@ -197,7 +197,7 @@
    ))
 
 
-(defpackage :gtk-gui (:use :glisp :runes))
+(defpackage :gtk-gui (:use :cl :glisp :runes))
 
 (defpackage :closure
     (:use)



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:18 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231114818.B3F2F4D004@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv26809/src/glisp

Modified Files:
	gendep.lisp package.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/glisp/gendep.lisp	2005/08/25 15:14:12	1.3
+++ /project/closure/cvsroot/closure/src/glisp/gendep.lisp	2006/12/31 11:48:18	1.4
@@ -440,7 +440,7 @@
       (format sink "~%    #:~(~A~)" k))
     (format sink "))")
     (format sink "~%")
-    (format sink "~%(defpackage :gluser (:use :glisp))")
+    (format sink "~%(defpackage :gluser (:use :cl :glisp))")
     (format sink "~%") )
   (terpri sink))
 
--- /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/29 21:29:25	1.5
+++ /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/31 11:48:18	1.6
@@ -32,179 +32,6 @@
 (defpackage :glisp (:use))
 
 (eval-when (compile)
-  (defparameter *all-ansi-symbols*
-    '("&ALLOW-OTHER-KEYS" "&AUX" "&BODY" "&ENVIRONMENT" "&KEY" "&OPTIONAL" "&REST" "&WHOLE" "*"
-      "**" "***" "*BREAK-ON-SIGNALS*" "*COMPILE-FILE-PATHNAME*" "*COMPILE-FILE-TRUENAME*"
-      "*COMPILE-PRINT*" "*COMPILE-VERBOSE*" "*DEBUG-IO*" "*DEBUGGER-HOOK*"
-      "*DEFAULT-PATHNAME-DEFAULTS*" "*ERROR-OUTPUT*" "*FEATURES*" "*GENSYM-COUNTER*"
-      "*LOAD-PATHNAME*" "*LOAD-PRINT*" "*LOAD-TRUENAME*" "*LOAD-VERBOSE*" "*MACROEXPAND-HOOK*"
-      "*MODULES*" "*PACKAGE*" "*PRINT-ARRAY*" "*PRINT-BASE*" "*PRINT-CASE*" "*PRINT-CIRCLE*"
-      "*PRINT-ESCAPE*" "*PRINT-GENSYM*" "*PRINT-LENGTH*" "*PRINT-LEVEL*" "*PRINT-LINES*"
-      "*PRINT-MISER-WIDTH*" "*PRINT-PPRINT-DISPATCH*" "*PRINT-PRETTY*" "*PRINT-RADIX*"
-      "*PRINT-READABLY*" "*PRINT-RIGHT-MARGIN*" "*QUERY-IO*" "*RANDOM-STATE*" "*READ-BASE*"
-      "*READ-DEFAULT-FLOAT-FORMAT*" "*READ-EVAL*" "*READ-SUPPRESS*" "*READTABLE*"
-      "*STANDARD-INPUT*" "*STANDARD-OUTPUT*" "*TERMINAL-IO*" "*TRACE-OUTPUT*" "+" "++" "+++" "-"
-      "/" "//" "///" "/=" "1+" "1-" "<" "<=" "=" ">" ">=" "ABORT" "ABS" "ACONS" "ACOS" "ACOSH"
-      "ADD-METHOD" "ADJOIN" "ADJUST-ARRAY" "ADJUSTABLE-ARRAY-P" "ALLOCATE-INSTANCE"
-      "ALPHA-CHAR-P" "ALPHANUMERICP" "AND" "APPEND" "APPLY" "APROPOS" "APROPOS-LIST" "AREF"
-      "ARITHMETIC-ERROR" "ARITHMETIC-ERROR-OPERANDS" "ARITHMETIC-ERROR-OPERATION" "ARRAY"
-      "ARRAY-DIMENSION" "ARRAY-DIMENSION-LIMIT" "ARRAY-DIMENSIONS" "ARRAY-DISPLACEMENT"
-      "ARRAY-ELEMENT-TYPE" "ARRAY-HAS-FILL-POINTER-P" "ARRAY-IN-BOUNDS-P" "ARRAY-RANK"
-      "ARRAY-RANK-LIMIT" "ARRAY-ROW-MAJOR-INDEX" "ARRAY-TOTAL-SIZE" "ARRAY-TOTAL-SIZE-LIMIT"
-      "ARRAYP" "ASH" "ASIN" "ASINH" "ASSERT" "ASSOC" "ASSOC-IF" "ASSOC-IF-NOT" "ATAN" "ATANH"
-      "ATOM" "BASE-CHAR" "BASE-STRING" "BIGNUM" "BIT" "BIT-AND" "BIT-ANDC1" "BIT-ANDC2"
-      "BIT-EQV" "BIT-IOR" "BIT-NAND" "BIT-NOR" "BIT-NOT" "BIT-ORC1" "BIT-ORC2" "BIT-VECTOR"
-      "BIT-VECTOR-P" "BIT-XOR" "BLOCK" "BOOLE" "BOOLE-1" "BOOLE-2" "BOOLE-AND" "BOOLE-ANDC1"
-      "BOOLE-ANDC2" "BOOLE-C1" "BOOLE-C2" "BOOLE-CLR" "BOOLE-EQV" "BOOLE-IOR" "BOOLE-NAND"
-      "BOOLE-NOR" "BOOLE-ORC1" "BOOLE-ORC2" "BOOLE-SET" "BOOLE-XOR" "BOOLEAN" "BOTH-CASE-P"
-      "BOUNDP" "BREAK" "BROADCAST-STREAM" "BROADCAST-STREAM-STREAMS" "BUILT-IN-CLASS" "BUTLAST"
-      "BYTE" "BYTE-POSITION" "BYTE-SIZE" "CAAAAR" "CAAADR" "CAAAR" "CAADAR" "CAADDR" "CAADR"
-      "CAAR" "CADAAR" "CADADR" "CADAR" "CADDAR" "CADDDR" "CADDR" "CADR" "CALL-ARGUMENTS-LIMIT"
-      "CALL-METHOD" "CALL-NEXT-METHOD" "CAR" "CASE" "CATCH" "CCASE" "CDAAAR" "CDAADR" "CDAAR"
-      "CDADAR" "CDADDR" "CDADR" "CDAR" "CDDAAR" "CDDADR" "CDDAR" "CDDDAR" "CDDDDR" "CDDDR"
-      "CDDR" "CDR" "CEILING" "CELL-ERROR" "CELL-ERROR-NAME" "CERROR" "CHANGE-CLASS" "CHAR"
-      "CHAR-CODE" "CHAR-CODE-LIMIT" "CHAR-DOWNCASE" "CHAR-EQUAL" "CHAR-GREATERP" "CHAR-INT"
-      "CHAR-LESSP" "CHAR-NAME" "CHAR-NOT-EQUAL" "CHAR-NOT-GREATERP" "CHAR-NOT-LESSP"
-      "CHAR-UPCASE" "CHAR/=" "CHAR<" "CHAR<=" "CHAR=" "CHAR>" "CHAR>=" "CHARACTER" "CHARACTERP"
-      "CHECK-TYPE" "CIS" "CLASS" "CLASS-NAME" "CLASS-OF" "CLEAR-INPUT" "CLEAR-OUTPUT" "CLOSE"
-      "CLRHASH" "CODE-CHAR" "COERCE" "COMPILATION-SPEED" "COMPILE" "COMPILE-FILE"
-      "COMPILE-FILE-PATHNAME" "COMPILED-FUNCTION" "COMPILED-FUNCTION-P" "COMPILER-MACRO"
-      "COMPILER-MACRO-FUNCTION" "COMPLEMENT" "COMPLEX" "COMPLEXP" "COMPUTE-APPLICABLE-METHODS"
-      "COMPUTE-RESTARTS" "CONCATENATE" "CONCATENATED-STREAM" "CONCATENATED-STREAM-STREAMS"
-      "COND" "CONDITION" "CONJUGATE" "CONS" "CONSP" "CONSTANTLY" "CONSTANTP" "CONTINUE"
-      "CONTROL-ERROR" "COPY-ALIST" "COPY-LIST" "COPY-PPRINT-DISPATCH" "COPY-READTABLE"
-      "COPY-SEQ" "COPY-STRUCTURE" "COPY-SYMBOL" "COPY-TREE" "COS" "COSH" "COUNT" "COUNT-IF"
-      "COUNT-IF-NOT" "CTYPECASE" "DEBUG" "DECF" "DECLAIM" "DECLARATION" "DECLARE" "DECODE-FLOAT"
-      "DECODE-UNIVERSAL-TIME" "DEFCLASS" "DEFCONSTANT" "DEFGENERIC" "DEFINE-COMPILER-MACRO"
-      "DEFINE-CONDITION" "DEFINE-METHOD-COMBINATION" "DEFINE-MODIFY-MACRO"
-      "DEFINE-SETF-EXPANDER" "DEFINE-SYMBOL-MACRO" "DEFMACRO" "DEFMETHOD" "DEFPACKAGE"
-      "DEFPARAMETER" "DEFSETF" "DEFSTRUCT" "DEFTYPE" "DEFUN" "DEFVAR" "DELETE"
-      "DELETE-DUPLICATES" "DELETE-FILE" "DELETE-IF" "DELETE-IF-NOT" "DELETE-PACKAGE"
-      "DENOMINATOR" "DEPOSIT-FIELD" "DESCRIBE" "DESCRIBE-OBJECT" "DESTRUCTURING-BIND"
-      "DIGIT-CHAR" "DIGIT-CHAR-P" "DIRECTORY" "DIRECTORY-NAMESTRING" "DISASSEMBLE"
-      "DIVISION-BY-ZERO" "DO" "DO*" "DO-ALL-SYMBOLS" "DO-EXTERNAL-SYMBOLS" "DO-SYMBOLS"
-      "DOCUMENTATION" "DOLIST" "DOTIMES" "DOUBLE-FLOAT" "DOUBLE-FLOAT-EPSILON"
-      "DOUBLE-FLOAT-NEGATIVE-EPSILON" "DPB" "DRIBBLE" "DYNAMIC-EXTENT" "ECASE" "ECHO-STREAM"
-      "ECHO-STREAM-INPUT-STREAM" "ECHO-STREAM-OUTPUT-STREAM" "ED" "EIGHTH" "ELT"
-      "ENCODE-UNIVERSAL-TIME" "END-OF-FILE" "ENDP" "ENOUGH-NAMESTRING"
-      "ENSURE-DIRECTORIES-EXIST" "ENSURE-GENERIC-FUNCTION" "EQ" "EQL" "EQUAL" "EQUALP" "ERROR"
-      "ETYPECASE" "EVAL" "EVAL-WHEN" "EVENP" "EVERY" "EXP" "EXPORT" "EXPT" "EXTENDED-CHAR"
-      "FBOUNDP" "FCEILING" "FDEFINITION" "FFLOOR" "FIFTH" "FILE-AUTHOR" "FILE-ERROR"
-      "FILE-ERROR-PATHNAME" "FILE-LENGTH" "FILE-NAMESTRING" "FILE-POSITION" "FILE-STREAM"
-      "FILE-STRING-LENGTH" "FILE-WRITE-DATE" "FILL" "FILL-POINTER" "FIND" "FIND-ALL-SYMBOLS"
-      "FIND-CLASS" "FIND-IF" "FIND-IF-NOT" "FIND-METHOD" "FIND-PACKAGE" "FIND-RESTART"
-      "FIND-SYMBOL" "FINISH-OUTPUT" "FIRST" "FIXNUM" "FLET" "FLOAT" "FLOAT-DIGITS"
-      "FLOAT-PRECISION" "FLOAT-RADIX" "FLOAT-SIGN" "FLOATING-POINT-INEXACT"
-      "FLOATING-POINT-INVALID-OPERATION" "FLOATING-POINT-OVERFLOW" "FLOATING-POINT-UNDERFLOW"
-      "FLOATP" "FLOOR" "FMAKUNBOUND" "FORCE-OUTPUT" "FORMAT" "FORMATTER" "FOURTH" "FRESH-LINE"
-      "FROUND" "FTRUNCATE" "FTYPE" "FUNCALL" "FUNCTION" "FUNCTION-KEYWORDS"
-      "FUNCTION-LAMBDA-EXPRESSION" "FUNCTIONP" "GCD" "GENERIC-FUNCTION" "GENSYM" "GENTEMP" "GET"
-      "GET-DECODED-TIME" "GET-DISPATCH-MACRO-CHARACTER" "GET-INTERNAL-REAL-TIME"
-      "GET-INTERNAL-RUN-TIME" "GET-MACRO-CHARACTER" "GET-OUTPUT-STREAM-STRING" "GET-PROPERTIES"
-      "GET-SETF-EXPANSION" "GET-UNIVERSAL-TIME" "GETF" "GETHASH" "GO" "GRAPHIC-CHAR-P"
-      "HANDLER-BIND" "HANDLER-CASE" "HASH-TABLE" "HASH-TABLE-COUNT" "HASH-TABLE-P"
-      "HASH-TABLE-REHASH-SIZE" "HASH-TABLE-REHASH-THRESHOLD" "HASH-TABLE-SIZE" "HASH-TABLE-TEST"
-      "HOST-NAMESTRING" "IDENTITY" "IF" "IGNORABLE" "IGNORE" "IGNORE-ERRORS" "IMAGPART" "IMPORT"
-      "IN-PACKAGE" "INCF" "INITIALIZE-INSTANCE" "INLINE" "INPUT-STREAM-P" "INSPECT" "INTEGER"
-      "INTEGER-DECODE-FLOAT" "INTEGER-LENGTH" "INTEGERP" "INTERACTIVE-STREAM-P" "INTERN"
-      "INTERNAL-TIME-UNITS-PER-SECOND" "INTERSECTION" "INVALID-METHOD-ERROR" "INVOKE-DEBUGGER"
-      "INVOKE-RESTART" "INVOKE-RESTART-INTERACTIVELY" "ISQRT" "KEYWORD" "KEYWORDP" "LABELS"
-      "LAMBDA" "LAMBDA-LIST-KEYWORDS" "LAMBDA-PARAMETERS-LIMIT" "LAST" "LCM" "LDB" "LDB-TEST"
-      "LDIFF" "LEAST-NEGATIVE-DOUBLE-FLOAT" "LEAST-NEGATIVE-LONG-FLOAT"
-      "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT" "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT"
-      "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT" "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT"
-      "LEAST-NEGATIVE-SHORT-FLOAT" "LEAST-NEGATIVE-SINGLE-FLOAT" "LEAST-POSITIVE-DOUBLE-FLOAT"
-      "LEAST-POSITIVE-LONG-FLOAT" "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT"
-      "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT"
-      "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" "LEAST-POSITIVE-SHORT-FLOAT"
-      "LEAST-POSITIVE-SINGLE-FLOAT" "LENGTH" "LET" "LET*" "LISP-IMPLEMENTATION-TYPE"
-      "LISP-IMPLEMENTATION-VERSION" "LIST" "LIST*" "LIST-ALL-PACKAGES" "LIST-LENGTH" "LISTEN"
-      "LISTP" "LOAD" "LOAD-LOGICAL-PATHNAME-TRANSLATIONS" "LOAD-TIME-VALUE" "LOCALLY" "LOG"
-      "LOGAND" "LOGANDC1" "LOGANDC2" "LOGBITP" "LOGCOUNT" "LOGEQV" "LOGICAL-PATHNAME"
-      "LOGICAL-PATHNAME-TRANSLATIONS" "LOGIOR" "LOGNAND" "LOGNOR" "LOGNOT" "LOGORC1" "LOGORC2"
-      "LOGTEST" "LOGXOR" "LONG-FLOAT" "LONG-FLOAT-EPSILON" "LONG-FLOAT-NEGATIVE-EPSILON"
-      "LONG-SITE-NAME" "LOOP" "LOOP-FINISH" "LOWER-CASE-P" "MACHINE-INSTANCE" "MACHINE-TYPE"
-      "MACHINE-VERSION" "MACRO-FUNCTION" "MACROEXPAND" "MACROEXPAND-1" "MACROLET" "MAKE-ARRAY"
-      "MAKE-BROADCAST-STREAM" "MAKE-CONCATENATED-STREAM" "MAKE-CONDITION"
-      "MAKE-DISPATCH-MACRO-CHARACTER" "MAKE-ECHO-STREAM" "MAKE-HASH-TABLE" "MAKE-INSTANCE"
-      "MAKE-INSTANCES-OBSOLETE" "MAKE-LIST" "MAKE-LOAD-FORM" "MAKE-LOAD-FORM-SAVING-SLOTS"
-      "MAKE-METHOD" "MAKE-PACKAGE" "MAKE-PATHNAME" "MAKE-RANDOM-STATE" "MAKE-SEQUENCE"
-      "MAKE-STRING" "MAKE-STRING-INPUT-STREAM" "MAKE-STRING-OUTPUT-STREAM" "MAKE-SYMBOL"
-      "MAKE-SYNONYM-STREAM" "MAKE-TWO-WAY-STREAM" "MAKUNBOUND" "MAP" "MAP-INTO" "MAPC" "MAPCAN"
-      "MAPCAR" "MAPCON" "MAPHASH" "MAPL" "MAPLIST" "MASK-FIELD" "MAX" "MEMBER" "MEMBER-IF"
-      "MEMBER-IF-NOT" "MERGE" "MERGE-PATHNAMES" "METHOD" "METHOD-COMBINATION"
-      "METHOD-COMBINATION-ERROR" "METHOD-QUALIFIERS" "MIN" "MINUSP" "MISMATCH" "MOD"
-      "MOST-NEGATIVE-DOUBLE-FLOAT" "MOST-NEGATIVE-FIXNUM" "MOST-NEGATIVE-LONG-FLOAT"
-      "MOST-NEGATIVE-SHORT-FLOAT" "MOST-NEGATIVE-SINGLE-FLOAT" "MOST-POSITIVE-DOUBLE-FLOAT"
-      "MOST-POSITIVE-FIXNUM" "MOST-POSITIVE-LONG-FLOAT" "MOST-POSITIVE-SHORT-FLOAT"
-      "MOST-POSITIVE-SINGLE-FLOAT" "MUFFLE-WARNING" "MULTIPLE-VALUE-BIND" "MULTIPLE-VALUE-CALL"
-      "MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-PROG1" "MULTIPLE-VALUE-SETQ" "MULTIPLE-VALUES-LIMIT"
-      "NAME-CHAR" "NAMESTRING" "NBUTLAST" "NCONC" "NEXT-METHOD-P" "NIL" "NINTERSECTION" "NINTH"
-      "NO-APPLICABLE-METHOD" "NO-NEXT-METHOD" "NOT" "NOTANY" "NOTEVERY" "NOTINLINE" "NRECONC"
-      "NREVERSE" "NSET-DIFFERENCE" "NSET-EXCLUSIVE-OR" "NSTRING-CAPITALIZE" "NSTRING-DOWNCASE"
-      "NSTRING-UPCASE" "NSUBLIS" "NSUBST" "NSUBST-IF" "NSUBST-IF-NOT" "NSUBSTITUTE"
-      "NSUBSTITUTE-IF" "NSUBSTITUTE-IF-NOT" "NTH" "NTH-VALUE" "NTHCDR" "NULL" "NUMBER" "NUMBERP"
-      "NUMERATOR" "NUNION" "ODDP" "OPEN" "OPEN-STREAM-P" "OPTIMIZE" "OR" "OTHERWISE"
-      "OUTPUT-STREAM-P" "PACKAGE" "PACKAGE-ERROR" "PACKAGE-ERROR-PACKAGE" "PACKAGE-NAME"
-      "PACKAGE-NICKNAMES" "PACKAGE-SHADOWING-SYMBOLS" "PACKAGE-USE-LIST" "PACKAGE-USED-BY-LIST"
-      "PACKAGEP" "PAIRLIS" "PARSE-ERROR" "PARSE-INTEGER" "PARSE-NAMESTRING" "PATHNAME"
-      "PATHNAME-DEVICE" "PATHNAME-DIRECTORY" "PATHNAME-HOST" "PATHNAME-MATCH-P" "PATHNAME-NAME"
-      "PATHNAME-TYPE" "PATHNAME-VERSION" "PATHNAMEP" "PEEK-CHAR" "PHASE" "PI" "PLUSP" "POP"
-      "POSITION" "POSITION-IF" "POSITION-IF-NOT" "PPRINT" "PPRINT-DISPATCH"
-      "PPRINT-EXIT-IF-LIST-EXHAUSTED" "PPRINT-FILL" "PPRINT-INDENT" "PPRINT-LINEAR"
-      "PPRINT-LOGICAL-BLOCK" "PPRINT-NEWLINE" "PPRINT-POP" "PPRINT-TAB" "PPRINT-TABULAR" "PRIN1"
-      "PRIN1-TO-STRING" "PRINC" "PRINC-TO-STRING" "PRINT" "PRINT-NOT-READABLE"
-      "PRINT-NOT-READABLE-OBJECT" "PRINT-OBJECT" "PRINT-UNREADABLE-OBJECT" "PROBE-FILE"
-      "PROCLAIM" "PROG" "PROG*" "PROG1" "PROG2" "PROGN" "PROGRAM-ERROR" "PROGV" "PROVIDE"
-      "PSETF" "PSETQ" "PUSH" "PUSHNEW" "QUOTE" "RANDOM" "RANDOM-STATE" "RANDOM-STATE-P" "RASSOC"
-      "RASSOC-IF" "RASSOC-IF-NOT" "RATIO" "RATIONAL" "RATIONALIZE" "RATIONALP" "READ"
-      "READ-BYTE" "READ-CHAR" "READ-CHAR-NO-HANG" "READ-DELIMITED-LIST" "READ-FROM-STRING"
-      "READ-LINE" "READ-PRESERVING-WHITESPACE" "READ-SEQUENCE" "READER-ERROR" "READTABLE"
-      "READTABLE-CASE" "READTABLEP" "REAL" "REALP" "REALPART" "REDUCE" "REINITIALIZE-INSTANCE"
-      "REM" "REMF" "REMHASH" "REMOVE" "REMOVE-DUPLICATES" "REMOVE-IF" "REMOVE-IF-NOT"
-      "REMOVE-METHOD" "REMPROP" "RENAME-FILE" "RENAME-PACKAGE" "REPLACE" "REQUIRE" "REST"
-      "RESTART" "RESTART-BIND" "RESTART-CASE" "RESTART-NAME" "RETURN" "RETURN-FROM" "REVAPPEND"
-      "REVERSE" "ROOM" "ROTATEF" "ROUND" "ROW-MAJOR-AREF" "RPLACA" "RPLACD" "SAFETY" "SATISFIES"
-      "SBIT" "SCALE-FLOAT" "SCHAR" "SEARCH" "SECOND" "SEQUENCE" "SERIOUS-CONDITION" "SET"
-      "SET-DIFFERENCE" "SET-DISPATCH-MACRO-CHARACTER" "SET-EXCLUSIVE-OR" "SET-MACRO-CHARACTER"
-      "SET-PPRINT-DISPATCH" "SET-SYNTAX-FROM-CHAR" "SETF" "SETQ" "SEVENTH" "SHADOW"
-      "SHADOWING-IMPORT" "SHARED-INITIALIZE" "SHIFTF" "SHORT-FLOAT" "SHORT-FLOAT-EPSILON"
-      "SHORT-FLOAT-NEGATIVE-EPSILON" "SHORT-SITE-NAME" "SIGNAL" "SIGNED-BYTE" "SIGNUM"
-      "SIMPLE-ARRAY" "SIMPLE-BASE-STRING" "SIMPLE-BIT-VECTOR" "SIMPLE-BIT-VECTOR-P"
-      "SIMPLE-CONDITION" "SIMPLE-CONDITION-FORMAT-ARGUMENTS" "SIMPLE-CONDITION-FORMAT-CONTROL"
-      "SIMPLE-ERROR" "SIMPLE-STRING" "SIMPLE-STRING-P" "SIMPLE-TYPE-ERROR" "SIMPLE-VECTOR"
-      "SIMPLE-VECTOR-P" "SIMPLE-WARNING" "SIN" "SINGLE-FLOAT" "SINGLE-FLOAT-EPSILON"
-      "SINGLE-FLOAT-NEGATIVE-EPSILON" "SINH" "SIXTH" "SLEEP" "SLOT-BOUNDP" "SLOT-EXISTS-P"
-      "SLOT-MAKUNBOUND" "SLOT-MISSING" "SLOT-UNBOUND" "SLOT-VALUE" "SOFTWARE-TYPE"
-      "SOFTWARE-VERSION" "SOME" "SORT" "SPACE" "SPECIAL" "SPECIAL-OPERATOR-P" "SPEED" "SQRT"
-      "STABLE-SORT" "STANDARD" "STANDARD-CHAR" "STANDARD-CHAR-P" "STANDARD-CLASS"
-      "STANDARD-GENERIC-FUNCTION" "STANDARD-METHOD" "STANDARD-OBJECT" "STEP" "STORAGE-CONDITION"
-      "STORE-VALUE" "STREAM" "STREAM-ELEMENT-TYPE" "STREAM-ERROR" "STREAM-ERROR-STREAM"
-      "STREAM-EXTERNAL-FORMAT" "STREAMP" "STRING" "STRING-CAPITALIZE" "STRING-DOWNCASE"
-      "STRING-EQUAL" "STRING-GREATERP" "STRING-LEFT-TRIM" "STRING-LESSP" "STRING-NOT-EQUAL"
-      "STRING-NOT-GREATERP" "STRING-NOT-LESSP" "STRING-RIGHT-TRIM" "STRING-STREAM" "STRING-TRIM"
-      "STRING-UPCASE" "STRING/=" "STRING<" "STRING<=" "STRING=" "STRING>" "STRING>=" "STRINGP"
-      "STRUCTURE" "STRUCTURE-CLASS" "STRUCTURE-OBJECT" "STYLE-WARNING" "SUBLIS" "SUBSEQ"
-      "SUBSETP" "SUBST" "SUBST-IF" "SUBST-IF-NOT" "SUBSTITUTE" "SUBSTITUTE-IF"
-      "SUBSTITUTE-IF-NOT" "SUBTYPEP" "SVREF" "SXHASH" "SYMBOL" "SYMBOL-FUNCTION"
-      "SYMBOL-MACROLET" "SYMBOL-NAME" "SYMBOL-PACKAGE" "SYMBOL-PLIST" "SYMBOL-VALUE" "SYMBOLP"
-      "SYNONYM-STREAM" "SYNONYM-STREAM-SYMBOL" "T" "TAGBODY" "TAILP" "TAN" "TANH" "TENTH"
-      "TERPRI" "THE" "THIRD" "THROW" "TIME" "TRACE" "TRANSLATE-LOGICAL-PATHNAME"
-      "TRANSLATE-PATHNAME" "TREE-EQUAL" "TRUENAME" "TRUNCATE" "TWO-WAY-STREAM"
-      "TWO-WAY-STREAM-INPUT-STREAM" "TWO-WAY-STREAM-OUTPUT-STREAM" "TYPE" "TYPE-ERROR"
-      "TYPE-ERROR-DATUM" "TYPE-ERROR-EXPECTED-TYPE" "TYPE-OF" "TYPECASE" "TYPEP" "UNBOUND-SLOT"
-      "UNBOUND-SLOT-INSTANCE" "UNBOUND-VARIABLE" "UNDEFINED-FUNCTION" "UNEXPORT" "UNINTERN"
-      "UNION" "UNLESS" "UNREAD-CHAR" "UNSIGNED-BYTE" "UNTRACE" "UNUSE-PACKAGE" "UNWIND-PROTECT"
-      "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS" "UPDATE-INSTANCE-FOR-REDEFINED-CLASS"
-      "UPGRADED-ARRAY-ELEMENT-TYPE" "UPGRADED-COMPLEX-PART-TYPE" "UPPER-CASE-P" "USE-PACKAGE"
-      "USE-VALUE" "USER-HOMEDIR-PATHNAME" "VALUES" "VALUES-LIST" "VARIABLE" "VECTOR"
-      "VECTOR-POP" "VECTOR-PUSH" "VECTOR-PUSH-EXTEND" "VECTORP" "WARN" "WARNING" "WHEN"
-      "WILD-PATHNAME-P" "WITH-ACCESSORS" "WITH-COMPILATION-UNIT" "WITH-CONDITION-RESTARTS"
-      "WITH-HASH-TABLE-ITERATOR" "WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE" "WITH-OPEN-STREAM"
-      "WITH-OUTPUT-TO-STRING" "WITH-PACKAGE-ITERATOR" "WITH-SIMPLE-RESTART" "WITH-SLOTS"
-      "WITH-STANDARD-IO-SYNTAX" "WRITE" "WRITE-BYTE" "WRITE-CHAR" "WRITE-LINE" "WRITE-SEQUENCE"
-      "WRITE-STRING" "WRITE-TO-STRING" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP"))
-
   (defvar *export-from-glisp*
     '(
       "DEFSUBST"
@@ -358,7 +185,7 @@
                (finish-output)
                nil)))
 
-  (defun dump-defpackage (&aux imports export-ansi export-gray)
+  (defun dump-defpackage (&aux imports export-gray)
     (labels ((grok (symbols packages)
                    (let ((res nil))
                      (dolist (nam symbols)
@@ -377,17 +204,16 @@
                                           ,(symbol-name sym))
                                         imports))))))
                      res)))
-      (setf export-ansi (grok *all-ansi-symbols* *packages*))
       (setf export-gray (grok *gray-symbols* *gray-packages*))
       `(progn
-         (defpackage "GLISP" (:use)
+         (defpackage "GLISP"
+	   (:use :cl)
            , at imports
            (:export
-            ,@(mapcar #'symbol-name export-ansi)
             ,@(mapcar #'symbol-name export-gray)
             ,@*export-from-glisp*))
          (defpackage "GLUSER"
-           (:use "GLISP")) )))
+           (:use "CL" "GLISP")) )))
 
   (defmacro define-glisp-package ()
     (dump-defpackage))



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:18 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061231114818.EBC884E000@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv26809/src/gui

Modified Files:
	clue-gui.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/29 21:29:27	1.4
+++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 11:48:18	1.5
@@ -115,7 +115,7 @@
                       ((member mime-type (list (netlib:find-mime-type "text/html")))
                        (sgml::parse-html input charset))
                       ((member mime-type (list (netlib:find-mime-type "text/xml")))
-                       (cxml:parse-stream input (cxml-dom:make-dom-builder) :recode nil))
+                       (cxml:parse-stream input (rune-dom:make-dom-builder) :recode nil))
 
                       ((or t
                            #+NIL



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:19 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:19 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/imagelib
Message-ID: <20061231114819.369DF4F005@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/imagelib
In directory clnet:/tmp/cvs-serv26809/src/imagelib

Modified Files:
	package.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/imagelib/package.lisp	2006/12/29 21:29:28	1.3
+++ /project/closure/cvsroot/closure/src/imagelib/package.lisp	2006/12/31 11:48:18	1.4
@@ -29,7 +29,7 @@
 (in-package :CL-USER)
 
 (defpackage :imagelib
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export
    #:aimage
    #:aimage-width
@@ -42,9 +42,9 @@
    #:pnm-stream->aimage))
 
 (defpackage :imagelib.gif
-  (:use :glisp :imagelib))
+  (:use :cl :glisp :imagelib))
 
 (defpackage :png
-  (:use :glisp :imagelib)
+  (:use :cl :glisp :imagelib)
   (:export #:png-stream->aimage))
 



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:19 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:19 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/net
Message-ID: <20061231114819.6E0B54F00E@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/net
In directory clnet:/tmp/cvs-serv26809/src/net

Modified Files:
	package.lisp url.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/net/package.lisp	2006/12/29 21:29:29	1.3
+++ /project/closure/cvsroot/closure/src/net/package.lisp	2006/12/31 11:48:19	1.4
@@ -30,7 +30,7 @@
 
 (defpackage :ws/netlib
   (:nicknames :netlib)
-  (:use :glisp :url :runes)
+  (:use :cl :glisp :url :runes)
   (:export #:*options/connection-timeout*
            #:open-document
            #:with-open-document
--- /project/closure/cvsroot/closure/src/net/url.lisp	2006/12/29 21:29:29	1.6
+++ /project/closure/cvsroot/closure/src/net/url.lisp	2006/12/31 11:48:19	1.7
@@ -41,7 +41,7 @@
 ;(require :glisp)
 
 (defpackage :url
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export
    #:parse-url
    #:unparse-url



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:20 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:20 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/parse
Message-ID: <20061231114820.30BEA5001A@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/parse
In directory clnet:/tmp/cvs-serv26809/src/parse

Modified Files:
	package.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/parse/package.lisp	2006/12/29 21:29:30	1.4
+++ /project/closure/cvsroot/closure/src/parse/package.lisp	2006/12/31 11:48:19	1.5
@@ -29,7 +29,7 @@
 (in-package :CL-USER)
 
 (defpackage :sgml
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export #:SGML-PARSE 
            #:PPT 
            #:SGML-UNPARSE 



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:20 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:20 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/protocols
Message-ID: <20061231114820.C91B18304E@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/protocols
In directory clnet:/tmp/cvs-serv26809/src/protocols

Modified Files:
	package.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/protocols/package.lisp	2006/12/29 21:29:33	1.4
+++ /project/closure/cvsroot/closure/src/protocols/package.lisp	2006/12/31 11:48:20	1.5
@@ -27,7 +27,7 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 (defpackage :CLOSURE-PROTOCOL
-    (:use :glisp :runes)
+    (:use :cl :glisp :runes)
   (:export
    ;; Basic Element Protocol
    #:element-p



From dlichteblau at common-lisp.net  Sun Dec 31 11:48:22 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 06:48:22 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/util
Message-ID: <20061231114822.6F85452002@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/util
In directory clnet:/tmp/cvs-serv26809/src/util

Modified Files:
	clex.lisp lalr.lisp xterm.lisp 
Log Message:
Finish what Eric started:
  - Added some missing (:use :cl) clauses.
  - Don't export COMMON-LISP symbols from GLISP anymore.


--- /project/closure/cvsroot/closure/src/util/clex.lisp	2006/12/29 21:29:44	1.4
+++ /project/closure/cvsroot/closure/src/util/clex.lisp	2006/12/31 11:48:20	1.5
@@ -27,7 +27,7 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 (defpackage :clex
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export
    #:deflexer #:backup #:begin #:initial #:bag))
 
--- /project/closure/cvsroot/closure/src/util/lalr.lisp	2006/12/29 21:29:44	1.2
+++ /project/closure/cvsroot/closure/src/util/lalr.lisp	2006/12/31 11:48:21	1.3
@@ -7,7 +7,7 @@
 ;;;  (c) 1988 Mark Johnson
 
 (defpackage :lalr
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export #:DEFINE-GRAMMAR))
 
 (in-package :LALR)
--- /project/closure/cvsroot/closure/src/util/xterm.lisp	2006/12/29 21:29:44	1.3
+++ /project/closure/cvsroot/closure/src/util/xterm.lisp	2006/12/31 11:48:21	1.4
@@ -28,7 +28,7 @@
 
 
 (defpackage :XTERM
-  (:use :glisp :runes)
+  (:use :cl :glisp :runes)
   (:export
    #:open-terminal
    ))



From dlichteblau at common-lisp.net  Sun Dec 31 12:05:33 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:05:33 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/css
Message-ID: <20061231120533.7B7B33C007@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/css
In directory clnet:/tmp/cvs-serv29975/src/css

Modified Files:
	css-parse.lisp css-support.lisp 
Log Message:
More rune fixes.


--- /project/closure/cvsroot/closure/src/css/css-parse.lisp	2006/12/29 21:29:23	1.6
+++ /project/closure/cvsroot/closure/src/css/css-parse.lisp	2006/12/31 12:05:33	1.7
@@ -1153,6 +1153,10 @@
   (eql a b))
 (defun hieroglyph-equal (a b)
   (equal a b))
+(defun hieroglyph-char (x)
+  (code-char x))
+(defun papyrus-string (v)
+  (map 'string (lambda (x) (or (hieroglyph-char x) #\?)) v))
 
 (defun find-value-parser (slot)
   (unless (typep slot 'rod)
--- /project/closure/cvsroot/closure/src/css/css-support.lisp	2006/12/29 21:29:24	1.4
+++ /project/closure/cvsroot/closure/src/css/css-support.lisp	2006/12/31 12:05:33	1.5
@@ -37,9 +37,12 @@
 
 ;;; hmmm
 
-(defun intern-attribute-name (string)
+(defun intern-attribute-name (papyrus)
   ;; XXX hack
-  (intern (string-upcase (map 'string (lambda (x) (or (rune-char x) #\?)) string)) :keyword))
+  (intern (string-upcase (if (stringp papyrus)
+			     papyrus
+			     (papyrus-string papyrus)))
+	  :keyword))
 
 (defun intern-gi (string)
   (intern-attribute-name string))



From dlichteblau at common-lisp.net  Sun Dec 31 12:05:33 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:05:33 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/html
Message-ID: <20061231120533.B03003E008@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/html
In directory clnet:/tmp/cvs-serv29975/src/html

Modified Files:
	html-style.lisp 
Log Message:
More rune fixes.


--- /project/closure/cvsroot/closure/src/html/html-style.lisp	2006/12/29 21:29:28	1.8
+++ /project/closure/cvsroot/closure/src/html/html-style.lisp	2006/12/31 12:05:33	1.9
@@ -191,9 +191,6 @@
         (t
          (format nil "[invalid html-length: ~S]" value))))
 
-(defun rod->string (x)
-  (map 'simple-string (lambda (x) (or (code-char x) #\?)) x))
-
 (defun pt-attr/with-parser (pt slot default parser pretty-type-name)
   (let ((s (pt-attr* pt slot)))
     (if (not s)
@@ -203,7 +200,7 @@
             value
           (progn
             (pt-attr-warn pt "The value of the ~A attribute, ~S, is not ~A."
-                          slot (rod->string s) pretty-type-name)
+                          slot (rod-string s) pretty-type-name)
             default))))))
 
 (defun pt-attr/integer (pt slot &optional default)
@@ -238,7 +235,7 @@
                  (progn
                    (pt-attr-warn pt "The value of the ~A attribute, ~
                                      should be ~{\"~A\"~#[~; or ~:;, ~]~}, but not ~S."
-                                 slot keys (rod->string s))
+                                 slot keys (rod-string s))
                    default)))))))
 
 (defun pt-attr/table.frame (pt slot &optional default)
@@ -298,28 +295,28 @@
 (defun html/parse-integer (s)
   (if-match (s :type rod :test #'rune=) 
             (& (w*) (= $res (integer)) (w*))
-            (parse-integer (rod->string (subseq s $res-start $res-end)))))
+            (parse-integer (rod-string (subseq s $res-start $res-end)))))
 
 (defun html/parse-length (s)
   (or
    (if-match (s :type rod :test #'rune=) 
              (& (w*) (= $res (integer)) (w*))
-             (cons :px (parse-integer (rod->string (subseq s $res-start $res-end)))))
+             (cons :px (parse-integer (rod-string (subseq s $res-start $res-end)))))
    (if-match (s :type rod :test #'rune=) 
              (& (w*) (= $res (integer)) #.(char-code #\%) (w*))
-             (cons :% (parse-integer (rod->string (subseq s $res-start $res-end)))))))
+             (cons :% (parse-integer (rod-string (subseq s $res-start $res-end)))))))
 
 (defun html/parse-multi-length (s)
   (or
    (html/parse-length s)
    (if-match (s :type rod :test #'rune=) 
              (& (w*) (= $res (integer)) #.(char-code #\*) (w*))
-             (cons '* (parse-integer (rod->string (subseq s $res-start $res-end)))))
+             (cons '* (parse-integer (rod-string (subseq s $res-start $res-end)))))
    ;; This below is illegal syntax '*i' is not allowed
    #+(OR)
    (if-match (s :type rod :test #'rune=) 
              (& (w*) #.(char-code #\*) (= $res (integer)) (w*))
-             (cons '* (parse-integer (rod->string (subseq s $res-start $res-end)))))
+             (cons '* (parse-integer (rod-string (subseq s $res-start $res-end)))))
    ;; "*" is abbrev for "1*"
    (if-match (s :type rod :test #'rune=) 
              (& (w*) #.(char-code #\*) (w*))



From dlichteblau at common-lisp.net  Sun Dec 31 12:05:34 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:05:34 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/parse
Message-ID: <20061231120534.248D73E008@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/parse
In directory clnet:/tmp/cvs-serv29975/src/parse

Modified Files:
	sgml-parse.lisp 
Log Message:
More rune fixes.


--- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp	2006/12/29 21:29:30	1.5
+++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp	2006/12/31 12:05:33	1.6
@@ -392,7 +392,7 @@
           (t
            (parse-warn input 3
                        "Saw character '~A' after '&' -- bad entity reference?!" 
-                       (or (code-char ch)
+                       (or (rune-char ch)
                            (format nil "&#x~4,'0X" ch)))
            (a-unread-byte ch input)     ;it might be something interesting
            (push-on-scratch input sp #/&)) )))
@@ -438,7 +438,7 @@
     (do ((ch (a-read-byte input) (a-read-byte input)))
         ((or (null ch) (not (digit-rune-p ch radix)))
          ;; Ok. [s1..sp) now is the digit sequence
-         (let ((num (parse-integer (map 'string #'code-char 
+         (let ((num (parse-integer (map 'string #'rune-char
                                         (subseq (a-stream-scratch input) s1 sp))
                                    :radix radix)))
            (cond ((<= 0 num #xFFFF)
@@ -446,7 +446,7 @@
                   (when (and (not (null ch)) (not (rune= ch #/\;)))
                     (a-unread-byte ch input))
                   ;; Rewind scratch pad to `s0' and push character `num'
-                  (setf sp (push-on-scratch input s0 num)))
+                  (setf sp (push-on-scratch input s0 (code-rune num))))
                  (t
                   ;; num too large; emit warning and leave scratch pad alone
                   (when (not (null ch))
@@ -537,7 +537,7 @@
              (read-start-tag input dtd))
             (t
              (parse-warn input 3 "Bad character after '<': '~A' -- ignored."
-                         (code-char ch))
+                         (rune-char ch))
              (let ((res (string-rod "<")))
                (values :pcdata res))) ))) )
 
@@ -669,7 +669,7 @@
           (t
            (read-tag-error input 
                            "Expected sloopy name, got ~A"
-                           (or (code-char ch) (format nil "U+~4,'0X" ch)) )) )))
+                           (or (rune-char ch) (format nil "U+~4,'0X" ch)) )) )))
 
 (defun read-sloopy-value (input)
   (let ((ch (a-peek-byte input))
@@ -683,7 +683,7 @@
              (setf sp (push-on-scratch input sp ch))))
           (t
            (read-tag-error input "Expected sloopy value, got ~A"
-                           (or (code-char ch) (format nil "U+~4,'0X" ch)) )) )))
+                           (or (rune-char ch) (format nil "U+~4,'0X" ch)) )) )))
 
 (defun read-define-tag (input dtd)
   (let ((ch (a-peek-byte input)))



From dlichteblau at common-lisp.net  Sun Dec 31 12:14:37 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:14:37 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231121437.09AAC8304E@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv30859/src/glisp

Modified Files:
	dep-acl.lisp dep-acl5.lisp dep-clisp.lisp dep-cmucl-dtc.lisp 
	dep-cmucl.lisp dep-openmcl.lisp dep-sbcl.lisp util.lisp 
Log Message:
No need to have two identical versions of defsubst.  Use the one in CXML.


--- /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp	2006/12/31 12:14:36	1.3
@@ -110,23 +110,5 @@
 (defun glisp::mp/process-wait (whostate predicate)
   (mp:process-wait whostate predicate))
 
-;; ACL is incapable to define compiler macros on (setf foo)
-;; Unfortunately it is also incapable to declaim such functions inline.
-;; So we revoke the DEFUN hack from dep-gcl here.
-
-(defmacro glisp::defsubst (fun args &body body)
-  (if (and (consp fun) (eq (car fun) 'setf))
-      (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
-                          (symbol-package (cadr fun)))))
-        `(progn
-           (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
-           (glisp::defsubst ,fnam ,args .,body)))
-    `(progn
-       (defun ,fun ,args .,body)
-       (define-compiler-macro ,fun (&rest .args.)
-         (cons '(lambda ,args .,body)
-               .args.)))))
-
-
 (defun glisp::getenv (string)
   (sys:getenv string))
--- /project/closure/cvsroot/closure/src/glisp/dep-acl5.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-acl5.lisp	2006/12/31 12:14:36	1.3
@@ -140,28 +140,5 @@
 (defun glisp::mp/process-kill (proc)
   (mp:process-kill proc))
 
-;; ACL is incapable to define compiler macros on (setf foo)
-;; Unfortunately it is also incapable to declaim such functions inline.
-;; So we revoke the DEFUN hack from dep-gcl here.
-
-(defmacro glisp::defsubst (fun args &body body)
-  (if (and (consp fun) (eq (car fun) 'setf))
-      (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
-                          (symbol-package (cadr fun)))))
-        `(progn
-           (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
-           (glisp::defsubst ,fnam ,args .,body)))
-    (labels ((declp (x)
-               (and (consp x) (eq (car x) 'declare))))
-      `(progn
-         (defun ,fun ,args .,body)
-         (define-compiler-macro ,fun (&rest .args.)
-           (cons '(lambda ,args
-                   ,@(remove-if-not #'declp body)
-                   (block ,fun 
-                     ,@(remove-if #'declp body)))
-                 .args.))))))
-
-
 (defun glisp::getenv (string)
-  (sys:getenv string))
\ No newline at end of file
+  (sys:getenv string))
--- /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp	2006/12/31 12:14:36	1.3
@@ -120,11 +120,6 @@
   (apply #'xlib:draw-glyphs drawable gcontext x y (vector elt) more))
 ||#
 
-(defmacro glisp::defsubst (name args &body body)
-  `(progn
-     (declaim (inline ,name))
-     (defun ,name ,args .,body)))
-
 (export 'glisp::getenv :glisp)
 (defun glisp::getenv (var)
   (sys::getenv var))
--- /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp	2006/12/31 12:14:36	1.3
@@ -161,7 +161,7 @@
 On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from:
 target:code/run-program.lisp
   Created: Saturday, 6/20/98 07:13:08 pm [-1]
-  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp,v 1.2 2005/03/13 18:01:15 gbaumann Exp $
+  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $
 ||#
 
 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
@@ -169,11 +169,6 @@
 (defun glisp:run-unix-shell-command (command)
   (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
 
-(defmacro glisp::defsubst (name args &body body)
-  `(progn
-     (declaim (inline ,name))
-     (defun ,name ,args .,body)))
-
 
 ;;; MP
 
--- /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp	2006/12/31 12:14:36	1.3
@@ -192,7 +192,7 @@
 On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from:
 target:code/run-program.lisp
   Created: Saturday, 6/20/98 07:13:08 pm [-1]
-  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.2 2005/03/13 18:01:15 gbaumann Exp $
+  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $
 ||#
 
 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
@@ -200,12 +200,6 @@
 (defun glisp:run-unix-shell-command (command)
   (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
 
-(defmacro glisp::defsubst (name args &body body)
-  `(progn
-     (declaim (inline ,name))
-     (defun ,name ,args .,body)))
-
-
 ;;; MP
 
 (export 'glisp::mp/process-yield :glisp)
--- /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp	2005/08/25 15:14:12	1.1
+++ /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp	2006/12/31 12:14:36	1.2
@@ -145,12 +145,6 @@
    (ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil
 		       :output nil))))
 
-(defmacro glisp::defsubst (name args &body body)
-  `(progn
-     (declaim (inline ,name))
-     (defun ,name ,args .,body)))
-
-
 ;;; MP
 
 (export 'glisp::mp/process-yield :glisp)
--- /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2006/12/30 15:00:28	1.3
+++ /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2006/12/31 12:14:36	1.4
@@ -100,12 +100,6 @@
    (sb-ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil
 		       :output nil)))
 
-(defmacro glisp::defsubst (name args &body body)
-  `(progn
-     (declaim (inline ,name))
-     (defun ,name ,args .,body)))
-
-
 ;;; MP
 
 (export 'glisp::mp/process-yield :glisp)
--- /project/closure/cvsroot/closure/src/glisp/util.lisp	2006/12/29 21:29:25	1.5
+++ /project/closure/cvsroot/closure/src/glisp/util.lisp	2006/12/31 12:14:36	1.6
@@ -41,6 +41,9 @@
 (define-compiler-macro neq (x y)
   `(not (eq ,x ,y)))
 
+(defmacro defsubst (name args &body body)
+  `(runes:definline ,name ,args , at body))
+
 ;;; --------------------------------------------------------------------------------
 ;;;  Meta functions
 



From dlichteblau at common-lisp.net  Sun Dec 31 12:35:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:35:18 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061231123518.78F071C009@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv2129

Modified Files:
	closure.asd 
Log Message:
Don't export gray stream symbols from glisp.  Use a normal defpackage
for glisp.  (I was planning to switch closure to the trivial-gray-streams
package instead, but couldn't find any actual gray streams usage.)


--- /project/closure/cvsroot/closure/closure.asd	2006/12/29 21:29:22	1.8
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/31 12:35:18	1.9
@@ -60,7 +60,10 @@
 			       (make-pathname :name nil :type nil
 					      :defaults *load-truename*))
     :default-component-class closure-source-file
-    :depends-on (:cxml :mcclim #+sbcl :sb-bsd-sockets)
+    :depends-on (:cxml :mcclim
+		       ;; uncomment this if we actually need gray streams:
+		       ;; :trivial-gray-streams
+		       #+sbcl :sb-bsd-sockets)
     :components
     ((:file dependent
 	    :pathname



From dlichteblau at common-lisp.net  Sun Dec 31 12:35:18 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 07:35:18 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231123518.B87D81E001@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv2129/src/glisp

Modified Files:
	package.lisp 
Log Message:
Don't export gray stream symbols from glisp.  Use a normal defpackage
for glisp.  (I was planning to switch closure to the trivial-gray-streams
package instead, but couldn't find any actual gray streams usage.)


--- /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/31 11:48:18	1.6
+++ /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/31 12:35:18	1.7
@@ -26,198 +26,102 @@
 ;;;  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-(defpackage :glisp-temp (:use #:cl))
-(in-package :glisp-temp)
+(in-package :cl-user)
 
-(defpackage :glisp (:use))
-
-(eval-when (compile)
-  (defvar *export-from-glisp*
-    '(
-      "DEFSUBST"
-      "G/MAKE-STRING"
-      "MP/MAKE-LOCK"
-      "MP/WITH-LOCK"
-      "WITH-TIMEOUT"
-      "OPEN-INET-SOCKET"
-      ;; util.lisp :
-      "ALWAYS"
-      "CL-BYTE-STREAM"
-      "CL-CHAR-STREAM"
-      "CL-STREAM"
-      "COMPOSE"
-      "CURRY"
-      "FALSE"
-      "FORCE"
-      "G/CLOSE"
-      "G/FINISH-OUTPUT"
-      "G/PEEK-CHAR"
-      "G/READ-BYTE"
-      "G/READ-BYTE-SEQUENCE"
-      "G/READ-CHAR"
-      "G/READ-CHAR-SEQUENCE"
-      "G/READ-LINE"
-      "G/READ-LINE*"
-      "G/UNREAD-BYTE"
-      "G/UNREAD-CHAR"
-      "G/WRITE-BYTE"
-      "G/WRITE-BYTE-SEQUENCE"
-      "G/WRITE-CHAR"
-      "G/WRITE-STRING"
-      "GSTREAM"
-      "MAP-ARRAY"
-      "MAPFCAR"
-      "MAX*"
-      "MAXF"
-      "MIN*"
-      "MINF"
-      "MULTIPLE-VALUE-OR"
-      "MULTIPLE-VALUE-SOME"
-      "NCONCF"
-      "NEQ"
-      "PROMISE"
-      "RCURRY"
-      "SANIFY-STRING"
-      "SHOW"
-      "SPLIT-BY"
-      "SPLIT-BY-IF"
-      "SPLIT-BY-MEMBER"
-      "SPLIT-STRING"
-      "STRING-BEGIN-EQUAL"
-      "TRUE"
-      "UNTIL"
-      "USE-BYTE-FOR-CHAR-STREAM-FLAVOUR"
-      "USE-CHAR-FOR-BYTE-STREAM-FLAVOUR"
-      "WHILE"
-      "WHITE-SPACE-P"
-
-      "CL-BYTE-STREAM->GSTREAM"
-      "CL-CHAR-STREAM->GSTREAM"
-      "G/OPEN-INET-SOCKET"
-      "ACCEPT-CONNECTION"
-
-      "FIND-TEMPORARY-FILE"
-      "DELETE-TEMPORARY-FILE"
-      "WITH-TEMPORARY-FILE"
+(defpackage "GLISP"
+  (:use :cl)
+  (:export "DEFSUBST"
+	   "G/MAKE-STRING"
+	   "MP/MAKE-LOCK"
+	   "MP/WITH-LOCK"
+	   "WITH-TIMEOUT"
+	   "OPEN-INET-SOCKET"
+	   ;; util.lisp :
+	   "ALWAYS"
+	   "CL-BYTE-STREAM"
+	   "CL-CHAR-STREAM"
+	   "CL-STREAM"
+	   "COMPOSE"
+	   "CURRY"
+	   "FALSE"
+	   "FORCE"
+	   "G/CLOSE"
+	   "G/FINISH-OUTPUT"
+	   "G/PEEK-CHAR"
+	   "G/READ-BYTE"
+	   "G/READ-BYTE-SEQUENCE"
+	   "G/READ-CHAR"
+	   "G/READ-CHAR-SEQUENCE"
+	   "G/READ-LINE"
+	   "G/READ-LINE*"
+	   "G/UNREAD-BYTE"
+	   "G/UNREAD-CHAR"
+	   "G/WRITE-BYTE"
+	   "G/WRITE-BYTE-SEQUENCE"
+	   "G/WRITE-CHAR"
+	   "G/WRITE-STRING"
+	   "GSTREAM"
+	   "MAP-ARRAY"
+	   "MAPFCAR"
+	   "MAX*"
+	   "MAXF"
+	   "MIN*"
+	   "MINF"
+	   "MULTIPLE-VALUE-OR"
+	   "MULTIPLE-VALUE-SOME"
+	   "NCONCF"
+	   "NEQ"
+	   "PROMISE"
+	   "RCURRY"
+	   "SANIFY-STRING"
+	   "SHOW"
+	   "SPLIT-BY"
+	   "SPLIT-BY-IF"
+	   "SPLIT-BY-MEMBER"
+	   "SPLIT-STRING"
+	   "STRING-BEGIN-EQUAL"
+	   "TRUE"
+	   "UNTIL"
+	   "USE-BYTE-FOR-CHAR-STREAM-FLAVOUR"
+	   "USE-CHAR-FOR-BYTE-STREAM-FLAVOUR"
+	   "WHILE"
+	   "WHITE-SPACE-P"
+
+	   "CL-BYTE-STREAM->GSTREAM"
+	   "CL-CHAR-STREAM->GSTREAM"
+	   "G/OPEN-INET-SOCKET"
+	   "ACCEPT-CONNECTION"
+
+	   "FIND-TEMPORARY-FILE"
+	   "DELETE-TEMPORARY-FILE"
+	   "WITH-TEMPORARY-FILE"
           
-      "SET-EQUAL"
-      "MAYBE-PARSE-INTEGER"
-      "NOP"
-      "WITH-STRUCTURE-SLOTS"
-
-      "COMPILE-FUNCALL"
-      "FUNCALL*"
-      "MAPC*"
-      "VREDUCE*"
-      "LREDUCE*"
-      "WITH-UNIQUE-NAMES"
+	   "SET-EQUAL"
+	   "MAYBE-PARSE-INTEGER"
+	   "NOP"
+	   "WITH-STRUCTURE-SLOTS"
+
+	   "COMPILE-FUNCALL"
+	   "FUNCALL*"
+	   "MAPC*"
+	   "VREDUCE*"
+	   "LREDUCE*"
+	   "WITH-UNIQUE-NAMES"
     
-      "G/MAKE-HASH-TABLE"
-      "G/HASHGET"
-      "G/CLRHASH"
-      "STIR-HASH-CODES"
-      "HASH-SEQUENCE"
-      "HASH/STRING-EQUAL"
-      "MAKE-STRING-EQUAL-HASH-TABLE"
+	   "G/MAKE-HASH-TABLE"
+	   "G/HASHGET"
+	   "G/CLRHASH"
+	   "STIR-HASH-CODES"
+	   "HASH-SEQUENCE"
+	   "HASH/STRING-EQUAL"
+	   "MAKE-STRING-EQUAL-HASH-TABLE"
 
-      "PRIMEP"
+	   "PRIMEP"
     
-      ;; match.lisp
-      "DEFINE-MATCH-MACRO"
-      "IF-MATCH"
-      "GSTREAM-AS-STRING"
-      ))
-
-  (defparameter *packages* 
-    #-GCL '(:common-lisp)
-    #+GCL '(:lisp :pcl) )
-
-  (defparameter *gray-symbols*
-    '("FUNDAMENTAL-STREAM"
-      "FUNDAMENTAL-INPUT-STREAM"
-      "FUNDAMENTAL-OUTPUT-STREAM"
-      "FUNDAMENTAL-CHARACTER-STREAM"
-      "FUNDAMENTAL-BINARY-STREAM"
-      "FUNDAMENTAL-CHARACTER-INPUT-STREAM"
-      "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM"
-      "FUNDAMENTAL-BINARY-INPUT-STREAM"
-
-      "STREAM-READ-CHAR"
-      "STREAM-UNREAD-CHAR"
-      "STREAM-READ-CHAR-NO-HANG"
-      "STREAM-PEEK-CHAR"
-      "STREAM-LISTEN"
-      "STREAM-READ-LINE"
-      "STREAM-CLEAR-INPUT"
-
-      "STREAM-WRITE-CHAR"
-      "STREAM-LINE-COLUMN"
-      "STREAM-START-LINE-P"
-      "STREAM-WRITE-STRING"
-      "STREAM-TERPRI"
-      "STREAM-FRESH-LINE"
-      "STREAM-FINISH-OUTPUT"
-      "STREAM-FORCE-OUTPUT"
-      "STREAM-ADVANCE-TO-COLUMN"
-
-      "STREAM-READ-BYTE"
-      "STREAM-WRITE-BYTE" ))
-
-  (defparameter *gray-packages*
-    `(
-      #+:CLISP                 ,@'(:lisp)
-      #+:CMU                   ,@'(:ext)
-      #+:sbcl                   ,@'(:sb-gray)
-      #+:ALLEGRO               ,@'(:common-lisp :excl :stream)
-      #+:HARLEQUIN-COMMON-LISP ,@'(:stream)
-      #+:OPENMCL               ,@'(:ccl)
-      ))
-
-  (defun seek-symbol (name packages)
-    ;; Seek the a symbol named 'name' in `packages'
-    (or (some #'(lambda (p) 
-                  (multiple-value-bind (sym res) (find-symbol name p)
-                    (if (eql res :external)
-                        (list sym)
-                      nil)))
-              packages)
-        (progn (format T "~&There is no ~A in ~A." name packages)
-               (finish-output)
-               nil)))
-
-  (defun dump-defpackage (&aux imports export-gray)
-    (labels ((grok (symbols packages)
-                   (let ((res nil))
-                     (dolist (nam symbols)
-                       (let ((sym (seek-symbol nam packages)))
-                         (when sym
-                           (push (car sym) res)
-                           (cond ((multiple-value-bind (sym2 res) (find-symbol nam :glisp)
-                                    (and sym2 (eq res :external)))
-                                  ;;
-                                  (format T "~&;; ~S is pacthed." sym) )
-                                 (t
-                                  (setf sym (car sym))
-                                  ;; CLISP has no (:import ..) ARG!
-                                  (push `(:import-from
-                                          ,(package-name (symbol-package sym))
-                                          ,(symbol-name sym))
-                                        imports))))))
-                     res)))
-      (setf export-gray (grok *gray-symbols* *gray-packages*))
-      `(progn
-         (defpackage "GLISP"
-	   (:use :cl)
-           , at imports
-           (:export
-            ,@(mapcar #'symbol-name export-gray)
-            ,@*export-from-glisp*))
-         (defpackage "GLUSER"
-           (:use "CL" "GLISP")) )))
-
-  (defmacro define-glisp-package ()
-    (dump-defpackage))
-  )
-
-(define-glisp-package)
+	   ;; match.lisp
+	   "DEFINE-MATCH-MACRO"
+	   "IF-MATCH"
+	   "GSTREAM-AS-STRING"))
 
+(defpackage "GLUSER"
+  (:use "CL" "GLISP"))



From dlichteblau at common-lisp.net  Sun Dec 31 13:00:04 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 08:00:04 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061231130004.207AF3E056@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv6441

Modified Files:
	closure.asd 
Log Message:
As part of the great glisp cleanup, remove dep-acl5.lisp.  Hopefully
this doesn't break anything, but according to both closure.asd and
closure.system, this file hasn't been in use ever since Allegro 6.0 came
out, and it's now at version 8.0.  Obviously, this file was -meant- for
ACL >= 5.0, not ACL == 5.0, but that's not what the reader conditionals
say.  The differences to dep-acl.lisp seem negligible anyway.  If this
breaks anything, please complain so that it can be fixed.


--- /project/closure/cvsroot/closure/closure.asd	2006/12/31 12:35:18	1.9
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/31 13:00:03	1.10
@@ -71,8 +71,7 @@
 	    #+(AND :CMU (NOT :PTHREAD))         "dep-cmucl"
 	    #+sbcl                              "dep-sbcl"
 	    #+(AND :CMU :PTHREAD)               "dep-cmucl-dtc"
-	    #+(AND ALLEGRO ALLEGRO-V5.0)        "dep-acl5"
-	    #+(AND ALLEGRO (NOT ALLEGRO-V5.0))  "dep-acl"
+	    #+ALLEGRO                           "dep-acl"
 	    #+GCL                               "dep-gcl"
 	    #+OPENMCL                           "dep-openmcl"
 	    #-(OR sbcl CLISP CMU ALLEGRO GCL OPENMCL) #.(error "Configure!"))



From dlichteblau at common-lisp.net  Sun Dec 31 13:00:06 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 08:00:06 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231130006.B4F0E48145@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv6441/src/glisp

Removed Files:
	dep-acl5.lisp 
Log Message:
As part of the great glisp cleanup, remove dep-acl5.lisp.  Hopefully
this doesn't break anything, but according to both closure.asd and
closure.system, this file hasn't been in use ever since Allegro 6.0 came
out, and it's now at version 8.0.  Obviously, this file was -meant- for
ACL >= 5.0, not ACL == 5.0, but that's not what the reader conditionals
say.  The differences to dep-acl.lisp seem negligible anyway.  If this
breaks anything, please complain so that it can be fixed.





From dlichteblau at common-lisp.net  Sun Dec 31 13:11:44 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 08:11:44 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061231131144.9BD00B@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv15409

Modified Files:
	closure.asd 
Log Message:
Based on the assumption that (and cmucl pthread) is actually code for
Scieneer CL, rename dep-cmucl-dtc to dep-scl.


--- /project/closure/cvsroot/closure/closure.asd	2006/12/31 13:00:03	1.10
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/31 13:11:44	1.11
@@ -68,9 +68,9 @@
     ((:file dependent
 	    :pathname
 	    #+CLISP                             "dep-clisp"
-	    #+(AND :CMU (NOT :PTHREAD))         "dep-cmucl"
+	    #+(AND :CMU (NOT SCL))              "dep-cmucl"
 	    #+sbcl                              "dep-sbcl"
-	    #+(AND :CMU :PTHREAD)               "dep-cmucl-dtc"
+	    #+SCL                               "dep-scl"
 	    #+ALLEGRO                           "dep-acl"
 	    #+GCL                               "dep-gcl"
 	    #+OPENMCL                           "dep-openmcl"



From dlichteblau at common-lisp.net  Sun Dec 31 13:11:44 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 08:11:44 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231131144.046DC100D@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv15409/src/glisp

Added Files:
	dep-scl.lisp 
Removed Files:
	dep-cmucl-dtc.lisp 
Log Message:
Based on the assumption that (and cmucl pthread) is actually code for
Scieneer CL, rename dep-cmucl-dtc to dep-scl.



--- /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp	2006/12/31 13:11:44	NONE
+++ /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp	2006/12/31 13:11:44	1.1
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;;     Title: [Originally CMUCL dependent stuff + fixups], probably for SCL
;;;   Created: 1999-05-25 22:32
;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
;;;   License: MIT style (see below)
;;; ---------------------------------------------------------------------------
;;;  (c) copyright 1999 by Gilbert Baumann

;;;  Permission is hereby granted, free of charge, to any person obtaining
;;;  a copy of this software and associated documentation files (the
;;;  "Software"), to deal in the Software without restriction, including
;;;  without limitation the rights to use, copy, modify, merge, publish,
;;;  distribute, sublicense, and/or sell copies of the Software, and to
;;;  permit persons to whom the Software is furnished to do so, subject to
;;;  the following conditions:
;;; 
;;;  The above copyright notice and this permission notice shall be
;;;  included in all copies or substantial portions of the Software.
;;; 
;;;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;;  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 
;;;  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;;;  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;;  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

(export 'glisp::read-byte-sequence :glisp)
(export 'glisp::read-char-sequence :glisp)
(export 'glisp::run-unix-shell-command :glisp)

(export 'glisp::getenv :glisp)

(defun glisp::read-byte-sequence (&rest ap)
  (apply #'read-sequence ap))

(defun glisp::read-char-sequence (&rest ap)
  (apply #'read-sequence ap))

(defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
  (let (c (i start))
    (loop
      (cond ((= i end) (return i)))
      (setq c (read-byte input nil :eof))
      (cond ((eql c :eof) (return i)))
      (setf (aref sequence i) c)
      (incf i) )))

(defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
  (let ((r (read-sequence sequence input :start start :end end)))
    (cond ((and (= r start) (> end start))
           (let ((byte (read-byte input nil :eof)))
             (cond ((eq byte :eof)
                    r)
                   (t
                    (setf (aref sequence start) byte)
                    (incf start)
                    (if (> end start)
                        (glisp::read-byte-sequence sequence input :start start :end end)
                      start)))))
          (t
           r))))

#||
(defun glisp::read-char-sequence (sequence input &key (start 0) (end (length sequence)))
  (let (c (i start))
    (loop
      (cond ((= i end) (return i)))
      (setq c (read-byte input nil :eof))
      (cond ((eql c :eof) (return i)))
      (setf (aref sequence i) c)
      (incf i) )))
||#

(defmacro glisp::with-timeout ((&rest ignore) &body body)
  (declare (ignore ignore))
  `(progn
     , at body))

(defun glisp::open-inet-socket (hostname port)
  (let ((fd (extensions:connect-to-inet-socket hostname port)))
    (values
     (sys:make-fd-stream fd
                         :input t
                         :output t
                         :element-type '(unsigned-byte 8)
                         :name (format nil "Network connection to ~A:~D" hostname port))
     :byte)))

(defun glisp::g/make-string (length &rest options)
  (apply #'make-array length :element-type 'base-char options))

#||

RUN-PROGRAM is an external symbol in the EXTENSIONS package.
Function: #<Function RUN-PROGRAM {12E7B79}>
Function arguments:
  (program args &key (env *environment-list*) (wait t) pty input
   if-input-does-not-exist output (if-output-exists :error) (error :output)
   (if-error-exists :error) status-hook)
Function documentation:
  Run-program creates a new process and runs the unix progam in the
   file specified by the simple-string program.  Args are the standard
   arguments that can be passed to a Unix program, for no arguments
   use NIL (which means just the name of the program is passed as arg 0).

   Run program will either return NIL or a PROCESS structure.  See the CMU
   Common Lisp Users Manual for details about the PROCESS structure.

   The keyword arguments have the following meanings:
     :env -
        An A-LIST mapping keyword environment variables to simple-string
        values.
     :wait -
        If non-NIL (default), wait until the created process finishes.  If
        NIL, continue running Lisp until the program finishes.
     :pty -
        Either T, NIL, or a stream.  Unless NIL, the subprocess is established
        under a PTY.  If :pty is a stream, all output to this pty is sent to
        this stream, otherwise the PROCESS-PTY slot is filled in with a stream
        connected to pty that can read output and write input.
     :input -
        Either T, NIL, a pathname, a stream, or :STREAM.  If T, the standard
        input for the current process is inherited.  If NIL, /dev/null
        is used.  If a pathname, the file so specified is used.  If a stream,
        all the input is read from that stream and send to the subprocess.  If
        :STREAM, the PROCESS-INPUT slot is filled in with a stream that sends 
        its output to the process. Defaults to NIL.
     :if-input-does-not-exist (when :input is the name of a file) -
        can be one of:
           :error - generate an error.
           :create - create an empty file.
           nil (default) - return nil from run-program.
     :output -
        Either T, NIL, a pathname, a stream, or :STREAM.  If T, the standard
        output for the current process is inherited.  If NIL, /dev/null
        is used.  If a pathname, the file so specified is used.  If a stream,
        all the output from the process is written to this stream. If
        :STREAM, the PROCESS-OUTPUT slot is filled in with a stream that can
        be read to get the output. Defaults to NIL.
     :if-output-exists (when :input is the name of a file) -
        can be one of:
           :error (default) - generates an error if the file already exists.
           :supersede - output from the program supersedes the file.
           :append - output from the program is appended to the file.
           nil - run-program returns nil without doing anything.
     :error and :if-error-exists - 
        Same as :output and :if-output-exists, except that :error can also be
        specified as :output in which case all error output is routed to the
        same place as normal output.
     :status-hook -
        This is a function the system calls whenever the status of the
        process changes.  The function takes the process as an argument.
Its defined argument types are:
  (T T &KEY (:ENV T) (:WAIT T) (:PTY T) (:INPUT T) (:IF-INPUT-DOES-NOT-EXIST T)
   (:OUTPUT T) (:IF-OUTPUT-EXISTS T) (:ERROR T) (:IF-ERROR-EXISTS T)
   (:STATUS-HOOK T))
Its result type is:
  (OR EXTENSIONS::PROCESS NULL)
On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from:
target:code/run-program.lisp
  Created: Saturday, 6/20/98 07:13:08 pm [-1]
  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.1 2006/12/31 13:11:44 dlichteblau Exp $
||#

;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))

(defun glisp:run-unix-shell-command (command)
  (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))


;;; MP

(export 'glisp::mp/process-yield :glisp)
(export 'glisp::mp/process-wait :glisp)
(export 'glisp::mp/process-run-function :glisp)
(export 'glisp::mp/make-lock :glisp)
(export 'glisp::mp/current-process :glisp)
(export 'glisp::mp/process-kill :glisp)

(defun glisp::mp/make-lock (&key name)
  (pthread::make-lock name))

(defmacro glisp::mp/with-lock ((lock) &body body)
  `(pthread::with-lock-held (,lock)
     , at body))

(defun glisp::mp/process-yield (&optional process-to-run)
  (declare (ignore process-to-run))
  (PTHREAD:SCHED-YIELD))

(defun glisp::mp/process-wait (whostate predicate)
  (do ()
      ((funcall predicate))
    (sleep .1)))

(defun glisp::mp/process-run-function (name fun &rest args)
  (pthread::thread-create
   (lambda ()
     (apply fun args))
   :name name))

(defun glisp::mp/current-process ()
  'blah)

(defun glisp::mp/process-kill (process)
  (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL."))

(defun glisp::getenv (string)
  (cdr (assoc string ext:*environment-list* :test #'string-equal)))



From dlichteblau at common-lisp.net  Sun Dec 31 13:24:49 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 08:24:49 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/parse
Message-ID: <20061231132449.F1ABA54125@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/parse
In directory clnet:/tmp/cvs-serv18356

Modified Files:
	pt.lisp 
Log Message:
rune fixes


--- /project/closure/cvsroot/closure/src/parse/pt.lisp	2005/03/13 18:02:40	1.4
+++ /project/closure/cvsroot/closure/src/parse/pt.lisp	2006/12/31 13:24:49	1.5
@@ -150,7 +150,13 @@
 
 (defun ppt (pt &optional (prefix "") (barp nil))
   (cond ((eq (pt-name pt) :pcdata)
-         (let ((s (map 'string #'(lambda (x) (if (eql x 10) #\space (code-char x))) (progn (pt-attrs pt)))) flag)
+         (let ((s (map 'string
+		    #'(lambda (x)
+			(if (eql x #/U+000a)
+			    #\space
+			    (rune-char x)))
+		    (progn (pt-attrs pt))))
+	       flag)
            (if (and (> (- 120 (length prefix)) 0)
                     (> (length s) (- 120 (length prefix))))
                (setq s (concatenate 'string (subseq s 0 (- 120 (length prefix))))
@@ -188,7 +194,7 @@
            value)
           (t
            (warn "~S: prop=~S." 'pt-attr prop)
-           (map 'string (lambda (x) (or (code-char x) #\?)) value)))))
+           (map 'string (lambda (x) (or (rune-char x) #\?)) value)))))
 
 (defun (setf pt-attr) (value pt prop)
   (setf (getf (pt-attrs pt) prop) value))
@@ -216,7 +222,7 @@
   (cond ((typep tree 'rod)
          (sgml::make-pt :name :pcdata :attrs tree))
         ((stringp tree)
-         (sgml::make-pt :name :pcdata :attrs (map '(vector (unsigned-byte 16)) #'char-code tree)))
+         (sgml::make-pt :name :pcdata :attrs (string-rod tree)))
         ((sgml::pt-p tree) tree)
         ((and (consp tree) (keywordp (car tree)))
          (let ((attrs nil)



From emarsden at common-lisp.net  Sun Dec 31 13:26:23 2006
From: emarsden at common-lisp.net (emarsden)
Date: Sun, 31 Dec 2006 08:26:23 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061231132623.F384054125@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv18515/src/gui

Modified Files:
	clim-gui.lisp 
Log Message:
- add basic wholine support (currently title & last-modified information)
- add "TeX mode On" and "TeX mode Off" commands (experimental)


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/30 15:13:54	1.25
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/31 13:26:23	1.26
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.25 2006/12/30 15:13:54 emarsden Exp $
+;;;       $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,10 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.26  2006/12/31 13:26:23  emarsden
+;; - add basic wholine support (currently title & last-modified information)
+;; - add "TeX mode On" and "TeX mode Off" commands (experimental)
+;;
 ;; Revision 1.25  2006/12/30 15:13:54  emarsden
 ;; - use CL from Closure packages
 ;; - minor rod fixes
@@ -183,7 +187,7 @@
     :height 20
     :min-height 20
     :max-height 20
-    :width 200
+    :width 300
     :background +black+
     :foreground +white+)
    (interactor
@@ -536,6 +540,13 @@
   (write-string string (find-pane-named *frame* 'status))
   (clim-backend:port-force-output (find-port)))
 
+(defun write-wholine (string)
+  (let ((wholine (find-pane-named *frame* 'wholine)))
+    (window-clear wholine)
+    (write-string string wholine)
+    (clim-backend:port-force-output (find-port))))
+
+
 (defun foo (url)
   (let ((*standard-output* *trace-output*))
     (clim-sys:make-process
@@ -553,8 +564,7 @@
                    (write-status "Fetching Document ...")
                    (let* ((doc (make-instance 'r2::document
                                               :processes-hooks nil
-                                              :location
-                                              (r2::parse-url* url)
+                                              :location (r2::parse-url* url)
                                               :http-header header
                                               :pt (clue-gui2::make-pt-from-input 
                                                    io 
@@ -576,6 +586,10 @@
                         600           ;xxx width
                         t             ;?
                         0)
+                       (write-wholine (format nil "Title: ~A~%~@[Modified: ~A~]"
+                                              (renderer::document-title *current-document*)
+                                              (or (netlib::get-header-field header :last-modified)
+                                                  (netlib::get-header-field header :date))))
                        (let ((x2 (bounding-rectangle-max-x (stream-output-history *pane*)))
                              (y2 (bounding-rectangle-max-y (stream-output-history *pane*))))
                          (setf y2 (max y2 r2::*document-height*))
@@ -600,7 +614,7 @@
              (let ((closure-protocol:*document-language*
                     (if (sgml::pt-p (r2::document-pt *current-document*))
                         (make-instance 'r2::html-4.0-document-language)
-                        (make-instance 'r2::xml-style-document-language) ))
+                        (make-instance 'r2::xml-style-document-language)))
                    (closure-protocol:*user-agent* nil)
                    (r2::*canvas-width*
                     (bounding-rectangle-width (sheet-parent *pane*))))
@@ -675,3 +689,15 @@
     (handle-repaint *pane* (sheet-region (pane-viewport *pane*))))
   (clim-backend:port-force-output (find-port)))
 
+(define-closure-command (com-tex-mode-on :name t) ()
+  (setq renderer:*tex-mode-p* t)
+  (setq renderer:*hyphenate-p* t)
+  (send-closure-command 'com-reflow))
+
+(define-closure-command (com-tex-mode-off :name t) ()
+  (setq renderer:*tex-mode-p* nil)
+  (setq renderer:*hyphenate-p* nil)
+  (send-closure-command 'com-reflow))
+
+
+;; EOF



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:40 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:40 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061231154240.4908B2D01D@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv11810

Modified Files:
	INSTALL closure.asd 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/INSTALL	2006/12/29 22:09:37	1.4
+++ /project/closure/cvsroot/closure/INSTALL	2006/12/31 15:42:40	1.5
@@ -17,10 +17,11 @@
 
     [Debian package gif2png]
 
- 4. McCLIM, Closure XML, and their dependencies
+ 4. McCLIM, Closure XML, Bordeaux Threads, and their dependencies
 
     [ http://common-lisp.net/project/mcclim/
-      http://common-lisp.net/project/cxml/ ]
+      http://common-lisp.net/project/cxml/
+      http://common-lisp.net/project/bordeaux-threads/ ]
 
 
 Compile closure using ASDF: Register closure.asd in your central
--- /project/closure/cvsroot/closure/closure.asd	2006/12/31 13:11:44	1.11
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/31 15:42:40	1.12
@@ -86,7 +86,8 @@
 (asdf:defsystem closure
     :depends-on (:clim
                  :clim-clx
-                 :glisp)
+                 :glisp
+		 :bordeaux-threads)
     :default-component-class closure-source-file
     :components
     ((:module src



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:40 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:40 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/glisp
Message-ID: <20061231154240.98F9D2E1BC@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv11810/src/glisp

Modified Files:
	dep-acl.lisp dep-clisp.lisp dep-cmucl.lisp dep-gcl.lisp 
	dep-openmcl.lisp dep-sbcl.lisp dep-scl.lisp package.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp	2006/12/31 12:14:36	1.3
+++ /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp	2006/12/31 15:42:40	1.4
@@ -29,14 +29,6 @@
 (export 'glisp::read-byte-sequence :glisp)
 (export 'glisp::read-char-sequence :glisp)
 (export 'glisp::run-unix-shell-command :glisp)
-(export 'glisp::mp/process-run-function :glisp)
-(export 'glisp::mp/process-kill :glisp)
-(export 'glisp::mp/seize-lock :glisp)
-(export 'glisp::mp/release-lock :glisp)
-(export 'glisp::mp/transfer-lock-owner :glisp)
-(export 'glisp::mp/current-process :glisp)
-(export 'glisp::mp/process-yield :glisp)
-(export 'glisp::mp/process-wait :glisp)
 (export 'glisp::getenv :glisp)
 
 (defun glisp::read-byte-sequence (&rest ap)
@@ -67,13 +59,6 @@
 )
 ||#
 
-(defun glisp::mp/make-lock (&key name)
-  (mp:make-process-lock :name name))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(mp:with-process-lock (,lock)
-     , at body))
-
 (defmacro glisp::with-timeout ((&rest options) &body body)
   `(mp:with-timeout ,options . ,body))
 
@@ -83,32 +68,5 @@
 (defun glisp:run-unix-shell-command (cmd)
   (excl:shell cmd))
 
-(defun glisp:mp/process-run-function (name fn &rest args)
-  (apply #'mp:process-run-function name fn args))
-
-(defun glisp:mp/process-kill (proc)
-  (mp:process-kill proc))
-
-(defun glisp:mp/current-process ()
-  sys:*current-process*)
-
-(defun glisp::mp/seize-lock (lock &key whostate)
-  whostate
-  (mp:process-lock lock))
-
-(defun glisp::mp/transfer-lock-owner (lock old-process new-process)
-  (assert (eql (mp:process-lock-locker lock) old-process))
-  (setf (mp:process-lock-locker lock) new-process)
-  )
-
-(defun glisp::mp/release-lock (lock)
-  (mp:process-unlock lock))
-
-(defun glisp::mp/process-yield (&optional process-to-run)
-  (mp:process-allow-schedule process-to-run))
-
-(defun glisp::mp/process-wait (whostate predicate)
-  (mp:process-wait whostate predicate))
-
 (defun glisp::getenv (string)
   (sys:getenv string))
--- /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp	2006/12/31 12:14:36	1.3
+++ /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp	2006/12/31 15:42:40	1.4
@@ -123,54 +123,3 @@
 (export 'glisp::getenv :glisp)
 (defun glisp::getenv (var)
   (sys::getenv var))
-
-
-
-(export 'glisp::mp/process-run-function :glisp)
-(defun glisp:mp/process-run-function (name fn &rest args)
-  (apply #'mp:process-run-function name fn args))
-
-(export 'glisp::mp/process-kill :glisp)
-(defun glisp:mp/process-kill (proc)
-  (mp:process-kill proc))
-
-(export 'glisp::mp/current-process :glisp)
-(defun glisp:mp/current-process ()
-  (mp:current-process))
-
-(export 'glisp::mp/seize-lock :glisp)
-(defun glisp::mp/seize-lock (lock &key whostate)
-  whostate
-  (mp:process-lock lock))
-
-(export 'glisp::mp/release-lock :glisp)
-(defun glisp::mp/release-lock (lock)
-  (mp:process-unlock lock))
-
-(export 'glisp::mp/process-yield :glisp)
-(defun glisp::mp/process-yield (&optional process-to-run)
-  process-to-run
-  (mp:process-allow-schedule))
-
-(export 'glisp::mp/process-wait :glisp)
-(defun glisp::mp/process-wait (whostate predicate)
-  (mp::process-wait whostate predicate))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(mp:with-process-lock (,lock)
-     , at body))
-
-(defun glisp::mp/make-lock (&key name)
-  (mp:make-process-lock :name name))
-
-
-
-
-
-
-
-
-
-
-
-
--- /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp	2006/12/31 12:14:36	1.3
+++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp	2006/12/31 15:42:40	1.4
@@ -192,7 +192,7 @@
 On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from:
 target:code/run-program.lisp
   Created: Saturday, 6/20/98 07:13:08 pm [-1]
-  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $
+  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.4 2006/12/31 15:42:40 dlichteblau Exp $
 ||#
 
 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
@@ -200,41 +200,5 @@
 (defun glisp:run-unix-shell-command (command)
   (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
 
-;;; MP
-
-(export 'glisp::mp/process-yield :glisp)
-(export 'glisp::mp/process-wait :glisp)
-(export 'glisp::mp/process-run-function :glisp)
-(export 'glisp::mp/make-lock :glisp)
-(export 'glisp::mp/current-process :glisp)
-(export 'glisp::mp/process-kill :glisp)
-
-(defun glisp::mp/make-lock (&key name)
-  (mp:make-lock name))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(mp:with-lock-held (,lock)
-     , at body))
-
-(defun glisp::mp/process-yield (&optional process-to-run)
-  (declare (ignore process-to-run))
-  (mp:process-yield))
-
-(defun glisp::mp/process-wait (whostate predicate)
-  (mp:process-wait whostate predicate))
-
-(defun glisp::mp/process-run-function (name fun &rest args)
-  (mp:make-process
-   (lambda ()
-     (apply fun args))
-   :name name))
-
-(defun glisp::mp/current-process ()
-  mp:*current-process*)
-
-(defun glisp::mp/process-kill (process)
-  (mp:destroy-process process))
-
 (defun glisp::getenv (string)
   (cdr (assoc string ext:*environment-list* :test #'string-equal)))
-
--- /project/closure/cvsroot/closure/src/glisp/dep-gcl.lisp	2005/03/13 18:01:15	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-gcl.lisp	2006/12/31 15:42:40	1.3
@@ -100,15 +100,6 @@
               index)
     value))
 
-(defun glisp::mp/make-lock (&key name)
-  name
-  nil)
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  (declare (ignore lock))
-  `(progn
-     , at body))
-
 (defmacro glisp::with-timeout ((&rest ignore) &body body)
   (declare (ignore ignore))
   `(progn
--- /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp	2006/12/31 12:14:36	1.2
+++ /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp	2006/12/31 15:42:40	1.3
@@ -145,41 +145,6 @@
    (ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil
 		       :output nil))))
 
-;;; MP
-
-(export 'glisp::mp/process-yield :glisp)
-(export 'glisp::mp/process-wait :glisp)
-(export 'glisp::mp/process-run-function :glisp)
-(export 'glisp::mp/make-lock :glisp)
-(export 'glisp::mp/current-process :glisp)
-(export 'glisp::mp/process-kill :glisp)
-
-(defun glisp::mp/make-lock (&key name)
-  (clim-sys::make-lock name))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(clim-sys:with-lock-held (,lock)
-    , at body))
-
-(defun glisp::mp/process-yield (&optional process-to-run)
-  (declare (ignore process-to-run))
-  (clim-sys:process-yield))
-
-(defun glisp::mp/process-wait (whostate predicate)
-  (clim-sys:process-wait whostate predicate))
-
-(defun glisp::mp/process-run-function (name fun &rest args)
-  (clim-sys:make-process
-   (lambda ()
-     (apply fun args))
-   :name name))
-
-(defun glisp::mp/current-process ()
-  (clim-sys:current-process))
-
-(defun glisp::mp/process-kill (process)
-  (clim-sys:destroy-process process))
-
 (defun glisp::getenv (string)
   (ccl::getenv string))
 
\ No newline at end of file
--- /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2006/12/31 12:14:36	1.4
+++ /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp	2006/12/31 15:42:40	1.5
@@ -100,41 +100,5 @@
    (sb-ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil
 		       :output nil)))
 
-;;; MP
-
-(export 'glisp::mp/process-yield :glisp)
-(export 'glisp::mp/process-wait :glisp)
-(export 'glisp::mp/process-run-function :glisp)
-(export 'glisp::mp/make-lock :glisp)
-(export 'glisp::mp/current-process :glisp)
-(export 'glisp::mp/process-kill :glisp)
-
-(defun glisp::mp/make-lock (&key name)
-  (clim-sys::make-lock name))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(clim-sys:with-lock-held (,lock)
-    , at body))
-
-(defun glisp::mp/process-yield (&optional process-to-run)
-  (declare (ignore process-to-run))
-  (clim-sys:process-yield))
-
-(defun glisp::mp/process-wait (whostate predicate)
-  (clim-sys:process-wait whostate predicate))
-
-(defun glisp::mp/process-run-function (name fun &rest args)
-  (clim-sys:make-process
-   (lambda ()
-     (apply fun args))
-   :name name))
-
-(defun glisp::mp/current-process ()
-  (clim-sys:current-process))
-
-(defun glisp::mp/process-kill (process)
-  (clim-sys:destroy-process process))
-
 (defun glisp::getenv (string)
   (sb-ext:posix-getenv string))
-
--- /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp	2006/12/31 13:11:44	1.1
+++ /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp	2006/12/31 15:42:40	1.2
@@ -161,7 +161,7 @@
 On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from:
 target:code/run-program.lisp
   Created: Saturday, 6/20/98 07:13:08 pm [-1]
-  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.1 2006/12/31 13:11:44 dlichteblau Exp $
+  Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.2 2006/12/31 15:42:40 dlichteblau Exp $
 ||#
 
 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
@@ -172,41 +172,5 @@
 
 ;;; MP
 
-(export 'glisp::mp/process-yield :glisp)
-(export 'glisp::mp/process-wait :glisp)
-(export 'glisp::mp/process-run-function :glisp)
-(export 'glisp::mp/make-lock :glisp)
-(export 'glisp::mp/current-process :glisp)
-(export 'glisp::mp/process-kill :glisp)
-
-(defun glisp::mp/make-lock (&key name)
-  (pthread::make-lock name))
-
-(defmacro glisp::mp/with-lock ((lock) &body body)
-  `(pthread::with-lock-held (,lock)
-     , at body))
-
-(defun glisp::mp/process-yield (&optional process-to-run)
-  (declare (ignore process-to-run))
-  (PTHREAD:SCHED-YIELD))
-
-(defun glisp::mp/process-wait (whostate predicate)
-  (do ()
-      ((funcall predicate))
-    (sleep .1)))
-
-(defun glisp::mp/process-run-function (name fun &rest args)
-  (pthread::thread-create
-   (lambda ()
-     (apply fun args))
-   :name name))
-
-(defun glisp::mp/current-process ()
-  'blah)
-
-(defun glisp::mp/process-kill (process)
-  (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL."))
-
 (defun glisp::getenv (string)
   (cdr (assoc string ext:*environment-list* :test #'string-equal)))
-
--- /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/31 12:35:18	1.7
+++ /project/closure/cvsroot/closure/src/glisp/package.lisp	2006/12/31 15:42:40	1.8
@@ -32,8 +32,6 @@
   (:use :cl)
   (:export "DEFSUBST"
 	   "G/MAKE-STRING"
-	   "MP/MAKE-LOCK"
-	   "MP/WITH-LOCK"
 	   "WITH-TIMEOUT"
 	   "OPEN-INET-SOCKET"
 	   ;; util.lisp :



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:40 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:40 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20061231154240.D79CC2E1BD@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv11810/src/gui

Modified Files:
	clim-gui.lisp clue-gui.lisp dce-and-pce.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/31 13:26:23	1.26
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/31 15:42:40	1.27
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 emarsden Exp $
+;;;       $Id: clim-gui.lisp,v 1.27 2006/12/31 15:42:40 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,14 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.27  2006/12/31 15:42:40  dlichteblau
+;; Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
+;; Closure don't have to depend on CLIM anymore.
+;;
+;;   - Removed all mp/ functions from glisp.
+;;
+;;   - Use condition variables instead of process-wait.
+;;
 ;; Revision 1.26  2006/12/31 13:26:23  emarsden
 ;; - add basic wholine support (currently title & last-modified information)
 ;; - add "TeX mode On" and "TeX mode Off" commands (experimental)
@@ -445,7 +453,7 @@
 
 (defmacro with-closure (ignore &body body)
   (declare (ignore ignore))
-  `(clim-sys:with-lock-held (*closure-lock*)
+  `(clim-sys:with-recursive-lock-held (*closure-lock*)
     , at body))
 
 (defun parse-url* (url)
--- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 11:48:18	1.5
+++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 15:42:40	1.6
@@ -41,7 +41,7 @@
 (in-package :clue-gui2)
 
 (defparameter *dcache* nil)
-(defparameter *dcache-lock* (mp/make-lock :name "dcache"))
+(defparameter *dcache-lock* (bordeaux-threads:make-lock "dcache"))
 
 (defparameter *pixmap-cache*
     nil)
--- /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2005/03/13 18:01:37	1.3
+++ /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2006/12/31 15:42:40	1.4
@@ -47,27 +47,28 @@
                             &key lazy-p callback)
   (let ((url (if (url:url-p url) (url:unparse-url url) url)))
     (let* ((dce
-            (mp/with-lock (*dcache-lock*)
+            (bordeaux-threads:with-recursive-lock-held (*dcache-lock*)
               (or
                (find-if (lambda (el)
                           (and (equal (dce-url el) url)
                                (eq (dce-presentation el) presentation)))
                         *dcache*)
-               (let ((new-dce (make-dce :url url
-                                        :presentation presentation
-                                        :data :work-in-progress
-                                        :lock (mp/make-lock :name "dce lock")))
-                     (flag nil))
-                 (r2::run-process-on-behalf-of-document
-                  document
-                  (lambda ()
-                    (mp/with-lock ((dce-lock new-dce))
-                      (setf flag t)
-                      (setf (dce-data new-dce)
-                            (dcache-generate-presentation presentation document url)) )))
-                 (mp/process-wait "foo"
-                                  (lambda () flag))
-                 (push new-dce *dcache*)
+               (let* ((lock (bordeaux-threads:make-lock "dce lock"))
+		      (new-dce (make-dce :url url
+					 :presentation presentation
+					 :data :work-in-progress
+					 :lock lock))
+		      (flag (bordeaux-threads:make-condition-variable)))
+                 (bordeaux-threads:with-recursive-lock-held (lock)
+		   (r2::run-process-on-behalf-of-document
+		    document
+		    (lambda ()
+		      (bordeaux-threads:with-recursive-lock-held (lock)
+			(bordeaux-threads:condition-notify flag)
+			(setf (dce-data new-dce)
+			      (dcache-generate-presentation presentation document url)) )))
+		   (bordeaux-threads:condition-wait flag lock)
+		   (push new-dce *dcache*))
                  new-dce)))))
       (if lazy-p
           (progn
@@ -75,10 +76,10 @@
              document
              (lambda ()
                (funcall callback
-                        (mp/with-lock ((dce-lock dce))
+                        (bordeaux-threads:with-recursive-lock-held ((dce-lock dce))
                           (dce-data dce)))))
             nil)
-          (mp/with-lock ((dce-lock dce))
+          (bordeaux-threads:with-recursive-lock-held ((dce-lock dce))
             (dce-data dce)) ))))
 
 (defmethod dcache-generate-presentation ((presentation (eql :aimage)) document url)



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:41 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:41 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/html
Message-ID: <20061231154241.15F7F2E1BD@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/html
In directory clnet:/tmp/cvs-serv11810/src/html

Modified Files:
	html-style.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/html/html-style.lisp	2006/12/31 12:05:33	1.9
+++ /project/closure/cvsroot/closure/src/html/html-style.lisp	2006/12/31 15:42:41	1.10
@@ -378,13 +378,13 @@
     (make-hash-table :test #'equalp))
 
 (defparameter *style-sheet-cache*/lock
-    (mp/make-lock :name "*style-sheet-cache*"))
+    (bordeaux-threads:make-lock "*style-sheet-cache*"))
 
 (defun maybe-parse-style-sheet-from-url (url &key (name "anonymous") 
                                                   (supersheet nil)
                                                   (media-type :all))
   (multiple-value-bind (looked presentp)
-      (mp/with-lock (*style-sheet-cache*/lock)
+      (bordeaux-threads:with-recursive-lock-held (*style-sheet-cache*/lock)
           (gethash url *style-sheet-cache*))
     (cond (presentp
            (format *debug-io* "~&;; Serving style sheet ~S [at ~S] from cache.~%"
@@ -398,7 +398,7 @@
                        :name name 
                        :supersheet supersheet
                        :media-type media-type)))
-             (mp/with-lock (*style-sheet-cache*/lock)
+             (bordeaux-threads:with-recursive-lock-held (*style-sheet-cache*/lock)
                 (setf (gethash url *style-sheet-cache*) res))
              res)))))
 



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:41 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:41 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/net
Message-ID: <20061231154241.515ED2E1BC@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/net
In directory clnet:/tmp/cvs-serv11810/src/net

Modified Files:
	ftp.lisp http.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/net/ftp.lisp	2005/03/13 18:02:19	1.2
+++ /project/closure/cvsroot/closure/src/net/ftp.lisp	2006/12/31 15:42:41	1.3
@@ -683,11 +683,11 @@
 ||#
 
 (defvar *connection-pool* nil)
-(defvar *connection-pool-lock* (mp/make-lock :name "FTP connections pool lock"))
+(defvar *connection-pool-lock* (bordeaux-threads:make-lock "FTP connections pool lock"))
 
 (defmacro with-ftp-connection-pool (dummy &body body)
   dummy
-  `(mp/with-lock (*connection-pool-lock*)
+  `(bordeaux-threads:with-recursive-lock-held (*connection-pool-lock*)
      , at body))
 
 (defun put-ftp-connection-into-pool (connection)
--- /project/closure/cvsroot/closure/src/net/http.lisp	2006/11/06 19:41:56	1.9
+++ /project/closure/cvsroot/closure/src/net/http.lisp	2006/12/31 15:42:41	1.10
@@ -414,7 +414,7 @@
     (cond ((probe-file fn)
            (with-open-file (stream fn :direction :input)
              (let ((*package* (symbol-package 'http-cache-entry)))
-               (let ((res (make-http-cache :lock (mp/make-lock :name "HTTP cache lock")
+               (let ((res (make-http-cache :lock (bordeaux-threads:make-lock "HTTP cache lock")
                                            :directory directory
                                            :entries (make-hash-table :test #'equal))))
                  (setf (http-cache-serial res) (read stream))
@@ -424,13 +424,13 @@
                    (put-hce res x))
                  res))))
           (t
-           (make-http-cache :lock (mp/make-lock :name "HTTP cache lock")
+           (make-http-cache :lock (bordeaux-threads:make-lock "HTTP cache lock")
                             :directory directory
                             :entries (make-hash-table :test #'equal)
                             :serial 0)) )))
 
 (defun commit-cache (&optional (cache (http-cache)))
-  (mp/with-lock ((http-cache-lock cache))
+  (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache))
     (with-open-file (sink (merge-pathnames "index" (http-cache-directory cache))
                      :direction :output :if-exists :new-version)
       (let ((*print-pretty* nil)
@@ -443,15 +443,15 @@
                  (http-cache-entries cache)) ))) )
 
 (defun invent-cache-filename (cache)
-  (mp/with-lock ((http-cache-lock cache))
+  (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache))
     (format nil "~5,'0D" (incf (http-cache-serial cache)))))
 
 (defun get-hce (cache url)
-  (mp/with-lock ((http-cache-lock cache))
+  (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache))
     (gethash url (http-cache-entries cache))))
 
 (defun put-hce (cache hce)
-  (mp/with-lock ((http-cache-lock cache))
+  (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache))
     ;; if there was already an entry for that URL with under a different filename,
     ;; delete the old file
     (let ((old-ce (gethash (hce-url hce) (http-cache-entries cache))))



From dlichteblau at common-lisp.net  Sun Dec 31 15:42:41 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:42:41 -0500 (EST)
Subject: [closure-cvs] CVS closure/src/renderer
Message-ID: <20061231154241.DE3C92F04B@common-lisp.net>

Update of /project/closure/cvsroot/closure/src/renderer
In directory clnet:/tmp/cvs-serv11810/src/renderer

Modified Files:
	document.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/renderer/document.lisp	2005/07/19 20:42:09	1.5
+++ /project/closure/cvsroot/closure/src/renderer/document.lisp	2006/12/31 15:42:41	1.6
@@ -39,8 +39,10 @@
 
    ;; list of all processes working for this document
    (processes      :initform nil :accessor document-processes)
-   (processes/lock :initform (mp/make-lock :name "doc-proc-list Lock")
+   (processes/lock :initform (bordeaux-threads:make-lock "doc-proc-list Lock")
                    :accessor document-processes/lock) ;this needs a lock
+   (processes/cv :initform (bordeaux-threads:make-condition-variable)
+		 :accessor document-processes/cv)
    (processes-hooks
     ;; a list of hooks to call when ever the value of processes changes.
     :initform nil
@@ -89,33 +91,44 @@
   ;; Runs a process on behalf of a document, `continuation' is the
   ;; function to be run within the new process.
   ;; Returns the new process created.
-  (mp/with-lock ((document-processes/lock document))
+  (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document))
     (let (new-process)
       (setf new-process
-        (mp/process-run-function
-         name
+        (bordeaux-threads:make-thread
          ;; << child
          (lambda ()
-           (unwind-protect
-               (funcall continuation)
-             ;; remove myself from the list of processes
-             (progn
-               (mp/with-lock ((document-processes/lock document))
-                 (setf (document-processes document)
-                   (delete new-process (document-processes document)))) )))
+           (catch 'quit-dce-process
+	     (unwind-protect
+		 (funcall continuation)
+	       ;; remove myself from the list of processes
+	       (progn
+		 (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document))
+		   (setf (document-processes document)
+			 (delete new-process (document-processes document)))
+		   (bordeaux-threads:condition-notify
+		    (document-processes/cv document)))))))
          ;; >>
-         ))
+	 :name name))
       ;; add new process to list of process
       (push new-process (document-processes document))
       new-process)))
             
+;; bordeaux-threads says that kill-thread might not unwind cleanly.
+;; Let's use interrupt-thread then.
+(defun kill-dce-thread (thread)
+  (bordeaux-threads:interrupt-thread
+   thread
+   (lambda () (throw 'quit-dce-process nil))))
+
 (defun kill-all-document-processes (document)
   (setf (document-dead-p document) t)
-  (mp/with-lock ((document-processes/lock document))
-    (mapc #'mp/process-kill (document-processes document)))
-  (mp/process-wait "Waiting for documents processes dying."
-                   (lambda ()
-                     (null (document-processes document))))
+  (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document))
+    (mapc #'kill-dce-thread (document-processes document)))
+  (loop
+    (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document))
+      (unless (document-processes document)
+	(return))
+      (bordeaux-threads:condition-wait (document-processes/cv document))))
   (values))
 
 (defstruct image-entry



From dlichteblau at common-lisp.net  Sun Dec 31 15:45:30 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 31 Dec 2006 10:45:30 -0500 (EST)
Subject: [closure-cvs] CVS closure
Message-ID: <20061231154530.94C3E60038@common-lisp.net>

Update of /project/closure/cvsroot/closure
In directory clnet:/tmp/cvs-serv12757

Modified Files:
	closure.asd 
Log Message:

"so that non-GUI parts of Closure don't have to depend on CLIM anymore"

... make it so.


--- /project/closure/cvsroot/closure/closure.asd	2006/12/31 15:42:40	1.12
+++ /project/closure/cvsroot/closure/closure.asd	2006/12/31 15:45:30	1.13
@@ -60,8 +60,7 @@
 			       (make-pathname :name nil :type nil
 					      :defaults *load-truename*))
     :default-component-class closure-source-file
-    :depends-on (:cxml :mcclim
-		       ;; uncomment this if we actually need gray streams:
+    :depends-on (:cxml ;; uncomment this if we actually need gray streams:
 		       ;; :trivial-gray-streams
 		       #+sbcl :sb-bsd-sockets)
     :components