[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
TI Scheme functions for MIT C-Scheme - 3 of 3
#--------------------------------CUT HERE-------------------------------------
#! /bin/sh
#
# This is a shell archive. Save this into a file, edit it
# and delete all lines above this comment. Then give this
# file to sh by executing the command "sh file". The files
# will be extracted into the current directory owned by
# you with default permissions.
#
# The files contained herein are:
#
# -rw-r--r-- 1 mike 3472 Mar 30 14:35 sort.scm
# -rw-r----- 1 mike 13385 Mar 30 14:35 ti.scm
# -rw-r----- 1 mike 1982 Mar 30 14:35 window.scm
#
echo 'x - sort.scm'
if test -f sort.scm; then echo 'shar: not overwriting sort.scm'; else
sed 's/^X//' << '________This_Is_The_END________' > sort.scm
X;;; -*-Scheme-*-
X;;;
X;;; $Header: msort.scm,v 13.42 87/11/21 18:06:51 GMT jinx Rel $
X;;;
X;;; Copyright (c) 1987 Massachusetts Institute of Technology
X;;;
X;;; This material was developed by the Scheme project at the
X;;; Massachusetts Institute of Technology, Department of
X;;; Electrical Engineering and Computer Science. Permission to
X;;; copy this software, to redistribute it, and to use it for any
X;;; purpose is granted, subject to the following restrictions and
X;;; understandings.
X;;;
X;;; 1. Any copy made of this software must include this copyright
X;;; notice in full.
X;;;
X;;; 2. Users of this software agree to make their best efforts (a)
X;;; to return to the MIT Scheme project any improvements or
X;;; extensions that they make, so that these may be included in
X;;; future releases; and (b) to inform MIT of noteworthy uses of
X;;; this software.
X;;;
X;;; 3. All materials developed as a consequence of the use of
X;;; this software shall duly acknowledge such use, in accordance
X;;; with the usual standards of acknowledging credit in academic
X;;; research.
X;;;
X;;; 4. MIT has made no warrantee or representation that the
X;;; operation of this software will be error-free, and MIT is
X;;; under no obligation to provide any services, by way of
X;;; maintenance, update, or otherwise.
X;;;
X;;; 5. In conjunction with products arising from the use of this
X;;; material, there shall be no use of the name of the
X;;; Massachusetts Institute of Technology nor of any adaptation
X;;; thereof in any advertising, promotional, or sales literature
X;;; without prior written consent from MIT in each case.
X;;;
X
X;;;; Merge Sort
X
X(declare (usual-integrations))
X
X;; Functional and unstable
X
X(define (sort obj #!optional pred)
X (define (loop l)
X (if (and (pair? l) (pair? (cdr l)))
X (split l '() '())
X l))
X
X (define (split l one two)
X (if (pair? l)
X (split (cdr l) two (cons (car l) one))
X (merge (loop one) (loop two))))
X
X (define (merge one two)
X (cond ((null? one) two)
X ((pred (car two) (car one))
X (cons (car two)
X (merge (cdr two) one)))
X (else
X (cons (car one)
X (merge (cdr one) two)))))
X
X (if (unassigned? pred) (set! pred <))
X (cond ((or (pair? obj) (null? obj))
X (loop obj))
X ((vector? obj)
X (sort! (vector-copy obj) pred))
X (else
X (error "sort: argument should be a list or vector" obj))))
X
X;; This merge sort is stable for partial orders (for predicates like
X;; <=, rather than like <).
X
X;; This is not destructive for lists
X(define (sort! v #!optional pred)
X (define (sort-internal! vec temp low high)
X (if (< low high)
X (let* ((middle (quotient (+ low high) 2))
X (next (1+ middle)))
X (sort-internal! temp vec low middle)
X (sort-internal! temp vec next high)
X (let loop ((p low) (p1 low) (p2 next))
X (if (not (> p high))
X (cond ((> p1 middle)
X (vector-set! vec p (vector-ref temp p2))
X (loop (1+ p) p1 (1+ p2)))
X ((or (> p2 high)
X (pred (vector-ref temp p1)
X (vector-ref temp p2)))
X (vector-set! vec p (vector-ref temp p1))
X (loop (1+ p) (1+ p1) p2))
X (else
X (vector-set! vec p (vector-ref temp p2))
X (loop (1+ p) p1 (1+ p2)))))))))
X
X (if (unassigned? pred) (set! pred <))
X (cond ((list? obj)
X (writeln "Warning: SORT! is not destructive on lists." v)
X (set! v (vector->list v)))
X ((not (vector? v))
X (error "sort!: argument not a vector or list." v)))
X
X (sort-internal! v
X (vector-copy v)
X 0
X (-1+ (vector-length v)))
________This_Is_The_END________
if test `wc -l < sort.scm` -ne 109; then
echo 'shar: sort.scm was damaged during transit (should have been 109 lines)'
fi
fi ; : end of overwriting check
echo 'x - ti.scm'
if test -f ti.scm; then echo 'shar: not overwriting ti.scm'; else
sed 's/^X//' << '________This_Is_The_END________' > ti.scm
X(declare (usual-integrations))
X
X;; Some required and worthwile definitions
X(define file-attributes (make-primitive-procedure 'FILE-ATTRIBUTES))
X
X(in-package system-global-environment
X (define (add-syntax! name expander)
X (SYNTAX-TABLE-DEFINE SYSTEM-GLOBAL-SYNTAX-TABLE name expander)
X name)
X )
X
X;; Extend the parser to recognize |
X(load "$TISCHEME/parser-escape" parser-package)
X
X(define (not-implemented-yet name)
X (error "Not implemented yet" name))
X
X;; Set up autoloading first
X;;; AUTOLOAD-FROM-FILE
X(load "$TISCHEME/auto-load")
X
X;;; ADD1
X(define add1 1+)
X
X;;; ALIAS
X
X;;; ALL-CLASSVARS
X(autoload-from-file "$TISCHEME/scoops" '(all-classvars))
X
X;;; ALL-INSTVARS
X(autoload-from-file "$TISCHEME/scoops" '(all-instvars))
X
X;;; ALL-METHODS
X(autoload-from-file "$TISCHEME/scoops" '(all-methods))
X
X;;; APPLY-IF
X(syntax-table-define system-global-syntax-table 'APPLY-IF
X (macro (pred proc exp)
X `(let ((t1 ,pred) (t2 (lambda () ,exp)))
X (if t1 (,proc t1)
X (t2)))))
X
X;;; ASCII->SYMBOL
X;; This is not really the same. TI's (ASCII->SYMBOL 39) returns |'|
X;; This one returns '
X(define (ascii->symbol number)
X (if (and (integer? number) (positive? number) (<= number 255))
X (string->symbol (char->string (ascii->char 39)))
X (error "ASCII->SYMBOL: Not an integer between 0 and 255" number)))
X
X;;; ASSERT
X(define (assert predicate . messages)
X (not-implemented-yet 'ASSERT))
X
X;;; ATOM?
X(define (atom? object)
X (not (pair? object)))
X
X
X;;; ATAN
X(let ()
X (let-syntax ()
X (define-macro (define-primitives . names)
X `(BEGIN ,@(map (lambda (name)
X `(LOCAL-ASSIGNMENT
X (the-environment)
X ',name
X ,(make-primitive-procedure name)))
X names)))
X (define-primitives &= &< &> &+ &- &* &/ &atan))
X
X (declare (integrate-primitive-procedures
X &= &< &> &+ &- &* &/ &atan))
X
X (define pi/4 (&atan 1))
X (define pi/2 (&* pi/4 2))
X (define -pi/2 (&- 0 pi/2))
X (define pi (&* pi/4 4))
X
X (set! atan
X (named-lambda (atan y #!optional x)
X (if (unassigned? x) (set! x 1))
X (if (zero? x)
X (if (negative? y) -pi/2 pi/2)
X (let ((atan1 (&atan (&/ y x))))
X (cond ((positive? x) atan1)
X ((negative? y) (&- atan1 pi))
X (else (&+ atan1 pi)))))))
X )
X
X;;; BEGIN0
X(define-macro (begin0 first . rest)
X `(let ((temp ,first)) ,@rest temp))
X
X;;; CALL/CC
X(define call/cc call-with-current-continuation)
X
X;;; CLASS-COMPILED?
X(autoload-from-file "$TISCHEME/scoops" '(class-compiled?))
X
X;;; CLASS-OF-OBJECT
X(autoload-from-file "$TISCHEME/scoops" '(class-of-object))
X
X;;; CLASSVARS
X(autoload-from-file "$TISCHEME/scoops" '(classvars))
X
X;;; CLEAR-GRAPHICS
X(autoload-from-file "$TISCHEME/graphics" '(clear-graphics))
X
X;;; CLEAR-POINT
X(autoload-from-file "$TISCHEME/graphics" '(clear-point))
X
X;;; CLOSURE?
X(define closure? procedure?)
X
X;;; COMPILE-CLASS
X(autoload-from-file "$TISCHEME/scoops" '(compile-class))
X
X;;; COMPILE-FILE
X(define compile-file sf)
X
X;;; CURRENT-COLUMN
X(define (current-column #!optional port)
X (cond ((unassigned? port) (set! port *current-input-port*))
X ((not (port? port)) (error "FLUSH-INPUT: Bad port" port)))
X (not-implemented-yet 'CURRENT-COLUMN))
X
X;;; DEFINE-CLASS
X(autoload-from-file "$TISCHEME/scoops" '(define-class))
X
X;;; DEFINE-INTEGRABLE
X(syntax-table-define system-global-syntax-table 'DEFINE-INTEGRABLE
X (macro (pattern . body)
X `(BEGIN (DECLARE (INTEGRATE-OPERATOR ,(car pattern)))
X (DEFINE ,pattern
X (DECLARE (INTEGRATE ,@(cdr pattern)))
X ,@body))))
X
X
X;;; DEFINE-METHOD
X(autoload-from-file "$TISCHEME/scoops" '(define-method))
X
X;;; DESCRIBE
X(autoload-from-file "$TISCHEME/scoops" '(describe))
X
X;;; DELAYED-OBJECT?
X(define delayed-object?
X (microcode-type-predicate 'DELAYED))
X
X;;; DOS-CHDIR
X(define (dos-chdir pathname)
X (set-working-directory-pathname!
X (cond ((pathname? pathname) pathname)
X ((symbol? pathname) (symbol->pathname pathname))
X ((string=? pathname ".")
X (working-directory-pathname))
X ((string=? pathname "..")
X (make-pathname
X (pathname-device (%pwd))
X (simplify-directory
X (append (pathname-directory (%pwd)) '(UP)))
X false
X false
X false))
X ((string? pathname)
X (string->pathname pathname))
X (else (error "DOS-CHDIR: Not a pathname, symbol or string")))))
X
X
X
X
X;;; DOS-COPY-FILE
X(define dos-file-copy copy-file)
X
X;;; DOS-DELETE
X(define dos-delete delete-file)
X
X;;; DOS-FILE-SIZE
X(define (dos-file-size filename)
X (if (file-exists? filename)
X (vector-ref (file-attributes filename) 7)))
X
X;;; DOS-RENAME
X(define dos-rename rename-file)
X
X;;; DRAW-BOX-TO
X(autoload-from-file "$TISCHEME/graphics" '(draw-box-to))
X
X;;; DRAW-FILLED-BOX-TO
X(autoload-from-file "$TISCHEME/graphics" '(draw-filled-box-to))
X
X;;; DRAW-LINE-TO
X(autoload-from-file "$TISCHEME/graphics" '(draw-line-to))
X
X;;; DRAW-POINT
X(autoload-from-file "$TISCHEME/graphics" '(draw-point))
X
X;;; EDIT
X(define (edit pair)
X (not-implemented-yet 'EDIT))
X
X;;; EDWIN
X(define (edwin)
X (not-implemented-yet 'EDWIN))
X
X;;; ENGINE-RETURN
X(define (engine-return val)
X (not-implemented-yet 'ENGINE-RETURN))
X
X;;; #\ESCAPE
X(load "$TISCHEME/escape")
X
X(define (eval expression #!optional environment)
X (if (unassigned? environment) (set! environment *rep-current-environment*))
X (scode-eval (syntax expression *rep-current-syntax-table*)
X environment))
X
X;;; EXIT
X(define exit %exit)
X
X;;; EXPLODE
X(autoload-from-file "$SCHEME/xplode" '(explode))
X
X;;; FLUSH-INPUT
X(define (flush-input #!optional port)
X (let ((newline-delimiters (char-set #\Newline)))
X (cond ((unassigned? port) (set! port *current-input-port*))
X ((not (port? port)) (error "FLUSH-INPUT: Bad port" port)))
X (or ((access :discard-chars port) newline-delimiters)
X eof-object)))
X
X;;; FREESP
X(define (freesp)
X (vector-ref (car (gc-statistics)) 5))
X
X;;; FRESH-LINE
X(define (fresh-line #!optional port)
X (cond ((unassigned? port) (set! port *current-output-port*))
X ((not (port? port)) (error "Bad port" port)))
X (not-implemented-yet 'FRESH-LINE))
X
X;;; GC
X(define gc gc-flip)
X
X;;; GENSYM
X;; Make gensym a version of generate-uninterned-symbol that accepts
X;; a number or a string, as well as a symbol as the optional argument
X(define gensym
X (let ((name-counter 0)
X (name-prefix "G"))
X (define (get-number)
X (let ((result name-counter))
X (set! name-counter (1+ name-counter))
X result))
X (named-lambda (gensym #!optional argument)
X (if (not (unassigned? argument))
X (cond ((string? argument)
X (set! name-prefix argument))
X ((symbol? argument)
X (set! name-prefix (symbol->string argument)))
X ((integer? argument)
X (set! name-counter argument))
X (else
X (error "Bad argument: GENSYM"
X argument))))
X (string->uninterned-symbol
X (string-append name-prefix (write-to-string (get-number)))))))
X
X;;; GETCV
X(autoload-from-file "$TISCHEME/scoops" '(getcv))
X
X;;; GET-FILE-POSITION
X;; Not implemented yet - needs C support
X(define (get-file-position port)
X (if (not (port? port)) (error "Bad port" port))
X (not-implemented-yet 'GET-FILE-POSITION))
X
X;;; GET-PEN-COLOR
X(autoload-from-file "$TISCHEME/graphics" '(get-pen-color))
X
X;;; GETPROP
X(define getprop 2D-get)
X
X;;; GET-VIDEO-MODE
X(autoload-from-file "$TISCHEME/graphics" '(get-video-mode))
X
X;;; *GRAPHICS-COLORS*
X(autoload-from-file "$TISCHEME/graphics" '(*graphics-colors*))
X
X;;; IF
X(set! undefined-conditional-branch '())
X
X;;; IMPLODE
X(autoload-from-file "$scheme/xplode" '(implode))
X
X;;; INSTVARS
X(autoload-from-file "$TISCHEME/scoops" '(instvars))
X
X;;; INTEGER->STRING
X(define (integer->string number base)
X (cond ((not (integer? number))
X (error "INTEGER->STRING: Not an integer" number))
X ((not (integer? base))
X (error "INTEGER->STRING: Not an integer" base))
X (else (list->string
X (fluid-let ((*radix* base))
X ((access unparse-signed-integer
X number-unparser-package) number))))))
X
X;;; IS-POINT-ON?
X(autoload-from-file "$TISCHEME/graphics" '(is-point-on?))
X
X;;; LINE-LENGTH
X(define (line-length #!optional port)
X (cond ((unassigned? port) (set! port *current-output-port*))
X ((not (port? port)) (error "Bad port" port)))
X ((access :x-size port)))
X
X;;; LIST*
X(define list* cons*)
X
X;;; LIST->STREAM
X;; This may be wrong. (cons (car obj) (delay (cdr obj))) ??
X(define (list->stream obj)
X (if (not (list? obj)) (error "LIST->STREAM: Not a list" obj))
X (let loop ((lyst obj)
X (result))
X (if (null? lyst)
X (reverse! result)
X (loop (cdr lyst) (cons-stream (car lyst) result)))))
X
X;;; MACRO
X;; TI's macro conflicts with MIT's macro.
X;; TI's MACRO has been renamed to ti-macro
X(add-syntax! 'ti-macro
X (macro (symbol def)
X (let ((var (caadr def))
X (body (cddr def)))
X `(add-syntax!
X ',symbol
X (macro ,var
X (let ((,var (cons ',symbol ,var)))
X ,@body))))))
X
X;;; MAKE-ENGINE
X(define (make-engine thunk)
X (not-implemented-yet 'MAKE-ENGINE))
X
X;;; MAKE-INSTANCE
X(autoload-from-file "$TISCHEME/scoops" '(make-instance))
X
X;;; MAKE-WINDOW
X(autoload-from-file "$TISCHEME/window" '(make-window))
X
X;;; METHODS
X;;; MIXINS
X;;; NAME->CLASS
X(autoload-from-file "$TISCHEME/scoops" '(methods mixins name->class))
X
X;;; NIL
X(define nil '())
X
X;;; OPEN-BINARY-INPUT-FILE
X(define open-binary-input-file open-input-file)
X
X;;; OPEN-BINARY-OUTPUT-FILE
X(define open-binary-output-file open-output-file)
X
X;;; OPEN-EXTEND-FILE
X;; Not implemented yet - needs C support
X(autoload-from-file "$TISCHEME/file-extend" '(open-extend-file))
X
X;;; PI
X(define pi (* 4.0 (atan 1.0 1.0)))
X
X;;; POINT-COLOR
X(autoload-from-file "$TISCHEME/graphics" '(point-color))
X
X;;; PORT?
X(define (port? port)
X (or (output-port? port)
X (input-port? port)))
X
X;;; POSITION-PEN
X(autoload-from-file "$TISCHEME/graphics" '(position-pen))
X
X;;; PRINC
X(define princ display)
X
X;;; PRIN1
X(define prin1 write)
X
X;;; PRINT
X(define (print object #!optional port)
X (cond ((unassigned? port) (set! port *current-output-port*))
X ((not (output-port? port)) (error "Bad output port" port)))
X (newline port)
X (write object port)
X (write " " port)
X *the-non-printing-object*)
X
X;;; PRINT-LENGTH
X(define (print-length object)
X (string-length
X (with-output-to-string
X (lambda ()
X (display object)))))
X
X;;; PROC?
X(define (proc? object)
X (or (procedure? object) (continuation? object)))
X
X;;; PROPLIST
X(define proplist 2d-get-alist-x)
X
X;;; PUTPROP
X(define (putprop name val prop)
X (2D-put! name prop val))
X
X;;; READ-ATOM
X(define (read-atom #!optional port)
X (let ((atom-delimiters (access atom-delimiters parser-package)))
X (cond ((unassigned? port) (set! port *current-input-port*))
X ((not (port? port)) (error "READ-ATOM: Bad port" port)))
X (or ((access :read-string port) atom-delimiters)
X eof-object)))
X
X;;; READ-LINE
X(define (read-line #!optional port)
X (let ((newline-delimiters (char-set #\Newline)))
X (cond ((unassigned? port) (set! port *current-input-port*))
X ((not (port? port)) (error "READ-LINE: Bad port" port)))
X (or ((access :read-string port) newline-delimiters)
X eof-object)))
X
X;;; REC
X;; You may want to change REC of lambdas to named lambdas
X(syntax-table-define system-global-syntax-table 'REC
X (macro (var exp)
X `(letrec ((,var ,exp)) ,var)))
X
X;;; REMPROP
X(define remprop 2D-remove!)
X
X;;; RENAME-CLASS
X;;; SEND
X;;; SEND-IF-HANDLES
X(autoload-from-file "$TISCHEME/scoops" '(rename-class send send-if-handles))
X
X;;; SET-LINE-LENGTH!
X(define (set-line-length! number #!optional port)
X (cond ((unassigned? port) (set! port *current-output-port*))
X ((not (port? port)) (error "SET-LINE-LENGTH!: Bad port" port)))
X (if (not (and (integer? number) (>= number 0)))
X (error "SET-LINE-LENGTH!: number must be a positive integer" number))
X (set! (access :x-size port) `(lambda () ,number)))
X
X;;; SET!
X;; (SET! (VECTOR-REF vector n) value) is not implemented yet.
X;; (SET! (FLUID var) value) is not implemented yet.
X
X;;; SETCV
X(autoload-from-file "$TISCHEME/scoops" '(setcv))
X
X;;; SORT
X(load "$TISCHEME/sort")
X
X;;; STREAM?
X(define (stream? obj)
X (and (pair? obj)
X (delayed? (cdr obj))))
X
X;;; STREAM->LIST
X(define (stream->list obj)
X (if (not (stream? obj)) (error "STREAM->LIST: Not a stream" obj))
X (let loop ((stream obj)
X (result))
X (if (empty-stream? stream)
X (reverse! result)
X (loop (force (cdr stream)) (cons (car stream) result)))))
X
X;;; SUB1
X(define sub1 -1+)
X
X;;; SYMBOL->ASCII
X(define (symbol->ascii symbol)
X (char->ascii (car (string->list (symbol->string symbol)))))
X
X;;; SYNTAX
X;; Confilicts with MIT definition
X
X;;; T
X(define t #!true)
X
X;;; WHEN
X(syntax-table-define system-global-syntax-table 'WHEN
X (macro args
X `(if ,(car args)
X (begin ,@(cdr args)))))
X
X;;; WINDOW-CLEAR
X;;; WINDOW-DELETE
X;;; WINDOW-GET-ATTRIBUTE
X;;; WINDOW-GET-CURSOR
X;;; WINDOW-GET-POSITION
X;;; WINDOW-GET-SIZE
X;;; WINDOW-POPUP
X;;; WINDOW-POPUP-DELETE
X;;; WINDOW-RESTORE-CONTENTS
X;;; WINDOW-SAVE-CONTENTS
X;;; WINDOW-SET-ATTRIBUTE!
X;;; WINDOW-SET-CURSOR!
X;;; WINDOW-SET-POSITION!
X;;; WINDOW-SET-SIZE!
X;;; WINDOW?
X
X(autoload-from-file "$TISCHEME/window" '(window-clear window-delete
Xwindow-get-attribute window-get-cursor window-get-position window-get-size
Xwindow-popup window-popup-delete window-restore-contents
Xwindow-save-contents window-set-attribute! window-set-cursor!
Xwindow-set-position! window-set-size! window?))
X
X;;; WRITELN
X(define (writeln #!rest objects)
X (for-each display objects)
X (newline))
X
X(newline)
X(define (ti-compatibility-package-version)
X "1.0")
X
X(writeln "TI Functions loaded.")
________This_Is_The_END________
if test `wc -l < ti.scm` -ne 532; then
echo 'shar: ti.scm was damaged during transit (should have been 532 lines)'
fi
fi ; : end of overwriting check
echo 'x - window.scm'
if test -f window.scm; then echo 'shar: not overwriting window.scm'; else
sed 's/^X//' << '________This_Is_The_END________' > window.scm
X(declare (usual-integrations))
X
X;;; MAKE-WINDOW
X(define (make-window #!optional label border)
X (not-implemented-yet 'make-window))
X
X;;; WINDOW-CLEAR
X(define (window-clear window)
X (not-implemented-yet 'window-clear))
X
X;;; WINDOW-DELETE
X(define (window-delete window)
X (not-implemented-yet 'window-delete))
X
X;;; WINDOW-GET-ATTRIBUTE
X(define (window-get-attribute window name)
X (case name
X (BORDER-ATTRIBUTES)
X (TEXT-ATTRIBUTES)
X (WINDOW-FLAGS)
X (else (error "WINDOW-GET-ATTRIBUTE: Unknown attribute" name)))
X (not-implemented-yet 'window-get-attribute))
X
X;;; WINDOW-GET-CURSOR
X(define (window-get-cursor window)
X (not-implemented-yet 'window-get-cursor))
X
X;;; WINDOW-GET-POSITION
X(define (window-get-position window)
X (not-implemented-yet 'window-get-position))
X
X;;; WINDOW-GET-SIZE
X(define (window-get-size window)
X (not-implemented-yet 'window-get-size))
X
X;;; WINDOW-POPUP
X(define (window-popup window)
X (not-implemented-yet 'window-popup))
X
X;;; WINDOW-POPUP-DELETE
X(define (window-popup-delete window)
X (not-implemented-yet 'window-popup-delete))
X
X;;; WINDOW-RESTORE-CONTENTS
X(define (window-restore-contents window contents)
X (not-implemented-yet 'window-restore-contents))
X
X;;; WINDOW-SAVE-CONTENTS
X(define (window-save-contents window)
X (not-implemented-yet 'window-save-contents))
X
X;;; WINDOW-SET-ATTRIBUTE!
X(define (window-set-attribute! window name value)
X (case name
X (BORDER-ATTRIBUTES)
X (TEXT-ATTRIBUTES)
X (WINDOW-FLAGS)
X (else (error "WINDOW-SET-ATTRIBUTE!: Unknown attribute" name)))
X (not-implemented-yet 'window-set-attribute!))
X
X;;; WINDOW-SET-CURSOR!
X(define (window-set-cursor! window line col)
X (not-implemented-yet 'window-set-cursor!))
X
X;;; WINDOW-SET-POSITION!
X(define (window-set-position! window line col)
X (not-implemented-yet 'window-set-position!))
X
X;;; WINDOW-SET-SIZE!
X(define (window-set-size! window lines cols)
X (not-implemented-yet 'window-set-size!))
X
X;;; WINDOW?
X(define (window? obj)
X (not-implemented-yet 'window?))
X
________This_Is_The_END________
if test `wc -l < window.scm` -ne 76; then
echo 'shar: window.scm was damaged during transit (should have been 76 lines)'
fi
fi ; : end of overwriting check
exit 0
--
Mike Clarkson mike@ists.UUCP
Institute for Space and Terrestrial Science mike@ists.ists.ca
York University, North York, Ontario, uunet!mnetor!yunexus!ists!mike
CANADA M3J 1P3 +1 (416) 736-5611