Change color stuff to use global color-name database implemented in

the runtime system.  Add M-x define-color.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 22d143fba7ef7e88298c7ad2f69fd7c0c59ad367..b5753db4ae8388a3b3df9de302719bad6a07600e 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.175 1995/05/16 09:21:12 cph Exp $
+$Id: edwin.pkg,v 1.176 1995/05/20 10:19:57 cph Exp $
 
 Copyright (c) 1989-95 Massachusetts Institute of Technology
 
@@ -1326,6 +1326,7 @@ MIT in each case. |#
     (files "os2com")
     (parent (edwin))
     (export (edwin)
+           edwin-command$define-color-name
            edwin-command$set-background-color
            edwin-command$set-font
            edwin-command$set-foreground-color

diff --git a/v7/src/edwin/os2com.scm b/v7/src/edwin/os2com.scm
index aa09311a2edcb23a16f8471728efc68d26dfed81..fbcee385419177388dcdaab225bdc18006802ca2 100644 (file)
--- a/v7/src/edwin/os2com.scm
+++ b/v7/src/edwin/os2com.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2com.scm,v 1.1 1994/12/19 19:46:35 cph Exp $
+;;;    $Id: os2com.scm,v 1.2 1995/05/20 10:19:46 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994 Massachusetts Institute of Technology
 ;;;
@@ -50,7 +50,7 @@
   "sSet foreground color"
   (lambda (name)
     (let ((screen (selected-screen)))
-      (os2-screen/set-foreground-color! screen (name->color name))
+      (os2-screen/set-foreground-color! screen (os2/find-color name))
       (update-screen! screen #t))))
 
 (define-command set-background-color
@@ -58,23 +58,16 @@
   "sSet background color"
   (lambda (name)
     (let ((screen (selected-screen)))
-      (os2-screen/set-background-color! screen (name->color name))
+      (os2-screen/set-background-color! screen (os2/find-color name))
       (update-screen! screen #t))))
 
-(define (name->color name)
-  (let ((length (string-length name)))
-    (if (and (not (fix:= 0 length))
-            (char=? #\# (string-ref name 0)))
-       (let ((color
-              (and (fix:= 7 length)
-                   (let ((color (substring->number name 1 length 16)))
-                     (and color
-                          (fix:>= color 0)
-                          color)))))
-         (if (not color)
-             (editor-error "Ill-formed RGB color name:" name))
-         color)
-       (editor-error "Unknown color name:" name))))
+(define-command define-color-name
+  "Globally define COLOR-NAME to be COLOR.
+This does not affect any colors on the screen,
+but changes the meaning of COLOR-NAME when it is used in the future."
+  "sDefine color\nsDefine color to"
+  (lambda (name color)
+    (os2/define-color name color)))
 
 (define-command set-font
   "Set font to be used for drawing text."