Changeset 869


Ignore:
Timestamp:
Aug 30, 2004, 3:20:12 PM (20 years ago)
Author:
Gary Byers
Message:

Lots of changes, mostly:

  • try to speed up callbacks that fetch characters from the virtual nsstring
  • kill echo-area buffers when closing windows
  • windows should be released when closed; documents should close when the last window closes.
  • try not to invalidate the buffer cache on insertions
  • disable background layout before closing the window (in case that's still going on ...)
  • clear the buffer's modified state when buffer is saved (not sure if the modeline indicator's updated correctly)
  • DISABLE-BLINK tells the layout manager to force redisplay of the (now non-blinking) character.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ccl/examples/cocoa-editor.lisp

    r856 r869  
    99
    1010(eval-when (:compile-toplevel :execute)
     11  (pushnew :all-in-cocoa-thread *features*)
    1112  (use-interface-dir :cocoa))
    1213
    … …  
    157158
    158159
     160(defun adjust-buffer-cache-for-insertion (display pos n)
     161  (if (buffer-cache-workline display)
     162    (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context (buffer-cache-buffer display))))
     163      (if (> (buffer-cache-workline-offset display) pos)
     164        (incf (buffer-cache-workline-offset display) n)
     165        (when (>= (+ (buffer-cache-workline-offset display)
     166                    (buffer-cache-workline-length display))
     167                 pos)
     168          (setf (buffer-cache-workline-length display)
     169                (hi::line-length (buffer-cache-workline display)))))
     170      (incf (buffer-cache-buflen display) n))
     171    (reset-buffer-cache display)))
     172
     173         
     174           
     175
    159176;;; Update the cache so that it's describing the current absolute
    160177;;; position.
     178
    161179(defun update-line-cache-for-index (cache index)
    162180  (let* ((buffer (buffer-cache-buffer cache))
    … …  
    179197                    (buffer-cache-workline-length cache) len))
    180198            (return (values line idx))))
    181         (setq moved t)
     199      (setq moved t)
    182200      (if (< index pos)
    183201        (setq line (hi::line-previous line)
    … …  
    242260
    243261
     262
    244263;;; Return the character at the specified index (as a :unichar.)
     264
    245265(define-objc-method ((:unichar :character-at-index (unsigned index))
    246266                     hemlock-buffer-string)
     267  #+debug
     268  (#_NSLog #@"Character at index: %d" :unsigned index)
    247269  (char-code (hemlock-char-at-index (hemlock-buffer-string-cache self) index)))
    248270
    249271
     272(define-objc-method ((:void :get-characters (:address buffer) :range (:<NSR>ange r))
     273                     hemlock-buffer-string)
     274  (let* ((cache (hemlock-buffer-string-cache self))
     275         (index (pref r :<NSR>ange.location))
     276         (length (pref r :<NSR>ange.length))
     277         (hi::*buffer-gap-context*
     278          (hi::buffer-gap-context (buffer-cache-buffer cache))))
     279    #+debug
     280    (#_NSLog #@"get characters: %d/%d"
     281             :unsigned index
     282             :unsigned length)
     283    (multiple-value-bind (line idx) (update-line-cache-for-index cache index)
     284      (let* ((len (hemlock::line-length line)))
     285        (do* ((i 0 (1+ i))
     286              (p 0 (+ p 2)))
     287             ((= i length))
     288          (cond ((< idx len)
     289                 (setf (%get-unsigned-word buffer p)
     290                       (char-code (hemlock::line-character line idx)))
     291                 (incf idx))
     292                (t
     293                 (setf (%get-unsigned-word buffer p)
     294                       (char-code #\Newline)
     295                       line (hi::line-next line)
     296                       len (hi::line-length line)
     297                  idx 0))))))))
     298
     299(define-objc-method ((:void :get-line-start ((:* :unsigned) startptr)
     300                            :end ((:* :unsigned) endptr)
     301                            :contents-end ((:* :unsigned) contents-endptr)
     302                            :for-range (:<NSR>ange r))
     303                     hemlock-buffer-string)
     304  (let* ((cache (hemlock-buffer-string-cache self))
     305         (index (pref r :<NSR>ange.location))
     306         (length (pref r :<NSR>ange.length))
     307         (hi::*buffer-gap-context*
     308          (hi::buffer-gap-context (buffer-cache-buffer cache))))
     309    #+debug 0
     310    (#_NSLog #@"get line start: %d/%d"
     311             :unsigned index
     312             :unsigned length)
     313    (update-line-cache-for-index cache index)
     314    (unless (%null-ptr-p startptr)
     315      ;; Index of the first character in the line which contains
     316      ;; the start of the range.
     317      (setf (pref startptr :unsigned)
     318            (buffer-cache-workline-offset cache)))
     319    (unless (%null-ptr-p endptr)
     320      ;; Index of the newline which terminates the line which
     321      ;; contains the start of the range.
     322      (setf (pref endptr :unsigned)
     323            (+ (buffer-cache-workline-offset cache)
     324               (buffer-cache-workline-length cache))))
     325    (unless (%null-ptr-p contents-endptr)
     326      ;; Index of the newline which terminates the line which
     327      ;; contains the start of the range.
     328      (unless (zerop length)
     329        (update-line-cache-for-index cache (+ index length)))
     330      (setf (pref contents-endptr :unsigned)
     331            (1+ (+ (buffer-cache-workline-offset cache)
     332                   (buffer-cache-workline-length cache)))))))
     333
     334                     
    250335;;; Return an NSData object representing the bytes in the string.  If
    251336;;; the underlying buffer uses #\linefeed as a line terminator, we can
    … …  
    260345         (external-format (if buffer (hi::buffer-external-format buffer )))
    261346         (raw-length (if buffer (hemlock-buffer-length buffer) 0)))
    262    
     347    (hi::%set-buffer-modified buffer nil)
    263348    (if (eql 0 raw-length)
    264349      (make-objc-instance 'ns:ns-mutable-data :with-length 0)
    … …  
    317402  (:metaclass ns:+ns-object))
    318403
     404(define-objc-method ((:unsigned :line-break-before-index (:unsigned index)
     405                                :within-range (:<NSR>ange r))
     406                     hemlock-text-storage)
     407  (#_NSLog #@"Line break before index: %d within range: %@"
     408           :unsigned index
     409           :id (#_NSStringFromRange r))
     410  (send-super :line-break-before-index index :within-range r))
     411
     412
    319413
    320414;;; Return true iff we're inside a "beginEditing/endEditing" pair
    … …  
    412506                          :effective-range ((* :<NSR>ange) rangeptr))
    413507                     hemlock-text-storage)
     508  #+debug
     509  (#_NSLog #@"Attributes at index: %d" :unsigned index)
    414510  (let* ((buffer-cache (hemlock-buffer-string-cache (slot-value self 'string)))
    415511         (buffer (buffer-cache-buffer buffer-cache))
    … …  
    472568  (let* ((layouts (send textstorage 'layout-managers)))
    473569    (unless (%null-ptr-p layouts)
    474       (dotimes (i (send layouts 'count))
     570      (dotimes (i (send (the ns:ns-array layouts) 'count))
    475571        (let* ((layout (send layouts :object-at-index i))
    476572               (containers (send layout 'text-containers)))
    477573          (unless (%null-ptr-p containers)
    478             (dotimes (j (send containers 'count))
     574            (dotimes (j (send (the ns:ns-array containers) 'count))
    479575              (let* ((container (send containers :object-at-index j))
    480576                     (tv (send container 'text-view)))
    … …  
    530626
    531627
    532 
     628(def-cocoa-default *layout-text-in-background* :int 1 "When non-zero, do text layout when idle.")
     629
     630(define-objc-method ((:void :layout-manager layout
     631                            :did-complete-layout-for-text-container cont
     632                            :at-end (:<BOOL> flag))
     633                     hemlock-textstorage-text-view)
     634  (declare (ignore cont))
     635  (when (zerop *layout-text-in-background*)
     636    (send layout :set-delegate (%null-ptr))
     637    (send layout :set-background-layout-enabled nil)))
     638   
    533639;;; Note changes to the textview's background color; record them
    534640;;; as the value of the "temporary" foreground color (for blinking).
    … …  
    545651                            :turned-on (:<BOOL> flag))
    546652                     hemlock-textstorage-text-view)
    547   (unless (eql #$NO (text-view-blink-enabled self))
    548     (let* ((layout (send self 'layout-manager))
    549            (container (send self 'text-container))
    550            (blink-color (text-view-blink-color self)))
    551       ;; We toggle the blinked character "off" by setting its
    552       ;; foreground color to the textview's background color.
    553       ;; The blinked character should be "on" whenever the insertion
    554       ;; point is drawn as "off"
    555       (slet ((glyph-range
    556               (send layout
    557                     :glyph-range-for-character-range
    558                     (ns-make-range (text-view-blink-location self) 1)
    559                     :actual-character-range (%null-ptr))))
    560         #+debug (#_NSLog #@"Flag = %d, location = %d" :<BOOL> (if flag #$YES #$NO) :int (text-view-blink-location self))
    561         (if flag
     653  (unless (send (send self 'text-storage) 'editing-in-progress)
     654    (unless (eql #$NO (text-view-blink-enabled self))
     655      (let* ((layout (send self 'layout-manager))
     656             (container (send self 'text-container))
     657             (blink-color (text-view-blink-color self)))
     658        ;; We toggle the blinked character "off" by setting its
     659        ;; foreground color to the textview's background color.
     660        ;; The blinked character should be "on" whenever the insertion
     661        ;; point is drawn as "off"
     662        (slet ((glyph-range
     663                (send layout
     664                      :glyph-range-for-character-range
     665                      (ns-make-range (text-view-blink-location self) 1)
     666                      :actual-character-range (%null-ptr))))
     667          #+debug (#_NSLog #@"Flag = %d, location = %d" :<BOOL> (if flag #$YES #$NO) :int (text-view-blink-location self))
    562668          (slet ((rect (send layout
    563669                             :bounding-rect-for-glyph-range glyph-range
    564670                             :in-text-container container)))
    565             (send blink-color 'set)
     671            (send (the ns:ns-color blink-color) 'set)
    566672            (#_NSRectFill rect))
    567           (send layout
    568                 :draw-glyphs-for-glyph-range glyph-range
    569                 :at-point  (send self 'text-container-origin)))
    570         )))
    571   (send-super :draw-insertion-point-in-rect r
    572               :color color
    573               :turned-on flag))
     673          (if flag
     674            (send layout
     675                  :draw-glyphs-for-glyph-range glyph-range
     676                  :at-point  (send self 'text-container-origin)))
     677          )))
     678    (send-super :draw-insertion-point-in-rect r
     679                :color color
     680                :turned-on flag)))
    574681               
    575682(defmethod disable-blink ((self hemlock-textstorage-text-view))
    576683  (when (eql (text-view-blink-enabled self) #$YES)
    577684    (setf (text-view-blink-enabled self) #$NO)
    578     (unwind-protect
    579          (progn
    580            (send self 'lock-focus)
    581            (let* ((layout (send self 'layout-manager)))
    582              (slet ((glyph-range (send layout
    583                                        :glyph-range-for-character-range
    584                                        (ns-make-range (text-view-blink-location self)
    585                                                       1)
    586                                        :actual-character-range (%null-ptr))))
    587                    (send layout
    588                          :draw-glyphs-for-glyph-range glyph-range
    589                          :at-point  (send self 'text-container-origin)))))
    590       (send self 'unlock-focus))))
     685    ;; Force the blinked character to be redrawn.  Let the text
     686    ;; system do the drawing.
     687    (let* ((layout (send self 'layout-manager)))
     688      (send layout :invalidate-display-for-character-range
     689            (ns-make-range (text-view-blink-location self) 1)))))
    591690
    592691(defmethod update-blink ((self hemlock-textstorage-text-view))
    … …  
    692791         (n (if (%null-ptr-p unmodchars)
    693792              0
    694               (send unmodchars 'length)))
     793              (send (the ns:ns-string unmodchars) 'length)))
    695794         (c (if (eql n 1)
    696795              (send unmodchars :character-at-index 0))))
    … …  
    10291128                                                 :text-container container)
    10301129                             'autorelease)))
     1130              (send layout :set-delegate tv)
    10311131              (send tv :set-min-size (ns-make-size
    10321132                                      0.0f0
    … …  
    10881188    ((textstorage :foreign-type :id))
    10891189  (:metaclass ns:+ns-object))
     1190
     1191(define-objc-method ((:void close) echo-area-document)
     1192  (let* ((ts (slot-value self 'textstorage)))
     1193    (unless (%null-ptr-p ts)
     1194      (setf (slot-value self 'textstorage) (%null-ptr))
     1195      (close-hemlock-textstorage ts))))
    10901196
    10911197(define-objc-method ((:void :update-change-count (:<NSD>ocument<C>hange<T>ype change)) echo-area-document)
    … …  
    12921398      (setf (slot-value self 'command-thread) nil)
    12931399      (process-kill proc)))
     1400  (let* ((buf (hemlock-frame-echo-area-buffer self))
     1401         (echo-doc (if buf (hi::buffer-document buf))))
     1402    (when echo-doc
     1403      (setf (hemlock-frame-echo-area-buffer self) nil)
     1404      (send echo-doc 'close)))
     1405  (release-canonical-nsobject self)
    12941406  (send-super 'close))
    12951407 
    … …  
    13121424          pane)))))
    13131425
    1314 
    1315          
    13161426                                       
    13171427                                     
    … …  
    13351445(defun %nsstring-to-mark (nsstring mark)
    13361446  "returns external-format of string"
    1337   (let* ((string-len (send nsstring 'length))
     1447  (let* ((string-len (send (the ns:ns-string nsstring) 'length))
    13381448         (line-start 0)
    13391449         (first-line-terminator ())
    … …  
    14401550         (frame (send pane 'window))
    14411551         (buffer (text-view-buffer (text-pane-text-view pane))))
    1442       (setf (slot-value frame 'echo-area-view)
    1443             (make-echo-area-for-window frame (hi::buffer-gap-context buffer) color))
     1552    (setf (slot-value frame 'echo-area-view)
     1553          (make-echo-area-for-window frame (hi::buffer-gap-context buffer) color))
    14441554    (setf (slot-value frame 'command-thread)
    14451555          (process-run-function (format nil "Hemlock window thread")
    … …  
    14701580 
    14711581(defun hi::document-begin-editing (document)
     1582  #-all-in-cocoa-thread
     1583  (send (slot-value document 'textstorage) 'begin-editing)
     1584  #+all-in-cocoa-thread
    14721585  (send (slot-value document 'textstorage)
    14731586        :perform-selector-on-main-thread
    … …  
    14791592
    14801593(defun hi::document-end-editing (document)
     1594  #-all-in-cocoa-thread
     1595  (send (slot-value document 'textstorage) 'end-editing)
     1596  #+all-in-cocoa-thread
    14811597  (send (slot-value document 'textstorage)
    14821598        :perform-selector-on-main-thread
    … …  
    15091625            (%get-ptr paramptrs (ash 1 target::word-shift))
    15101626            number-for-n)
    1511       (let* ((params (make-objc-instance 'ns:ns-array
    1512                                          :with-objects paramptrs
    1513                                          :count 2)))
     1627      (let* ((params
     1628              (send (send (@class "NSArray") 'alloc)
     1629                    :init-with-objects paramptrs
     1630                    :count 2)))
    15141631        (send textstorage
    15151632                    :perform-selector-on-main-thread
    … …  
    15581675          (format t "~&insert: pos = ~d, n = ~d" pos n)
    15591676          (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
    1560             (reset-buffer-cache display)
     1677            ;(reset-buffer-cache display)
     1678            (adjust-buffer-cache-for-insertion display pos n)
    15611679            (update-line-cache-for-index display pos))
     1680          #-all-in-cocoa-thread
     1681          (textstorage-note-insertion-at-position textstorage pos n)
     1682          #+all-in-cocoa-thread
    15621683          (perform-edit-change-notification textstorage
    15631684                                            (@selector "noteInsertion:")
    … …  
    15741695                 :int (mark-absolute-position mark)
    15751696                 :int n)
     1697        #-all-in-cocoa-thread
     1698        (send textstorage
     1699          :edited (logior #$NSTextStorageEditedCharacters
     1700                          #$NSTextStorageEditedAttributes)
     1701          :range (ns-make-range (mark-absolute-position mark) n)
     1702          :change-in-length 0)
     1703        #+all-in-cocoa-thread
    15761704        (perform-edit-change-notification textstorage
    15771705                                          (@selector "noteModification:")
    … …  
    15851713           (textstorage (if document (slot-value document 'textstorage))))
    15861714      (when textstorage
     1715        #-all-in-cocoa-thread
     1716        (let* ((pos (mark-absolute-position mark)))
     1717          (send textstorage
     1718          :edited #$NSTextStorageEditedCharacters
     1719          :range (ns-make-range pos n)
     1720          :change-in-length (- n))
     1721          (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
     1722            (reset-buffer-cache display)
     1723            (update-line-cache-for-index display pos)))
     1724        #+all-in-cocoa-thread
    15871725        (perform-edit-change-notification textstorage
    15881726                                          (@selector "noteDeletion:")
    15891727                                          (mark-absolute-position mark)
    15901728                                          (abs n))))))
     1729
    15911730(defun hi::set-document-modified (document flag)
    15921731  (send document
    … …  
    16481787  (:metaclass ns:+ns-object))
    16491788
    1650    
    1651 
     1789
     1790
     1791(define-objc-method ((:void :_window-will-close notification)
     1792                     hemlock-editor-window-controller)
     1793  #+debug
     1794  (let* ((w (send notification 'object)))
     1795    (#_NSLog #@"Window controller: window will close: %@" :id w))
     1796  (send-super :_window-will-close notification))
    16521797
    16531798;;; The HemlockEditorDocument class.
    … …  
    18001945
    18011946(define-objc-method ((:void close) hemlock-editor-document)
     1947  #+debug
     1948  (#_NSLog #@"Document close: %@" :id self)
    18021949  (let* ((textstorage (slot-value self 'textstorage)))
    1803     (setf (slot-value self 'textstorage) (%null-ptr))
    18041950    (unless (%null-ptr-p textstorage)
     1951      (setf (slot-value self 'textstorage) (%null-ptr))
    18051952      (for-each-textview-using-storage
    18061953       textstorage
    1807        #'(lambda (tv) (send tv :set-string #@"")))
     1954       #'(lambda (tv)
     1955           (let* ((layout (send tv 'layout-manager)))
     1956             (send layout :set-background-layout-enabled nil))))
    18081957      (close-hemlock-textstorage textstorage)))
    1809     (send-super 'close))
     1958  (send-super 'close))
    18101959
    18111960
Note: See TracChangeset for help on using the changeset viewer.