(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'.

1 files changed, 34 insertions, 20 deletions

diff --git a/lisp/comint.el b/lisp/comint.el
index 04dd848a539..dbd520ba569 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1495,29 +1495,43 @@ This variable is permanent-local.")
     (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