Changeset 6598

Timestamp:

May 25, 2007, 4:49:40 AM (18 years ago)

Author:

Gary Byers

Message:

Need to tell text system when echo buffer is being modified. (May have
missed some cases.)

File:

• branches/ide-1.0/ccl/hemlock/src/echo.lisp (modified) (3 diffs)

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

@@ -41 +41 @@
   "Function that verifies what's being parsed.")
 
+(defmacro modifying-echo-buffer (&body body)
+  `(unwind-protect
+    (progn
+      (buffer-document-begin-editing *echo-area-buffer*)
+      ,@body)
+    (buffer-document-end-editing *echo-area-buffer*)))
 ;;; %Not-Inside-A-Parse  --  Internal
 ;;;
@@ -113 +119 @@
          (progn
            (setf (current-buffer) *echo-area-buffer*)
-           (delete-region *echo-area-region*)
+           (modifying-echo-buffer
+            (delete-region *echo-area-region*))
            (setf (buffer-modified *echo-area-buffer*) nil))
       (setf (current-buffer) b))))
@@ -128 +135 @@
   control string and format arguments, respectively."
   (maybe-wait)
-  (cond ((eq *current-window* *echo-area-window*)
-         (let ((point (buffer-point *echo-area-buffer*)))
-           (with-mark ((m point :left-inserting))
-             (line-start m)
-             (with-output-to-mark (s m :full)
-               (apply #'format s string args)
-               (fresh-line s)))))
-        (t
-         (let ((mark (region-end *echo-area-region*)))
-           (cond ((buffer-modified *echo-area-buffer*)
-                  (clear-echo-area))
-                 ((not (zerop (mark-charpos mark)))
-                  (insert-character mark #\newline)
-                  (clear-echo-area)))
-           (apply #'format *echo-area-stream* string args)
-           (setf (buffer-modified *echo-area-buffer*) nil))))
-  (force-output *echo-area-stream*)
-  (setq *last-message-time* (get-internal-real-time))
+  (modifying-echo-buffer
+   (cond ((eq *current-window* *echo-area-window*)
+          (let ((point (buffer-point *echo-area-buffer*)))
+            (with-mark ((m point :left-inserting))
+              (line-start m)
+              (with-output-to-mark (s m :full)
+                (apply #'format s string args)
+                (fresh-line s)))))
+         (t
+          (let ((mark (region-end *echo-area-region*)))
+            (cond ((buffer-modified *echo-area-buffer*)
+                   (clear-echo-area))
+                  ((not (zerop (mark-charpos mark)))
+                   (insert-character mark #\newline)
+                   (clear-echo-area)))
+            (apply #'format *echo-area-stream* string args)
+            (setf (buffer-modified *echo-area-buffer*) nil))))
+   (force-output *echo-area-stream*)
+   (setq *last-message-time* (get-internal-real-time)))
   nil)