[Openmcl-cvs-notifications] r14480 - in /trunk/source/cocoa-ide/hemlock/src: buffer.lisp edit-defs.lisp

[gb at clozure.com]

Author: gb
Date: Fri Dec 10 21:52:40 2010
New Revision: 14480

Log:
Compensate for CRLF line-termination in meta-.
Fixes ticket:741, but note that there may be other problems
with (e.g.) variable-length character encodings.

Modified:
    trunk/source/cocoa-ide/hemlock/src/buffer.lisp
    trunk/source/cocoa-ide/hemlock/src/edit-defs.lisp

Modified: trunk/source/cocoa-ide/hemlock/src/buffer.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/buffer.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/buffer.lisp Fri Dec 10 21:52:40 2010
@@ -525,6 +525,14 @@
           (setq end middle)
           (setq start middle))))))
 =

+(defun buffer-lines-before-absolute-position (buffer position)
+  (do* ((prev (line-previous (buffer-line-at-absolute-position buffer posi=
tion))
+              (line-previous prev))
+        (n 0))
+       ((null prev) n)
+    (declare (fixnum n))
+    (incf n)))
+
 ;; Called whenever change a line's next or previous pointer.  Don't update=
 immediately
 ;; so don't thrash when inserting multiple lines.
 (declaim (inline invalidate-buffer-lines))

Modified: trunk/source/cocoa-ide/hemlock/src/edit-defs.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/edit-defs.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/edit-defs.lisp Fri Dec 10 21:52:40 2=
010
@@ -323,9 +323,20 @@
     (move-mark point target)
     point))
 =

+;;; Adjust for CRLF line termination.  Multibyte character encodings
+;;; can also cause discrepancies between physical/logical positions.
+;;; Handling that would require making the source location stuff
+;;; aware of that newfangled Unicode thing ...
+(defun byte-position-to-character-position (pos &optional (buffer (current=
-buffer)))
+  (let* ((line-termination (hi::buffer-line-termination buffer)))
+    (if (eq line-termination :crlf)
+      (- pos (hi::buffer-lines-before-absolute-position buffer pos))
+      pos)))
+
 (defun move-to-source-note (source)
   (let ((start-pos (ccl:source-note-start-pos source)))
     (when start-pos
+      (setq start-pos (byte-position-to-character-position start-pos))
       (let ((full-text (ccl:source-note-text source))
             (pattern nil)
             (offset 0))
@@ -345,6 +356,7 @@
                                               (ccl:source-note-start-pos t=
oplevel)))
                      (text (and toplevel-start-pos (ccl:source-note-text t=
oplevel))))
                 (when text
+                  (setq toplevel-start-pos (byte-position-to-character-pos=
ition toplevel-start-pos))
                   (setq offset (- start-pos toplevel-start-pos))
                   (setq start-pos toplevel-start-pos)
                   (setq full-text text)