Changeset 6603

Timestamp:

May 25, 2007, 4:57:08 AM (18 years ago)

Author:

Gary Byers

Message:

INSERT-STRING: don't take start/end args; if embedded newlines, cons
up a region and do NINSERT-REGION.

Insertions try to adjust line-origins of subsequent lines.

File:

• branches/ide-1.0/ccl/hemlock/src/htext3.lisp (modified) (6 diffs)

branches/ide-1.0/ccl/hemlock/src/htext3.lisp

@@ -76 +76 @@
                                       character)
                                 (incf *left-open-pos*)))))
+                      (adjust-line-origins-forward line)
                       (buffer-note-insertion buffer mark 1))))
 
 
 
-(defun insert-string (mark string &optional (start 0) (end (length string)))
+(defun insert-string (mark string #| &optional (start 0) (end (length string))|#)
   "Inserts the String at the Mark.  Do not use Start and End unless you
   know what you're doing!"
   (let* ((line (mark-line mark))
+         (len (length string))
          (buffer (line-%buffer line))
          (string (coerce string 'simple-string))
@@ -91 +93 @@
     (when region
       (delete-region region))
-    (unless (zerop (- end start))
-      (if (%sp-find-character string start end #\newline)
-        (with-mark ((mark mark :left-inserting))
-           (do ((left-index start (1+ right-index))
-                (right-index
-                 (%sp-find-character string start end #\newline)
-                 (%sp-find-character string (1+ right-index) end #\newline)))
-               ((null right-index)
-                (if (/= left-index end)
-                  (insert-string mark string left-index end)))
-             (insert-string mark string left-index right-index)
-             (insert-character mark #\newline)))
-        (modifying-buffer
-         buffer
-         (modifying-line line mark)
-         (let ((length (- end start)))
-           (if (<= *right-open-pos* (+ *left-open-pos* end))
-             (grow-open-chars (* (+ *line-cache-length* end) 2)))
-              
-           (maybe-move-some-marks (charpos line) *left-open-pos*
-                                  (+ charpos length))
-           (cond
-             ((eq (mark-%kind mark) :right-inserting)
-              (let ((new (- *right-open-pos* length)))
-                (%sp-byte-blt string start *open-chars* new *right-open-pos*)
-                (setq *right-open-pos* new)))
-             (t
-              (let ((new (+ *left-open-pos* length)))
-                (%sp-byte-blt string start *open-chars* *left-open-pos* new)
-                (setq *left-open-pos* new)))))
-         (buffer-note-insertion buffer mark (- end start)))))))
+    (unless (zerop len)
+      (if (%sp-find-character string 0 len #\newline)
+        (ninsert-region mark (string-to-region string))
+        (modifying-buffer
+         buffer
+         (progn
+           (modifying-line line mark)
+           (if (<= *right-open-pos* (+ *left-open-pos* len))
+             (grow-open-chars (* (+ *line-cache-length* len) 2)))
+           (maybe-move-some-marks (charpos line) *left-open-pos*
+                                  (+ charpos len))
+           (cond
+             ((eq (mark-%kind mark) :right-inserting)
+              (let ((new (- *right-open-pos* len)))
+                (%sp-byte-blt string 0 *open-chars* new *right-open-pos*)
+                (setq *right-open-pos* new)))
+             (t
+              (let ((new (+ *left-open-pos* len)))
+                (%sp-byte-blt string 0 *open-chars* *left-open-pos* new)
+                (setq *left-open-pos* new)))))
+         (adjust-line-origins-forward line)
+         (buffer-note-insertion buffer mark (length string)))))))
+                        
+  
 
 
@@ -141 +136 @@
       ;; simple case -- just BLT the characters in with insert-string
       (if (eq first-line *open-line*) (close-line))
-      (insert-string mark (line-chars first-line) first-charpos last-charpos))
+      (let* ((string (line-chars first-line)))
+        (unless (and (eql first-charpos 0)
+                     (eql last-charpos (length string)))
+          (setq string (subseq string first-charpos last-charpos)))
+        (insert-string mark string)))
      (t
       (close-line)
@@ -193 +192 @@
                     (+ last-charpos (- this-charpos charpos)))))
             (setf (line-next previous) new-line  previous new-line))
+          (adjust-line-origins-forward line)
           (buffer-note-insertion buffer  mark nins)))))))
 
@@ -210 +210 @@
       ;; Simple case -- just BLT the characters in with insert-string.
       (if (eq first-line *open-line*) (close-line))
-      (insert-string mark (line-chars first-line) first-charpos last-charpos))
+      (let* ((string (line-chars first-line)))
+        (unless (and (eq first-charpos 0)
+                     (eql last-charpos (length string)))
+          (setq string (subseq string first-charpos last-charpos)))
+        (insert-string mark string)))
      (t
       (when (bufferp (line-%buffer first-line))
@@ -265 +269 @@
           (maybe-move-some-marks (this-charpos line last-line) charpos
             (+ last-charpos (- this-charpos charpos)))
+          (adjust-line-origins-forward line)
           (buffer-note-insertion buffer mark nins)))))))