From 3c875a4dfbc7907615f59fd679be8dba2b7a8640 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 8 May 2018 21:50:15 -0700 Subject: [PATCH] Simplify console port exports. * Eliminate console-input-port, console-output-port, and set-console-i/o-port!. * Change console-i/o-port to be a thunk that returns the port. --- src/edwin/bios.scm | 6 ++--- src/edwin/termcap.scm | 4 ++-- src/edwin/tterm.scm | 48 +++++++++++++++++++------------------- src/edwin/win32.scm | 2 +- src/runtime/console-io.scm | 17 ++++---------- src/runtime/gcstat.scm | 4 ++-- src/runtime/interrupt.scm | 2 +- src/runtime/make.scm | 6 ++--- src/runtime/rep.scm | 4 ++-- src/runtime/runtime.pkg | 5 +--- src/runtime/thread.scm | 2 +- 11 files changed, 44 insertions(+), 56 deletions(-) diff --git a/src/edwin/bios.scm b/src/edwin/bios.scm index 8ddce9577..7bc1a492e 100644 --- a/src/edwin/bios.scm +++ b/src/edwin/bios.scm @@ -31,9 +31,9 @@ USA. (define (make-bios-screen) ;; What is the baud rate needed for? It's not even meaningful. - (let ((baud-rate (output-port/baud-rate console-output-port)) - (x-size (output-port/x-size console-output-port)) - (y-size (output-port/y-size console-output-port))) + (let ((baud-rate (output-port/baud-rate (console-i/o-port))) + (x-size (output-port/x-size (console-i/o-port))) + (y-size (output-port/y-size (console-i/o-port)))) (make-screen (cons (fix:-1+ y-size) (fix:-1+ x-size)) bios-console-beep bios-console-clear-line! diff --git a/src/edwin/termcap.scm b/src/edwin/termcap.scm index bec84e5e3..727da1951 100644 --- a/src/edwin/termcap.scm +++ b/src/edwin/termcap.scm @@ -129,8 +129,8 @@ USA. (define (make-termcap-description terminal-type-name) (if (string-ci=? terminal-type-name "ansi.sys") - (let ((x-size (output-port/x-size console-output-port)) - (y-size (output-port/y-size console-output-port))) + (let ((x-size (output-port/x-size (console-i/o-port))) + (y-size (output-port/y-size (console-i/o-port)))) (make-ansi-terminal-description x-size y-size)) (and (implemented-primitive-procedure? (ucode-primitive termcap-initialize 1)) diff --git a/src/edwin/tterm.scm b/src/edwin/tterm.scm index dcc01c3bf..296bce796 100644 --- a/src/edwin/tterm.scm +++ b/src/edwin/tterm.scm @@ -30,7 +30,7 @@ USA. (define (make-console-screen) (let ((description (console-termcap-description))) - (cond ((not (output-port/baud-rate console-i/o-port)) + (cond ((not (output-port/baud-rate (console-i/o-port))) (error "standard output not a terminal")) ((not description) (error "terminal type not set")) @@ -42,9 +42,9 @@ USA. ((not (no-undesirable-characteristics? description)) (error "terminal type has undesirable characteristics" (terminal-type-name description)))) - (let ((baud-rate (output-port/baud-rate console-i/o-port)) - (x-size (output-port/x-size console-i/o-port)) - (y-size (output-port/y-size console-i/o-port))) + (let ((baud-rate (output-port/baud-rate (console-i/o-port))) + (x-size (output-port/x-size (console-i/o-port))) + (y-size (output-port/y-size (console-i/o-port)))) (make-screen (with-values (lambda () (compute-scrolling-costs description @@ -113,7 +113,7 @@ USA. (set! console-description (let ((term (get-environment-variable "TERM"))) (and term - (or (and (output-port/baud-rate console-i/o-port) + (or (and (output-port/baud-rate (console-i/o-port)) (make-termcap-description term)) term))))) console-description) @@ -168,7 +168,7 @@ USA. ;; terminal's special key sequences against the buffer. They wait a ;; little-while for incomplete sequences, then yield the individual ;; characters. - (let ((channel (port/input-channel console-i/o-port)) + (let ((channel (port/input-channel (console-i/o-port))) (buffer (make-string (* 3 input-buffer-size))) (start 0) (end 0) @@ -398,10 +398,10 @@ USA. (bind-console-state false (lambda (get-outside-state) (terminal-operation terminal-raw-input - (port/input-channel console-i/o-port)) - (channel-nonblocking (port/input-channel console-i/o-port)) + (port/input-channel (console-i/o-port))) + (channel-nonblocking (port/input-channel (console-i/o-port))) (terminal-operation terminal-raw-output - (port/output-channel console-i/o-port)) + (port/output-channel (console-i/o-port))) (tty-set-interrupt-enables 2) (receiver (lambda (thunk) @@ -424,14 +424,14 @@ USA. (set-console-state! outside-state))))) (define (console-state) - (vector (channel-state (port/input-channel console-i/o-port)) - (channel-state (port/output-channel console-i/o-port)) + (vector (channel-state (port/input-channel (console-i/o-port))) + (channel-state (port/output-channel (console-i/o-port))) (tty-get-interrupt-enables))) (define (set-console-state! state) - (set-channel-state! (port/input-channel console-i/o-port) + (set-channel-state! (port/input-channel (console-i/o-port)) (vector-ref state 0)) - (set-channel-state! (port/output-channel console-i/o-port) + (set-channel-state! (port/output-channel (console-i/o-port)) (vector-ref state 1)) (tty-set-interrupt-enables (vector-ref state 2))) @@ -551,7 +551,7 @@ USA. (exit-insert-mode screen) (maybe-output screen (ts-exit-keypad-mode description)) (maybe-output screen (ts-exit-termcap-mode description))) - (output-port/flush-output console-i/o-port)) + (output-port/flush-output (console-i/o-port))) (define (console-modeline-event! screen window type) screen window type @@ -560,14 +560,14 @@ USA. (define (console-wrap-update! screen thunk) (let ((finished? (thunk))) (window-direct-output-cursor! (screen-cursor-window screen)) - (output-port/flush-output console-i/o-port) + (output-port/flush-output (console-i/o-port)) finished?)) (define (console-discretionary-flush screen) - (let ((n (output-port/buffered-bytes console-i/o-port))) + (let ((n (output-port/buffered-bytes (console-i/o-port)))) (if (fix:< 20 n) (begin - (output-port/flush-output console-i/o-port) + (output-port/flush-output (console-i/o-port)) (let ((baud-rate (screen-baud-rate screen))) (if (fix:< baud-rate 2400) (let ((msec (quotient (* n 10000) baud-rate))) @@ -582,7 +582,7 @@ USA. (define (console-flush! screen) screen - (output-port/flush-output console-i/o-port)) + (output-port/flush-output (console-i/o-port))) (define (console-write-cursor! screen x y) (move-cursor screen x y)) @@ -596,7 +596,7 @@ USA. (exit-insert-mode screen) (move-cursor screen x y) (highlight-if-desired screen highlight) - (output-port/write-char console-i/o-port char) + (output-port/write-char (console-i/o-port) char) (record-cursor-after-output screen (fix:1+ x))))) (define (console-write-substring! screen x y string start end highlight) @@ -613,7 +613,7 @@ USA. (screen-x-size screen)))) (fix:-1+ end) end))) - (output-port/write-substring console-i/o-port string start end) + (output-port/write-substring (console-i/o-port) string start end) (record-cursor-after-output screen (fix:+ x (fix:- end start))))))) (define (console-clear-line! screen x y first-unused-x) @@ -745,7 +745,7 @@ USA. first-unused-x))) (do ((x (screen-cursor-x screen) (fix:1+ x))) ((fix:= x first-unused-x)) - (output-port/write-char console-i/o-port #\space)) + (output-port/write-char (console-i/o-port) #\space)) (record-cursor-after-output screen first-unused-x))))))) (define (clear-multi-char screen n) @@ -770,7 +770,7 @@ USA. x-end)))) (do ((x cursor-x (fix:1+ x))) ((fix:= x x-end)) - (output-port/write-char console-i/o-port #\space)) + (output-port/write-char (console-i/o-port) #\space)) (record-cursor-after-output screen x-end)))))))) (define (insert-lines screen yl yu n) @@ -1091,7 +1091,7 @@ USA. (output-n screen command 1)) (define-integrable (output-n screen command n-lines) - (output-port/write-string console-i/o-port + (output-port/write-string (console-i/o-port) (pad-string screen command n-lines))) (define (maybe-output screen command) @@ -1223,7 +1223,7 @@ Note that the multiply factors are in tenths of characters. |# (state (screen-state screen))) (if (not (terminal-state? state)) (editor-error "Not a terminal screen") - (let ((port console-i/o-port) + (let ((port (console-i/o-port)) (desc (terminal-state/description state))) (let ((x-size (output-port/x-size port)) (y-size (output-port/y-size port))) diff --git a/src/edwin/win32.scm b/src/edwin/win32.scm index 47a662aa3..8327b28df 100644 --- a/src/edwin/win32.scm +++ b/src/edwin/win32.scm @@ -48,7 +48,7 @@ USA. (win32-screen-write-substring! 7)) ;;(define (debug . details) -;; (pp details console-output-port)) +;; (pp details (console-i/o-port))) (define-structure (win32-screen-state (constructor make-win32-screen-state (handle)) diff --git a/src/runtime/console-io.scm b/src/runtime/console-io.scm index e32333970..ac56b24cc 100644 --- a/src/runtime/console-io.scm +++ b/src/runtime/console-io.scm @@ -54,7 +54,6 @@ USA. (set-channel-port! input-channel port) (set-channel-port! output-channel port) (set! the-console-port port) - (set-console-i/o-port! port) (current-input-port port) (current-output-port port)))) (set! port/echo-input? (generic-i/o-port-accessor 0)) @@ -65,7 +64,7 @@ USA. (define (save-console-input) ((ucode-primitive reload-save-string 1) - (generic-io/buffer-contents console-input-port))) + (generic-io/buffer-contents the-console-port))) (define (reset-console) (let ((input-channel (tty-input-channel)) @@ -86,21 +85,13 @@ USA. (default-object) (channel-type=file? input-channel))) -(define (set-console-i/o-port! port) - (if (not (i/o-port? port)) - (error:wrong-type-argument port "I/O port" 'set-console-i/o-port!)) - (set! console-i/o-port port) - (set! console-input-port port) - (set! console-output-port port) - unspecific) +(define (console-i/o-port) + the-console-port) (define (console-i/o-port? port) - (eqv? port console-i/o-port)) + (eqv? port the-console-port)) (define the-console-port) -(define console-i/o-port) -(define console-input-port) -(define console-output-port) (define (operation/read-char port) (let ((char (generic-io/read-char port))) diff --git a/src/runtime/gcstat.scm b/src/runtime/gcstat.scm index 0e0035cb8..0f7e2333c 100644 --- a/src/runtime/gcstat.scm +++ b/src/runtime/gcstat.scm @@ -43,7 +43,7 @@ USA. unspecific) (define (recorder/gc-start) - (port/gc-start console-i/o-port) + (port/gc-start (console-i/o-port)) (set! this-gc-start-uctime (get-universal-time)) (set! this-gc-start-clock (real-time-clock)) (set! this-gc-start (process-time-clock)) @@ -58,7 +58,7 @@ USA. space-remaining this-gc-start-uctime this-gc-start-clock end-time-clock)) - (port/gc-finish console-i/o-port)) + (port/gc-finish (console-i/o-port))) (define timestamp) (define total-gc-time) diff --git a/src/runtime/interrupt.scm b/src/runtime/interrupt.scm index dfca0db5e..052b780eb 100644 --- a/src/runtime/interrupt.scm +++ b/src/runtime/interrupt.scm @@ -191,7 +191,7 @@ USA. (define (signal-interrupt hook/interrupt hook/clean-input char interrupt) (let ((thread - (thread-mutex-owner (textual-port-thread-mutex console-i/o-port)))) + (thread-mutex-owner (textual-port-thread-mutex (console-i/o-port))))) (if thread (signal-thread-event thread (lambda () diff --git a/src/runtime/make.scm b/src/runtime/make.scm index ec83273d9..f298d2c45 100644 --- a/src/runtime/make.scm +++ b/src/runtime/make.scm @@ -599,13 +599,13 @@ USA. 'gc-boot-loading? #f) (set! fasload-purification-queue) - (newline console-output-port) - (write-string "purifying..." console-output-port) + (newline (console-i/o-port)) + (write-string "purifying..." (console-i/o-port)) ;; First, flush whatever we can. (gc-clean) ;; Then, really purify the rest. (purify roots #t #f) - (write-string "done" console-output-port)) + (write-string "done" (console-i/o-port))) ) diff --git a/src/runtime/rep.scm b/src/runtime/rep.scm index 9699abc67..9a8301591 100644 --- a/src/runtime/rep.scm +++ b/src/runtime/rep.scm @@ -46,7 +46,7 @@ USA. (lambda (continuation) (set! root-continuation continuation) (repl/start (make-repl #f - console-i/o-port + (console-i/o-port) user-initial-environment #f `((set-default-directory @@ -215,7 +215,7 @@ USA. (let ((cmdl (param:nearest-cmdl))) (if cmdl (cmdl/port cmdl) - console-i/o-port))) + (console-i/o-port)))) (define (nearest-cmdl/level) (let ((cmdl (param:nearest-cmdl))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 13fb600c7..787bcdbad 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1552,10 +1552,7 @@ USA. tty-output-channel) (export () console-i/o-port - console-i/o-port? - console-input-port - console-output-port - set-console-i/o-port!) + console-i/o-port?) (export (runtime emacs-interface) the-console-port) (initialization (initialize-package!))) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 3f6f82672..1f034636e 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -264,7 +264,7 @@ USA. ((not return?) (run-first-thread))))) (define (console-thread) - (thread-mutex-owner (textual-port-thread-mutex console-i/o-port))) + (thread-mutex-owner (textual-port-thread-mutex (console-i/o-port)))) (define (other-running-threads?) (thread/next (current-thread))) -- 2.25.1