Changeset 6687

Timestamp:

Jun 8, 2007, 3:20:58 PM (17 years ago)

Author:

Gary Byers

Message:

Lots-o-changes, mostly having to do with using a real NSString for
#/string. (Could the attributed string just be self ?)

File:

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

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

@@ -354 +354 @@
 
                      
-;;; Return an NSData object representing the bytes in the string.  If
-;;; the underlying buffer uses #\linefeed as a line terminator, we can
-;;; let the superclass method do the work; otherwise, we have to
-;;; ensure that each line is terminated according to the buffer's
-;;; conventions.
-(objc:defmethod #/dataUsingEncoding:allowLossyConversion:
-    ((self hemlock-buffer-string)
-     (encoding :<NSS>tring<E>ncoding)
-     (flag :<BOOL>))
-  (let* ((buffer (buffer-cache-buffer (hemlock-buffer-string-cache self)))
-         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-         (external-format (if buffer (hi::buffer-external-format buffer )))
-         (raw-length (if buffer (hemlock-buffer-length buffer) 0)))
-    (hi::%set-buffer-modified buffer nil)
-    (if (eql 0 raw-length)
-      (make-instance 'ns:ns-mutable-data :with-length 0)
-      (case external-format
-        ((:unix nil)
-         (call-next-method encoding flag))
-        ((:macos :cp/m)
-         (let* ((cp/m-p (eq external-format :cp/m)))
-           (when cp/m-p
-             ;; This may seem like lot of fuss about an ancient OS and its
-             ;; odd line-termination conventions.  Of course, I'm actually
-             ;; referring to CP/M-86.
-             (do* ((line (hi::mark-line (hi::buffer-start-mark buffer))
-                         next)
-                   (next (hi::line-next line) (hi::line-next line)))
-                  ((null line))
-               (when next (incf raw-length))))
-           (let* ((pos 0)
-                  (data (make-instance 'ns:ns-mutable-data
-                                       :with-length raw-length))
-                  (bytes (#/mutableBytes data)))
-             (do* ((line (hi::mark-line (hi::buffer-start-mark buffer))
-                         next)
-                   (next (hi::line-next line) (hi::line-next line)))
-                  ((null line) data)
-               (let* ((chars (hi::line-chars line))
-                      (len (length chars)))
-                 (unless (zerop len)
-                   (%cstr-pointer chars (%inc-ptr bytes pos) nil)
-                   (incf pos len))
-                 (when next
-                   (when cp/m-p
-                     (setf (%get-byte bytes pos) (char-code #\return))
-                     (incf pos)
-                   (setf (%get-byte bytes pos) (char-code #\linefeed))  
-                   (incf pos))))))))))))
+
 
 
@@ -419 +371 @@
 (defclass hemlock-text-storage (ns:ns-text-storage)
     ((string :foreign-type :id)
+     (hemlock-string :foreign-type :id)
      (edit-count :foreign-type :int)
      (append-edits :foreign-type :int)
@@ -438 +391 @@
 
 
+
 ;;; Return true iff we're inside a "beginEditing/endEditing" pair
 (objc:defmethod (#/editingInProgress :<BOOL>) ((self hemlock-text-storage))
@@ -457 +411 @@
          (n (#/longValue (#/objectAtIndex: params 1))))
     (#/edited:range:changeInLength: self #$NSTextStorageEditedCharacters (ns:make-ns-range pos n) (- n))
-    (let* ((display (hemlock-buffer-string-cache (#/string self))))
+    (let* ((display (hemlock-buffer-string-cache (#/hemlockString self))))
       (reset-buffer-cache display) 
       (update-line-cache-for-index display pos))))
@@ -499 +453 @@
 ;;; Access the string.  It'd be nice if this was a generic function;
 ;;; we could have just made a reader method in the class definition.
+
+
+
 (objc:defmethod #/string ((self hemlock-text-storage))
   (slot-value self 'string))
@@ -505 +462 @@
   (slot-value self 'cache))
 
+(objc:defmethod #/hemlockString ((self hemlock-text-storage))
+(slot-value self 'hemlock-string))
+
 (objc:defmethod #/initWithString: ((self hemlock-text-storage) s)
-  (let* ((newself (#/init self)))
-    (setf (slot-value newself 'string) s)
-    (setf (slot-value newself 'cache)
-          (#/retain (make-instance ns:ns-mutable-attributed-string
+  (setq s (%inc-ptr s 0))
+  (let* ((newself (#/init self))
+         (cache (#/retain (make-instance ns:ns-mutable-attributed-string
                                    :with-string s
-                                   :attributes (svref *styles* 0))))
+                                   :attributes (svref *styles* 0)))))
+    (declare (type hemlock-text-storage newself))
+    (setf (slot-value newself 'hemlock-string) s)
+    (setf (slot-value newself 'cache) cache)
+    (setf (slot-value newself 'string) (#/retain (#/string cache)))
     newself))
 
 ;;; Should generally only be called after open/revert.
 (objc:defmethod (#/updateCache :void) ((self hemlock-text-storage))
-  (with-slots (string cache) self
-    (#/replaceCharactersInRange:withString: cache (ns:make-ns-range 0 (#/length cache)) string)))
+  (with-slots (hemlock-string cache) self
+    (#/replaceCharactersInRange:withString: cache (ns:make-ns-range 0 (#/length cache)) hemlock-string)
+    (#/setAttributes:range: cache (svref *styles* 0) (ns:make-ns-range 0 (#/length cache)))))
 
 ;;; This is the only thing that's actually called to create a
@@ -536 +500 @@
   #+debug
   (#_NSLog #@"Attributes at index: %d" :unsigned index)
-  #+no
-  (let* ((buffer-cache (hemlock-buffer-string-cache (slot-value self 'string)))
-         (buffer (buffer-cache-buffer buffer-cache))
-         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)))
-    (update-line-cache-for-index buffer-cache index)
-    (multiple-value-bind (start len style)
-        (ccl::do-dll-nodes (node
-                            (hi::buffer-font-regions buffer)
-                            (values 0 (buffer-cache-buflen buffer-cache) 0))
-          (let* ((region (hi::font-region-node-region node))
-                 (start (hi::region-start region))
-                 (end (hi::region-end region))
-                 (startpos (mark-absolute-position start))
-                 (endpos (mark-absolute-position end)))
-            (when (and (>= index startpos)
-                       (< index endpos))
-              (return (values startpos
-                              (- endpos startpos)
-                              (hi::font-mark-font start))))))
-      #+debug
-      (#_NSLog #@"Start = %d, len = %d, style = %d"
-               :int start :int len :int style)
-      (unless (%null-ptr-p rangeptr)
-        (setf (pref rangeptr :<NSR>ange.location) start
-              (pref rangeptr :<NSR>ange.length) len))
-      (svref *styles* style)))
-  #-no
   (with-slots (cache) self
     (let* ((attrs (#/attributesAtIndex:effectiveRange: cache index rangeptr)))
       (when (eql 0 (#/count attrs))
+        (#_NSLog #@"No attributes ?")
         (ns:with-ns-range (r)
           (#/attributesAtIndex:longestEffectiveRange:inRange:
@@ -575 +513 @@
 (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)))
+  #+debug  (#_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 (#/hemlockString  self)))
          (buffer (if cache (buffer-cache-buffer cache)))
          (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
          (location (pref r :<NSR>ange.location))
          (length (pref r :<NSR>ange.length))
-         (mark (hi::buffer-%mark buffer))
-         (point (hi::buffer-point buffer))
-         input-mark)
-    ;;
-    ;; special behavior for listener windows.
-    ;;
-    (if (and (> (slot-value self 'append-edits) 0)
-             (progn
-               (setf input-mark (hi::variable-value 'hemlock::buffer-input-mark :buffer buffer))
-               (not (hi::same-line-p point input-mark))))
-      (progn
-        ;;
-        ;;  move the point to the end of the buffer
-        ;;
-        (setf (hi::buffer-region-active buffer) nil)
-        (move-hemlock-mark-to-absolute-position point cache (hemlock-buffer-length buffer)))
-      (cond ((> length 0)
-             (move-hemlock-mark-to-absolute-position mark cache location)
-             (move-hemlock-mark-to-absolute-position point cache (+ location length))
-             (hemlock::%buffer-activate-region buffer))
-            (t
-             (move-hemlock-mark-to-absolute-position point cache location))))
-    (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)))))))
+         (point (hi::buffer-point buffer)))
+    (let* ((lisp-string (lisp-string-from-nsstring string))
+           (document (if buffer (hi::buffer-document buffer)))
+           (textstorage (if document (slot-value document 'textstorage))))
+      (when textstorage (#/beginEditing textstorage))
+      (setf (hi::buffer-region-active buffer) nil)
+      (unless (zerop length)
+        (hi::with-mark ((start point)
+                        (end point))
+          (move-hemlock-mark-to-absolute-position start cache location)
+          (move-hemlock-mark-to-absolute-position end cache (+ location length))
+          (hi::delete-region (hi::region start end))))
+      (hi::insert-string point lisp-string)
+      (when textstorage
+        (#/endEditing textstorage)
+        (for-each-textview-using-storage textstorage (lambda (tv)
+                                                       (hi::disable-self-insert (hemlock-frame-event-queue (#/window tv)))))
+        (#/ensureSelectionVisible textstorage)))))
 
 
@@ -624 +549 @@
   (with-slots (cache) self
     (#/setAttributes:range: cache attributes r)
-    #+debug
-    (#_NSLog #@"Assigned attributes = %@" :id (#/attributesAtIndex:effectiveRange: cache (pref r :<NSR>ange.location) +null-ptr+))
-    ))
+      #+debug
+      (#_NSLog #@"Assigned attributes = %@" :id (#/attributesAtIndex:effectiveRange: cache (pref r :<NSR>ange.location) +null-ptr+))))
 
 (defun for-each-textview-using-storage (textstorage f)
@@ -642 +566 @@
 ;;; Again, it's helpful to see the buffer name when debugging.
 (objc:defmethod #/description ((self hemlock-text-storage))
-  (#/stringWithFormat: ns:ns-string #@"%s : string %@" (#_object_getClassName self) (slot-value self 'string)))
+  (#/stringWithFormat: ns:ns-string #@"%s : string %@" (#_object_getClassName self) (slot-value self 'hemlock-string)))
 
 ;;; This needs to happen on the main thread.
@@ -653 +577 @@
 
 (defun close-hemlock-textstorage (ts)
-  (let* ((string (slot-value ts 'string)))
-    (setf (slot-value ts 'string) (%null-ptr))
-    (unless (%null-ptr-p string)
-      (let* ((cache (hemlock-buffer-string-cache string))
-             (buffer (if cache (buffer-cache-buffer cache))))
-        (when buffer
-          (setf (buffer-cache-buffer cache) nil
-                (slot-value string 'cache) nil
-                (hi::buffer-document buffer) nil)
-          (let* ((p (hi::buffer-process buffer)))
-            (when p
-              (setf (hi::buffer-process buffer) nil)
-              (process-kill p)))
-          (when (eq buffer hi::*current-buffer*)
-            (setf (hi::current-buffer)
-                  (car (last hi::*buffer-list*))))
-          (hi::invoke-hook (hi::buffer-delete-hook buffer) buffer)
-          (hi::invoke-hook hemlock::delete-buffer-hook buffer)
-          (setq hi::*buffer-list* (delq buffer hi::*buffer-list*))
-          (hi::delete-string (hi::buffer-name buffer) hi::*buffer-names*))))))
+  (let* ((hemlock-string (slot-value ts 'hemlock-string)))
+    (setf (slot-value ts 'hemlock-string) +null-ptr+)
+    (unless (%null-ptr-p hemlock-string)
+      (let* ((cache (hemlock-buffer-string-cache hemlock-string))
+             (buffer (if cache (buffer-cache-buffer cache))))
+        (when buffer
+          (setf (buffer-cache-buffer cache) nil
+                (slot-value hemlock-string 'cache) nil
+                (hi::buffer-document buffer) nil)
+          (let* ((p (hi::buffer-process buffer)))
+            (when p
+              (setf (hi::buffer-process buffer) nil)
+              (process-kill p)))
+          (when (eq buffer hi::*current-buffer*)
+            (setf (hi::current-buffer)
+                  (car (last hi::*buffer-list*))))
+          (hi::invoke-hook (hi::buffer-delete-hook buffer) buffer)
+          (hi::invoke-hook hemlock::delete-buffer-hook buffer)
+          (setq hi::*buffer-list* (delq buffer hi::*buffer-list*))
+         (hi::delete-string (hi::buffer-name buffer) hi::*buffer-names*))))))
 
       
@@ -691 +615 @@
     ((self hemlock-textstorage-text-view) layout cont (flag :<BOOL>))
   (declare (ignorable cont flag))
+  #+debug (#_NSLog #@"layout complete: container = %@, atend = %d" :id cont :int (if flag 1 0))
   (when (zerop *layout-text-in-background*)
     (#/setDelegate: layout +null-ptr+)
@@ -744 +669 @@
 (defmethod update-blink ((self hemlock-textstorage-text-view))
   (disable-blink self)
-  (let* ((d (hemlock-buffer-string-cache (#/string self)))
+  (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
          (buffer (buffer-cache-buffer d)))
     (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
@@ -794 +719 @@
 ;;; object that displays buffers.
 (defclass hemlock-text-view (hemlock-textstorage-text-view)
-    ((pane :foreign-type :id :accessor text-view-pane))
+    ((pane :foreign-type :id :accessor text-view-pane)
+     (char-width :foreign-type :<CGF>loat :accessor text-view-char-width)
+     (char-height :foreign-type :<CGF>loat :accessor text-view-char-height))
   (:metaclass ns:+ns-object))
 
@@ -803 +730 @@
 ;;; Access the underlying buffer in one swell foop.
 (defmethod text-view-buffer ((self hemlock-text-view))
-  (buffer-cache-buffer (hemlock-buffer-string-cache (#/string (#/textStorage self)))))
-
-(objc:defmethod (#/setString: :void) ((self hemlock-textstorage-text-view) s)
-  #+debug
-  (#_NSLog #@"hemlock-text-view %@ string set to %@" :id self :id s)
-  (call-next-method) s)
+  (buffer-cache-buffer (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self)))))
+
+
 
 (objc:defmethod (#/selectionRangeForProposedRange:granularity: :ns-range)
@@ -817 +741 @@
   (#_NSLog #@"Granularity = %d" :int g)
   (objc:returning-foreign-struct (r)
-    (block HANDLED
-      (let* ((index (ns:ns-range-location proposed))             
-             (length (ns:ns-range-length proposed)))
-        (when (and (eql 0 length)       ; not extending existing selection
-                   (not (eql g #$NSSelectByCharacter)))
-          (let* ((textstorage (#/textStorage self))
-                 (cache (hemlock-buffer-string-cache (#/string textstorage)))
-                 (buffer (if cache (buffer-cache-buffer cache))))
-            (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
-              (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer)))
-                (hi::with-mark ((m1 (hi::buffer-point buffer)))
-                  (move-hemlock-mark-to-absolute-position m1 cache index)
-                  (hemlock::pre-command-parse-check m1)
-                  (when (hemlock::valid-spot m1 nil)
-                    (cond ((eql (hi::next-character m1) #\()
-                           (hi::with-mark ((m2 m1))
-                             (when (hemlock::list-offset m2 1)
-                               (ns:init-ns-range r index (- (mark-absolute-position m2) index))
-                               (return-from HANDLED r))))
-                          ((eql (hi::previous-character m1) #\))
-                           (hi::with-mark ((m2 m1))
-                             (when (hemlock::list-offset m2 -1)
-                               (ns:init-ns-range r (mark-absolute-position m2) (- index (mark-absolute-position m2)))
-                               (return-from HANDLED r))))))))))))
-                                   (call-next-method proposed g)
-                                   #+debug
-                                   (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
-                                            :address (#_NSStringFromRange r)
-                                            :address (#_NSStringFromRange proposed)
-                                            :<NSS>election<G>ranularity g))))
+     (block HANDLED
+       (let* ((index (ns:ns-range-location proposed))             
+              (length (ns:ns-range-length proposed)))
+         (when (and (eql 0 length)      ; not extending existing selection
+                    (not (eql g #$NSSelectByCharacter)))
+           (let* ((textstorage (#/textStorage self))
+                  (cache (hemlock-buffer-string-cache (#/hemlockString textstorage)))
+                  (buffer (if cache (buffer-cache-buffer cache))))
+             (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
+               (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer)))
+                 (hi::with-mark ((m1 (hi::buffer-point buffer)))
+                   (move-hemlock-mark-to-absolute-position m1 cache index)
+                   (hemlock::pre-command-parse-check m1)
+                   (when (hemlock::valid-spot m1 nil)
+                     (cond ((eql (hi::next-character m1) #\()
+                            (hi::with-mark ((m2 m1))
+                              (when (hemlock::list-offset m2 1)
+                                (ns:init-ns-range r index (- (mark-absolute-position m2) index))
+                                (return-from HANDLED r))))
+                           ((eql (hi::previous-character m1) #\))
+                            (hi::with-mark ((m2 m1))
+                              (when (hemlock::list-offset m2 -1)
+                                (ns:init-ns-range r (mark-absolute-position m2) (- index (mark-absolute-position m2)))
+                                (return-from HANDLED r))))))))))))
+       (call-next-method proposed g)
+       #+debug
+       (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
+                :address (#_NSStringFromRange r)
+                :address (#_NSStringFromRange proposed)
+                :<NSS>election<G>ranularity g))))
+
+
 
   
@@ -852 +778 @@
 
 ;;; Translate a keyDown NSEvent to a Hemlock key-event.
-(defun nsevent-to-key-event (nsevent)
+(defun nsevent-to-key-event (nsevent &optional quoted)
   (let* ((modifiers (#/modifierFlags nsevent)))
     (unless (logtest #$NSCommandKeyMask modifiers)
-      (let* ((unmodchars (#/charactersIgnoringModifiers nsevent))
-             (n (if (%null-ptr-p unmodchars)
+      (let* ((chars (if quoted
+                      (#/characters nsevent)
+                      (#/charactersIgnoringModifiers nsevent)))
+             (n (if (%null-ptr-p chars)
                   0
-                  (#/length unmodchars)))
+                  (#/length chars)))
              (c (if (eql n 1)
-                  (#/characterAtIndex: unmodchars 0))))
+                  (#/characterAtIndex: chars 0))))
         (when c
           (let* ((bits 0)
@@ -866 +794 @@
                                              (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))))))
+            (unless quoted
+              (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)
+(defun pass-key-down-event-to-hemlock (self event q)
   #+debug
   (#_NSLog #@"Key down event = %@" :address event)
   (let* ((buffer (text-view-buffer self)))
     (when buffer
-      (let* ((hemlock-event (nsevent-to-key-event event)))
+      (let* ((hemlock-event (nsevent-to-key-event event (hi::frame-event-queue-quoted-insert q ))))
         (when hemlock-event
-          (let* ((q (hemlock-frame-event-queue (#/window self))))
-            (hi::enqueue-key-event q hemlock-event)))))))
+          (hi::enqueue-key-event q hemlock-event))))))
 
 (defun hi::enqueue-buffer-operation (buffer thunk)
@@ -893 +821 @@
 ;;; interpreter. 
 
+(defun handle-key-down (self event)
+  (let* ((q (hemlock-frame-event-queue (#/window self))))
+    (if (or (and (zerop (#/length (#/characters event)))
+                 (hi::frame-event-queue-quoted-insert q))
+            (#/hasMarkedText self))
+      nil
+      (progn
+        (pass-key-down-event-to-hemlock self event q)
+        t))))
+  
+
 (objc:defmethod (#/keyDown: :void) ((self hemlock-text-view) event)
-  (pass-key-down-event-to-hemlock self event))
+  (or (handle-key-down self event)
+      (call-next-method event)))
 
 ;;; Update the underlying buffer's point (and "active region", if appropriate.
@@ -916 +856 @@
            :id (#/string (#/textStorage self)))
   (unless (#/editingInProgress (#/textStorage self))
-    (let* ((d (hemlock-buffer-string-cache (#/string self)))
+    (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
            (buffer (buffer-cache-buffer d))
            (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
@@ -1155 +1095 @@
 
 
-(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color)
+(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color style)
   (let* ((scrollview (#/autorelease
                       (make-instance
@@ -1170 +1110 @@
     (let* ((layout (make-instance 'ns:ns-layout-manager)))
       (#/addLayoutManager: textstorage layout)
+      (#/setUsesScreenFonts: layout t)
       (#/release layout)
       (let* ((contentsize (#/contentSize scrollview)))
@@ -1191 +1132 @@
                 (#/setAutoresizingMask: tv #$NSViewWidthSizable)
                 (#/setBackgroundColor: tv color)
+                (#/setTypingAttributes: tv (aref *styles* style))
                 (#/setSmartInsertDeleteEnabled: tv nil)
                 (#/setAllowsUndo: tv t)
@@ -1199 +1141 @@
                 (values tv scrollview)))))))))
 
-(defun make-scrolling-textview-for-pane (pane textstorage track-width color)
+(defun make-scrolling-textview-for-pane (pane textstorage track-width color style)
   (let* ((contentrect (#/frame (#/contentView pane))))
     (multiple-value-bind (tv scrollview)
@@ -1209 +1151 @@
          (ns:ns-rect-height contentrect)
          track-width
-         color)
+         color
+         style)
       (#/setContentView: pane scrollview)
       (setf (slot-value pane 'scroll-view) scrollview
@@ -1238 +1181 @@
 
 (defmethod text-view-buffer ((self echo-area-view))
-  (buffer-cache-buffer (hemlock-buffer-string-cache (#/string (#/textStorage self)))))
+  (buffer-cache-buffer (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self)))))
 
 ;;; The "document" for an echo-area isn't a real NSDocument.
@@ -1245 +1188 @@
   (:metaclass ns:+ns-object))
 
-(define-objc-method ((:void close) echo-area-document)
+(objc:defmethod (#/close :void) ((self echo-area-document))
   (let* ((ts (slot-value self 'textstorage)))
     (unless (%null-ptr-p ts)
@@ -1251 +1194 @@
       (close-hemlock-textstorage ts))))
 
-(define-objc-method ((:void :update-change-count (:<NSD>ocument<C>hange<T>ype change)) echo-area-document)
+(objc:defmethod (#/updateChangeCount: :void)
+    ((self echo-area-document)
+     (change :<NSD>ocument<C>hange<T>ype))
   (declare (ignore change)))
 
-(define-objc-method ((:void :key-down event)
-                     echo-area-view)
-  (pass-key-down-event-to-hemlock self event))
+(objc:defmethod (#/keyDown: :void) ((self echo-area-view) event)
+  (or (handle-key-down self event)
+      (call-next-method event)))
 
 
@@ -1474 +1419 @@
         pane))))
 
-(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width color)
+(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width color style)
   (let* ((pane (nth-value
                 1
                 (new-hemlock-document-window))))
-    (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width color)
+    (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width color style)
     (multiple-value-bind (height width)
         (size-of-char-in-font (default-font))
@@ -1492 +1437 @@
 
 (defun %nsstring-to-mark (nsstring mark)
-  "returns external-format of string"
-  (let* ((string-len (#/length nsstring))
-         (line-start 0)
-         (first-line-terminator ())
-         (first-line (hi::mark-line mark))
-         (previous first-line)
-         (buffer (hi::line-%buffer first-line))
-         (hi::*buffer-gap-context*
-          (or 
-           (hi::buffer-gap-context buffer)
-           (setf (hi::buffer-gap-context buffer)
-                 (hi::make-buffer-gap-context)))))
-    (rlet ((remaining-range :ns-range :location 0 :length  1)
-           (line-end-index :<NSUI>nteger)
-           (contents-end-index :<NSUI>nteger))
-      (do* ((number (+ (hi::line-number first-line) hi::line-increment)
-                    (+ number hi::line-increment)))
-           ((= line-start string-len)
-            (let* ((line (hi::mark-line mark)))
-              (hi::insert-string mark (make-string 0))
-              (setf (hi::line-next previous) line
-                    (hi::line-previous line) previous))
-            nil)
-        (setf (pref remaining-range :<NSR>ange.location) line-start)
-        (#/getLineStart:end:contentsEnd:forRange:
-         nsstring
-         +null-ptr+
-         line-end-index
-         contents-end-index
-         remaining-range)
-        (let* ((contents-end (pref contents-end-index :<NSUI>nteger))
-               (line-end (pref line-end-index :<NSUI>nteger))
-               (chars (make-string (- contents-end line-start))))
-          (do* ((i line-start (1+ i))
-                (j 0 (1+ j)))
-               ((= i contents-end))
-            (setf (schar chars j) (code-char (#/characterAtIndex: nsstring i))))
-          (unless first-line-terminator
-            (let* ((terminator (code-char
-                                (#/characterAtIndex: nsstring contents-end))))
-              (setq first-line-terminator
-                    (case terminator
-                      (#\return (if (= line-end (+ contents-end 2))
-                                  :cp/m
-                                  :macos))
-                      (t :unix)))))
-          (if (eq previous first-line)
-            (progn
-              (hi::insert-string mark chars)
-              (hi::insert-character mark #\newline)
-              (setq first-line nil))
-            (if (eq string-len contents-end)
-              (hi::insert-string mark chars)
-              (let* ((line (hi::make-line
-                            :previous previous
-                            :%buffer buffer
-                            :chars chars
-                            :number number)))
-                (setf (hi::line-next previous) line)
-                (setq previous line))))
-          (setq line-start line-end))))
-    first-line-terminator))
+  "returns line-termination of string"
+  (let* ((string (lisp-string-from-nsstring nsstring))
+         (lfpos (position #\linefeed string))
+         (crpos (position #\return string))
+         (line-termination (if crpos
+                             (if (eql lfpos (1+ crpos))
+                               :cp/m
+                               :macos)
+                             :unix)))
+    (hi::insert-string mark
+                           (case line-termination
+                             (:cp/m (remove #\return string))
+                             (:macos (nsubstitute #\linefeed #\return string))
+                             (t string)))
+    line-termination))
   
 (defun nsstring-to-buffer (nsstring buffer)
@@ -1563 +1461 @@
          (progn
            (hi::delete-region region)
-           (hi::modifying-buffer buffer)
-           (hi::with-mark ((mark (hi::buffer-point buffer) :left-inserting))
-             (setf (hi::buffer-external-format buffer)
-                   (%nsstring-to-mark nsstring mark)))
-           (setf (hi::buffer-modified buffer) nil)
-           (hi::buffer-start (hi::buffer-point buffer))
-           (hi::renumber-region region)
-           buffer)
+           (hi::modifying-buffer buffer
+                                 (hi::with-mark ((mark (hi::buffer-point buffer) :left-inserting))
+                                   (setf (hi::buffer-line-termination buffer)
+                                         (%nsstring-to-mark nsstring mark)))
+                                 (setf (hi::buffer-modified buffer) nil)
+                                 (hi::buffer-start (hi::buffer-point buffer))
+                                 (hi::renumber-region region)
+                                 buffer))
       (setf (hi::buffer-document buffer) document))))
-
-;;; This assumes that the buffer has no document and no textstorage (yet).
-(defun hi::cocoa-read-file (lisp-pathname mark buffer)
-  (let* ((lisp-namestring (native-translated-namestring lisp-pathname))
-         (cocoa-pathname (%make-nsstring lisp-namestring))
-         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-         (data (make-instance 'ns:ns-data
-                              :with-contents-of-file cocoa-pathname))
-         (string (make-instance 'ns:ns-string
-                                :with-data data
-                                :encoding #$NSASCIIStringEncoding))
-         (external-format (%nsstring-to-mark string mark)))
-    (unless (hi::buffer-external-format buffer)
-      (setf (hi::buffer-external-format buffer) external-format))
-    buffer))
-    
 
 
@@ -1597 +1479 @@
 
 ;;; This function must run in the main event thread.
-(defun %hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color)
-  (let* ((pane (textpane-for-textstorage ts ncols nrows container-tracks-text-view-width color))
+(defun %hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color style)
+  (let* ((pane (textpane-for-textstorage ts ncols nrows container-tracks-text-view-width color style))
          (frame (#/window pane))
          (buffer (text-view-buffer (text-pane-text-view pane))))
@@ -1617 +1499 @@
 
 
-(defun hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color)
+(defun hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color style)
   (process-interrupt *cocoa-event-process*
                      #'%hemlock-frame-for-textstorage
-                     ts  ncols nrows container-tracks-text-view-width color))
+                     ts  ncols nrows container-tracks-text-view-width color style))
 
 
@@ -1717 +1599 @@
         (let* ((pos (mark-absolute-position mark))
                (cache (#/cache textstorage))
-               (hemlock-string (#/string textstorage))
+               (hemlock-string (#/hemlockString textstorage))
                (display (hemlock-buffer-string-cache hemlock-string))
                (buffer (buffer-cache-buffer display))
@@ -1745 +1627 @@
            (textstorage (if document (slot-value document 'textstorage))))
       (when textstorage
-        (let* ((hemlock-string (#/string textstorage))
+        (let* ((hemlock-string (#/hemlockString textstorage))
                (cache (#/cache textstorage))
                (pos (mark-absolute-position mark)))
@@ -1780 +1662 @@
             (#/edited:range:changeInLength:
              textstorage #$NSTextStorageEditedCharacters (ns:make-ns-range pos n) (- n))
-            (let* ((display (hemlock-buffer-string-cache (#/string textstorage))))
+            (let* ((display (hemlock-buffer-string-cache (#/hemlockString textstorage))))
               (reset-buffer-cache display) 
               (update-line-cache-for-index display pos)))
@@ -1838 +1720 @@
               (ns:ns-size-width margins))
         (#/setContentSize: window sv-size)
+        (setf (slot-value tv 'char-width) char-width
+              (slot-value tv 'char-height) char-height)
         (#/setResizeIncrements: window
                                 (ns:make-ns-size char-width char-height))))))
@@ -1847 +1731 @@
 
 
+;;; Map *default-file-character-encoding* to an :<NSS>tring<E>ncoding
+(defun get-default-encoding ()
+  (let* ((string (string (or *default-file-character-encoding*
+                                 "ISO-8859-1")))
+         (len (length string)))
+    (with-cstrs ((cstr string))
+      (with-nsstr (nsstr cstr len)
+        (let* ((cf (#_CFStringConvertIANACharSetNameToEncoding nsstr)))
+          (if (= cf #$kCFStringEncodingInvalidId)
+            (setq cf (#_CFStringGetSystemEncoding)))
+          (let* ((ns (#_CFStringConvertEncodingToNSStringEncoding cf)))
+            (if (= ns #$kCFStringEncodingInvalidId)
+              (#/defaultCStringEncoding ns:ns-string)
+              ns)))))))
 
 ;;; The HemlockEditorDocument class.
@@ -1855 +1753 @@
      (encoding :foreign-type :<NSS>tring<E>ncoding))
   (:metaclass ns:+ns-object))
+
+
+(defmethod user-input-style ((doc hemlock-editor-document))
+  0)
+
+(defvar *encoding-name-hash* (make-hash-table))
+
+(defmethod hi::document-encoding-name ((doc hemlock-editor-document))
+  (with-slots (encoding) doc
+    (if (eql encoding 0)
+      "Automatic"
+      (or (gethash encoding *encoding-name-hash*)
+          (setf (gethash encoding *encoding-name-hash*)
+                (lisp-string-from-nsstring (nsstring-for-nsstring-encoding encoding)))))))
+
 
 (defmethod textview-background-color ((doc hemlock-editor-document))
@@ -1867 +1780 @@
 (objc:defmethod (#/setTextStorage: :void) ((self hemlock-editor-document) ts)
   (let* ((doc (%inc-ptr self 0))        ; workaround for stack-consed self
-         (string (#/string ts))
+         (string (#/hemlockString ts))
          (cache (hemlock-buffer-string-cache string))
          (buffer (buffer-cache-buffer cache)))
@@ -1899 +1812 @@
       (#/edited:range:changeInLength: textstorage  #$NSTextStorageEditedAttributes (ns:make-ns-range 0 0) newlen)
       (#/edited:range:changeInLength: textstorage #$NSTextStorageEditedCharacters (ns:make-ns-range 0 newlen) 0)
-      (let* ((ts-string (#/string textstorage))
+      (let* ((ts-string (#/hemlockString textstorage))
              (display (hemlock-buffer-string-cache ts-string)))
         (reset-buffer-cache display) 
@@ -1955 +1868 @@
       (when (%null-ptr-p string)
         (if (zerop selected-encoding)
-          (setq selected-encoding (#/defaultCStringEncoding ns:ns-string)))
+          (setq selected-encoding (get-default-encoding)))
         (setq string (#/stringWithContentsOfURL:encoding:error:
                       ns:ns-string
@@ -1963 +1876 @@
       (unless (%null-ptr-p string)
         (with-slots (encoding) self (setq encoding selected-encoding))
+        (hi::queue-buffer-change buffer)
         (hi::document-begin-editing self)
         (nsstring-to-buffer string buffer)
         (let* ((textstorage (slot-value self 'textstorage))
-               (display (hemlock-buffer-string-cache (#/string textstorage))))
+               (display (hemlock-buffer-string-cache (#/hemlockString textstorage))))
           (reset-buffer-cache display) 
           (#/updateCache textstorage)
@@ -1992 +1906 @@
 
 (defmethod hemlock-document-buffer (document)
-  (let* ((string (#/string (slot-value document 'textstorage))))
+  (let* ((string (#/hemlockString (slot-value document 'textstorage))))
     (unless (%null-ptr-p string)
       (let* ((cache (hemlock-buffer-string-cache string)))
@@ -2008 +1922 @@
     panes))
 
-
+(objc:defmethod (#/noteEncodingChange: :void) ((self hemlock-editor-document)
+                                               popup)
+  (with-slots (encoding) self
+    (setq encoding (#/selectedTag popup))
+    ;; Force modeline update.
+    (hi::queue-buffer-change (hemlock-document-buffer self))))
 
 (objc:defmethod (#/prepareSavePanel: :<BOOL>) ((self hemlock-editor-document)
                                                panel)
   (with-slots (encoding) self
-    (let* ((popup (build-encodings-popup (#/sharedDocumentController ns:ns-document-controller) encoding)))      
+    (let* ((popup (build-encodings-popup (#/sharedDocumentController ns:ns-document-controller) encoding)))
+      (#/setAction: popup (@selector #/noteEncodingChange:))
+      (#/setTarget: popup self)
       (#/setAccessoryView: panel popup)))
   (#/setExtensionHidden: panel nil)
@@ -2030 +1951 @@
     (let* ((string (#/string textstorage))
            (buffer (hemlock-document-buffer self)))
-      (case (when buffer (hi::buffer-external-format buffer))
+      (case (when buffer (hi::buffer-line-termination buffer))
         (:cp/m (setq string (#/stringByReplacingOccurrencesOfString:withString:
                              string *ns-lf-string* *ns-crlf-string*)))
@@ -2056 +1977 @@
 
 
-(def-cocoa-default *initial-editor-x-pos* :float 200.0f0 "X position of upper-left corner of initial editor")
-
-(def-cocoa-default *initial-editor-y-pos* :float 400.0f0 "Y position of upper-left corner of initial editor")
+(def-cocoa-default *initial-editor-x-pos* :float 20.0f0 "X position of upper-left corner of initial editor")
+
+(def-cocoa-default *initial-editor-y-pos* :float -20.0f0 "Y position of upper-left corner of initial editor")
 
 (defloadvar *next-editor-x-pos* nil) ; set after defaults initialized
 (defloadvar *next-editor-y-pos* nil)
+
+(defun x-pos-for-window (window x)
+  (let* ((frame (#/frame window))
+         (screen (#/screen window)))
+    (if (%null-ptr-p screen) (setq screen (#/mainScreen ns:ns-screen)))
+    (let* ((screen-rect (#/visibleFrame screen)))
+      (if (>= x 0)
+        (+ x (ns:ns-rect-x screen-rect))
+        (- (+ (ns:ns-rect-width screen-rect) x) (ns:ns-rect-width frame))))))
+
+(defun y-pos-for-window (window y)
+  (let* ((frame (#/frame window))
+         (screen (#/screen window)))
+    (if (%null-ptr-p screen) (setq screen (#/mainScreen ns:ns-screen)))
+    (let* ((screen-rect (#/visibleFrame screen)))
+      (if (>= y 0)
+        (+ y (ns:ns-rect-y screen-rect) (ns:ns-rect-height frame))
+        (+ (ns:ns-rect-height screen-rect) y)))))
 
 (objc:defmethod (#/makeWindowControllers :void) ((self hemlock-editor-document))
   #+debug
   (#_NSLog #@"Make window controllers")
-  (let* ((window (%hemlock-frame-for-textstorage 
-                                    (slot-value self 'textstorage)
-                                    *editor-columns*
-                                    *editor-rows*
-                                    nil
-                                    (textview-background-color self)))
+  (let* ((textstorage  (slot-value self 'textstorage))
+         (window (%hemlock-frame-for-textstorage 
+                  textstorage
+                  *editor-columns*
+                  *editor-rows*
+                  nil
+                  (textview-background-color self)
+                  (user-input-style self)))
          (controller (make-instance
                       'hemlock-editor-window-controller
@@ -2079 +2020 @@
     (ns:with-ns-point  (current-point
                         (or *next-editor-x-pos*
-                            *initial-editor-x-pos*)
+                            (x-pos-for-window window *initial-editor-x-pos*))
                         (or *next-editor-y-pos*
-                            *initial-editor-y-pos*))
+                            (y-pos-for-window window *initial-editor-y-pos*)))
       (let* ((new-point (#/cascadeTopLeftFromPoint: window current-point)))
         (setq *next-editor-x-pos* (ns:ns-point-x new-point)
@@ -2105 +2046 @@
 
 (defun hi::scroll-window (textpane n)
-  (declare (ignore textpane))
-  (let* ((point (hi::current-point)))
-    (or (hi::line-offset point (if (and n (< n 0)) -24 24) 0))))
+  (let* ((n (or n 0))
+         (sv (text-pane-scroll-view textpane))
+         (tv (text-pane-text-view textpane))
+         (char-height (text-view-char-height tv))
+         (sv-height (ns:ns-size-height (#/contentSize sv)))
+         (nlines (floor sv-height char-height))
+         (point (hi::current-point)))
+    (or (hi::line-offset point (* n nlines))        
+        (if (< n 0)
+          (hi::buffer-start point)
+          (hi::buffer-end point)))))
 
 (defmethod hemlock::center-text-pane ((pane text-pane))
-  (#/centerSelectionInVisibleArea: (text-pane-text-view pane) +null-ptr+))
+  (#/performSelectorOnMainThread:withObject:waitUntilDone:
+   (text-pane-text-view pane)
+   (@selector #/centerSelectionInVisibleArea:)
+   +null-ptr+
+   t))
 
 
@@ -2137 +2090 @@
     
 
+(defun nsstring-for-nsstring-encoding (ns)
+  (let* ((iana (iana-charset-name-of-nsstringencoding ns)))
+    (if (%null-ptr-p iana)
+      (#/stringWithFormat: ns:ns-string #@"{%@}"
+                           (#/localizedNameOfStringEncoding: ns:ns-string ns))
+      iana)))
+      
 ;;; Return a list of :<NSS>tring<E>ncodings, sorted by the
 ;;; (localized) name of each encoding.
@@ -2151 +2111 @@
                                 (= #$NSOrderedAscending
                                    (#/localizedCompare:
-                                    (#/localizedNameOfStringEncoding: ns:ns-string x)
-                                    (#/localizedNameOfStringEncoding: ns:ns-string y))))))
+                                    (nsstring-for-nsstring-encoding x)
+                                    (nsstring-for-nsstring-encoding y))))))
               (ids id))))))))
 
@@ -2166 +2126 @@
     (#/setTag: (#/itemAtIndex: popup 0) 0)
     (dolist (id id-list)
-      (#/addItemWithTitle: popup (#/localizedNameOfStringEncoding: ns:ns-string id))
+      (#/addItemWithTitle: popup (nsstring-for-nsstring-encoding id))
       (#/setTag: (#/lastItem popup) id))
     (when preferred-encoding
@@ -2206 +2166 @@
 ;;; This needs to run on the main thread.
 (objc:defmethod (#/updateHemlockSelection :void) ((self hemlock-text-storage))
-  (let* ((string (#/string self))
+  (let* ((string (#/hemlockString self))
          (buffer (buffer-cache-buffer (hemlock-buffer-string-cache string)))
          (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
@@ -2283 +2243 @@
         (#/replaceCharactersInRange:withString: textstorage selectedrange string)))))
 
-           
+(defun hi::edit-definition (name)
+  (let* ((info (get-source-files-with-types&classes name)))
+    (if info
+      (if (cdr info)
+        (edit-definition-list name info)
+        (edit-single-definition name (car info))))))
+
+
+(defun find-definition-in-document (name indicator document)
+  (let* ((buffer (hemlock-document-buffer document))
+         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)))
+    (hemlock::find-definition-in-buffer buffer name indicator)))
+
+
+(defstatic *edit-definition-id-map* (make-id-map))
+
+;;; Need to force things to happen on the main thread.
+(defclass cocoa-edit-definition-request (ns:ns-object)
+    ((name-id :foreign-type :int)
+     (info-id :foreign-type :int))
+  (:metaclass ns:+ns-object))
+
+(objc:defmethod #/initWithName:info:
+    ((self cocoa-edit-definition-request)
+     (name :int) (info :int))
+  (#/init self)
+  (setf (slot-value self 'name-id) name
+        (slot-value self 'info-id) info)
+  self)
+
+(objc:defmethod (#/editDefinition: :void)
+    ((self hemlock-document-controller) request)
+  (let* ((name (id-map-free-object *edit-definition-id-map* (slot-value request 'name-id)))
+         (info (id-map-free-object *edit-definition-id-map* (slot-value request 'info-id))))
+    (destructuring-bind (indicator . pathname) info
+      (let* ((namestring (native-translated-namestring pathname))
+             (url (#/initFileURLWithPath:
+                   (#/alloc ns:ns-url)
+                   (%make-nsstring namestring)))
+             (document (#/openDocumentWithContentsOfURL:display:error:
+                        self
+                        url
+                        nil
+                        +null-ptr+)))
+        (unless (%null-ptr-p document)
+          (if (= (#/count (#/windowControllers document)) 0)
+            (#/makeWindowControllers document))
+          (find-definition-in-document name indicator document)
+          (#/updateHemlockSelection (slot-value document 'textstorage))
+          (#/showWindows document))))))
+
+(defun edit-single-definition (name info)
+  (let* ((request (make-instance 'cocoa-edit-definition-request
+                                 :with-name (assign-id-map-id *edit-definition-id-map* name)
+                                 :info (assign-id-map-id *edit-definition-id-map* info))))
+    (#/performSelectorOnMainThread:withObject:waitUntilDone:
+     (#/sharedDocumentController ns:ns-document-controller)
+     (@selector #/editDefinition:)
+     request
+     t)))
+
+                                        
+(defun edit-definition-list (name infolist)
+  (make-instance 'sequence-window-controller
+                 :sequence infolist
+                 :result-callback #'(lambda (info)
+                                      (edit-single-definition name info))
+                 :key #'car
+                 :title (format nil "Definitions of ~s" name)))
+
+                                       
+