From thenriksen at common-lisp.net  Wed Jan  2 08:54:12 2008
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 02 Jan 2008 08:54:12 -0000
Subject: [closure-cvs] CVS closure/src
Message-ID: <20080102085412.208736A1BC@common-lisp.net>

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

Modified Files:
	defpack.lisp 
Log Message:
Created a new package, CLIM-GUI instead of putting everything in
CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
package prefixes would also be a good idea.


--- /project/closure/cvsroot/closure/src/defpack.lisp	2007/01/07 19:33:02	1.9
+++ /project/closure/cvsroot/closure/src/defpack.lisp	2008/01/02 08:54:11	1.10
@@ -195,6 +195,13 @@
    #:option-menu-option-group-children
    ))
 
+(defpackage :clim-gui
+  (:use :clim-lisp :clim)
+  (:export
+   #:*medium*
+   #:*frame*
+   #:*pane*
+   #:url))
 
 (defpackage :gtk-gui (:use :cl :glisp :runes))
 



From thenriksen at common-lisp.net  Wed Jan  2 08:54:12 2008
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 02 Jan 2008 08:54:12 -0000
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20080102085412.57A1673238@common-lisp.net>

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

Modified Files:
	clim-gui.lisp 
Log Message:
Created a new package, CLIM-GUI instead of putting everything in
CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
package prefixes would also be a good idea.


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2007/11/21 23:47:24	1.34
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2008/01/02 08:54:12	1.35
@@ -1,10 +1,10 @@
-;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-USER; -*-
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-GUI; -*-
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: CLIM GUI
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.34 2007/11/21 23:47:24 dlichteblau Exp $
+;;;       $Id: clim-gui.lisp,v 1.35 2008/01/02 08:54:12 thenriksen 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.35  2008/01/02 08:54:12  thenriksen
+;; Created a new package, CLIM-GUI instead of putting everything in
+;; CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
+;; package prefixes would also be a good idea.
+;;
 ;; Revision 1.34  2007/11/21 23:47:24  dlichteblau
 ;; Renamed the command `Visit Url In New Tab' to just `Visit In New Tab' so that
 ;; plain `Visit Url' followed by SPC in the interactor works again.
@@ -176,14 +181,16 @@
 ;; imported sources
 ;;
 
-(in-package :CLIM-USER)
-(use-package :clim)
+(in-package :clim-gui)
 
 ;;;;;;;
 
-(defvar *medium*)
-(defvar *frame*)
-(defvar *pane*)
+(defvar *medium* nil
+  "The medium of the pane of the running Closure instance.")
+(defvar *frame* nil
+  "The frame of the running Closure instance.")
+(defvar *pane* nil
+  "The pane of the running Closure instance.")
 
 (defvar *initial-url* nil)
 
@@ -222,17 +229,6 @@
   ((tabs))
   (:menu-bar menubar-command-table)
   (:panes
-   (aux :application
-    :height 300
-    :width 300
-    :min-width 100
-    :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
     :text-style (make-text-style :sans-serif :roman :normal)
     :scroll-bar nil
@@ -254,9 +250,7 @@
     :height 25
     :text-style (make-text-style :sans-serif :roman 10)
     :foreground +white+
-    :background +black+)
-   ;;(menu-bar (climi::make-menu-bar 'menubar-command-table :height 25))
-   )
+    :background +black+))
   (:layouts
    (default
        (vertically ()
@@ -275,20 +269,7 @@
          (horizontally (:height 80 :min-height 80 :max-height 80)
            wholine
            2
-           (200 status))))
-   #+NIL
-   (hidden-listener
-       (vertically ()
-         menu-bar
-         (horizontally ()
-           (vertically ()
-	     (canvasly :height 600 :min-height 400)))
-         (horizontally ()
-           wholine
-           2
-           (200 status)))))
-  ;; (:top-level (closure-frame-top-level . nil))
-  )
+           (200 status))))))
 
 
 (make-command-table 'menubar-command-table



From thenriksen at common-lisp.net  Wed Jan  2 08:54:12 2008
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 02 Jan 2008 08:54:12 -0000
Subject: [closure-cvs] CVS closure/src/renderer
Message-ID: <20080102085412.A6AA073238@common-lisp.net>

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

Modified Files:
	clim-draw.lisp renderer2.lisp tables.lisp 
Log Message:
Created a new package, CLIM-GUI instead of putting everything in
CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
package prefixes would also be a good idea.


--- /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2006/12/30 15:13:55	1.6
+++ /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp	2008/01/02 08:54:12	1.7
@@ -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.6 2006/12/30 15:13:55 emarsden Exp $
+;;;       $Id: clim-draw.lisp,v 1.7 2008/01/02 08:54:12 thenriksen Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -171,14 +171,14 @@
     (dolist (deco text-decoration)
       (case deco
         (:underline
-         (clim:draw-line* clim-user::*pane*
+         (clim:draw-line* clim-gui:*pane*
           xx1 (+ yy 2) xx (+ yy 2) :ink (ws/x11::parse-x11-color color)))
         (:overline
          ;; xxx hack
-         (clim:draw-line* clim-user::*pane*
+         (clim:draw-line* clim-gui:*pane*
           xx1 (- yy 12) xx (- yy 12) :ink (ws/x11::parse-x11-color color)))
         (:line-through
-         (clim:draw-line* clim-user::*pane*
+         (clim:draw-line* clim-gui:*pane*
           xx1 (- yy 6) xx (- yy 6) :ink (ws/x11::parse-x11-color color))) ))))
 
 ;;;; Runes
--- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2007/07/01 12:16:44	1.20
+++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp	2008/01/02 08:54:12	1.21
@@ -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.20 2007/07/01 12:16:44 dlichteblau Exp $
+;;;       $Id: renderer2.lisp,v 1.21 2008/01/02 08:54:12 thenriksen Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -450,8 +450,8 @@
                                                          (open-chunk-dy chunk))
                                                  )))
                                   (when (eql pass 1)
-                                    (clim:draw-text* clim-user::*pane* q x y))
-                                  (incf x (clim:text-size clim-user::*pane* q))))
+                                    (clim:draw-text* clim-gui:*pane* q x y))
+                                  (incf x (clim:text-size clim-gui:*pane* q))))
                               (push dy ys)
                               (setf dy (open-chunk-dy chunk))
                               (push (bounding-chunk-style chunk) ss)
@@ -466,10 +466,10 @@
                                 (let (p q res.text-seen-p)
                                   (cond (link
                                          (clim:with-output-as-presentation
-                                             (clim-user::*pane*
+                                             (clim-gui:*pane*
                                               (url:unparse-url
                                                (hyper-link-url (imap-area-link link)))
-                                              'clim-user::url
+                                              'clim-gui:url
                                               :record-type 'link-presentation)
                                            (setf (values p q res.text-seen-p)
                                                  (walk chunks))))
@@ -485,8 +485,8 @@
                                                      (chunk-debug-name q)
                                                      "")))
                                         (when (eql pass 1)
-                                          (clim:draw-text* clim-user::*pane* q x y))
-                                        (incf x (clim:text-size clim-user::*pane* q))
+                                          (clim:draw-text* clim-gui:*pane* q x y))
+                                        (incf x (clim:text-size clim-gui:*pane* q))
                                         )))
 
                                   (pop ss)
@@ -498,7 +498,7 @@
                                       ;; replaced objects are different to dimensions of regular
                                       ;; inline boxen.
                                       (cond (replaced-object-p
-                                             (draw-box-decoration clim-user::*pane*
+                                             (draw-box-decoration clim-gui:*pane*
                                                                      x1 (- (+ y dy) (open-chunk-height oc)
                                                                            (cooked-style-padding-top (bounding-chunk-style oc))
                                                                            (- (cooked-style-padding-top (bounding-chunk-style oc)))
@@ -514,7 +514,7 @@
                                                                      :right-halfp (not (bounding-chunk-halfp q))
                                                                      ))
                                             (t
-                                             (draw-box-decoration clim-user::*pane*
+                                             (draw-box-decoration clim-gui:*pane*
                                                                      x1 (- (+ y dy) (open-chunk-height oc)
                                                                            (cooked-style-padding-top (bounding-chunk-style oc)))
                                                                      x  (+ (+ y dy) (open-chunk-depth oc)
@@ -541,9 +541,9 @@
                             (setf text-seen-p t)
                             (when (and ss (car ss))
                               (when (eql pass 1)
-                                (setf (clim:medium-ink clim-user::*medium*)
+                                (setf (clim:medium-ink clim-gui:*medium*)
                                       (css-color-ink (cooked-style-color (black-chunk-style chunk))))
-                                (clim-draw-runes* clim-user::*pane*
+                                (clim-draw-runes* clim-gui:*pane*
                                                  x (+ dy y)
                                                  (black-chunk-data chunk)
                                                  0 (length (black-chunk-data chunk))
@@ -554,7 +554,7 @@
                             (let ((ro (replaced-object-chunk-object chunk)))
                               (when (eql pass 1)
                                 (closure/clim-device::draw-ro*
-                                 clim-user::*pane*
+                                 clim-gui:*pane*
                                  ro x (+ dy y)))
                               (incf x (chunk-width chunk))) )))))
                    ;;
@@ -1196,7 +1196,7 @@
 (defun format-block (item x1 x2 ss before-markers #||# pos-vertical-margin neg-vertical-margin yy)
   (let (res)
     (setf (block-box-output-record item)
-          (clim:with-new-output-record (clim-user::*pane*) #+nil foo
+          (clim:with-new-output-record (clim-gui:*pane*) #+nil foo
               (setf res
                     (multiple-value-list
                         (case (cooked-style-display (block-box-style item))
@@ -1236,7 +1236,7 @@
          (yy0 nil)      ;the inner top padding edge
                         ; NIL initially to indicate that we do not know it for now.
          (bg-record
-          (clim:with-new-output-record (clim-user::*pane*)
+          (clim:with-new-output-record (clim-gui:*pane*)
             )))
 
     ;; remember the output record of the decoration
@@ -1350,7 +1350,7 @@
                                         before-markers))))))
 
                  (setf (para-box-output-record item)
-                       (clim:with-new-output-record (clim-user::*pane*)
+                       (clim:with-new-output-record (clim-gui:*pane*)
                          (setf (values pos-vertical-margin neg-vertical-margin x1 x2 yy ss block-style)
                                (funcall (para-box-genesis item)))))
 
@@ -1461,9 +1461,9 @@
                 (minf neg-vertical-margin bm)))
 
           ;;
-          (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
+          (clim:with-output-recording-options (clim-gui:*pane* :record t :draw nil)
             (let ((new-record
-                   (clim:with-new-output-record (clim-user::*pane*)
+                   (clim:with-new-output-record (clim-gui:*pane*)
                      ;;
                      (multiple-value-bind (x1 y1 x2 y2)
                          (values (- x1 pl) (+ yy0
@@ -1472,7 +1472,7 @@
                                  (+ x2 pr) (- yy
                                               (cooked-style-border-bottom-width s)
                                               ))
-                       (draw-box-decoration clim-user::*pane* x1 y1 x2 y2 block-style)
+                       (draw-box-decoration clim-gui:*pane* x1 y1 x2 y2 block-style)
                        (incf y1 (cooked-style-padding-top s))
                        (decf y2 (cooked-style-padding-bottom s))
                        (when (realp (cooked-style-height s))
@@ -1481,7 +1481,7 @@
                            (error "Fubar")))
                        #+NIL
                        (unless (or (= x1 x2) (= y1 y2))
-                         (clim:draw-rectangle* clim-user::*pane* x1 y1 x2 y2
+                         (clim:draw-rectangle* clim-gui:*pane* x1 y1 x2 y2
                                                :ink clim:+red+
                                                :filled nil))
                        )
@@ -2033,7 +2033,7 @@
                       (values x1 (+ x1 actual-width))))))
 
 
-           (let ((bg-record (clim:with-new-output-record (clim-user::*pane*))))
+           (let ((bg-record (clim:with-new-output-record (clim-gui:*pane*))))
              (setf (table-decoration-output-record table) bg-record)
              (let ((yyy yy)
                    (dangling-cells nil)) ;a list of (rowspan total-rowspan cell) pairs of cells whose row span
@@ -2083,7 +2083,7 @@
                                        (unless (or (= x1 (+ x1 w))
                                                    (= yyy yy))
                                          #-NIL
-                                         (clim:draw-rectangle* clim-user::*pane*
+                                         (clim:draw-rectangle* clim-gui:*pane*
                                                                x1 yyy (+ x1 w) yy
                                                                :ink (elt *table-depth-color*
                                                                          (mod *table-depth* (length *table-depth-color*)))
@@ -2191,9 +2191,9 @@
                                   (clim:clear-output-record bg-record)
                                   (multiple-value-bind (xx1 xx2) (table-column-coordinates table column-widths ci (table-cell-colspan cell))
                                     (let ((new-record
-                                           (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
-                                             (clim:with-new-output-record (clim-user::*pane*)
-                                               (draw-box-decoration clim-user::*pane* (+ x1 xx1) y1 (+ x1 xx2) y2
+                                           (clim:with-output-recording-options (clim-gui:*pane* :record t :draw nil)
+                                             (clim:with-new-output-record (clim-gui:*pane*)
+                                               (draw-box-decoration clim-gui:*pane* (+ x1 xx1) y1 (+ x1 xx2) y2
                                                                        (block-box-style (table-cell-content cell)))))))
                                       (clim:delete-output-record new-record (clim:output-record-parent new-record))
                                       (clim:add-output-record new-record bg-record)))))))
@@ -2205,9 +2205,9 @@
                         (x1 x1)
                         (x2 x2))
                    (let ((new-record
-                          (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
-                            (clim:with-new-output-record (clim-user::*pane*)
-                              (draw-box-decoration clim-user::*pane* x1 y1 x2 y2
+                          (clim:with-output-recording-options (clim-gui:*pane* :record t :draw nil)
+                            (clim:with-new-output-record (clim-gui:*pane*)
+                              (draw-box-decoration clim-gui:*pane* x1 y1 x2 y2
                                                       (table-style table))))))
                      (clim:delete-output-record new-record (clim:output-record-parent new-record))
                      (clim:add-output-record new-record bg-record)))
@@ -2224,7 +2224,7 @@
                                    (multiple-value-bind (x1 x2) (table-column-coordinates table column-widths j)
                                      (let* (
                                             (y1 (+ yy (loop for k below i sum (elt row-heights k)))))
-                                       (clim:draw-line* clim-user::*pane*
+                                       (clim:draw-line* clim-gui:*pane*
                                                         x1 y1 x2 y1
                                                         :ink (ws/x11::parse-x11-color color)
                                                         :line-thickness width)))))))
@@ -2238,7 +2238,7 @@
                                    (let* ((y1 (+ yy (loop for k below i sum (elt row-heights k))))
                                           (y2 (+ y1 (elt row-heights i)))
                                           (x1 (+ x1 (loop for k below j sum (elt column-widths k)))))
-                                     (clim:draw-line* clim-user::*pane*
+                                     (clim:draw-line* clim-gui:*pane*
                                                       x1 y1 x1 y2
                                                       :ink (ws/x11::parse-x11-color color)
                                                       :line-thickness width)))))) )
@@ -4983,6 +4983,11 @@
 
 
 ;; $Log: renderer2.lisp,v $
+;; Revision 1.21  2008/01/02 08:54:12  thenriksen
+;; Created a new package, CLIM-GUI instead of putting everything in
+;; CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
+;; package prefixes would also be a good idea.
+;;
 ;; Revision 1.20  2007/07/01 12:16:44  dlichteblau
 ;; Patch by Christophe Rhodes on closure-devel <87ejk2sngi.fsf at cantab.net>
 ;;
--- /project/closure/cvsroot/closure/src/renderer/tables.lisp	2005/08/08 19:28:20	1.5
+++ /project/closure/cvsroot/closure/src/renderer/tables.lisp	2008/01/02 08:54:12	1.6
@@ -941,8 +941,8 @@
               (rc-first-line-tasks new-rc) nil
               (rc-left-floating-boxen new-rc) nil
               (rc-right-floating-boxen new-rc) nil)
-        (clim:with-new-output-record (clim-user::*pane* 'clim:standard-sequence-output-record record)
-         (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
+        (clim:with-new-output-record (clim-gui:*pane* 'clim:standard-sequence-output-record record)
+         (clim:with-output-recording-options (clim-gui:*pane* :record t :draw nil)
           (let* ((fake-parent (make-bbox))
                  (bbox (brender new-rc (cell-content cell) fake-parent)))
             (if bbox
@@ -1028,15 +1028,15 @@
 (defun render-table (rc pt parent-box)
   ;; Now, while we render a table, we unfortunatly have to disable
   ;; drawing.
-  (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
+  (clim:with-output-recording-options (clim-gui:*pane* :record t :draw nil)
    ;;; xxx not yet correct
-   (funcall (if t ;(clim:stream-drawing-p clim-user::*pane*)
+   (funcall (if t ;(clim:stream-drawing-p clim-gui:*pane*)
                 #'clim:replay-output-record
                 #'values)
-    (clim:with-new-output-record (clim-user::*pane*)
+    (clim:with-new-output-record (clim-gui:*pane*)
      ;; why does drawp nest proper?
      (render-table-2 rc pt parent-box))
-    clim-user::*pane* clim:+everywhere+ 0 0)))
+    clim-gui:*pane* clim:+everywhere+ 0 0)))
   
 (defun render-table-2 (rc pt parent-box)
   (let ((table (parse-table pt))



From thenriksen at common-lisp.net  Wed Jan  2 09:10:00 2008
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 02 Jan 2008 09:10:00 -0000
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20080102091000.240B0620C4@common-lisp.net>

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

Modified Files:
	clim-gui.lisp 
Log Message:
If we get an URI with no protocol specified, add http:// to it and
reparse. This allows (closure:visit "planet.lisp.org"), though still
not (closure:visit #u"planet.lisp.org").


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2008/01/02 08:54:12	1.35
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2008/01/02 09:10:00	1.36
@@ -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.35 2008/01/02 08:54:12 thenriksen Exp $
+;;;       $Id: clim-gui.lisp,v 1.36 2008/01/02 09:10:00 thenriksen 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.36  2008/01/02 09:10:00  thenriksen
+;; If we get an URI with no protocol specified, add http:// to it and
+;; reparse. This allows (closure:visit "planet.lisp.org"), though still
+;; not (closure:visit #u"planet.lisp.org").
+;;
 ;; Revision 1.35  2008/01/02 08:54:12  thenriksen
 ;; Created a new package, CLIM-GUI instead of putting everything in
 ;; CLIM-USER. Also removed some stale code from clim-gui.lisp. Perhaps
@@ -538,7 +543,11 @@
 
 (defun parse-url* (url)
   (etypecase url
-    (string (url:parse-url url))
+    (string
+     (let ((parsed-url (url:parse-url url)))
+       (if (url:url-protocol parsed-url)
+           parsed-url
+           (parse-url* (concatenate 'string "http://" url)))))
     (url:url url)))
 
 (defun send-closure-command (command &rest args)



From thenriksen at common-lisp.net  Wed Jan  9 23:19:06 2008
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 09 Jan 2008 23:19:06 -0000
Subject: [closure-cvs] CVS closure/src/gui
Message-ID: <20080109231906.304C764042@common-lisp.net>

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

Modified Files:
	dce-and-pce.lisp 
Log Message:
Fixed call to make-rgb-image-design.


--- /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2007/12/16 17:13:02	1.6
+++ /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2008/01/09 23:19:04	1.7
@@ -149,8 +149,8 @@
       (return (pce-design k)))))
 
 (defun really-make-design-from-aimage (medium aimage width height)
-  (climi::make-rgb-image-design medium
-				(imagelib::aimage-rgb-image
+  (declare (ignore medium))
+  (climi::make-rgb-image-design (imagelib::aimage-rgb-image
 				 (imagelib:scale-aimage aimage width height))))
 
 (defun reset-caches ()