Changeset 16343


Ignore:
Timestamp:
Jan 21, 2015, 1:47:44 AM (5 years ago)
Author:
gz
Message:

move selection-info handling into hemlock, remove cocoa dependencies.

Location:
trunk/source/cocoa-ide
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-editor.lisp

    r16250 r16343  
    4949  (let ((view (hemlock-view unknown)))
    5050    (when view (hi::hemlock-view-buffer view))))
     51
     52(defmacro with-hemlock-context ((ns-object) &body body)
     53  (let ((ns-obj (gensym)) (view (gensym)) (buffer (gensym)) (pane (gensym)))
     54    `(let* ((,ns-obj ,ns-object)
     55            (,view (hemlock-view ,ns-obj))
     56            (,buffer (hemlock-buffer ,ns-obj))
     57            (,pane (cond ((eq ,buffer (hi::hemlock-view-buffer ,view)) :text)
     58                         ((eq ,buffer (hi::hemlock-echo-area-buffer ,view)) :echo)
     59                         (t (error "invalid buffer ~s for view ~s" ,view ,buffer)))))
     60       (hemlock:with-display-context (,view ,pane)
     61         ,@body))))
     62
    5163
    5264(defmacro nsstring-encoding-to-nsinteger (n)
     
    814826        (#/endEditing self)))))
    815827
    816 ;; In theory (though not yet in practice) we allow for a buffer to be shown in multiple
    817 ;; windows, and any change to a buffer through one window has to be reflected in all of
    818 ;; them.  Once hemlock really supports multiple views of a buffer, it will have some
    819 ;; mechanims to ensure that.
    820 ;; In Cocoa, we get some messages for the buffer (i.e. the document or the textstorage)
    821 ;; with no reference to a view.  There used to be code here that tried to do special-
    822 ;; case stuff for all views on the buffer, but that's not necessary, because as long
    823 ;; as hemlock doesn't support it, there will only be one view, and as soon as hemlock
    824 ;; does support it, will take care of updating all other views.  So all we need is to
    825 ;; get our hands on one of the views and do whatever it is through it.
    826828(defun front-view-for-buffer (buffer)
    827829  (loop
     
    837839         (hi::*current-buffer* buffer)
    838840         (position (pref r :<NSR>ange.location))
    839          (length (pref r :<NSR>ange.length))
    840          (lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring string)))
    841          (view (front-view-for-buffer buffer))
     841        (length (pref r :<NSR>ange.length))
     842        (lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring string)))
    842843         (edit-count (slot-value self 'edit-count)))
    843844    ;; #!#@#@* find panel neglects to call #/beginEditing / #/endEditing.
     
    853854      (when (eql 0 edit-count)
    854855        (#/endEditing self)))
    855     (when view
    856       (setf (hi::hemlock-view-quote-next-p view) nil))))
     856    (let ((view (front-view-for-buffer buffer)))
     857      (when view
     858        (setf (hi::hemlock-view-quote-next-p view) nil)))))
    857859
    858860(objc:defmethod (#/setAttributes:range: :void) ((self hemlock-text-storage)
     
    919921     (peer :foreign-type :id)
    920922     (paren-highlighting :initform nil :accessor text-view-paren-highlighting)
    921      (hemlock-view :initform nil)
    922      (selection-info :initform nil :accessor view-selection-info))
     923     (hemlock-view :initform nil))
    923924  (:metaclass ns:+ns-object))
    924925(declaim (special hemlock-textstorage-text-view))
     926
     927(defmethod hemlock-buffer ((tv hemlock-textstorage-text-view))
     928  ;; Could be the main buffer or the echo area.
     929  (hemlock-buffer (#/textStorage tv)))
    925930
    926931#| causes more problems than it solves.
     
    10361041               (call-next-method event)))))))
    10371042
    1038 (defmacro with-view-selection-info ((text-view buffer) &body body)
    1039   (let* ((old (gensym)))
    1040     `(let* ((,old (hi::buffer-selection-info ,buffer)))
    1041       (unwind-protect
    1042            (progn
    1043              (setf (hi::buffer-selection-info ,buffer)
    1044                    (view-selection-info ,text-view))
    1045              ,@body)
    1046         (setf (hi::buffer-selection-info ,buffer) ,old)))))
    1047      
    10481043(defmacro with-string-under-cursor ((text-view selection-name &optional bufname) &body body)
    10491044  "Intelligently grab the string under the cursor in the given text-view.
     
    10511046   selection-name is the name of a variable to which the selection will be assigned.
    10521047   bufname (if given) is the name of a variable to which the current buffer will be assigned."
    1053   (let ((bufsym (or bufname (gensym)))
    1054         (viewsym (gensym)))     
    1055     `(let* ((,viewsym ,text-view)
    1056             (,bufsym (hemlock-buffer ,viewsym)))
    1057        (with-view-selection-info (,viewsym ,bufsym)
    1058          (let* ((hi::*current-buffer* ,bufsym) ; needed for symbol-at-point to work
    1059                 (,selection-name (hemlock::symbol-at-point ,bufsym)))
    1060            ,@body)))))
     1048  (let ((bufsym (or bufname (gensym))))
     1049    `(with-hemlock-context (,text-view)
     1050       (let* ((,bufsym (hi:current-buffer))
     1051              (,selection-name (hemlock::symbol-at-point ,bufsym)))
     1052         ,@body))))
    10611053
    10621054(defmethod hi::handle-hemlock-event :around ((view hi:hemlock-view) event)
    10631055  (declare (ignore event))
    1064   (with-view-selection-info ((text-pane-text-view (hi::hemlock-view-pane view))
    1065                              (hi::hemlock-view-buffer view))
    1066     (with-autorelease-pool
    1067         (call-next-method))))
     1056  (with-autorelease-pool
     1057      (call-next-method)))
    10681058
    10691059(defconstant +shift-event-mask+ (hi:key-event-modifier-mask "Shift"))
     
    12211211         (length (ns:ns-range-length char-range))
    12221212         (end (+ start length)))
    1223     (hemlock:with-display-context (hemlock-view self)
     1213    (with-hemlock-context (self)
    12241214      (ns:with-ns-range (range)
    12251215        (when (> length 0)
     
    12551245(defmethod update-paren-highlight ((self hemlock-textstorage-text-view))
    12561246  (disable-paren-highlight self)
    1257   (let* ((view (hemlock-view self))
    1258          (buffer (and view (hi:hemlock-view-buffer view))))
    1259     (when (and buffer (string= (hi:buffer-major-mode buffer) "Lisp"))
    1260       (hemlock:with-display-context view
     1247  (with-hemlock-context (self)
     1248    (let ((buffer (hi:current-buffer)))
     1249      (when (string= (hi:buffer-major-mode buffer) "Lisp")
    12611250        #+debug (#_NSLog #@"Syntax check for paren-highlighting")
    12621251        (update-buffer-package (hi::buffer-document buffer))
     
    12801269  (when (eql length 0)
    12811270    (update-paren-highlight self))
    1282   (let* ((buffer (hemlock-buffer self)))
    1283     (with-view-selection-info (self buffer)
    1284       (setf (hi::buffer-selection-set-by-command buffer) (> length 0))
    1285       (rlet ((range :ns-range :location pos :length length))
    1286         (ccl::%call-next-objc-method self
    1287                                      hemlock-textstorage-text-view
    1288                                      (@selector #/setSelectedRange:affinity:stillSelecting:)
    1289                                      '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
    1290                                      range
    1291                                      affinity
    1292                                      nil)
    1293         (assume-not-editing self)
    1294         (when (> length 0)
    1295           (let* ((ts (#/textStorage self)))
    1296             (with-slots (selection-set-by-search) ts
    1297               (when (prog1 (eql #$YES selection-set-by-search)
    1298                       (setq selection-set-by-search #$NO))
    1299                 (highlight-search-selection self pos length)))))
    1300     ))))
     1271  (with-hemlock-context (self)
     1272    (setf (hi::buffer-selection-set-by-command (hi:current-buffer)) (> length 0))
     1273    (rlet ((range :ns-range :location pos :length length))
     1274      (ccl::%call-next-objc-method self
     1275                                   hemlock-textstorage-text-view
     1276                                   (@selector #/setSelectedRange:affinity:stillSelecting:)
     1277                                   '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
     1278                                   range
     1279                                   affinity
     1280                                   nil)
     1281      (assume-not-editing self)
     1282      (when (> length 0)
     1283        (let* ((ts (#/textStorage self)))
     1284          (with-slots (selection-set-by-search) ts
     1285            (when (prog1 (eql #$YES selection-set-by-search)
     1286                    (setq selection-set-by-search #$NO))
     1287              (highlight-search-selection self pos length))))))))
    13011288
    13021289(defloadvar *can-use-show-find-indicator-for-range*
     
    13211308(objc:defmethod (#/duplicate: :void) ((self hemlock-text-view) sender)
    13221309  (#/duplicate: (#/window self) sender))
    1323 
    1324 (defmethod hemlock-view ((self hemlock-text-view))
    1325   (slot-value self 'hemlock-view))
    13261310
    13271311(objc:defmethod (#/evalSelection: :void) ((self hemlock-text-view) sender)
     
    14811465                    (t #$NSSelectByParagraph))))
    14821466        (unless (eql g #$NSSelectByCharacter)
    1483           (let* ((cache (hemlock-buffer-string-cache (#/hemlockString textstorage)))
    1484                  (buffer (buffer-cache-buffer cache)))
    1485             (with-view-selection-info (self buffer)
    1486               (let* ((hi::*current-buffer* buffer)
    1487                      (point (hi:buffer-point buffer))
    1488                      (atom-mode (eql g #$NSSelectByParagraph)))
    1489                 (hi:with-mark ((mark point))
    1490                   (when (or (= length 0) (hi:move-to-absolute-position mark index))
    1491                     (let* ((region (hemlock:selection-for-click mark atom-mode))
    1492                            (other-region (and (< 0 length)
    1493                                               (hi:character-offset mark length)
    1494                                               (hemlock:selection-for-click mark atom-mode))))
    1495                       (when (null region) (setq region other-region other-region nil))
    1496                       (when region
    1497                         (let ((start-pos (min (hi:mark-absolute-position (hi:region-start region))
    1498                                               (if other-region
    1499                                                 (hi:mark-absolute-position (hi:region-start other-region))
    1500                                                 index)))
    1501                               (end-pos (max (hi:mark-absolute-position (hi:region-end region))
     1467          (with-hemlock-context (self)
     1468            (let* ((point (hi:current-point))
     1469                   (atom-mode (eql g #$NSSelectByParagraph)))
     1470              (hi:with-mark ((mark point))
     1471                (when (or (= length 0) (hi:move-to-absolute-position mark index))
     1472                  (let* ((region (hemlock:selection-for-click mark atom-mode))
     1473                         (other-region (and (< 0 length)
     1474                                            (hi:character-offset mark length)
     1475                                            (hemlock:selection-for-click mark atom-mode))))
     1476                    (when (null region) (setq region other-region other-region nil))
     1477                    (when region
     1478                      (let ((start-pos (min (hi:mark-absolute-position (hi:region-start region))
    15021479                                            (if other-region
    1503                                               (hi:mark-absolute-position (hi:region-end other-region))
    1504                                               (+ index length)))))
    1505                           (assert (<= start-pos end-pos))
    1506                           ;; Act as if we started the selection at the other end, so the heuristic
    1507                           ;; in #/setSelectedRange does the right thing.  ref bug #565.
    1508                           ;; However, only do so at the end, so don't keep toggling during selection, ref bug #851.
    1509                           (when (and (eql event-type #$NSLeftMouseUp) (< start-pos end-pos))
    1510                             (let ((point-pos (hi:mark-absolute-position point)))
    1511                               (cond ((eql point-pos start-pos)
    1512                                      (hi:move-to-absolute-position point end-pos))
    1513                                     ((eql point-pos end-pos)
    1514                                      (hi:move-to-absolute-position point start-pos)))))
    1515                           (ns:init-ns-range r start-pos (- end-pos start-pos))
    1516                           #+debug
    1517                           (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
    1518                                    :address (#_NSStringFromRange r)
    1519                                    :address (#_NSStringFromRange proposed)
    1520                                    :<NSS>election<G>ranularity g)
    1521                           (return-from HANDLED r))))))))))
     1480                                              (hi:mark-absolute-position (hi:region-start other-region))
     1481                                              index)))
     1482                            (end-pos (max (hi:mark-absolute-position (hi:region-end region))
     1483                                          (if other-region
     1484                                            (hi:mark-absolute-position (hi:region-end other-region))
     1485                                            (+ index length)))))
     1486                        (assert (<= start-pos end-pos))
     1487                        ;; Act as if we started the selection at the other end, so the heuristic
     1488                        ;; in #/setSelectedRange does the right thing.  ref bug #565.
     1489                        ;; However, only do so at the end, so don't keep toggling during selection, ref bug #851.
     1490                        (when (and (eql event-type #$NSLeftMouseUp) (< start-pos end-pos))
     1491                          (let ((point-pos (hi:mark-absolute-position point)))
     1492                            (cond ((eql point-pos start-pos)
     1493                                   (hi:move-to-absolute-position point end-pos))
     1494                                  ((eql point-pos end-pos)
     1495                                   (hi:move-to-absolute-position point start-pos)))))
     1496                        (ns:init-ns-range r start-pos (- end-pos start-pos))
     1497                        #+debug
     1498                        (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
     1499                                 :address (#_NSStringFromRange r)
     1500                                 :address (#_NSStringFromRange proposed)
     1501                                 :<NSS>election<G>ranularity g)
     1502                        (return-from HANDLED r)))))))))
    15221503        (prog1
    15231504            (call-next-method proposed g)
     
    15551536           :id (#/string (#/textStorage self)))
    15561537  (unless (#/editingInProgress (#/textStorage self))
    1557     (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
    1558            (buffer (buffer-cache-buffer d))
    1559            (hi::*current-buffer* buffer)
    1560            (location (pref r :<NSR>ange.location))
    1561            (len (pref r :<NSR>ange.length)))
    1562       (setf (hi::buffer-selection-set-by-command buffer) nil)
    1563       (with-view-selection-info (self buffer)
     1538    (with-hemlock-context (self)
     1539      (let* ((buffer (hi:current-buffer))
     1540             (d (hemlock-buffer-string-cache (#/hemlockString (#/textStorage self))))
     1541             (location (pref r :<NSR>ange.location))
     1542             (len (pref r :<NSR>ange.length)))
     1543        (setf (hi::buffer-selection-set-by-command buffer) nil)
    15641544        (cond ((eql len 0)
    15651545               #+debug
     
    18901870        (#/autorelease menu)))))
    18911871
    1892 (defun init-selection-info-for-textview (tv buffer)
    1893   (let* ((buffer-info (hi::buffer-selection-info buffer))
    1894          (view-info (hi::make-selection-info :point (hi::copy-mark (hi::selection-info-point buffer-info))
    1895                                              :%mark (let* ((mark (hi::selection-info-%mark buffer-info)))
    1896                                                       (if mark (hi::copy-mark mark)))
    1897                                              :view tv)))
    1898     (setf (view-selection-info tv) view-info)))
    1899                                                      
    19001872(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color style)
    19011873  (let* ((scrollview (#/autorelease
     
    19291901                                                       :with-frame tv-frame
    19301902                                                       :text-container container))))
    1931                 (init-selection-info-for-textview tv (hemlock-buffer textstorage))
    19321903                (#/setDelegate: layout tv)
    19331904                (#/setMinSize: tv (ns:make-ns-size 0 (ns:ns-size-height contentsize)))
     
    20312002)
    20322003
    2033 (defmethod hemlock-view ((self echo-area-view))
    2034   (slot-value self 'hemlock-view))
    2035 
    20362004;;; The "document" for an echo-area isn't a real NSDocument.
    20372005(defclass echo-area-document (ns:ns-object)
     
    20932061        (let* ((echo (make-instance 'echo-area-view
    20942062                                    :with-frame box-frame
    2095                                     :text-container container))
    2096                (info (hi::buffer-selection-info (hemlock-buffer textstorage))))
    2097           (setf (view-selection-info echo) info
    2098                 (hi::selection-info-view info) echo)
     2063                                    :text-container container)))
    20992064          (#/setMinSize: echo (pref box-frame :<NSR>ect.size))
    21002065          (#/setMaxSize: echo (ns:make-ns-size large-number-for-text large-number-for-text))
     
    22172182  #-cocotron 0.0f0)
    22182183
    2219 (defun new-hemlock-document-window (class)
    2220   (let* ((w (new-cocoa-window :class class
    2221                               :activate nil))
    2222          (echo-area-height (+ 1 (size-of-char-in-font *editor-font*))))
    2223       (values w (add-pane-to-window w :reserve-below echo-area-height))))
    2224 
    2225 
    22262184
    22272185(defun add-pane-to-window (w &key (reserve-above 0.0f0) (reserve-below 0.0f0))
     
    22402198
    22412199(defun textpane-for-textstorage (class ts ncols nrows container-tracks-text-view-width color style)
    2242   (let* ((pane (nth-value
    2243                 1
    2244                 (new-hemlock-document-window class))))
     2200  (let* ((w (new-cocoa-window :class class :activate nil))
     2201         (echo-area-height (+ 1 (size-of-char-in-font *editor-font*)))
     2202         (pane (add-pane-to-window w :reserve-below echo-area-height)))
    22452203    (make-scrolling-textview-for-pane pane ts container-tracks-text-view-width color style)
    22462204    (multiple-value-bind (height width)
     
    25582516(objc:defmethod (#/textViewDidChangeSelection: :void)
    25592517    ((self hemlock-editor-window-controller) notification)
    2560   (let* ((hv (hemlock-view self))
    2561          (buffer (hi:hemlock-view-buffer hv))
    2562          (tv (#/object notification)))
    2563    (unless (> (buffer-edit-level buffer) 0) ;; if editing, hemlock position is the master position.
    2564     (with-view-selection-info (tv buffer)
    2565       (let* ((range (#/selectedRange tv))
    2566              (v0 (ns:ns-range-location range))
    2567              (v1 (+ v0 (ns:ns-range-length range))))
    2568         (multiple-value-bind (b0 b1) (hi:buffer-selection-range buffer)
    2569           ;; If the selections differ, synch them up.
    2570           (unless (and (= b0 v0)
    2571                        (= b1 v1))
    2572             (let ((point (hi:buffer-point buffer)))
    2573               (hi:move-to-absolute-position point v0)
    2574               (when (> v1 v0)
    2575                 (let ((mark (hi:copy-mark point :right-inserting)))
    2576                   (hi:move-to-absolute-position mark v1)
    2577                   (hemlock::%buffer-push-buffer-mark buffer mark t)))))))))))
     2518  (let ((tv (#/object notification)))
     2519    (with-hemlock-context (tv)
     2520      (let ((buffer (hi:current-buffer)))
     2521        (unless (> (buffer-edit-level buffer) 0) ;; if editing, hemlock position is the master position.
     2522          (let* ((range (#/selectedRange tv))
     2523                 (v0 (ns:ns-range-location range))
     2524                 (v1 (+ v0 (ns:ns-range-length range))))
     2525            (multiple-value-bind (b0 b1) (hi:buffer-selection-range buffer)
     2526              ;; If the selections differ, synch them up.
     2527              (unless (and (= b0 v0)
     2528                           (= b1 v1))
     2529                (let ((point (hi:buffer-point buffer)))
     2530                  (hi:move-to-absolute-position point v0)
     2531                  (when (> v1 v0)
     2532                    (let ((mark (hi:copy-mark point :right-inserting)))
     2533                      (hi:move-to-absolute-position mark v1)
     2534                      (hemlock::%buffer-push-buffer-mark buffer mark t))))))))))))
    25782535
    25792536(objc:defmethod #/windowTitleForDocumentDisplayName: ((self hemlock-editor-window-controller) docname)
     
    28422799    doc))
    28432800
    2844  
    28452801(defun make-buffer-for-document (ns-document pathname)
    28462802  (let* ((buffer-name (hi::pathname-to-buffer-name pathname))
     
    31413097  (let* ((self-controller (#/windowController self))
    31423098         (doc (#/document self-controller)))
    3143     (when (typep doc 'hemlock-editor-document
    3144       (let* ((sequence-number (incf (slot-value doc 'dupcount))))
    3145         (#/makeWindowControllers doc)
    3146         ;; Now we have to find the window controller that was just made ...
    3147         (let* ((controllers (#/windowControllers doc))
    3148                (count (#/count controllers))
    3149                (controller (dotimes (i count)
    3150                              (let* ((c (#/objectAtIndex: controllers i)))
    3151                                (when (eql sequence-number (slot-value c 'sequence))
    3152                                  (return c))))))
    3153 
    3154           (when controller
    3155             (let* ((window (#/window controller))
    3156                    (new-text-view (text-pane-text-view (slot-value window 'pane)))
    3157                    (new-selection-info (view-selection-info new-text-view))
    3158                    (old-selection-info (view-selection-info (text-pane-text-view (slot-value self 'pane))))
    3159                    (old-mark (hi::selection-info-%mark old-selection-info)))
    3160               (hi::move-mark (hi::selection-info-point new-selection-info)
    3161                              (hi::selection-info-point old-selection-info))
    3162               (setf (hi::selection-info-%mark new-selection-info)
    3163                     (if old-mark (hi::copy-mark old-mark))
    3164                     (hi::selection-info-region-active new-selection-info)
    3165                     (hi::selection-info-region-active old-selection-info))
    3166               (update-hemlock-selection (#/textStorage new-text-view))
    3167               (#/scrollRangeToVisible: new-text-view
    3168                                        (#/selectedRange new-text-view))
    3169               (#/makeKeyAndOrderFront: window +null-ptr+)))))))))
     3099    (when (typep doc 'hemlock-editor-document)
     3100      (with-hemlock-context (self) ;; default values from this view when creating new view
     3101        (let* ((sequence-number (incf (slot-value doc 'dupcount))))
     3102          (#/makeWindowControllers doc) ;; creates hemlock-view
     3103          ;; Now we have to find the window controller that was just made ...
     3104          (let* ((controllers (#/windowControllers doc))
     3105                 (count (#/count controllers))
     3106                 (controller (dotimes (i count)
     3107                               (let* ((c (#/objectAtIndex: controllers i)))
     3108                                 (when (eql sequence-number (slot-value c 'sequence))
     3109                                   (return c))))))
     3110           
     3111            (when controller
     3112              (let* ((window (#/window controller))
     3113                     (new-text-view (text-pane-text-view (slot-value window 'pane))))
     3114                (update-hemlock-selection (#/textStorage new-text-view))
     3115                (#/scrollRangeToVisible: new-text-view
     3116                                         (#/selectedRange new-text-view))
     3117                (#/makeKeyAndOrderFront: window +null-ptr+)))))))))
    31703118             
    31713119     
     
    34253373(defmethod update-hemlock-selection ((self hemlock-text-storage))
    34263374  (assume-cocoa-thread)
    3427   (let* ((buffer (hemlock-buffer self)))
    3428     (for-each-textview-using-storage
    3429      self
    3430      (lambda (tv)
    3431        (with-view-selection-info (tv buffer)
    3432          (multiple-value-bind (start end) (hi:buffer-selection-range buffer)
    3433            #+debug
    3434            (#_NSLog #@"update Hemlock selection: charpos = %d, abspos = %d"
    3435                     :int (hi::mark-charpos (hi::buffer-point buffer)) :int start)
    3436            (#/updateSelection:length:affinity: tv
    3437                                                start
    3438                                                (- end start)
    3439                                                (if (eql start 0)
    3440                                                  #$NSSelectionAffinityUpstream
    3441                                                  #$NSSelectionAffinityDownstream))))))))
     3375  (for-each-textview-using-storage
     3376   self
     3377   (lambda (tv)
     3378     (with-hemlock-context (tv)
     3379       (multiple-value-bind (start end) (hi:buffer-selection-range (hi:current-buffer))
     3380         #+debug 0
     3381         (#_NSLog #@"update Hemlock selection: charpos = %d, abspos = %d"
     3382                  :int (hi::mark-charpos (hi:current-point)) :int start)
     3383         (#/updateSelection:length:affinity: tv
     3384                                             start
     3385                                             (- end start)
     3386                                             (if (eql start 0)
     3387                                               #$NSSelectionAffinityUpstream
     3388                                               #$NSSelectionAffinityDownstream)))))))
    34423389
    34433390;; This should be invoked by any command that modifies the buffer, so it can show the
  • trunk/source/cocoa-ide/hemlock/src/display.lisp

    r15966 r16343  
    77;; Functions used by the IDE display code.
    88
    9 (defmacro with-display-context (view &body body)
    10   `(let* ((hi::*current-view* ,view)
    11           (hi::*current-buffer* (hemlock-view-buffer hi::*current-view*)))
    12      ,@body))
    13 
     9(defmacro with-display-context ((view &optional pane) &body body)
     10  (let ((viewvar (gensym "VIEW")))
     11    `(let* ((,viewvar ,view)
     12            (hi::*current-view* ,viewvar)
     13            (hi::*current-buffer* (ecase ,pane
     14                                    ((:text) (hi::hemlock-view-buffer ,viewvar))
     15                                    ((:echo) (hi::hemlock-echo-area-buffer ,viewvar))
     16                                    ((nil) (hi::hemlock-view-current-buffer ,viewvar)))))
     17       (hi::with-default-view-for-buffer (,viewvar)
     18         ,@body))))
    1419
    1520;; User variable.  Maps symbol categories (see compute-symbol-category) to color specs
  • trunk/source/cocoa-ide/hemlock/src/macros.lisp

    r16244 r16343  
    588588  `(handler-bind ((error #'lisp-error-error-handler))
    589589     ,@body))
     590
     591
     592;;;;
     593
     594(defmacro with-default-view-for-buffer ((view) &body body)
     595  (let ((viewvar (gensym)) (buffervar (gensym)) (savevar (gensym)))
     596    `(let* ((,viewvar ,view)
     597            (,buffervar (hemlock-view-buffer ,viewvar))
     598            (,savevar (buffer-default-view ,buffervar)))
     599       ;;(assert (null (buffer-default-view (hemlock-echo-area-buffer ,viewvar))))
     600       (unwind-protect
     601           (progn
     602             (setf (buffer-default-view ,buffervar) ,viewvar)
     603             ,@body)
     604         (setf (buffer-default-view ,buffervar) ,savevar)))))
     605
  • trunk/source/cocoa-ide/hemlock/src/struct.lisp

    r15291 r16343  
    8181  node)
    8282
    83 ;;; swappable selection info
     83;; Each view has a selection.  The view's selection is what is displayed in the window, and by
     84;; default it is what is manipulated by commands.  In addition, each buffer has its own selection
     85;; info that is only used when a buffer is accessed without any view context (or if the buffer
     86;; is serving as the echo area buffer).
    8487(defstruct (selection-info (:copier nil))
    8588  point                       ; current position in buffer
     
    8790  (mark-ring (make-ring 10 #'delete-mark))                 ; per-view
    8891  region-active               ; modified-tick when region last activated
    89   view                        ; hemlock-text-view or NIL
    90 )
    91 
     92  )
    9293 
    9394;;; The buffer object:
     
    105106  bindings                    ; buffer's command table
    106107  (shadow-syntax nil)         ; buffer's changes to syntax attributes.
    107   #-clozure
    108   point                       ; current position in buffer
    109   #-clozure
    110   %mark                       ; a saved buffer position
    111   #-clozure
    112   region-active               ; modified-tick when region last activated
    113   #+clozure
    114   (selection-info (make-selection-info))
     108  (default-selection-info (make-selection-info)) ; usually shadowed by a view's info
    115109  (%writable t)               ; t => can alter buffer's region
    116110  (modified-tick -2)          ; The last time the buffer was modified.
     
    137131  (%lines (make-array 10 :adjustable t :fill-pointer 0)) ;; all lines in the buffer
    138132  (plist ())                  ; plist for users
    139   #+clozure
    140   textstorage
     133
     134  ;; Dynamically bound slot, pointing to the preferred view for buffer.
     135  (default-view nil)
    141136  )
     137
     138(defun buffer-selection-info (buffer)
     139  (let ((view (buffer-default-view buffer)))
     140    (if view (hemlock-selection-info view) (buffer-default-selection-info buffer))))
    142141
    143142(defun buffer-point (buffer)
  • trunk/source/cocoa-ide/hemlock/src/views.lisp

    r15983 r16343  
    1010;;
    1111;; A HEMLOCK-VIEW never changes which text buffer it displays (unlike in emacs).  A
    12 ;; text buffer can be displayed in multiple HEMLOCK-VIEW's, although currently there
    13 ;; is no UI to make that happen.  But we try take care to distinguish per-buffer info
    14 ;; from per-view info.  The former is stored in the buffer struct and in buffer
    15 ;; variables.  The latter is currently stored in HEMLOCK-VIEW slots, although I'd
     12;; text buffer can be displayed in multiple HEMLOCK-VIEW's (through the "Duplicate
     13;; this window" command in the context menu, or programmatically thru #/duplicate.)
     14;; Per-buffer info is stored in the buffer struct and in buffer variables.  The
     15;; per-view info is currently stored in HEMLOCK-VIEW slots, although I'd
    1616;; like to introduce user-definable "view variables" and get rid of some of these
    17 ;; user-level slots.  [Note: currently, multiple views on a buffer are but a remote
    18 ;; dream.  Basic things like the insertion point are still per buffer when they
    19 ;; should be per view]
    20 
    21 ;; NOTE: In CCL, it's no longer a dream. See definition
    22 ;;  (objc:defmethod (#/duplicate: :void) ((self hemlock-frame) sender)
     17;; user-level slots.
    2318;;
    2419;; The user interacts with a HEMLOCK-VIEW using events.  Each time the user presses a
     
    3934   (echo-area-buffer :initarg :echo-area-buffer :reader hemlock-echo-area-buffer)
    4035   (echo-area-stream :reader hemlock-echo-area-stream)
     36   (selection-info :reader hemlock-selection-info)
    4137
    4238   ;; Input state
     
    5551   ;; User level "view variables", for now give each its own slot.
    5652   (last-command-type :initform nil :accessor hemlock-last-command-type)
     53   ;; TODO: should this be in selection-info?  E.g. should it get copied when copy the view?
    5754   (target-column :initform 0 :accessor hemlock-target-column)
    5855   ))
     
    6966(defmethod initialize-instance ((view hemlock-view) &key)
    7067  (call-next-method)
     68  (with-slots (selection-info buffer) view
     69    (setf selection-info (make-selection-info :point (copy-mark (buffer-point buffer))
     70                                              :%mark (let ((mark (buffer-mark buffer)))
     71                                                       (and mark (copy-mark mark)))
     72                                              :region-active (buffer-region-active buffer)))
     73    (setf (buffer-default-view buffer) view))
    7174  (with-slots (echo-area-buffer echo-area-stream) view
     75    #+debug (assert (null (buffer-default-view echo-area-buffer))) ;; For echo area, use the selection info from buffer, not view.
    7276    (setf echo-area-stream
    7377          (make-hemlock-output-stream (buffer-end-mark echo-area-buffer) :full))))
     
    191195
    192196(defmethod execute-hemlock-key ((view hemlock-view) key)
    193   #+debug (log-debug "~&execute-hemlock-key ~s" key)
     197  #+debug (log-debug "~&execute-hemlock-key ~s ~s" view key)
    194198  (with-output-to-listener
    195199   (if (or (symbolp key) (functionp key))
     
    276280             (text-buffer (hemlock-view-buffer view))
    277281             (mod (buffer-modification-state text-buffer)))
    278         (modifying-buffer-storage (*current-buffer*)
    279           (restart-case
    280               (handler-bind ((error #'(lambda (c)
    281                                         (lisp-error-error-handler c :debug-p t))))
    282                 (execute-hemlock-key view key))
    283             (exit-event-handler () :report "Exit from hemlock event handler")))
    284         ;; Update display
    285         (if *next-view-start*
    286           (destructuring-bind (how . where) *next-view-start*
    287             (hemlock-ext:scroll-view view how where))
    288           (unless (equal mod (buffer-modification-state text-buffer))
    289             ;; Modified buffer, make sure user sees what happened
    290             (hemlock-ext:ensure-selection-visible view)))
    291         (update-echo-area-after-command view)))))
     282        (with-default-view-for-buffer (view)
     283          (modifying-buffer-storage (*current-buffer*)
     284            (restart-case
     285                (handler-bind ((error #'(lambda (c)
     286                                          (lisp-error-error-handler c :debug-p t))))
     287                  (execute-hemlock-key view key))
     288              (exit-event-handler () :report "Exit from hemlock event handler")))
     289          ;; Update display
     290          (if *next-view-start*
     291            (destructuring-bind (how . where) *next-view-start*
     292              (hemlock-ext:scroll-view view how where))
     293            (unless (equal mod (buffer-modification-state text-buffer))
     294              ;; Modified buffer, make sure user sees what happened
     295              (hemlock-ext:ensure-selection-visible view)))
     296          (update-echo-area-after-command view))))))
Note: See TracChangeset for help on using the changeset viewer.