Index: /branches/ide-1.0/ccl/examples/cocoa-editor.lisp
===================================================================
--- /branches/ide-1.0/ccl/examples/cocoa-editor.lisp	(revision 6667)
+++ /branches/ide-1.0/ccl/examples/cocoa-editor.lisp	(revision 6668)
@@ -1,3 +1,3 @@
-;;-*- Mode: LISP; Package: CCL -*-
+;;;-*- Mode: LISP; Package: CCL -*-
 
 
@@ -58,5 +58,5 @@
 			 (#/yellowColor color-class)))
 	 (styles (make-array (the fixnum (* 4 (length colors)))))
-         (bold-stroke-width 8.5f0)
+         (bold-stroke-width -10.0f0)
          (fonts (vector font (or bold-font font) (or oblique-font font) (or bold-oblique-font font)))
          (real-fonts (vector font bold-font oblique-font bold-oblique-font))
@@ -575,4 +575,8 @@
 (objc:defmethod (#/replaceCharactersInRange:withString: :void)
     ((self hemlock-text-storage) (r :<NSR>ange) string)
+  #+debug 0 (#_NSLog #@"Replace in range %ld/%ld with %@"
+                   :<NSI>nteger (pref r :<NSR>ange.location)
+                   :<NSI>nteger (pref r :<NSR>ange.length)
+                   :id string)
   (let* ((cache (hemlock-buffer-string-cache (#/string  self)))
 	 (buffer (if cache (buffer-cache-buffer cache)))
@@ -602,5 +606,13 @@
 	    (t
 	     (move-hemlock-mark-to-absolute-position point cache location))))
-    (hi::insert-string point (lisp-string-from-nsstring string))))
+    (let* ((lisp-string (lisp-string-from-nsstring string)))
+      (hi::enqueue-buffer-operation
+       buffer
+       #'(lambda ()
+           (unwind-protect
+                (progn
+                  (hi::buffer-document-begin-editing buffer)
+                  (hi::insert-string point lisp-string))
+             (hi::buffer-document-end-editing buffer)))))))
 
 
@@ -784,4 +796,8 @@
     ((pane :foreign-type :id :accessor text-view-pane))
   (:metaclass ns:+ns-object))
+
+
+
+
 
 ;;; Access the underlying buffer in one swell foop.
@@ -837,21 +853,22 @@
 ;;; Translate a keyDown NSEvent to a Hemlock key-event.
 (defun nsevent-to-key-event (nsevent)
-  (let* ((unmodchars (#/charactersIgnoringModifiers nsevent))
-	 (n (if (%null-ptr-p unmodchars)
-	      0
-	      (#/length unmodchars)))
-	 (c (if (eql n 1)
-	      (#/characterAtIndex: unmodchars 0))))
-    (when c
-      (let* ((bits 0)
-	     (modifiers (#/modifierFlags nsevent))
-             (useful-modifiers (logandc2 modifiers
-                                         (logior #$NSShiftKeyMask
-                                                 #$NSAlphaShiftKeyMask))))
-	(dolist (map hemlock-ext::*modifier-translations*)
-	  (when (logtest useful-modifiers (car map))
-	    (setq bits (logior bits (hemlock-ext::key-event-modifier-mask
-				     (cdr map))))))
-	(hemlock-ext::make-key-event c bits)))))
+  (let* ((modifiers (#/modifierFlags nsevent)))
+    (unless (logtest #$NSCommandKeyMask modifiers)
+      (let* ((unmodchars (#/charactersIgnoringModifiers nsevent))
+             (n (if (%null-ptr-p unmodchars)
+                  0
+                  (#/length unmodchars)))
+             (c (if (eql n 1)
+                  (#/characterAtIndex: unmodchars 0))))
+        (when c
+          (let* ((bits 0)
+                 (useful-modifiers (logandc2 modifiers
+                                             (logior #$NSShiftKeyMask
+                                                     #$NSAlphaShiftKeyMask))))
+            (dolist (map hemlock-ext::*modifier-translations*)
+              (when (logtest useful-modifiers (car map))
+                (setq bits (logior bits (hemlock-ext::key-event-modifier-mask
+                                         (cdr map))))))
+            (hemlock-ext::make-key-event c bits)))))))
 
 (defun pass-key-down-event-to-hemlock (self event)
@@ -860,8 +877,10 @@
   (let* ((buffer (text-view-buffer self)))
     (when buffer
-      (let* ((q (hemlock-frame-event-queue (#/window self))))
-        (hi::enqueue-key-event q (nsevent-to-key-event event))))))
-
-(defun enqueue-buffer-operation (buffer thunk)
+      (let* ((hemlock-event (nsevent-to-key-event event)))
+        (when hemlock-event
+          (let* ((q (hemlock-frame-event-queue (#/window self))))
+            (hi::enqueue-key-event q hemlock-event)))))))
+
+(defun hi::enqueue-buffer-operation (buffer thunk)
   (dolist (w (hi::buffer-windows buffer))
     (let* ((q (hemlock-frame-event-queue (#/window w)))
@@ -1173,4 +1192,5 @@
                 (#/setBackgroundColor: tv color)
                 (#/setSmartInsertDeleteEnabled: tv nil)
+                (#/setAllowsUndo: tv t)
                 (#/setUsesFindPanel: tv t)
                 (#/setWidthTracksTextView: container tracks-width)
@@ -1330,5 +1350,5 @@
   (let* ((message (#/objectAtIndex: info 0))
          (signal (#/objectAtIndex: info 1)))
-    (#_NSLog #@"runErrorSheet: signal = %@" :id signal)
+    #+debug (#_NSLog #@"runErrorSheet: signal = %@" :id signal)
     (#_NSBeginAlertSheet #@"Error in Hemlock command processing" ;title
                          (if (logbitp 0 (random 2))
@@ -2203,5 +2223,5 @@
     #+debug
     (#_NSLog #@"update Hemlock selection: charpos = %d, abspos = %d"
-             :int (hi::mark-charpos point) :int pos)
+             :int (hi::mark-charpos point) :int pointpos)
     (for-each-textview-using-storage
      self
@@ -2243,4 +2263,24 @@
      *nsapp* (@selector #/stringToPasteBoard:) (%make-nsstring string) t)))
 
+;;; The default #/paste method seems to want to set the font to
+;;; something ... inappropriate.  If we can figure out why it
+;;; does that and persuade it not to, we wouldn't have to do
+;;; this here.
+;;; (It's likely to also be the case that Carbon applications
+;;; terminate lines with #\Return when writing to the clipboard;
+;;; we may need to continue to override this method in order to
+;;; fix that.)
+(objc:defmethod (#/paste: :void) ((self hemlock-text-view) sender)
+  (declare (ignorable sender))
+  #+debug (#_NSLog #@"Paste: sender = %@" :id sender)
+  (let* ((pb (general-pasteboard))
+         (string (progn (#/types pb) (#/stringForType: pb #&NSStringPboardType))))
+    (unless (%null-ptr-p string)
+      (unless (zerop (ns:ns-range-length (#/rangeOfString: string *ns-cr-string*)))
+        (setq string (#/stringByReplacingOccurrencesOfString:withString: string *ns-cr-string* *ns-lf-string*)))
+      (let* ((textstorage (#/textStorage self))
+             (selectedrange (#/selectedRange self)))
+        (#/replaceCharactersInRange:withString: textstorage selectedrange string)))))
+
            
       
