Changeset 6758

Timestamp:

Jun 18, 2007, 1:38:34 AM (17 years ago)

Author:

Gary Byers

Message:

More changes.

File:

• branches/ide-1.0/ccl/examples/cocoa-defaults.lisp (modified) (3 diffs)

branches/ide-1.0/ccl/examples/cocoa-defaults.lisp

@@ -59 +59 @@
 ;;; Names which contain #\* confuse Cocoa Bindings.
 (defun objc-default-key (name)
-  (ns-constant-string (remove #\* (lisp-to-objc-message (list name)))))
+  (ns-constant-string (lisp-to-objc-message (list (make-symbol (remove #\* (string name)))))))
   
 
@@ -90 +90 @@
 
 (defun update-cocoa-defaults-list (domain defaults)
-  (let* ((need-synch nil))
-    (dolist (d defaults)
-      (let* ((name (cocoa-default-symbol d))
-             (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
-        (if (%null-ptr-p (#/objectForKey:  domain key))
-          (let* ((value (cocoa-default-value d)))
-            (case (cocoa-default-type d)
-              (:int (#/setInteger:forKey: domain value key))
-              (:float (#/setFloat:forKey: domain value key))
-              (:bool (#/setBool:forKey: domain value key))
-              (:color (#/setObject:forKey: domain
-                                           (#/archivedDataWithRootObject:
-                                            ns:ns-archiver
-                                            value)
-                                           key))
-              (t 
-               (#/setObject:forKey: domain
-                                    (%make-nsstring (format nil "~a" (cocoa-default-value d)))
+  (dolist (d defaults)
+    (let* ((name (cocoa-default-symbol d))
+           (type (cocoa-default-type d)) 
+           (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
+      (let* ((hook (cocoa-default-change-hook d))
+             (old-value (symbol-value name)))
+        (case type
+          (:int
+           (set name (#/integerForKey: domain key)))
+          (:float
+           (set name (#/floatForKey: domain key)))
+          (:bool
+           (set name (#/boolForKey: domain key)))
+          (:string
+           (let* ((nsstring (#/stringForKey: domain key)))
+             (unless (%null-ptr-p nsstring)
+               (set name (lisp-string-from-nsstring nsstring)))))
+          (:color
+           (let* ((data (#/dataForKey: domain key)))
+             (unless (%null-ptr-p data)
+               (set name (#/retain (#/unarchiveObjectWithData: ns:ns-unarchiver data)))))))
+        (when hook (funcall hook old-value (symbol-value name)))))))
 
-                                    key)))
-            (setq need-synch t))
-          (let* ((hook (cocoa-default-change-hook d))
-                 (old-value (symbol-value name)))
-            (case (cocoa-default-type d)
-              (:int
-               (set name (#/integerForKey: domain key)))
-              (:float
-               (set name (#/floatForKey: domain key)))
-              (:bool
-               (set name (#/boolForKey: domain key)))
-              (:string
-               (let* ((nsstring (#/stringForKey: domain key)))
-                 (unless (%null-ptr-p nsstring)
-                   (set name (lisp-string-from-nsstring nsstring)))))
-              (:color
-               (let* ((data (#/dataForKey: domain key)))
-                 (unless (%null-ptr-p data)
-                   (set name (#/retain (#/unarchiveObjectWithData: ns:ns-unarchiver data)))))))
-            (when hook (funcall hook old-value (symbol-value name)))))))
-    (when need-synch (#/synchronize domain))))
 
-;;; Type of newval depends on cocoa-default-type.
-(defun update-cocoa-default (d newval)
-  (let* ((name (cocoa-default-symbol d))) 
-    (case (cocoa-default-type d)
-            (:int
-             (set name (#/intValue newval)))
-            (:bool
-             (#_NSLog #@"newvalue = %@" :id newval)
-             (set name (coerce-from-bool (#/intValue newval))))
-            (:float
-             (set name (#/floatValue newval)))
-            (:string
-             (unless (%null-ptr-p newval)
-                 (set name (lisp-string-from-nsstring newval))))
-            (:color
-               (unless (%null-ptr-p newval)
-                 (set name (#/retain (#/unarchiveObjectWithData: ns:ns-unarchiver newval))))))))
 
 ;;; Return an NSDictionary describing the "default" values of the defaults.
@@ -156 +122 @@
     (dolist (d defaults dict)
       (let* ((value (cocoa-default-value d)))
-      (#/setObject:forKey: dict
-                           (case (cocoa-default-type d)
-                             (:color (#/archivedDataWithRootObject:
-                                      ns:ns-archiver
-                                      value))
-                             (:int (make-instance 'ns:ns-number
-                                                  :with-int value))
-                             (:float (make-instance 'ns:ns-number
-                                                    :with-float value))
-                             (:bool (make-instance 'ns:ns-number
-                                                   :with-bool (coerce-to-bool value)))
-                             (t
-                              (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
-                           (objc-constant-string-nsstringptr (cocoa-default-string d)))))))
+        (#/setObject:forKey: dict
+                             (case (cocoa-default-type d)
+                               (:color (#/archivedDataWithRootObject:
+                                        ns:ns-archiver
+                                        value))
+                               (:bool (if value #@"YES" #@"NO"))
+                               (t
+                                (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
+                             (objc-constant-string-nsstringptr (cocoa-default-string d)))))))