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@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