Changeset 14732

Timestamp:

Apr 25, 2011, 11:10:16 AM (14 years ago)

Author:

gz

Message:

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

Location:

trunk/source/cocoa-ide

Files:

• cocoa-editor.lisp (modified) (1 diff)
• hemlock/src/lispmode.lisp (modified) (5 diffs)

trunk/source/cocoa-ide/cocoa-editor.lisp

@@ -1579 +1579 @@
 ;; Return nil to use the default Cocoa selection, which will be word for double-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= bwd fwd)
-        (return-from selection-for-click (hi::region bwd fwd)))))
+  ;; Handle lisp mode specially, otherwise just go with default Cocoa behavior
   (when (string= (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= bwd fwd)
+          (when (eq (hi:character-attribute :lisp-syntax (hi:previous-character 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)))

trunk/source/cocoa-ide/hemlock/src/lispmode.lisp

@@ -778 +778 @@
   (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 :prefix :prefix-dispatch)) do (mark-before m))
       (move-mark mark m))))
 
@@ -798 +798 @@
     (: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))
@@ -933 +936 @@
 
 
+(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 :symbol-quote
+                                          :prefix-dispatch :constituent))
+      do (unless (and (test-char (next-character m) :lisp-syntax :prefix-dispatch)
+                      (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
 
@@ -938 +960 @@
   `(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-quote
-                                       :prefix-dispatch :constituent))
+       (when (%scan-to-form m ,forwardp)
          (ecase (character-attribute :lisp-syntax (direction-char m ,forwardp))
            (: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-dispatch :prefix))))
               (move-mark ,mark m)
               t))
@@ -952 +971 @@
             (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-dispatch :prefix))))
               (move-mark ,mark m)
               t))