Index: /branches/ide-1.0/ccl/examples/cocoa-editor.lisp
===================================================================
--- /branches/ide-1.0/ccl/examples/cocoa-editor.lisp	(revision 6588)
+++ /branches/ide-1.0/ccl/examples/cocoa-editor.lisp	(revision 6589)
@@ -161,5 +161,5 @@
   (when buffer-p (setf (buffer-cache-buffer d) buffer))
   (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-	 (workline (hi::mark-line
+         (workline (hi::mark-line
 		    (hi::buffer-start-mark buffer))))
     (setf (buffer-cache-buflen d) (hemlock-buffer-length buffer)
@@ -177,6 +177,6 @@
         (incf (buffer-cache-workline-offset display) n)
         (when (>= (+ (buffer-cache-workline-offset display)
-                    (buffer-cache-workline-length display))
-                 pos)
+                     (buffer-cache-workline-length display))
+                  pos)
           (setf (buffer-cache-workline-length display)
                 (hi::line-length (buffer-cache-workline display)))))
@@ -192,6 +192,6 @@
 (defun update-line-cache-for-index (cache index)
   (let* ((buffer (buffer-cache-buffer cache))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-	 (line (or
+         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+         (line (or
 		(buffer-cache-workline cache)
 		(progn
@@ -229,5 +229,5 @@
 (defun hemlock-char-at-index (cache index)
   (let* ((hi::*buffer-gap-context*
-	  (hi::buffer-gap-context (buffer-cache-buffer cache))))
+          (hi::buffer-gap-context (buffer-cache-buffer cache))))
     (multiple-value-bind (line idx) (update-line-cache-for-index cache index)
       (let* ((len (hemlock::line-length line)))
@@ -240,10 +240,10 @@
 (defun move-hemlock-mark-to-absolute-position (mark cache abspos)
   (let* ((hi::*buffer-gap-context*
-	  (hi::buffer-gap-context (buffer-cache-buffer cache))))
+          (hi::buffer-gap-context (buffer-cache-buffer cache))))
     (multiple-value-bind (line idx) (update-line-cache-for-index cache abspos)
       #+debug
       (#_NSLog #@"Moving point from current pos %d to absolute position %d"
-	       :int (mark-absolute-position mark)
-	       :int abspos)
+               :int (mark-absolute-position mark)
+               :int abspos)
       (hemlock::move-to-position mark idx line)
       #+debug
@@ -255,6 +255,6 @@
 (defun mark-absolute-position (mark)
   (let* ((pos (hi::mark-charpos mark))
-         (hi::*buffer-gap-context* (hi::buffer-gap-context (hi::line-%buffer
-                                                            (hi::mark-line mark)))))
+         (hi::*buffer-gap-context*
+          (hi::buffer-gap-context (hi::line-%buffer (hi::mark-line mark)))))
     (do* ((line (hi::line-previous (hi::mark-line mark))
 		(hi::line-previous line)))
@@ -289,5 +289,5 @@
          (length (ns:ns-range-length r))
          (hi::*buffer-gap-context*
-	  (hi::buffer-gap-context (buffer-cache-buffer cache))))
+          (hi::buffer-gap-context (buffer-cache-buffer cache))))
     #+debug
     (#_NSLog #@"get characters: %d/%d"
@@ -356,5 +356,5 @@
      (flag :<BOOL>))
   (let* ((buffer (buffer-cache-buffer (hemlock-buffer-string-cache self)))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+         (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)))
@@ -533,5 +533,5 @@
                               (- endpos startpos)
                               (hi::font-mark-font start))))))
-      #+debug
+      #+debug 
       (#_NSLog #@"Start = %d, len = %d, style = %d"
                :int start :int len :int style)
@@ -545,6 +545,6 @@
   (let* ((cache (hemlock-buffer-string-cache (#/string  self)))
 	 (buffer (if cache (buffer-cache-buffer cache)))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-	 (location (pref r :<NSR>ange.location))
+         (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))
@@ -774,31 +774,31 @@
       (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))))
+        (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))))
 
   
@@ -1299,4 +1299,5 @@
   (let* ((message (#/objectAtIndex: info 0))
          (signal (#/objectAtIndex: info 1)))
+    (#_NSLog #@"runErrorSheet: signal = %@" :id signal)
     (#_NSBeginAlertSheet #@"Error in Hemlock command processing" ;title
                          (if (logbitp 0 (random 2))
@@ -1313,9 +1314,12 @@
 
 (objc:defmethod (#/sheetDidEnd:returnCode:contextInfo: :void) ((self hemlock-frame))
- (declare (ignore sheet code info)))
+ (declare (ignore sheet code info))
+  #+debug
+  (#_NSLog #@"Sheet did end"))
 
 (objc:defmethod (#/sheetDidDismiss:returnCode:contextInfo: :void)
     ((self hemlock-frame) sheet code info)
   (declare (ignore sheet code))
+  #+debug (#_NSLog #@"dismiss sheet: semaphore = %lx" :unsigned-doubleword (#/unsignedLongValue info))
   (ccl::%signal-semaphore-ptr (%int-to-ptr (#/unsignedLongValue info))))
   
@@ -1325,11 +1329,13 @@
          (sem-value (make-instance 'ns:ns-number
                                    :with-unsigned-long (%ptr-to-int (semaphore.value semaphore)))))
-    (%stack-block ((paramptrs (ash 2 target::word-shift)))
-      (setf (%get-ptr paramptrs 0) message
-            (%get-ptr paramptrs (ash 1 target::word-shift)) sem-value)
+    #+debug
+    (#_NSLog #@"created semaphore with value %lx" :address (semaphore.value semaphore))
+    (rlet ((paramptrs (:array :id 2)))
+      (setf (paref paramptrs (:array :id) 0) message
+            (paref paramptrs (:array :id) 1) sem-value)
       (let* ((params (make-instance 'ns:ns-array
                                     :with-objects paramptrs
                                     :count 2))
-             (*debug-io* *typeout-stream*))
+             #|(*debug-io* *typeout-stream*)|#)
         (stream-clear-output *debug-io*)
         (print-call-history :detailed-p nil)
@@ -1364,5 +1370,5 @@
          (hi::*last-key-event-typed* nil)
          (hi::*input-transcript* nil)
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
          (hemlock::*target-column* 0)
          (hemlock::*last-comment-start* " ")
@@ -1500,5 +1506,5 @@
 (defun nsstring-to-buffer (nsstring buffer)
   (let* ((document (hi::buffer-document buffer))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
          (region (hi::buffer-region buffer)))
     (setf (hi::buffer-document buffer) nil)
@@ -1521,5 +1527,5 @@
   (let* ((lisp-namestring (native-translated-namestring lisp-pathname))
          (cocoa-pathname (%make-nsstring lisp-namestring))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
 	 (data (make-instance 'ns:ns-data
                               :with-contents-of-file cocoa-pathname))
@@ -1767,5 +1773,6 @@
 
 (defclass hemlock-editor-document (ns:ns-document)
-    ((textstorage :foreign-type :id))
+    ((textstorage :foreign-type :id)
+     (encoding :foreign-type :<NSS>tring<E>ncoding))
   (:metaclass ns:+ns-object))
 
@@ -1837,36 +1844,57 @@
                                :modes '("Lisp" "Editor")))))
     doc))
-                     
-(objc:defmethod (#/readFromFile:ofType: :<BOOL>)
-    ((self hemlock-editor-document) filename type)
+
+  
+(objc:defmethod (#/readFromURL:ofType:error: :<BOOL>)
+    ((self hemlock-editor-document) url type (perror (:* :id)))
   (declare (ignorable type))
-  (let* ((pathname (lisp-string-from-nsstring filename))
-	 (buffer-name (hi::pathname-to-buffer-name pathname))
-	 (buffer (or
-		  (hemlock-document-buffer self)
-		  (let* ((b (make-hemlock-buffer buffer-name)))
-		    (setf (hi::buffer-pathname b) pathname)
-		    (setf (slot-value self 'textstorage)
-			  (make-textstorage-for-hemlock-buffer b))
-		    b)))
-	 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
-	 (data (make-instance 'ns:ns-data :with-contents-of-file filename))
-	 (string (make-instance 'ns:ns-string
-                                :with-data data
-                                :encoding #$NSASCIIStringEncoding)))
-    (hi::document-begin-editing self)
-    (nsstring-to-buffer string buffer)
-    (let* ((textstorage (slot-value self 'textstorage))
-	   (display (hemlock-buffer-string-cache (#/string textstorage))))
-      (reset-buffer-cache display) 
-      (update-line-cache-for-index display 0)
-      (textstorage-note-insertion-at-position
-       textstorage
-       0
-       (hemlock-buffer-length buffer)))
-    (hi::document-end-editing self)
-    (setf (hi::buffer-modified buffer) nil)
-    (hi::process-file-options buffer pathname)
-    t))
+  (rlet ((pused-encoding :<NSS>tring<E>ncoding 0))
+    (let* ((pathname
+            (lisp-string-from-nsstring
+             (if (#/isFileURL url)
+               (#/path url)
+               (#/absoluteString url))))
+           (buffer-name (hi::pathname-to-buffer-name pathname))
+           (buffer (or
+                    (hemlock-document-buffer self)
+                    (let* ((b (make-hemlock-buffer buffer-name)))
+                      (setf (hi::buffer-pathname b) pathname)
+                      (setf (slot-value self 'textstorage)
+                            (make-textstorage-for-hemlock-buffer b))
+                      b)))
+           (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
+           (selected-encoding (slot-value (#/sharedDocumentController (find-class 'hemlock-document-controller)) 'last-encoding))
+           (string
+            (if (zerop selected-encoding)
+              (#/stringWithContentsOfURL:usedEncoding:error:
+               ns:ns-string
+               url
+               pused-encoding
+               perror)
+              +null-ptr+)))
+      (when (%null-ptr-p string)
+        (if (zerop selected-encoding)
+          (setq selected-encoding (#/defaultCStringEncoding ns:ns-string)))
+        (setq string (#/stringWithContentsOfURL:encoding:error:
+                      ns:ns-string
+                      url
+                      selected-encoding
+                      perror)))
+      (unless (%null-ptr-p string)
+        (with-slots (encoding) self (setq encoding selected-encoding))
+        (hi::document-begin-editing self)
+        (nsstring-to-buffer string buffer)
+        (let* ((textstorage (slot-value self 'textstorage))
+               (display (hemlock-buffer-string-cache (#/string textstorage))))
+          (reset-buffer-cache display) 
+          (update-line-cache-for-index display 0)
+          (textstorage-note-insertion-at-position
+           textstorage
+           0
+           (hemlock-buffer-length buffer)))
+        (hi::document-end-editing self)
+        (setf (hi::buffer-modified buffer) nil)
+        (hi::process-file-options buffer pathname)
+        t))))
 
 #+experimental
@@ -1967,8 +1995,5 @@
 
 
-(defun initialize-user-interface ()
-  (#/sharedPanel preferences-panel)
-  (update-cocoa-defaults)
-  (make-editor-style-map))
+
 
 (defun hi::scroll-window (textpane n)
@@ -1981,7 +2006,73 @@
 
 
+(defclass hemlock-document-controller (ns:ns-document-controller)
+    ((last-encoding :foreign-type :<NSS>tring<E>ncoding))
+  (:metaclass ns:+ns-object))
+
+(defloadvar *hemlock-document-controller* nil "Shared document controller")
+
+(objc:defmethod #/sharedDocumentController ((self +hemlock-document-controller))
+  (or *hemlock-document-controller*
+      (setq *hemlock-document-controller* (#/init (#/alloc self)))))
+
+(objc:defmethod #/init ((self hemlock-document-controller))
+  (if *hemlock-document-controller*
+    (progn
+      (#/release self)
+      *hemlock-document-controller*)
+    (prog1
+      (setq *hemlock-document-controller* (call-next-method))
+      (setf (slot-value *hemlock-document-controller* 'last-encoding) 0))))
+
+;;; Return a list of :<NSS>tring<E>ncodings, sorted by the
+;;; (localized) name of each encoding.
+(defun supported-nsstring-encodings ()
+  (collect ((ids))
+    (let* ((ns-ids (#/availableStringEncodings ns:ns-string)))
+      (unless (%null-ptr-p ns-ids)
+        (do* ((i 0 (1+ i)))
+             ()
+          (let* ((id (paref ns-ids (:* :<NSS>tring<E>ncoding) i)))
+            (if (zerop id)
+              (return (sort (ids)
+                            #'(lambda (x y)
+                                (= #$NSOrderedAscending
+                                   (#/localizedCompare:
+                                    (#/localizedNameOfStringEncoding: ns:ns-string x)
+                                    (#/localizedNameOfStringEncoding: ns:ns-string y))))))
+              (ids id))))))))
+
+;;; TexEdit.app has support for allowing the encoding list in this
+;;; popup to be customized (e.g., to suppress encodings that the
+;;; user isn't interested in.)
+(defmethod build-encodings-popup ((self hemlock-document-controller)
+                                  &optional (preferred-encoding 0))
+  (let* ((id-list (supported-nsstring-encodings))
+         (popup (make-instance 'ns:ns-pop-up-button)))
+    ;;; Add a fake "Automatic" item with tag 0.
+    (#/addItemWithTitle: popup #@"Automatic")
+    (#/setTag: (#/itemAtIndex: popup 0) 0)
+    (dolist (id id-list)
+      (#/addItemWithTitle: popup (#/localizedNameOfStringEncoding: ns:ns-string id))
+      (#/setTag: (#/lastItem popup) id))
+    (when preferred-encoding
+      (#/selectItemWithTag: popup preferred-encoding))
+    (#/sizeToFit popup)
+    popup))
+
+
+(objc:defmethod (#/runModalOpenPanel:forTypes: :<NSI>nteger)
+    ((self hemlock-document-controller) panel types)
+  (let* ((popup (build-encodings-popup self #|preferred|#)))
+    (#/setAccessoryView: panel popup)
+    (let* ((result (call-next-method panel types)))
+      (when (= result #$NSOKButton)
+        (with-slots (last-encoding) self
+          (setq last-encoding (#/tag (#/selectedItem popup)))))
+      result)))
+  
 (defun hi::open-document ()
   (#/performSelectorOnMainThread:withObject:waitUntilDone:
-   (#/sharedDocumentController ns:ns-document-controller)
+   (#/sharedDocumentController hemlock-document-controller)
    (@selector #/openDocument:) +null-ptr+ t))
   
@@ -1994,4 +2085,10 @@
   (#/performSelectorOnMainThread:withObject:waitUntilDone:
    self (@selector #/saveDocumentAs:) +null-ptr+ t))
+
+(defun initialize-user-interface ()
+  (#/sharedDocumentController hemlock-document-controller)
+  (#/sharedPanel preferences-panel)
+  (update-cocoa-defaults)
+  (make-editor-style-map))
 
 ;;; This needs to run on the main thread.