OS/2 Shareware BBS: 10 Tools

home *** CD-ROM | disk | FTP | other *** search

/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / swat / scheme / load.scm < prev next >

Wrap

Text File | 1998-02-11 | 30KB | 1,058 lines

#| (with-working-directory-pathname (directory-pathname (current-load-pathname)) (lambda () ;; Dynamically load the microcode. Order important. (load "dynload/scxl") (load "dynload/tcl") (load "dynload/tk") (load "dynload/uitk") ((access with-directory-rewriting-rule (->environment '(RUNTIME COMPILER-INFO))) (working-directory-pathname) (pathname-as-directory "lib/swat") (lambda () (package/system-loader "swat" '() 'QUERY))) (add-identification! "SWAT" 1 0))) |# (let ((swat-env (in-package system-global-environment (let () (the-environment))))) (package/add-child! (find-package '()) 'SWAT swat-env) (for-each (lambda (export) (local-assignment swat-env export 'UNASSIGNED) (environment-link-name (package/environment (find-package '())) swat-env export)) ;; All of SWAT's exported names. This list need pruning '(*-alert-structure-size-* *-alert.function-* *-alert.reason-* *-canvasitem-structure-size-* *-canvasitem.add-event-handler!-procedure-* *-canvasitem.ask-widget-procedure-* *-canvasitem.canvas-* *-canvasitem.name-* *-canvasitem.set-callback!-procedure-* *-canvasitemgroup-structure-size-* *-canvasitemgroup.add-event-handler!-procedure-* *-canvasitemgroup.ask-widget-procedure-* *-canvasitemgroup.canvas-* *-canvasitemgroup.set-callback!-procedure-* *-canvasitemgroup.tag-* *-context-structure-size-* *-context.activebackground-* *-context.activeforeground-* *-context.anchor-* *-context.background-* *-context.border-* *-context.borderwidth-* *-context.foreground-* *-context.relief-* *-drawingsurface-structure-size-* *-drawingsurface.toolkitwindow-* *-drawingsurface.uitkwindow-* *-drawingsurface.weak-list-of-widgets-* *-event-structure-size-* *-event.height-* *-event.offset-* *-event.os-event-* *-event.point-or-rectangle?-* *-event.type-* *-event.width-* *-event.window-* *-glue-structure-size-* *-glue.class-* *-glue.minsize-* *-glue.value-* *-locked-list-structure-size-* *-menuitem-structure-size-* *-menuitem.add-event-handler!-procedure-* *-menuitem.ask-widget-procedure-* *-menuitem.index-* *-menuitem.menurecord-* *-menuitem.set-callback!-procedure-* *-menurecord-structure-size-* *-menurecord.items-* *-menurecord.menu-* *-point-structure-size-* *-point.x-* *-point.y-* *-queue-structure-size-* *-scxl-wrapper-structure-size-* *-scxl-wrapper.other-stuff-* *-scxl-wrapper.strong-dependents-* *-scxl-wrapper.type-* *-scxl-wrapper.wrapped-object-* *-sensitive-surface-structure-size-* *-sensitive-surface.drawingsurface-* *-sensitive-surface.handlers-* *-sensitivity-structure-size-* *-sensitivity.masks-* *-size-structure-size-* *-size.height-* *-size.width-* *-surface-sensitivity-structure-size-* *-surface-sensitivity.mask-* *-surface-sensitivity.sensitivities-* *-surface-sensitivity.weak-surface-* *-texttag-structure-size-* *-texttag.add-event-handler!-procedure-* *-texttag.ask-widget-procedure-* *-texttag.callbacks-* *-texttag.name-* *-texttag.set-callback!-procedure-* *-texttag.text-* *-tk-variable-structure-size-* *-tk-variable.application-* *-tk-variable.callback-* *-tk-variable.tk-name-* *-toolkitwindow-structure-size-* *-toolkitwindow.application-* *-toolkitwindow.tk-window-* *-toolkitwindow.top-level-geometry-callback-* *-uiobjinternals-structure-size-* *-uiobjinternals.add-child!-procedure-* *-uiobjinternals.already-have-a-parent?-* *-uiobjinternals.assign-drawing-surface!-procedure-* *-uiobjinternals.assign-glue!-procedure-* *-uiobjinternals.assign-screen-area!-procedure-* *-uiobjinternals.assigned-screen-area-* *-uiobjinternals.assigned-screen-area-procedure-* *-uiobjinternals.clip-region-* *-uiobjinternals.crud-that-i-dont-want-to-gc-away-* *-uiobjinternals.drawing-surface-* *-uiobjinternals.get-desired-size-procedure-* *-uiobjinternals.handle-event-procedure-* *-uiobjinternals.point-within?-procedure-* *-uiobjinternals.rectangle-overlaps?-procedure-* *-uiobjinternals.remove-child!-procedure-* *-uiobjinternals.set-assigned-screen-area!-procedure-* *-uiobjinternals.set-context!-procedure-* *-uiobjinternals.set-used-screen-area!-procedure-* *-uiobjinternals.used-screen-area-* *-uiobjinternals.used-screen-area-procedure-* *-uitkrectangle-structure-size-* *-uitkrectangle.offset-* *-uitkrectangle.size-* *-uitkwindow-structure-size-* *-uitkwindow.xdisplay-* *-uitkwindow.xwindow-* *all-menus* *all-sensitive-surfaces* *event-processing-mutex* *fil-glue* *fil-glue-class* *fill-glue-class* *our-hash-table* *percent-glue-class* *rigid-glue* *rigid-glue-class* *synchronizing?* *the-default-application* *uitk-interval* *uitk:gc-has-occurred?* *xclosedisplaycallbacks* ->widget ->xcolormap ->xdisplay ->xgc ->xpixel ->xregion ->xwindow active-variable-value add-child! add-event-handler! add-event-handler!-procedure-index add-sub-menu add-to-agenda! add-to-canvas-item-group add-to-menu ;;add-to-protection-list! add-vectors add-widget-list-for-display-number! after-delay after-last-space alert.function alert.reason alert/pp alert? allow-free-trace? application->display application->tkmainwindow application-add-child! application-maker application-remove-child! application-remove-destroyed-child! array-arrange array-box-add-child! array-box-assign-drawing-surface! array-box-assign-glue! array-box-assign-screen-area! array-box-maker array-box-propagator array-get-hglue array-get-vglue array-size array:rearrange ask-widget ask-widget-procedure-index assign-drawing-surface! assign-geometry! assign-glue! assign-location! assign-screen-area! assigned-screen-area atomic-read-and-clear-cell! bit-or box-add-child! box-assign-drawing-surface! box-assign-glue! box-assign-screen-area! box-children box-maker box-remove-child! box:event-propagator box:rearrange button-stretch ;;canvas-flush-protect-list! ;;canvas-protect-from-gc! canvas-stretch ;;canvas-unprotect-from-gc! canvasitem-add-event-handler! canvasitem-ask-widget canvasitem.add-event-handler!-procedure canvasitem.ask-widget-procedure canvasitem.canvas canvasitem.name canvasitem.set-callback!-procedure canvasitem/pp canvasitem? canvasitemgroup-add-event-handler! canvasitemgroup-ask-widget canvasitemgroup.add-event-handler!-procedure canvasitemgroup.ask-widget-procedure canvasitemgroup.canvas canvasitemgroup.set-callback!-procedure canvasitemgroup.tag canvasitemgroup/pp canvasitemgroup? change-sensitive-surface! check-drawing-surface! checkbutton-variable-on? choose-maximum-glue choose-minimum-glue clean-lost-celled-objects ;;clean-lost-protected-objects cleanup-vanished-objects-for-display clear-counters! cleararea clip-region close-lost-displays-daemon color? colormap/colormap colormap/pixel-list compose-glues compute-cumulative-glues conquer-space context-change! context.activebackground context.activeforeground context.anchor context.background context.border context.borderwidth context.foreground context.relief context/pp context? copy-free-traces copy-rectangle copyxregion create-default-context create-sensitive-surface crud-that-i-dont-want-to-gc-away current-size current-time death! debug-print debug-surface debugging-port decode-button-event decode-configure-event decode-crossing-event decode-expose-event decode-key-event decode-motion-event decode-unknown-event decode-window-attributes defer ;;del-assq! ;;del-assv! ;;del-op! delete-<interactor>! delete-menuitem! ;;dequeue! destroy-all-sensitive-surfaces-from-display destroy-associated-tk-widgets destroy-registration destroy-sensitive-surface display->tk-widgets ;;display-protection-list display/colormap-list display/default-root-window display/display display/font-list display/gc-list display/screen/default-color-map display/window-list divide-space do-tk-callbacks do-tk-callbacks-from-string drawarc drawing-surface drawingsurface.application drawingsurface.toolkitwindow drawingsurface.uitkwindow drawingsurface.weak-list-of-widgets drawingsurface/pp drawingsurface? drawline drawrectangle empty-agenda? empty-queue? empty-segments? ;;enqueue! ensure-graphics-context entry-height-stretch event! event-counter event-within? event.height event.offset event.os-event event.point-or-rectangle? event.type event.width event.window event/pp event? fil-glue? fill-glue? fillarc fillrectangle finalize-uitk-objects finalize-uitk-objects-later ;;find-in-protection-list find-menu-record find-real-array-box-children find-sensitivity find-ss ;;find-tk-protection-list ;;find-tk-protection-list-from-number first-segment flush-display-hook flush-queued-output forget! forget-context-change! forget-death-notification! forget-event! forget-geometry-change! fork-to-wait-on gc/gc gc/region generate-events! generate-graphics-context! geometry-change! get-desired-size get-interval-to-next-delayed-event get-interval-to-tk-wakeup get-tk-widget-orientation get-uitkwindow get-window-attributes get-x-event getdefaultvalue glue.class glue.minsize glue.value glue/pp glue? h-arrange h-get-hglue h-get-vglue h-size handle-button-grab handle-event handle-exposure handler->sensitivity idle-queue ignore-repl init-alert init-canvasitem init-canvasitemgroup init-context init-drawingsurface init-event init-glue init-locked-list init-menuitem init-menurecord init-point init-queue init-scxl-wrapper init-sensitive-surface init-sensitivity init-size init-surface-sensitivity init-texttag init-tk-variable init-toolkitwindow init-uiobjinternals init-uitkrectangle init-uitkwindow initial-thread-state initialize-mit-widgets! initialize-scxl! initialize-uitk! initialize-widgets! insert-new-time! interactor-add-child! interactor-maker interactor-remove-child! intersectxregions is-type-wrapped-object kick-uitk-thread kids-lists->complete-kids-lists locked-list/pp locked-list? loop-counter loop-trace make-active-variable make-add-alert! make-agenda make-alert make-alert! make-application make-arc-on-canvas make-arg-transformers make-array-box make-bitmap-on-canvas make-box make-button make-canvas make-canvas-item make-canvas-item-group make-canvasitem make-canvasitemgroup make-checkbutton make-colored-graphics-context make-context make-del-op! make-destroy-<application>-related-objects make-drawingsurface make-drop-rubber-rectangle-surface make-enqueueable-thunk make-entry make-event make-fil-glue make-fill-glue make-filled-circle make-filled-oval make-filled-rectangle make-free-trace make-glue make-hbox make-interactor make-label make-line make-line-on-canvas make-listbox make-locked-list make-lookup make-menu make-menubutton make-menuitem make-menurecord make-message make-oval make-oval-on-canvas make-percent-glue make-point make-point-event make-polygon-on-canvas ;;make-protection-list ;;make-queue make-radiobutton make-rect make-rectangle-event make-rectangle-on-canvas make-remove-alert! make-rigid-glue make-scale make-scaling-line make-scaling-oval make-scaling-rect make-scrollable-canvas make-scrollable-text make-scrollbar make-scxl-wrapper make-self-painting-circle make-self-painting-rectangle make-self-painting-unfilled-rectangle make-sensitive-surface make-sensitivity make-shape make-shape-surface make-simple-graphics-context make-size make-space make-surface-sensitivity make-text make-text-on-canvas make-text-tag make-texttag make-time-segment make-tk-variable make-tk-widget make-toolkitwindow make-top-level-geometry-callback make-uiobjinternals make-uitk-thread make-uitkrectangle make-uitkwindow make-unfilled-circle make-unfilled-oval make-unfilled-rectangle make-unknown-event make-vbox ;;make-weak-del-op! ;;make-weak-lookup make-widget-on-canvas makexregion maybe-defer menuitem-ask-widget menuitem-set-callback! menuitem.add-event-handler!-procedure menuitem.ask-widget-procedure menuitem.index menuitem.menu menuitem.menurecord menuitem.set-callback!-procedure menuitem/pp menuitem? menurecord.items menurecord.menu menurecord/pp menurecord? merge-canvas-item-groups more-counter more-work-to-do mouse-drag on-context-change! on-death! on-event! on-geometry-change! one-parent-only! open-display our-with-thread-mutex-locked parallel-compose-glue parallel-compose-glues percent-glue? pixel/pixel point-event-within? point-event? point-in-rectangle? point-within? point.x point.y point/pp point= point? proc-with-transformed-args ;;protection-list-all-elements ;;protection-list-referenced-elements queue/pp ;;queue? read-and-empty-agenda! read-and-empty-queue! read-queue-trace record-free-pointer record-surface-sensitivity! rectangle->xregion rectangle-event-within? rectangle-event? rectangle-overlaps-rectangle? rectangle-overlaps? rectangle= ;;region-protection-list region/region remember-on-canvas! remove-child! ;;remove-from-protection-list! remove-from-registry reset-sensitivity! rest-segments restart-uitk retract-area rigid-glue? row-lists->col-lists run-queue-trace screen-area= scrollable-canvas-canvas scrollable-canvas-hscroll scrollable-canvas-vscroll scrollable-text-text scrollable-text-vscroll scxl-destroy! scxl-destroyed? scxl-display? scxl-install-xclosedisplay-callback scxl-unwrap scxl-wrap scxl-wrapped? scxl-wrapper.other-stuff scxl-wrapper.strong-dependents scxl-wrapper.type scxl-wrapper.wrapped-object scxl-wrapper/pp scxl-wrapper? ;;search-protection-list segment-queue segment-time segments self-paint! sensitive-surface.drawingsurface sensitive-surface.handlers sensitive-surface/pp sensitive-surface? sensitivity.masks sensitivity/pp sensitivity? series-compose-glue series-compose-glues set-active-variable! set-active-variable-callback! set-alert.function! set-alert.reason! set-assigned-screen-area! set-callback! set-callback!-procedure-index set-canvasitem.add-event-handler!-procedure! set-canvasitem.ask-widget-procedure! set-canvasitem.canvas! set-canvasitem.name! set-canvasitem.set-callback!-procedure! set-canvasitemgroup.add-event-handler!-procedure! set-canvasitemgroup.ask-widget-procedure! set-canvasitemgroup.canvas! set-canvasitemgroup.set-callback!-procedure! set-canvasitemgroup.tag! set-clip-region! set-context! set-context.activebackground! set-context.activeforeground! set-context.anchor! set-context.background! set-context.border! set-context.borderwidth! set-context.foreground! set-context.relief! set-crud-that-i-dont-want-to-gc-away! set-drawing-surface! set-drawingsurface.toolkitwindow! set-drawingsurface.uitkwindow! set-drawingsurface.weak-list-of-widgets! set-event.height! set-event.offset! set-event.os-event! set-event.point-or-rectangle?! set-event.type! set-event.width! set-event.window! set-floating-error-mask! set-gc/region! set-glue.class! set-glue.minsize! set-glue.value! set-menuitem.add-event-handler!-procedure! set-menuitem.ask-widget-procedure! set-menuitem.index! set-menuitem.menurecord! set-menuitem.set-callback!-procedure! set-menurecord.items! set-menurecord.menu! set-point.x! set-point.y! set-scxl-wrapper.other-stuff! set-scxl-wrapper.strong-dependents! set-scxl-wrapper.type! set-scxl-wrapper.wrapped-object! set-segments! set-sensitive-surface.drawingsurface! set-sensitive-surface.handlers! set-sensitivity.masks! set-size.height! set-size.width! set-surface-sensitivity.mask! set-surface-sensitivity.sensitivities! set-surface-sensitivity.weak-surface! set-texttag.add-event-handler!-procedure! set-texttag.ask-widget-procedure! set-texttag.callbacks! set-texttag.name! set-texttag.set-callback!-procedure! set-texttag.text! set-tk-variable.application! set-tk-variable.callback! set-tk-variable.tk-name! set-toolkitwindow.application! set-toolkitwindow.tk-window! set-toolkitwindow.top-level-geometry-callback! set-uiobjinternals.add-child!-procedure! set-uiobjinternals.already-have-a-parent?! set-uiobjinternals.assign-drawing-surface!-procedure! set-uiobjinternals.assign-glue!-procedure! set-uiobjinternals.assign-screen-area!-procedure! set-uiobjinternals.assigned-screen-area! set-uiobjinternals.assigned-screen-area-procedure! set-uiobjinternals.clip-region! set-uiobjinternals.crud-that-i-dont-want-to-gc-away! set-uiobjinternals.drawing-surface! set-uiobjinternals.get-desired-size-procedure! set-uiobjinternals.handle-event-procedure! set-uiobjinternals.point-within?-procedure! set-uiobjinternals.rectangle-overlaps?-procedure! set-uiobjinternals.remove-child!-procedure! set-uiobjinternals.set-assigned-screen-area!-procedure! set-uiobjinternals.set-context!-procedure! set-uiobjinternals.set-used-screen-area!-procedure! set-uiobjinternals.used-screen-area! set-uiobjinternals.used-screen-area-procedure! set-uitkrectangle.offset! set-uitkrectangle.size! set-uitkwindow.xdisplay! set-uitkwindow.xwindow! set-used-screen-area! setclipxregion shape-assign-glue! shape-assign-screen-area! shape-copy shape-draw shape-draw-function shape-erase-maybe shape-maker shape-point-within? shape-rectangle-overlaps? shape-set-color! shape-set-erase-function! shape-set-gc-function! show-counters shut-down-event-server size.height size.width size/pp size= size? string->color stringify-for-tk sub-vectors subtractxregions surface-sensitivity.mask surface-sensitivity.sensitivities surface-sensitivity.weak-surface surface-sensitivity/pp surface-sensitivity? suspend-counter swat-close swat-open swat-open-in-application swat:number->string tcl-global-eval ;;text-flush-protect-list! ;;text-protect-from-gc! ;;text-unprotect-from-gc! texttag-add-event-handler! texttag-ask-widget texttag.add-event-handler!-procedure texttag.ask-widget-procedure texttag.callbacks texttag.name texttag.set-callback!-procedure texttag.text texttag/pp texttag? the-agenda thread-start tk-completely-handles-event? tk-create-top-level-window tk-delete-display tk-doevents tk-gen-name tk-generate-scheme-event tk-has-requested-new-size tk-init tk-invoke-command tk-kill-application tk-make-button tk-make-canvas tk-make-checkbutton tk-make-entry tk-make-label tk-make-listbox tk-make-menu tk-make-menubutton tk-make-message tk-make-radiobutton tk-make-scale tk-make-scrollbar tk-make-text tk-manage-geometry tk-map-window tk-move-resize-widget tk-op tk-unmap-window tk-variable.application tk-variable.callback tk-variable.tk-name tk-variable/pp tk-variable? tk-widget->pathname tk-widget-destroy tk-widget.tkwin tkwidget-add-child! tkwidget-add-event-handler! tkwidget-ask-widget tkwidget-assign-drawing-surface! tkwidget-assign-glue! tkwidget-assign-screen-area! tkwidget-assigned-screen-area tkwidget-get-desired-size tkwidget-maker tkwidget-set-assigned-screen-area! tkwidget-set-callback! tkwidget-set-used-screen-area! tkwidget-used-screen-area tkwin->requested-size tkwin->size tkwin.display tkwin.height tkwin.ismapped? tkwin.name tkwin.pathname tkwin.req-height tkwin.req-width tkwin.width tkwin.window tkwin.x tkwin.y toolkitwindow.application toolkitwindow.tk-window toolkitwindow.top-level-geometry-callback toolkitwindow/pp toolkitwindow? translate-rectangle type-check-wrapped-object uiobj-assign-drawing-surface! uiobj-assign-screen-area! uiobj-assigned-screen-area uiobj-get-desired-size uiobj-handle-event uiobj-point-within? ;;uiobj-protect-from-gc! uiobj-rectangle-overlaps? uiobj-set-assigned-screen-area! uiobj-set-context! uiobj-set-used-screen-area! ;;uiobj-unprotect-from-gc! uiobj-used-screen-area uiobjinternals uiobjinternals-index uiobjinternals.add-child!-procedure uiobjinternals.already-have-a-parent? uiobjinternals.assign-drawing-surface!-procedure uiobjinternals.assign-glue!-procedure uiobjinternals.assign-screen-area!-procedure uiobjinternals.assigned-screen-area uiobjinternals.assigned-screen-area-procedure uiobjinternals.clip-region uiobjinternals.crud-that-i-dont-want-to-gc-away uiobjinternals.drawing-surface uiobjinternals.get-desired-size-procedure uiobjinternals.handle-event-procedure uiobjinternals.point-within?-procedure uiobjinternals.rectangle-overlaps?-procedure uiobjinternals.remove-child!-procedure uiobjinternals.set-assigned-screen-area!-procedure uiobjinternals.set-context!-procedure uiobjinternals.set-used-screen-area!-procedure uiobjinternals.used-screen-area uiobjinternals.used-screen-area-procedure uiobjinternals/pp uiobjinternals? ;;uitk-protection-list uitk-queue uitk-thread uitk-thread-main-loop uitk-timer uitkrectangle.height uitkrectangle.offset uitkrectangle.size uitkrectangle.width uitkrectangle/pp uitkrectangle? uitkwindow.xdisplay uitkwindow.xwindow uitkwindow/pp uitkwindow? unionxregions unwrap-display update-locked-list! used-screen-area v-arrange v-get-hglue v-get-vglue v-size valid-child? valid-color-for-application? valid-color? valid-non-widget? ;;weak-delq! when-idle! when-unreferenced widget->screen-area widget->size widget/widget window/window with-clipping! with-locked-list with-uitk-thread-errors-captured wrap-colormap wrap-display wrap-graphics-context wrap-pixel wrap-region wrap-tk-widget wrap-window wrap-with-scxl-destroy! xallocnamedcolor xchangewindowattributes xcheckmaskevent!? xcleararea xclearwindow xclosedisplay xclosedisplaybynumber xcolor.pixel xconnectionnumber xcopy-event xcreategc xcreateregion xcreatesimplewindow xdecodebuttonevent xdecodeconfigureevent xdecodecrossingevent xdecodeexposeevent xdecodekeyevent xdecodemotionevent xdecodeunknownevent xdecodewindowattributes xdecodexcolor xdefaultcolormap xdefaultrootwindow xdefaultscreen xdestroyregion xdestroywindow xdrawarc xdrawline xdrawrectangle xevent-><event> xevent-type xfillarc xfillrectangle xflush xfreecolormap xfreegc xgetdefault xgetwindowattributes xintersectregion! xloadfont xmake-color xmake-event xmake-gcvalues xmake-setwindowattributes xmapwindow xnextevent xnextevent! xopendisplay xpending xputbackevent xquerypointer xquerytree xscreencount xsetforeground xsetfunction xsetregion xsetwindowattributes-event_mask! xstorename xsubtractregion! xtranslatecoordinates xunionrectspecswithregion! xunionregion! xunloadfont))) (with-working-directory-pathname (directory-pathname (current-load-pathname)) (lambda () (in-package (->environment '(SWAT)) ;; These get overriden when TK is loaded (define (tk-doevents) 'tk-doevents) (define (tk-init dsp) 'tk-init)) ;; Dynamically load the microcode. Order important. (load "dynload/scxl") (load "dynload/tcl") (load "dynload/tk") (load "dynload/uitk") ;; And now the Scheme level ;;(load "scc-macros") ;;(load "uitk-macros") ((access with-directory-rewriting-rule (->environment '(RUNTIME COMPILER-INFO))) (working-directory-pathname) (pathname-as-directory "lib/swat") (lambda () (let ((load (lambda (file) (load file '(SWAT))))) (load "control-floating-errors") (load "structures") (load "structures2") (load "generics") (load "uitk") (load "xlibCONSTANTS") (load "mit-xlib") (load "tk-mit") (load "mit-xhooks") (load "widget-mit") (load "baseobj") (load "widget") (load "geometry") (load "simple") (load "canvas") (load "menu") (load "text") ;;(load "rtest") ;;(load "btest") )))))