From 8ed4802947dd564a83064da0d72195f18b56ae78 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 14 Sep 2004 20:06:19 +0000
Subject: [PATCH] Change strategy used to manage the emacs interface: just swap
port types on the console port. This modulates the behavior without messing
with any of the state.
---
v7/src/runtime/emacs.scm | 76 +++++++++++++++-------------------------
1 file changed, 29 insertions(+), 47 deletions(-)
diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm
index a838d62cc..f3c424082 100644
--- a/v7/src/runtime/emacs.scm
+++ b/v7/src/runtime/emacs.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: emacs.scm,v 14.34 2004/09/14 19:51:56 cph Exp $
+$Id: emacs.scm,v 14.35 2004/09/14 20:06:19 cph Exp $
Copyright 1986,1987,1991,1993,1994,1999 Massachusetts Institute of Technology
Copyright 2001,2003,2004 Massachusetts Institute of Technology
@@ -214,61 +214,43 @@ USA.
;;;; Initialization
-(define emacs-console-port)
+(define vanilla-console-port-type)
+(define emacs-console-port-type)
(define (initialize-package!)
- (set! emacs-console-port
- (make-port (make-port-type
- `((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression)
- (PROMPT-FOR-COMMAND-CHAR ,emacs/prompt-for-command-char)
- (PROMPT-FOR-COMMAND-EXPRESSION
- ,emacs/prompt-for-command-expression)
- (PROMPT-FOR-CONFIRMATION ,emacs/prompt-for-confirmation)
- (DEBUGGER-FAILURE ,emacs/debugger-failure)
- (DEBUGGER-MESSAGE ,emacs/debugger-message)
- (DEBUGGER-PRESENTATION ,emacs/debugger-presentation)
- (WRITE-RESULT ,emacs/write-result)
- (SET-DEFAULT-DIRECTORY ,emacs/set-default-directory)
- (READ-START ,emacs/read-start)
- (READ-FINISH ,emacs/read-finish)
- (GC-START ,emacs/gc-start)
- (GC-FINISH ,emacs/gc-finish))
- (port/type the-console-port))
- (port/state the-console-port)))
- ;; YUCCH! Kludge to copy mutex of console port into emacs port.
- (set-port/thread-mutex! emacs-console-port
- (port/thread-mutex the-console-port))
- (set-console-i/o-port! (select-console-port))
- (add-event-receiver! event:after-restore reset-console-port!))
-
-(define (reset-console-port!)
- ;; This is a kludge. Maybe this method shouldn't be used.
- (let* ((new-port (select-console-port))
- (replace-port
- (lambda (get set)
- (if (let ((port (get)))
- (or (eq? port the-console-port)
- (eq? port emacs-console-port)))
- (set new-port)))))
- (replace-port (lambda () console-i/o-port) set-console-i/o-port!)
- (do ((pairs standard-port-accessors (cdr pairs)))
- ((null? pairs))
- (replace-port (caar pairs) (cdar pairs)))
- (do ((cmdl (nearest-cmdl) (cmdl/parent cmdl)))
- ((not cmdl))
- (replace-port (lambda () (cmdl/port cmdl))
- (lambda (port) (set-cmdl/port! cmdl port))))))
-
-(define (select-console-port)
+ (set! vanilla-console-port-type (port/type the-console-port))
+ (set! emacs-console-port-type
+ (make-port-type
+ `((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression)
+ (PROMPT-FOR-COMMAND-CHAR ,emacs/prompt-for-command-char)
+ (PROMPT-FOR-COMMAND-EXPRESSION
+ ,emacs/prompt-for-command-expression)
+ (PROMPT-FOR-CONFIRMATION ,emacs/prompt-for-confirmation)
+ (DEBUGGER-FAILURE ,emacs/debugger-failure)
+ (DEBUGGER-MESSAGE ,emacs/debugger-message)
+ (DEBUGGER-PRESENTATION ,emacs/debugger-presentation)
+ (WRITE-RESULT ,emacs/write-result)
+ (SET-DEFAULT-DIRECTORY ,emacs/set-default-directory)
+ (READ-START ,emacs/read-start)
+ (READ-FINISH ,emacs/read-finish)
+ (GC-START ,emacs/gc-start)
+ (GC-FINISH ,emacs/gc-finish))
+ vanilla-console-port-type))
+ (add-event-receiver! event:after-restore
+ (lambda ()
+ (set-port/type! the-console-port
+ (select-console-port-type)))))
+
+(define (select-console-port-type)
(if ((ucode-primitive under-emacs? 0))
(begin
(set! hook/clean-input/flush-typeahead
emacs/clean-input/flush-typeahead)
(set! hook/^G-interrupt emacs/^G-interrupt)
(set! hook/error-decision emacs/error-decision)
- emacs-console-port)
+ emacs-console-port-type)
(begin
(set! hook/clean-input/flush-typeahead #f)
(set! hook/^G-interrupt #f)
(set! hook/error-decision #f)
- the-console-port)))
\ No newline at end of file
+ vanilla-console-port-type)))
\ No newline at end of file
--
2.25.1