2) Eliminate some interrupt windows in direct output.
3) Add operations to the screen data structure to accomodate curses.
4) Add a new structure, a display, which consists of a keyboard and a screen.
5) Conditions not trapped by edwin now revert to the user in a
reasonable way, ie. the terminal should be in the same state that it
was before edwin was entered.
6) Reentering edwin after an unhandled condition updates the display.
7) The interaction buffer prompt is now inserted in the "exit" thunk
of the dynamic unwind, so that an abort will insert it as well.
8) Fix wrong number of args bug in ^R Screen Video.
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.29 1989/03/14 07:58:54 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.30 1989/03/30 16:39:21 jinx Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(%window-direct-update! (frame-text-inferior frame) display-style))
(define (window-direct-output-insert-char! frame char)
- (let ((point (window-point frame)))
- (%group-insert-char! (mark-group point) (mark-index point) char))
- (%direct-output-insert-char! (frame-text-inferior frame) char))
+ (without-interrupts
+ (lambda ()
+ (let ((point (window-point frame)))
+ (%group-insert-char! (mark-group point) (mark-index point) char))
+ (%direct-output-insert-char! (frame-text-inferior frame) char))))
(define (window-direct-output-insert-newline! frame)
- (let ((point (window-point frame)))
- (%group-insert-char! (mark-group point) (mark-index point) #\newline))
- (%direct-output-insert-newline! (frame-text-inferior frame)))
+ (without-interrupts
+ (lambda ()
+ (let ((point (window-point frame)))
+ (%group-insert-char! (mark-group point) (mark-index point) #\newline))
+ (%direct-output-insert-newline! (frame-text-inferior frame)))))
(define (window-direct-output-insert-substring! frame string start end)
- (let ((point (window-point frame)))
- (%group-insert-substring! (mark-group point) (mark-index point)
- string start end))
- (%direct-output-insert-substring! (frame-text-inferior frame)
- string start end))
+ (without-interrupts
+ (lambda ()
+ (let ((point (window-point frame)))
+ (%group-insert-substring! (mark-group point) (mark-index point)
+ string start end))
+ (%direct-output-insert-substring! (frame-text-inferior frame)
+ string start end))))
(define-integrable (window-direct-output-forward-char! frame)
- (%direct-output-forward-character! (frame-text-inferior frame)))
+ (without-interrupts
+ (lambda ()
+ (%direct-output-forward-character! (frame-text-inferior frame)))))
(define-integrable (window-direct-output-backward-char! frame)
- (%direct-output-backward-character! (frame-text-inferior frame)))
+ (without-interrupts
+ (lambda ()
+ (%direct-output-backward-character! (frame-text-inferior frame)))))
(define (window-scroll-y-absolute! frame y-point)
(let ((window (frame-text-inferior frame)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.5 1989/03/14 07:59:18 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.6 1989/03/30 16:39:27 jinx Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
;;; modifiable, and the modeline must already show that it has been
;;; modified. None of the procedures may be used if the window needs
;;; redisplay.
+;;; They must be called without interrupts.
(define (%window-direct-update! window display-style)
(with-instance-variables buffer-window window (display-style)
(define (%direct-output-forward-character! window)
(with-instance-variables buffer-window window ()
- (without-interrupts
- (lambda ()
- (%set-buffer-point! buffer (mark1+ point))
- (set! point (buffer-point buffer))
- (let ((x-start (1+ (inferior-x-start cursor-inferior)))
- (y-start (inferior-y-start cursor-inferior)))
- (screen-write-cursor! saved-screen
- (+ saved-x-start x-start)
- (+ saved-y-start y-start))
- (screen-flush! saved-screen)
- (%set-inferior-x-start! cursor-inferior x-start))))))
+ (%set-buffer-point! buffer (mark1+ point))
+ (set! point (buffer-point buffer))
+ (let ((x-start (1+ (inferior-x-start cursor-inferior)))
+ (y-start (inferior-y-start cursor-inferior)))
+ (screen-write-cursor! saved-screen
+ (+ saved-x-start x-start)
+ (+ saved-y-start y-start))
+ (screen-flush! saved-screen)
+ (%set-inferior-x-start! cursor-inferior x-start))))
(define (%direct-output-backward-character! window)
(with-instance-variables buffer-window window ()
- (without-interrupts
- (lambda ()
- (%set-buffer-point! buffer (mark-1+ point))
- (set! point (buffer-point buffer))
- (let ((x-start (-1+ (inferior-x-start cursor-inferior)))
- (y-start (inferior-y-start cursor-inferior)))
- (screen-write-cursor! saved-screen
- (+ saved-x-start x-start)
- (+ saved-y-start y-start))
- (screen-flush! saved-screen)
- (%set-inferior-x-start! cursor-inferior x-start))))))
+ (%set-buffer-point! buffer (mark-1+ point))
+ (set! point (buffer-point buffer))
+ (let ((x-start (-1+ (inferior-x-start cursor-inferior)))
+ (y-start (inferior-y-start cursor-inferior)))
+ (screen-write-cursor! saved-screen
+ (+ saved-x-start x-start)
+ (+ saved-y-start y-start))
+ (screen-flush! saved-screen)
+ (%set-inferior-x-start! cursor-inferior x-start))))
\f
(define (%direct-output-insert-char! window char)
(with-instance-variables buffer-window window (char)
- (without-interrupts
- (lambda ()
- (let ((x-start (inferior-x-start cursor-inferior))
- (y-start (inferior-y-start cursor-inferior)))
- (let ((x (+ saved-x-start x-start))
- (y (+ saved-y-start y-start)))
- (screen-write-char! saved-screen x y char)
- (screen-write-cursor! saved-screen (1+ x) y)
- (screen-flush! saved-screen))
- (line-window-direct-output-insert-char!
- (inferior-window (car (y->inferiors window y-start)))
- x-start
- char)
- (%set-inferior-x-start! cursor-inferior (1+ x-start)))))))
+ (let ((x-start (inferior-x-start cursor-inferior))
+ (y-start (inferior-y-start cursor-inferior)))
+ (let ((x (+ saved-x-start x-start))
+ (y (+ saved-y-start y-start)))
+ (screen-write-char! saved-screen x y char)
+ (screen-write-cursor! saved-screen (1+ x) y)
+ (screen-flush! saved-screen))
+ (line-window-direct-output-insert-char!
+ (inferior-window (car (y->inferiors window y-start)))
+ x-start
+ char)
+ (%set-inferior-x-start! cursor-inferior (1+ x-start)))))
(define (%direct-output-insert-newline! window)
(with-instance-variables buffer-window window ()
- (without-interrupts
- (lambda ()
- (let ((y-start (1+ (inferior-y-start cursor-inferior))))
- (let ((inferior (make-inferior window line-window)))
- (%set-inferior-x-start! inferior 0)
- (%set-inferior-y-start! inferior y-start)
- (set-cdr! (last-pair line-inferiors) (list inferior))
- (set! last-line-inferior inferior)
- (line-window-direct-output-insert-newline!
- (inferior-window inferior)))
- (let ((y-end (1+ y-start)))
- (if (< y-end y-size)
- (begin
- (%set-inferior-y-size! blank-inferior (- y-size y-end))
- (%set-inferior-y-start! blank-inferior y-end))
- (begin
- (%set-inferior-x-start! blank-inferior false)
- (%set-inferior-y-start! blank-inferior false))))
- (%set-inferior-x-start! cursor-inferior 0)
- (%set-inferior-y-start! cursor-inferior y-start)
- (screen-write-cursor! saved-screen
- saved-x-start
- (+ saved-y-start y-start))
- (screen-flush! saved-screen))))))
+ (let ((y-start (1+ (inferior-y-start cursor-inferior))))
+ (let ((inferior (make-inferior window line-window)))
+ (%set-inferior-x-start! inferior 0)
+ (%set-inferior-y-start! inferior y-start)
+ (set-cdr! (last-pair line-inferiors) (list inferior))
+ (set! last-line-inferior inferior)
+ (line-window-direct-output-insert-newline!
+ (inferior-window inferior)))
+ (let ((y-end (1+ y-start)))
+ (if (< y-end y-size)
+ (begin
+ (%set-inferior-y-size! blank-inferior (- y-size y-end))
+ (%set-inferior-y-start! blank-inferior y-end))
+ (begin
+ (%set-inferior-x-start! blank-inferior false)
+ (%set-inferior-y-start! blank-inferior false))))
+ (%set-inferior-x-start! cursor-inferior 0)
+ (%set-inferior-y-start! cursor-inferior y-start)
+ (screen-write-cursor! saved-screen
+ saved-x-start
+ (+ saved-y-start y-start))
+ (screen-flush! saved-screen))))
(define (%direct-output-insert-substring! window string start end)
(with-instance-variables buffer-window window (string start end)
- (without-interrupts
- (lambda ()
- (let ((x-start (inferior-x-start cursor-inferior))
- (y-start (inferior-y-start cursor-inferior))
- (length (- end start)))
- (let ((x (+ saved-x-start x-start))
- (y (+ saved-y-start y-start)))
- (screen-write-substring! saved-screen x y string start end)
- (screen-write-cursor! saved-screen (+ x length) y)
- (screen-flush! saved-screen))
- (line-window-direct-output-insert-substring!
- (inferior-window (car (y->inferiors window y-start)))
- x-start
- string start end)
- (%set-inferior-x-start! cursor-inferior (+ x-start length)))))))
\ No newline at end of file
+ (let ((x-start (inferior-x-start cursor-inferior))
+ (y-start (inferior-y-start cursor-inferior))
+ (length (- end start)))
+ (let ((x (+ saved-x-start x-start))
+ (y (+ saved-y-start y-start)))
+ (screen-write-substring! saved-screen x y string start end)
+ (screen-write-cursor! saved-screen (+ x length) y)
+ (screen-flush! saved-screen))
+ (line-window-direct-output-insert-substring!
+ (inferior-window (car (y->inferiors window y-start)))
+ x-start
+ string start end)
+ (%set-inferior-x-start! cursor-inferior (+ x-start length)))))
\ No newline at end of file
"clscon"
"clsmac"
"complt"
+ "cterm"
"entity"
"grpops"
"image"
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.183 1989/03/14 08:00:27 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.184 1989/03/30 16:39:37 jinx Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define (edwin)
(if (not edwin-editor)
(edwin-reset))
- (with-editor-input-port edwin-input-port
- (lambda ()
- (with-editor-interrupts
- (lambda ()
- (within-editor edwin-editor
- (lambda ()
- (perform-buffer-initializations! (current-buffer))
- (update-screens! true)
- (if edwin-initialization (edwin-initialization))
- (let ((message (cmdl-message/null)))
- (push-cmdl (lambda (cmdl)
- cmdl ;ignore
- (top-level-command-reader)
- message)
- false
- message))))))))
+ (call-with-current-continuation
+ (lambda (edwin-abort-continuation)
+ (bind-condition-handler
+ '()
+ (lambda (condition)
+ (within-continuation edwin-abort-continuation
+ (lambda ()
+ (signal-error condition))))
+ enter-edwin))))
+
+(define (enter-edwin)
+ (using-screen edwin-screen
+ (lambda ()
+ (with-editor-input-port edwin-input-port
+ (lambda ()
+ (with-editor-interrupts
+ (lambda ()
+ (within-editor edwin-editor
+ (lambda ()
+ (perform-buffer-initializations! (current-buffer))
+ (dynamic-wind
+ (lambda ()
+ (update-screens! true))
+ (lambda ()
+ ;; Should this be in a dynamic wind? -- Jinx
+ (if edwin-initialization (edwin-initialization))
+ (let ((message (cmdl-message/null)))
+ (push-cmdl (lambda (cmdl)
+ cmdl ;ignore
+ (top-level-command-reader)
+ message)
+ false
+ message)))
+ (lambda ()
+ unspecific))))))))))
+ ;; Should this be here or in a dynamic wind? -- Jinx
(if edwin-finalization (edwin-finalization))
unspecific)
(load "bufset" environment)
(load "undo" (->environment '(EDWIN UNDO)))
(load "screen" (->environment '(EDWIN SCREEN)))
- (load "xterm" (->environment '(EDWIN X-SCREEN)))
(load "winren" (->environment '(EDWIN)))
(let ((environment (->environment '(EDWIN WINDOW))))
(load "window" environment)
(load "buffrm" environment)
(load "edtfrm" environment)
(load "winmis" environment))
+ (let ((env (->environment '(EDWIN X-SCREEN))))
+ (load "xterm" env)
+ ((access initialize-package! env)))
+ (let ((env (->environment '(EDWIN CONSOLE-SCREEN))))
+ (load "cterm" env)
+ ((access initialize-package! env)))
(load "edtstr" environment)
(load "editor" environment)
(load "curren" environment)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.1 1989/03/14 08:12:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.2 1989/03/30 16:39:47 jinx Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
(export (edwin)
make-screen
screen-beep
+ screen-discard!
+ screen-enter!
+ screen-exit!
screen-flush!
screen-in-update?
screen-inverse-video!
screen-state
screen-window
+ screen-wipe!
screen-write-char!
screen-write-cursor!
screen-write-substring!
screen-y-size
set-screen-window!
subscreen-clear!
+ using-screen
with-screen-in-update!))
(define-package (edwin x-screen)
(files "xterm")
(parent (edwin))
(export (edwin)
- make-xterm-input-port
- make-xterm-screen
- with-editor-interrupts
- with-editor-interrupts-disabled
- with-editor-interrupts-enabled
- xterm-close-all-displays
- xterm-close-display
- xterm-close-window
- xterm-map
- xterm-open-display
- xterm-open-window
- xterm-unmap))
+ X-display)
+ (initialization (initialize-package!)))
+
+(define-package (edwin console-screen)
+ (files "cterm")
+ (parent (edwin))
+ (export (edwin)
+ console-display)
+ (initialization (initialize-package!)))
(define-package (edwin window)
(files "window"
"edtfrm"
"winmis")
(parent (edwin))
+ (export ()
+ edwin-set-display!)
(export (edwin)
editor-frame-select-cursor!
editor-frame-select-window!
editor-frame-typein-window
editor-frame-window0
edwin-discard-state!
+ edwin-display
edwin-editor
edwin-input-port
edwin-reset
edwin-reset-windows
+ edwin-screen
+ make-display
make-editor-frame
modeline-mode-string
modeline-modified-string
window-select-time
window-set-override-message!
window-start-mark
- window-y-center)
+ window-y-center
+ with-editor-interrupts
+ with-editor-interrupts-enabled
+ with-editor-interrupts-disabled)
(export (edwin prompt)
clear-override-message!
frame-text-inferior
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.1 1989/03/14 08:00:49 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.2 1989/03/30 16:39:53 jinx Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define (group-insert-char! group index char)
(without-interrupts
(lambda ()
- (group-insert-char-kernel group index char)
+ (%group-insert-char! group index char)
(record-insertion! group index (group-gap-start group)))))
-(define (%group-insert-char! group index char)
- (without-interrupts
- (lambda ()
- (group-insert-char-kernel group index char))))
-
-(define-integrable (group-insert-char-kernel group index char)
+(define-integrable (%group-insert-char! group index char)
(barf-if-read-only group)
(move-gap-to! group index)
(guarantee-gap-length! group 1)
(define (group-insert-substring! group index string start end)
(without-interrupts
(lambda ()
- (group-insert-substring-kernel group index string start end)
+ (%group-insert-substring! group index string start end)
(record-insertion! group index (group-gap-start group)))))
-(define (%group-insert-substring! group index string start end)
- (without-interrupts
- (lambda ()
- (group-insert-substring-kernel group index string start end))))
-
-(define-integrable (group-insert-substring-kernel group index string start end)
+(define-integrable (%group-insert-substring! group index string start end)
(barf-if-read-only group)
(move-gap-to! group index)
(let ((n (- end start)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.30 1989/03/14 08:01:05 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.31 1989/03/30 16:39:58 jinx Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(dynamic-wind
(lambda () 'DONE)
(lambda ()
- (intercept-^G-interrupts (lambda ()
- (newline)
- (write-string "Abort!"))
- (lambda ()
- (let ((environment (evaluation-environment false)))
- (with-output-to-current-point
- (lambda ()
- (write-line (eval-with-history (with-input-from-mark mark
- read)
- environment))))))))
+ (with-output-to-current-point
+ (lambda ()
+ (intercept-^G-interrupts
+ (lambda ()
+ (newline)
+ (write-string "Abort!"))
+ (lambda ()
+ (write-line
+ (eval-with-history (with-input-from-mark mark
+ read)
+ (evaluation-environment false))))))))
insert-interaction-prompt))))
\f
(define-command ("^R Interaction Refresh")
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.1 1989/03/15 19:17:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.2 1989/03/30 16:40:02 jinx Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
(declare (usual-integrations))
(package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 1 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 2 '()))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.78 1989/03/14 08:02:42 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.79 1989/03/30 16:40:07 jinx Exp $
;;;
;;; Copyright (c) 1989 Massachusetts Institute of Technology
;;;
operation/write-substring!
operation/write-substrings!
operation/x-size
- operation/y-size)))
+ operation/y-size
+ operation/wipe!
+ operation/enter!
+ operation/exit!
+ operation/discard!)))
(state false read-only true)
(operation/beep false read-only true)
(operation/finish-update! false read-only true)
(operation/write-substrings! false read-only true)
(operation/x-size false read-only true)
(operation/y-size false read-only true)
+ (operation/wipe! false read-only true)
+ (operation/enter! false read-only true)
+ (operation/exit! false read-only true)
+ (operation/discard! false read-only true)
(window false)
(in-update? false))
+(define (using-screen screen thunk)
+ (dynamic-wind (lambda ()
+ ((screen-operation/enter! screen) screen))
+ thunk
+ (lambda ()
+ ((screen-operation/exit! screen) screen))))
+
(define (with-screen-in-update! screen thunk)
(let ((old-flag)
(new-flag true))
(define (screen-write-substrings! screen x y strings bil biu bjl bju)
((screen-operation/write-substrings! screen)
- screen x y strings bil biu bjl bju))
\ No newline at end of file
+ screen x y strings bil biu bjl bju))
+
+(define (screen-wipe! screen)
+ ((screen-operation/wipe! screen) screen))
+
+(define (screen-enter! screen)
+ ((screen-operation/enter! screen) screen))
+
+(define (screen-exit! screen)
+ ((screen-operation/exit! screen) screen))
+
+(define (screen-discard! screen)
+ ((screen-operation/discard! screen) screen))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.89 1989/03/14 08:03:47 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.90 1989/03/30 16:40:11 jinx Exp $
;;;
;;; Copyright (c) 1987, 1989 Massachusetts Institute of Technology
;;;
With a positive argument, inverse video is forced.
With a negative argument, normal video is forced."
(screen-inverse-video!
+ (current-screen)
(or (positive? argument)
(not (or (negative? argument)
- (screen-inverse-video! false)))))
+ (screen-inverse-video!
+ (current-screen)
+ false)))))
(update-screens! true))
(define-command ("What Cursor Position")
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.1 1989/03/14 08:08:58 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.2 1989/03/30 16:40:21 jinx Exp $
;;;
;;; Copyright (c) 1989 Massachusetts Institute of Technology
;;;
(define (make-xterm-screen #!optional geometry)
(make-screen (make-xterm-screen-state
- (xterm-open-window (or (xterm-open-display false)
+ (xterm-open-window (or (get-X-display)
(error "unable to open display"))
(and (not (default-object? geometry))
geometry)
xterm-screen/write-substring!
xterm-screen/write-substrings!
xterm-screen/x-size
- xterm-screen/y-size))
+ xterm-screen/y-size
+ xterm-screen/wipe!
+ xterm-screen/enter!
+ xterm-screen/exit!
+ xterm-screen/discard!))
(define-integrable (screen-xterm screen)
(xterm-screen-state/xterm (screen-state screen)))
(define-integrable (screen-highlight screen)
(xterm-screen-state/highlight (screen-state screen)))
-
+\f
(define-integrable (set-screen-highlight! screen highlight)
(set-xterm-screen-state/highlight! (screen-state screen) highlight))
ail aiu
highlight)
(loop (1+ y) (1+ j)))))))))))
-
+\f
(define (clip axu x bil biu receiver)
(let ((ail (- bil x)))
(if (< ail biu)
(define (xterm-screen/y-size screen)
(xterm-y-size (screen-xterm screen)))
+
+(define (xterm-screen/wipe! screen)
+ screen ; ignored
+ unspecific)
+
+(define (xterm-screen/enter! screen)
+ screen ; ignored
+ unspecific)
+
+(define (xterm-screen/exit! screen)
+ screen ; ignored
+ unspecific)
+
+(define (xterm-screen/discard! screen)
+ screen ; ignored
+ (close-X-display))
\f
;;;; Input Port
(set! pending-interrupt? false)
(^G-signal))
-(define (with-editor-interrupts thunk)
+(define (with-editor-interrupts-from-X thunk)
(fluid-let ((signal-interrupts? true)
(pending-interrupt? false))
(thunk)))
-(define (with-editor-interrupts-enabled thunk)
+(define (with-X-interrupts-enabled thunk)
(bind-signal-interrupts? true thunk))
-(define (with-editor-interrupts-disabled thunk)
+(define (with-X-interrupts-disabled thunk)
(bind-signal-interrupts? false thunk))
(define (bind-signal-interrupts? new-mask thunk)
(set! new-mask signal-interrupts?)
(set! signal-interrupts? old-mask)
(if (and old-mask pending-interrupt?)
- (signal-interrupt!))))))
\ No newline at end of file
+ (signal-interrupt!))))))
+\f
+;;;; Display description for X displays
+
+(define X-display)
+(define X-display-data)
+
+(define (get-X-display)
+ (if (and (not (unassigned? X-display-data))
+ X-display-data)
+ X-display-data
+ (let ((display (xterm-open-display false)))
+ (set! X-display-data display)
+ display)))
+
+(define (close-X-display)
+ (xterm-close-all-displays)
+ (set! X-display-data false)
+ unspecific)
+
+(define (initialize-package!)
+ (set! X-display
+ (make-display get-X-display
+ make-xterm-screen
+ make-xterm-input-port
+ with-editor-interrupts-from-X
+ with-X-interrupts-enabled
+ with-X-interrupts-disabled)))
projects / mit-scheme.git / commitdiff