Changeset 12324


Ignore:
Timestamp:
Jun 28, 2009, 2:22:00 PM (10 years ago)
Author:
gb
Message:

struct.lisp: Add a new SELECTION-SET-BY-COMMAND slot to the BUFFER
structure.

cocoa-editor.lisp: clear the new SELECTION-SET-BY-COMMAND slot if
the selection's set by Cocoa; set if it the selection's set by Hemlock
command processing (and has non-zero length.)

bindings.lisp: new functions CURRENT-POINT-FOR-SELECTION-START,
CURRENT-POINT-FOR-SELECTION-END: ensure that the Hemlock region
is active and return point; if the region was active but the
selection wasn't set by an editing command, ensure that point
is at the start (end) of the selection (exchanging the positions
of point and mark if necessary.)

package.lisp: export those function names.

command.lisp, lispmode.lisp: use these new functions for motion
commands that modify the selection. As far as I can see, their
behavior is pretty close to TextEdit?'s (there -may- be cases where
TextEdit?'s notion of a "word" differs from Hemlock's, and there may
be different behavior regarding whether or not whitepace is included
in the selection in some cases.)

If this isn't broken and someone works on it: we currently pass
key events that have the command modifier set to Cocoa, and
command-shift-arrow extends the selection to the start/end of the
line/buffer. We may need to either handle these events as Hemlock
commands (with a hyper or other modifer) or somehow ensure that
our notion of how the selection is anchored matches Cocoa's (which
seems to be maintained in some internal undocumented way.)

bindings.lisp: bind meta-leftarrow, meta-rightarrow. (May still need
to setup bindings for other modified arrow-key events.)

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

