Changeset 14732 for trunk/source


Ignore:
Timestamp:
Apr 25, 2011, 6:10:16 PM (8 years ago)
Author:
gz
Message:

Handle navigating around # a bit better - dtrt for #' #_ #$ $/

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

Legend:

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

    r14722 r14732  
    15791579;; Return nil to use the default Cocoa selection, which will be word for double-click, line for triple.
    15801580(defun selection-for-click (mark paragraph-mode-p)
    1581   (unless paragraph-mode-p
    1582     ;; Select a word if near one
    1583     (hi::with-mark ((fwd mark)
    1584                     (bwd mark))
    1585       (or (hi::find-attribute fwd :word-delimiter)
    1586           (hi::buffer-end fwd))
    1587       (or (hi::reverse-find-attribute bwd :word-delimiter)
    1588           (hi::buffer-start bwd))
    1589       (unless (hi::mark= bwd fwd)
    1590         (return-from selection-for-click (hi::region bwd fwd)))))
     1581  ;; Handle lisp mode specially, otherwise just go with default Cocoa behavior
    15911582  (when (string= (hi::buffer-major-mode (hi::mark-buffer mark)) "Lisp") ;; gag
     1583    (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)))))
    15921596    (hemlock::pre-command-parse-check mark)
    15931597    (hemlock::form-region-at-mark mark)))
  • trunk/source/cocoa-ide/hemlock/src/lispmode.lisp

    r14211 r14732  
    778778  (with-mark ((m mark))
    779779    (when (%backward-form-at-mark m in-comment-p)
    780       (loop while (test-char (previous-character m) :lisp-syntax :prefix) do (mark-before m))
     780      (loop while (test-char (previous-character m) :lisp-syntax (or :prefix :prefix-dispatch)) do (mark-before m))
    781781      (move-mark mark m))))
    782782
     
    798798    (:prefix-dispatch
    799799     (mark-after mark)
    800      (if (test-char (next-character mark) :lisp-syntax :symbol-quote)
    801        (progn
    802          (mark-after mark)
    803          (%forward-nesting-comment-at-mark mark 1))
    804        (progn
    805          (mark-before mark)
    806          (%forward-symbol-at-mark mark in-comment-p))))
     800     (case (character-attribute :lisp-syntax (next-character mark))
     801       (:symbol-quote
     802        (mark-after mark)
     803        (%forward-nesting-comment-at-mark mark 1))
     804       (:prefix
     805        (mark-after mark)
     806        (%forward-form-at-mark mark in-comment-p))
     807       (t
     808        (mark-before mark)
     809        (%forward-symbol-at-mark mark in-comment-p))))
    807810    (:string-quote
    808811     (%forward-string-at-mark mark))
     
    933936
    934937
     938(defun %scan-to-form (m forwardp)
     939  (if forwardp
     940    ;; Stop at :prefix-dispatch if it is not followed by :prefix. If it's followed by :prefix,
     941    ;; assume it has the semantics of :prefix and skip it.
     942    (loop while (scan-direction-valid m t :lisp-syntax
     943                                      (or :open-paren :close-paren
     944                                          :char-quote :string-quote :symbol-quote
     945                                          :prefix-dispatch :constituent))
     946      do (unless (and (test-char (next-character m) :lisp-syntax :prefix-dispatch)
     947                      (mark-after m))
     948           (return t))
     949      do (unless (test-char (next-character m) :lisp-syntax :prefix)
     950           (mark-before m)
     951           (return t)))
     952    (scan-direction-valid m nil :lisp-syntax
     953                          (or :open-paren :close-paren
     954                              :char-quote :string-quote :symbol-quote
     955                              :prefix-dispatch :constituent))))
     956
    935957;; %FORM-OFFSET
    936958
     
    938960  `(if (valid-spot ,mark ,forwardp)
    939961     (with-mark ((m ,mark))
    940        (when (scan-direction-valid m ,forwardp :lisp-syntax
    941                                    (or :open-paren :close-paren
    942                                        :char-quote :string-quote :symbol-quote
    943                                        :prefix-dispatch :constituent))
     962       (when (%scan-to-form m ,forwardp)
    944963         (ecase (character-attribute :lisp-syntax (direction-char m ,forwardp))
    945964           (:open-paren
    946965            (when ,(if forwardp `(list-offset m 1) `(mark-before m))
    947966              ,(unless forwardp
    948                  '(scan-direction m nil :lisp-syntax (not :prefix)))
     967                 '(scan-direction m nil :lisp-syntax (not (or :prefix-dispatch :prefix))))
    949968              (move-mark ,mark m)
    950969              t))
     
    952971            (when ,(if forwardp `(mark-after m) `(list-offset m -1))
    953972              ,(unless forwardp
    954                  '(scan-direction m nil :lisp-syntax (not :prefix)))
     973                 '(scan-direction m nil :lisp-syntax (not (or :prefix-dispatch :prefix))))
    955974              (move-mark ,mark m)
    956975              t))
Note: See TracChangeset for help on using the changeset viewer.