Define process filter to strip carriage-returns from the output of a

process.  Change COMINT-EXEC to start a buffer's process -before- the
buffer's major mode is set, so that process filters can be defined in
the mode hooks.

diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index 89360bcd5ec4de75cfb5d6b1ad34311ba79c3d68..c1cbf7c242f01a4f7de440663fa0f1bc603c81d4 100644 (file)
--- a/v7/src/edwin/comint.scm
+++ b/v7/src/edwin/comint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: comint.scm,v 1.24 1997/06/14 01:22:05 cph Exp $
+$Id: comint.scm,v 1.25 1997/11/20 05:51:30 cph Exp $
 
 Copyright (c) 1991-97 Massachusetts Institute of Technology
 
@@ -51,8 +51,8 @@ license should have been included along with this file. |#
          (or (not process)
              (not (process-runnable? process))))
        (begin
-         (set-buffer-major-mode! buffer mode)
-         (comint-exec buffer (buffer-name buffer) program switches)))
+         (comint-exec buffer (buffer-name buffer) program switches)
+         (set-buffer-major-mode! buffer mode)))
     buffer))
 
 (define (comint-exec buffer name program switches)
@@ -96,6 +96,25 @@ This is a good thing to set in mode hooks."
 (define-variable comint-program-name
   "File name of program that is running in this buffer."
   false)
+
+(define (comint-strip-carriage-returns buffer)
+  (let ((process (get-buffer-process buffer)))
+    (if process
+       (add-process-filter process process-filter:strip-carriage-returns))))
+
+(define process-filter:strip-carriage-returns
+  (standard-process-filter
+   (lambda (mark string start end)
+     (let ((group (mark-group mark)))
+       (let loop ((start start))
+        (let ((cr
+               (or (substring-find-next-char string start end #\return)
+                   end))
+              (index (mark-index mark)))
+          (group-insert-substring! group index string start cr)
+          (set-mark-index! mark (fix:+ index (fix:- cr start)))
+          (if (not (fix:= cr end))
+              (loop (fix:+ cr 1)))))))))
 \f
 (define-major-mode comint fundamental "Comint"
   "Major mode for interacting with an inferior interpreter.

diff --git a/v7/src/edwin/telnet.scm b/v7/src/edwin/telnet.scm
index 83b06c4bb3d887199813d8250e4df424bd6b1627..d5dff80805548c8e54976a5b94abec5c7ea7a679 100644 (file)
--- a/v7/src/edwin/telnet.scm
+++ b/v7/src/edwin/telnet.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: telnet.scm,v 1.12 1997/11/20 05:27:45 cph Exp $
+$Id: telnet.scm,v 1.13 1997/11/20 05:51:14 cph Exp $
 
 Copyright (c) 1991-97 Massachusetts Institute of Technology
 
@@ -77,31 +77,29 @@ If port number is typed after hostname (separated by a space),
 use it instead of the default."
   "sTelnet to host\nP"
   (lambda (host new-process?)
-    (let ((buffer
-          (let ((mode (ref-mode-object telnet))
-                (buffer-name
-                  (let ((buffer-name (string-append "*" host "-telnet*")))
-                    (if (not new-process?)
-                        buffer-name
-                        (new-buffer buffer-name)))))
-            (if (re-string-match "\\([^ ]+\\) \\([^ ]+\\)" host)
-                (let ((host
-                       (substring host
-                                  (re-match-start-index 1)
-                                  (re-match-end-index 1)))
-                      (port
-                       (substring host
-                                  (re-match-start-index 2)
-                                  (re-match-end-index 2))))
-                  (if (not (exact-nonnegative-integer? (string->number port)))
-                      (editor-error "Port must be a positive integer: " port))
-                  (make-comint mode buffer-name "telnet" host port))
-                (make-comint mode buffer-name "telnet" host)))))
-      (let ((process (get-buffer-process buffer)))
-       (if process
-           (add-process-filter process
-                               (standard-process-filter telnet-filter))))
-      (select-buffer buffer))))
+    (select-buffer
+     (let ((mode (ref-mode-object telnet))
+          (buffer-name
+            (let ((buffer-name (string-append "*" host "-telnet*")))
+              (if (not new-process?)
+                  buffer-name
+                  (new-buffer buffer-name)))))
+       (if (re-string-match "\\([^ ]+\\) \\([^ ]+\\)" host)
+          (let ((host
+                 (substring host
+                            (re-match-start-index 1)
+                            (re-match-end-index 1)))
+                (port
+                 (substring host
+                            (re-match-start-index 2)
+                            (re-match-end-index 2))))
+            (if (not (exact-nonnegative-integer? (string->number port)))
+                (editor-error "Port must be a positive integer: " port))
+            (make-comint mode buffer-name "telnet" host port))
+          (make-comint mode buffer-name "telnet" host))))))
+
+(add-event-receiver! (ref-variable telnet-mode-hook)
+                    comint-strip-carriage-returns)
 
 (define-command telnet-send-input
   "Send input to telnet process.
@@ -126,70 +124,4 @@ With prefix arg, the character is repeated that many times."
       (cond ((= argument 1)
             (process-send-char process char))
            ((> argument 1)
-            (process-send-string process (make-string argument char)))))))
-\f
-(define (telnet-filter mark string start end)
-  (let ((index (mark-index mark))
-       (new-string (telnet-filter-substring string start end)))
-    (let ((new-length (string-length new-string)))
-      (group-insert-substring! (mark-group mark) index new-string 0 new-length)
-      (set-mark-index! mark (+ index new-length)))))
-
-(define (telnet-filter-substring string start end)
-  (substring-substitute string start end
-                       (ref-variable telnet-replacee)
-                       (ref-variable telnet-replacement)))
-
-(define-variable telnet-replacee
-  "String to replace in telnet output."
-  (string #\return))
-
-(define-variable telnet-replacement
-  "String to use as replacement in telnet output."
-  "")
-
-(define (substring-substitute string start end source target)
-  (let ((length (fix:- end start))
-       (slength (string-length source))
-       (tlength (string-length target)))
-    (let ((alloc-length
-          (fix:+ length
-                 (fix:* (fix:quotient length slength)
-                        tlength)))
-         (char (string-ref source 0)))
-      (let ((result (string-allocate alloc-length)))
-
-       (define (loop copy-index read-index write-index)
-         (if (fix:>= read-index end)
-             (done copy-index write-index)
-             (let ((index
-                    (substring-find-next-char string read-index end char)))
-               (cond ((not index)
-                      (done copy-index write-index))
-                     ((or (fix:= slength 1)
-                          (substring-prefix? source 0 slength
-                                             string index end))
-                      (substring-move-right! string copy-index index
-                                             result write-index)
-                      (let ((next-write
-                             (fix:+ write-index (fix:- index copy-index)))
-                            (next-read (fix:+ index slength)))
-                        (if (not (fix:= tlength 0))
-                            (substring-move-right! target 0 tlength
-                                                   result next-write))
-                        (loop next-read
-                              next-read
-                              (fix:+ next-write tlength))))
-                     (else
-                      (loop copy-index (fix:+ index 1) write-index))))))
-
-       (define (done copy-index write-index)
-         (if (fix:< copy-index end)
-             (substring-move-right! string copy-index end
-                                    result write-index))
-         (set-string-length! result
-                             (fix:+ write-index
-                                    (fix:- end copy-index)))
-         result)
-
-       (loop start start 0)))))
\ No newline at end of file
+            (process-send-string process (make-string argument char)))))))
\ No newline at end of file