Changeset 7862


Ignore:
Timestamp:
Dec 9, 2007, 8:41:10 AM (17 years ago)
Author:
gz
Message:

Get back blinking cursor in echo area reads; simplify paste support; more api tweaks

Location:
branches/event-ide/ccl/cocoa-ide
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/event-ide/ccl/cocoa-ide/cocoa-editor.lisp

    r7844 r7862  
    2828
    2929
    30 (defgeneric hi:hemlock-view (ns-object))
    31 
    32 (defmethod hi:hemlock-view ((unknown t)) nil)
    33 
    34 
     30(defgeneric hemlock-view (ns-object))
     31
     32(defmethod hemlock-view ((unknown t))
     33  nil)
     34
     35(defgeneric hemlock-buffer (ns-object))
     36
     37(defmethod hemlock-buffer ((unknown t))
     38  (let ((view (hemlock-view unknown)))
     39    (when view (hi::hemlock-view-buffer view))))
    3540
    3641(defmacro nsstring-encoding-to-nsinteger (n)
    … …  
    200205  (:metaclass ns:+ns-object))
    201206
     207(defmethod hemlock-buffer ((self hemlock-buffer-string))
     208  (let ((cache (hemlock-buffer-string-cache self)))
     209    (when cache
     210      (hemlock-buffer cache))))
     211
    202212;;; Cocoa wants to treat the buffer as a linear array of characters;
    203213;;; Hemlock wants to treat it as a doubly-linked list of lines, so
    … …  
    220230  workline-start-font-index             ; current font index at start of workline
    221231  )
     232
     233(defmethod hemlock-buffer ((self buffer-cache))
     234  (buffer-cache-buffer self))
    222235
    223236;;; Initialize (or reinitialize) a buffer cache, so that it points
    … …  
    433446(declaim (special hemlock-text-storage))
    434447
     448(defmethod hemlock-buffer ((self hemlock-text-storage))
     449  (let ((string (slot-value self 'hemlock-string)))
     450    (unless (%null-ptr-p string)
     451      (hemlock-buffer string))))
    435452
    436453;;; This is only here so that calls to it can be logged for debugging.
    … …  
    475492  (assume-cocoa-thread)
    476493  (let* ((mirror (#/mirror self))
    477         (hemlock-string (#/hemlockString self))
     494        (hemlock-string (#/hemlockString self))
    478495         (display (hemlock-buffer-string-cache hemlock-string))
    479496         (buffer (buffer-cache-buffer display))
    … …  
    686703(objc:defmethod (#/replaceCharactersInRange:withString: :void)
    687704    ((self hemlock-text-storage) (r :<NSR>ange) string)
    688   #+debug (#_NSLog #@"Replace in range %ld/%ld with %@"
    689                     :<NSI>nteger (pref r :<NSR>ange.location)
    690                     :<NSI>nteger (pref r :<NSR>ange.length)
    691                     :id string)
    692   (let* ((cache (hemlock-buffer-string-cache (#/hemlockString  self)))
    693          (buffer (if cache (buffer-cache-buffer cache)))
    694          (hi::*current-buffer* buffer)
    695          (location (pref r :<NSR>ange.location))
     705  #+GZ (log-debug "~&replaceCharacters ts: ~s r: ~s s: ~s buf ~s frame: ~s"
     706                   self r string (hemlock-buffer self) (find (hemlock-buffer self) (windows) :key #'hemlock-buffer))
     707  (let* ((buffer (hemlock-buffer self))
     708         (position (pref r :<NSR>ange.location))
    696709         (length (pref r :<NSR>ange.length))
    697          (point (hi::buffer-point buffer)))
    698     (let* ((lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring string)))
    699            (document (if buffer (hi::buffer-document buffer)))
    700            (textstorage (if document (slot-value document 'textstorage))))
    701       #+gz (unless (eql textstorage self) (break "why is self.ne.textstorage?"))
    702       (when textstorage
    703         (assume-cocoa-thread)
    704         (#/beginEditing textstorage))
    705       (setf (hi::buffer-region-active buffer) nil)
    706       (hi::with-mark ((start point :right-inserting))
    707         (move-hemlock-mark-to-absolute-position start cache location)
    708         (unless (zerop length)
    709           (hi::delete-characters start length))
    710         (when lisp-string
    711           (hi::insert-string start lisp-string)))
    712       (when textstorage
    713         (#/endEditing textstorage)
    714         ;; This isn't really right.  It should abort the entire command in progress,
    715         ;; e.g. c-x ..., etc. and should do it before event start... Basically it
    716         ;; should be handled as if it was a regular key event, except for the
    717         ;; extra string argument.
    718         (for-each-textview-using-storage
    719          textstorage
    720          (lambda (tv)
    721            (hi::disable-self-insert
    722             (hi:hemlock-view tv))))
    723         (#/ensureSelectionVisible textstorage)))))
    724 
     710         (lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring string)))
     711         ;; In theory (though not yet in practice) we allow for a buffer to be shown in multiple
     712         ;; windows, and this change has to affect all the windows.  That's true for all changes
     713         ;; to a buffer, so once hemlock supports multiple views of a buffer, it will have some
     714         ;; way to update all the views.  So just pick any one window here and let hemlock take
     715         ;; care of the rest.
     716         (view (loop for w in (windows) thereis (and (eq (hemlock-buffer w) buffer) (hemlock-view w)))))
     717    (when view
     718      (hi::handle-hemlock-event view #'(lambda ()
     719                                         (hi:paste-characters position length
     720                                                              lisp-string)))
     721      )))
     722
     723#|
     724TODO: the absolute-bla bla stuff is likely not used anymore, right?
     725
     726;; TODO: If selection scrolled out of view, anything that modifies the buffer should
     727;; bring the selection back into view so the user can see what happened.
     728;; Hemlock should ensure that.
     729(defmethod ensure-selection-visible ((view hi:hemlock-view))
     730  (let ((tv ???))
     731  (assume-not-editing tv)
     732  (#/scrollRangeToVisible: tv (#/selectedRange tv))
     733  ))
     734|#
    725735
    726736(objc:defmethod (#/setAttributes:range: :void) ((self hemlock-text-storage)
    … …  
    749759(objc:defmethod #/description ((self hemlock-text-storage))
    750760  (#/stringWithFormat: ns:ns-string #@"%s : string %@" (#_object_getClassName self) (slot-value self 'hemlock-string)))
    751 
    752 ;;; This needs to happen on the main thread.
    753 (objc:defmethod (#/ensureSelectionVisible :void) ((self hemlock-text-storage))
    754   (assume-cocoa-thread)
    755   (for-each-textview-using-storage
    756    self
    757    #'(lambda (tv)
    758        (assume-not-editing tv)
    759        (#/scrollRangeToVisible: tv (#/selectedRange tv)))))
    760 
    761761
    762762(defun close-hemlock-textstorage (ts)
    … …  
    811811(declaim (special hemlock-textstorage-text-view))
    812812
    813 (defmethod hi:hemlock-view ((self hemlock-textstorage-text-view))
    814   ;; Not sure when any of this can fail, but at least try to make sure that if hemlock-view
    815   ;; returns non-nil, then callers don't have to check for any other marginal situations.
     813(defmethod hemlock-view ((self hemlock-textstorage-text-view))
    816814  (let ((frame (#/window self)))
    817815    (unless (%null-ptr-p frame)
    818       (let ((view (hi:hemlock-view frame)))
    819         (when view
    820           (when (eq (hi::hemlock-view-buffer view) (text-view-buffer self))
    821             view))))))
    822 
     816      (hemlock-view frame))))
     817
     818(defmethod activate-hemlock-view ((self hemlock-textstorage-text-view))
     819  (assume-cocoa-thread)
     820  (let* ((the-hemlock-frame (#/window self)))
     821    #+debug (log-debug "Activating ~s" self)
     822    (with-slots ((echo peer)) self
     823      (deactivate-hemlock-view echo))
     824    (#/setEditable: self t)
     825    (#/makeFirstResponder: the-hemlock-frame self)))
     826
     827(defmethod deactivate-hemlock-view ((self hemlock-textstorage-text-view))
     828  (assume-cocoa-thread)
     829  #+debug (log-debug "deactivating ~s" self)
     830  (assume-not-editing self)
     831  (#/setSelectable: self nil))
    823832
    824833(defmethod eventqueue-abort-pending-p ((self hemlock-textstorage-text-view))
    … …  
    840849(objc:defmethod (#/keyDown: :void) ((self hemlock-textstorage-text-view) event)
    841850  #+debug (#_NSLog #@"Key down event = %@" :address event)
    842   (let* ((view (hi:hemlock-view self))
     851  (let* ((view (hemlock-view self))
    843852         ;; quote-p means handle characters natively
    844853         (quote-p (and view (hi::hemlock-view-quote-next-p view))))
    … …  
    896905  ;; If no modifier keys are pressed, send hemlock a no-op.
    897906  (unless (logtest #$NSDeviceIndependentModifierFlagsMask (#/modifierFlags event))
    898     (let* ((view (hi:hemlock-view self)))
     907    (let* ((view (hemlock-view self)))
    899908      (when view
    900909        (unless (eventqueue-abort-pending-p self)
    … …  
    989998(defmethod update-blink ((self hemlock-textstorage-text-view))
    990999  (disable-blink self)
    991   (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
    992          (buffer (buffer-cache-buffer d)))
     1000  (let* ((buffer (hemlock-buffer self)))
    9931001    (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
    9941002      (let* ((hi::*current-buffer* buffer)
    … …  
    10631071     (char-height :foreign-type :<CGF>loat :accessor text-view-char-height))
    10641072  (:metaclass ns:+ns-object))
     1073(declaim (special hemlock-text-view))
     1074
     1075(defmethod hemlock-view ((self hemlock-text-view))
     1076  (let ((pane (text-view-pane self)))
     1077    (when pane (hemlock-view pane))))
    10651078
    10661079(objc:defmethod (#/evalSelection: :void) ((self hemlock-text-view) sender)
    … …  
    12031216
    12041217
    1205 
    1206 ;;; Access the underlying buffer in one swell foop.
    1207 (defmethod text-view-buffer ((self hemlock-textstorage-text-view))
    1208   (buffer-cache-buffer (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self)))))
    1209 
    1210 
    1211 
     1218(defmethod text-view-string-cache ((self hemlock-textstorage-text-view))
     1219  (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
    12121220
    12131221(objc:defmethod (#/selectionRangeForProposedRange:granularity: :ns-range)
    … …  
    13981406      (let* ((tv (text-pane-text-view pane)))
    13991407        (unless (%null-ptr-p tv)
    1400           (text-view-buffer tv))))))
     1408          (hemlock-buffer tv))))))
    14011409
    14021410;;; Draw a string in the modeline view.  The font and other attributes
    … …  
    15101518
    15111519(defclass text-pane (ns:ns-box)
    1512     ((text-view :foreign-type :id :accessor text-pane-text-view)
     1520    ((hemlock-view :initform nil :reader text-pane-hemlock-view)
     1521     (text-view :foreign-type :id :accessor text-pane-text-view)
    15131522     (mode-line :foreign-type :id :accessor text-pane-mode-line)
    15141523     (scroll-view :foreign-type :id :accessor text-pane-scroll-view))
    15151524  (:metaclass ns:+ns-object))
     1525
     1526(defmethod hemlock-view ((self text-pane))
     1527  (text-pane-hemlock-view self))
    15161528
    15171529;;; Mark the buffer's modeline as needing display.  This is called whenever
    … …  
    16331645      tv)))
    16341646
    1635 
    1636 (objc:defmethod (#/activateHemlockView :void) ((self text-pane))
    1637   (let* ((the-hemlock-frame (#/window self))
    1638          (text-view (text-pane-text-view self)))
    1639     #+debug (#_NSLog #@"Activating text pane")
    1640     (with-slots ((echo peer)) text-view
    1641       (deactivate-hemlock-view echo))
    1642     (#/setEditable: text-view t)
    1643     (#/makeFirstResponder: the-hemlock-frame text-view)))
    1644 
    1645 (defmethod hi::activate-hemlock-view ((view text-pane))
    1646   (#/performSelectorOnMainThread:withObject:waitUntilDone:
    1647    view
    1648    (@selector #/activateHemlockView)
    1649    +null-ptr+
    1650    t))
    1651 
    1652 
    1653 
    1654 (defmethod deactivate-hemlock-view ((self hemlock-text-view))
    1655   #+debug (#_NSLog #@"deactivating text view")
    1656   (#/setSelectable: self nil))
     1647(defmethod hemlock-ext:change-active-pane ((view hi:hemlock-view) new-pane)
     1648  #+GZ (log-debug "change active pane, current: ~s" new-pane)
     1649  (let* ((pane (hi::hemlock-view-pane view))
     1650         (text-view (text-pane-text-view pane))
     1651         (tv (ecase new-pane
     1652               (:echo (slot-value text-view 'peer))
     1653               (:text text-view))))
     1654    (activate-hemlock-view tv)))
    16571655
    16581656(defclass echo-area-view (hemlock-textstorage-text-view)
    16591657    ()
    16601658  (:metaclass ns:+ns-object))
    1661 
    1662 (objc:defmethod (#/activateHemlockView :void) ((self echo-area-view))
    1663   (assume-cocoa-thread)
    1664   (let* ((the-hemlock-frame (#/window self)))
    1665     #+debug
    1666     (#_NSLog #@"Activating echo area")
    1667     (with-slots ((pane peer)) self
    1668       (deactivate-hemlock-view pane))
    1669     (#/setEditable: self t)
    1670   (#/makeFirstResponder: the-hemlock-frame self)))
    1671 
    1672 (defmethod hi::activate-hemlock-view ((view echo-area-view))
    1673   (#/performSelectorOnMainThread:withObject:waitUntilDone:
    1674    view
    1675    (@selector #/activateHemlockView)
    1676    +null-ptr+
    1677    t))
    1678 
    1679 (defmethod deactivate-hemlock-view ((self echo-area-view))
    1680   (assume-cocoa-thread)
    1681   #+debug (#_NSLog #@"deactivating echo area")
    1682   (let* ((ts (#/textStorage self)))
    1683     #+debug 0
    1684     (when (#/editingInProgress ts)
    1685       (#_NSLog #@"deactivating %@, edit-count = %d" :id self :int (slot-value ts 'edit-count)))
    1686     (do* ()
    1687          ((not (#/editingInProgress ts)))
    1688       (#/endEditing ts))
    1689 
    1690     (#/setSelectable: self nil)))
    1691 
     1659(declaim (special echo-area-view))
     1660
     1661(defmethod hemlock-view ((self echo-area-view))
     1662  (let ((text-view (slot-value self 'peer)))
     1663    (when text-view
     1664      (hemlock-view text-view))))
    16921665
    16931666;;; The "document" for an echo-area isn't a real NSDocument.
    … …  
    16951668    ((textstorage :foreign-type :id))
    16961669  (:metaclass ns:+ns-object))
     1670
     1671(defmethod hemlock-buffer ((self echo-area-document))
     1672  (let ((ts (slot-value self 'textstorage)))
     1673    (unless (%null-ptr-p ts)
     1674      (hemlock-buffer ts))))
    16971675
    16981676(objc:defmethod (#/undoManager :<BOOL>) ((self echo-area-document))
    … …  
    17881766    ((echo-area-view :foreign-type :id)
    17891767     (pane :foreign-type :id)
    1790      (hemlock-view :initform nil :reader hemlock-frame-hemlock-view)
    17911768     (echo-area-buffer :initform nil :accessor hemlock-frame-echo-area-buffer)
    17921769     (echo-area-stream :initform nil :accessor hemlock-frame-echo-area-stream))
    … …  
    17941771(declaim (special hemlock-frame))
    17951772
    1796 (defmethod hi:hemlock-view ((self hemlock-frame))
    1797   (hemlock-frame-hemlock-view self))
    1798 
     1773(defmethod hemlock-view ((self hemlock-frame))
     1774  (let ((pane (slot-value self 'pane)))
     1775    (unless (%null-ptr-p pane)
     1776      (hemlock-view pane))))
    17991777
    18001778(defun double-%-in (string)
    … …  
    19551933  (assume-cocoa-thread)
    19561934  (let* ((pane (textpane-for-textstorage class ts ncols nrows container-tracks-text-view-width color style))
     1935         (buffer (hemlock-buffer ts))
    19571936         (frame (#/window pane))
    1958          (buffer (text-view-buffer (text-pane-text-view pane)))
    19591937         (echo-area (make-echo-area-for-window frame buffer color))
     1938         (echo-buffer (hemlock-buffer (#/textStorage echo-area)))
    19601939         (tv (text-pane-text-view pane)))
     1940    #+GZ (assert echo-buffer)
    19611941    (with-slots (peer) tv
    19621942      (setq peer echo-area))
    19631943    (with-slots (peer) echo-area
    19641944      (setq peer tv))
    1965     (hi::activate-hemlock-view pane)
    1966     (setf (slot-value frame 'hemlock-view)
     1945    (setf (slot-value frame 'echo-area-view) echo-area
     1946          (slot-value frame 'pane) pane)
     1947    #+GZ (log-debug "~&echo-area: ~s textstorage: ~s"
     1948                    echo-area
     1949                    (#/textStorage echo-area))
     1950    (setf (slot-value pane 'hemlock-view)
    19671951          (make-instance 'hi:hemlock-view
    19681952            :buffer buffer
    19691953            :pane pane
    1970             :echo-area-buffer (hemlock-frame-echo-area-buffer frame)
    1971             :echo-area-pane echo-area))
    1972     (setf (slot-value frame 'echo-area-view) echo-area
    1973           (slot-value frame 'pane) pane)
    1974     frame))
     1954            :echo-area-buffer echo-buffer))
     1955
     1956    (activate-hemlock-view tv)
     1957   frame))
    19751958
    19761959
    … …  
    20031986        (let ((ts (slot-value document 'textstorage)))
    20041987          (#/endEditing ts)
    2005           ;; TODO: no reason for this to be an objC function!!
    2006           (#/updateHemlockSelection ts))))))
     1988          (update-hemlock-selection ts))))))
    20071989
    20081990(defun buffer-document-begin-editing (buffer)
    … …  
    21082090(defun hemlock-ext:note-buffer-saved (buffer)
    21092091  (assume-cocoa-thread)
    2110   (let* ((document (buffer-document buffer)))
     2092  (let* ((document (hi::buffer-document buffer)))
    21112093    (when document
    21122094      ;; Hmm... I guess this is always done by the act of saving.
    … …  
    21152097(defun hemlock-ext:note-buffer-unsaved (buffer)
    21162098  (assume-cocoa-thread)
    2117   (let* ((document (buffer-document buffer)))
     2099  (let* ((document (hi::buffer-document buffer)))
    21182100    (when document
    21192101      (#/updateChangeCount: document #$NSChangeCleared))))
    … …  
    21672149  (:metaclass ns:+ns-object))
    21682150
    2169 (defmethod hi:hemlock-view ((self hemlock-editor-window-controller))
     2151(defmethod hemlock-view ((self hemlock-editor-window-controller))
    21702152  (let ((frame (#/window self)))
    21712153    (unless (%null-ptr-p frame)
    2172       (hi:hemlock-view frame))))
     2154      (hemlock-view frame))))
    21732155
    21742156;;; Map *default-file-character-encoding* to an :<NSS>tring<E>ncoding
    … …  
    22052187     (encoding :foreign-type :<NSS>tring<E>ncoding :initform (get-default-encoding)))
    22062188  (:metaclass ns:+ns-object))
     2189
     2190(defmethod hemlock-buffer ((self hemlock-editor-document))
     2191  (let ((ts (slot-value self 'textstorage)))
     2192    (unless (%null-ptr-p ts)
     2193      (hemlock-buffer ts))))
    22072194
    22082195(defmethod assume-not-editing ((doc hemlock-editor-document))
    … …  
    22562243               (eql action (@selector #/compileBuffer:))
    22572244               (eql action (@selector #/compileAndLoadBuffer:)))
    2258            (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
    2259                   (buffer (buffer-cache-buffer d))
     2245           (let* ((buffer (hemlock-buffer self))
    22602246                  (pathname (hi::buffer-pathname buffer)))
    22612247             (not (null pathname))))
    … …  
    23282314    (#/updateMirror textstorage)
    23292315    (#/endEditing textstorage)
    2330     (#/updateHemlockSelection textstorage)
     2316    (update-hemlock-selection textstorage)
    23312317    (setf (hi::buffer-modified buffer) nil)
    23322318    (hi::note-modeline-change buffer)
    … …  
    24482434
    24492435(defmethod hemlock-document-buffer (document)
    2450   (let* ((string (#/hemlockString (slot-value document 'textstorage))))
    2451     (unless (%null-ptr-p string)
    2452       (let* ((cache (hemlock-buffer-string-cache string)))
    2453         (when cache (buffer-cache-buffer cache))))))
    2454 
    2455 (defmethod hemlock-buffer ((frame hemlock-frame))
    2456   (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
    2457          (doc (#/documentForWindow: dc frame)))
    2458     ;; Sometimes doc is null.  Why?  What would cause a hemlock frame to
    2459     ;; not have a document?  (When it happened, there seemed to be a hemlock
    2460     ;; frame in (windows) that didn't correspond to any visible window).
    2461     (unless (%null-ptr-p doc)
    2462       (hemlock-document-buffer doc))))
    2463 
    2464 (defmethod hemlock-buffer ((pane text-pane))
    2465   (hemlock-buffer (#/window pane)))
    2466 
    2467 (defmethod hemlock-buffer (whatever)
    2468   (let ((view (hi::hemlock-view whatever)))
    2469     (when view (hi::hemlock-view-buffer view))))
    2470 
    2471 (defun hemlock-ext:visible-buffers ()
    2472   "List of all buffers visible in windows, in z-order, frontmost first"
     2436  (hemlock-buffer document))
     2437
     2438(defmethod hemlock-view ((frame hemlock-frame))
     2439  (let ((pane (slot-value frame 'pane)))
     2440    (when (and pane (not (%null-ptr-p pane)))
     2441      (hemlock-view pane))))
     2442
     2443(defun hemlock-ext:all-hemlock-views ()
     2444  "List of all hemlock views, in z-order, frontmost first"
    24732445  (loop for win in (windows)
    2474     as buf = (and (typep win 'hemlock-frame) (hemlock-buffer win))
     2446    as buf = (and (typep win 'hemlock-frame) (hemlock-view win))
    24752447    when buf collect buf))
    24762448
    … …  
    27862758
    27872759;;; This needs to run on the main thread.
    2788 (objc:defmethod (#/updateHemlockSelection :void) ((self hemlock-text-storage))
     2760(defmethod update-hemlock-selection ((self hemlock-text-storage))
    27892761  (assume-cocoa-thread)
    2790   (let* ((string (#/hemlockString self))
    2791          (buffer (buffer-cache-buffer (hemlock-buffer-string-cache string)))
     2762  (let* ((buffer (buffer-cache-buffer (hemlock-buffer-string-cache (#/hemlockString self))))
    27922763         (hi::*current-buffer* buffer)
    27932764         (point (hi::buffer-point buffer))
    … …  
    29212892            (#/makeWindowControllers document))
    29222893          (find-definition-in-document name indicator document)
    2923           (#/updateHemlockSelection (slot-value document 'textstorage))
     2894          (update-hemlock-selection (slot-value document 'textstorage))
    29242895          (#/showWindows document))))))
    29252896

  • branches/event-ide/ccl/cocoa-ide/cocoa-grep.lisp

    r7698 r7862  
    3838             (hi::*current-buffer* buffer))
    3939        (edit-grep-line-in-buffer line-num))
    40       (#/updateHemlockSelection (slot-value document 'textstorage))
     40      (update-hemlock-selection (slot-value document 'textstorage))
    4141      (#/showWindows document))))
    4242

  • branches/event-ide/ccl/cocoa-ide/cocoa-listener.lisp

    r7844 r7862  
    202202                      (%get-unsigned-byte xlate (+ noctets-used i)))))
    203203            (setq nextra n)
    204             (let ((view (hi::hemlock-view self)))
     204            (let ((view (hemlock-view self)))
    205205              (queue-for-cocoa-thread #'(lambda () (append-output view string))))
    206206            (#/readInBackgroundAndNotify fh)))))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/echo.lisp

    r7844 r7862  
    133133                  (buffer-name (hemlock-view-buffer *recursive-edit-view*))))
    134134  (modifying-echo-buffer
    135    (let* ((old-eps (hemlock-prompted-input-state *current-view*))
    136           (parse-mark (copy-mark (buffer-point *current-buffer*) :right-inserting))
    137           (end-mark (buffer-end-mark *current-buffer*))
     135   (let* ((view *current-view*)
     136          (buffer *current-buffer*)
     137          (old-eps (hemlock-prompted-input-state view))
     138          (parse-mark (copy-mark (buffer-point buffer) :right-inserting))
     139          (end-mark (buffer-end-mark buffer))
    138140          (eps (make-echo-parse-state
    139141                :parse-starting-mark parse-mark
    … …  
    153155       (editor-error "Attempt to recursively use echo area"))
    154156     (unwind-protect
    155          (let ((*recursive-edit-view* *current-view*))
    156            (setf (hemlock-prompted-input-state *current-view*) eps)
     157         (let ((*recursive-edit-view* view))
     158           (setf (hemlock-prompted-input-state view) eps)
     159           (unless old-eps
     160             (hemlock-ext:change-active-pane view :echo))
    157161           (display-prompt-nicely eps)
    158162           (modifying-buffer-storage (nil)
    … …  
    160164              (gui::event-loop #'(lambda () (eps-parse-results eps)))))
    161165           #+gz (gui::log-debug "~&Event loop exited!, results = ~s" (eps-parse-results eps)))
    162        (setf (hemlock-prompted-input-state *current-view*) old-eps)
     166       (setf (hemlock-prompted-input-state view) old-eps)
     167       (unless old-eps
     168         (hemlock-ext:change-active-pane view :text))
    163169       (delete-mark parse-mark))
    164170     (let ((results (eps-parse-results eps)))
    … …  
    279285    (cond (pn)
    280286          (t (modifying-echo-buffer
    281               (delete-characters (region-end (eps-input-region eps))
     287              (delete-characters (region-end (eps-parse-input-region eps))
    282288                                 (- idx (length string))))
    283289             nil))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/htext3.lisp

    r7833 r7862  
    272272          (adjust-line-origins-forward line)
    273273          (buffer-note-insertion buffer mark nins)))))))
     274
     275(defun paste-characters (position count string)
     276  "Replace COUNT characters at POSITION with STRING.  POSITION is the
     277absolute character position in buffer"
     278  (with-mark ((m (buffer-start-mark (current-buffer))))
     279    (unless (character-offset m position)
     280      (buffer-end m))
     281    (when (> count 0) (delete-characters m count))
     282    (when string (insert-string m string))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp

    r7844 r7862  
    306306  #+clozure
    307307  (:import-from :ccl #:memq #:assq #:delq)
     308  #+clozure
     309  (:import-from :gui #:log-debug)
    308310  ;;
    309311  (:export
    … …  
    357359   #:note-buffer-unsaved
    358360   #:read-only-listener-p
    359    #:visible-buffers
     361   #:all-hemlock-views
    360362   #:open-sequence-dialog
    361363   #:edit-single-definition
     364   #:change-active-pane
    362365   ))
    363366
    … …  
    394397   #:stream-line-column)
    395398  (:import-from :hemlock-ext
    396                 #:delq #:memq #:assq)
     399                #:delq #:memq #:assq
     400                #+clozure #:log-debug)
    397401  ;;
    398402  (:export
    … …  
    431435
    432436   ;; from views.lisp
    433    #:hemlock-view #:current-view
     437   #:hemlock-view #:current-view #:hemlock-view-buffer
    434438   #:current-prefix-argument-state #:last-key-event-typed #:last-char-typed
    435439   #:abort-to-toplevel #:abort-current-command
    … …  
    519523   ;; htext3.lisp
    520524   #:insert-character #:insert-string #:insert-region #:ninsert-region
    521 
     525   #:paste-characters
    522526
    523527   ;; htext4.lisp
    … …  
    574578(defpackage :hemlock
    575579  (:use :common-lisp :hemlock-interface :hemlock-internals :hemlock-ext)
    576   (:shadowing-import-from #:hemlock-ext
     580  (:shadowing-import-from :hemlock-ext
    577581                          #:char-code-limit)
     582  #+clozure (:import-from :hemlock-ext #:log-debug)
    578583  )
    579584

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/symbol-completion.lisp

    r7844 r7862  
    103103
    104104(defmethod dabbrev-sources-in ((state (eql :other-buffers)) context)
    105   (let* ((buffers (hemlock-ext:visible-buffers)))
     105  (let* ((buffers (mapcar #'hemlock-view-buffer (hemlock-ext:all-hemlock-views))))
    106106    ;; Remove duplicates, always keeping the first occurance (frontmost window)
    107107    (loop for blist on buffers do (setf (cdr blist) (delete (car blist) (cdr blist))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/views.lisp

    r7844 r7862  
    3030
    3131(defclass hemlock-view ()
    32   ((buffer :initarg :buffer :reader hemlock-view-buffer)
    33    (pane :initarg :pane :reader hemlock-view-pane)
     32  ((pane :initarg :pane :reader hemlock-view-pane)
     33   (buffer :initarg :buffer :reader hemlock-view-buffer)
    3434   (echo-area-buffer :initarg :echo-area-buffer :reader hemlock-echo-area-buffer)
    35    (echo-area-pane :initarg :echo-area-pane :reader hemlock-echo-area-pane)
    36 
    3735   (echo-area-stream :reader hemlock-echo-area-stream)
    3836
    … …  
    223221                  (message cstr))))))))))
    224222
     223(defmethod hemlock-view-current-buffer ((view hemlock-view))
     224  (if (hemlock-prompted-input-state view)
     225    (hemlock-echo-area-buffer view)
     226    (hemlock-view-buffer view)))
     227
    225228(defmethod handle-hemlock-event ((view hemlock-view) key)
    226229  ;; Key can also be a function, in which case it will get executed in the view event context
    227230  (ccl::with-standard-abort-handling "Abort editor event handling"
    228231    (let* ((*current-view* view)
    229            (*current-buffer* (if (hemlock-prompted-input-state view)
    230                                (hemlock-echo-area-buffer view)
    231                                (hemlock-view-buffer view))))
     232           (*current-buffer* (hemlock-view-current-buffer view)))
    232233      (with-buffer-bindings (*current-buffer*)
    233234        (modifying-buffer-storage (*current-buffer*)
Note: See TracChangeset for help on using the changeset viewer.