Changeset 14737


Ignore:
Timestamp:
Apr 27, 2011, 6:19:49 PM (9 years ago)
Author:
gz
Message:

When moving point to new position by mouse click, leave mark at the old position so c-x c-x (or c-u c-@) will bring you back.

Make c-x c-x with prefix argument deactivate region.

Make cmd-E invoke editor-execute-expression-command, in particular it doesn't require a selection.

Treat the colon in keywords as a word constituent for selection purposes.

Make extending the selection use the same rules as setting it. This eliminates a number of inconsistencies in selection behavior.

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

Legend:

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

    r14732 r14737  
    13711371
    13721372
    1373 
    13741373(objc:defmethod (#/evalSelection: :void) ((self hemlock-text-view) sender)
    13751374  (declare (ignore sender))
    1376   ;; TODO: this should just invoke editor-evaluate-region-command instead of reinventing the wheel.
    1377   (let* ((buffer (hemlock-buffer self))
    1378          (package-name (hi::variable-value 'hemlock::current-package :buffer buffer))
    1379          (pathname (hi::buffer-pathname buffer))
    1380          ;; Cocotron issue 380: NSTextView doesn't implement #/selectedRanges and
    1381          ;;  #/setSelectedRanges: methods.
    1382          #-cocotron (ranges (#/selectedRanges self))
    1383          #+cocotron (ranges (#/arrayWithObject: ns:ns-array
    1384                                                 (#/valueWithRange: ns:ns-value
    1385                                                                    (#/selectedRange self))))
    1386          (text (#/string self)))
    1387     (dotimes (i (#/count ranges))
    1388       (let* ((r (#/rangeValue (#/objectAtIndex: ranges i)))
    1389              (s (#/substringWithRange: text r))
    1390              (o (ns:ns-range-location r)))
    1391         (setq s (lisp-string-from-nsstring s))
    1392         (ui-object-eval-selection *NSApp* (list package-name pathname s o))))))
     1375  (let* ((view (hemlock-view self)))
     1376    (when view
     1377      (hi::handle-hemlock-event view #'(lambda ()
     1378                                         (hemlock::editor-execute-expression-command nil))))))
    13931379
    13941380(objc:defmethod (#/evalAll: :void) ((self hemlock-text-view) sender)
     
    15291515  (objc:returning-foreign-struct (r)
    15301516     (block HANDLED
    1531        (let* ((index (ns:ns-range-location proposed)) 
     1517       (let* ((index (ns:ns-range-location proposed))
    15321518              (length (ns:ns-range-length proposed))
    1533               (textstorage (#/textStorage self)))
    1534          (when (and (eql 0 length)      ; not extending existing selection
    1535                     (or (not (eql g #$NSSelectByCharacter))
    1536                         (and (eql index (#/length textstorage))
    1537                              (let* ((event (#/currentEvent (#/window self))))
    1538                                (and (eql (#/type event) #$NSLeftMouseDown)
    1539                                     (> (#/clickCount event) 1))))))
     1519              (textstorage (#/textStorage self))
     1520              (event (#/currentEvent (#/window self)))
     1521              (event-type (#/type event)))
     1522         ;; Workaround for bug #150
     1523         (when (and (eql g #$NSSelectByCharacter)
     1524                    (eql index (#/length textstorage))
     1525                    (or (eql event-type #$NSLeftMouseDown) (eql event-type #$NSLeftMouseUp)))
     1526           (setq g (case (#/clickCount event)
     1527                     ((0 1) #$NSSelectByCharacter)
     1528                     (2 #$NSSelectByWord)
     1529                     (t #$NSSelectByParagraph))))
     1530         (unless (eql g #$NSSelectByCharacter)
    15401531           (let* ((cache (hemlock-buffer-string-cache (#/hemlockString textstorage)))
    15411532                  (buffer (buffer-cache-buffer cache))
    15421533                  (hi::*current-buffer* buffer)
    1543                   (point (hi::buffer-point buffer))
    1544                   (atom-mode (or (eql g #$NSSelectByParagraph)
    1545                                  (and (eql index (#/length textstorage))
    1546                                       (let* ((event (#/currentEvent (#/window self)))
    1547                                              (type (#/type event)))
    1548                                         (and (or (eql type #$NSLeftMouseDown) (eql type #$NSLeftMouseUp))
    1549                                              (> (#/clickCount event) 2)))))))
    1550              (hi::with-mark ((mark point))
    1551                (let ((region (selection-for-click mark atom-mode)))
    1552                  (when region
    1553                    ;; Act as if we started the selection at the other end, so the heuristic
    1554                    ;; in #/setSelectedRange does the right thing.  ref bug #565.
    1555                    ;; However, only do so on mouse up, ref bug #851.
    1556                    (when (eql (#/type (#/currentEvent (#/window self))) #$NSLeftMouseUp)
    1557                      (cond ((hi::mark= (hi::region-start region) mark)
    1558                             (hi::move-mark point (hi::region-end region)))
    1559                            ((hi::mark= (hi::region-end region) mark)
    1560                             (hi::move-mark point (hi::region-start region)))))
    1561                    (let ((start (hi::mark-absolute-position (hi::region-start region)))
    1562                          (end (hi::mark-absolute-position (hi::region-end region))))
    1563                      (assert (<= start end))
    1564                      (ns:init-ns-range r start (- end start)))
    1565                    #+debug
    1566                    (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
    1567                             :address (#_NSStringFromRange r)
    1568                             :address (#_NSStringFromRange proposed)
    1569                             :<NSS>election<G>ranularity g)
    1570                    (return-from HANDLED r)))))))
    1571        (prog1
    1572            (call-next-method proposed g)
    1573          #+debug
    1574          (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
    1575                   :address (#_NSStringFromRange r)
    1576                   :address (#_NSStringFromRange proposed)
    1577                   :<NSS>election<G>ranularity g)))))
     1534                  (point (hi:buffer-point buffer))
     1535                  (atom-mode (eql g #$NSSelectByParagraph)))
     1536             (hi:with-mark ((mark point))
     1537               (when (or (= length 0) (hi:move-to-absolute-position mark index))
     1538                 (let* ((region (selection-for-click mark atom-mode))
     1539                        (other-region (and (< 0 length)
     1540                                           (hi:character-offset mark length)
     1541                                           (selection-for-click mark atom-mode))))
     1542                   (when (null region) (setq region other-region other-region nil))
     1543                   (when region
     1544                     (let ((start-pos (min (hi:mark-absolute-position (hi:region-start region))
     1545                                           (if other-region
     1546                                             (hi:mark-absolute-position (hi:region-start other-region))
     1547                                             index)))
     1548                           (end-pos (max (hi:mark-absolute-position (hi:region-end region))
     1549                                         (if other-region
     1550                                           (hi:mark-absolute-position (hi:region-end other-region))
     1551                                           (+ index length)))))
     1552                       (assert (<= start-pos end-pos))
     1553                       ;; Act as if we started the selection at the other end, so the heuristic
     1554                       ;; in #/setSelectedRange does the right thing.  ref bug #565.
     1555                       ;; However, only do so at the end, so don't keep toggling during selection, ref bug #851.
     1556                       (when (and (eql event-type #$NSLeftMouseUp) (< start-pos end-pos))
     1557                         (let ((point-pos (hi:mark-absolute-position point)))
     1558                           (cond ((eql point-pos start-pos)
     1559                                  (hi:move-to-absolute-position point end-pos))
     1560                                 ((eql point-pos end-pos)
     1561                                  (hi:move-to-absolute-position point start-pos)))))
     1562                       (ns:init-ns-range r start-pos (- end-pos start-pos))
     1563                       #+debug
     1564                       (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
     1565                                :address (#_NSStringFromRange r)
     1566                                :address (#_NSStringFromRange proposed)
     1567                                :<NSS>election<G>ranularity g)
     1568                       (return-from HANDLED r))))))))
     1569         (prog1
     1570             (call-next-method proposed g)
     1571           #+debug
     1572           (#_NSLog #@"range = %@, proposed = %@, granularity = %d"
     1573                    :address (#_NSStringFromRange r)
     1574                    :address (#_NSStringFromRange proposed)
     1575                    :<NSS>election<G>ranularity g))))))
    15781576
    15791577;; Return nil to use the default Cocoa selection, which will be word for double-click, line for triple.
    15801578(defun selection-for-click (mark paragraph-mode-p)
    15811579  ;; Handle lisp mode specially, otherwise just go with default Cocoa behavior
    1582   (when (string= (hi::buffer-major-mode (hi::mark-buffer mark)) "Lisp") ;; gag
     1580  (when (string= (hi:buffer-major-mode (hi::mark-buffer mark)) "Lisp") ;; gag
    15831581    (unless paragraph-mode-p
    1584       ;; Select a word if near one
    1585       (hi:with-mark ((fwd mark)
    1586                      (bwd mark))
    1587         (or (hi:find-attribute  fwd :word-delimiter)
    1588             (hi:buffer-end fwd))
    1589         (or (hi:reverse-find-attribute bwd :word-delimiter)
    1590             (hi:buffer-start bwd))
    1591         (unless (hi:mark= bwd fwd)
    1592           (when (eq (hi:character-attribute :lisp-syntax (hi:previous-character bwd)) :prefix-dispatch)
    1593             ;; let :prefix-dispatch take on the attribute of the following char, which is a word constituent
    1594             (hi:mark-before bwd))
    1595           (return-from selection-for-click (hi::region bwd fwd)))))
     1582      (let ((region (hemlock::word-region-at-mark mark)))
     1583        (when region
     1584          (return-from selection-for-click region))))
    15961585    (hemlock::pre-command-parse-check mark)
    15971586    (hemlock::form-region-at-mark mark)))
     
    16051594
    16061595
     1596(defun move-point-for-click (buffer index)
     1597  (let* ((point (hi::buffer-point buffer))
     1598         (mark (and (hemlock::%buffer-region-active-p buffer) (hi::buffer-mark buffer))))
     1599    (setf (hi::buffer-region-active buffer) nil)
     1600    (unless (eql (hi:mark-absolute-position point) index)  ;; if point is already at target, leave mark alone
     1601      (if (and mark (eql (hi:mark-absolute-position mark) index))
     1602        (hi:move-mark mark point)
     1603        (hi::push-new-buffer-mark point))
     1604      (hi:move-to-absolute-position point index))))
     1605 
    16071606;;; Update the underlying buffer's point (and "active region", if appropriate.
    16081607;;; This is called in response to a mouse click or other event; it shouldn't
     
    16271626           (buffer (buffer-cache-buffer d))
    16281627           (hi::*current-buffer* buffer)
    1629            (point (hi::buffer-point buffer))
    16301628           (location (pref r :<NSR>ange.location))
    16311629           (len (pref r :<NSR>ange.length)))
     
    16341632             #+debug
    16351633             (#_NSLog #@"Moving point to absolute position %d" :int location)
    1636              (setf (hi::buffer-region-active buffer) nil)
    1637              (move-hemlock-mark-to-absolute-position point d location)
     1634             ;; Do this even if still-selecting, in order to enable the heuristic below.
     1635             (move-point-for-click buffer location)
    16381636             (update-paren-highlight self))
    16391637            (t
     
    16431641             ;; selection via the mouse generates a sequence of calls to
    16441642             ;; this method whose parameters look like:
    1645              ;; a: range: {n0,0} still-selecting: false  [ rarely repeats ]
     1643             ;; a: range: {n0,0} still-selecting: false  [ rarely repeats ] (this doesn't actually happen)
    16461644             ;; b: range: {n0,0) still-selecting: true   [ rarely repeats ]
    16471645             ;; c: range: {n1,m} still-selecting: true   [ often repeats ]
    1648              ;; d: range: {n1,m} still-selecting: false  [ rarely repeats ]
     1646             ;; d: range: {n1,m} still-selecting: false  [ rarely repeats ] (mouse up)
    16491647             ;;
    16501648             ;; (Sadly, "affinity" doesn't tell us anything interesting.)
     
    16611659             ;; In all cases, activate Hemlock selection.
    16621660             (unless still-selecting
    1663                 (let* ((pointpos (hi:mark-absolute-position point))
    1664                        (selection-end (+ location len))
    1665                        (mark (hi::copy-mark point :right-inserting)))
    1666                    (cond ((eql pointpos location)
    1667                           (move-hemlock-mark-to-absolute-position point
    1668                                                                   d
    1669                                                                   selection-end))
    1670                          ((eql pointpos selection-end)
    1671                           (move-hemlock-mark-to-absolute-position point
    1672                                                                   d
    1673                                                                   location))
    1674                          (t
    1675                           (move-hemlock-mark-to-absolute-position mark
    1676                                                                   d
    1677                                                                   location)
    1678                           (move-hemlock-mark-to-absolute-position point
    1679                                                                   d
    1680                                                                   selection-end)))
    1681                    (hemlock::%buffer-push-buffer-mark buffer mark t)))))))
     1661               (let* ((point (hi::buffer-point buffer))
     1662                      (pointpos (hi:mark-absolute-position point))
     1663                      (selection-end (+ location len))
     1664                      (mark (hi::copy-mark point :right-inserting)))
     1665                 (cond ((eql pointpos location)
     1666                        (move-hemlock-mark-to-absolute-position point
     1667                                                                d
     1668                                                                selection-end))
     1669                       ((eql pointpos selection-end)
     1670                        (move-hemlock-mark-to-absolute-position point
     1671                                                                d
     1672                                                                location))
     1673                       (t
     1674                        (move-hemlock-mark-to-absolute-position mark
     1675                                                                d
     1676                                                                location)
     1677                        (move-hemlock-mark-to-absolute-position point
     1678                                                                d
     1679                                                                selection-end)))
     1680                 (hemlock::%buffer-push-buffer-mark buffer mark t)))))))
    16821681  (call-next-method r affinity still-selecting))
    16831682
     
    26972696                  (#/shouldChangeTextInRange:replacementString: self selection #@""))))
    26982697          ((eql action (@selector #/evalSelection:))
    2699            (not (eql 0 (ns:ns-range-length (#/selectedRange self)))))
     2698           (when (hemlock-view self)
     2699             (if (eql 0 (ns:ns-range-length (#/selectedRange self)))
     2700               ;; Should check whether there is a current form
     2701               (#/setTitle: item #@"Execute Expression")
     2702               (#/setTitle: item #@"Execute Selection"))
     2703             t))
    27002704          ((eql action (@selector #/evalAll:))
    27012705           (let* ((doc (#/document (#/windowController (#/window self)))))
  • trunk/source/cocoa-ide/hemlock/src/killcoms.lisp

    r8428 r14737  
    180180
    181181(defcommand "Exchange Point and Mark" (p)
    182   "Swap the positions of the point and the mark, activating region"
    183   "Swap the positions of the point and the mark."
    184   (declare (ignore p))
     182  "Swap the positions of the point and the mark, activating region.
     183   With a prefix argument, deactivates region"
    185184  (let ((point (current-point))
    186185        (mark (current-mark)))
     
    188187      (move-mark point mark)
    189188      (move-mark mark temp)))
    190   (activate-region))
     189  (if p
     190    (deactivate-region)
     191    (activate-region)))
    191192
    192193(defcommand "Mark Whole Buffer"  (p)
  • trunk/source/cocoa-ide/hemlock/src/lispmode.lisp

    r14732 r14737  
    11111111        (if fwd
    11121112          (region fwd-start fwd-end))))))
     1113
     1114;; Return region for the current word at mark, or nil if there isn't one.
     1115(defun word-region-at-mark (mark)
     1116  (with-mark ((fwd mark)
     1117              (bwd mark))
     1118    (or (find-attribute  fwd :word-delimiter)
     1119        (buffer-end fwd))
     1120    (or (reverse-find-attribute bwd :word-delimiter)
     1121        (buffer-start bwd))
     1122    (unless (mark= bwd fwd)
     1123      ;; Special-case for keywords (and gensyms)
     1124      (when (eq (previous-character bwd) #\:)
     1125        (mark-before bwd)
     1126        (when (test-char (previous-character bwd) :lisp-syntax :constituent)
     1127          (mark-after bwd))) ;; oops, never mind
     1128      ;; Special-case for stuff like  #_foo.
     1129      (when (test-char (previous-character bwd) :lisp-syntax :prefix-dispatch)
     1130        ;; let :prefix-dispatch take on the attribute of the following char, which is a word constituent
     1131        (mark-before bwd))
     1132      (region bwd fwd))))
    11131133
    11141134;;;; Table of special forms with special indenting requirements.
Note: See TracChangeset for help on using the changeset viewer.