From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Oct 1991 00:03:22 +0000 (+0000)
Subject: Include the integrable definitions from a few basic files throughout
X-Git-Tag: 20090517-FFI~10128
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aa14c2bc2d1529c2fd531b2652dda278131989e8;p=mit-scheme.git

Include the integrable definitions from a few basic files throughout
the editor, to reduce space and increase speed.
---

diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index d6416a61c..9be480eb8 100644
--- a/v7/src/edwin/comint.scm
+++ b/v7/src/edwin/comint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.9 1991/09/19 22:12:17 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.10 1991/10/25 00:02:54 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -42,11 +42,11 @@ license should have been included along with this file. |#
 
 (declare (usual-integrations))
 
-(define (make-comint mode name program . switches)
+(define (make-comint mode buffer program . switches)
   (let ((buffer
-	 (if (pair? name)
-	     (new-buffer (string-append "*" (car name) "*"))
-	     (find-or-create-buffer (string-append "*" name "*")))))
+	 (if (buffer? buffer)
+	     buffer
+	     (find-or-create-buffer buffer))))
     (if (let ((process (get-buffer-process buffer)))
 	  (or (not process)
 	      (not (process-runnable? process))))
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index a0997e2a8..74ad98c9e 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.92 1991/04/21 00:30:35 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.93 1991/10/25 00:02:59 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -48,16 +48,16 @@
 
 ;;;; Screens
 
-(define-integrable (screen-list)
+(define (screen-list)
   (editor-screens current-editor))
 
-(define-integrable (selected-screen)
+(define (selected-screen)
   (editor-selected-screen current-editor))
 
-(define-integrable (selected-screen? screen)
+(define (selected-screen? screen)
   (eq? screen (selected-screen)))
 
-(define-integrable (multiple-screens?)
+(define (multiple-screens?)
   (display-type/multiple-screens? (current-display-type)))
 
 (define (make-screen buffer . make-screen-args)
@@ -118,7 +118,7 @@
 (define (update-selected-screen! display-style)
   (update-screen! (selected-screen) display-style))
 
-(define-integrable (screen0)
+(define (screen0)
   (car (screen-list)))
 
 (define (screen1+ screen)
@@ -162,16 +162,16 @@
 
 ;;;; Windows
 
-(define-integrable (current-window)
+(define (current-window)
   (screen-selected-window (selected-screen)))
 
 (define (window-list)
   (append-map screen-window-list (screen-list)))
 
-(define-integrable (current-window? window)
+(define (current-window? window)
   (eq? window (current-window)))
 
-(define-integrable (window0)
+(define (window0)
   (screen-window0 (selected-screen)))
 
 (define (select-window window)
@@ -186,7 +186,7 @@
 	     (screen-select-window! screen window)
 	     (select-screen screen)))))))
 
-(define-integrable (select-cursor window)
+(define (select-cursor window)
   (screen-select-cursor! (window-screen window) window))
 
 (define (window-visible? window)
@@ -226,13 +226,13 @@
 	  (else
 	   window))))
 
-(define-integrable (typein-window)
+(define (typein-window)
   (screen-typein-window (selected-screen)))
 
-(define-integrable (typein-window? window)
+(define (typein-window? window)
   (eq? window (screen-typein-window (window-screen window))))
 
-(define-integrable (current-message)
+(define (current-message)
   (window-override-message (typein-window)))
 
 (define (set-current-message! message)
@@ -251,22 +251,22 @@
 
 ;;;; Buffers
 
-(define-integrable (buffer-list)
+(define (buffer-list)
   (bufferset-buffer-list (current-bufferset)))
 
-(define-integrable (buffer-alive? buffer)
+(define (buffer-alive? buffer)
   (memq buffer (buffer-list)))
 
-(define-integrable (buffer-names)
+(define (buffer-names)
   (bufferset-names (current-bufferset)))
 
-(define-integrable (current-buffer? buffer)
+(define (current-buffer? buffer)
   (eq? buffer (current-buffer)))
 
-(define-integrable (current-buffer)
+(define (current-buffer)
   (window-buffer (current-window)))
 
-(define-integrable (previous-buffer)
+(define (previous-buffer)
   (other-buffer (current-buffer)))
 
 (define (other-buffer buffer)
@@ -281,19 +281,19 @@
 	  (else
 	   (car buffers)))))
 
-(define-integrable (bury-buffer buffer)
+(define (bury-buffer buffer)
   (bufferset-bury-buffer! (current-bufferset) buffer))
 
-(define-integrable (find-buffer name)
+(define (find-buffer name)
   (bufferset-find-buffer (current-bufferset) name))
 
-(define-integrable (create-buffer name)
+(define (create-buffer name)
   (bufferset-create-buffer (current-bufferset) name))
 
-(define-integrable (find-or-create-buffer name)
+(define (find-or-create-buffer name)
   (bufferset-find-or-create-buffer (current-bufferset) name))
 
-(define-integrable (rename-buffer buffer new-name)
+(define (rename-buffer buffer new-name)
   (bufferset-rename-buffer (current-bufferset) buffer new-name))
 
 (define (kill-buffer buffer)
@@ -313,13 +313,13 @@
 	    (buffer-processes buffer))
   (bufferset-kill-buffer! (current-bufferset) buffer))
 
-(define-integrable (select-buffer buffer)
+(define (select-buffer buffer)
   (set-window-buffer! (current-window) buffer true))
 
-(define-integrable (select-buffer-no-record buffer)
+(define (select-buffer-no-record buffer)
   (set-window-buffer! (current-window) buffer false))
 
-(define-integrable (select-buffer-in-window buffer window)
+(define (select-buffer-in-window buffer window)
   (set-window-buffer! window buffer true))
 
 (define (set-window-buffer! window buffer record?)
@@ -370,10 +370,10 @@ The buffer is guaranteed to be selected at that time."
 
 ;;;; Point
 
-(define-integrable (current-point)
+(define (current-point)
   (window-point (current-window)))
 
-(define-integrable (set-current-point! mark)
+(define (set-current-point! mark)
   (set-window-point! (current-window) mark))
 
 (define (set-buffer-point! buffer mark)
@@ -400,12 +400,12 @@ The buffer is guaranteed to be selected at that time."
 		    (set! old-point)
 		    unspecific))))
 
-(define-integrable (current-column)
+(define (current-column)
   (mark-column (current-point)))
 
 ;;;; Mark and Region
 
-(define-integrable (current-mark)
+(define (current-mark)
   (buffer-mark (current-buffer)))
 
 (define (buffer-mark buffer)
@@ -417,7 +417,7 @@ The buffer is guaranteed to be selected at that time."
 (define (set-current-mark! mark)
   (set-buffer-mark! (current-buffer) (guarantee-mark mark)))
 
-(define-integrable (set-buffer-mark! buffer mark)
+(define (set-buffer-mark! buffer mark)
   (ring-set! (buffer-mark-ring buffer) 0 (mark-right-inserting-copy mark)))
 
 (define-variable auto-push-point-notification
@@ -434,16 +434,16 @@ If false, don't display any message."
 	     (not (typein-window? (current-window))))
 	(temporary-message notification))))
 
-(define-integrable (push-buffer-mark! buffer mark)
+(define (push-buffer-mark! buffer mark)
   (ring-push! (buffer-mark-ring buffer) (mark-right-inserting-copy mark)))
 
-(define-integrable (pop-current-mark!)
+(define (pop-current-mark!)
   (pop-buffer-mark! (current-buffer)))
 
-(define-integrable (pop-buffer-mark! buffer)
+(define (pop-buffer-mark! buffer)
   (ring-pop! (buffer-mark-ring buffer)))
 
-(define-integrable (current-region)
+(define (current-region)
   (make-region (current-point) (current-mark)))
 
 (define (set-current-region! region)
@@ -456,23 +456,23 @@ If false, don't display any message."
 
 ;;;; Modes and Comtabs
 
-(define-integrable (current-major-mode)
+(define (current-major-mode)
   (buffer-major-mode (current-buffer)))
 
-(define-integrable (current-minor-modes)
+(define (current-minor-modes)
   (buffer-minor-modes (current-buffer)))
 
-(define-integrable (current-comtabs)
+(define (current-comtabs)
   (buffer-comtabs (current-buffer)))
 
-(define-integrable (set-current-major-mode! mode)
+(define (set-current-major-mode! mode)
   (set-buffer-major-mode! (current-buffer) mode))
 
-(define-integrable (current-minor-mode? mode)
+(define (current-minor-mode? mode)
   (buffer-minor-mode? (current-buffer) mode))
 
-(define-integrable (enable-current-minor-mode! mode)
+(define (enable-current-minor-mode! mode)
   (enable-buffer-minor-mode! (current-buffer) mode))
 
-(define-integrable (disable-current-minor-mode! mode)
+(define (disable-current-minor-mode! mode)
   (disable-buffer-minor-mode! (current-buffer) mode))
\ No newline at end of file
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 48230120e..3489ebc7a 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.26 1991/09/20 20:47:15 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.27 1991/10/25 00:03:03 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -78,12 +78,11 @@ MIT in each case. |#
        (sf-edwin (sf-dependent 'edwin-syntax-table))
        (sf-class (sf-dependent 'class-syntax-table)))
   (for-each sf-global
-	    '("bufinp"
-	      "bufout"
-	      "class"
+	    '("class"
 	      "clscon"
 	      "clsmac"
 	      "display"
+	      "key"
 	      "macros"
 	      "make"
 	      "nvector"
@@ -91,102 +90,105 @@ MIT in each case. |#
 	      "rename"
 	      "rgxcmp"
 	      "ring"
-	      "simple"
 	      "strpad"
 	      "strtab"
 	      "termcap"
 	      "utils"
-	      "winout"
 	      "winren"
 	      "xform"
-	      "key"
 	      "xterm"))
-  (for-each sf-edwin
-	    '("argred"
-	      "autold"
-	      "autosv"
-	      "basic"
-	      "bufcom"
-	      "bufmnu"
-	      "bufset"
-	      "c-mode"
-	      "calias"
-	      "cinden"
-	      "comint"
-	      "comman"
-	      "comtab"
-	      "comred"
-	      "debug"
-	      "debuge"
-	      "dired"
-	      "ed-ffi"
-	      "editor"
-	      "edtstr"
-	      "evlcom"
-	      "filcom"
-	      "fileio"
-	      "fill"
-	      "hlpcom"
-	      "info"
-	      "input"
-	      "intmod"
-	      "iserch"
-	      "keymap"
-	      "kilcom"
-	      "kmacro"
-	      "lincom"
-	      "linden"
-	      "loadef"
-	      "lspcom"
-	      "malias"
-	      "manual"
-	      "midas"
-	      "modefs"
-	      "modes"
-	      "modlin"
-	      "motcom"
-	      "pasmod"
-	      "print"
-	      "process"
-	      "prompt"
-	      "rcs"
-	      "reccom"
-	      "regcom"
-	      "regexp"
-	      "replaz"
-	      "rmail"
-	      "rmailsrt"
-	      "rmailsum"
-	      "schmod"
-	      "scrcom"
-	      "screen"
-	      "sendmail"
-	      "sercom"
-	      "shell"
-	      "struct"
-	      "syntax"
-	      "tags"
-	      "telnet"
-	      "texcom"
-	      "things"
-	      "tparse"
-	      "tximod"
-	      "undo"
-	      "unix"
-	      "wincom"
-	      "xcom"))
+  (sf-global "tterm" "termcap")
+  (let ((includes '("struct" "comman" "modes" "buffer" "edtstr")))
+    (let loop ((files includes) (includes '()))
+      (if (not (null? files))
+	  (begin
+	    (apply sf-edwin (car files) includes)
+	    (loop (cdr files) (cons (car files) includes)))))
+    (for-each (lambda (filename)
+		(apply sf-edwin filename includes))
+	      '("argred"
+		"autold"
+		"autosv"
+		"basic"
+		"bufcom"
+		"bufinp"
+		"bufmnu"
+		"bufout"
+		"bufset"
+		"c-mode"
+		"calias"
+		"cinden"
+		"comint"
+		"comtab"
+		"comred"
+		"curren"
+		"debug"
+		"debuge"
+		"dired"
+		"ed-ffi"
+		"editor"
+		"evlcom"
+		"filcom"
+		"fileio"
+		"fill"
+		"grpops"
+		"hlpcom"
+		"image"
+		"info"
+		"input"
+		"intmod"
+		"iserch"
+		"keymap"
+		"kilcom"
+		"kmacro"
+		"lincom"
+		"linden"
+		"loadef"
+		"lspcom"
+		"malias"
+		"manual"
+		"midas"
+		"modefs"
+		"modlin"
+		"motcom"
+		"motion"
+		"pasmod"
+		"print"
+		"process"
+		"prompt"
+		"rcs"
+		"reccom"
+		"regcom"
+		"regexp"
+		"regops"
+		"replaz"
+		"rmail"
+		"rmailsrt"
+		"rmailsum"
+		"schmod"
+		"scrcom"
+		"screen"
+		"search"
+		"sendmail"
+		"sercom"
+		"shell"
+		"simple"
+		"syntax"
+		"tags"
+		"telnet"
+		"texcom"
+		"things"
+		"tparse"
+		"tximod"
+		"undo"
+		"unix"
+		"wincom"
+		"winout"
+		"xcom")))
   (for-each sf-class
 	    '("comwin"
 	      "modwin"
 	      "edtfrm"))
-  (sf-global "tterm" "termcap")
-  (sf-global "image" "struct")
-  (sf-edwin "grpops" "struct")
-  (sf-edwin "regops" "struct")
-  (sf-edwin "motion" "struct")
-  (sf-edwin "search" "struct")
-  (sf-edwin "buffer" "comman" "modes")
-  (sf-edwin "curren" "buffer")
   (sf-class "window" "class")
   (sf-class "utlwin" "window" "class")
   (sf-class "bufwin" "utlwin" "window" "class" "buffer" "struct")
diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 4a2f50c66..f958e0270 100644
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.59 1991/08/28 02:54:31 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.60 1991/10/25 00:03:06 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -308,23 +308,24 @@
 
 (define (re-match-forward regexp start #!optional end case-fold-search)
   (let ((group (mark-group start)))
-    (let ((case-fold-search
+    (let ((end
+	   (if (default-object? end)
+	       (group-end-mark group)
+	       (begin
+		 (if (not (mark<= start end))
+		     (error "Marks incorrectly related:" start end))
+		 end)))
+	  (case-fold-search
 	   (if (default-object? case-fold-search)
 	       (group-case-fold-search group)
 	       case-fold-search)))
       (let ((index
-	     (re-match-buffer-forward
-	      (re-compile-pattern regexp case-fold-search)
-	      case-fold-search
-	      (group-syntax-table group)
-	      group
-	      (mark-index start)
-	      (mark-index
-	       (if (default-object? end)
-		   (group-end-mark group)
-		   (begin
-		     (if (not (mark<= start end))
-			 (error "Marks incorrectly related:" start end))
-		     end))))))
+	     (re-match-buffer-forward (re-compile-pattern regexp
+							  case-fold-search)
+				      case-fold-search
+				      (group-syntax-table group)
+				      group
+				      (mark-index start)
+				      (mark-index end))))
 	(and index
 	     (make-mark group index))))))
\ No newline at end of file
diff --git a/v7/src/edwin/shell.scm b/v7/src/edwin/shell.scm
index 5684e2c2f..a4378f1ee 100644
--- a/v7/src/edwin/shell.scm
+++ b/v7/src/edwin/shell.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/shell.scm,v 1.6 1991/10/03 10:19:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/shell.scm,v 1.7 1991/10/25 00:03:10 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -111,7 +111,7 @@ such as `explicit-csh-arguments'.  If that symbol is a variable,
 its value is used as a list of arguments when invoking the shell.
 Otherwise, one argument `-i' is passed to the shell."
   "P"
-  (lambda (#!optional arg)
+  (lambda (new-buffer?)
     (select-buffer
      (let ((program
 	    (or (ref-variable explicit-shell-file-name)
@@ -120,10 +120,7 @@ Otherwise, one argument `-i' is passed to the shell."
 		"/bin/sh")))
        (apply make-comint
 	      (ref-mode-object shell)
-	      (if (or (default-object? arg)
-		      (not arg))
-		  "shell"
-		  '("shell"))
+	      (if (not new-buffer?) "*shell*" (new-buffer "*shell*"))
 	      program
 	      (let ((variable
 		     (string-table-get editor-variables
diff --git a/v7/src/edwin/simple.scm b/v7/src/edwin/simple.scm
index 505199c0c..3f3282f7b 100644
--- a/v7/src/edwin/simple.scm
+++ b/v7/src/edwin/simple.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/simple.scm,v 1.38 1991/05/14 02:02:42 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/simple.scm,v 1.39 1991/10/25 00:03:14 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -258,5 +258,5 @@
 	  (group-narrow! group index2 index1)))))
 
 (define (widen #!optional point)
-  (group-widen!
-   (mark-group (if (default-object? point) (current-point) point))))
\ No newline at end of file
+  (let ((point (if (default-object? point) (current-point) point)))
+    (group-widen! (mark-group point))))
\ No newline at end of file
diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm
index 5e5dba016..d821b0ae5 100644
--- a/v7/src/edwin/syntax.scm
+++ b/v7/src/edwin/syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.73 1991/05/20 21:56:05 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.74 1991/10/25 00:03:18 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -213,22 +213,24 @@ a comment ending."
 	  (ERROR "Marks incorrectly related:" ,start ,end))))
 
 (define (forward-prefix-chars start #!optional end)
-  (let ((group (mark-group start)))
+  (let ((group (mark-group start))
+	(end (default-end/forward start end)))
     (make-mark group
 	       ((ucode-primitive scan-forward-prefix-chars 4)
 		(syntax-table/entries (group-syntax-table group))
 		group
 		(mark-index start)
-		(mark-index (default-end/forward start end))))))
+		(mark-index end)))))
 
 (define (backward-prefix-chars start #!optional end)
-  (let ((group (mark-group start)))
+  (let ((group (mark-group start))
+	(end (default-end/backward start end)))
     (make-mark group
 	       ((ucode-primitive scan-backward-prefix-chars 4)
 		(syntax-table/entries (group-syntax-table group))
 		group
 		(mark-index start)
-		(mark-index (default-end/backward start end))))))
+		(mark-index end)))))
 
 (define (mark-right-char-quoted? mark)
   (let ((group (mark-group mark)))
diff --git a/v7/src/edwin/telnet.scm b/v7/src/edwin/telnet.scm
index d4e6beb71..aa57d90e3 100644
--- a/v7/src/edwin/telnet.scm
+++ b/v7/src/edwin/telnet.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/telnet.scm,v 1.3 1991/10/03 17:47:59 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/telnet.scm,v 1.4 1991/10/25 00:03:22 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -36,7 +36,7 @@ MIT in each case.
 ;;;; Run Telnet in a buffer
 
 (declare (usual-integrations))
-
+
 (define-variable telnet-prompt-pattern
   "#f or Regexp to match prompts in telnet buffers."
   #f)				    
@@ -66,7 +66,7 @@ and telnet-mode-hook, in that order."
 (define-key 'telnet '(#\C-c #\C-q) 'telnet-send-character)
 (define-key 'telnet '(#\C-c #\C-z) 'telnet-self-send)
 (define-key 'telnet '(#\C-c #\C-\\) 'telnet-self-send)
-
+
 ;;;moved to "loadef.scm".
 ;;;(define-variable telnet-mode-hook
 ;;;  "An event distributor that is invoked when entering Telnet mode."
@@ -75,39 +75,34 @@ and telnet-mode-hook, in that order."
 (define-command telnet
   "Run telnet in a buffer.
 With a prefix argument, it unconditionally creates a new telnet connection.
-If port number is typed after hostname (separated by a space), use it instead
-of the default."
-  "sTelnet to Host\nP"
-  (lambda (host #!optional arg)
-    (let ((default
-	    (let ((default (string-append host "-telnet")))
-	      (if (or (default-object? arg)
-		      (not arg))
-		  default
-		  (list default)))))
-      (select-buffer
+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?)
+    (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-match-string-forward
 	    (re-compile-pattern "\\([^ ]+\\) \\([^ ]+\\)" false)
 	    true
 	    false
 	    host)
-	   (let ((host* (substring host
-				   (re-match-start-index 1)
-				   (re-match-end-index 1))))
-	     (let ((port (substring host
-				    (re-match-start-index 2)
-				    (re-match-end-index 2))))
-	       (if (exact-nonnegative-integer? (string->number port))
-		   (make-comint (ref-mode-object telnet)
-				default
-				"telnet"
-				host*
-				port)
-		   (editor-error "Port must be a positive integer"))))
-	   (make-comint (ref-mode-object telnet)
-			default
-			"telnet"
-			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))))))
 
 (define-command telnet-send-input
   "Send input to telnet process.
@@ -120,22 +115,32 @@ The input is entered in the history ring."
 Typically bound to C-c <char> where char is an interrupt key for the process
 running remotely."
   ()
-  (lambda ()
-    (process-send-char (current-process)
-		       (last-command-key))))
+  (lambda () (process-send-char (current-process) (last-command-key))))
 
 (define-command telnet-send-character
-  "Reads a character and sends it to the telnet process."
+  "Read a character and send it to the telnet process.
+With prefix arg, the character is repeated that many times."
   "p"
   (lambda (argument)
     (let ((char (read-quoted-char "Send Character: "))
 	  (process (current-process)))
-      (if (= argument 1)
-	  (process-send-char process char)
-	  (process-send-string process
-			       (make-string argument char))))))
-
+      (cond ((= argument 1)
+	     (process-send-char process char))
+	    ((> argument 1)
+	     (process-send-string process (make-string argument char)))))))
 
+(define (make-telnet-filter process)
+  (lambda (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))
+	       true))))))
+
 (define (telnet-filter-substring string start end)
   (substring-substitute string start end
 			(ref-variable telnet-replacee)
@@ -149,24 +154,10 @@ running remotely."
   "String to use as replacement in telnet output."
   "")
 
-(define (make-telnet-filter process)
-  (lambda (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))
-	       true))))))
-
 (define (substring-substitute string start end source target)
   (let ((length (fix:- end start))
 	(slength (string-length source))
 	(tlength (string-length target)))
-    (if (fix:zero? slength)
-	(error "substring-replace: Empty source" source))
     (let ((alloc-length
 	   (fix:+ length
 		  (fix:* (fix:quotient length slength)
@@ -174,26 +165,16 @@ running remotely."
 	  (char (string-ref source 0)))
       (let ((result (string-allocate alloc-length)))
 
-	(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)
-
 	(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)))
+	      (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-prefix? source 0 slength
+					      string index end))
 		       (substring-move-right! string copy-index index
 					      result write-index)
 		       (let ((next-write
@@ -208,4 +189,13 @@ running remotely."
 		      (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