Changeset 6709

Timestamp:

Jun 12, 2007, 12:56:02 PM (17 years ago)

Author:

Gary Byers

Message:

Mostly commented-out debugging stuff. listener windows have their
own class (for cmd-L), hyperspec lookup.

File:

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

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

@@ -418 +418 @@
   (let* ((pos (#/longValue (#/objectAtIndex: params 0)))
          (n (#/longValue (#/objectAtIndex: params 1))))
-    #+debug
+    #+debug 0
     (#_NSLog #@"Note modification: pos = %d, n = %d" :int pos :int n)
     (#/edited:range:changeInLength: self (logior #$NSTextStorageEditedCharacters
@@ -430 +430 @@
 
 (objc:defmethod (#/beginEditing :void) ((self hemlock-text-storage))
-  #+debug
-  (#_NSLog #@"begin-editing")
-  (incf (slot-value self 'edit-count))
-  #+debug
-  (#_NSLog #@"after beginEditing edit-count now = %d" :int (slot-value self 'edit-count))
-  (call-next-method))
+  (with-slots (edit-count) self
+    #+debug
+    (#_NSLog #@"begin-editing")
+    (incf edit-count)
+    #+debug
+    (#_NSLog #@"after beginEditing on %@ edit-count now = %d" :id self :int edit-count)
+    (call-next-method)))
 
 (objc:defmethod (#/endEditing :void) ((self hemlock-text-storage))
-  #+debug
-  (#_NSLog #@"end-editing")
-  (call-next-method)
-  (decf (slot-value self 'edit-count))
-  #+debug
-  (#_NSLog #@"after endEditing edit-count now = %d" :int (slot-value self 'edit-count)))
+  (with-slots (edit-count) self
+    #+debug
+    (#_NSLog #@"end-editing")
+    (call-next-method)
+    (decf edit-count)
+    #+debug
+    (#_NSLog #@"after endEditing on %@, edit-count now = %d" :id self :int edit-count)))
 
 ;;; Return true iff we're inside a "beginEditing/endEditing" pair
@@ -499 +501 @@
     ((self hemlock-text-storage) (index :<NSUI>nteger) (rangeptr (* :<NSR>ange)))
   #+debug
-  (#_NSLog #@"Attributes at index: %d" :unsigned index)
+  (#_NSLog #@"Attributes at index: %d storage %@" :unsigned index :id self)
   (with-slots (cache) self
     (let* ((attrs (#/attributesAtIndex:effectiveRange: cache index rangeptr)))
@@ -513 +515 @@
 (objc:defmethod (#/replaceCharactersInRange:withString: :void)
     ((self hemlock-text-storage) (r :<NSR>ange) string)
-  #+debug  (#_NSLog #@"Replace in range %ld/%ld with %@"
+  #+debug (#_NSLog #@"Replace in range %ld/%ld with %@"
                     :<NSI>nteger (pref r :<NSR>ange.location)
                     :<NSI>nteger (pref r :<NSR>ange.length)
@@ -598 +600 @@
          (hi::delete-string (hi::buffer-name buffer) hi::*buffer-names*))))))
 
-      
+
+
+;;; Mostly experimental, so that we can see what happens when a 
+;;; real typesetter is used.
+(defclass hemlock-ats-typesetter (ns:ns-ats-typesetter)
+    ()
+  (:metaclass ns:+ns-object))
+
+(objc:defmethod (#/layoutGlyphsInLayoutManager:startingAtGlyphIndex:maxNumberOfLineFragments:nextGlyphIndex: :void)
+    ((self hemlock-ats-typesetter)
+     layout-manager
+     (start-index :<NSUI>nteger)
+     (max-lines :<NSUI>nteger)
+     (next-index (:* :<NSUI>nteger)))
+  (#_NSLog #@"layoutGlyphs: start = %d, maxlines = %d" :int start-index :int max-lines)
+  (call-next-method layout-manager start-index max-lines next-index))
 
 
@@ -728 +745 @@
 
 
+
 ;;; Access the underlying buffer in one swell foop.
 (defmethod text-view-buffer ((self hemlock-text-view))
   (buffer-cache-buffer (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self)))))
+
 
 
@@ -1109 +1128 @@
     (#/setAutoresizesSubviews: (#/contentView scrollview) t)
     (let* ((layout (make-instance 'ns:ns-layout-manager)))
+      #+suffer
+      (#/setTypesetter: layout (make-instance 'hemlock-ats-typesetter))
       (#/addLayoutManager: textstorage layout)
       (#/setUsesScreenFonts: layout t)
@@ -1134 +1155 @@
                 (#/setTypingAttributes: tv (aref *styles* style))
                 (#/setSmartInsertDeleteEnabled: tv nil)
-                (#/setAllowsUndo: tv t)
+                (#/setAllowsUndo: tv nil) ; don't want NSTextView undo
                 (#/setUsesFindPanel: tv t)
                 (#/setWidthTracksTextView: container tracks-width)
@@ -1167 +1188 @@
   (let* ((the-hemlock-frame (#/window view))
          (text-view (text-pane-text-view view)))
+    #+debug (#_NSLog #@"Activating text pane")
     (#/makeFirstResponder: the-hemlock-frame text-view)))
 
@@ -1280 +1302 @@
   (:metaclass ns:+ns-object))
 
-
 (defun double-%-in (string)
   ;; Replace any % characters in string with %%, to keep them from
@@ -1404 +1425 @@
   (call-next-method))
   
-(defun new-hemlock-document-window ()
-  (let* ((w (new-cocoa-window :class hemlock-frame
+(defun new-hemlock-document-window (class)
+  (let* ((w (new-cocoa-window :class class
                               :activate nil)))
       (values w (add-pane-to-window w :reserve-below 20.0))))
@@ -1419 +1440 @@
         pane))))
 
-(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width color style)
+(defun textpane-for-textstorage (class ts ncols nrows container-tracks-text-view-width color style)
   (let* ((pane (nth-value
                 1
-                (new-hemlock-document-window))))
+                (new-hemlock-document-window class))))
     (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width color style)
     (multiple-value-bind (height width)
@@ -1479 +1500 @@
 
 ;;; This function must run in the main event thread.
-(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))
+(defun %hemlock-frame-for-textstorage (class ts ncols nrows container-tracks-text-view-width color style)
+  (let* ((pane (textpane-for-textstorage class ts ncols nrows container-tracks-text-view-width color style))
          (frame (#/window pane))
          (buffer (text-view-buffer (text-pane-text-view pane))))
@@ -1499 +1520 @@
 
 
-(defun hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color style)
+(defun hemlock-frame-for-textstorage (class 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 style))
+                     class ts  ncols nrows container-tracks-text-view-width color style))
 
 
@@ -1610 +1631 @@
           (adjust-buffer-cache-for-insertion display pos n)
           (update-line-cache-for-index display pos)
-          (#/replaceCharactersInRange:withString:
-           cache (ns:make-ns-range pos 0)
-           (#/substringWithRange: hemlock-string (ns:make-ns-range pos n)))
+          (let* ((replacestring (#/substringWithRange: hemlock-string (ns:make-ns-range pos n))))
+            (ns:with-ns-range (replacerange pos 0)
+              (#/replaceCharactersInRange:withString:
+               cache replacerange replacestring)))
           (#/setAttributes:range: cache font (ns:make-ns-range pos n))
           #-all-in-cocoa-thread
@@ -1754 +1776 @@
   (:metaclass ns:+ns-object))
 
+
+(objc:defmethod (#/validateMenuItem: :<BOOL>)
+    ((self hemlock-editor-document) item)
+  (let* ((action (#/action item)))
+    (#_NSLog #@"action = %s" :address action)
+    (if (eql action (@selector #/hyperSpecLookUp:))
+      ;;; For now, demand a selection.
+      (not (eql 0 (ns:ns-range-length (#/selectedRange self))))
+      (call-next-method item))))
 
 (defmethod user-input-style ((doc hemlock-editor-document))
@@ -2006 +2037 @@
   (#_NSLog #@"Make window controllers")
   (let* ((textstorage  (slot-value self 'textstorage))
-         (window (%hemlock-frame-for-textstorage 
+         (window (%hemlock-frame-for-textstorage
+                  hemlock-frame
                   textstorage
                   *editor-columns*
@@ -2243 +2275 @@
         (#/replaceCharactersInRange:withString: textstorage selectedrange string)))))
 
+(objc:defmethod (#/hyperSpecLookUp: :void)
+    ((self hemlock-text-view) sender)
+  (declare (ignore sender))
+  (let* ((range (#/selectedRange self)))
+    (unless (eql 0 (ns:ns-range-length range))
+      (let* ((string (nstring-upcase (lisp-string-from-nsstring (#/substringWithRange: (#/string (#/textStorage self)) range)))))
+        (multiple-value-bind (symbol win) (find-symbol string "CL")
+          (when win
+            (lookup-hyperspec-symbol symbol self)))))))
+
+
 (defun hi::edit-definition (name)
   (let* ((info (get-source-files-with-types&classes name)))
@@ -2310 +2353 @@
                  :result-callback #'(lambda (info)
                                       (edit-single-definition name info))
-                 :key #'car
+                 :display #'(lambda (item stream)
+                              (prin1 (car item) stream))
                  :title (format nil "Definitions of ~s" name)))
 
                                        
-  
+(objc:defmethod (#/documentClassForType: :<C>lass) ((self hemlock-document-controller)
+                                         type)
+  (if (#/isEqualToString: type #@"html")
+    display-document
+    (call-next-method type)))
       
-  
+
+(objc:defmethod #/newDisplayDocumentWithTitle:content:
+    ((self hemlock-document-controller)
+     title
+     string)
+  (let* ((doc (#/makeUntitledDocumentOfType:error: self #@"html" +null-ptr+)))
+    (unless (%null-ptr-p doc)
+      (#/addDocument: self doc)
+      (#/makeWindowControllers doc)
+      (let* ((window (#/window (#/objectAtIndex: (#/windowControllers doc) 0))))
+        (#/setTitle: window title)
+        (let* ((tv (slot-value doc 'text-view))
+               (lm (#/layoutManager tv))
+               (ts (#/textStorage lm)))
+          (#/beginEditing ts)
+          (#/replaceCharactersInRange:withAttributedString:
+           ts
+           (ns:make-ns-range 0 (#/length ts))
+           string)
+          (#/endEditing ts))
+        (#/makeKeyAndOrderFront:
+         window
+         self)))))
+
+
+
 (provide "COCOA-EDITOR")