Changeset 6668

Timestamp:

Jun 3, 2007, 3:04:25 AM (17 years ago)

Author:

Gary Byers

Message:

Use negative stroke width.
"Random" insertions are enqueued to the window thread. Need to think harder
about where to insert in listener.
Don't pass command-key events to Hemlock.
Do #/paste ourselves, to get font sane and to handle embedded #\returns
(from Carbon apps.)

File:

• branches/ide-1.0/ccl/examples/cocoa-editor.lisp (modified) (11 diffs)

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

@@ -1 @@
-;;-*- Mode: LISP; Package: CCL -*-
+;;;-*- Mode: LISP; Package: CCL -*-
 
 
@@ -58 +58 @@
                          (#/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 +575 @@
 (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 +606 @@
             (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 +796 @@
     ((pane :foreign-type :id :accessor text-view-pane))
   (:metaclass ns:+ns-object))
+
+
+
+
 
 ;;; Access the underlying buffer in one swell foop.
@@ -837 +853 @@
 ;;; 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 +877 @@
   (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 +1192 @@
                 (#/setBackgroundColor: tv color)
                 (#/setSmartInsertDeleteEnabled: tv nil)
+                (#/setAllowsUndo: tv t)
                 (#/setUsesFindPanel: tv t)
                 (#/setWidthTracksTextView: container tracks-width)
@@ -1330 +1350 @@
   (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 +2223 @@
     #+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 +2263 @@
      *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)))))
+