[closure-cvs] CVS closure/src/gui

[emarsden]

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