Changeset 12280


Ignore:
Timestamp:
Jun 23, 2009, 5:30:01 PM (10 years ago)
Author:
mikel
Message:

Ticket #471: implemented corrected selection-collapsing for Forward Word and Backward Word.

Fixed a couple more stupid copy-paste bugs introduced in the initial implementation.

Factored the common selection-collapsing out into a simple utility function.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/command.lisp

    r12279 r12280  
    1515(in-package :hemlock)
    1616
     17;;; utility for collapsing selections from movement commands
     18;;; returns a true value if a selection was collapsed, false otherwise
     19(defun collapse-if-selection (&key (direction :end))
     20  (assert (memq direction '(:start :end))()
     21          "collapse-if-selection requires a :direction argument equal to either :start or :end")
     22  (if (hi::%buffer-current-region-p hi::*current-buffer*)
     23      (multiple-value-bind (start end)(region-bounds (current-region nil nil))
     24        (let ((d (ecase direction ((:end) end)((:start) start))))
     25          (setf (buffer-point hi::*current-buffer*) d)
     26          (setf (hi::buffer-region-active hi::*current-buffer*) nil)
     27          t))
     28      nil))
    1729
    1830;;; Make a mark for buffers as they're consed:
     
    6880   go backwards."
    6981    "Move the point of the current buffer forward p characters, collapsing the selection."
    70   (if (hi::%buffer-current-region-p hi::*current-buffer*)
    71       (multiple-value-bind (start end)(region-bounds (current-region nil nil))
    72         (setf (buffer-point hi::*current-buffer*) end)
    73         (setf (hi::buffer-region-active hi::*current-buffer*) nil))
     82  (or (collapse-if-selection :direction :end)
    7483      (let* ((p (cond
    7584                  (p p)
     
    8897               (editor-error "Not enough characters."))))))
    8998
    90 
    9199(defcommand "Select Forward Character" (p)
    92100    "Move the point forward one character, extending the selection.
     
    94102   go backwards."
    95103    "Move the point of the current buffer forward p characters, extending the selection."
    96   (let* ((p (cond
    97                   (p p)
    98                   ((hi::%buffer-current-region-p hi::*current-buffer*) 0)
    99                   (t 1)))
    100              (point (current-point-collapsing-selection)))
    101         (cond ((character-offset point p))
    102               ((= p 1)
    103                (editor-error "No next character."))
    104               ((= p -1)
    105                (editor-error "No previous character."))
    106               (t
    107                (if (plusp p)
    108                    (buffer-end point)
    109                    (buffer-start point))
    110                (editor-error "Not enough characters.")))))
     104  (let* ((p (or p 1))
     105         (point (current-point-collapsing-selection)))
     106    (cond ((character-offset point p))
     107          ((= p 1)
     108           (editor-error "No next character."))
     109          ((= p -1)
     110           (editor-error "No previous character."))
     111          (t
     112           (if (plusp p)
     113               (buffer-end point)
     114               (buffer-start point))
     115           (editor-error "Not enough characters.")))))
    111116
    112117(defcommand "Backward Character" (p)
     
    114119  With prefix argument move that many characters backward."
    115120    "Move the point p characters backward, collapsing the selection."
    116   (if (hi::%buffer-current-region-p hi::*current-buffer*)
    117       (multiple-value-bind (start end)(region-bounds (current-region nil nil))
    118         (setf (buffer-point hi::*current-buffer*) start)
    119         (setf (hi::buffer-region-active hi::*current-buffer*) nil))
     121  (or (collapse-if-selection :direction :start)
    120122      (forward-character-command (if p (- p) -1))))
    121123
     
    213215
    214216(defcommand "Forward Word" (p)
    215   "Moves forward one word, collapsing the selection.
     217    "Moves forward one word, collapsing the selection.
    216218  With prefix argument, moves the point forward over that many words."
    217   "Moves the point forward p words, collapsing the selection."
    218   (let* ((point (current-point-collapsing-selection)))
    219     (cond ((word-offset point (or p 1)))
    220           ((and p (minusp p))
    221            (buffer-start point)
    222            (editor-error "No previous word."))
    223           (t
    224            (buffer-end point)
    225            (editor-error "No next word.")))))
     219    "Moves the point forward p words, collapsing the selection."
     220  (or (collapse-if-selection :direction :end)
     221      (let* ((point (current-point-collapsing-selection)))
     222        (cond ((word-offset point (or p 1)))
     223              ((and p (minusp p))
     224               (buffer-start point)
     225               (editor-error "No previous word."))
     226              (t
     227               (buffer-end point)
     228               (editor-error "No next word."))))))
    226229
    227230(defcommand "Select Forward Word" (p)
     
    242245  With prefix argument, moves the point back over that many words."
    243246  "Moves the point backward p words."
    244   (forward-word-command (- (or p 1))))
     247  (or (collapse-if-selection :direction :start)
     248   (forward-word-command (- (or p 1)))))
    245249
    246250(defcommand "Select Backward Word" (p)
Note: See TracChangeset for help on using the changeset viewer.