Index: /trunk/ccl/examples/cocoa-defaults.lisp
===================================================================
--- /trunk/ccl/examples/cocoa-defaults.lisp	(revision 616)
+++ /trunk/ccl/examples/cocoa-defaults.lisp	(revision 617)
@@ -1,4 +1,2 @@
-;;;-*- Mode: LISP; Package: CCL -*-
-
 ;;;-*-Mode: LISP; Package: CCL -*-
 ;;;
@@ -20,5 +18,6 @@
 
 (eval-when (:compile-toplevel :execute)
-  (use-interface-dir :cocoa))
+  (use-interface-dir :cocoa)
+  (use-interface-dir :carbon))
 
 (require "OBJC-SUPPORT")
@@ -60,5 +59,5 @@
   (record-source-file name 'variable)
   (setf (documentation name 'variable) doc)
-  (set name (set-cocoa-default name (ns-constant-string (string-downcase name)) type value doc))
+  (set name (set-cocoa-default name (ns-constant-string (string name)) type value doc))
   name)
   
@@ -76,26 +75,21 @@
       (let* ((name (cocoa-default-symbol d))
              (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
-        (case (cocoa-default-type d)
-          (:int
-           (set name (send domain :integer-for-key key)))
-          (:float
-           (set name (send domain :float-for-key key)))
-          (:string
-           (let* ((nsstring (send domain :string-for-key key)))
-             (unless (%null-ptr-p nsstring)
-               (set name (lisp-string-from-nsstring nsstring))))))))))
+	(if (%null-ptr-p (send domain :object-for-key key))
+	  (send domain
+		:set-object (%make-nsstring (format nil "~a" (cocoa-default-value d)))
+		:for-key key)
+	  (case (cocoa-default-type d)
+	    (:int
+	     (set name (send domain :integer-for-key key)))
+	    (:float
+	     (set name (send domain :float-for-key key)))
+	    (:string
+	     (let* ((nsstring (send domain :string-for-key key)))
+	       (unless (%null-ptr-p nsstring)
+		 (set name (lisp-string-from-nsstring nsstring)))))))))
+    (send domain 'synchronize)
+    (send domain 'dictionary-representation)))
 
-(defun register-cocoa-defaults ()
-  (let* ((domain (send (@class "NSUserDefaults") 'standard-user-defaults))
-         (defaults (cocoa-defaults))
-         (dict (make-objc-instance 'ns:ns-mutable-dictionary
-                                   :with-capacity (length defaults))))
-    (dolist (d defaults)
-      (let* ((key (objc-constant-string-nsstringptr (cocoa-default-string d)))
-             (value (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
-        (send dict :set-value value :for-key key)))
-    (break "dict = ~s" dict)
-    (send domain :register-defaults dict)
-    (send domain 'synchronize)))
+
   
                                    
Index: /trunk/ccl/examples/cocoa-editor.lisp
===================================================================
--- /trunk/ccl/examples/cocoa-editor.lisp	(revision 616)
+++ /trunk/ccl/examples/cocoa-editor.lisp	(revision 617)
@@ -10,4 +10,40 @@
 (eval-when (:compile-toplevel :execute)
   (use-interface-dir :cocoa))
+
+(def-cocoa-default *editor-rows* :int 24)
+(def-cocoa-default *editor-columns* :int 80)
+
+;;; At runtime, this'll be a vector of character attribute dictionaries.
+(defloadvar *styles* ())
+
+(defun make-editor-style-map ()
+  (let* ((font-name *default-font-name*)
+	 (font-size *default-font-size*)
+	 (fonts (vector (default-font :name font-name :size font-size
+				      :attributes ())
+			(default-font :name font-name :size font-size
+				      :attributes '(:bold))
+			(default-font  :name font-name :size font-size
+				      :attributes '(:italic))
+			(default-font :name font-name :size font-size
+				      :attributes '(:bold :italic))))
+	 (color-class (find-class 'ns:ns-color))
+	 (colors (vector (send color-class 'black-color)
+			 (send color-class 'white-color)
+			 (send color-class 'dark-gray-color)
+			 (send color-class 'light-gray-color)
+			 (send color-class 'red-color)
+			 (send color-class 'blue-color)
+			 (send color-class 'green-color)
+			 (send color-class 'yellow-color)))
+	 (styles (make-array (the fixnum (* (length fonts) (length colors)))))
+	 (s 0))
+    (declare (dynamic-extent fonts colors))
+    (dotimes (c (length colors))
+      (dotimes (f (length fonts))
+	(setf (svref styles s) (create-text-attributes :font (svref fonts f)
+						       :color (svref colors c)))
+	(incf s)))
+    (setq *styles* styles)))
 
 (defun make-hemlock-buffer (&rest args)
@@ -88,4 +124,5 @@
   workline-offset			; cached offset of workline
   workline-length			; length of cached workline
+  workline-start-font-index		; current font index at start of worklin
   )
 
@@ -103,5 +140,6 @@
 	  (buffer-cache-workline-offset d) 0
 	  (buffer-cache-workline d) workline
-	  (buffer-cache-workline-length d) (hemlock::line-length workline))
+	  (buffer-cache-workline-length d) (hemlock::line-length workline)
+	  (buffer-cache-workline-start-font-index d) 0)
     d))
 
@@ -246,6 +284,5 @@
 ;;; Lisp-text-storage objects
 (defclass lisp-text-storage (ns:ns-text-storage)
-    ((string :foreign-type :id)
-     (defaultattrs :foreign-type :id))
+    ((string :foreign-type :id))
   (:metaclass ns:+ns-object))
 
@@ -257,6 +294,5 @@
 (define-objc-method ((:id :init-with-string s) lisp-text-storage)
   (let* ((newself (send-super 'init)))
-    (setf (slot-value newself 'string) s
-	  (slot-value newself 'defaultattrs) (create-text-attributes))
+    (setf (slot-value newself 'string) s)
     newself))
 
@@ -285,5 +321,5 @@
       (setf (pref rangeptr :<NSR>ange.location) 0
 	    (pref rangeptr :<NSR>ange.length) len))
-    (slot-value self 'defaultattrs)))
+    (svref *styles* 0)))
 
 ;;; The range's origin should probably be the buffer's point; if
@@ -581,5 +617,5 @@
 
 
-(defun make-scrolling-text-view-for-textstorage (textstorage x y width height)
+(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width)
   (slet ((contentrect (ns-make-rect x y width height)))
     (let* ((scrollview (send (make-objc-instance
@@ -623,10 +659,10 @@
 	      (send tv :set-vertically-resizable t) 
 	      (send tv :set-autoresizing-mask #$NSViewWidthSizable)
-	      (send container :set-width-tracks-text-view nil)
+	      (send container :set-width-tracks-text-view tracks-width)
 	      (send container :set-height-tracks-text-view nil)
 	      (send scrollview :set-document-view tv)	      
 	      (values tv scrollview))))))))
 
-(defun make-scrolling-textview-for-pane (pane textstorage)
+(defun make-scrolling-textview-for-pane (pane textstorage track-widht)
   (slet ((contentrect (send (send pane 'content-view) 'frame)))
     (multiple-value-bind (tv scrollview)
@@ -636,5 +672,6 @@
 	 (pref contentrect :<NSR>ect.origin.y)
 	 (pref contentrect :<NSR>ect.size.width)
-	 (pref contentrect :<NSR>ect.size.height))
+	 (pref contentrect :<NSR>ect.size.height)
+	 track-widht)
       (send pane :set-content-view scrollview)
       (setf (slot-value pane 'scroll-view) scrollview
@@ -747,12 +784,12 @@
 					
 				      
-(defun textpane-for-textstorage (ts)
+(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width)
   (let* ((pane (nth-value
                 1
                 (new-hemlock-document-window :activate nil)))
-         (tv (make-scrolling-textview-for-pane pane ts)))
+         (tv (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width)))
     (multiple-value-bind (height width)
         (size-of-char-in-font (default-font))
-      (size-textview-containers tv height width 24 80))
+      (size-textview-containers tv height width nrows ncols))
     pane))
 
@@ -841,15 +878,13 @@
 
 ;;; This function must run in the main event thread.
-(defun %hemlock-frame-for-textstorage (ts title activate)
-  (let* ((pane (textpane-for-textstorage ts))
-         (w (send pane 'window)))
-    (when title (send w :set-title (%make-nsstring title)))
-    (when activate (activate-window w))
-    w))
-
-(defun hemlock-frame-for-textstorage (ts title activate)
+(defun %hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width)
+  (let* ((pane (textpane-for-textstorage ts ncols nrows container-tracks-text-view-width)))
+    (send pane 'window)))
+
+
+(defun hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width)
   (process-interrupt *cocoa-event-process*
                      #'%hemlock-frame-for-textstorage
-                     ts title activate))
+                     ts  ncols nrows container-tracks-text-view-width))
 
 
@@ -911,5 +946,5 @@
             (decf pos n))
           #+debug
-	  (format t "~&pos = ~d, n = ~d" pos n)
+	  (format t "~&insert: pos = ~d, n = ~d" pos n)
           (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
             (reset-buffer-cache display) 
@@ -930,5 +965,5 @@
           (force-output)
 	  (send textstorage
-                :edited #$NSTextStorageEditedAttributes
+                :edited #$NSTextStorageEditedCharacters
                 :range (ns-make-range pos n)
                 :change-in-length (- n))
@@ -1090,6 +1125,9 @@
   (let* ((controller (make-objc-instance
 		      'lisp-editor-window-controller
-		      :with-window (%hemlock-frame-for-textstorage
-                                    (slot-value self 'textstorage) nil nil))))
+		      :with-window (%hemlock-frame-for-textstorage 
+                                    (slot-value self 'textstorage)
+				    *editor-columns*
+				    *editor-rows*
+				    nil))))
     (send self :add-window-controller controller)
     (send controller 'release)))	 
Index: /trunk/ccl/examples/cocoa-listener.lisp
===================================================================
--- /trunk/ccl/examples/cocoa-listener.lisp	(revision 616)
+++ /trunk/ccl/examples/cocoa-listener.lisp	(revision 617)
@@ -6,4 +6,7 @@
   (require "COCOA-EDITOR")
   (require "PTY"))
+
+(def-cocoa-default *listener-rows* :int 16)
+(def-cocoa-default *listener-columns* :int 80)
 
 ;;; Setup the server end of a pty pair.
@@ -225,8 +228,12 @@
 
 (define-objc-method ((:void make-window-controllers) lisp-listener-document)
-  (let* ((controller (make-objc-instance
+  (let* ((textstorage (slot-value self 'textstorage))
+	 (controller (make-objc-instance
 		      'lisp-listener-window-controller
 		      :with-window (%hemlock-frame-for-textstorage
-                                    (slot-value self 'textstorage) nil nil)))
+                                    textstorage
+				    *listener-columns*
+				    *listener-rows*
+				    t)))
 	 (listener-name (hi::buffer-name (hemlock-document-buffer self))))
     (send self :add-window-controller controller)
Index: /trunk/ccl/hemlock/src/font.lisp
===================================================================
--- /trunk/ccl/hemlock/src/font.lisp	(revision 616)
+++ /trunk/ccl/hemlock/src/font.lisp	(revision 617)
@@ -93,4 +93,6 @@
 ;;;; Referencing and setting font ids.
 
+#+clx
+(progn
 (defun window-font (window font)
   "Returns a font id for window and font."
@@ -119,2 +121,3 @@
       (setf (bitmap-hunk-trashed (window-hunk w)) :font-change)))
   (setf (svref (font-family-map *default-font-family*) font) font-object))
+)
Index: /trunk/ccl/hemlock/src/listener.lisp
===================================================================
--- /trunk/ccl/hemlock/src/listener.lisp	(revision 616)
+++ /trunk/ccl/hemlock/src/listener.lisp	(revision 617)
@@ -325,5 +325,5 @@
 	 (length (ring-length ring))
 	 (p (or p 1)))
-    (when (or (mark< point mark) (zerop length)) (editor-error))
+    (when (or (mark< point mark) (zerop length)) (editor-error "Can't get command history"))
     (cond
      ((eq (last-command-type) :interactive-history)
Index: /trunk/ccl/hemlock/src/rompsite.lisp
===================================================================
--- /trunk/ccl/hemlock/src/rompsite.lisp	(revision 616)
+++ /trunk/ccl/hemlock/src/rompsite.lisp	(revision 617)
@@ -261,5 +261,5 @@
   "The number of possible fonts in a font-map.")
 #-clx
-(defconstant font-map-size 16)
+(defconstant font-map-size 32)
 
 ;;; SETUP-FONT-FAMILY sets *default-font-family*, opening the three font names