Legend:

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

    r12319 r12324  
    11651165  (when (eql length 0)
    11661166    (update-paren-highlight self))
     1167  (let* ((buffer (hemlock-buffer self)))
     1168    (setf (hi::buffer-selection-set-by-command buffer) (> length 0)))
    11671169  (rlet ((range :ns-range :location pos :length length))
    11681170    (ccl::%call-next-objc-method self
     
    14741476           (location (pref r :<NSR>ange.location))
    14751477           (len (pref r :<NSR>ange.length)))
     1478      (setf (hi::buffer-selection-set-by-command buffer) nil)
    14761479      (cond ((eql len 0)
    14771480             #+debug
  • trunk/source/cocoa-ide/hemlock/src/bindings.lisp

    r12291 r12324  
    159159
    160160(bind-key "Forward Word" #k"meta-f")
     161(bind-key "Forward Word" #k"meta-rightarrow")
    161162(bind-key "Select Forward Word" #k"meta-F")
    162163(bind-key "Select Forward Word" #k"meta-shift-rightarrow")
    163164(bind-key "Backward Word" #k"meta-b")
     165(bind-key "Backward Word" #k"meta-leftarrow")
    164166(bind-key "Select Backward Word" #k"meta-B")
    165167(bind-key "Select Backward Word" #k"meta-shift-leftarrow")
  • trunk/source/cocoa-ide/hemlock/src/buffer.lisp

    r8428 r12324  
    239239
    240240(defun current-point-extending-selection ()
    241   "Return the Buffer-Point of the current buffer, deactivating the
    242    region."
     241  "Return the Buffer-Point of the current buffer, ensuring that
     242   the region's active."
    243243  (let* ((b *current-buffer*)
    244244         (point (buffer-point b)))
     
    248248      (push-new-buffer-mark point t))
    249249    point))
     250
     251(defun current-point-for-selection-start ()
     252  "Return the Buffer-Point of the current buffer, ensuring that
     253   the region's active.  If the region was active but the
     254   buffer's SELECTION-SET-BY-COMMAND flag is false, ensure that
     255   point precedes mark by exchanging their positions if necessary."
     256  (let* ((b *current-buffer*)
     257         (point (buffer-point b)))
     258    ;; If the region is active, keep it active.  Otherwise,
     259    ;; establish a new (empty) region at point.
     260    (if (%buffer-current-region-p b)
     261      (unless (buffer-selection-set-by-command b)
     262        (let* ((mark (current-mark)))
     263          (if (mark< mark point)
     264            (with-mark ((temp point))
     265              (move-mark point mark)
     266              (move-mark mark temp)))))
     267      (push-new-buffer-mark point t))
     268    point))
     269
     270(defun current-point-for-selection-end ()
     271  "Return the Buffer-Point of the current buffer, ensuring that
     272   the region's active.  If the region was active but the
     273   buffer's SELECTION-SET-BY-COMMAND flag is false, ensure that
     274   point follows mark by exchanging their positions if necessary."
     275  (let* ((b *current-buffer*)
     276         (point (buffer-point b)))
     277    ;; If the region is active, keep it active.  Otherwise,
     278    ;; establish a new (empty) region at point.
     279    (if (%buffer-current-region-p b)
     280      (unless (buffer-selection-set-by-command b)
     281        (let* ((mark (current-mark)))
     282          (if (mark> mark point)
     283            (with-mark ((temp point))
     284              (move-mark point mark)
     285              (move-mark mark temp)))))
     286      (push-new-buffer-mark point t))
     287    point))
     288 
     289
    250290
    251291(defun current-point-for-insertion ()
  • trunk/source/cocoa-ide/hemlock/src/command.lisp

    r12287 r12324  
    103103
    104104(defcommand "Select Forward Character" (p)
    105     "Move the point forward one character, extending the selection.
     105  "Move the point forward one character, extending the selection.
    106106   With prefix argument move that many characters, with negative argument
    107107   go backwards."
    108     "Move the point of the current buffer forward p characters, extending the selection."
    109   (let* ((p (or p 1))
    110          (point (current-point-extending-selection)))
    111     (cond ((character-offset point p))
    112           ((= p 1)
    113            (editor-error "No next character."))
    114           ((= p -1)
    115            (editor-error "No previous character."))
    116           (t
    117            (if (plusp p)
     108  "Move the point of the current buffer forward p characters, extending the selection."
     109  (let* ((p (or p 1)))
     110    (if (< p 0)
     111      (select-backward-character-command (- p))
     112      (let* ((point (current-point-for-selection-end)))
     113        (cond ((character-offset point p))
     114              ((= p 1)
     115               (editor-error "No next character."))
     116              (t
    118117               (buffer-end point)
    119                (buffer-start point))
    120            (editor-error "Not enough characters.")))))
     118               (editor-error "Not enough characters.")))))))
    121119
    122120(defcommand "Backward Character" (p)
     
    131129  With prefix argument move that many characters backward."
    132130  "Move the point p characters backward, extending the selection."
    133   (select-forward-character-command (if p (- p) -1)))
     131  (let* ((p (or p 1)))
     132    (if (< p 0)
     133      (select-forward-character-command (- p))
     134      (let* ((point (current-point-for-selection-start)))
     135        (cond ((character-offset point (- p)))
     136              ((= p 1)
     137               (editor-error "No previous character."))
     138              (t
     139               (buffer-start point)
     140               (editor-error "Not enough characters.")))))))
    134141
    135142#|
     
    237244  With prefix argument, moves the point forward over that many words."
    238245  "Moves the point forward p words, extending the selection."
    239   (let* ((point (current-point-extending-selection)))
    240     (cond ((word-offset point (or p 1)))
    241           ((and p (minusp p))
    242            (buffer-start point)
    243            (editor-error "No previous word."))
    244           (t
    245            (buffer-end point)
    246            (editor-error "No next word.")))))
     246  (let* ((p (or p 1)))
     247    (if (< p 0)
     248      (select-backward-word-command (- p))
     249      (let* ((point (current-point-for-selection-end)))
     250        (cond ((word-offset point p))
     251              (t
     252               (buffer-end point)
     253               (editor-error "No next word.")))))))
    247254
    248255(defcommand "Backward Word" (p)
     
    257264  With prefix argument, moves the point back over that many words."
    258265  "Moves the point backward p words, extending the selection."
    259   (select-forward-word-command (- (or p 1))))
     266  (let* ((p (or p 1)))
     267    (if (< p 0)
     268      (select-forward-word-command (- p))
     269      (let* ((point (current-point-for-selection-start)))
     270        (cond ((word-offset point (- p)))
     271              (t
     272               (buffer-start point)
     273               (editor-error "No previous word.")))))))
    260274
    261275
     
    301315   With prefix argument, moves the point that many lines down (or up if
    302316   the prefix is negative)."
    303   "Moves the down p lines, extendin the selection."
    304   (let* ((point (current-point-extending-selection))
    305          (target (set-target-column point)))
    306     (unless (line-offset point (or p 1))
    307       (when (value next-line-inserts-newlines)
    308         (cond ((not p)
    309                (when (same-line-p point (buffer-end-mark (current-buffer)))
    310                  (line-end point))
    311                (insert-character point #\newline))
    312               ((minusp p)
    313                (buffer-start point)
    314                (editor-error "No previous line."))
    315               (t
    316                (buffer-end point)
    317                (when p (editor-error "No next line."))))))
    318     (unless (move-to-position point target) (line-end point))
    319     (setf (last-command-type) :line-motion)))
     317  "Moves the down p lines, extending the selection."
     318  (let* ((p (or p 1)))
     319    (if (< p 0)
     320      (select-previous-line-command (- p))
     321      (let* ((point (current-point-for-selection-end))
     322             (target (set-target-column point)))
     323        (unless (line-offset point (or p 1))
     324          (when (value next-line-inserts-newlines)
     325            (cond ((not p)
     326                   (when (same-line-p point (buffer-end-mark (current-buffer)))
     327                     (line-end point))
     328                   (insert-character point #\newline))
     329                  (t
     330                   (buffer-end point)
     331                   (when p (editor-error "No next line."))))))
     332        (unless (move-to-position point target) (line-end point))
     333        (setf (last-command-type) :line-motion)))))
    320334
    321335
     
    332346  the prefix is negative)."
    333347  "Moves the point up p lines, collapsing the selection."
    334   (select-next-line-command (- (or p 1))))
     348  (let* ((p (or p 1)))
     349    (if (< p 0)
     350      (select-next-line-command (- p))
     351      (let* ((point (current-point-for-selection-start))
     352             (target (set-target-column point)))
     353        (line-offset point (- p))
     354        (unless (move-to-position point target) (line-end point))
     355        (setf (last-command-type) :line-motion)))))
    335356
    336357(defcommand "Mark to End of Buffer" (p)
     
    376397  next line."
    377398    "Moves the point down p lines and then to the beginning of the line, extending the selection."
    378   (let ((point (current-point-extending-selection)))
     399  (let ((point (current-point-for-selection-start)))
    379400    (unless (line-offset point (if p p 0)) (editor-error "No such line."))
    380401    (line-start point)))
     
    392413  With prefix argument, moves the point to the end of the prefix'th next line."
    393414  "Moves the point down p lines and then to the end of the line, extending the selection."
    394   (let ((point (current-point-extending-selection)))
     415  (let ((point (current-point-for-selection-end)))
    395416    (unless (line-offset point (if p p 0)) (editor-error "No such line."))
    396417    (line-end point)))
  • trunk/source/cocoa-ide/hemlock/src/lispmode.lisp

    r12322 r12324  
    12411241  with an argument, skips the previous p top-level forms."
    12421242  "Move the point to the beginning of a top-level form, extending the selection."
    1243   (let ((point (current-point-extending-selection))
     1243  (let ((point (current-point-for-selection-start))
    12441244        (count (or p 1)))
    12451245    (pre-command-parse-check point)
     
    12841284   With an argument, skips the next p top-level forms."
    12851285  "Move the point to the end of a top-level form, extending the selection."
    1286   (let ((point (current-point-extending-selection))
     1286  (let ((point (current-point-for-selection-end))
    12871287        (count (or p 1)))
    12881288    (pre-command-parse-check point)
     
    13171317  With argument, skips the next p lists."
    13181318  "Skip over the next Lisp list, extending the selection."
    1319   (let ((point (current-point-extending-selection))
     1319  (let ((point (current-point-for-selection-end))
    13201320        (count (or p 1)))
    13211321    (pre-command-parse-check point)
     
    13361336  With argument, skips the previous p lists."
    13371337  "Skip over the previous Lisp list, extending the selection."
    1338   (let ((point (current-point-extending-selection))
     1338  (let ((point (current-point-for-selection-start))
    13391339        (count (- (or p 1))))
    13401340    (pre-command-parse-check point)
     
    13551355  With argument, skips the next p Forms."
    13561356  "Skip over the next Form, extending the selection."
    1357   (let ((point (current-point-extending-selection))
     1357  (let ((point (current-point-for-selection-end))
    13581358        (count (or p 1)))
    13591359    (pre-command-parse-check point)
     
    13741374  With argument, skips the previous p Forms."
    13751375  "Skip over the previous Form, extending the selection."
    1376   (let ((point (current-point-extending-selection))
     1376  (let ((point (current-point-for-selection-start))
    13771377        (count (- (or p 1))))
    13781378    (pre-command-parse-check point)
  • trunk/source/cocoa-ide/hemlock/src/package.lisp

    r12317 r12324  
    6060   #:current-point-collapsing-selection
    6161   #:current-point-extending-selection
     62   #:current-point-for-selection-start
     63   #:current-point-for-selection-end
    6264   #:current-point
    6365   #:current-mark
  • trunk/source/cocoa-ide/hemlock/src/struct.lisp

    r12272 r12324  
    119119  active-font-region                    ; currently active font region
    120120  charprops                   ; the buffer's default charprops
     121  (selection-set-by-command nil) ; boolean: true if selection set by (shifted) motion command.
    121122  )
    122123
Note: See TracChangeset for help on using the changeset viewer.