changeset 37921:682de754cdf0

(comint-carriage-motion): Renamed from `comint-cr-magic'. Operate on the buffer instead of the string (for use as a comint post-output filter, instead of as a pre-output filter). Handle backspaces too. Add to the `comint-output-filter-functions' hook instead of `comint-preoutput-filter-functions'.
author Gerd Moellmann <gerd@gnu.org>
date Mon, 28 May 2001 13:01:24 +0000
parents abf444fe5166
children fcd11c3e6341
files lisp/comint.el
diffstat 1 files changed, 34 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/comint.el	Mon May 28 12:21:59 2001 +0000
+++ b/lisp/comint.el	Mon May 28 13:01:24 2001 +0000
@@ -1495,29 +1495,43 @@
     (overlay-put comint-last-prompt-overlay 'evaporate t)
     (setq comint-last-prompt-overlay nil)))
 
-(defun comint-cr-magic (string)
+(defun comint-carriage-motion (string)
   "Handle carriage returns in comint output.
 Translate carraige return/linefeed sequences to linefeeds.
-Let single carriage returns delete to the beginning of the line."
+Let single carriage returns delete to the beginning of the line.
+Let backspaces delete the previous character.
+
+This function should be in the list `comint-output-filter-functions'."
   (save-match-data
-    ;; CR LF -> LF
-    (while (string-match "\r\n" string)
-      (setq string (replace-match "\n" nil t string)))
-    ;; Let a single CR act like a carriage return on a real terminal.
-    ;; Delete everything from the beginning of the line to the
-    ;; insertion point.
-    (when (string-match ".*\r" string)
-      (setq string (replace-match "" nil t string))
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (let ((inhibit-field-text-motion t)
-		(buffer-read-only nil))
-	    (goto-char (process-mark (get-buffer-process (current-buffer))))
-	    (delete-region (line-beginning-position) (point))))))
-    string))
-
-(add-hook 'comint-preoutput-filter-functions 'comint-cr-magic)
+    ;; We first check to see if STRING contains any magic characters, to
+    ;; avoid overhead in the common case where it does not
+    (when (string-match "[\r\b]" string)
+      (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
+	(save-excursion
+	  (save-restriction
+	    (widen)
+	    (let ((inhibit-field-text-motion t)
+		  (buffer-read-only nil))
+	      ;; CR LF -> LF
+	      ;; Note that this won't work properly when the CR and LF
+	      ;; are in different output chunks, but this is probably an
+	      ;; exceedingly rare case (because they are generally
+	      ;; written as a unit), and to delay interpretation of a
+	      ;; trailing CR in a chunk would result in odd interactive
+	      ;; behavior (and this case is probably far more common).
+	      (goto-char comint-last-output-start)
+	      (while (re-search-forward "\r$" pmark t)
+		(delete-char -1))
+	      ;; bare CR -> delete preceding line
+	      (goto-char comint-last-output-start)
+	      (while (search-forward "\r" pmark t)
+		(delete-region (point) (line-beginning-position)))
+	      ;; BS -> delete preceding character
+	      (goto-char comint-last-output-start)
+	      (while (search-forward "\b" pmark t)
+		(delete-char -2)))))))))
+
+(add-hook 'comint-output-filter-functions 'comint-carriage-motion)
     
 ;; The purpose of using this filter for comint processes
 ;; is to keep comint-last-input-end from moving forward