Changeset 554

Timestamp:

Feb 21, 2004, 5:19:58 PM (21 years ago)

Author:

Gary Byers

Message:

Maybe update the selection if the mark we move is the buffer's point.

Location:

trunk/ccl/hemlock/src

Files:

• htext1.lisp (modified) (1 diff)
• htext2.lisp (modified) (3 diffs)

trunk/ccl/hemlock/src/htext1.lisp

@@ -126 +126 @@
                   (len (length chars)))
              (declare (simple-string chars))
-             (when (> *line-cache-length* len)
+             (when (> len *line-cache-length*)
                (setf *line-cache-length* (* len 2))
                (setf *open-chars* (make-string *line-cache-length*)))

trunk/ccl/hemlock/src/htext2.lisp

@@ -19 +19 @@
 (in-package :hemlock-internals)
 
+(defun maybe-update-selection (mark)
+  (let* ((line (mark-line mark))
+         (buffer (if line (line-%buffer line)))
+         (textstorage (if buffer (buffer-text-storage buffer))))
+    (if (and buffer
+             (eq mark (buffer-point buffer))
+             textstorage)
+      (textstorage-set-point-position textstorage))
+    mark))
+    
+         
 
 
@@ -248 +259 @@
 (defun move-mark (mark new-position)
   "Changes the Mark to point to the same position as New-Position."
-  (let ((line (mark-line new-position)))
+  (let* ((line (mark-line new-position)))
     (change-line mark line))
   (setf (mark-charpos mark) (mark-charpos new-position))
-  mark)
+  (maybe-update-selection mark))
+
 
 
@@ -288 +300 @@
   where it currently points.  If there aren't N characters before (or after)
   the mark, Nil is returned."
-  (let ((charpos (mark-charpos mark)))
-    (if (< n 0)
-        (let ((n (- n)))
-          (if (< charpos n)
-              (do ((line (line-previous (mark-line mark)) (line-previous line))
-                   (n (- n charpos 1)))
-                  ((null line) nil)
-                (let ((length (line-length* line)))
-                  (cond ((<= n length)
-                         (always-change-line mark line)
-                         (setf (mark-charpos mark) (- length n))
-                         (return mark))
-                        (t
-                         (setq n (- n (1+ length)))))))
-              (progn (setf (mark-charpos mark) (- charpos n))
-                     mark)))
-        (let* ((line (mark-line mark))
-               (length (line-length* line)))
-          (if (> (+ charpos n) length)
-              (do ((line (line-next line) (line-next line))
-                   (n (- n (1+ (- length charpos)))))
-                  ((null line) nil)
-                (let ((length (line-length* line)))
-                  (cond ((<= n length)
-                         (always-change-line mark line)
-                         (setf (mark-charpos mark) n)
-                         (return mark))
-                        (t
-                         (setq n (- n (1+ length)))))))
-              (progn (setf (mark-charpos mark) (+ charpos n))
-                     mark))))))
+  (let* ((charpos (mark-charpos mark))
+         (result-mark
+          (if (< n 0)
+            (let ((n (- n)))
+              (if (< charpos n)
+                (do ((line (line-previous (mark-line mark)) (line-previous line))
+                     (n (- n charpos 1)))
+                    ((null line) nil)
+                  (let ((length (line-length* line)))
+                    (cond ((<= n length)
+                           (always-change-line mark line)
+                           (setf (mark-charpos mark) (- length n))
+                           (return mark))
+                          (t
+                           (setq n (- n (1+ length)))))))
+                (progn (setf (mark-charpos mark) (- charpos n))
+                       mark)))
+            (let* ((line (mark-line mark))
+                   (length (line-length* line)))
+              (if (> (+ charpos n) length)
+                (do ((line (line-next line) (line-next line))
+                     (n (- n (1+ (- length charpos)))))
+                    ((null line) nil)
+                  (let ((length (line-length* line)))
+                    (cond ((<= n length)
+                           (always-change-line mark line)
+                           (setf (mark-charpos mark) n)
+                           (return mark))
+                          (t
+                           (setq n (- n (1+ length)))))))
+                (progn (setf (mark-charpos mark) (+ charpos n))
+                       mark))))))
+    (if result-mark (maybe-update-selection result-mark))))