Changeset 800

Timestamp:

Apr 30, 2004, 7:30:04 PM (21 years ago)

Author:

Gary Byers

Message:

Remove old selection-updating code (was unused.)

File:

• trunk/ccl/hemlock/src/htext2.lisp (modified) (10 diffs)

trunk/ccl/hemlock/src/htext2.lisp

@@ -19 +19 @@
 (in-package :hemlock-internals)
 
-(defun maybe-update-selection (mark)
-  mark
-  #+nil
-  (let* ((line (mark-line mark))
-         (buffer (if line (line-%buffer line)))
-         (document (if buffer (buffer-document buffer))))
-    (if (and buffer
-             (eq mark (buffer-point buffer))
-             document)
-      (document-set-point-position document))
-    mark))
+
     
          
@@ -238 +228 @@
     (change-line mark line))
   (setf (mark-charpos mark) 0)
-  (maybe-update-selection mark))
+  mark)
 
 (defun line-end (mark &optional line)
@@ -247 +237 @@
       (setq line (mark-line mark)))
   (setf (mark-charpos mark) (line-length* line))
-  (maybe-update-selection mark))
+  mark)
 
 (defun buffer-start (mark &optional (buffer (line-buffer (mark-line mark))))
@@ -266 +256 @@
     (change-line mark line))
   (setf (mark-charpos mark) (mark-charpos new-position))
-  (maybe-update-selection mark))
+  mark)
 
 
@@ -279 +269 @@
                (always-change-line mark prev)
                (setf (mark-charpos mark) (line-length* prev))
-               (maybe-update-selection mark))))
+               mark)))
           (t
            (setf (mark-charpos mark) (1- charpos))
-           (maybe-update-selection mark)))))
+           mark))))
 
 (defun mark-after (mark)
@@ -294 +284 @@
                (always-change-line mark next)
                (setf (mark-charpos mark) 0)
-               (maybe-update-selection mark))))
+               mark)))
           (t
            (setf (mark-charpos mark) (1+ charpos))
-           (maybe-update-selection mark)))))
+           mark))))
 
 
@@ -304 +294 @@
   where it currently points.  If there aren't N characters before (or after)
   the mark, Nil is returned."
-  (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))))
+  (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))))))
 
 
@@ -343 +331 @@
   it currently points.  If there aren't N lines after (or before) the Mark,
   Nil is returned."
-  (let* ((result
-          (if (< n 0)
+    (if (< n 0)
             (do ((line (mark-line mark) (line-previous line))
                  (n n (1+ n)))
@@ -364 +351 @@
                         (min (line-length line) charpos)
                         (min (line-length line) (mark-charpos mark))))
-                (return mark))))))
-    (when result (maybe-update-selection result))))
+                (return mark)))))
 
 ;;; region-bounds  --  Public
@@ -518 +504 @@
   (write-string (buffer-name structure) stream)
   (write-string "\">" stream))
+
+(defun check-buffer-modification (buffer mark)
+  (when (typep buffer 'buffer)
+    (let* ((protected-region (buffer-protected-region buffer)))
+      (when protected-region
+        (let* ((prot-start (region-start protected-region))
+               (prot-end (region-end protected-region)))
+          
+          (when (and (mark>= mark prot-start)
+                     (mark< mark prot-end))
+            (editor-error "Can't modify protected buffer region.")))))))