[Openmcl-cvs-notifications] r7558 - /trunk/ccl/cocoa-ide/cocoa-defaults.lisp

[rme at clozure.com]

Author: rme
Date: Tue Oct 30 22:39:02 2007
New Revision: 7558

Log:
Add :font type.

Modified:
    trunk/ccl/cocoa-ide/cocoa-defaults.lisp

Modified: trunk/ccl/cocoa-ide/cocoa-defaults.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/ccl/cocoa-ide/cocoa-defaults.lisp (original)
+++ trunk/ccl/cocoa-ide/cocoa-defaults.lisp Tue Oct 30 22:39:02 2007
@@ -109,7 +109,7 @@
            (let* ((nsstring (#/stringForKey: domain key)))
              (unless (%null-ptr-p nsstring)
                (set name (lisp-string-from-nsstring nsstring)))))
-          (:color
+          ((:color :font)
            (let* ((data (#/dataForKey: domain key)))
              (unless (%null-ptr-p data)
                (set name (#/retain (#/unarchiveObjectWithData: ns:ns-unarc=
hiver data)))))))
@@ -126,6 +126,9 @@
       (let* ((value (cocoa-default-value d)))
         (#/setObject:forKey: dict
                              (case (cocoa-default-type d)
+			       (:font (#/archivedDataWithRootObject:
+				       ns:ns-archiver
+				       value))
                                (:color (#/archivedDataWithRootObject:
                                         ns:ns-archiver
                                         (apply #'color-values-to-nscolor v=
alue)))