--- /dev/null
+;;; -*-Scheme-*-
+;;;
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/display.scm,v 1.1 1989/08/12 08:33:51 cph Exp $
+;;;
+;;; Copyright (c) 1989 Massachusetts Institute of Technology
+;;;
+;;; This material was developed by the Scheme project at the
+;;; Massachusetts Institute of Technology, Department of
+;;; Electrical Engineering and Computer Science. Permission to
+;;; copy this software, to redistribute it, and to use it for any
+;;; purpose is granted, subject to the following restrictions and
+;;; understandings.
+;;;
+;;; 1. Any copy made of this software must include this copyright
+;;; notice in full.
+;;;
+;;; 2. Users of this software agree to make their best efforts (a)
+;;; to return to the MIT Scheme project any improvements or
+;;; extensions that they make, so that these may be included in
+;;; future releases; and (b) to inform MIT of noteworthy uses of
+;;; this software.
+;;;
+;;; 3. All materials developed as a consequence of the use of this
+;;; software shall duly acknowledge such use, in accordance with
+;;; the usual standards of acknowledging credit in academic
+;;; research.
+;;;
+;;; 4. MIT has made no warrantee or representation that the
+;;; operation of this software will be error-free, and MIT is
+;;; under no obligation to provide any services, by way of
+;;; maintenance, update, or otherwise.
+;;;
+;;; 5. In conjunction with products arising from the use of this
+;;; material, there shall be no use of the name of the
+;;; Massachusetts Institute of Technology nor of any adaptation
+;;; thereof in any advertising, promotional, or sales literature
+;;; without prior written consent from MIT in each case.
+;;;
+;;; NOTE: Parts of this program (Edwin) were created by translation
+;;; from corresponding parts of GNU Emacs. Users should be aware that
+;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts. A copy
+;;; of that license should have been included along with this file.
+;;;
+
+;;;; Display-Type Abstraction
+;;; package: (edwin display-type)
+
+(declare (usual-integrations))
+\f
+(define-structure (display-type
+ (conc-name display-type/)
+ (constructor %make-display-type))
+ (name false read-only true)
+ (operation/available? false read-only true)
+ (operation/make-screen false read-only true)
+ (operation/make-input-port false read-only true)
+ (operation/with-interrupt-source false read-only true)
+ (operation/with-interrupts-enabled false read-only true)
+ (operation/with-interrupts-disabled false read-only true))
+
+(define (make-display-type name
+ available?
+ make-screen
+ make-input-port
+ with-interrupt-source
+ with-interrupts-enabled
+ with-interrupts-disabled)
+ (let ((display-type
+ (%make-display-type name
+ available?
+ make-screen
+ make-input-port
+ with-interrupt-source
+ with-interrupts-enabled
+ with-interrupts-disabled)))
+ (set! display-types (cons display-type display-types))
+ display-type))
+
+(define display-types '())
+(define edwin-display-type false)
+
+(define (display-type/available? display-type)
+ ((display-type/operation/available? display-type)))
+
+(define (make-editor-screen . args)
+ (apply (display-type/operation/make-screen edwin-display-type) args))
+
+(define (make-editor-input-port screen)
+ ((display-type/operation/make-input-port edwin-display-type) screen))
+
+(define (with-editor-interrupts thunk)
+ ((display-type/operation/with-interrupt-source edwin-display-type) thunk))
+
+(define (with-editor-interrupts-enabled thunk)
+ ((display-type/operation/with-interrupts-enabled edwin-display-type) thunk))
+
+(define (with-editor-interrupts-disabled thunk)
+ ((display-type/operation/with-interrupts-disabled edwin-display-type) thunk))
+
+(define (initialize-display-type!)
+ (set! edwin-display-type
+ (cond (edwin-display-type)
+ ((display-type/available? x-display-type) x-display-type)
+ ((list-search-positive display-types display-type/available?))
+ (else (error "No display available"))))
+ unspecific)
+
+(define (editor-display-types)
+ (map display-type/name
+ (list-transform-positive display-types display-type/available?)))
+
+(define (editor-display-type)
+ (and edwin-display-type (display-type/name edwin-display-type)))
+
+(define (set-editor-display-type! type-name)
+ (set! edwin-display-type
+ (and type-name
+ (or (list-search-positive display-types
+ (lambda (display-type)
+ (eq? type-name (display-type/name display-type))))
+ (error "Unknown display-type name" type-name))))
+ unspecific)
\ No newline at end of file
--- /dev/null
+(standard-scheme-find-file-initialization
+ '#(("argred" (edwin command-argument)
+ edwin-syntax-table)
+ ("autold" (edwin)
+ edwin-syntax-table)
+ ("autosv" (edwin)
+ edwin-syntax-table)
+ ("basic" (edwin)
+ edwin-syntax-table)
+ ("bufcom" (edwin)
+ edwin-syntax-table)
+ ("buffer" (edwin)
+ edwin-syntax-table)
+ ("buffrm" (edwin window)
+ class-syntax-table)
+ ("bufinp" (edwin buffer-input-port)
+ syntax-table/system-internal)
+ ("bufmnu" (edwin buffer-menu)
+ edwin-syntax-table)
+ ("bufott" (edwin buffer-output-port-truncating)
+ syntax-table/system-internal)
+ ("bufout" (edwin buffer-output-port)
+ syntax-table/system-internal)
+ ("bufset" (edwin)
+ edwin-syntax-table)
+ ("bufwfs" (edwin window)
+ class-syntax-table)
+ ("bufwin" (edwin window)
+ class-syntax-table)
+ ("bufwiu" (edwin window)
+ class-syntax-table)
+ ("bufwmc" (edwin window)
+ class-syntax-table)
+ ("c-mode" (edwin)
+ edwin-syntax-table)
+ ("calias" (edwin)
+ edwin-syntax-table)
+ ("cinden" (edwin c-indentation)
+ edwin-syntax-table)
+ ("class" (edwin)
+ syntax-table/system-internal)
+ ("clscon" (edwin class-constructor)
+ syntax-table/system-internal)
+ ("clsmac" (edwin class-macros)
+ syntax-table/system-internal)
+ ("comman" (edwin)
+ edwin-syntax-table)
+ ("comred" (edwin command-reader)
+ edwin-syntax-table)
+ ("comtab" (edwin comtab)
+ syntax-table/system-internal)
+ ("comwin" (edwin window combination)
+ class-syntax-table)
+ ("cterm" (edwin console-screen)
+ syntax-table/system-internal)
+ ("curren" (edwin)
+ edwin-syntax-table)
+ ("debug" (edwin debugger)
+ edwin-syntax-table)
+ ("debuge" (edwin)
+ edwin-syntax-table)
+ ("dired" (edwin dired)
+ edwin-syntax-table)
+ ("display" (edwin display-type)
+ syntax-table/system-internal)
+ ("ed-ffi" (edwin)
+ edwin-syntax-table)
+ ("editor" (edwin)
+ edwin-syntax-table)
+ ("edtfrm" (edwin window)
+ class-syntax-table)
+ ("edtstr" (edwin)
+ edwin-syntax-table)
+ ("entity" (edwin)
+ syntax-table/system-internal) ("evlcom" (edwin)
+ edwin-syntax-table)
+ ("filcom" (edwin)
+ edwin-syntax-table)
+ ("fileio" (edwin)
+ edwin-syntax-table)
+ ("fill" (edwin)
+ edwin-syntax-table)
+ ("grpops" (edwin group-operations)
+ syntax-table/system-internal)
+ ("hlpcom" (edwin)
+ edwin-syntax-table)
+ ("image" (edwin)
+ syntax-table/system-internal)
+ ("info" (edwin info)
+ edwin-syntax-table)
+ ("input" (edwin keyboard)
+ edwin-syntax-table)
+ ("intmod" (edwin)
+ edwin-syntax-table)
+ ("iserch" (edwin incremental-search)
+ edwin-syntax-table)
+ ("keymap" (edwin command-summary)
+ edwin-syntax-table)
+ ("kilcom" (edwin)
+ edwin-syntax-table)
+ ("kmacro" (edwin)
+ edwin-syntax-table)
+ ("lincom" (edwin)
+ edwin-syntax-table)
+ ("linden" (edwin lisp-indentation)
+ edwin-syntax-table)
+ ("linwin" (edwin window)
+ class-syntax-table)
+ ("loadef" (edwin)
+ edwin-syntax-table)
+ ("lspcom" (edwin)
+ edwin-syntax-table)
+ ("macros" (edwin macros)
+ syntax-table/system-internal)
+ ("make" ()
+ syntax-table/system-internal)
+ ("midas" (edwin)
+ edwin-syntax-table)
+ ("modefs" (edwin)
+ edwin-syntax-table)
+ ("modes" (edwin)
+ edwin-syntax-table)
+ ("modlin" (edwin modeline-string)
+ edwin-syntax-table)
+ ("modwin" (edwin window)
+ class-syntax-table)
+ ("motcom" (edwin)
+ edwin-syntax-table)
+ ("motion" (edwin)
+ syntax-table/system-internal)
+ ("nvector" (edwin)
+ syntax-table/system-internal)
+ ("pasmod" (edwin)
+ edwin-syntax-table)
+ ("paths" (edwin)
+ syntax-table/system-internal)
+ ("prompt" (edwin prompt)
+ edwin-syntax-table)
+ ("reccom" (edwin rectangle)
+ edwin-syntax-table)
+ ("regcom" (edwin register-command)
+ edwin-syntax-table)
+ ("regexp" (edwin regular-expression)
+ edwin-syntax-table)
+ ("regops" (edwin)
+ syntax-table/system-internal)
+ ("rename" ()
+ syntax-table/system-internal)
+ ("replaz" (edwin)
+ edwin-syntax-table)
+ ("rgxcmp" (edwin regular-expression-compiler)
+ syntax-table/system-internal)
+ ("ring" (edwin)
+ syntax-table/system-internal)
+ ("schmod" (edwin)
+ edwin-syntax-table)
+ ("screen" (edwin screen)
+ syntax-table/system-internal)
+ ("search" (edwin)
+ syntax-table/system-internal)
+ ("sercom" (edwin)
+ edwin-syntax-table)
+ ("simple" (edwin)
+ syntax-table/system-internal)
+ ("strpad" (edwin)
+ syntax-table/system-internal)
+ ("strtab" (edwin)
+ syntax-table/system-internal)
+ ("struct" (edwin)
+ edwin-syntax-table)
+ ("syntax" (edwin)
+ edwin-syntax-table)
+ ("tags" (edwin tags)
+ edwin-syntax-table)
+ ("texcom" (edwin)
+ edwin-syntax-table)
+ ("things" (edwin)
+ edwin-syntax-table)
+ ("tparse" (edwin)
+ edwin-syntax-table)
+ ("tximod" (edwin)
+ edwin-syntax-table)
+ ("undo" (edwin undo)
+ edwin-syntax-table)
+ ("unix" (edwin)
+ edwin-syntax-table)
+ ("utils" (edwin)
+ syntax-table/system-internal)
+ ("utlwin" (edwin window)
+ class-syntax-table)
+ ("wincom" (edwin)
+ edwin-syntax-table)
+ ("window" (edwin window)
+ class-syntax-table)
+ ("winmis" (edwin window)
+ class-syntax-table)
+ ("winout" (edwin window-output-port)
+ syntax-table/system-internal)
+ ("winren" (edwin)
+ syntax-table/system-internal)
+ ("xcom" (edwin x-commands)
+ edwin-syntax-table)
+ ("xform" (edwin class-macros transform-instance-variables)
+ syntax-table/system-internal)
+ ("xterm" (edwin x-screen)
+ syntax-table/system-internal)))
\ No newline at end of file
projects / mit-scheme.git / commitdiff