Change interface to process-filter.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index bbe4395a54af0b3b2ae44ab53e4e1e6a27db3fc5..0e5d8a51a7ae0a1708187fff556138194af171c0 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.214 1997/11/04 11:04:52 cph Exp $
+$Id: edwin.pkg,v 1.215 1997/11/20 05:27:37 cph Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -904,6 +904,7 @@ MIT in each case. |#
   (parent (edwin))
   (export (edwin)
          accept-process-output
+         add-process-filter
          buffer-default-directory
          buffer-processes                      ; always present
          continue-process
@@ -943,15 +944,18 @@ MIT in each case. |#
          process-status-changes?               ; always present
          process-status-message
          quit-process
+         remove-process-filter
+         run-synchronous-process
          set-process-buffer!
          set-process-filter!
          set-process-kill-without-query!
          set-process-sentinel!
          shell-command
+         standard-process-filter
          start-process
          stop-process
          subprocesses-available?               ; always present
-         run-synchronous-process))
+         ))
 \f
 (os-type-case
  ((dos)

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index a1d229ef7222df972d470f39eed6db9e2a912cf8..4e4049e0173a0c0d8de77f842a75d26e4fc5ddd5 100644 (file)
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: process.scm,v 1.52 1997/11/19 23:40:59 cph Exp $
+;;;    $Id: process.scm,v 1.53 1997/11/20 05:27:30 cph Exp $
 ;;;
 ;;;    Copyright (c) 1991-97 Massachusetts Institute of Technology
 ;;;
@@ -399,7 +399,7 @@ Initialized from the SHELL environment variable."
           (message-with-reason "exited abnormally" "with code")))
       ((SIGNAL) (message-with-reason "terminated by signal" false))
       (else (error "illegal process status" status)))))
-
+\f
 (define (output-substring process string length)
   (cond ((process-filter process)
         =>
@@ -413,6 +413,57 @@ Initialized from the SHELL environment variable."
             (set-mark-index! mark (+ index length)))
           true))
        (else false)))
+
+(define (add-process-filter process filter)
+  (let ((filter* (process-filter process)))
+    (if (filter-dispatcher? filter*)
+       (add-filter-to-dispatcher filter* filter)
+       (set-process-filter! process
+                            (make-filter-dispatcher (if filter*
+                                                        (list filter* filter)
+                                                        (list filter)))))))
+
+(define (remove-process-filter process filter)
+  (set-process-filter!
+   process
+   (let ((filter* (process-filter process)))
+     (cond ((eq? filter filter*) #f)
+          ((filter-dispatcher? filter*)
+           (remove-filter-from-dispatcher filter* filter))
+          (else filter*)))))
+
+(define (make-filter-dispatcher filters)
+  (make-entity filter-dispatcher-procedure filters))
+
+(define (filter-dispatcher? object)
+  (and (entity? object)
+       (eq? filter-dispatcher-procedure (entity-procedure object))))
+
+(define (filter-dispatcher-procedure dispatcher process string start end)
+  (let loop ((filters (entity-extra dispatcher)))
+    (and (not (null? filters))
+        (or ((car filters) process string start end)
+            (loop (cdr filters))))))
+
+(define (add-filter-to-dispatcher dispatcher filter)
+  (let ((filters (entity-extra dispatcher)))
+    (if (pair? filters)
+       (set-cdr! (last-pair filters) (list filter))
+       (set-entity-extra! dispatcher (list filter)))))
+
+(define (remove-filter-from-dispatcher dispatcher filter)
+  (let ((filters (delq! filter (entity-extra dispatcher))))
+    (set-entity-extra! dispatcher filters)
+    (and (not (null? filters))
+        dispatcher)))
+
+(define (standard-process-filter filter)
+  (lambda (process string start end)
+    (let ((mark (process-mark process)))
+      (and mark
+          (begin
+            (filter mark string start end)
+            #t)))))
 \f
 ;;;; Signals
 

diff --git a/v7/src/edwin/telnet.scm b/v7/src/edwin/telnet.scm
index 302deb76edd0bc82f447ee16236f0db6d369dbc1..83b06c4bb3d887199813d8250e4df424bd6b1627 100644 (file)
--- a/v7/src/edwin/telnet.scm
+++ b/v7/src/edwin/telnet.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: telnet.scm,v 1.11 1997/11/19 23:40:53 cph Exp $
+$Id: telnet.scm,v 1.12 1997/11/20 05:27:45 cph Exp $
 
 Copyright (c) 1991-97 Massachusetts Institute of Technology
 
@@ -99,8 +99,8 @@ use it instead of the default."
                 (make-comint mode buffer-name "telnet" host)))))
       (let ((process (get-buffer-process buffer)))
        (if process
-           (set-process-filter! process
-                                (make-telnet-filter process))))
+           (add-process-filter process
+                               (standard-process-filter telnet-filter))))
       (select-buffer buffer))))
 
 (define-command telnet-send-input
@@ -128,16 +128,12 @@ With prefix arg, the character is repeated that many times."
            ((> argument 1)
             (process-send-string process (make-string argument char)))))))
 \f
-(define (telnet-filter process string start end)
-  (let ((mark (process-mark process)))
-    (and mark
-        (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))
-            #t)))))
+(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