Index: /branches/ide-1.0/ccl/examples/cocoa-editor.lisp =================================================================== --- /branches/ide-1.0/ccl/examples/cocoa-editor.lisp (revision 6708) +++ /branches/ide-1.0/ccl/examples/cocoa-editor.lisp (revision 6709) @@ -418,5 +418,5 @@ (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,18 +430,20 @@ (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,5 +501,5 @@ ((self hemlock-text-storage) (index :nteger) (rangeptr (* :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,5 +515,5 @@ (objc:defmethod (#/replaceCharactersInRange:withString: :void) ((self hemlock-text-storage) (r :ange) string) - #+debug (#_NSLog #@"Replace in range %ld/%ld with %@" + #+debug (#_NSLog #@"Replace in range %ld/%ld with %@" :nteger (pref r :ange.location) :nteger (pref r :ange.length) @@ -598,5 +600,20 @@ (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 :nteger) + (max-lines :nteger) + (next-index (:* :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,7 +745,9 @@ + ;;; 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,4 +1128,6 @@ (#/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,5 +1155,5 @@ (#/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,4 +1188,5 @@ (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,5 +1302,4 @@ (:metaclass ns:+ns-object)) - (defun double-%-in (string) ;; Replace any % characters in string with %%, to keep them from @@ -1404,6 +1425,6 @@ (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,8 +1440,8 @@ 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,6 +1500,6 @@ ;;; 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,8 +1520,8 @@ -(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,7 +1631,8 @@ (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,4 +1776,13 @@ (:metaclass ns:+ns-object)) + +(objc:defmethod (#/validateMenuItem: :) + ((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,5 +2037,6 @@ (#_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,4 +2275,15 @@ (#/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,10 +2353,40 @@ :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: :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")