[Openmcl-cvs-notifications] r14732 - in /trunk/source/cocoa-ide: cocoa-editor.lisp hemlock/src/lispmode.lisp
gz at clozure.com
gz at clozure.com
Mon Apr 25 13:10:16 CDT 2011
Author: gz
Date: Mon Apr 25 13:10:16 2011
New Revision: 14732
Log:
Handle navigating around # a bit better - dtrt for #' #_ #$ $/
Modified:
trunk/source/cocoa-ide/cocoa-editor.lisp
trunk/source/cocoa-ide/hemlock/src/lispmode.lisp
Modified: trunk/source/cocoa-ide/cocoa-editor.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-editor.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-editor.lisp Mon Apr 25 13:10:16 2011
@@ -1573,17 +1573,21 @@
=
;; Return nil to use the default Cocoa selection, which will be word for d=
ouble-click, line for triple.
(defun selection-for-click (mark paragraph-mode-p)
- (unless paragraph-mode-p
- ;; Select a word if near one
- (hi::with-mark ((fwd mark)
- (bwd mark))
- (or (hi::find-attribute fwd :word-delimiter)
- (hi::buffer-end fwd))
- (or (hi::reverse-find-attribute bwd :word-delimiter)
- (hi::buffer-start bwd))
- (unless (hi::mark=3D bwd fwd)
- (return-from selection-for-click (hi::region bwd fwd)))))
+ ;; Handle lisp mode specially, otherwise just go with default Cocoa beha=
vior
(when (string=3D (hi::buffer-major-mode (hi::mark-buffer mark)) "Lisp") =
;; gag
+ (unless paragraph-mode-p
+ ;; Select a word if near one
+ (hi:with-mark ((fwd mark)
+ (bwd mark))
+ (or (hi:find-attribute fwd :word-delimiter)
+ (hi:buffer-end fwd))
+ (or (hi:reverse-find-attribute bwd :word-delimiter)
+ (hi:buffer-start bwd))
+ (unless (hi:mark=3D bwd fwd)
+ (when (eq (hi:character-attribute :lisp-syntax (hi:previous-char=
acter bwd)) :prefix-dispatch)
+ ;; let :prefix-dispatch take on the attribute of the following=
char, which is a word constituent
+ (hi:mark-before bwd))
+ (return-from selection-for-click (hi::region bwd fwd)))))
(hemlock::pre-command-parse-check mark)
(hemlock::form-region-at-mark mark)))
=
Modified: trunk/source/cocoa-ide/hemlock/src/lispmode.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/hemlock/src/lispmode.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/lispmode.lisp Mon Apr 25 13:10:16 20=
11
@@ -768,7 +768,7 @@
;; If in-comment-p is true, tries not to go past a #|.
(with-mark ((m mark))
(when (%backward-form-at-mark m in-comment-p)
- (loop while (test-char (previous-character m) :lisp-syntax :prefix) =
do (mark-before m))
+ (loop while (test-char (previous-character m) :lisp-syntax (or :pref=
ix :prefix-dispatch)) do (mark-before m))
(move-mark mark m))))
=
(defun %forward-form-at-mark (mark in-comment-p)
@@ -788,13 +788,16 @@
(%forward-symbol-at-mark mark in-comment-p)))
(:prefix-dispatch
(mark-after mark)
- (if (test-char (next-character mark) :lisp-syntax :symbol-quote)
- (progn
- (mark-after mark)
- (%forward-nesting-comment-at-mark mark 1))
- (progn
- (mark-before mark)
- (%forward-symbol-at-mark mark in-comment-p))))
+ (case (character-attribute :lisp-syntax (next-character mark))
+ (:symbol-quote
+ (mark-after mark)
+ (%forward-nesting-comment-at-mark mark 1))
+ (:prefix
+ (mark-after mark)
+ (%forward-form-at-mark mark in-comment-p))
+ (t
+ (mark-before mark)
+ (%forward-symbol-at-mark mark in-comment-p))))
(:string-quote
(%forward-string-at-mark mark))
(:constituent
@@ -923,26 +926,42 @@
(return mark)))))))
=
=
+(defun %scan-to-form (m forwardp)
+ (if forwardp
+ ;; Stop at :prefix-dispatch if it is not followed by :prefix. If it's =
followed by :prefix,
+ ;; assume it has the semantics of :prefix and skip it.
+ (loop while (scan-direction-valid m t :lisp-syntax
+ (or :open-paren :close-paren
+ :char-quote :string-quote :symbo=
l-quote
+ :prefix-dispatch :constituent))
+ do (unless (and (test-char (next-character m) :lisp-syntax :prefix-d=
ispatch)
+ (mark-after m))
+ (return t))
+ do (unless (test-char (next-character m) :lisp-syntax :prefix)
+ (mark-before m)
+ (return t)))
+ (scan-direction-valid m nil :lisp-syntax
+ (or :open-paren :close-paren
+ :char-quote :string-quote :symbol-quote
+ :prefix-dispatch :constituent))))
+
;; %FORM-OFFSET
=
(defmacro %form-offset (mark forwardp)
`(if (valid-spot ,mark ,forwardp)
(with-mark ((m ,mark))
- (when (scan-direction-valid m ,forwardp :lisp-syntax
- (or :open-paren :close-paren
- :char-quote :string-quote :symbol-q=
uote
- :prefix-dispatch :constituent))
+ (when (%scan-to-form m ,forwardp)
(ecase (character-attribute :lisp-syntax (direction-char m ,forwa=
rdp))
(:open-paren
(when ,(if forwardp `(list-offset m 1) `(mark-before m))
,(unless forwardp
- '(scan-direction m nil :lisp-syntax (not :prefix)))
+ '(scan-direction m nil :lisp-syntax (not (or :prefix-disp=
atch :prefix))))
(move-mark ,mark m)
t))
(:close-paren
(when ,(if forwardp `(mark-after m) `(list-offset m -1))
,(unless forwardp
- '(scan-direction m nil :lisp-syntax (not :prefix)))
+ '(scan-direction m nil :lisp-syntax (not (or :prefix-disp=
atch :prefix))))
(move-mark ,mark m)
t))
((:constituent :char-quote :symbol-quote :prefix-dispatch)
More information about the Openmcl-cvs-notifications
mailing list