conservatory
/
stk
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Commit of 3.99.4 version

This commit is contained in:
Erick Gallesio 1999-02-02 12:13:40 +01:00
parent fd0f8b8984
commit 956ab227cc
317 changed files with 48894 additions and 20439 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
CHANGES
View File

@ -1,4 +1,23 @@
30/09/98 Release 3.99.3
02/02/99 Release 3.99.4
-----------------------
Mains changes/modifications since 3.99.3 are:
* Works on Windows too (need some more testing, since this is
far form perfect)
* A console mode (which is used by default on Windows, but can
be used with the -console option on Unix)
* A new editor with Scheme fontification and indentation
* New kind of ports: virtual ports
* All the code dealing with files has been rewritten.
* As usual, some bug corrections
09/30/98 Release 3.99.3
-----------------------
Mains changes/modifications since 3.99.2 are:

181
ChangeLog
View File

@ -1,3 +1,184 @@
1999-02-02 Erick Gallesio <eg@unice.fr>
* Release 3.99.4: This is the last pre 4.0 version. Code for Win32
is included. The definitive version will follow shortly if people
thinks this version is OK (and when documentation will be updated
:-<)
1999-02-01 Erick Gallesio <eg@unice.fr>
* Lib/font-chooser.stklos: New file.
1999-01-28 Erick Gallesio <eg@unice.fr>
* Lib/ftp.stklos: Changed the ftp code which hanged in some
situations Thanks to David Tillman <dtillman@cannonexpress.com>
for signalling the bug.
1999-01-27 Erick Gallesio <eg@unice.fr>
* configure.in : typos which avoid the compilation of static
libraries.
1999-01-26 Erick Gallesio <eg@unice.fr>
* Lib/console.stk: some console binding have been changed to be less
"alien" with Windows.
1999-01-07 Erick Gallesio <eg@unice.fr>
* Src/stk.h: Acces to float is now direct (i.e. without pointer).
It was not the case to avoid to make too much big cells due to
alignments problems. The trick was to put the union before the
tag (suggested by "Jay Krell" <jay.krell@cornell.edu>. Thanks)
1998-12-27 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Composite/Balloon.stklos (<Help-Balloon>): class
redefined to use the STk layer ballons (defined for the console).
* STklos/Tk/Composite/Schemetext.stklos: Modified to use the new
font-lock code.
1998-12-26 Erick Gallesio <eg@unice.fr>
* Src/signal.c: Finally code for Control-C works (finger crossed),
for the console and for classical xterms. This was a pain to write
it correctly.
* Lib/console.stk: code cleaning and some minor bug corrections.
1998-12-25 Erick Gallesio <eg@unice.fr>
* Src/dynload.c (find_function): Better error message when dynamic
loading fails
1998-12-19 Erick Gallesio <eg@unice.fr>
* Src/error.c (print_message): recursive error seems finally correct ;-)
This was something that was unsatisfying since v2.0 !!!
* Src/unix.c: Changes for MS C compiler provided by jay.krell@cornell.edu
have been applied.
* STklos/Tk/Basics.stklos (Id->instance): typo error
1998-12-10 Erick Gallesio <eg@unice.fr>
* Src/error.c: error management has ben completely changed. This should
be less fragile now.
1998-12-08 Erick Gallesio <eg@unice.fr>
* Lib/tk-init.stk ("edit"): The ed function is now the scheme editor
instead of the old one in file editor.stk
* Lib/text.stk: Deleted the binding for Control-v on Unix. I don't
like that but this allow to be more consistent with others
software which use the windowish Contol-C Control-v Control-X
bindings.
* Lib/tk-init.stk:New functions set-widget-property! and
get-widget-property
1998-12-02 Erick Gallesio <eg@unice.fr>
* Lib/tk-init.stk: Typo correction which prevent the loading of
Tk:get-save-file on Unix.
* STklos/Tk/Text.stklos: Correction of a bug in the initialization
of <Text-window> (generic parent was hidden by a local). Thanks to
Eric Fintzel <tpfintz@fr.ibm.com> for signaling it.
1998-12-01 Erick Gallesio <eg@unice.fr>
* Src/argv.c: New option -console to the interpreter to interact
through a console rather than a xterm. On Windows, the console
will be the implicit way to interact with the interpreter
* Src/console.c:
* Lib/console.stk: New files to implement a console for interacting
with STklos.
* Lib/font-lock.stk: New file. Font-lock doesn't need to load STklos
now.
1998-11-22 Erick Gallesio <eg@unice.fr>
* Src/port.c (STk_copy_port): New primitive: copy-port
* Src/tcl-lib.c : Some cleaning on Tcl channels.
* STklos/Tk/Listbox.stklos (y-view): Method lacks a dot before the
"args" paramter (thanks to Walter C. Pelissero
<wcp@luppolo.lpds.sublink.org> for signaling it).
1998-11-21 Erick Gallesio <eg@unice.fr>
* configure.in : Applied the patch given by Shiro Kawai
<shiro@squareusa.com> for IRIX 6.2.
* Src/port.c: Char-ready is now implemented in io.c which is a
quite natural place ... More code cleaning.
1998-11-19 Erick Gallesio <eg@unice.fr>
* Src/sport.c: New primitive with-error-to-string
* Src/port.c:
- New primitive with-error-to-file (why was it absent?)
- New primitives with-input-from-port, with-output-to-port,
with-error-to-port
- Rewriting of large parts of the file using new primitives.
Src/io.c: has completely be rewritten. It should be faster now
and handle all the kind of port we have: file, strings and
virtual
1998-11-18 Erick Gallesio <eg@unice.fr>
* Lib/text.stk: Pasting with mouse is now correct.
1998-11-10 Erick Gallesio <eg@unice.fr>
* Src/*.c : * Extensions/*.c: Funtions using files heve all been
replaced with port. It means that port, string-ports and virtual
ports are now truly interchangeable. The drawback is that user
code written in C which use files can be BROKEN.
1998-11-05 Erick Gallesio <eg@unice.fr>
* Src/signal.c (STk_send_signal): New primitive.
1998-11-04 Erick Gallesio <eg@unice.fr>
* Src/vport.c: New file which implement virtual ports. A virtual
port can be opened for reading or writing. Functions to access
the port are given by the user as Scheme procedures
* STklos/Tk/Composite/Filebox.stklos : Error messages use a :text
option instead of :message => error messages were not correctly
displayed
1998-10-29 Erick Gallesio <eg@unice.fr>
* Src/port.c (STk_read_line): starts now with a static buffer and
extend it dynamically if needed. Furthermore a potential bug has
been corrceted.
1998-10-22 Erick Gallesio <eg@unice.fr>
* Lib/listbox.stk : 2 typo errors corrected
1998-10-15 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Toplevel.stklos: New generic-function: children and
typo error correction in export list
1998-09-30 Erick Gallesio <eg@unice.fr>
* Release 3.99.3
1998-09-27 Erick Gallesio <eg@unice.fr>
* Src/toplevel.c (init_interpreter): *stk-library* is now

2
Demos/Widget/Wcscroll.stklos
View File

@ -51,7 +51,7 @@
:coords (read-from-string (format #f "(~Ac ~Ac ~Ac ~Ac)"
x y (+ x 2) (+ y 2))))
(make <Text-item> :parent c :text (cons i j) :anchor 'center
:font "fixed"
:font '(Courier -12)
:tags "text" :coords (read-from-string
(format #f "(~Ac ~Ac)"
(+ x 1) (+ y 1))))

264
Demos/Widget/Wfloor.stklos
View File

@ -351,101 +351,101 @@
(define (fg1 w color)
(clearReferences)
(storeReference [w 'create 'polygon 375 246 375 172 341 172 341 246 :fill "" :tags "floor1 room"] "101")
(w 'create 'text 358 209 :text "101" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 358 209 :text "101" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 307 240 339 240 339 206 307 206 :fill "" :tags "floor1 room"] "Pub Lift1")
(w 'create 'text 323 223 :text "Pub Lift1" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 323 223 :text "Pub Lift1" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 339 205 307 205 307 171 339 171 :fill "" :tags "floor1 room"] "Priv Lift1")
(w 'create 'text 323 188 :text "Priv Lift1" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 323 188 :text "Priv Lift1" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 42 389 42 337 1 337 1 389 :fill "" :tags "floor1 room"] "110")
(w 'create 'text 21.5 363 :text "110" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 21.5 363 :text "110" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 59 389 59 385 90 385 90 337 44 337 44 389 :fill "" :tags "floor1 room"] "109")
(w 'create 'text 67 363 :text "109" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 67 363 :text "109" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 300 51 253 6 253 6 300 :fill "" :tags "floor1 room"] "111")
(w 'create 'text 28.5 276.5 :text "111" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 28.5 276.5 :text "111" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 98 248 98 309 79 309 79 248 :fill "" :tags "floor1 room"] "117B")
(w 'create 'text 88.5 278.5 :text "117B" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 88.5 278.5 :text "117B" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 251 51 204 6 204 6 251 :fill "" :tags "floor1 room"] "112")
(w 'create 'text 28.5 227.5 :text "112" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 28.5 227.5 :text "112" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 6 156 51 156 51 203 6 203 :fill "" :tags "floor1 room"] "113")
(w 'create 'text 28.5 179.5 :text "113" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 28.5 179.5 :text "113" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 85 169 79 169 79 192 85 192 :fill "" :tags "floor1 room"] "117A")
(w 'create 'text 82 180.5 :text "117A" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 82 180.5 :text "117A" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 77 302 77 168 53 168 53 302 :fill "" :tags "floor1 room"] "117")
(w 'create 'text 65 235 :text "117" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 65 235 :text "117" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 155 51 115 6 115 6 155 :fill "" :tags "floor1 room"] "114")
(w 'create 'text 28.5 135 :text "114" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 28.5 135 :text "114" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 95 115 53 115 53 168 95 168 :fill "" :tags "floor1 room"] "115")
(w 'create 'text 74 141.5 :text "115" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 74 141.5 :text "115" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 87 113 87 27 10 27 10 113 :fill "" :tags "floor1 room"] "116")
(w 'create 'text 48.5 70 :text "116" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 48.5 70 :text "116" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 89 91 128 91 128 113 89 113 :fill "" :tags "floor1 room"] "118")
(w 'create 'text 108.5 102 :text "118" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 108.5 102 :text "118" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 :fill "" :tags "floor1 room"] "120")
(w 'create 'text 189.5 111.5 :text "120" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 189.5 111.5 :text "120" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 :fill "" :tags "floor1 room"] "122")
(w 'create 'text 131 207.5 :text "122" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 131 207.5 :text "122" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 138 169 154 169 154 191 138 191 :fill "" :tags "floor1 room"] "121")
(w 'create 'text 146 180 :text "121" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 146 180 :text "121" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 99 300 126 300 126 309 99 309 :fill "" :tags "floor1 room"] "106A")
(w 'create 'text 112.5 304.5 :text "106A" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 112.5 304.5 :text "106A" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 128 299 128 309 150 309 150 248 99 248 99 299 :fill "" :tags "floor1 room"] "105")
(w 'create 'text 124.5 278.5 :text "105" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 124.5 278.5 :text "105" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 174 309 174 300 152 300 152 309 :fill "" :tags "floor1 room"] "106B")
(w 'create 'text 163 304.5 :text "106B" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 163 304.5 :text "106B" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 176 299 176 309 216 309 216 248 152 248 152 299 :fill "" :tags "floor1 room"] "104")
(w 'create 'text 184 278.5 :text "104" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 184 278.5 :text "104" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 138 385 138 337 91 337 91 385 :fill "" :tags "floor1 room"] "108")
(w 'create 'text 114.5 361 :text "108" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 114.5 361 :text "108" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 256 337 140 337 140 385 256 385 :fill "" :tags "floor1 room"] "107")
(w 'create 'text 198 361 :text "107" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 198 361 :text "107" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 300 353 300 329 260 329 260 353 :fill "" :tags "floor1 room"] "Smoking")
(w 'create 'text 280 341 :text "Smoking" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 280 341 :text "Smoking" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 314 135 314 170 306 170 306 246 177 246 177 135 :fill "" :tags "floor1 room"] "123")
(w 'create 'text 245.5 190.5 :text "123" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 245.5 190.5 :text "123" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 217 248 301 248 301 326 257 326 257 310 217 310 :fill "" :tags "floor1 room"] "103")
(w 'create 'text 259 287 :text "103" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 259 287 :text "103" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 396 188 377 188 377 169 316 169 316 131 396 131 :fill "" :tags "floor1 room"] "124")
(w 'create 'text 356 150 :text "124" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 356 150 :text "124" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 397 226 407 226 407 189 377 189 377 246 397 246 :fill "" :tags "floor1 room"] "125")
(w 'create 'text 392 217.5 :text "125" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 392 217.5 :text "125" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 399 187 409 187 409 207 474 207 474 164 399 164 :fill "" :tags "floor1 room"] "126")
(w 'create 'text 436.5 185.5 :text "126" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 436.5 185.5 :text "126" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 :fill "" :tags "floor1 room"] "127")
(w 'create 'text 436.5 231 :text "127" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 436.5 231 :text "127" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 :fill "" :tags "floor1 room"] "MShower")
(w 'create 'text 488.5 184 :text "MShower" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 488.5 184 :text "MShower" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 497 176 513 176 513 204 492 204 492 190 497 190 :fill "" :tags "floor1 room"] "Closet")
(w 'create 'text 502.5 190 :text "Closet" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 502.5 190 :text "Closet" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 476 237 476 206 513 206 513 254 488 254 488 237 :fill "" :tags "floor1 room"] "WShower")
(w 'create 'text 494.5 230 :text "WShower" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 494.5 230 :text "WShower" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 :fill "" :tags "floor1 room"] "130")
(w 'create 'text 638.5 205 :text "130" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 638.5 205 :text "130" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 :fill "" :tags "floor1 room"] "102")
(w 'create 'text 367.5 278.5 :text "102" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 367.5 278.5 :text "102" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 397 255 486 255 486 276 397 276 :fill "" :tags "floor1 room"] "128")
(w 'create 'text 441.5 265.5 :text "128" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 441.5 265.5 :text "128" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 :fill "" :tags "floor1 room"] "129")
(w 'create 'text 535.5 293 :text "129" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 535.5 293 :text "129" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 :fill "" :tags "floor1 room"] "133")
(w 'create 'text 628.5 335 :text "133" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 628.5 335 :text "133" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 742 387 742 281 800 281 800 387 :fill "" :tags "floor1 room"] "132")
(w 'create 'text 771 334 :text "132" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 771 334 :text "132" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 800 168 800 280 699 280 699 168 :fill "" :tags "floor1 room"] "134")
(w 'create 'text 749.5 224 :text "134" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 749.5 224 :text "134" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 726 131 726 166 800 166 800 131 :fill "" :tags "floor1 room"] "135")
(w 'create 'text 763 148.5 :text "135" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 763 148.5 :text "135" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 :fill "" :tags "floor1 room"] "Ramona Stair")
(w 'create 'text 368 323 :text "Ramona Stair" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 368 323 :text "Ramona Stair" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 :fill "" :tags "floor1 room"] "University Stair")
(w 'create 'text 155 77.5 :text "University Stair" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 155 77.5 :text "University Stair" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 :fill "" :tags "floor1 room"] "Plaza Stair")
(w 'create 'text 317.5 28.5 :text "Plaza Stair" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 317.5 28.5 :text "Plaza Stair" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 :fill "" :tags "floor1 room"] "Plaza Deck")
(w 'create 'text 303 81 :text "Plaza Deck" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 303 81 :text "Plaza Deck" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 :fill "" :tags "floor1 room"] "106")
(w 'create 'text 131.5 318.5 :text "106" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 131.5 318.5 :text "106" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 :fill "" :tags "floor1 room"] "119")
(w 'create 'text 143.5 133 :text "119" :fill color :anchor "c" :tags "floor1 label" :font "fixed")
(w 'create 'text 143.5 133 :text "119" :fill color :anchor "c" :tags "floor1 label" :font '(Courier -12))
(w 'create 'line 155 191 155 189 :fill color :tags "floor1 wall")
(w 'create 'line 155 177 155 169 :fill color :tags "floor1 wall")
@ -610,107 +610,107 @@
(define (fg2 w color)
(clearReferences)
(storeReference [w 'create 'polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 :fill "" :tags "floor2 room"] "238")
(w 'create 'text 774 195 :text "238" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 774 195 :text "238" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 726 188 746 188 746 166 800 166 800 131 726 131 :fill "" :tags "floor2 room"] "237")
(w 'create 'text 763 148.5 :text "237" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 763 148.5 :text "237" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 :fill "" :tags "floor2 room"] "246")
(w 'create 'text 600 264 :text "246" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 600 264 :text "246" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 694 279 643 279 643 314 694 314 :fill "" :tags "floor2 room"] "247")
(w 'create 'text 668.5 296.5 :text "247" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 668.5 296.5 :text "247" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 :fill "" :tags "floor2 room"] "202")
(w 'create 'text 285.5 260 :text "202" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 285.5 260 :text "202" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 :fill "" :tags "floor2 room"] "206")
(w 'create 'text 143 267 :text "206" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 143 267 :text "206" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 277 6 277 6 338 51 338 :fill "" :tags "floor2 room"] "212")
(w 'create 'text 28.5 307.5 :text "212" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 28.5 307.5 :text "212" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 557 276 486 276 486 309 510 309 510 325 557 325 :fill "" :tags "floor2 room"] "245")
(w 'create 'text 521.5 300.5 :text "245" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 521.5 300.5 :text "245" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 560 389 599 389 599 326 560 326 :fill "" :tags "floor2 room"] "244")
(w 'create 'text 579.5 357.5 :text "244" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 579.5 357.5 :text "244" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 601 389 601 326 643 326 643 389 :fill "" :tags "floor2 room"] "243")
(w 'create 'text 622 357.5 :text "243" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 622 357.5 :text "243" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 688 316 645 316 645 365 688 365 :fill "" :tags "floor2 room"] "242")
(w 'create 'text 666.5 340.5 :text "242" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 666.5 340.5 :text "242" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 802 367 759 367 759 226 802 226 :fill "" :tags "floor2 room"] "Barbecue Deck")
(w 'create 'text 780.5 296.5 :text "Barbecue Deck" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 780.5 296.5 :text "Barbecue Deck" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 755 262 755 314 717 314 717 262 :fill "" :tags "floor2 room"] "240")
(w 'create 'text 736 288 :text "240" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 736 288 :text "240" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 755 316 689 316 689 365 755 365 :fill "" :tags "floor2 room"] "241")
(w 'create 'text 722 340.5 :text "241" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 722 340.5 :text "241" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 755 206 717 206 717 261 755 261 :fill "" :tags "floor2 room"] "239")
(w 'create 'text 736 233.5 :text "239" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 736 233.5 :text "239" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 695 277 643 277 643 206 695 206 :fill "" :tags "floor2 room"] "248")
(w 'create 'text 669 241.5 :text "248" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 669 241.5 :text "248" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 676 135 676 185 724 185 724 135 :fill "" :tags "floor2 room"] "236")
(w 'create 'text 700 160 :text "236" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 700 160 :text "236" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 675 135 635 135 635 145 628 145 628 185 675 185 :fill "" :tags "floor2 room"] "235")
(w 'create 'text 651.5 160 :text "235" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 651.5 160 :text "235" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 :fill "" :tags "floor2 room"] "234")
(w 'create 'text 606 160 :text "234" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 606 160 :text "234" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 :fill "" :tags "floor2 room"] "233")
(w 'create 'text 552.5 158 :text "233" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 552.5 158 :text "233" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 476 249 557 249 557 205 476 205 :fill "" :tags "floor2 room"] "230")
(w 'create 'text 516.5 227 :text "230" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 516.5 227 :text "230" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 476 164 486 164 486 131 525 131 525 185 476 185 :fill "" :tags "floor2 room"] "232")
(w 'create 'text 500.5 158 :text "232" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 500.5 158 :text "232" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 476 186 495 186 495 204 476 204 :fill "" :tags "floor2 room"] "229")
(w 'create 'text 485.5 195 :text "229" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 485.5 195 :text "229" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 474 207 409 207 409 187 399 187 399 164 474 164 :fill "" :tags "floor2 room"] "227")
(w 'create 'text 436.5 185.5 :text "227" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 436.5 185.5 :text "227" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 399 228 399 253 474 253 474 209 409 209 409 228 :fill "" :tags "floor2 room"] "228")
(w 'create 'text 436.5 231 :text "228" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 436.5 231 :text "228" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 397 246 397 226 407 226 407 189 377 189 377 246 :fill "" :tags "floor2 room"] "226")
(w 'create 'text 392 217.5 :text "226" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 392 217.5 :text "226" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 377 169 316 169 316 131 397 131 397 188 377 188 :fill "" :tags "floor2 room"] "225")
(w 'create 'text 356.5 150 :text "225" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 356.5 150 :text "225" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 234 198 306 198 306 249 234 249 :fill "" :tags "floor2 room"] "224")
(w 'create 'text 270 223.5 :text "224" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 270 223.5 :text "224" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 270 179 306 179 306 170 314 170 314 135 270 135 :fill "" :tags "floor2 room"] "223")
(w 'create 'text 292 157 :text "223" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 292 157 :text "223" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 268 179 221 179 221 135 268 135 :fill "" :tags "floor2 room"] "222")
(w 'create 'text 244.5 157 :text "222" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 244.5 157 :text "222" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 177 179 219 179 219 135 177 135 :fill "" :tags "floor2 room"] "221")
(w 'create 'text 198 157 :text "221" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 198 157 :text "221" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 299 327 349 327 349 284 341 284 341 276 299 276 :fill "" :tags "floor2 room"] "204")
(w 'create 'text 324 301.5 :text "204" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 324 301.5 :text "204" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 234 276 297 276 297 327 257 327 257 338 234 338 :fill "" :tags "floor2 room"] "205")
(w 'create 'text 265.5 307 :text "205" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 265.5 307 :text "205" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 256 385 256 340 212 340 212 385 :fill "" :tags "floor2 room"] "207")
(w 'create 'text 234 362.5 :text "207" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 234 362.5 :text "207" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 210 340 164 340 164 385 210 385 :fill "" :tags "floor2 room"] "208")
(w 'create 'text 187 362.5 :text "208" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 187 362.5 :text "208" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 115 340 162 340 162 385 115 385 :fill "" :tags "floor2 room"] "209")
(w 'create 'text 138.5 362.5 :text "209" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 138.5 362.5 :text "209" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 89 228 89 156 53 156 53 228 :fill "" :tags "floor2 room"] "217")
(w 'create 'text 71 192 :text "217" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 71 192 :text "217" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 89 169 97 169 97 190 89 190 :fill "" :tags "floor2 room"] "217A")
(w 'create 'text 93 179.5 :text "217A" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 93 179.5 :text "217A" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 89 156 89 168 95 168 95 135 53 135 53 156 :fill "" :tags "floor2 room"] "216")
(w 'create 'text 71 145.5 :text "216" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 71 145.5 :text "216" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 179 51 135 6 135 6 179 :fill "" :tags "floor2 room"] "215")
(w 'create 'text 28.5 157 :text "215" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 28.5 157 :text "215" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 227 6 227 6 180 51 180 :fill "" :tags "floor2 room"] "214")
(w 'create 'text 28.5 203.5 :text "214" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 28.5 203.5 :text "214" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 51 275 6 275 6 229 51 229 :fill "" :tags "floor2 room"] "213")
(w 'create 'text 28.5 252 :text "213" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 28.5 252 :text "213" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 114 340 67 340 67 385 114 385 :fill "" :tags "floor2 room"] "210")
(w 'create 'text 90.5 362.5 :text "210" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 90.5 362.5 :text "210" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 59 389 59 385 65 385 65 340 1 340 1 389 :fill "" :tags "floor2 room"] "211")
(w 'create 'text 33 364.5 :text "211" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 33 364.5 :text "211" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 393 309 350 309 350 282 342 282 342 276 393 276 :fill "" :tags "floor2 room"] "203")
(w 'create 'text 367.5 292.5 :text "203" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 367.5 292.5 :text "203" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 :fill "" :tags "floor2 room"] "220")
(w 'create 'text 132.5 208.5 :text "220" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 132.5 208.5 :text "220" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 339 205 307 205 307 171 339 171 :fill "" :tags "floor2 room"] "Priv Lift2")
(w 'create 'text 323 188 :text "Priv Lift2" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 323 188 :text "Priv Lift2" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 307 240 339 240 339 206 307 206 :fill "" :tags "floor2 room"] "Pub Lift 2")
(w 'create 'text 323 223 :text "Pub Lift 2" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 323 223 :text "Pub Lift 2" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 175 168 97 168 97 131 175 131 :fill "" :tags "floor2 room"] "218")
(w 'create 'text 136 149.5 :text "218" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 136 149.5 :text "218" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 154 191 111 191 111 169 154 169 :fill "" :tags "floor2 room"] "219")
(w 'create 'text 132.5 180 :text "219" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 132.5 180 :text "219" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 375 246 375 172 341 172 341 246 :fill "" :tags "floor2 room"] "201")
(w 'create 'text 358 209 :text "201" :fill color :anchor "c" :tags "floor2 label" :font "fixed")
(w 'create 'text 358 209 :text "201" :fill color :anchor "c" :tags "floor2 label" :font '(Courier -12))
(w 'create 'line 641 186 678 186 :fill color :tags "floor2 wall")
(w 'create 'line 757 350 757 367 :fill color :tags "floor2 wall")
@ -870,71 +870,71 @@
(define (fg3 w color)
(clearReferences)
(storeReference [w 'create 'polygon 89 228 89 180 70 180 70 228 :fill "" :tags "floor3 room"] "316")
(w 'create 'text 79.5 204 :text "316" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 79.5 204 :text "316" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 115 368 162 368 162 323 115 323 :fill "" :tags "floor3 room"] "309")
(w 'create 'text 138.5 345.5 :text "309" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 138.5 345.5 :text "309" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 164 323 164 368 211 368 211 323 :fill "" :tags "floor3 room"] "308")
(w 'create 'text 187.5 345.5 :text "308" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 187.5 345.5 :text "308" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 256 368 212 368 212 323 256 323 :fill "" :tags "floor3 room"] "307")
(w 'create 'text 234 345.5 :text "307" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 234 345.5 :text "307" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 244 276 297 276 297 327 260 327 260 321 244 321 :fill "" :tags "floor3 room"] "305")
(w 'create 'text 270.5 301.5 :text "305" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 270.5 301.5 :text "305" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 251 219 251 203 244 203 244 219 :fill "" :tags "floor3 room"] "324B")
(w 'create 'text 247.5 211 :text "324B" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 247.5 211 :text "324B" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 251 249 244 249 244 232 251 232 :fill "" :tags "floor3 room"] "324A")
(w 'create 'text 247.5 240.5 :text "324A" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 247.5 240.5 :text "324A" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 223 135 223 179 177 179 177 135 :fill "" :tags "floor3 room"] "320")
(w 'create 'text 200 157 :text "320" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 200 157 :text "320" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 114 368 114 323 67 323 67 368 :fill "" :tags "floor3 room"] "310")
(w 'create 'text 90.5 345.5 :text "310" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 90.5 345.5 :text "310" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 23 277 23 321 68 321 68 277 :fill "" :tags "floor3 room"] "312")
(w 'create 'text 45.5 299 :text "312" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 45.5 299 :text "312" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 23 229 68 229 68 275 23 275 :fill "" :tags "floor3 room"] "313")
(w 'create 'text 45.5 252 :text "313" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 45.5 252 :text "313" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 68 227 23 227 23 180 68 180 :fill "" :tags "floor3 room"] "314")
(w 'create 'text 45.5 203.5 :text "314" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 45.5 203.5 :text "314" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 95 179 95 135 23 135 23 179 :fill "" :tags "floor3 room"] "315")
(w 'create 'text 59 157 :text "315" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 59 157 :text "315" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 99 226 99 204 91 204 91 226 :fill "" :tags "floor3 room"] "316B")
(w 'create 'text 95 215 :text "316B" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 95 215 :text "316B" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 91 202 99 202 99 180 91 180 :fill "" :tags "floor3 room"] "316A")
(w 'create 'text 95 191 :text "316A" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 95 191 :text "316A" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 :fill "" :tags "floor3 room"] "319")
(w 'create 'text 141.5 209 :text "319" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 141.5 209 :text "319" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 :fill "" :tags "floor3 room"] "311")
(w 'create 'text 29.5 361 :text "311" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 29.5 361 :text "311" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 154 191 111 191 111 169 154 169 :fill "" :tags "floor3 room"] "318")
(w 'create 'text 132.5 180 :text "318" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 132.5 180 :text "318" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 175 168 97 168 97 131 175 131 :fill "" :tags "floor3 room"] "317")
(w 'create 'text 136 149.5 :text "317" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 136 149.5 :text "317" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 274 194 274 221 306 221 306 194 :fill "" :tags "floor3 room"] "323")
(w 'create 'text 290 207.5 :text "323" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 290 207.5 :text "323" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 306 222 274 222 274 249 306 249 :fill "" :tags "floor3 room"] "325")
(w 'create 'text 290 235.5 :text "325" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 290 235.5 :text "325" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 263 179 224 179 224 135 263 135 :fill "" :tags "floor3 room"] "321")
(w 'create 'text 243.5 157 :text "321" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 243.5 157 :text "321" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 :fill "" :tags "floor3 room"] "322")
(w 'create 'text 293.5 163.5 :text "322" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 293.5 163.5 :text "322" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 307 240 339 240 339 206 307 206 :fill "" :tags "floor3 room"] "Pub Lift3")
(w 'create 'text 323 223 :text "Pub Lift3" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 323 223 :text "Pub Lift3" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 339 205 307 205 307 171 339 171 :fill "" :tags "floor3 room"] "Priv Lift3")
(w 'create 'text 323 188 :text "Priv Lift3" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 323 188 :text "Priv Lift3" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 350 284 376 284 376 276 397 276 397 309 350 309 :fill "" :tags "floor3 room"] "303")
(w 'create 'text 373.5 292.5 :text "303" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 373.5 292.5 :text "303" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 :fill "" :tags "floor3 room"] "324")
(w 'create 'text 262 226 :text "324" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 262 226 :text "324" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 299 276 299 327 349 327 349 284 341 284 341 276 :fill "" :tags "floor3 room"] "304")
(w 'create 'text 324 301.5 :text "304" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 324 301.5 :text "304" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 375 246 375 172 341 172 341 246 :fill "" :tags "floor3 room"] "301")
(w 'create 'text 358 209 :text "301" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 358 209 :text "301" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 397 246 377 246 377 185 397 185 :fill "" :tags "floor3 room"] "327")
(w 'create 'text 387 215.5 :text "327" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 387 215.5 :text "327" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 316 131 316 169 377 169 377 185 397 185 397 131 :fill "" :tags "floor3 room"] "326")
(w 'create 'text 356.5 150 :text "326" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 356.5 150 :text "326" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 :fill "" :tags "floor3 room"] "302")
(w 'create 'text 319.5 261 :text "302" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 319.5 261 :text "302" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(storeReference [w 'create 'polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 :fill "" :tags "floor3 room"] "306")
(w 'create 'text 200.5 284.5 :text "306" :fill color :anchor "c" :tags "floor3 label" :font "fixed")
(w 'create 'text 200.5 284.5 :text "306" :fill color :anchor "c" :tags "floor3 label" :font '(Courier -12))
(w 'create 'line 341 275 341 283 :fill color :tags "floor3 wall")
(w 'create 'line 162 197 155 197 :fill color :tags "floor3 wall")

10
Demos/amib.stklos
View File

@ -4,7 +4,7 @@
;;;; a m i b . s t k l o s -- A mini interface builder. I hope it will serve
;;;; as the basis of something more complete...
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -17,7 +17,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 22-May-1995 14:56
;;;; Last file update: 3-Mar-1998 22:50
;;;; Last file update: 1-Feb-1999 17:56
(require "Tk-classes")
@ -331,7 +331,8 @@
(let* ((f (make <Frame> :parent parent :relief "groove" :border-width 2))
(val (get-keyword :side old-packing-options "top"))
(v (make-var 'side val)))
(pack (make <Label> :text "Side: " :parent f :font "fixed") :side "left")
(pack (make <Label> :text "Side: " :parent f :font '(Courier -12))
:side "left")
(for-each (lambda (x)
(pack (make <Radio-button> :parent f :text x :variable v
:value x :command change-pack-opt)
@ -358,7 +359,8 @@
(let* ((f (make <Frame> :parent parent :relief "groove" :border-width 2))
(val (get-keyword :fill old-packing-options "none"))
(v (make-var 'fill val)))
(pack (make <Label> :text "Fill: " :parent f :font "fixed") :side "left")
(pack (make <Label> :text "Fill: " :parent f :font '(Courier -12))
:side "left")
(for-each (lambda (x)
(pack (make <Radio-button> :parent f :text x :variable v
:value x :command change-pack-opt)

14
Demos/browse.stk
View File

@ -8,11 +8,11 @@
;;;; double-clicking.
;;;; This is a new version of the demo which can be run before STk is installed
;;;;
;;;; $Id: browse.stk 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;; $Id: browse.stk 1.4 Tue, 02 Feb 1999 09:04:21 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Aug-1993 17:33
;;;; Last file update: 12-Feb-1998 11:28
;;;; Last file update: 2-Feb-1999 08:45
(require "unix")
@ -21,7 +21,7 @@
(frame '.f)
(scrollbar '.f.scroll :command (lambda l (apply .f.list 'yview l)))
(listbox '.f.list :yscroll (lambda l (apply .f.scroll 'set l))
:width 30 :height 20 :font "fixed")
:width 30 :height 20 :font '(Courier -12))
(pack .f.scroll .f.list :side "right" :expand #t :fill "both")
(pack .f :side "top" :fill "both" :expand #t)
@ -37,12 +37,18 @@
(.f.list 'delete 0 "end")
(apply .f.list 'insert 0 (sort (glob "*" ".*") string<?)))
(define (edit-file file)
(if (eqv? (os-kind) 'Unix)
(system (string-append "xedit " file "&"))
(system (string-append "notepad " file))))
(define (browse)
(catch
(let ((file (string-append (getcwd) "/" (selection 'get))))
(cond
((file-is-directory? file) (fill-listbox file))
((file-is-readable? file) (system (string-append "xedit " file "&")))
((file-is-readable? file) (edit-file file))
(else (error "Bad directory or file ~S" file))))))

13
Demos/browse.stklos
View File

@ -7,11 +7,11 @@
;;;; directory and allows you to open files or subdirectories by
;;;; double-clicking.
;;;;
;;;; $Id: browse.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;; $Id: browse.stklos 1.4 Tue, 02 Feb 1999 09:04:21 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Aug-1993 17:33
;;;; Last file update: 12-Feb-1998 11:28
;;;; Last file update: 2-Feb-1999 08:45
(require "Tk-classes")
(require "unix")
@ -19,7 +19,7 @@
;;;;
;;;; Interface
;;;;
(define lb (make <Scroll-Listbox> :width 30 :height 20 :font 'fixed))
(define lb (make <Scroll-Listbox> :width 30 :height 20 :font '(Courier -12)))
(pack lb :fill "both" :side "top" :expand #t)
(define quit (make <Button> :text "Quit" :command '(exit)))
@ -33,12 +33,17 @@
(delete lb 0 'end)
(apply insert lb 0 (sort (glob "*" ".*") string<?)))
(define (edit-file file)
(if (eqv? (os-kind) 'Unix)
(system (string-append "xedit " file "&"))
(system (string-append "notepad " file))))
(define (browse)
(catch
(let ((file (string-append (getcwd) "/" (selection 'get))))
(cond
((file-is-directory? file) (fill-listbox lb file))
((file-is-readable? file) (system (string-append "xedit " file "&")))
((file-is-readable? file) (edit-file file))
(else (error "Bad directory or file ~S" file))))))

7
Demos/colormap.stk
View File

@ -1,7 +1,7 @@
#!/bin/sh
:;exec /usr/local/bin/stk -f "$0" "$@"
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -13,7 +13,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 19-Aug-1993 15:08
;;;; Last file update: 24-Feb-1998 11:50
;;;; Last file update: 1-Feb-1999 18:34
(define Color "#000000")
(define V (vector 0 0 0))
@ -39,7 +39,8 @@
(pack
[frame '.f :relief "raised" :bd 2]
[frame '.sample :width 30 :height 50 :bg Color]
[label '.color :font "fixed" :textvariable 'Color :relief "ridge" :bd 4]
[label '.color :font '(helvetica 10) :textvariable 'Color
:relief "ridge" :bd 4]
[button '.quit :text "Quit" :command (lambda ()
(format #t "color=~A~%" Color)
(destroy *root*))]

8
Demos/filebox.stklos
View File

@ -3,7 +3,7 @@
;;;;
;;;; f i l e b o x . s t k l o s -- A demo of the <FileBox> class
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -16,16 +16,16 @@
;;;; This software is a derivative work of other copyrighted softwares; the
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
;;;;
;;;; $Id: filebox.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;; $Id: filebox.stklos 1.3 Tue, 02 Feb 1999 15:29:27 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: 12-Jun-1994 11:24
;;;; Last file update: 12-Feb-1998 11:27
;;;; Last file update: 2-Feb-1999 13:56
(require "Tk-classes")
;; Just create a filebox and return the selected value
(let ((result (Tk:get-file)))
(let ((result (Tk:get-open-file)))
(apply format #t (if result
(list "You have selected the file ~S\n" result)
(list "CANCEL. No file selected\n")))

6
Demos/hanoi.stk
View File

@ -55,7 +55,8 @@
(frame ".nrframe" :bd 2 :relief 'raised)
(pack [label ".nrframe.label" :text "Number of Rings: " :width 15 :anchor 'e]
:side "left")
(pack [scale ".nrframe.scale" :orient 'hor :from 1 :to max-rings :font "fixed"
(pack [scale ".nrframe.scale" :orient 'hor :from 1 :to max-rings
:font '(Courier -12)
:command (lambda (val)
(set! num-rings val))]
:side "right" :expand #t :fill "x")
@ -67,7 +68,8 @@
(frame ".speed-frame" :bd 2 :relief 'raised)
(pack [label ".speed-frame.label" :text "Speed: " :width 15 :anchor 'e]
:side "left")
(pack [scale ".speed-frame.scale" :orient 'hor :from 1 :to 100 :font "fixed"
(pack [scale ".speed-frame.scale" :orient 'hor :from 1 :to 100
:font '(Courier -12)
:command (lambda (val)
(set! accel val))]
:side "right" :expand #t :fill "x")

6
Demos/stklos-demo.stklos
View File

@ -2,7 +2,7 @@
;;;;
;;;; s t k l o s - d e m o . s t k -- A demo which use some STklos classes
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -14,7 +14,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 24-Aug-1993 19:55
;;;; Last file update: 3-Mar-1998 17:18
;;;; Last file update: 2-Feb-1999 08:45
(require "Tk-classes")
@ -30,7 +30,7 @@
(define f (make <Frame>))
(define l (make <Label> :parent f :text "A simple demo written in STklos"))
(define c (make <Canvas> :parent f :relief "groove" :height 400 :width 700))
(define m (make <Label> :parent f :font "fixed" :justify 'left
(define m (make <Label> :parent f :font '(Courier -12) :justify 'left
:foreground "red"
:text "Left button to move squares.
Right button to move circles"))

6
Demos/stklos-demo2.stklos
View File

@ -2,7 +2,7 @@
;;;;
;;;; s t k l o s - d e m o 2 . s t k -- A demo which use some STklos classes
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -14,7 +14,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 24-Aug-1993 19:55
;;;; Last file update: 3-Mar-1998 17:21
;;;; Last file update: 2-Feb-1999 08:45
(require "Tk-classes")
@ -22,7 +22,7 @@
(define f (make <Frame>))
(define l (make <Label> :parent f :text "A simple demo written in STklos"))
(define c (make <Canvas> :parent f :relief "groove" :height 400 :width 700))
(define m (make <Label> :parent f :font "fixed" :justify 'left
(define m (make <Label> :parent f :font '(Courier -12) :justify 'left
:text "This demo file illustrates the use of bind-for-dragging with various parameters:
- Left button to drag any kind of object.
- Left button with Shift key pressed to drag an object and executes user hooks

10
Demos/stklos-widgets.stklos
View File

@ -89,13 +89,17 @@
(f (make <Frame> :parent top))
(txt (make <Label> :parent top
:text "Place the mouse on a button\n and wait a while"))
(h (make <Help-Balloon>)))
(h (make <Help-Balloon> :background "#ffffb9")))
(for-each (lambda (x)
(let ((b (make <Button> :parent f :text x :side "left")))
(add-balloon h b (format #f "This is ~S" x))
(add-balloon h b (format #f "This is the help\nof\n~S" x))
(pack b :side "left")))
'("Button1" "Button2" "Button3" "Button4" "Button5" "Button6"))
(pack f )
(pack (make <Button> :text "Balloons" :parent f :width 10
:command activate-balloons))
(pack (make <Button> :text "No Balloons" :parent f :width 10
:command deactivate-balloons))
(pack f)
(pack txt :expand #t :fill "both")))
;=============================================================================

3
Demos/widget.stk
View File

@ -69,7 +69,8 @@
:geometry "+400+400"))
(but (make <Frame> :parent top))
(txt (make <Scheme-text> :parent top :wrap "none"
:h-scroll-side "bottom" :width 85 :height 30 :font "fixed"
:h-scroll-side "bottom" :font '(Courier -12)
:width 85 :height 30
:value (exec (string-append "cat " file)))))
(pack txt :side "top" :expand #t :fill "both")

BIN
Doc/Isotas96/Isotas96.dvi
View File

Binary file not shown.

7433
Doc/Isotas96/Isotas96.ps
View File

File diff suppressed because it is too large Load Diff

11
Doc/Reference/Appendix-E.tex
View File

@ -3,7 +3,7 @@
%
% Author: Erick Gallesio [eg@unice.fr]
% Creation date: 21-Dec-1997 20:09
% Last file update: 30-Sep-1998 13:56
% Last file update: 2-Feb-1999 15:25
%
\section*{Introduction}
@ -16,9 +16,16 @@ the various recent versions of STk. Differences with older versions
as well as implementation changes are described in the CHANGES file
located in the main directory of the STk distribution.
\section*{Release 3.99.4}
\small{\emph{Release date: 02/02/99}}
Mains changes/modifications since 3.99.3:
\begin{itemize}
\item Virtuals ports
\end{itemize}
\section*{Release 3.99.3}
\small{\emph{Release date: 09/30/98}}
Mains changes/modifications since 3.99.2 are:
Mains changes/modifications since 3.99.2:
\begin{itemize}
\item Tk version is 8.0.3

BIN
Doc/Reference/manual.dvi
View File

Binary file not shown.

17167
Doc/Reference/manual.ps
View File

File diff suppressed because it is too large Load Diff

14
Extensions/base64.c
View File

@ -13,9 +13,11 @@
* permission of the copyright holder.
* This software is provided ``as is'' without express or implied warranty.
*
* $Id: base64.c 1.3 Wed, 18 Nov 1998 16:16:26 +0100 eg $
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 20-Jul-1998 12:19
* Last file update: 20-Jul-1998 19:40
* Last file update: 10-Nov-1998 23:40
*/
#include <stk.h>
@ -32,10 +34,10 @@ static void initialize_rev_table(void)
char *p;
int count = 0;
for (p = table; *p; p++) rev_table[*p] = count++;
for (p = table; *p; p++) rev_table[(int) *p] = count++;
}
static void encode(FILE *f, FILE *g)
static void encode(SCM f, SCM g)
{
int c, state, count, old;
@ -65,7 +67,7 @@ static void encode(FILE *f, FILE *g)
}
}
static void decode(FILE *f, FILE *g)
static void decode(SCM f, SCM g)
{
static int initialized = 0;
int c, bits, group, j;
@ -106,7 +108,7 @@ static PRIMITIVE base64_encode(SCM f, SCM g)
else
if (!OUTP(g)) Serror("bad output port", g);
encode(PORT_FILE(f), PORT_FILE(g));
encode(f, g);
return UNDEFINED;
}
@ -120,7 +122,7 @@ static PRIMITIVE base64_decode(SCM f, SCM g)
else
if (!OUTP(g)) Serror("bad output port", g);
decode(PORT_FILE(f), PORT_FILE(g));
decode(f, g);
return UNDEFINED;
}

10
Extensions/hash.c
View File

@ -16,10 +16,11 @@
* This software is a derivative work of other copyrighted softwares; the
* copyright notices of these softwares are placed in the file COPYRIGHTS
*
* $Id: hash.c 1.4 Mon, 28 Dec 1998 23:05:11 +0100 eg $
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 17-Jan-1994 17:49
* Last file update: 15-Jul-1998 17:34
* Last file update: 27-Dec-1998 20:19
*/
#include <stk.h>
@ -141,7 +142,7 @@ static SCM find_key(SCM obj, SCM alist, SCM comparison)
*/
static SCM remove_key(SCM obj, SCM alist, SCM comparison)
{
register SCM l, tmp;
register SCM l;
for(l=NIL; !NULLP(alist); alist=CDR(alist)) {
if (STk_apply(comparison, LIST2(obj, CAR(CAR(alist)))) == Ntruth)
@ -446,11 +447,12 @@ static PRIMITIVE hash_table_stats(SCM ht)
*/
if (Tcl_FirstHashEntry(HASH_H(ht), &search)) {
s = Tcl_HashStats(HASH_H(ht));
fprintf(STk_stderr, "%s\n", s);
Puts(s, STk_curr_eport);
Putc('\n', STk_curr_eport);
free(s);
}
else
fprintf(STk_stderr, "Empty hash table\n");
Puts("Empty hash table\n", STk_curr_eport);
return UNDEFINED;
}

17
Extensions/html.c
View File

@ -13,11 +13,11 @@
* permission of the copyright holder.
* This software is provided ``as is'' without express or implied warranty.
*
*
* $Id: html.c 1.4 Mon, 28 Dec 1998 23:05:11 +0100 eg $
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 1-Sep-1995 23:10
* Last file update: 28-May-1998 21:57
* Last file update: 27-Dec-1998 20:20
*/
#include <ctype.h>
@ -67,7 +67,7 @@ static struct char_type table [] = {
{"yacute", '\xfd'}, {"thorn", '\xfe'}, {"yuml", '\xff'},
{"", 0}};
static void skip_spaces(FILE *f)
static void skip_spaces(SCM f)
{
int c;
@ -82,7 +82,7 @@ static void skip_spaces(FILE *f)
}
/* next_entity: Read an entity such as <A HREF=x.html> */
static SCM next_entity(FILE *f)
static SCM next_entity(SCM f)
{
Tcl_DString dStr1, dStr2;
int c;
@ -120,7 +120,7 @@ static SCM next_entity(FILE *f)
/* Read an entity such as &amp; */
static void next_character(Tcl_DString *dStr, FILE *f)
static void next_character(Tcl_DString *dStr, SCM f)
{
char *t, ch, token[MAXTOKEN];
int c, i;
@ -169,16 +169,13 @@ static void next_character(Tcl_DString *dStr, FILE *f)
}
static PRIMITIVE html_next_token(SCM iport) /* Return next HTML token */
static PRIMITIVE html_next_token(SCM f) /* Return next HTML token */
{
int c;
FILE *f;
ENTER_PRIMITIVE("%html:next-token");
if (!INP(iport)) Serror("bad port", iport);
f = PORT_FILE(iport);
if (!INP(f)) Serror("bad port", f);
if (Eof(f) || ((c = Getc(f)) == EOF)) return STk_eof_object;

6
Extensions/posix.c
View File

@ -16,11 +16,11 @@
* This software is a derivative work of other copyrighted softwares; the
* copyright notices of these softwares are placed in the file COPYRIGHTS
*
* $Id: posix.c 1.2 Thu, 10 Sep 1998 23:44:28 +0200 eg $
* $Id: posix.c 1.3 Wed, 18 Nov 1998 16:16:26 +0100 eg $
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 14-Mar-1995 20:14
* Last file update: 10-Sep-1998 15:06
* Last file update: 10-Nov-1998 23:35
*
* This file contains also contains code additions from Shiro Kawai
* <shiro@sqush.squareusa.com>
@ -221,7 +221,7 @@ static void display_Cpointer_tm(SCM obj, SCM port, int mode)
sprintf(STk_tkbuffer, "#<C-struct tm %02d/%02d/%02d %02d:%02d:%02d>",
p->tm_mon, p->tm_mday, p->tm_year,
p->tm_hour, p->tm_min, p->tm_sec);
Puts(STk_tkbuffer, PORT_FILE(port));
Puts(STk_tkbuffer, port);
}
static PRIMITIVE posix_time(void)

7
Extensions/process.c
View File

@ -350,7 +350,7 @@ static PRIMITIVE run_process(SCM l, int len)
execvp(*argv, argv);
/* Cannot exec if we are here */
fprintf(STk_stderr, "**** Cannot exec %s!\n", *argv);
Fprintf(STk_curr_eport, "**** Cannot exec %s!\n", *argv);
exit(1);
default: /* Father */
info->pid = pid;
@ -374,8 +374,6 @@ static PRIMITIVE run_process(SCM l, int len)
sprintf(msg, "pipe-%s-%d", stdStreams[i], pid);
STk_disallow_sigint();
s = (char *) must_malloc(strlen(msg)+1);
strcpy(s, msg);
@ -383,7 +381,6 @@ static PRIMITIVE run_process(SCM l, int len)
f,
(i==0) ? tc_oport : tc_iport,
0);
STk_allow_sigint();
}
}
}
@ -566,7 +563,7 @@ static void free_process(SCM process)
static void process_display(SCM obj, SCM port, int mode)
{
sprintf(STk_tkbuffer, "#<process PID=%d>", PROCPID(obj));
Puts(STk_tkbuffer, PORT_FILE(port));
Puts(STk_tkbuffer, port);
}

8
Extensions/socket.c
View File

@ -9,7 +9,7 @@
*
* Win32 support by Caleb Deupree <cdeupree@erinet.com>
*
* Last file update: 10-Sep-1998 15:17
* Last file update: 20-Dec-1998 10:34
*/
@ -81,8 +81,6 @@ static void set_socket_io_ports(int s, SCM sock, char *who)
FILE *fs, *ft;
char buffer[200];
STk_disallow_sigint();
#ifdef WIN32
{
int r;
@ -124,8 +122,6 @@ static void set_socket_io_ports(int s, SCM sock, char *who)
/* Create output port */
SOCKET(sock)->output = STk_Cfile2port(strdup(fname), ft, tc_oport, 0);
STk_allow_sigint();
}
/******************************************************************************
@ -491,7 +487,7 @@ static void displ_socket(SCM sock, SCM port, int mode)
sprintf(STk_tkbuffer, "#[socket %s %d]",
(s->hostname == Ntruth)?"*none*": CHARS(s->hostname),
s->portnum);
Puts(STk_tkbuffer, PORT_FILE(port));
Puts(STk_tkbuffer, port);
}
static STk_extended_scheme_type socket_type = {

4
INSTALL
View File

@ -3,6 +3,10 @@
+-----------------------------+
** This is the Unix INSTALL file. For Windows platform, please look at the
** INSTALL.win32 file
IMPORTANT NOTE - IMPORTANT NOTE - IMPORTANT NOTE
------------------------------------------------
|

59
INSTALL.win32 Normal file
View File

@ -0,0 +1,59 @@
+-----------------------------+
| STk 3.99 Installation notes |
+-----------------------------+
** This is the Windous INSTALL file. For Unix platform, please look at the
** INSTALL file
INSTALLATION NOTES
------------------
STk 3.99.4 has been compiled on Win32 using the VC 5.0 compiler. File
necessary for compiling it are in the Win32 directory.
Since, I know nearly nothing on this environment, please, tell me how to make
the distribution more convenient (I know it is not ;^).
One the package is compiled, you have to install it (you cannot test
it without installing it). This can be done by using the install.bat
script in the main directory. Give to this script the directory wher
you want to install STk. For instance:
C:> install C:\STk
will install all the necessary files in the C:\STk directory.
STk doesn't use the registry mechanism, so de-installing it just
consist in deleting the installation directory.
WIN32 BINARY RELEASE
--------------------
Win32 binary release are available from http://kaolin.unice.fr/STk.
HELP NEEDED
-----------
As I said before, I'm far from an expert on the Win32 environment. In
particular, I know absolutely nothing about DLL creation, compiler
environment or common customs in this environment. Any help on these
topic (or any topic btw :-) is welcome.
BTW, Some people sent me some stuff about DLL for 3.1.1. I was not able to
integrate it for 3.99 releases. I can provide this stuff if needed...
Erick Gallesio
Tue Feb 21 1999

BIN
Lib/Images/LineLeft.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.0 KiB

BIN
Lib/Images/LineRight.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1019 B

BIN
Lib/Images/STk-big-logo.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 65 KiB

BIN
Lib/Images/STk-logo.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 7.5 KiB

BIN
Lib/Images/STk-small-logo.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.8 KiB

BIN
Lib/Images/STk-tiny-logo.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
Lib/Images/border.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 105 B

BIN
Lib/Images/box-minus.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 88 B

14
Lib/Images/box-minus.xpm
View File

@ -1,14 +0,0 @@
/* XPM */
static char * box_minux_xpm[] = {
"9 9 2 1",
" c black",
". c white",
" ",
" ....... ",
" ....... ",
" ....... ",
" . . ",
" ....... ",
" ....... ",
" ....... ",
" "};

BIN
Lib/Images/box-plus.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 88 B

14
Lib/Images/box-plus.xpm
View File

@ -1,14 +0,0 @@
/* XPM */
static char * box_plus_xpm[] = {
"9 9 2 1",
" c black",
". c white",
" ",
" ....... ",
" ... ... ",
" ... ... ",
" . . ",
" ... ... ",
" ... ... ",
" ....... ",
" "};

BIN
Lib/Images/clipboard.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/colorline.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 479 B

BIN
Lib/Images/colors.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/console.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/copy.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 204 B

BIN
Lib/Images/customize.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 204 B

BIN
Lib/Images/cut.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 204 B

BIN
Lib/Images/dir.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/dir.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 859 B

24
Lib/Images/dir.xpm
View File

@ -1,24 +0,0 @@
/* XPM */
static char * dir_xpm[] = {
"16 16 5 1",
" s None c None",
". c grey51",
"X c goldenrod1",
"o c white",
"O c grey4",
" ",
" ..... ",
" .XXXXX. ",
".XXXXXXX...... ",
".oooooooooooo.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
".oXXXXXXXXXXX.O ",
"..............O ",
" OOOOOOOOOOOOOO ",
" ",
" "};

BIN
Lib/Images/diropen.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

25
Lib/Images/diropen.xpm
View File

@ -1,25 +0,0 @@
/* XPM */
static char * diropen_xpm[] = {
"16 16 5 1",
" s None c None",
". c grey51",
"X c white",
"o c goldenrod1",
"O c grey4",
" ",
" .... ",
" .XXXX. ",
" .XooooX...... ",
" .XoooooXXXXX.O ",
" .Xoooooooooo.O ",
"...........oo.O ",
".XXXXXXXXX.Oo.O ",
".XoooooooooO..O ",
" .Xoooooooo.O.O ",
" .XoooooooooO.O ",
" .Xoooooooo.OO ",
" ...........OO ",
" OOOOOOOOOOOO ",
" ",
" "};

BIN
Lib/Images/edit.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/error.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

64
Lib/Images/error.xpm
View File

@ -1,64 +0,0 @@
/* XPM */
static char * error_xpm[] = {
/* width height ncolors chars_per_pixel */
"48 48 10 1",
/* colors */
" s None c None",
". c #999999",
"X c black",
"o c #111111",
"O c #333333",
"+ c white",
"@ c #FF6666",
"# c yellow",
"$ c #DDDDDD",
"% c #BBBBBB",
/* pixels */
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" ",
" .XX.XX. ",
" o.XX.XX.o ",
" XX XX. ",
" . XX ",
" . XX ",
" X .o ",
" OOOOOOO X ",
" OOOOOOO X ",
" oOoooooO oo ",
" OOoooXoooOO +XX ",
" ooOOoooXoooOOoo XX ",
" OOOooXXXXooXooOOO .o @ #",
" OoooXXXXXXXXXXXoooO XX # @@ ",
" oOoooXXXXXXXXXXXoooOo XX # @@ ",
" OOoXXXXXXXXXXXXXXXXXoOO oo ## ",
" OOoXXXXXXXXX$$%..XXXoOO X @ ## ",
" oOOoXXXXXXXXX$$%..XXXoOOo X @ ## ",
" oOooXXXXXXXXXXXX$%%.XXXooO .. ",
" oOooXXXXXXXXXXXXXXXXXXXooO X..X @ # @",
"+oOooXXXXXXXXXXXXXXXXXXXooOo X..X @ # @",
"ooOooXXXXXXXXXXXXX$$%..XooOo ",
"ooOooXXXXXXXXXXXXX$$%..XooOo ## ## ",
"+oOooXXXXXXXXXXXXX$$%..XooOo ## ## ",
" oOooXXXXXXXXXXXXX$$%..XooOo @@ @ ",
" oOooXXXXXXXXXXXX$%%.XXXooOo @ ",
" oOooXXXXXXXXXXXX$%%.XXXooOo @ ",
" OooXXXXXXXXXXXX$%%.XXXooO ## ## #",
" OOoXXXXXXXXX$$%..XXXoOOo ",
" OOoXXXXXXXXX$$%..XXXoOO ",
" OOoXXXXXXXXXXXXXXXXXoOO @@ ",
" OoooXXXXXXXXXXXoooOo ",
" OoooXXXXXXXXXXXoooo ",
" OOOoooooooooooOOO ",
" ooOOOOOOOOOOOoo ",
" OOOOOOOOOOO ",
" oooooooo "};

BIN
Lib/Images/evalbuf.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/evalreg.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/file.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 168 B

22
Lib/Images/file.xpm
View File

@ -1,22 +0,0 @@
/* XPM */
static char *textfile[] = {
/* width height num_colors chars_per_pixel */
" 16 12 3 1",
/* colors */
". c none",
"# c #000000",
"a c #f8fcf0",
/* pixels */
"...########.....",
"...#aaaaaa#.....",
"...#aaaaaa###...",
"...#a####aaa#...",
"...#aaaaaaaa#...",
"...#a###aaaa#...",
"...#aaaaaaaa#...",
"...#a#####aa#...",
"...#aaaaaaaa#...",
"...#a#####aa#...",
"...#aaaaaaaa#...",
"...##########..."
};

BIN
Lib/Images/floppy.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

BIN
Lib/Images/font.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 204 B

BIN
Lib/Images/hborder.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 78 B

BIN
Lib/Images/info.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.4 KiB

98
Lib/Images/info.xpm
View File

@ -1,98 +0,0 @@
/* XPM */
static char * Info_xpm[] = {
"48 48 47 1",
" c None",
". c #69A675D679E7",
"X c #59655D7579E7",
"o c #410349246185",
"O c #69A671C69658",
"+ c #1861186130C2",
"@ c #1040104028A2",
"# c #186120814103",
"$ c #208128A25965",
"% c #208120814924",
"& c #208128A24924",
"* c #49244D346185",
"= c #1040186130C2",
"- c #30C238E371C6",
"; c #38E341038E38",
": c #38E349248E38",
"> c #38E345148617",
", c #38E33CF35965",
"< c #5144555569A6",
"1 c #28A234D34924",
"2 c #30C2410379E7",
"3 c #51445D759658",
"4 c #D75CD75CDF7D",
"5 c #EFBEEBADEFBE",
"6 c #DF7DDB6CDF7D",
"7 c #596561859E79",
"8 c #410349248E38",
"9 c #28A230C26185",
"0 c #E79DE38DE79D",
"q c #C71BC30BC71B",
"w c #96589248A699",
"e c #C71BCB2BCF3C",
"r c #1861208138E3",
"t c #410351448E38",
"y c #79E77DF7A699",
"u c #CF3CCB2BDF7D",
"i c #861786179658",
"p c #1040186128A2",
"a c #410351449658",
"s c #492451449658",
"d c #F7DEF3CEF7DE",
"f c #86178A28AEBA",
"g c #D75CD34CD75C",
"h c #492459659658",
"j c #492459658E38",
"k c #FFFFFBEEFFFF",
"l c #1861186128A2",
" ",
" ",
" ",
" ",
" ",
" .XXooooXOO ",
" ++@++#$$$$%%&** ",
" ==$$-;;;;::::::>>,< ",
" ,===$$-;;;;::::::>>,<< ",
" 11@$$2;;;3345667:::888>>X ",
" #==9;;;;;;440qqqw228888888XX ",
" #==9;;;;;;440qqqw228888888XX ",
" 11=--;;;;;;;55qqqqerr8888888tty ",
" <@@9;;;;;;;;:uuqqeeipp888888tttt ",
" <@@9;;;;;;;;:uuqqeeipp888888tttt ",
" +%%;;;;;;;:::77weiirrr8888ttttttOO ",
" <@--;;;;;;::::::2rppr22888ttttttass ",
" <@--;;;;;;::::::2rppr22888ttttttass ",
" 11%;;;;;;::75555555ddd888ttttttaasssf ",
" ==9;;;;;:::7>>@eeeggggppttttttasssss3 ",
" ==9;;;;;:::7>>@eeeggggppttttttasssss3 ",
" @@2;;;::::::>>855gggg6ppttttaasssssss ",
" ==;;;:::::::888ddgg666pptttasssssssss ",
" ##;::::::::8888ddg6666pptaassssssssss ",
" ##;::::::::8888ddg6666pptaassssssssss ",
" ##:::::::888888dd66660ppasssssssssssh ",
" ++::::::8888888dd66000ppsssssssssshhh ",
" ++::::::8888888dd66000ppsssssssssshhh ",
" ##::::888888888dd60000ppssssssssshhhy ",
" <<2::888888888tdd00000ppssssssshhhhh ",
" <<2::888888888tdd00000ppssssssshhhhh ",
" &888888888tttdd00005ppsssssshhhhhh ",
" *88888888ttttdd00555ppsssshhhhhh ",
" *88888888ttttdd00555ppsssshhhhhh ",
" --8888ttttttdd55555ppssshhhhhh7 ",
" iij88ttttddddd55dddddkhhhhhh77 ",
" ij88ttttddddd55dddddkhhhhhh77 ",
" Ojjttttaapppppppplllllhhh7 ",
" 3ttasssssssssshhhhhhOO ",
" ttasssssssssshhhhhhOO ",
" 3ssssssssshhhh77 ",
" yyysyyf ",
" ",
" ",
" ",
" ",
" ",
" "};

BIN
Lib/Images/parentdir.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 233 B

25
Lib/Images/parentdir.xpm
View File

@ -1,25 +0,0 @@
/* XPM */
static char * symdir2_xpm[] = {
"16 16 6 1",
" s None c None",
". c grey51",
"X c grey76",
"o c yellow1",
"O c white",
"+ c grey4",
" ",
" ..... ",
" .XoXoX. ",
".XoXoXoX...... ",
".OOOOOOOOOOOO.+ ",
".OoXoXoXoXoXo.+ ",
".OXoX+XoX+XoX.+ ",
".OoX++oXo+oXo.+ ",
".OX+++++++XoX.+ ",
".OoX++oXoXoXo.+ ",
".OXoX+XoXoXoX.+ ",
".OoXoXoXoXoXo.+ ",
"..............+ ",
" ++++++++++++++ ",
" ",
" "};

BIN
Lib/Images/qmark.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 215 B

BIN
Lib/Images/question.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

59
Lib/Images/question.xpm
View File

@ -1,59 +0,0 @@
/* XPM */
static char * question_xpm[] = {
/* width height ncolors chars_per_pixel */
"48 48 5 1",
/* colors */
" c None",
". c orange",
"X c red",
"o c firebrick",
"O c slate grey",
/* pixels */
" ",
" ",
" ................. ",
" ...XXXXXXXXXXXXXXXXXXXX ",
" ...XXXXXXXXXXXXXXXXXXXX ",
" .XXXXXXXXoooooooooooooXXXOO ",
" ..XXXXXXoooooooooooooooooooXXO ",
" ..XXXXXXoooooooooooooooooooXXO ",
" .XXXXXXooooooXXXXXXoooooooooooXOO ",
" ..XXXXXXooooooOOOO XXXooooooooooooO ",
" ..XXXXXXooooooOOOO XXXooooooooooooO ",
" .XXXXXXooooooOOOOO XXXoooooooooooOOO ",
" .XXXXXoooooooOOO ..XXXoooooooooOOO ",
" .XXXXXoooooooOOO ..XXXoooooooooOOO ",
" .XXXXXoooooooooO ..XXXoooooooooOOO ",
" XXXXXoooooooooOOO ..XXXoooooooooOOO ",
" XXXXXoooooooooOOO ..XXXoooooooooOOO ",
" XXXoooooooooOOO .XXXXXoooooooooOOO ",
" XXXooooooOOOOO .XXXoooooooooOOOOO ",
" XXXooooooOOOOO .XXXoooooooooOOOOO ",
" XXXoooOOOO ..XXXoooooooooOOOO ",
" OOOOOOOO .XXXoooooooooOOOOOO ",
" OOOOOOOO .XXXoooooooooOOOOOO ",
" OOOO ..XXXoooooooooOOOOOO ",
" .XXXooooooooOOOOOOO ",
" .XXXooooooooOOOOOOO ",
" ..XXXoooooooOOOOOO ",
" .XXXooooooooOOOOOO ",
" .XXXooooooooOOOOOO ",
" .XXXooooooOOOOOO ",
" XXXoooooOOOOOO ",
" XXXoooooOOOOOO ",
" XXXoOOOOOO ",
" OOOOOOOO ",
" OOOOOOOO ",
" ..XXXoooO ",
" .XX.XXXooo ",
" .XX.XXXooo ",
" ..X..X..XXXooo ",
" ..XXX.XXXXXoooO ",
" ..XXX.XXXXXoooO ",
" XXXXXXXXXoooOOO ",
" XXXXXXoooOOOOO ",
" XXXXXXoooOOOOO ",
" XoooooOOOOOO ",
" OOOOOOOOO ",
" OOOOOOOOO ",
" OOOOOO "};

BIN
Lib/Images/warning.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

59
Lib/Images/warning.xpm
View File

@ -1,59 +0,0 @@
/* XPM */
static char * warning_xpm[] = {
/* width height ncolors chars_per_pixel */
"48 48 5 1",
/* colors */
" c None",
". c orange",
"X c red",
"o c firebrick",
"O c slate grey",
/* pixels */
" ",
" ",
" ",
" ",
" ...... . ",
" ..XoooooooO ",
" .XXXoooooooO ",
" ..XXXXXXXoooOOO ",
" XXXXXXXXXoooooO ",
" XXXXXXXXXoooooOO ",
" XXXXXXXXXXooooOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOOO ",
" XXXXXXXXXXooooOO ",
" XXXXXXXXooOOO ",
" XXXXXXXXooOOO ",
" XXXXXXXoooOO ",
" XXXXXoooOO ",
" XXXXooooOO ",
" XXXoooooOO ",
" XoooOOO ",
" XoooOOO ",
" OoooOOO ",
" OOOOOO ",
" OOOOOO ",
" OOOOOO ",
" .XXXXOO ",
" ...XXXXOOO ",
" .XXXXXXXXOO ",
" ..XXXXXXXXXOO ",
" ..XXXXXXXXXXOOO ",
" ..XXXXXX.XXXOOO ",
" ..XXXXXX.XXXOOO ",
" XXXXXX.XXXOOO ",
" XXX..XXXOOOO ",
" XXXXOOOOOO ",
" XXXXOOOOO ",
" OOOOOOO ",
" OOOOOO ",
" OOO ",
" "};

111
Lib/balloon.stk Normal file
View File

@ -0,0 +1,111 @@
;;;;
;;;; b a l l o o n . s t k -- balloon help
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: balloon.stk 1.2 Tue, 02 Feb 1999 09:04:21 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 11-Dec-1998 18:00
;;;; Last file update: 22-Jan-1999 12:00
(select-module Tk)
(export add-balloon-help activate-balloons deactivate-balloons find-balloon-help)
;;;;
;;;; Resources (FIXME: background does not work. why? Tk bug?)
;;;;
(option 'add "*HelpBalloon*Label*Background" "#ffffb0" "widgetDefault")
(option 'add "*HelpBalloon*Label*Foreground" "black" "widgetDefault")
(option 'add "*HelpBalloon*Label*BorderWidth" 1 "widgetDefault")
(option 'add "*HelpBalloon*Font" '(Courier -12) "widgetDefault")
(option 'add "*HelpBalloon*Relief" "solid" "widgetDefault")
(option 'add "*HelpBalloon*HighlightThickness" 0 "widgetDefault")
;;;;
;;;; Globals
;;;;
(define *balloon-handler* #f)
(define *balloon-top* #f)
(define *balloon-label* #f)
(define (initialize-balloon)
(set! *balloon-top* (toplevel ".__balloon__" :class "HelpBalloon"))
(set! *balloon-label* (label (& *balloon-top* ".l") :padx 3 :pady 2))
(pack *balloon-label* :expand #f :fill "both")
(activate-balloons)
; make widget transient
(wm 'withdraw *balloon-top*)
(wm 'over *balloon-top* #t))
(define (activate-balloons)
(bind "Balloon" "<Enter>" (lambda (|W|) (display-balloon-help |W|)))
(bind "Balloon" "<Leave>" (lambda (|W|) (delete-balloon-help |W|))))
(define (deactivate-balloons)
(bind "Balloon" "<Enter>" "")
(bind "Balloon" "<Leave>" ""))
(define (add-balloon-help w txt delay bg)
(unless *balloon-top*
(initialize-balloon))
;; store parameters in widget and make it a "Balloon" widget
(set-widget-property! w :balloon-txt txt)
(set-widget-property! w :balloon-delay delay)
(set-widget-property! w :balloon-bg bg)
(bindtags w (cons "Balloon" (remove "Balloon" (bindtags w)))))
(define (find-balloon-help)
(unless *balloon-label*
(initialize-balloon))
*balloon-label*)
(define (display-balloon-help w)
(after 'cancel *balloon-handler*)
(let ((delay (get-widget-property w :balloon-delay -1))
(txt (get-widget-property w :balloon-txt ""))
(bg (get-widget-property w :balloon-bg "")))
(when (>= delay 0)
(set! *balloon-handler*
(after delay
(lambda ()
(let* ((height (winfo 'height w))
(pos-y (winfo 'rooty w)))
(*balloon-label* 'conf :text txt :bg bg)
;; place the balloon just outside the widget
(wm 'geometry *balloon-top*
(format #f "+~A+~A"
(winfo 'pointerx w) (+ pos-y height 2)))
;; Deiconify
(wm 'deiconify *balloon-top*)
(raise *balloon-top*))))))))
(define (delete-balloon-help w)
(wm 'withdraw *balloon-top*)
(after 'cancel *balloon-handler*))
(provide "balloon")
#|
(button '.b1 :text "foo")
(button '.b2 :text "bar")
(pack .b1 .b2)
(add-balloon-help .b1 "On several\nlines\n..." 10 "yellow")
(add-balloon-help .b2 "This is help" 1000 "red")
|#

85
Lib/butbar.stk Normal file
View File

@ -0,0 +1,85 @@
;;;; butbar.stk -- Button bar management
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: butbar.stk 1.3 Fri, 22 Jan 1999 14:44:12 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 8-Dec-1998 18:58
;;;; Last file update: 22-Jan-1999 14:22
(require "balloon")
(select-module Tk)
(export make-bordered-frame make-button-bar)
;;;
;;; Button-bar default bindings
;;;
(bind "ButtonBar" "<Enter>" (lambda (|W|) (tk-set! |W| :relief "raised")))
(bind "ButtonBar" "<Leave>" (lambda (|W|) (tk-set! |W| :relief "flat")))
;=============================================================================
;
; bordered-frame functions
;
;=============================================================================
(define (hide-bordered-frame parent)
(let* ((info (pack 'info parent))
(grand-pa (winfo 'parent parent))
(b (button (& grand-pa ".hb") :image (make-image "hborder.gif"))))
(tk-set! b :command (lambda ()
(pack 'unpack b)
(apply pack parent (cddr info))
(destroy b)))
(pack 'unpack parent)
(pack b :side "left")))
(define (make-bordered-frame parent)
(let* ((f (frame (gensym (& parent ".border") :relief "ridge" :bd 1)))
(b (button (& f ".b") :image (make-image "border.gif")
:bd 1 :relief "ridge" :command (lambda ()
(hide-bordered-frame f)))))
(pack b :side "left" :fill 'y)
(pack f :fill 'x)
f))
;=============================================================================
;
; make-button-bar
;
;=============================================================================
(define (make-button-bar parent l)
(define (make-button parent img balloon action)
(let* ((name (gensym (& parent ".b")))
(but (button name :image (make-image img) :relief "flat" :comm action)))
(pack but :side "left" :fill "both")
(add-balloon-help but balloon 1500 "#ffffb0")
(bindtags but (cons "ButtonBar" (bindtags but)))))
(define (make-space parent size)
(let ((name (gensym (& parent ".f"))))
(pack (frame name :width size) :side "left" :fill "both")))
;; make-button-bar starts here
(let ((f (make-bordered-frame parent)))
(for-each (lambda (x)
(if (integer? x)
(make-space f x)
(apply make-button f x)))
l)
f))
(provide "butbar")

23
Lib/button.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; Buttons, Check button and radio buttons bindings and procs
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -17,7 +17,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-1993 12:35
;;;; Last file update: 21-Mar-1998 12:45
;;;; Last file update: 23-Jan-1999 11:48
;;;;
(select-module Tk)
@ -27,9 +27,7 @@
(unless (or (tk-command? Tk:button)
(tk-command? Tk:checkbutton)
(tk-command? Tk:radiobutton))
(let ()
;==============================================================================
;
; UNIX stuff
@ -176,6 +174,9 @@
(unless (equal? (tk-get |W| :state) "disabled")
(|W| (if (null? cmd) 'invoke (car cmd)))))
(define (Tk:R&C-invoke1 |W|)
(Tk:R&C-invoke |W|))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -226,16 +227,16 @@
(bind "Button" "<1>" Tk:button-down)
(bind "Button" "<ButtonRelease-1>" Tk:button-up)
(bind "Button" "<space>" Tk:button-invoke)
(bind "Button" "<Return>" Tk:button-invoke)
(bind "Checkbutton" "<FocusIn>" "")
(bind "Checkbutton" "<Leave>" Tk:button-leave)
(bind "Checkbutton" "<space>" (lambda (|W|)
(Tk:R&C-invoke |W|)))
(bind "Checkbutton" "<space>" Tk:R&C-invoke1)
(bind "Checkbutton" "<Return>" Tk:R&C-invoke1)
(bind "Radiobutton" "<FocusIn>" "")
(bind "Radiobutton" "<Leave>" Tk:button-leave)
(bind "Radiobutton" "<space>" (lambda (|W|)
(Tk:R&C-invoke |W|)))
))
(bind "Radiobutton" "<space>" Tk:R&C-invoke1)
(bind "Radiobutton" "<Return>" Tk:R&C-invoke1)
)

174
Lib/console-customize.stk Normal file
View File

@ -0,0 +1,174 @@
;;;; console-customize.stk -- console customization stuff
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: console-customize.stk 1.2 Mon, 01 Feb 1999 15:18:22 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 19-Dec-1998 16:39
;;;; Last file update: 1-Feb-1999 14:27
(require "console")
(require "edit") ; for *editor-font*
(require "font-chooser")
(select-module Tk)
(define make-font-chooser (with-module STklos+Tk make-font-chooser)) ; kludge
(define (make-console-color-button parent name var env)
(let* ((col (eval var env))
(f (frame (& parent (gensym ".f"))))
(n (label (& f ".n") :text name :justify 'right :width 12 :anchor 'e))
(v (entry (& f ".v") :bg "white" :width 30 :fg col))
(c (button (& f ".c") :image (make-image "colors.gif")
:command (lambda ()
(let ((c (Tk:choose-color
:initial-color col
:title (string-append name " Color"))))
(when c
(v 'delete 0 'end)
(v 'insert 0 c)
(event 'gen v "<<Choose-Color>>")))))))
(pack n v c :side 'left :padx 2)
;; Fill the entry with the name of the current color
(v 'insert 0 col)
(bind c "<Return>" (lambda () (event 'generate v "<<Choose-Color>>")))
(bind v "<<Choose-Color>>" (lambda ()
(let ((value (v 'get)))
(catch
(tk-set! v :fg value)
(eval `(set! ,var ,value) env)))))
f))
(define (make-console-font-button parent name var env)
(let* ((font (eval var env))
(f (frame (& parent (gensym ".f"))))
(n (label (& f ".n") :text name :justify 'right :width 12 :anchor 'e))
(v (entry (& f ".v") :bg "white" :width 30))
(new (lambda ()
(let ((f (make-font-chooser font)))
(when f
(v 'delete 0 'end)
(v 'insert 0 f)
(eval `(set! ,var ',f) env)))))
(c (button (& f ".c") :image (make-image "font.gif") :command new)))
(pack n v c :side 'left :padx 2)
(bind v "<Return>" (lambda () (eval `(set! ,var ',(v 'get)) env)))
;; Fill the entry with the name of the current color
(v 'insert 0 font)
f))
(define (console-save-n-apply file)
;; Write variables in the given file
(with-output-to-file file
(lambda ()
(format #t "; This file isautomatically generated\n; ****DO NOT EDIT ***\n")
(format #t "(select-module STk)\n")
(format #t "(set! *show-splash-screen* ~A)\n" *show-splash-screen*)
(format #t "(set! *print-banner* ~A)\n" *print-banner*)
(format #t "(set! *load-verbose* ~A)\n" *load-verbose*)
(format #t "(set! *fontify-keyword-color* ~S)\n" *fontify-keyword-color*)
(format #t "(set! *fontify-class-color* ~S)\n" *fontify-class-color*)
(format #t "(set! *fontify-syntax-color* ~S)\n" *fontify-syntax-color*)
(format #t "(set! *fontify-comment-color* ~S)\n" *fontify-comment-color*)
(format #t "(set! *fontify-string-color* ~S)\n" *fontify-string-color*)
(format #t "(set! *console-font* '~S)\n" *console-font*)
;; Use a define for *editor-font* since the editor is possibly not loaded
(format #t "(define *editor-font* '~S)\n" *editor-font*))))
;=============================================================================
;
; console-customize-save
;
;=============================================================================
(define (console-customize-save)
(console-save-n-apply (expand-file-name "~/.stkvars")))
;=============================================================================
;
; console-customize
;
;=============================================================================
(define (console-customize)
(destroy ".__cons_customize")
(let* ((top (toplevel ".__cons_customize"))
(env (global-environment))
(f1 (frame (& top ".f1") :bd 3 :relief "groove" :bg "white"))
(f2 (frame (& top ".f2") :bd 3 :relief "groove"))
(f3 (frame (& top ".f3") :bd 3 :relief "groove"))
(lab (label (& f1 ".lab")
:text (string-append
"This is the customization window for STk.\n\n"
"Change the following values to customize\n"
"the behavior of consoles and editors.")
:bg "white"
:justify 'left))
(logo (label (& f1 ".lab2") :bd 0 :relief "flat"
:image (make-image "STk-logo.gif")))
(clab (label (& f2 ".clab") :text "General Options"
:fg "IndianRed3"))
(splash (checkbutton (& f2 ".splash") :text "Display the splash screen"
:env env :variable '*show-splash-screen* :anchor 'w))
(cprwt (checkbutton (& f2 ".cprwt")
:text "Display the STk version when starting"
:env env :variable '*print-banner* :anchor 'w))
(verb (checkbutton (& f2 ".verb")
:text "Load verbose"
:env env :variable '*load-verbose* :anchor 'w))
(hlab (label (& f2 ".hlab") :text "Syntax Hilighting"
:fg "IndianRed3"))
(flab (label (& f2 ".flab") :text "Fonts" :fg "IndianRed3")))
;; Change window title
(wm 'title top "STk Customization Window")
;; *** The upper frame ***
(pack logo lab :side 'left :fill 'x :pady '3m :padx '3m)
(pack f1 :side 'top :fill 'x :padx 5 :pady 5)
;; *** The lower-frame ***
; G e n e r a l O p t i o n s
(pack clab :side 'top :fill 'x)
(pack splash cprwt verb :side 'top :fill 'x :padx '3m)
; S y n t a x h i g h l i g h t i n g
(pack hlab :side 'top :fill 'x)
(pack (make-console-color-button f2 "Comments" '*fontify-comment-color* env)
(make-console-color-button f2 "Keywords" '*fontify-keyword-color* env)
(make-console-color-button f2 "Classes" '*fontify-class-color* env)
(make-console-color-button f2 "Strings" '*fontify-string-color* env)
(make-console-color-button f2 "Syntax" '*fontify-syntax-color* env)
:side 'top :fill 'x :padx '3m)
; F o n t s
(pack flab :side 'top :fill 'x)
(pack (make-console-font-button f2 "Console" '*console-font* env)
(make-console-font-button f2 "Editor" '*editor-font* env)
:side 'top :fill 'x :padx '3m)
(pack f2 :side 'top :fill 'x :padx 5 :pady 5)
;; *** The buttons ***
(let ((b1 (button (& f3 ".save") :text "Save" :bd 2
:command console-customize-save))
(b2 (button (& f3 ".exit") :text "Exit" :bd 2
:command (lambda () (destroy top)))))
(pack b1 b2 :side 'left :padx 3 :pady 3 :fill 'y)
(pack f3 :fill 'x :side 'bottom))))
(provide "console-customize")

604
Lib/console.stk Normal file
View File

@ -0,0 +1,604 @@
;;;;
;;;; console.stk -- A simple console written in STk
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: console.stk 1.9 Mon, 01 Feb 1999 15:18:22 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 29-Oct-1998 18:51
;;;; Last file update: 1-Feb-1999 14:18
(require "font-lock")
(require "butbar")
(require "edit")
;;;
;;; Variables which which can be overloaded by the user file ~/.stkvars
;;;
(define-module STk
(define *show-splash-screen* #t)
(define *console-font* '(courier)))
;;;
;;; The rest of the file is in the Tk module
;;;
(select-module Tk)
(export make-console)
(autoload "console-customize" console-customize console-customize-save)
;=============================================================================
;
; Globals
;
;=============================================================================
(define *console-version-message*
(string-append "STk version" (version)
"\n(Tk version is " *tk-patch-level* ")\n\n"
"Copyright © 1993-1999\nErick Gallesio - I3S-CNRS/ESSI\n"
"<eg@unice.fr>"))
;=============================================================================
;
; Utilities
;
;=============================================================================
(define (bad-port . _)
(error "console is not tied to a standard input port"))
(define (set-cursor console pos)
(let ((pos (if (console 'compare pos "==" "end") "end - 1 chars" pos)))
(console 'mark 'set 'insert pos)
(console 'tag 'remove 'sel "1.0" "end")
(console 'see "insert")))
;;
;; console-insert --
;; Insert a string into a text at the point of the insertion cursor. If
;; there is a selection in the text, and it covers the point of the
;; insertion cursor, then delete the selection before inserting.
;; Insertion is restricted to the prompt area.
;;
(define (console-insert console s)
(unless (zero? (string-length s))
; 1. Raise window
(raise (winfo 'top console))
; 2. Do text insertion
(catch
(when (and (console 'compare "sel.first" "<=" "insert")
(console 'compare "sel.last" ">=" "insert"))
(console 'tag 'remove 'sel "sel.first" "prompt-end")
(console 'delete "sel.first" "sel.last")))
(if (console 'compare "insert" "<" "prompt-end")
(console 'mark 'set "insert" "end"))
(console 'insert "insert" s "input stdin")
(console 'see "insert")
; 3. Fontify
(idle-fontify console)))
;;
;; console-output --
;; This routine is called directly by the interpreter to cause a string
;; to be displayed in the console.
;;
(define (console-output console string file-type)
(console 'insert "output" string file-type)
(console 'see "insert"))
;;
;; console-load
;;
(define (console-load)
(let ((file (Tk:get-open-file :title "Load File")))
(and file (load file))))
;;
;; console-about
;;
(define (console-about)
(let* ((top (toplevel '.__cons_about__))
(m (label (& top ".m") :justify "center" :foreground "IndianRed4"
:text *console-version-message*))
(img (make-image "STk-big-logo.gif"))
(lab (label (& top ".l") :image img :relief "groove" :bd 5))
(q (button (& top ".b") :text "Close"
:command (lambda ()
(delete-image "STk-big-logo.gif")
(destroy top)))))
(wm 'title top "About STk ...")
(grab top)
(raise top)
(pack lab :padx 20 :pady 20)
(pack m :fill "both" :expand #t)
(pack q :ipadx 10 :pady 10)))
;;
;; console-splash-screen
;;
(define (console-splash-screen)
(let* ((width 400)
(height 300)
(top (toplevel '.__cons_splash__ :bg "white" :relief "solid" :bd 3
:width width :height height))
(m (label (& top ".m") :justify "center" :fg "IndianRed4"
:bg "white" :text *console-version-message*))
(img (make-image "STk-big-logo.gif"))
(lab (label (& top ".l") :image img :bd 0))
(w (winfo 'screenwidth top))
(h (winfo 'screenheight top))
(kill (lambda ()
(catch (delete-image "STk-big-logo.gif"))
(destroy top))))
(wm 'over top #t)
(wm 'geometry top (format #f "+~A+~A" (/ (- w 400) 2) (/ (- h 300) 2)))
(pack 'propagate top #f)
(pack lab m)
(bind top "<1>" kill) ;; for the impatients
(raise top)
(after 2000 kill)))
;;
;; console-logo
;;
(define (console-logo console)
(let ((l0 (label (& console ".l0") :image (make-image "LineLeft.gif") :bd 0))
(l1 (label (& console ".l1") :image (make-image "STk-tiny-logo.gif"):bd 0))
(l2 (label (& console ".l2") :image (make-image "LineRight.gif") :bd 0)))
(console 'insert 'insert "\n")
(console 'window 'create "insert" :window l0 :align "baseline")
(console 'insert 'insert " ")
(console 'window 'create "insert" :window l1 :align "baseline")
(console 'insert 'insert " ")
(console 'window 'create "insert" :window l2 :align "baseline")
(console 'tag 'add "center" "1.0" "insert")
(console 'tag 'configure "center" :justify "center")
(console 'insert "insert" "\n\n")))
;;
;; console-invoke --
;;
;; Processes the command line input. If the command is complete it
;; is evaluated.
;;
(define (console-invoke console module stdin stdout stderr)
(let* ((ranges (console 'tag 'ranges "input"))
(cmd (apply console 'get ranges))
(mod (or module (%get-selected-module)))
(env (module-environment mod))
(stdcons? (eq? stdin (current-input-port))))
(if (complete-sexpr? cmd)
(begin
;; We have a complete set of expression to evaluate
(console 'mark 'set "output" "end")
(console 'tag "delete" "input")
(with-input-from-string cmd
(lambda ()
(do ((sexpr (read) (read)))
((eof-object? sexpr))
(add-history! console (substring cmd 0 (- (string-length cmd) 1)))
(if stdcons?
;; We are on the main console. Directly fill the std buffer
(%fill-stdin cmd)
;; Not the standard console. Use redirection
(dynamic-wind
(lambda () #f)
(lambda ()
(with-input-from-port stdin
(lambda ()
(with-output-to-port stdout
(lambda ()
(with-error-to-port stderr
(lambda ()
(let ((E (eval sexpr env)))
(repl-display-result E)))))))))
(lambda ()
(console-prompt console module stdout stderr)
(console 'yview :pickplace "insert"))))))))
;; Not a complete sexpr. Indent text
(font-lock-indent console "input"))))
;=============================================================================
;
; console-prompt
;
;=============================================================================
(define (console-prompt console module stdout stderr)
(let ((temp (console 'index "end -1 char"))
(mod (or module (%get-selected-module))))
(with-output-to-port stdout
(lambda()
(with-error-to-port stderr
(lambda ()
(repl-display-prompt mod)))))
(console 'mark 'set "output" temp)
(set-cursor console "end")
(console 'mark 'set "prompt-end" "insert") ; FIXME: obligé de mettre
(console 'mark 'gravity "prompt-end" 'left) ; la gravité?
(console 'mark 'set "start_fontify" "insert")
(console 'mark 'gravity "start_fontify" 'left)))
(define console-display-prompt #f)
(define (make-console-display-prompt console stdout stderr)
(set! console-display-prompt
(lambda (module)
(console-prompt console module stdout stderr))))
;=============================================================================
;
; History management
;
;=============================================================================
(define (update-history! console h index)
(set-widget-data! console (list :hist h :index index)))
(define (get-history console)
(let ((data (get-widget-data console)))
(if data
; we have already an history for this console
(values (get-keyword :hist data) (get-keyword :index data))
; make an empty history for this console
(values '() 0))))
(define (add-history! console line)
(call-with-values (lambda () (get-history console))
(lambda (h idx) (update-history! console (cons line h) 0))))
(define(follow-history console oper)
(call-with-values
(lambda () (get-history console))
(lambda (h idx)
(if (null? h)
""
(let ((r (list-ref h idx)))
(update-history! console h (modulo (oper idx 1) (length h)))
r)))))
(define (previous-history console)
(follow-history console +))
(define (next-history console)
(follow-history console -))
;=============================================================================
;
; Init-console-bindings
;
; This is quite unreadable, but who cares?
;
;=============================================================================
(define (init-console-bindings console module stdin stdout stderr)
;; Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
;; Otherwise, if a widget binding for one of these is defined, the
;; <KeyPress> class binding will also fire and insert the character,
;; which is wrong. Ditto for <Escape>.
(bind console "<Alt-KeyPress>" "")
(bind console "<Meta-KeyPress>" "")
(bind console "<Control-KeyPress>" "")
(bind console "<Escape>" "")
(bind console "<KP_Enter>" "")
;; Inserting characters
(bind console "<Tab>" (lambda ()
(console-insert console "\t")
(focus console)
'break))
(bind console "<Return>" (lambda ()
(console 'mark 'set 'insert "end - 1c")
(console-insert console "\n")
(console-invoke console module stdin stdout stderr)
'break))
(bind console "<KeyPress>" (lambda (|A|)
(console-insert console |A|)
'break))
;; Deleting characters
(let ((del (lambda (comparison)
(idle-fontify console)
(if (null? (console 'tag 'nextrange 'sel "1.0" 'end))
(if (console 'compare "insert" comparison "prompt-end") 'break)
(console 'tag 'remove 'sel "sel.first" "prompt-end")))))
(bind console "<Delete>" (lambda () (del "<")))
(bind console "<Control-d>" (lambda () (del "<")))
(bind console "<BackSpace>" (lambda () (del "<=")))
(bind console "<Control-k>" (lambda ()
(idle-fontify console)
(if (console 'compare "insert" "<" "prompt-end")
(console 'mark 'set "insert" "prompt-end"))))
(bind console "<Meta-d>" (lambda ()
(idle-fontify console)
(if (console 'compare "insert" "<" "prompt-end")
'break)))
(bind console "<Meta-BackSpace>"
(lambda ()
(idle-fontify console)
(if (console 'compare "insert" "<=" "prompt-end") 'break))))
;; Moving around
(let ((start (lambda ()
(idle-fontify console)
(let ((pos (if (console 'comp "insert linestart" ">" "prompt-end")
"insert linestart"
"prompt-end")))
(set-cursor console pos)
'break)))
(end (lambda ()
(idle-fontify console)
(set-cursor console "insert lineend")
'break))
(forw (lambda ()
(if (console 'compare "insert" ">=" "prompt-end")
(set-cursor console "insert+1c"))
'break))
(back (lambda ()
(if (console 'compare "insert" ">=" "prompt-end")
(set-cursor console "insert-1c"))
'break))
(nop (lambda () #f)))
(bind console "<Control-a>" start)
(bind console "<Home>" start)
(bind console "<Control-e>" end)
(bind console "<End>" end)
(bind console "<Control-f>" forw)
(bind console "<Right>" forw)
(bind console "<Control-b>" back)
(bind console "<Left>" back)
(bind console "<Control-Left>" nop)
(bind console "<Control-Right>" nop))
;; History
(let ((prev (lambda ()
(when (console 'compare "insert linestart" "<" "prompt-end")
(console 'delete "prompt-end" "end")
(console-insert console (previous-history console))
'break)))
(next (lambda ()
(when (console 'compare "insert linestart" "<" "prompt-end")
(console 'delete "prompt-end" "end")
(console-insert console (next-history console))
'break))))
(bind console "<Control-p>" prev)
(bind console "<Up>" prev)
(bind console "<Control-n>" next)
(bind console "<Down>" next))
(bind console "<<PasteSelection>>" (lambda ()
(catch
(console-insert console
(selection 'get :displayof console)))
(fontify-buffer console "prompt-end")
'break))
(bind console "<<Cut>>" (lambda ()
(catch
(let ((buffer (console 'get "sel.first" "sel.last")))
(clipboard 'clear :displayof console)
(clipboard 'append :displayof console buffer)
(console 'delete "sel.first" "sel.last")))
'break))
(bind console "<<Copy>>" (lambda ()
(catch
(let ((buffer (console 'get "sel.first" "sel.last")))
(clipboard 'clear :displayof console)
(clipboard 'append :displayof console buffer)))
'break))
(bind console "<<Paste>>" (lambda ()
(catch
(let ((clip (selection 'get
:displayof console
:selection "CLIPBOARD")))
(console-insert console clip)
(fontify-buffer console "prompt-end")))
'break))
(bind console "<Control-c>" (lambda ()
(bell)
(send-signal |SIGINT|)))
;; Use fontification for the console (but call it by hand because the console
;; completely manage text insertion)
(make-fontifiable console)
(bindtags console (remove "ScmTxt" (bindtags console)))
)
;=============================================================================
;
; init-console
;
;=============================================================================
(define (init-console module std-console?)
(let* ((top (toplevel (gensym "._cons_") :class "STk"))
(console (text (& top ".txt") :background "white" :setgrid #t
:font *console-font*))
(sb (scrollbar (& top ".sb") :width 10))
(mb (console-make-menubar top console))
(bb (console-make-buttonbar top console))
(stdin (if std-console?
(current-input-port)
(open-input-virtual bad-port bad-port bad-port bad-port)))
(stdout (open-output-virtual
(lambda (c) (console-output console (string c) "stdout"))
(lambda (s) (console-output console s "stdout")(update 'idle))
#f
#f))
(stderr (open-output-virtual
(lambda (c) (console-output console (string c) "stderr"))
(lambda (s) (console-output console s "stderr")(update 'idle))
#f
#f)))
;; Associate the scrollbar commands
(tk-set! sb :command (lambda l (apply console 'yview l)))
(tk-set! console :yscroll (lambda l (apply sb 'set l)))
;; Pack stuff
(pack bb :fill "x")
(pack console :expand #t :fill "both" :side "left")
(pack sb :expand #f :fill "y" :side "left")
(wm 'title top (if module
(format #f "Console (~A)" (module-name module))
"STk console"))
(if std-console?
(wm 'protocol top "WM_DELETE_WINDOW" (lambda () (exit 0))))
(console 'tag 'configure "stdin" :foreground "black")
(console 'tag 'configure "stdout" :foreground "midnightblue")
(console 'tag 'configure "stderr" :foreground "DarkRed")
(console 'mark 'set "output" (console 'index "end - 1 char"))
(set-cursor console "end")
(console 'mark 'set "prompt-end" "insert")
(console 'mark 'gravity "prompt-end" "left")
(init-console-bindings console module stdin stdout stderr)
(if std-console?
(begin
(if *show-splash-screen* (console-splash-screen))
(if *print-banner* (console-logo console))
(%change-standard-ports stdin stdout stderr)
(make-console-display-prompt console stdout stderr))
(console-prompt console module stdout stderr))
(focus console)
console))
(define (console-make-buttonbar parent txt)
(let* ((f (frame (& parent ".butbar") :relief "ridge" :bd 1)))
(make-button-bar f
(list 5
(list "console.gif"
"Open New Console"
make-console)
(list "edit.gif"
"Open New Editor"
ed)
(list "customize.gif"
"Customize Environment"
(lambda () (console-customize))) ; delayed to avoid autoload
(list "diropen.gif"
"Load File"
console-load)
20
(list "copy.gif"
"Copy"
(lambda () (event 'gen txt "<<Copy>>")))
(list "clipboard.gif"
"Paste"
(lambda () (event 'gen txt "<<Paste>>")))
(list "cut.gif"
"Cut"
(lambda () (event 'gen txt "<<Cut>>")))
20
(list "qmark.gif"
"Help on Console"
(lambda () (help "console")))))
f))
(define (console-make-menubar top console)
(let* ((f (frame (& top ".f") :relief "ridge" :bd 1))
(b (make-bordered-frame f))
(file (menubutton (& b ".file") :text "File"))
(edit (menubutton (& b ".edit") :text "Edit"))
(conf (menubutton (& b ".conf") :text "Customize"))
(hlp (menubutton (& b ".help") :text "Help")))
;; File Menu
(let ((m (menu (& file ".m") :tearoff #f)))
(m 'add 'command :label "Load ..." :command console-load)
(m 'add 'separator)
(m 'add 'command :label "New Console" :command make-console)
(m 'add 'separator)
(m 'add 'command :label "Hide Console" :command (lambda () (wm 'iconify top)))
(m 'add 'command :label "Close Console" :command (lambda () (destroy top)))
(m 'add 'command :label "Exit STk" :command (lambda () (exit 0)))
(tk-set! file :menu m)
(pack file :side "left"))
;; Edit Menu
(let ((m (menu (& edit ".m") :tearoff #f)))
(m 'add 'command :label "Cut" :accel "Ctrl-X"
:command (lambda () (event 'gen console "<<Cut>>")))
(m 'add 'command :label "Copy"
:command (lambda () (event 'gen console "<<Copy>>")))
(m 'add 'command :label "Paste" :accel "Ctrl-V"
:command (lambda () (event 'gen console "<<Paste>>")))
(m 'add 'command :label "Clear" :accel "Del"
:command (lambda () (event 'gen console "<<Clear>>")))
(m 'add 'separator)
(m 'add 'command :label "Flush Console"
:command (lambda () (console 'delete "1.0" "end")))
(tk-set! edit :menu m)
(pack edit :side "left"))
(let ((m (menu (& conf ".m") :tearoff #f)))
(m 'add 'command :label "Customize"
:command (lambda () (console-customize)))
(m 'add 'command :label "Save Configuration"
:command (lambda () (console-customize-save)))
(tk-set! conf :menu m)
(pack conf :side "left"))
;; Help Menu
(let ((m (menu (& hlp ".m") :tearoff #f)))
(m 'add 'command :label "STk" :command (lambda () ; Indirect to avoid
(help))) ; autoloads
(m 'add 'command :label "Console" :command (lambda ()
(help "console")))
(m 'add 'separator)
(m 'add 'command :label "About" :command console-about)
(tk-set! hlp :menu m)
(pack hlp :side "right"))
(pack f :fill "x" :side "top")))
;=============================================================================
;
; make-console
;
;=============================================================================
(define (make-console . args)
(let ((module (get-keyword :module args #f)))
(when module
(if (symbol? module) (set! module (find-module module)))
(if (not (module? module))
(error "make-console: bad module ~S" module)))
(init-console module #f)))
(define (%make-standard-console)
(try-load "~/.stkvars")
(init-console #f #t))
(provide "console")

6
Lib/dialog.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; Dialog box creation utility
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -17,7 +17,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 4-Aug-1993 11:05
;;;; Last file update: 13-Jan-1998 10:12
;;;; Last file update: 22-Jan-1999 12:13
;;;;
(provide "dialog")
@ -78,7 +78,7 @@
(option 'add "*Dialog.msg.wrapLength" "3i" "widgetDefault")
(Tk:pack [message w.msg :justify "left" :text text :aspect 1000
:font "-Adobe-Times-Medium-R-Normal-*-180-*"]
:font '(Times 18)]
:side "right"
:expand #t
:padx 10

275
Lib/edit.stk Normal file
View File

@ -0,0 +1,275 @@
;;;; edit.stk -- A small editor for STk
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: edit.stk 1.5 Tue, 02 Feb 1999 09:04:21 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 8-Dec-1998 08:47
;;;; Last file update: 2-Feb-1999 08:46
(require "font-lock")
(require "butbar")
;;;
;;; Variables which which can be overloaded by the user file ~/.stkvars
;;;
(define-module STk
(define *editor-font* '(Courier -12)))
;;;
;;; The rest of the file is in the Tk module
;;;
(select-module Tk)
;=============================================================================
;
; I/O functions
;
;=============================================================================
(define (new-file txt . file)
(let ((file (if (null? file)
(Tk:get-open-file :title "Open File ...")
(car file))))
(when file
(let ((port (open-file file "r")))
(unless port (error "Cannot open file ~S for reading" file))
(txt 'delete "1.0" "end")
(do ((l (read-line port) (read-line port)))
((eof-object? l))
(txt 'insert "insert" l "" "\n" ""))
(fontify-whole-buffer txt)
;; retain this name as the default save name for this file
(set-widget-property! txt :default-file file)))))
(define (save-file-as txt)
(let* ((default (get-widget-property txt :default-file #f))
(dd (if default (dirname default) (getcwd)))
(df (if default (basename default) ""))
(file (Tk:get-save-file :title "Save File ..."
:initial-file df :initial-dir dd)))
(when file (save-file txt file))))
(define (save-file txt . file)
(let ((file (if (null? file)
(get-widget-property txt :default-file #f)
(car file))))
(if file
(let ((port (open-file file "w")))
(unless port (error "Cannot open file ~S for writing" file))
(display (txt 'get "1.0" "end") port)
(close-port port)
;; retain this name as the default save name for this file
(set-widget-property! txt :default-file file))
;; no file provided and no default value. Do the same thing as a "Save as ..."
(save-file-as txt))))
;=============================================================================
;
; Evaluation functions
;
; Only works if we have a standard console
;
;=============================================================================
(define (fill-standard-input s)
(if (complete-sexpr? s)
(%fill-stdin s)
(begin
(bell)
(error "Selected region is not a complete (or complete set of) sexpr"))))
(define (evaluate-buffer txt)
(unless (catch %fill-stdin)
;; We have a console
(fill-standard-input (txt 'get "1.0" "end"))))
(define (evaluate-region txt)
(unless (catch %fill-stdin)
;; We have a console
(let ((s #f))
(catch (set! s (txt 'get "sel.first" "sel.last")))
(and s (fill-standard-input s)))))
(define (evaluate-previous-sexpr txt)
(catch (let ((prev (find-previous-sexpr txt)))
(and prev (%fill-stdin prev)))))
;=============================================================================
;
; Editor -- menubar
;
;=============================================================================
(define (make-menubar parent txt)
(let* ((f (frame (& parent ".menu") :relief "ridge" :bd 1))
(b (make-bordered-frame f))
(file (menubutton (& b ".file") :text "File"))
(edit (menubutton (& b ".edit") :text "Edit"))
(evil (menubutton (& b ".eval") :text "Evaluate"))
(hlp (menubutton (& b ".help") :text "Help")))
;; File
(let ((m (menu (& file ".m") :tearoff #f)))
(tk-set! file :menu m)
(m 'add 'command :label "Open ..." :command (lambda () (new-file txt)))
(m 'add 'command :label "New Editor" :command make-editor-window)
(m 'add 'separator)
(m 'add 'command :label "Save" :command (lambda () (save-file txt)))
(m 'add 'command :label "Save as ..." :command (lambda () (save-file-as txt)))
(m 'add 'separator)
(m 'add 'command :label "Close" :command (lambda () (destroy parent)))
(m 'add 'command :label "Exit STk" :command (lambda () (exit 0))))
;; Edit
(let ((m (menu (& edit ".m") :tearoff #f)))
(tk-set! edit :menu m)
(m 'add 'command :label "Cut" :accel "Ctrl-X"
:command (lambda () (event 'gen txt "<<Cut>>")))
(m 'add 'command :label "Copy" :accel "Ctrl-C"
:command (lambda () (event 'gen txt "<<Copy>>")))
(m 'add 'command :label "Paste" :accel "Ctrl-V"
:command (lambda () (event 'gen txt "<<Paste>>")))
(m 'add 'command :label "Clear" :accel "Del"
:command (lambda () (event 'gen txt "<<Clear>>"))))
;; Evaluate
(let ((m (menu (& evil ".m") :tearoff #f)))
(tk-set! evil :menu m)
(m 'add 'command :label "Buffer"
:command (lambda () (evaluate-buffer txt)))
(m 'add 'command :label "Selection"
:command (lambda () (evaluate-region txt)))
(m 'add 'command :label "Previous Sexpr" :accel "KP-Enter"
:command (lambda () (evaluate-previous-sexpr txt))))
;; Help
(let ((m (menu (& hlp ".m") :tearoff #f)))
(tk-set! hlp :menu m)
(m 'add 'command :label "STk" :command (lambda () ; Indirect to avoid
(help))) ; autoloads
(m 'add 'command :label "Editor" :command (lambda () (help "editor"))))
(pack file edit evil :side "left")
(pack hlp :side "right")
f))
;=============================================================================
;
; Editor -- button bar
;
;=============================================================================
(define (make-buttonbar parent txt)
(let* ((f (frame (& parent ".butbar") :relief "ridge" :bd 1)))
(make-button-bar f
(list 5
(list "edit.gif"
"New Editor"
make-editor-window)
(list "diropen.gif"
"Open File"
(lambda () (new-file txt)))
(list "floppy.gif"
"Save File"
(lambda () (save-file txt)))
20
(list "copy.gif"
"Copy"
(lambda () (event 'gen txt "<<Copy>>")))
(list "clipboard.gif"
"Paste"
(lambda () (event 'gen txt "<<Paste>>")))
(list "cut.gif"
"Cut"
(lambda () (event 'gen txt "<<Cut>>")))
20
(list "evalbuf.gif"
"Eval buffer"
(lambda () (evaluate-buffer txt)))
(list "evalreg.gif"
"Eval region"
(lambda () (evaluate-region txt)))
20
(list "qmark.gif"
"Help on Editor"
(lambda () (help "editor")))))
f))
;=============================================================================
;
; Editor -- bottom bar
;
;=============================================================================
(define (make-bottombar parent txt)
(let* ((f (frame (& parent ".botbar") :bd 1 :relief "ridge"))
(l1 (label (& f ".l1") :width 10 :font '(Courier -12) :anchor 'w))
(l2 (label (& f ".l2") :width 10 :font '(Courier -12) :anchor 'w))
(updt (lambda ()
(let ((pos (txt 'index "insert")))
(tk-set! l1 :text (format #f " Line: ~A" (car pos)))
(tk-set! l2 :text (format #f " Col: ~A" (cdr pos)))))))
(set-widget-property! txt :idle-hook updt)
(updt) ; to set the first value
(pack l2 l1 :side "right")
f))
;=============================================================================
;
; Editor -- special bindings for Scheme text
;
;=============================================================================
(define (add-scheme-editor-binding txt)
(bind txt "<KP_Enter>" (lambda ()
(evaluate-previous-sexpr txt)
(event 'generate txt "<Return>")))
(bind txt "<Return>" (lambda ()
(after 'idle (lambda () (font-lock-indent txt ""))))))
(define (make-editor-window)
(let* ((top (toplevel (gensym "._ed__") :class "STkEdit"))
(f (frame (& top ".f")))
(txt (text (& f ".txt") :background "ivory2" :font *editor-font*))
(sb (scrollbar (& f ".scroll" :width 10)))
(menubar (make-menubar top txt))
(buttonbar (make-buttonbar top txt))
(botbar (make-bottombar top txt)))
;; Set title and the mode of the text-widget to scheme
(wm 'title top "STk editor")
(make-fontifiable txt)
(add-scheme-editor-binding txt)
;; Associate the scrollbar commands
(tk-set! sb :command (lambda l (apply txt 'yview l)))
(tk-set! txt :yscroll (lambda l (apply sb 'set l)))
;; Pack stuff
(pack txt :expand #t :fill "both" :side "left")
(pack sb :expand #f :fill "y" :side "left")
(pack menubar buttonbar :fill "x")
(pack f :expand #t :fill "both")
(pack botbar :fill "x")
txt))
(define (ed . file)
(let ((txt (make-editor-window)))
(unless (null? file)
(new-file txt (car file))))
(make-undefined))
(provide "edit")

12
Lib/error.stk
View File

@ -3,7 +3,7 @@
;;;; display
;;;;
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -16,7 +16,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 15-Sep-1993 14:11
;;;; Last file update: 1-Feb-1998 15:47
;;;; Last file update: 2-Feb-1999 08:47
;;;;
(require "dialog")
@ -83,7 +83,7 @@
;;;;; Listbox and its scrollbar
(set! lst (listbox lst :width 70 :height (max 2 (min (length el) 20))
:font "fixed"
:font '(Courier -12)
:xscroll (lambda args (apply scroll-x 'set args))
:yscroll (lambda args (apply scroll-y 'set args))))
(set! scroll-x (scrollbar scroll-x :orient "hor"
@ -143,7 +143,7 @@
(pack (listbox '.stackview.f.env
:width 18
:height 10
:font "fixed"
:font '(Courier -12)
:bd 1
:relief "raised")
:expand #f :fill "y" :side "left")
@ -151,7 +151,7 @@
(pack (listbox '.stackview.f.list
:width 70
:height 10
:font "fixed"
:font '(Courier -12)
:bd 1
:relief "raised"
:xscroll (lambda args (apply .stackview.f.sx 'set args))
@ -195,7 +195,7 @@
(pack (frame '.stackview.vt :bd 3 :relief "groove")
:expand #t :fill "both" :padx 5 :pady 5)
(pack (listener '.stackview.vt.l
:font "fixed"
:font '(Courier -12)
:wrap "word"
:height 10
:command (lambda (x) (format #f "~S"

186
Lib/font-chooser.stklos Normal file
View File

@ -0,0 +1,186 @@
;;;;
;;;; f o n t - c h o o s e r . s t k l o s -- A simple font editor widget
;;;;
;;;; Copyright © 1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: font-chooser.stklos 1.1 Mon, 01 Feb 1999 15:18:22 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 1-Feb-1999 08:55
;;;; Last file update: 1-Feb-1999 13:57
(require "Tk-classes")
;;; FIXME: These variables should be in the STklos+Tk module
(define *font-family* "courier")
(define *font-size* 12)
(define *font-weight* "normal")
(define *font-slant* "roman")
(define *font-under* #f)
(define *font-over* #f)
(define *font* #f) ; the prototype font
(select-module STklos+Tk)
(export make-font-chooser)
(define *font-lock* #f) ; to grab the window while choosing a font
;=============================================================================
;
; Utilities
;
;=============================================================================
(define (font-wait-result chooser)
(let ((cur-grab (grab 'current chooser))
(pretty (lambda ()
(append (list *font-family*
*font-size*
(string->symbol *font-slant*))
(if *font-under* '(underline) '())
(if *font-over* '(overstrike) '())))))
(tkwait 'visibility chooser)
(grab 'set chooser)
(tkwait 'variable '*font-lock*)
(and cur-grab (grab 'set cur-grab))
;; Compute result
(case *font-lock*
((ok) (destroy chooser) (pretty))
((cancel) (destroy chooser) #f))))
(define (%make-font-chooser fnt)
(define (change-font)
(font 'configure *font* :family *font-family*
:size *font-size*
:weight *font-weight*
:slant *font-slant*
:underline *font-under*
:overstrike *font-over*))
(define (change-family fam)
(set! *font-family* fam)
(change-font))
(define (change-size sz)
(set! *font-size* sz)
(change-font))
(define (make-sample parent)
(make <Label> :parent parent :font *font*
:text (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ\n"
"abcdefghijklmnopqrstuvwxyz\n"
"0123456789~`!@#$%^&*()_-+=\n"
"{}[]:;\"'<>,.?/")))
(define (set-variables)
(let* ((f (font 'actual fnt)))
(set! *font-family* (get-keyword :family f))
(set! *font-size* (get-keyword :size f))
(set! *font-under* (get-keyword :underline f))
(set! *font-weight* (get-keyword :weight f))
(set! *font-slant* (get-keyword :slant f))
(set! *font-over* (get-keyword :overstrike f))))
(define (make-top-frame parent)
(let* ((f (make <Frame> :parent parent :relief "groove" :border-width 2))
(family (make <Labeled-Entry> :parent f :title "Font Family:"
:width 25 :text-variable '*font-family*))
(size (make <Labeled-Entry> :parent f :title "Font Size:"
:string-value #f
:width 3 :text-variable '*font-size*))
(bold (make <Check-button> :parent f :text "B" :width 3
:font (font 'create :weight 'bold)
:on-value "bold" :off-value "normal"
:variable '*font-weight* :indicator-on #f
:command change-font))
(italic (make <Check-button> :parent f :text "i" :width 3
:font (font 'create :slant 'italic)
:on-value "italic" :off-value "roman"
:variable '*font-slant* :indicator-on #f
:command change-font))
(under (make <Check-button> :parent f :text "U" :width 3
:font (font 'create :underline #t)
:variable '*font-under* :indicator-on #f
:command change-font))
(over (make <Check-button> :parent f :text "O" :width 3
:font (font 'create :overstrike #t)
:variable '*font-over* :indicator-on #f
:command change-font)))
;; set global variables and pack widgets
(set-variables)
(pack family size bold under italic over :side 'left :padx 2)
; change binding of labeled-entry to allow direct ùanipulation
(bind (entry-of family) "<Return>" (lambda () (change-family *font-family*)))
(bind (entry-of size) "<Return>" (lambda () (change-size *font-size*)))
f))
(define (make-listboxes parent)
(let* ((f (make <Frame> :parent parent :relief "groove" :border-width 2))
(names (make <Scroll-listbox> :parent f :v-scroll-side "left"
:width 25 :value (sort (font 'families) string<?)))
(sz (make <Listbox> :parent f :width 3
:value '(8 10 12 14 16 18 24 36 48 72))))
(pack names sz :side "left" :fill 'y)
(bind (Id names) "<ButtonRelease-1>"
(lambda () (catch (change-family (selection 'get)))))
(bind (Id sz) "<ButtonRelease-1>"
(lambda () (catch (change-size (string->number (selection 'get))))))
f))
(define (make-buttons parent)
(let* ((f (make <Frame> :parent parent :relief "groove" :border-width 2))
(sel (make <Button> :parent f :text "Select"
:command (lambda () (set! *font-lock* 'ok))))
(cancel (make <Button> :parent f :text "Cancel"
:command (lambda () (set! *font-lock* 'cancel)))))
(wm 'protocol parent "WM_DELETE_WINDOW" (lambda() (set! *font-lock* 'cancel)))
(pack sel cancel :side 'left :padx 2 :pady 2)
f))
(let* ((t (make <Toplevel> :title "Font chooser ..." :geometry "500x300"))
(f (make <Frame> :parent t))
(top (make-top-frame t))
(box (make-listboxes f))
(txt (make-sample f))
(but (make-buttons t)))
; The internal frame
(pack box :fill 'y :expand #f :side 'left)
(pack txt :fill 'none :expand #t :side 'right)
(pack top :fill 'x :expand #f)
(pack f :fill 'both :expand #t)
(pack but :fill 'x :expand #f :side 'bottom)
t))
;=============================================================================
;
; make-font-chooser
;
;=============================================================================
(define (make-font-chooser . fnt)
;; If this is the first call to this function. Create the prototype font
(unless *font*
(set! *font* (apply font 'create (font 'actual fnt))))
;; Call the chooser box
(font-wait-result (%make-font-chooser (if (null? fnt) "courier" (car fnt)))))
(provide "font-chooser")

301
Lib/font-lock.stk Normal file
View File

@ -0,0 +1,301 @@
;;;; f o n t - l o c k . s t k -- A simple syntax high-lighter
;;;;
;;;; Copyright © 1998-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
;;;; that both the above copyright notice and this permission notice appear in
;;;; all copies and derived works. Fees for distribution or use of this
;;;; software or derived works may only be charged with express written
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: font-lock.stk 1.6 Mon, 01 Feb 1999 15:18:22 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 29-Oct-1998 18:51
;;;; Last file update: 1-Feb-1999 15:08
;; This package is a extra light version of the Emacs font-lock package
;; (specialized for Scheme)
;; It is a little bit slow and it is has some "bugs":
;; - Multi-lines comments are not correctly handled (because the
;; Tk text widget works line by line
;; - Regexps are very simplistic and not correct in all circumstances
;; - There is no way to customize the font-lock colors
;;
;; Any help to improve this package will be greatly appreciated
;;;
;;; Variables which which can be overloaded by the user file ~/.stkvars
;;;
(define-module STk
(define *fontify-keyword-color* "Green4")
(define *fontify-class-color* "Blue")
(define *fontify-syntax-color* "Purple3")
(define *fontify-comment-color* "Red")
(define *fontify-string-color* "IndianRed"))
;;;
;;; The rest of the file is in the Tk module
;;;
(select-module Tk)
;=============================================================================
;
; Global variables
;
;=============================================================================
(define *fontify-count* 0)
(define *fontify-idle* #t)
;;; Regexps for various think that we want "font-lockify". This is a list whose
;;; first element is the regexp and the second element is an offset
(define *fontify-keyword-regexp* (list "(^|[ \t]+):[0-9a-zA-Z_-]+" 0))
(define *fontify-comment-regexp* (list "(#!|;).*$|#\\|.*\\|#" 0))
(define *fontify-string-regexp* (list "\"([^\\\"]|\\\\.)*\"" 0))
(define *fontify-class-regexp* (list "<[^>]*>" 0))
(define *fontify-syntax-regexp* (list "\\((lambda|if|else|define(-macro|-generic|-method|-class)*|begin|case|cond|while|do|when|unless|set!|let(\\*|rec)*) "
1))
(define *fontify-syntax* '(lambda if else define define-macro define-generic
define-class begin case cond while do when
unless set let let* letrec))
;=============================================================================
;
; make-fontifiable
; Transforms a text widget in a widget able to do Scheme fontification
;
;=============================================================================
(define (make-fontifiable txt)
;; Creates tags for strings keywords comments. ORDER IS IMPORTANT!!!
(for-each (lambda (x)
(let ((name (car x))
(fg (cadr x)))
(txt 'tag 'configure name :foreground fg)))
(list
(list "keyword_tag" *fontify-keyword-color*)
(list "class_tag" *fontify-class-color*)
(list "syntax_tag" *fontify-syntax-color*)
(list "comment_tag" *fontify-comment-color*)
(list "string_tag" *fontify-string-color*)))
;; Define a mark which states where is the beginning of the region to font-lock
(txt 'mark 'set "start_fontify" "insert")
(txt 'mark 'gravity "start_fontify" 'left)
;; Change text bindings such that entering a new character triggers fontify
;; This is done by changing the "bindtags" of the text
(let* ((order (bindtags txt))
(text (member "Text" order))
(when-move (gensym "when-move")))
(when text
(set-cdr! text (cons "ScmTxt" (cdr text)))
(bindtags txt (cons when-move order)))
(bind when-move "<Tab>" (lambda (|W|) (reindent-line |W|) 'break))
(bind when-move "<Any-KeyPress>" (lambda (|W|) (idle-fontify |W|)))
(bind when-move "<Any-ButtonPress>" (lambda (|W|) (idle-fontify |W|))))
(bind "ScmTxt" "<Any-KeyPress>" (lambda (|W|)
(flash-delete-tags |W|)
(fontify-line |W| "insert")))
(for-each (lambda (x)
(bind "ScmTxt" x (lambda(|W|)
(fontify-buffer |W| "start_fontify"))))
'("<<Paste>>" "<ButtonRelease-2>" "<Control-l>"))
(bind "ScmTxt" ")" (lambda (|W|) (flash-paren |W| "(" ")")))
(bind "ScmTxt" "]" (lambda (|W|) (flash-paren |W| "[" "]")))
)
;=============================================================================
;
; Fontify functions
;
;=============================================================================
(define (fontify-line t pos)
(define (fontify-regexp regexp offset tag from to)
;; Search for all instances of a given regexp in a text widget and
;; apply a given tag to each instance found.
(t 'tag 'remove tag from to)
(let Loop ((start from))
(let ((cur (t 'search :regexp :count '*fontify-count*
;;;;FIXME: :env (module-environment (current-module))
regexp start to)))
(when cur
(let ((cur (cons (car cur) (+ (cdr cur) offset)))
(last (cons (car cur) (- (+ (cdr cur) *fontify-count*) offset))))
(t 'tag 'add tag cur last)
(loop last))))))
(let* ((start (t 'index (format #f "~A linestart" pos)))
(end (t 'index (format #f "~A lineend" pos)))
(do-font (lambda (rgxp tag)
(fontify-regexp (car rgxp) (cadr rgxp) tag start end))))
;; Eventually correct the start position
(if (t 'compare start "<" "start_fontify") (set! start "start_fontify"))
(do-font *fontify-keyword-regexp* "keyword_tag")
(do-font *fontify-class-regexp* "class_tag")
(do-font *fontify-syntax-regexp* "syntax_tag")
(do-font *fontify-string-regexp* "string_tag")
(do-font *fontify-comment-regexp* "comment_tag")))
(define (fontify-buffer t from-line)
(when *fontify-idle*
(set! *fontify-idle* #f)
(let ((start (car (t 'index from-line)))
(end (car (t 'index "end"))))
(let Loop ((line start))
(fontify-line t (cons line 0))
(after 'idle (lambda () (if (< line end) (Loop (+ line 1)))))))
(set! *fontify-idle* #t)))
(define (fontify-whole-buffer t)
(fontify-buffer t "1.0"))
;=============================================================================
;
; Flashing parenthesis
;
;=============================================================================
(define (flash-delete-tags txt)
(txt 'tag 'delete "fontify_flash")
(txt 'tag 'delete "fontify_bad_flash"))
(define (flash-paren txt open close)
;; Erase the current flashing parent and create a new tag for this one
(flash-delete-tags txt)
(txt 'tag 'conf "fontify_flash" :background "green")
;; Search the opening parenthesis
(let Loop ((depth 0) (count -2))
(let* ((pos (txt 'index (format #f "insert ~Ac" count)))
(char (txt 'get pos)))
(cond
((txt 'compare pos "<=" "start_fontify")
(if (and (string=? char open) (zero? depth))
(txt 'tag 'add "fontify_flash" pos)
(begin
;; create a tag to signal the bad match
(txt 'tag 'conf "fontify_bad_flash" :background "red")
(txt 'tag 'add "fontify_bad_flash" "insert-1c"))))
((string=? char close) (Loop (- depth 1) (- count 1)))
((string=? char open) (if (zero? depth)
(txt 'tag 'add "fontify_flash" pos)
(Loop (+ depth 1) (- count 1))))
(else (Loop depth (- count 1)))))))
(define (idle-fontify txt)
(after 'idle
(lambda ()
; fontify current line
(fontify-line txt "insert")
; see if we have an opening parenthesis to flash
(flash-delete-tags txt)
(let ((cur (txt 'get "insert-1c")))
(cond
((string=? cur ")") (flash-paren txt "(" ")"))
((string=? cur "]") (flash-paren txt "[" "]"))))
; if the text has a idle-hook associated execute it
(let ((hook (get-widget-property txt :idle-hook #f)))
(if hook (hook))))))
;=============================================================================
;
; font-lock-indent
;
; This is not really fontification. Anyway this so close ...
;=============================================================================
(define (how-much-spaces line) ; find the amount of spaces needed for next line
(let ((len (string-length line))
(spc 0))
;; Find the number of leading spaces
(let Loop ((i 0))
(if (and (< i len) (memv (string-ref line i) '(#\space #\tab)))
(Loop (+ i 1))
(set! spc i)))
;; Find te position of last open parenthesis (which is not closed)
(let Loop ((i spc) (stack '()))
(if (< i len)
(case (string-ref line i)
((#\( #\[) (Loop (+ i 1) (cons i stack)))
((#\) #\]) (Loop (+ i 1) (if (null? stack) stack (cdr stack))))
(else (Loop (+ i 1) stack)))
;; string exhausted
(unless (null? stack)
(let* ((pos (+ (car stack) 1))
(s (substring line pos len))
(first #f))
;; See if the first word the substring is a symbol
(catch (set! first (read-from-string s)))
(if (symbol? first)
; car of the list is a symbol
(if (memv first *fontify-syntax*)
;; We have syntax. Do a small indent
(set! spc (+ pos 2))
;; Not syntax. Find the first non space after it
(let Loop
((i (+ pos (string-length (symbol->string first)))))
(if (and (< i len)
(memv (string-ref line i) '(#\space #\tab)))
(Loop (+ i 1))
(set! spc i))))
;; Not a symbol. Indent just after the parenthesis
(set! spc pos))))))
spc))
(define (font-lock-indent txt tag) ;; tag is the tag associated to inserted spaces
(let* ((pos (if (txt 'compare "insert linestart -1l" "<" "start_fontify linest")
"start_fontify linestart"
"insert linestart -1 l"))
(line (txt 'get pos "insert-1l lineend"))
(spc (how-much-spaces line)))
(txt 'insert "insert" (make-string spc #\space) tag)))
(define (find-previous-sexpr txt)
(let ((pos (txt 'tag 'ranges "fontify_flash")))
(if (= (length pos) 2)
(txt 'get (car pos) "insert")
#f)))
(define (reindent-line txt)
(define (trim l)
(let Loop ((pos 0)
(max (string-length l)))
(if (or (>= pos max)
(not (memv (string-ref l pos) '(#\space #\tab))))
(substring l pos max)
(Loop (+ pos 1) max))))
(let* ((line (txt 'get "insert linestart" "insert lineend"))
(tline (trim line)))
(txt 'delete "insert linestart" "insert lineend")
(font-lock-indent txt "")
(txt 'insert "insert" tline)))
(provide "font-lock")
;======================================================================
#|
(pack (text '.t) :expand #t :fill "both")
(make-fontifiable .t)
|#

46
Lib/ftp.stklos
View File

@ -4,7 +4,7 @@
;;;; A lot of things are missing
;;;; (See RFC 959)
;;;;
;;;; Copyright © 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -14,9 +14,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: ftp.stklos 1.4 Mon, 01 Feb 1999 15:18:22 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 10-Jun-1996 12:22
;;;; Last file update: 9-Apr-1998 10:46
;;;; Last file update: 28-Jan-1999 23:31
(require "stklos")
(require "posix")
@ -76,26 +78,6 @@
;;;
;;; Utilities
;;;
(define-method ftp-data ((self <FTP-connection>) cmd)
(let* ((s (make-server-socket 0))
(c (socket-of self))
(n (socket-port-number s))
(ip (regexp-replace-all "\\." (socket-local-address c) ",")))
(if (and (ftp-write-line self (format #f "PORT ~A,~A,~A" ip
(quotient n 256) (remainder n 256)) #f)
(ftp-write-line self cmd #f))
;; Transfer seems OK
(begin
(socket-accept-connection s)
(let ((in (socket-input s)))
(do ((l (read-line in) (read-line in)))
((eof-object? l))
(display l)
(newline)))
(ftp-read-line self #f))
;; There something which is not OK (we should be more precise here)
#f)))
(define-method ftp-data ((self <FTP-connection>) cmd)
(let* ((s (make-server-socket 0))
@ -148,24 +130,36 @@
(ftp-write-line s "TYPE A" #f)
(let* ((cmd (if (null? args) "LIST" (format #f "NLST ~A" (car args))))
(sock (ftp-data s cmd)))
(and sock (ftp-copy s (socket-input sock) (current-output-port) #f))))
(and sock
(ftp-copy s (socket-input sock) (current-output-port) #f)
(socket-shutdown sock)
#t)))
(define (ftp-get s file)
(ftp-write-line s "TYPE I" #f)
(let* ((cmd (format #f "RETR ~A" file))
(sock (ftp-data s cmd)))
(and sock (ftp-copy s (socket-input sock) (open-output-file file) #f))))
(and sock
(ftp-copy s (socket-input sock) (open-output-file file) #f)
(socket-shutdown sock)
#t)))
(define (ftp-display s file)
(ftp-write-line s "TYPE A" #f)
(let* ((cmd (format #f "RETR ~A" file))
(sock (ftp-data s cmd)))
(and sock (ftp-copy s (socket-input sock) (current-output-port) #f))))
(and sock
(ftp-copy s (socket-input sock) (current-output-port) #f)
(socket-shutdown sock)
#t)))
(define (ftp-put s file)
(ftp-write-line s "TYPE I" #f)
(let* ((cmd (format #f "STOR ~A" file))
(sock (ftp-data s cmd)))
(and sock (ftp-copy s (open-input-file file) (socket-output sock) #t))))
(and sock
(ftp-copy s (open-input-file file) (socket-output sock) #t)
(socket-shutdown sock)
#t)))
(provide "ftp")

4
Lib/image.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; i m a g e . s t k -- Images functions for STk
;;;;
;;;; Copyright © 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -13,7 +13,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 15-Oct-1996 14:25
;;;; Last file update: 28-Feb-1998 18:20
;;;; Last file update: 22-Jan-1999 12:10
(require "hash")

22
Lib/init.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; i n i t . s t k -- The file launched at startup
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -11,11 +11,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: init.stk 1.17 Sat, 26 Sep 1998 19:19:52 +0200 eg $
;;;; $Id: init.stk 1.22 Tue, 02 Feb 1999 15:29:27 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: ??-Sep-1993 ??:??
;;;; Last file update: 26-Sep-1998 17:22
;;;; Last file update: 2-Feb-1999 13:46
;;;;
;;;==============================================================================
@ -454,9 +454,19 @@
(else (apply fn l))))
(define (os-kind)
(case (machine-type)
(("MS_Win32") 'Windows)
(else 'Unix)))
(if (string=? (machine-type) "Ms-Win32")
'Windows
'Unix))
;; Tell if the parameter string is a complete (or a set of complete) sexpr
(define (complete-sexpr? s)
(with-input-from-string s
(lambda ()
(let Loop ()
(let ((sexpr #f))
(if (catch (set! sexpr (read)))
#f
(or (eof-object? sexpr) (Loop))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;

10
Lib/listbox.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; Listboxes bindings and procs
;;;;
;;;; Copyright © 1993-1997 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -17,7 +17,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-1993 12:35
;;;; Last file update: 27-Aug-1997 19:07
;;;; Last file update: 8-Dec-1998 13:09
;;;;
(select-module Tk)
@ -139,8 +139,8 @@
(Tk:listbox-select-all |W|))
(define-binding "Listbox" "<Control-backslash>" (|W|)
(unless (equal? (tk-get |W| :selectmode != "browse"))
(|W| 'selection 'clear 0 'end)))
(unless (equal? (tk-get |W| :selectmode) "browse"))
(|W| 'selection 'clear 0 'end))
;; Additional Tk bindings that aren't part of the Motif look and feel:
@ -334,7 +334,7 @@
(w 'see el)
(if (w 'selection 'includes 'anchor)
(Tk:listbox-motion w el)))
((string=? mode "multiple") (w 'activate $el)
((string=? mode "multiple") (w 'activate el)
(w 'see el)))))
;; Tk:listbox-cancel

9
Lib/scrollbar.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; Scrollbars bindings and procs
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -17,13 +17,12 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-1993 12:35
;;;; Last file update: 21-Mar-1998 12:46
;;;; Last file update: 2-Feb-1999 14:49
;;;;
(select-module Tk)
(when (eqv? (os-kind) 'Unix)
(let ()
(let ()
(define tk::init-pos "")
(define tk::init-values '())
@ -356,4 +355,4 @@
(w 'activate 'slider)
(Tk:scroll-start-drag w x y)))))
))
)

45
Lib/text.stk
View File

@ -1,5 +1,5 @@
;;;;
;;;; Texts bindings and procs (bindings a` la emacs)
;;;; Texts bindings and procs (bindings à la emacs)
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
@ -14,11 +14,11 @@
;;;; This software is a derivative work of other copyrighted softwares; the
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
;;;;
;;;; $Id: text.stk 1.5 Wed, 30 Sep 1998 14:02:29 +0200 eg $
;;;; $Id: text.stk 1.7 Fri, 11 Dec 1998 21:01:53 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-1993 12:35
;;;; Last file update: 27-Sep-1998 12:20
;;;; Last file update: 8-Dec-1998 16:00
;;;;
(select-module Tk)
@ -133,6 +133,19 @@
(w 'tag 'add "sel" first last)
(w 'tag 'remove "sel" last "end"))))
;; Tk:paste-txt --
;; This procedure sets the insertion cursor to the mouse position,
;; inserts the selection, and sets the focus to the window.
;;
;; Arguments:
;; w - The text window.
;; x, y - Position of the mouse.
(define (Tk:paste-txt w x y)
(w 'mark 'set 'insert (tk:text-closest-gap w x y))
(catch (w 'insert "insert" (selection 'get :displayof w)))
(if (equal? (tk-get w :state) "normal")
(focus w)))
;; Tk:text-auto-scan --
;; This procedure is invoked when the mouse leaves an "Text" window
@ -364,13 +377,12 @@
;;
;; w - The text window.
;; x, y - Position of the mouse.
(define (Tk:text-mouse-paste |W| x y)
(|W| 'mark 'set 'insert (Tk:text-closest-gap |W| x y))
(catch (|W| 'insert 'insert (selection 'get :displayof |W|)))
(if (string=? (tk-get |W| :state) "normal")
(focus |W|)))
;;(define (Tk:text-mouse-paste |W| x y)
;; (|W| 'mark 'set 'insert (Tk:text-closest-gap |W| x y))
;; (catch (|W| 'insert 'insert (selection 'get :displayof |W|)))
;; (if (string=? (tk-get |W| :state) "normal")
;; (focus |W|)))
;;
;; Tk:text-copy --
;; This procedure copies the selection from a text widget into the clipboard.
@ -396,6 +408,9 @@
(clipboard 'append :displayof w (selection 'get :displayof w))
(w 'delete 'sel.first 'sel.last))))
;; Tk:text-paste --
;; This procedure pastes the contents of the clipboard to the insertion
;; point in a text widget.
@ -403,9 +418,9 @@
;; w - Name of a text widget.
(define (Tk:text-paste w)
(catch
(catch
(unless (eqv? (os-kind) 'Unix)
(w 'delete 'sel.first 'sel.last))
(catch (w 'delete 'sel.first 'sel.last)))
(w 'insert 'insert (selection 'get :displayof w :selection "CLIPBOARD"))))
;;-------------------------------------------------------------------------
@ -610,7 +625,7 @@
(define-binding "Text" "<<PasteSelection>>" (|W| x y)
(if (or (not tk::mouse-moved) *tk-strict-motif*)
(Tk:text-mouse-paste |W| x y)))
(Tk:paste-txt |W| x y)))
(define-binding "Text" "<Insert>" (|W|)
(catch
@ -666,10 +681,6 @@
(define-binding "Text" "<Control-t>" (|W|)
(Tk:text-transpose |W|))
(when (eqv? (os-kind) 'Unix) ;; Unix Only
(define-binding "Text" "<Control-v>" (|W|)
(Tk:text-scroll-pages |W| +1)))
(define-binding "Text" "<Meta-b>" (|W|)
(Tk:text-set-cursor |W| "insert - 1c wordstart"))

29
Lib/tk-init.stk
View File

@ -17,11 +17,11 @@
;;;; This software is a derivative work of other copyrighted softwares; the
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
;;;;
;;;; $Id: tk-init.stk 1.18 Wed, 30 Sep 1998 14:02:29 +0200 eg $
;;;; $Id: tk-init.stk 1.20 Fri, 11 Dec 1998 21:01:53 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-1993 12:35
;;;; Last file update: 27-Sep-1998 12:26
;;;; Last file update: 11-Dec-1998 19:36
;;;;
(unless (equal? *tk-version* "8.0")
@ -59,6 +59,27 @@
`(bind ,class ,event "")
`(bind ,class ,event (lambda ,args ,@body))))
;;
;; Read and write access to the data associated to widget
;;
(define (set-widget-property! widget name value)
(let ((data (get-widget-data widget)))
(if (or (not data) (null? data))
(set-widget-data! widget (list name value))
(let ((prop (memv name data)))
(if prop
(set-cdr! prop (cons value (cddr prop)))
(set-widget-data! widget (append (list name value) data)))))))
(define (get-widget-property widget name . default)
(let ((data (get-widget-data widget)))
(if (or (not data) (null? data))
(if (null? default)
(error "get-widget-property: No property ~S in ~S" name widget)
(car default))
(apply get-keyword name data default))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Following vars are used everywhere. So define them here
@ -320,7 +341,7 @@
;;;; Some autoloads
;;;;
(autoload "dialog" STk:make-dialog STk:center-window)
(autoload "editor" ed) ; Editor must be changed
(autoload "edit" ed)
(autoload "error" STk:report-error bgerror)
(autoload "focus" Tk:focus-next Tk:focus-prev)
(autoload "listener" listener)
@ -333,7 +354,7 @@
(when (eq? (os-kind) 'Unix)
(autoload "tk-unix" Tk:choose-color Tk:message-box
Tk:get-open-file Tk:get-set-file Tk:get-file))
Tk:get-open-file Tk:get-save-file Tk:get-file))
;=============================================================================
;

6
Lib/tk-unix.stk
View File

@ -12,11 +12,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: tk-unix.stk 1.2 Thu, 10 Sep 1998 23:44:28 +0200 eg $
;;;; $Id: tk-unix.stk 1.3 Sun, 01 Nov 1998 10:56:14 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 10-Sep-1998 23:20
;;;; Last file update: 10-Sep-1998 23:29
;;;; Last file update: 26-Oct-1998 16:00
;;; Functions defined here are only loaded when we are on Unix.
;;; On windows, they are defined in C and implemented using the
@ -61,7 +61,7 @@
; Tk:get-open-file
;
;=============================================================================
(define (Tk:get-file . l)
(define (Tk:get-open-file . l)
(require "Tk-classes")
(apply (with-module STklos+Tk Tk:get-open-file) l))

8
Lib/www-browser.stklos
View File

@ -1,7 +1,7 @@
;;;;
;;;; w w w - b r o w s e r . s t k l o s -- A simple WEB browser
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -13,7 +13,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 21-Oct-1996 14:02
;;;; Last file update: 28-May-1998 19:14
;;;; Last file update: 2-Feb-1999 09:00
;;;;
(require "Tk-classes")
@ -70,8 +70,8 @@
(define (make-interface parent)
(let* ((loc (make <Labeled-entry> :parent parent :title "Location:"
:font "fixed"))
(txt (make <Scroll-text> :parent parent :font "fixed"
:font '(Courier -12)))
(txt (make <Scroll-text> :parent parent :font '(Courier -12)
:width 100 :height 45))
(f (make-buttons parent (Id txt)))
(f1 (make <Frame> :parent parent))

6
Lib/www-file.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; w w w - f i l e . s t k -- WWW for STk (FILE: protocol)
;;;;
;;;; Copyright Š 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -16,7 +16,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 4-Oct-1996 22:14
;;;; Last file update: 28-Feb-1998 11:06
;;;; Last file update: 22-Jan-1999 13:55
;; Add the "FILE:" protocol
@ -30,7 +30,7 @@
(files (sort (all dir) string<?))
(link (lambda (img ref txt)
(format out "<A HREF=file:~A>" ref)
(format out "<IMG ALIGN=middle SRC=@~A@.xpm>~A</A>\n"
(format out "<IMG ALIGN=middle SRC=@~A@.gif>~A</A>\n"
img txt))))
(chdir cwd)

16
Lib/www-img.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; w w w - i m g . s t k -- WWW for STk (images file reader)
;;;;
;;;; Copyright © 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -16,7 +16,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 6-Oct-1996 17:12
;;;; Last file update: 11-Apr-1998 11:50
;;;; Last file update: 1-Feb-1999 18:46
;;;;
(require "image")
@ -42,12 +42,12 @@
(define (load-default-image name)
;; Default images must have the following name
;; file:@parentdir.xpm
;; file:@dir.xpm
;; file:@file.xpm
;; file:@parentdir.gif
;; file:@dir.gif
;; file:@file.gif
;; These names are generated by the directory viewer.
(make-image (string-append "@" name "@.xpm")
:file (string-append *stk-library* "/Images/" name ".xpm")))
(make-image (string-append "@" name "@.gif")
:file (string-append *stk-library* "/Images/" name ".gif")))
;=============================================================================
;
@ -96,7 +96,7 @@
;;;; Initialize package
(need "pixmap")
(need "jpeg")
;(need "jpeg")
(when (provided? "pixmap")
(load-default-image "parentdir")

6
Lib/www.stk
View File

@ -1,7 +1,7 @@
;;;;
;;;; w w w . s t k -- WWW for STk
;;;;
;;;; Copyright © 1996-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1996-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -16,7 +16,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 4-Oct-1996 16:14
;;;; Last file update: 11-Apr-1998 11:51
;;;; Last file update: 1-Feb-1999 19:34
;;
;; This module needs a library of protocol getters & file viewers to be
@ -147,7 +147,7 @@
;;
(set! *loading-document* #t)
; Reset text
(tk-set! txt :state "normal" :wrap "word" :tabs 8 :font "fixed")
(tk-set! txt :state "normal" :wrap "word" :tabs 8)
(txt 'delete 1.0 "end")
; Insert url
(set! www:stop-loading #f)

8
Makefile.in
View File

@ -12,9 +12,11 @@
# permission of the copyright holder.
# This software is provided ``as is'' without express or implied warranty.
#
# $Id: Makefile.in 1.3.1.11 Mon, 28 Dec 1998 23:12:55 +0100 eg $
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: ??-Sep-1993 ??:??
# Last file update: 30-Sep-1998 09:52
# Last file update: 28-Dec-1998 23:12
#
@ -192,9 +194,9 @@ clean:
(cd Doc; $(MAKE) clean)
/bin/rm -f core *~ Makefile config.* Src/Makefile
checkin-n:
cin:
@(cat VERSION; prcs checkin -n)
checkin:
ci:
@(cat VERSION; prcs checkin)

14
README
View File

@ -15,11 +15,9 @@ functions, multi-methods and a Meta Object Protocol).
This release runs on majors Unix versions (Linux, Solaris, OSF, ...)
The previous version was also running on Microsoft Win32 (port of
current version is planned but has not be done yet).
This version also runs on Win32. Consider this port as beta.
Version 3.99 uses the Tk 8.0.3 package for the graphical widgets
(Tk8.0.3 is the latest stable release of Tk).
Version 3.99 uses the Tk 8.0.3 package for the graphical widgets.
DIFFERENCE PREVIOUS RELEASE
@ -48,10 +46,13 @@ distribution main directory for more informations.
web (i.e. you can grab distant texts or images). The
Web browser admit now applets written in Scheme.
* Numerous bug corrections
* Runs on Win32 platforms
* New option -console to run STk in a windowed environment
(with indentation and fontification).
* ...
SCHEME WITHOUT TK
SCHEME WITHOUT TK (for Unix Only)
-----------------
Standard make build a light version of STk which does not provide support for
@ -121,7 +122,8 @@ For now, STk is known to run on the following machine/systems
Version 3.1.1 is also known to run on Windows 95 (and probably Windows NT).
The version 3.99 has not been ported yet on this environment. Sorry for that.
The version 3.99.4 has also been ported on this environment. Consider this port
as beta.
If you install it on another architecture/system, please let me now the

504
STk.prj
View File

@ -1,16 +1,17 @@
;; -*- Lisp -*-
(Created-By-Prcs-Version 1 2 8)
(Project-Description "The STk Scheme Interpreter")
(Project-Version STk 3.99.3 24)
(Parent-Version STk 3.99.3 23)
(Project-Version STk 3.99.4 21)
(Parent-Version STk 3.99.4 20)
(Version-Log "")
(New-Version-Log "")
(Checkin-Time "Wed, 30 Sep 1998 15:23:06 +0200")
(Checkin-Time "Tue, 02 Feb 1999 15:49:11 +0100")
(Checkin-Login eg)
(Populate-Ignore ("\\.o$"
"\\.a$"
"\\.so$"
"core$"
"*~"
"config.log$"
"config.cache$"
"config.make$"
@ -34,16 +35,17 @@
(Files
;; Top Level Files
(configure.in (STk/K/29_configure. 1.1.1.8 644))
(configure (STk/K/30_configure 1.1.1.8 755))
(VERSION (STk/K/31_VERSION 1.5 644))
(README (STk/K/32_README 1.5 644))
(Makefile.in (STk/K/33_Makefile.i 1.3.1.8 644))
(INSTALL (STk/K/35_INSTALL 1.6 644))
(ChangeLog (STk/K/36_ChangeLog 1.20.1.27 644))
(configure.in (STk/K/29_configure. 1.1.1.11 644))
(configure (STk/K/30_configure 1.1.1.11 755))
(VERSION (STk/K/31_VERSION 1.6 644))
(README (STk/K/32_README 1.6 644))
(Makefile.in (STk/K/33_Makefile.i 1.3.1.11 644))
(INSTALL (STk/K/35_INSTALL 1.7 644))
(INSTALL.win32 (STk/i/b/46_INSTALL.wi 1.1 644))
(ChangeLog (STk/K/36_ChangeLog 1.20.1.41 644))
(COPYRIGHTS (STk/K/37_COPYRIGHTS 1.1 644))
(COMPILING-HINTS (STk/K/38_COMPILING- 1.1 444))
(CHANGES (STk/K/39_CHANGES 1.8 644))
(CHANGES (STk/K/39_CHANGES 1.9 644))
(BINARY_DISTRIB (STk/K/40_BINARY_DIS 1.2 644))
(paths (STk/e/b/29_paths 1.1 644))
@ -188,13 +190,13 @@
(Demos/Widget/Wbutton.stklos (STk/M/5_Wbutton.st 1.1 444))
(Demos/Widget/Wcheck.stklos (STk/M/6_Wcheck.stk 1.1 444))
(Demos/Widget/Wcolors.stklos (STk/M/7_Wcolors.st 1.1 444))
(Demos/Widget/Wcscroll.stklos (STk/c/b/26_Wcscroll.s 1.1 644))
(Demos/Widget/Wcscroll.stklos (STk/c/b/26_Wcscroll.s 1.3 644))
(Demos/Widget/Wctext.stklos (STk/M/8_Wctext.stk 1.1 444))
(Demos/Widget/Wdialog1.stklos (STk/M/9_Wdialog1.s 1.1 444))
(Demos/Widget/Wdialog2.stklos (STk/M/10_Wdialog2.s 1.1 444))
(Demos/Widget/Wentry1.stklos (STk/M/11_Wentry1.st 1.1 444))
(Demos/Widget/Wentry2.stklos (STk/M/12_Wentry2.st 1.1 444))
(Demos/Widget/Wfloor.stklos (STk/c/b/27_Wfloor.stk 1.1 644))
(Demos/Widget/Wfloor.stklos (STk/c/b/27_Wfloor.stk 1.3 644))
(Demos/Widget/Wform.stklos (STk/M/13_Wform.stkl 1.1 444))
(Demos/Widget/Whscale.stklos (STk/M/14_Whscale.st 1.1 444))
(Demos/Widget/Wicon.stklos (STk/M/15_Wicon.stkl 1.1 444))
@ -214,14 +216,14 @@
(Demos/Widget/Wtext.stklos (STk/M/28_Wtext.stkl 1.1 444))
(Demos/Widget/Wvscale.stklos (STk/M/29_Wvscale.st 1.1 444))
(Demos/Widget/Wwind.stklos (STk/M/30_Wwind.stkl 1.2 644))
(Demos/amib.stklos (STk/M/31_amib.stklo 1.2 755))
(Demos/browse.stk (STk/M/32_browse.stk 1.2 755))
(Demos/browse.stklos (STk/M/33_browse.stk 1.2 755))
(Demos/amib.stklos (STk/M/31_amib.stklo 1.4 755))
(Demos/browse.stk (STk/M/32_browse.stk 1.4 755))
(Demos/browse.stklos (STk/M/33_browse.stk 1.4 755))
(Demos/calc.stklos (STk/M/34_calc.stklo 1.2 755))
(Demos/classbrowse.stklos (STk/e/b/41_classbrows 1.1 755))
(Demos/colormap.stk (STk/M/35_colormap.s 1.2 755))
(Demos/filebox.stklos (STk/M/37_filebox.st 1.2 755))
(Demos/hanoi.stk (STk/M/38_hanoi.stk 1.1 555))
(Demos/colormap.stk (STk/M/35_colormap.s 1.3 755))
(Demos/filebox.stklos (STk/M/37_filebox.st 1.3 755))
(Demos/hanoi.stk (STk/M/38_hanoi.stk 1.3 755))
(Demos/hello.stk (STk/M/39_hello.stk 1.1 555))
(Demos/hello.stklos (STk/M/40_hello.stkl 1.1 555))
(Demos/inspector.stk (STk/M/41_inspector. 1.1 555))
@ -231,15 +233,15 @@
(Demos/showvars.stk (STk/M/45_showvars.s 1.2 755))
(Demos/small-ed.stk (STk/M/46_small-ed.s 1.1 555))
(Demos/stetris.stk (../Contrib/Stetris/stetris.stk) :symlink)
(Demos/stklos-demo.stklos (STk/M/47_stklos-dem 1.2 755))
(Demos/stklos-demo2.stklos (STk/M/48_stklos-dem 1.2 555))
(Demos/stklos-widgets.stklos (STk/M/49_stklos-wid 1.4 755))
(Demos/stklos-demo.stklos (STk/M/47_stklos-dem 1.4 755))
(Demos/stklos-demo2.stklos (STk/M/48_stklos-dem 1.4 755))
(Demos/stklos-widgets.stklos (STk/M/49_stklos-wid 1.5 755))
(Demos/term.stk (STk/M/50_term.stk 1.2 755))
(Demos/tkcolor.stklos (STk/M/51_tkcolor.st 1.1 555))
(Demos/ttt.stk (STk/N/0_ttt.stk 1.1 755))
(Demos/turtle.stk (STk/N/1_turtle.stk 1.1 755))
(Demos/S-scape.stklos (STk/d/b/5_S-scape.st 1.1 755))
(Demos/widget.stk (STk/N/3_widget.stk 1.3 755))
(Demos/widget.stk (STk/N/3_widget.stk 1.5 755))
(Demos/wtour.stk (../Contrib/STk-wtour/lib/wtour.stk) :symlink)
;; Documentation Directory
@ -254,18 +256,18 @@
(Doc/Extension/posix.c (../../Extensions/posix.c) :symlink)
(Doc/Extension/stack.c (../../Extensions/stack.c) :symlink)
(Doc/Extension/time.c (../../Extensions/time.c) :symlink)
(Doc/FAQ/FAQ-1.html (STk/N/9_FAQ-1.html 1.1 444))
(Doc/FAQ/FAQ-2.html (STk/N/10_FAQ-2.html 1.1 444))
(Doc/FAQ/FAQ-3.html (STk/N/11_FAQ-3.html 1.1 444))
(Doc/FAQ/FAQ-4.html (STk/N/12_FAQ-4.html 1.1 444))
(Doc/FAQ/FAQ-5.html (STk/N/13_FAQ-5.html 1.1 444))
(Doc/FAQ/FAQ-6.html (STk/N/14_FAQ-6.html 1.1 444))
(Doc/FAQ/FAQ.dvi (STk/N/15_FAQ.dvi 1.1 444) :no-keywords)
(Doc/FAQ/FAQ.html (STk/N/16_FAQ.html 1.1 444))
(Doc/FAQ/FAQ.ps (STk/N/17_FAQ.ps 1.1 444))
(Doc/FAQ/FAQ.txt (STk/N/18_FAQ.txt 1.1 444))
(Doc/Isotas96/Isotas96.dvi (STk/N/19_Isotas96.d 1.9 644) :no-keywords)
(Doc/Isotas96/Isotas96.ps (STk/N/20_Isotas96.p 1.9 644))
(Doc/FAQ/FAQ-1.html (STk/N/9_FAQ-1.html 1.1 644))
(Doc/FAQ/FAQ-2.html (STk/N/10_FAQ-2.html 1.1 644))
(Doc/FAQ/FAQ-3.html (STk/N/11_FAQ-3.html 1.1 644))
(Doc/FAQ/FAQ-4.html (STk/N/12_FAQ-4.html 1.1 644))
(Doc/FAQ/FAQ-5.html (STk/N/13_FAQ-5.html 1.1 644))
(Doc/FAQ/FAQ-6.html (STk/N/14_FAQ-6.html 1.1 644))
(Doc/FAQ/FAQ.dvi (STk/N/15_FAQ.dvi 1.1 644) :no-keywords)
(Doc/FAQ/FAQ.html (STk/N/16_FAQ.html 1.1 644))
(Doc/FAQ/FAQ.ps (STk/N/17_FAQ.ps 1.1 644))
(Doc/FAQ/FAQ.txt (STk/N/18_FAQ.txt 1.1 644))
(Doc/Isotas96/Isotas96.dvi (STk/N/19_Isotas96.d 1.10 644) :no-keywords)
(Doc/Isotas96/Isotas96.ps (STk/N/20_Isotas96.p 1.10 644))
(Doc/Isotas96/Isotas96.tex (STk/N/21_Isotas96.t 1.1 444))
(Doc/Isotas96/Makefile (STk/N/22_Makefile 1.1 444))
(Doc/Isotas96/bibliography.bib (../bibliography.bib) :symlink)
@ -353,7 +355,7 @@
(Doc/Reference/Appendix-B.tex (STk/O/45_Appendix-B 1.2 644))
(Doc/Reference/Appendix-C.tex (STk/O/46_Appendix-C 1.2 644))
(Doc/Reference/Appendix-D.tex (STk/O/47_Appendix-D 1.2 644))
(Doc/Reference/Appendix-E.tex (STk/O/48_Appendix-E 1.5 644))
(Doc/Reference/Appendix-E.tex (STk/O/48_Appendix-E 1.6 644))
(Doc/Reference/Appendix-F.tex (STk/e/b/5_Appendix-F 1.2 644))
(Doc/Reference/Detail.ps (STk/O/49_Detail.ps 1.1 444))
(Doc/Reference/Inspector.ps (STk/O/50_Inspector. 1.1 444))
@ -368,8 +370,8 @@
(Doc/Reference/hierarchy.eps (STk/P/6_hierarchy. 1.1 444))
(Doc/Reference/hierarchy.fig (STk/P/7_hierarchy. 1.1 444))
(Doc/Reference/index.stk (STk/P/8_index.stk 1.1 444))
(Doc/Reference/manual.dvi (STk/P/9_manual.dvi 1.11 644) :no-keywords)
(Doc/Reference/manual.ps (STk/P/10_manual.ps 1.10 644) :no-keywords)
(Doc/Reference/manual.dvi (STk/P/9_manual.dvi 1.12 644) :no-keywords)
(Doc/Reference/manual.ps (STk/P/10_manual.ps 1.11 644) :no-keywords)
(Doc/Reference/manual.tex (STk/P/11_manual.tex 1.4 644))
(Doc/STklos+Tk/Basic-Fig-1.ps (STk/P/12_Basic-Fig- 1.1 444))
(Doc/STklos+Tk/Chap1.tex (STk/P/13_Chap1.tex 1.1 444))
@ -397,17 +399,17 @@
;; Modules Extensions Directory
(Extensions/%README (STk/P/32_%README 1.3 644))
(Extensions/Makefile.in (STk/P/33_Makefile.i 1.4 644))
(Extensions/base64.c (STk/e/b/30_base64.c 1.1 644))
(Extensions/base64.c (STk/e/b/30_base64.c 1.3 644))
(Extensions/configure (STk/P/35_configure 1.2 755))
(Extensions/configure.in (STk/P/36_configure. 1.2 644))
(Extensions/hash.c (STk/P/37_hash.c 1.2 644))
(Extensions/html.c (STk/P/38_html.c 1.2 644))
(Extensions/hash.c (STk/P/37_hash.c 1.4 644))
(Extensions/html.c (STk/P/38_html.c 1.4 644))
(Extensions/jpeg.c (STk/P/39_jpeg.c 1.1 444))
(Extensions/locale.c (STk/e/b/42_locale.c 1.1 644))
(Extensions/pixmap.c (STk/P/40_pixmap.c 1.1 644))
(Extensions/posix.c (STk/P/41_posix.c 1.2 644))
(Extensions/process.c (STk/P/42_process.c 1.3 644))
(Extensions/socket.c (STk/P/43_socket.c 1.3 644))
(Extensions/posix.c (STk/P/41_posix.c 1.3 644))
(Extensions/process.c (STk/P/42_process.c 1.5 644))
(Extensions/socket.c (STk/P/43_socket.c 1.5 644))
(Extensions/sregexp.c (STk/P/44_sregexp.c 1.2 644))
(Extensions/stack.c (STk/P/45_stack.c 1.1 444))
(Extensions/stk-genmake.in (STk/e/b/28_stk-genmak 1.1 644))
@ -512,28 +514,67 @@
(Help/make-image.n.html (STk/e/b/27_make-image 1.1 644))
;; Library files
(Lib/Images/Cancel.gif (STk/R/32_Cancel.gif 1.1 444) :no-keywords)
(Lib/Images/Help.gif (STk/R/33_Help.gif 1.1 444) :no-keywords)
(Lib/Images/LineLeft.gif (STk/f/b/1_LineLeft.g 1.1 644) :no-keywords)
(Lib/Images/LineRight.gif (STk/f/b/2_LineRight. 1.1 644) :no-keywords)
(Lib/Images/Ok.gif (STk/R/34_Ok.gif 1.1 444) :no-keywords)
(Lib/Images/STk-normal.gif (STk/R/35_STk-normal 1.2 644) :no-keywords)
(Lib/Images/STk-tiny.gif (STk/e/b/7_STk-tiny.g 1.1 644) :no-keywords)
(Lib/Images/STk-big-logo.gif (STk/f/b/3_STk-big-lo 1.1 644) :no-keywords)
(Lib/Images/STk-large.gif (STk/e/b/8_STk-large. 1.1 644) :no-keywords)
(Lib/Images/box-plus.xpm (STk/e/b/32_box-plus.x 1.1 644))
(Lib/Images/box-minus.xpm (STk/e/b/33_box-minus. 1.1 644))
(Lib/Images/STk-logo.gif (STk/f/b/4_STk-logo.g 1.1 644) :no-keywords)
(Lib/Images/STk-normal.gif (STk/R/35_STk-normal 1.2 644) :no-keywords)
(Lib/Images/STk-small-logo.gif (STk/f/b/5_STk-small- 1.1 644) :no-keywords)
(Lib/Images/STk-tiny-logo.gif (STk/f/b/6_STk-tiny-l 1.1 644) :no-keywords)
(Lib/Images/STk-tiny.gif (STk/e/b/7_STk-tiny.g 1.1 644) :no-keywords)
(Lib/Images/border.gif (STk/f/b/21_border.gif 1.1 644) :no-keywords)
; (Lib/Images/border.xpm (STk/f/b/7_border.xpm 1.1 644))
(Lib/Images/box-minus.gif (STk/f/b/22_box-minus. 1.1 644) :no-keywords)
; (Lib/Images/box-minus.xpm (STk/e/b/33_box-minus. 1.1 644))
(Lib/Images/box-plus.gif (STk/f/b/23_box-plus.g 1.1 644) :no-keywords)
; (Lib/Images/box-plus.xpm (STk/e/b/32_box-plus.x 1.1 644))
(Lib/Images/boxes (STk/R/36_boxes 1.1 444))
(Lib/Images/clipboard.gif (STk/f/b/24_clipboard. 1.1 644) :no-keywords)
; (Lib/Images/clipboard.xpm (STk/f/b/8_clipboard. 1.1 644))
(Lib/Images/colorline.gif (STk/f/b/25_colorline. 1.1 444) :no-keywords)
(Lib/Images/colors.gif (STk/f/b/26_colors.gif 1.1 644) :no-keywords)
; (Lib/Images/colors.xpm ())
(Lib/Images/console.gif (STk/f/b/27_console.gi 1.1 644) :no-keywords)
; (Lib/Images/console.xpm (STk/f/b/9_console.xp 1.1 644))
(Lib/Images/copy.gif (STk/f/b/28_copy.gif 1.1 644) :no-keywords)
; (Lib/Images/copy.xpm (STk/f/b/10_copy.xpm 1.1 644))
(Lib/Images/cross_weave (STk/R/37_cross_weav 1.1 444))
(Lib/Images/customize.gif (STk/f/b/29_customize. 1.1 644) :no-keywords)
; (Lib/Images/customize.xpm ())
(Lib/Images/cut.gif (STk/f/b/30_cut.gif 1.1 644) :no-keywords)
; (Lib/Images/cut.xpm (STk/f/b/11_cut.xpm 1.1 644))
(Lib/Images/dimple1 (STk/R/38_dimple1 1.1 444))
(Lib/Images/dimple3 (STk/R/39_dimple3 1.1 444))
(Lib/Images/dir.xpm (STk/R/40_dir.xpm 1.1 644))
(Lib/Images/diropen.xpm (STk/e/b/34_diropen.xp 1.1 644))
(Lib/Images/dir.gif (STk/f/b/31_dir.gif 1.1 644) :no-keywords)
(Lib/Images/dir.jpg (STk/f/b/12_dir.jpg 1.1 644) :no-keywords)
; (Lib/Images/dir.xpm (STk/R/40_dir.xpm 1.1 644))
(Lib/Images/diropen.gif (STk/f/b/32_diropen.gi 1.1 644) :no-keywords)
; (Lib/Images/diropen.xpm (STk/e/b/34_diropen.xp 1.1 644))
(Lib/Images/down_arrow_8.bm (STk/R/41_down_arrow 1.1 444))
(Lib/Images/earth.gif (STk/R/42_earth.gif 1.1 444) :no-keywords)
(Lib/Images/earthris.gif (STk/R/43_earthris.g 1.1 444) :no-keywords)
(Lib/Images/error.xpm (STk/R/44_error.xpm 1.1 644))
(Lib/Images/edit.gif (STk/f/b/33_edit.gif 1.1 644) :no-keywords)
; (Lib/Images/edit.xpm (STk/f/b/13_edit.xpm 1.1 644))
(Lib/Images/error (STk/c/b/19_error 1.1 444))
(Lib/Images/error.gif (STk/f/b/34_error.gif 1.1 644) :no-keywords)
; (Lib/Images/error.xpm (STk/R/44_error.xpm 1.1 644))
(Lib/Images/evalbuf.gif (STk/f/b/35_evalbuf.gi 1.1 644) :no-keywords)
; (Lib/Images/evalbuf.xpm (STk/f/b/14_evalbuf.xp 1.1 644))
(Lib/Images/evalreg.gif (STk/f/b/36_evalreg.gi 1.1 644) :no-keywords)
; (Lib/Images/evalreg.xpm (STk/f/b/15_evalreg.xp 1.1 644))
(Lib/Images/face (STk/R/45_face 1.1 444))
(Lib/Images/file.xpm (STk/R/46_file.xpm 1.1 644))
(Lib/Images/file.gif (STk/f/b/37_file.gif 1.1 644) :no-keywords)
; (Lib/Images/file.xpm (STk/R/46_file.xpm 1.1 644))
(Lib/Images/flagdown (STk/R/47_flagdown 1.1 444))
(Lib/Images/flagup (STk/R/48_flagup 1.1 444))
(Lib/Images/floppy.gif (STk/f/b/38_floppy.gif 1.1 644) :no-keywords)
; (Lib/Images/floppy.xpm (STk/f/b/16_floppy.xpm 1.1 644))
(Lib/Images/font.gif (STk/i/b/39_font.gif 1.1 644) :no-keywords)
(Lib/Images/full (STk/R/49_full 1.1 444))
(Lib/Images/gray1 (STk/R/50_gray1 1.1 444))
(Lib/Images/gray3 (STk/R/51_gray3 1.1 444))
@ -541,28 +582,35 @@
(Lib/Images/grey.5 (STk/S/1_grey.5 1.1 444))
(Lib/Images/grid4 (STk/S/2_grid4 1.1 444))
(Lib/Images/grid8 (STk/S/3_grid8 1.1 444))
(Lib/Images/hborder.gif (STk/f/b/39_hborder.gi 1.1 644) :no-keywords)
; (Lib/Images/hborder.xpm (STk/f/b/17_hborder.xp 1.1 644))
(Lib/Images/hlines2 (STk/S/4_hlines2 1.1 444))
(Lib/Images/hlines3 (STk/S/5_hlines3 1.1 444))
(Lib/Images/info.xpm (STk/S/6_info.xpm 1.1 644))
(Lib/Images/info (STk/c/b/18_info 1.1 444))
(Lib/Images/info.gif (STk/f/b/40_info.gif 1.1 644) :no-keywords)
; (Lib/Images/info.xpm (STk/S/6_info.xpm 1.1 644))
(Lib/Images/letters (STk/S/7_letters 1.1 444))
(Lib/Images/light_gray (STk/S/8_light_gray 1.1 444))
(Lib/Images/menu.bm (STk/S/9_menu.bm 1.1 444))
(Lib/Images/mickey.gif (STk/S/10_mickey.gif 1.1 444) :no-keywords)
(Lib/Images/noletters (STk/S/11_noletters 1.1 444))
(Lib/Images/parentdir.xpm (STk/S/12_parentdir. 1.1 644))
(Lib/Images/parentdir.gif (STk/f/b/41_parentdir. 1.1 644) :no-keywords)
; (Lib/Images/parentdir.xpm (STk/S/12_parentdir. 1.1 644))
(Lib/Images/pattern (STk/S/13_pattern 1.1 444))
(Lib/Images/qmark.gif (STk/f/b/42_qmark.gif 1.1 644) :no-keywords)
; (Lib/Images/qmark.xpm (STk/f/b/18_qmark.xpm 1.1 644))
(Lib/Images/queen (STk/S/14_queen 1.1 444))
(Lib/Images/question.xpm (STk/S/15_question.x 1.1 644))
(Lib/Images/question (STk/c/b/17_question 1.1 444))
(Lib/Images/question.gif (STk/f/b/43_question.g 1.1 644) :no-keywords)
; (Lib/Images/question.xpm (STk/S/15_question.x 1.1 644))
(Lib/Images/root_weave (STk/S/16_root_weave 1.1 444))
(Lib/Images/stipple (STk/S/17_stipple 1.1 444))
(Lib/Images/teapot.ppm (STk/S/18_teapot.ppm 1.1 444))
(Lib/Images/vlines2 (STk/S/19_vlines2 1.1 444))
(Lib/Images/vlines3 (STk/S/20_vlines3 1.1 444))
(Lib/Images/warning.xpm (STk/S/21_warning.xp 1.1 644))
(Lib/Images/warning (STk/c/b/16_warning 1.1 444))
(Lib/Images/question (STk/c/b/17_question 1.1 444))
(Lib/Images/info (STk/c/b/18_info 1.1 444))
(Lib/Images/error (STk/c/b/19_error 1.1 444))
(Lib/Images/warning.gif (STk/f/b/44_warning.gi 1.1 644) :no-keywords)
; (Lib/Images/warning.xpm (STk/S/21_warning.xp 1.1 644))
(Lib/Makefile (STk/S/22_Makefile 1.4 644))
(Lib/Match/compiler.scm (STk/S/23_compiler.s 1.1 444))
(Lib/Match/descr.scm (STk/S/24_descr.scm 1.1 444))
@ -571,32 +619,39 @@
(Lib/Match/s2cfun.scm (STk/S/27_s2cfun.scm 1.1 444))
(Lib/STk (.) :symlink)
(Lib/STk.init (STk/S/28_STk.init 1.3 644))
(Lib/balloon.stk (STk/f/b/45_balloon.st 1.2 644))
(Lib/base64.stk (STk/e/b/31_base64.stk 1.1 644))
(Lib/bigloo.stk (STk/S/30_bigloo.stk 1.3 644))
(Lib/button.stk (STk/S/31_button.stk 1.2 644))
(Lib/butbar.stk (STk/f/b/19_butbar.stk 1.3 644))
(Lib/button.stk (STk/S/31_button.stk 1.5 644))
(Lib/class-browser.stklos (STk/e/b/43_class-brow 1.1 644))
(Lib/compatibility.stk (STk/S/32_compatibil 1.1 644))
(Lib/dialog.stk (STk/S/33_dialog.stk 1.2 444))
(Lib/console.stk (STk/e/b/48_console.st 1.9 644))
(Lib/console-customize.stk (STk/f/b/46_console-cu 1.2 644))
(Lib/dialog.stk (STk/S/33_dialog.stk 1.3 444))
(Lib/edit.stk (STk/f/b/20_edit.stk 1.5 644))
(Lib/editor.stk (STk/S/34_editor.stk 1.1 644))
(Lib/entry.stk (STk/S/35_entry.stk 1.2 644))
(Lib/error.stk (STk/S/36_error.stk 1.2 644))
(Lib/error.stk (STk/S/36_error.stk 1.4 644))
(Lib/extset.stk (STk/S/37_extset.stk 1.2 644))
(Lib/ffi.stk (STk/S/38_ffi.stk 1.2 644))
(Lib/fileevent.stk (STk/S/39_fileevent. 1.2 644))
(Lib/focus.stk (STk/S/40_focus.stk 1.1 644))
(Lib/ftp.stklos (STk/S/41_ftp.stklos 1.3 644))
(Lib/font-chooser.stklos (STk/i/b/40_font-choos 1.1 644))
(Lib/font-lock.stk (STk/f/b/0_font-lock. 1.6 644))
(Lib/ftp.stklos (STk/S/41_ftp.stklos 1.4 644))
(Lib/hash.stk (STk/S/42_hash.stk 1.2 644))
(Lib/help.stk (STk/S/43_help.stk 1.3 644))
(Lib/html.stk (STk/S/44_html.stk 1.1 644))
(Lib/image.stk (STk/S/45_image.stk 1.4 644))
(Lib/init.stk (STk/S/46_init.stk 1.17 644))
(Lib/image.stk (STk/S/45_image.stk 1.5 644))
(Lib/init.stk (STk/S/46_init.stk 1.22 644))
(Lib/inspect-detail.stk (STk/S/47_inspect-de 1.1 644))
(Lib/inspect-help.stk (STk/S/48_inspect-he 1.1 444))
(Lib/inspect-main.stk (STk/S/49_inspect-ma 1.2 644))
(Lib/inspect-misc.stk (STk/S/50_inspect-mi 1.1 644))
(Lib/inspect-view.stk (STk/S/51_inspect-vi 1.1 644))
(Lib/jpeg.stk (STk/T/0_jpeg.stk 1.1 644))
(Lib/listbox.stk (STk/T/1_listbox.st 1.1 644))
(Lib/listbox.stk (STk/T/1_listbox.st 1.3 644))
(Lib/listener.stk (STk/T/2_listener.s 1.1 644))
(Lib/locale.stk (STk/e/b/44_locale.stk 1.1 644))
(Lib/match.stk (STk/T/3_match.stk 1.2 644))
@ -610,25 +665,25 @@
; (Lib/prolog.ps (STk/T/10_prolog.ps 1.1 444))
(Lib/regexp.stk (STk/T/11_regexp.stk 1.1 444))
(Lib/scale.stk (STk/T/12_scale.stk 1.2 644))
(Lib/scrollbar.stk (STk/T/13_scrollbar. 1.2 644))
(Lib/scrollbar.stk (STk/T/13_scrollbar. 1.3 644))
(Lib/security.stk (STk/T/14_security.s 1.1 644))
(Lib/slib.stk (STk/T/15_slib.stk 1.1 444))
(Lib/socket.stk (STk/T/16_socket.stk 1.1 444))
(Lib/sterm.stk (STk/T/17_sterm.stk 1.3 644))
(Lib/text.stk (STk/T/18_text.stk 1.5 644))
(Lib/tk-init.stk (STk/T/19_tk-init.st 1.18 644))
(Lib/tk-unix.stk (STk/e/b/9_tk-unix.st 1.2 644))
(Lib/text.stk (STk/T/18_text.stk 1.7 644))
(Lib/tk-init.stk (STk/T/19_tk-init.st 1.20 644))
(Lib/tk-unix.stk (STk/e/b/9_tk-unix.st 1.3 644))
(Lib/trace.stk (STk/T/20_trace.stk 1.3 644))
(Lib/unix.stk (STk/T/21_unix.stk 1.1 444))
(Lib/www-browser.stklos (STk/c/b/29_www-browse 1.4 644))
(Lib/www-file.stk (STk/T/23_www-file.s 1.2 644))
(Lib/www-browser.stklos (STk/c/b/29_www-browse 1.6 644))
(Lib/www-file.stk (STk/T/23_www-file.s 1.3 644))
(Lib/www-html.stk (STk/T/24_www-html.s 1.4 644))
(Lib/www-http.stk (STk/T/25_www-http.s 1.2 644))
(Lib/www-img.stk (STk/T/26_www-img.st 1.3 644))
(Lib/www-img.stk (STk/T/26_www-img.st 1.5 644))
(Lib/www-snd.stk (STk/T/27_www-snd.st 1.2 644))
(Lib/www-txt.stk (STk/T/28_www-txt.st 1.2 644))
(Lib/www-url.stk (STk/T/29_www-url.st 1.2 644))
(Lib/www.stk (STk/T/30_www.stk 1.3 644))
(Lib/www.stk (STk/T/30_www.stk 1.4 644))
;; The Multiple Precision Library (Free and Gnu)
(Mp/Makefile (STk/T/31_Makefile 1.2 644))
@ -770,7 +825,7 @@
(Mp/gmp-1.3.2/xtom.c (STk/W/11_xtom.c 1.1 444))
;; STklos Directory (+ STklos and Tk)
(STklos/%README (STk/W/12_%README 1.2 644))
(STklos/%README (STk/W/12_%README 1.3 644))
(STklos/Examples/E0.stklos (STk/W/13_E0.stklos 1.1 444))
(STklos/Examples/E1.stklos (STk/W/14_E1.stklos 1.1 444))
(STklos/Examples/E2.stklos (STk/W/15_E2.stklos 1.2 644))
@ -778,27 +833,27 @@
(STklos/Examples/E4.stklos (../../Demos/stklos-widgets.stklos) :symlink)
(STklos/Examples/complex.stklos (STk/c/b/12_complex.st 1.1 644))
(STklos/Makefile (STk/W/17_Makefile 1.4 644))
(STklos/README.html (STk/W/18_README.htm 1.2 644))
(STklos/README.html (STk/W/18_README.htm 1.3 644))
(STklos/Tk/%README (STk/W/19_%README 1.2 644))
(STklos/Tk/Basics.stklos (STk/W/20_Basics.stk 1.12 644))
(STklos/Tk/Button.stklos (STk/W/21_Button.stk 1.4 644))
(STklos/Tk/Basics.stklos (STk/W/20_Basics.stk 1.13 644))
(STklos/Tk/Button.stklos (STk/W/21_Button.stk 1.5 644))
(STklos/Tk/Canvas.stklos (STk/W/22_Canvas.stk 1.4 644))
(STklos/Tk/Canvitem.stklos (STk/W/23_Canvitem.s 1.5 644))
(STklos/Tk/Composite/Balloon.stklos (STk/c/b/23_Balloon.st 1.3 644))
(STklos/Tk/Composite/Balloon.stklos (STk/c/b/23_Balloon.st 1.4 644))
(STklos/Tk/Composite/Choicebox.stklos (STk/W/24_Choicebox. 1.4 644))
(STklos/Tk/Composite/Colorbox.stklos (STk/c/b/24_Colorbox.s 1.3 644))
(STklos/Tk/Composite/Defbutton.stklos (STk/W/25_Defbutton. 1.3 644))
(STklos/Tk/Composite/Filebox.stklos (STk/W/26_Filebox.st 1.7 644))
(STklos/Tk/Composite/Filebox.stklos (STk/W/26_Filebox.st 1.9 644))
(STklos/Tk/Composite/Gauge.stklos (STk/c/b/25_Gauge.stkl 1.1 644))
(STklos/Tk/Composite/Hierarchy.stklos (STk/e/b/35_Hierarchy. 1.3 644))
(STklos/Tk/Composite/Lentry.stklos (STk/W/28_Lentry.stk 1.4 644))
(STklos/Tk/Composite/Lframe.stklos (STk/W/29_Lframe.stk 1.2 644))
(STklos/Tk/Composite/Hierarchy.stklos (STk/e/b/35_Hierarchy. 1.4 644))
(STklos/Tk/Composite/Lentry.stklos (STk/W/28_Lentry.stk 1.6 644))
(STklos/Tk/Composite/Lframe.stklos (STk/W/29_Lframe.stk 1.4 644))
(STklos/Tk/Composite/Msgbox.stklos (STk/c/b/20_Msgbox.stk 1.4 644))
(STklos/Tk/Composite/Multipaned.stklos (STk/W/30_Multipaned 1.2 644))
(STklos/Tk/Composite/Multiwin.stklos (STk/W/31_Multiwin.s 1.8 644))
(STklos/Tk/Composite/Notepad.stklos (STk/e/b/36_Notepad.st 1.1 644))
(STklos/Tk/Composite/Paned.stklos (STk/W/32_Paned.stkl 1.3 644))
(STklos/Tk/Composite/Schemetext.stklos (STk/e/b/46_Schemetext 1.1 644))
(STklos/Tk/Composite/Schemetext.stklos (STk/e/b/46_Schemetext 1.2 644))
(STklos/Tk/Composite/Scrollbox.stklos (STk/W/33_Scrollbox. 1.4 644))
(STklos/Tk/Composite/Scrollcanvas.stklos (STk/W/34_Scrollcanv 1.3 644))
(STklos/Tk/Composite/Scrolltext.stklos (STk/W/35_Scrolltext 1.2 644))
@ -809,22 +864,22 @@
(STklos/Tk/Entry.stklos (STk/W/36_Entry.stkl 1.6 644))
(STklos/Tk/Frame.stklos (STk/W/37_Frame.stkl 1.3 644))
(STklos/Tk/Image.stklos (STk/W/38_Image.stkl 1.4 644))
(STklos/Tk/Listbox.stklos (STk/W/39_Listbox.st 1.3 644))
(STklos/Tk/Menu.stklos (STk/W/40_Menu.stklo 1.2 644))
(STklos/Tk/Listbox.stklos (STk/W/39_Listbox.st 1.4 644))
(STklos/Tk/Menu.stklos (STk/W/40_Menu.stklo 1.3 644))
(STklos/Tk/Message.stklos (STk/W/41_Message.st 1.2 644))
(STklos/Tk/STF.stklos (STk/W/42_STF.stklos 1.1 444))
(STklos/Tk/Scale.stklos (STk/W/43_Scale.stkl 1.3 644))
(STklos/Tk/Scrollbar.stklos (STk/W/44_Scrollbar. 1.3 644))
(STklos/Tk/Text.stklos (STk/W/45_Text.stklo 1.5 644))
(STklos/Tk/Text.stklos (STk/W/45_Text.stklo 1.7 644))
(STklos/Tk/Tk-active.stklos (STk/W/46_Tk-active. 1.3 644))
(STklos/Tk/Tk-classes.stklos (STk/W/47_Tk-classes 1.17 644))
(STklos/Tk/Tk-meta.stklos (STk/W/48_Tk-meta.st 1.9 644))
(STklos/Tk/Toplevel.stklos (STk/W/50_Toplevel.s 1.8 644))
(STklos/Tk/Toplevel.stklos (STk/W/50_Toplevel.s 1.9 644))
; (STklos/Tk/Widget/ImgButton.stklos ())
(STklos/active-slot.stklos (STk/c/b/21_active-slo 1.1 644))
(STklos/composite-slot.stklos (STk/c/b/22_composite- 1.1 644))
(STklos/describe.stklos (STk/c/b/14_describe.s 1.1 644))
(STklos/stklos.stk (STk/c/b/10_stklos.stk 1.27 644))
(STklos/stklos.stk (STk/c/b/10_stklos.stk 1.28 644))
(STklos/trace-gf.stklos (STk/c/b/11_trace-gf.s 1.1 644))
;; Snow (Stk with NO Window) Directory
@ -836,6 +891,7 @@
(Snow/char.c (../Src/char.c) :symlink)
(Snow/configure (../Src/configure) :symlink)
(Snow/configure.in (../Src/configure.in) :symlink)
(Snow/console.c (../Src/console.c) :symlink)
(Snow/cont.c (../Src/cont.c) :symlink)
(Snow/dummy.c (../Src/dummy.c) :symlink)
(Snow/dump.c (../Src/dump.c) :symlink)
@ -890,78 +946,83 @@
(Snow/trace.c (../Src/trace.c) :symlink)
(Snow/unix.c (../Src/unix.c) :symlink)
(Snow/userinit.c (../Src/userinit.c) :symlink)
(Snow/vport.c (../Src/vport.c) :symlink)
(Snow/vport.h (../Src/vport.h) :symlink)
(Snow/vector.c (../Src/vector.c) :symlink)
;; Source directory of the Interpreter
(Src/Makefile.in (STk/X/5_Makefile.i 1.9 644))
(Src/address.c (STk/X/6_address.c 1.2 644))
(Src/argv.c (STk/X/7_argv.c 1.5 644))
(Src/Makefile.in (STk/X/5_Makefile.i 1.10 644))
(Src/address.c (STk/X/6_address.c 1.4 644))
(Src/argv.c (STk/X/7_argv.c 1.8 644))
(Src/base64.c (../Extensions/base64.c) :symlink)
(Src/boolean.c (STk/X/8_boolean.c 1.1 644))
(Src/boolean.c (STk/X/8_boolean.c 1.2 644))
(Src/char.c (STk/X/9_char.c 1.3 644))
(Src/configure (STk/X/10_configure 1.1 555))
(Src/configure.in (STk/X/11_configure. 1.1 444))
(Src/cont.c (STk/X/12_cont.c 1.3 644))
(Src/dummy.c (STk/X/13_dummy.c 1.2 644))
(Src/dump.c (STk/X/14_dump.c 1.1 644))
(Src/dynload.c (STk/X/15_dynload.c 1.6 644))
(Src/env.c (STk/X/16_env.c 1.6 644))
(Src/error.c (STk/X/17_error.c 1.9 644))
(Src/eval.c (STk/X/18_eval.c 1.12 644))
(Src/extend.c (STk/X/19_extend.c 1.3 644))
(Src/console.c (STk/e/b/49_console.c 1.5 644))
(Src/cont.c (STk/X/12_cont.c 1.4 644))
(Src/dummy.c (STk/X/13_dummy.c 1.3 644))
(Src/dump.c (STk/X/14_dump.c 1.2 644))
(Src/dynload.c (STk/X/15_dynload.c 1.10 644))
(Src/env.c (STk/X/16_env.c 1.7 644))
(Src/error.c (STk/X/17_error.c 1.13 644))
(Src/eval.c (STk/X/18_eval.c 1.16 644))
(Src/extend.c (STk/X/19_extend.c 1.6 644))
(Src/extend.h (STk/X/20_extend.h 1.1 444))
(Src/gc.c (STk/X/21_gc.c 1.9 644))
(Src/gc.c (STk/X/21_gc.c 1.14 644))
(Src/gc.h (STk/X/22_gc.h 1.1 444))
(Src/hash.c (../Extensions/hash.c) :symlink)
(Src/html.c (../Extensions/html.c) :symlink)
(Src/io.c (STk/X/23_io.c 1.5 644))
(Src/io.c (STk/X/23_io.c 1.11 644))
(Src/jpeg.c (../Extensions/jpeg.c) :symlink)
(Src/keyword.c (STk/X/24_keyword.c 1.2 644))
(Src/keyword.c (STk/X/24_keyword.c 1.4 644))
(Src/list.c (STk/X/25_list.c 1.2 644))
(Src/locale.c (../Extensions/locale.c) :symlink)
(Src/macros.c (STk/X/26_macros.c 1.2 644))
(Src/module.c (STk/X/27_module.c 1.12 644))
(Src/module.c (STk/X/27_module.c 1.14 644))
(Src/module.h (STk/X/28_module.h 1.3 644))
(Src/number.c (STk/X/29_number.c 1.4 644))
(Src/number.c (STk/X/29_number.c 1.5 644))
(Src/pixmap.c (../Extensions/pixmap.c) :symlink)
(Src/port.c (STk/X/30_port.c 1.13 644))
(Src/port.c (STk/X/30_port.c 1.23 644))
(Src/posix.c (../Extensions/posix.c) :symlink)
(Src/primitives.c (STk/X/31_primitives 1.13 644))
(Src/print.c (STk/X/32_print.c 1.7 644))
(Src/primitives.c (STk/X/31_primitives 1.21 644))
(Src/print.c (STk/X/32_print.c 1.10 644))
(Src/proc.c (STk/X/33_proc.c 1.4 644))
(Src/process.c (../Extensions/process.c) :symlink)
(Src/promise.c (STk/X/34_promise.c 1.1 644))
(Src/read.c (STk/X/35_read.c 1.5 644))
(Src/read.c (STk/X/35_read.c 1.7 644))
(Src/run-stk.in (STk/X/36_run-stk.in 1.1 444))
(Src/signal.c (STk/X/37_signal.c 1.5 644))
(Src/slib.c (STk/X/38_slib.c 1.11 644))
(Src/signal.c (STk/X/37_signal.c 1.12 644))
(Src/slib.c (STk/X/38_slib.c 1.17 644))
(Src/socket.c (../Extensions/socket.c) :symlink)
(Src/sport.c (STk/X/39_sport.c 1.4 644))
(Src/sport.h (STk/X/40_sport.h 1.1 444))
(Src/sport.c (STk/X/39_sport.c 1.7 644))
(Src/sport.h (STk/X/40_sport.h 1.3 444))
(Src/sregexp.c (../Extensions/sregexp.c) :symlink)
(Src/stk.c (STk/X/41_stk.c 1.1 644))
(Src/stk.h (STk/X/42_stk.h 1.19 644))
(Src/stklos.c (STk/X/43_stklos.c 1.15 644))
(Src/stk.h (STk/X/42_stk.h 1.29 644))
(Src/stklos.c (STk/X/43_stklos.c 1.17 644))
(Src/stklos.h (STk/X/44_stklos.h 1.5 644))
(Src/str.c (STk/X/45_str.c 1.3 644))
(Src/symbol.c (STk/X/46_symbol.c 1.2 644))
(Src/str.c (STk/X/45_str.c 1.4 644))
(Src/symbol.c (STk/X/46_symbol.c 1.4 644))
(Src/syntax.c (STk/X/47_syntax.c 1.4 644))
(Src/tcl-glue.c (STk/X/48_tcl-glue.c 1.7 644))
(Src/tcl-glue.h (STk/X/49_tcl-glue.h 1.3 644))
(Src/tcl-lib.c (STk/X/50_tcl-lib.c 1.6 644))
(Src/tcl-obj.c (STk/X/51_tcl-obj.c 1.6 644))
(Src/tcl-util.c (STk/Y/0_tcl-util.c 1.1 644))
(Src/tcl-lib.c (STk/X/50_tcl-lib.c 1.9 644))
(Src/tcl-obj.c (STk/X/51_tcl-obj.c 1.8 644))
(Src/tcl-util.c (STk/Y/0_tcl-util.c 1.2 644))
(Src/test-stk (STk/Y/1_test-stk 1.1 755))
(Src/tk-glue.c (STk/Y/2_tk-glue.c 1.7 644))
(Src/tk-glue.c (STk/Y/2_tk-glue.c 1.9 644))
(Src/tk-glue.h (STk/Y/3_tk-glue.h 1.3 644))
(Src/tk-main.c (STk/Y/4_tk-main.c 1.5 644))
(Src/tk-main.c (STk/Y/4_tk-main.c 1.7 644))
(Src/tk-util.c (STk/Y/5_tk-util.c 1.1 644))
(Src/toplevel.c (STk/Y/6_toplevel.c 1.11 644))
(Src/trace.c (STk/Y/7_trace.c 1.1 644))
(Src/unix.c (STk/Y/8_unix.c 1.5 644))
(Src/userinit.c (STk/Y/9_userinit.c 1.2 644))
(Src/vector.c (STk/Y/11_vector.c 1.1 644))
(Src/wstk.c (STk/Y/12_wstk.c 1.2 644))
(Src/toplevel.c (STk/Y/6_toplevel.c 1.16 644))
(Src/trace.c (STk/Y/7_trace.c 1.2 644))
(Src/unix.c (STk/Y/8_unix.c 1.9 644))
(Src/vport.c (STk/e/b/50_vport.c 1.1 644))
(Src/vport.h (STk/e/b/51_vport.h 1.1 644))
(Src/userinit.c (STk/Y/9_userinit.c 1.5 644))
(Src/vector.c (STk/Y/11_vector.c 1.3 644))
(Src/wstk.c (STk/Y/12_wstk.c 1.3 644))
;; Stack Management Directory
(Stack/libstack.h.in (STk/Y/13_libstack.h 1.1 644))
@ -977,7 +1038,7 @@
(Stack/libstack-I386.c (STk/Y/22_libstack-I 1.1 644))
(Stack/libstack-ALPHA.c (STk/Y/23_libstack-A 1.1 644))
(Stack/configure (STk/Y/25_configure 1.2 755))
(Stack/Makefile.in (STk/Y/26_Makefile.i 1.1 644))
(Stack/Makefile.in (STk/Y/26_Makefile.i 1.2 644))
(Stack/configure.in (STk/Y/27_configure. 1.2 644))
(Stack/README (STk/Y/28_README 1.1 644))
@ -1010,7 +1071,7 @@
(Tcl/license.terms (STk/Z/2_license.te 1.2 644))
(Tcl/panic.c (STk/Z/3_panic.c 1.2 644))
(Tcl/regexp.c (STk/Z/4_regexp.c 1.1 644))
(Tcl/tcl.h (STk/Z/5_tcl.h 1.5 644))
(Tcl/tcl.h (STk/Z/5_tcl.h 1.6 644))
(Tcl/tclAsync.c (STk/Z/6_tclAsync.c 1.1 644))
(Tcl/tclConfig.sh.in (STk/Z/7_tclConfig. 1.1 644))
(Tcl/tclEvent.c (STk/Z/8_tclEvent.c 1.5 644))
@ -1098,7 +1159,7 @@
(Tk/generic/tkImgBmap.c (STk/a/b/35_tkImgBmap. 1.2 644))
(Tk/generic/tkImgGIF.c (STk/a/b/36_tkImgGIF.c 1.1 644))
(Tk/generic/tkImgPPM.c (STk/a/b/37_tkImgPPM.c 1.2 644))
(Tk/generic/tkImgPhoto.c (STk/a/b/38_tkImgPhoto 1.1 644))
(Tk/generic/tkImgPhoto.c (STk/a/b/38_tkImgPhoto 1.2 644))
(Tk/generic/tkImgUtil.c (STk/a/b/39_tkImgUtil. 1.1 644))
(Tk/generic/tkInitScript.h (STk/a/b/40_tkInitScri 1.2 644))
(Tk/generic/tkInt.h (STk/a/b/41_tkInt.h 1.2 644))
@ -1138,7 +1199,7 @@
(Tk/generic/tkVisual.c (STk/b/b/23_tkVisual.c 1.1 644))
(Tk/generic/tkWindow.c (STk/b/b/24_tkWindow.c 1.4 644))
(Tk/license.terms (STk/b/b/25_license.te 1.1 444))
(Tk/unix/Makefile.in (STk/b/b/26_Makefile.i 1.5 644))
(Tk/unix/Makefile.in (STk/b/b/26_Makefile.i 1.6 644))
(Tk/unix/README (STk/b/b/27_README 1.1 644))
(Tk/unix/configure (STk/b/b/28_configure 1.1 755))
(Tk/unix/configure.in (STk/b/b/29_configure. 1.1 755))
@ -1176,19 +1237,176 @@
;; Utilities directory
(Utils/install-sh (STk/c/b/9_install-sh 1.1 755))
(Utils/STk.spec.in (STk/e/b/20_STk.spec.i 1.12 644))
(Utils/STk.spec (STk/e/b/21_STk.spec 1.14 644))
(Utils/STk.spec.in (STk/e/b/20_STk.spec.i 1.13 644))
(Utils/STk.spec (STk/e/b/21_STk.spec 1.15 644))
;=============================================================================
;
; Windows Stuff
;
;=============================================================================
;; Windows Directory
; (Win32/STk-make.vc ())
; (Win32/STk-inst.bat ())
; (Win32/README ())
; (Win32/STk.def ())
; (Win32/STk.rc ())
; (Win32/STk-make.bc ())
; (Win32/STk.ico () :no-keywords)
(install.bat (STk/f/b/47_install.ba 1.2 755))
(Tcl/tclWinTime.c (STk/f/b/48_tclWinTime 1.1 444))
(Tcl/tclWinPort.h (STk/f/b/49_tclWinPort 1.1 444))
(Tcl/tclWinNotify.c (STk/f/b/50_tclWinNoti 1.1 444))
(Tk/xlib/X11/license.terms (STk/f/b/51_license.te 1.1 444))
(Tk/xlib/X11/keysymdef.h (STk/g/b/0_keysymdef. 1.1 444))
(Tk/xlib/X11/keysym.h (STk/g/b/1_keysym.h 1.1 444))
(Tk/xlib/X11/cursorfont.h (STk/g/b/2_cursorfont 1.1 444))
(Tk/xlib/X11/Xutil.h (STk/g/b/3_Xutil.h 1.1 444))
(Tk/xlib/X11/Xlib.h (STk/g/b/4_Xlib.h 1.1 444))
(Tk/xlib/X11/Xfuncproto.h (STk/g/b/5_Xfuncproto 1.1 444))
(Tk/xlib/X11/Xatom.h (STk/g/b/6_Xatom.h 1.1 444))
(Tk/xlib/X11/X.h (STk/g/b/7_X.h 1.1 444))
(Tk/xlib/license.terms (STk/g/b/8_license.te 1.1 444))
(Tk/xlib/xutil.c (STk/g/b/9_xutil.c 1.1 444))
(Tk/xlib/ximage.c (STk/g/b/10_ximage.c 1.1 444))
(Tk/xlib/xgc.c (STk/g/b/11_xgc.c 1.1 444))
(Tk/xlib/xdraw.c (STk/g/b/12_xdraw.c 1.1 444))
(Tk/xlib/xcolors.c (STk/g/b/13_xcolors.c 1.1 444))
(Tk/xlib/xbytes.h (STk/g/b/14_xbytes.h 1.1 444))
(Tk/win/install-sh (../../Utils/install-sh) :symlink)
(Tk/win/tkWinWm.c.orig (STk/g/b/15_tkWinWm.c. 1.1 644))
(Tk/win/tkWinFont.c.orig (STk/g/b/16_tkWinFont. 1.1 644))
(Tk/win/winMain.c (STk/g/b/17_winMain.c 1.1 644))
(Tk/win/tkWinX.c (STk/g/b/18_tkWinX.c 1.1 644))
(Tk/win/tkWinWm.c (STk/g/b/19_tkWinWm.c 1.1 644))
(Tk/win/tkWinWindow.c (STk/g/b/20_tkWinWindo 1.1 644))
(Tk/win/tkWinSend.c (STk/g/b/21_tkWinSend. 1.1 644))
(Tk/win/tkWinScrlbr.c (STk/g/b/22_tkWinScrlb 1.1 644))
(Tk/win/tkWinRegion.c (STk/g/b/23_tkWinRegio 1.1 644))
(Tk/win/tkWinPort.h (STk/g/b/24_tkWinPort. 1.1 644))
(Tk/win/tkWinPointer.c (STk/g/b/25_tkWinPoint 1.1 644))
(Tk/win/tkWinPixmap.c (STk/g/b/26_tkWinPixma 1.1 644))
(Tk/win/tkWinMenu.c (STk/g/b/27_tkWinMenu. 1.1 644))
(Tk/win/tkWinKey.c (STk/g/b/28_tkWinKey.c 1.1 644))
(Tk/win/tkWinInt.h (STk/g/b/29_tkWinInt.h 1.1 644))
(Tk/win/tkWinInit.c (STk/g/b/30_tkWinInit. 1.1 644))
(Tk/win/tkWinImage.c (STk/g/b/31_tkWinImage 1.1 644))
(Tk/win/tkWinFont.c (STk/g/b/32_tkWinFont. 1.1 644))
(Tk/win/tkWinEmbed.c (STk/g/b/33_tkWinEmbed 1.1 644))
(Tk/win/tkWinDraw.c (STk/g/b/34_tkWinDraw. 1.1 644))
(Tk/win/tkWinDialog.c (STk/g/b/35_tkWinDialo 1.2 644))
(Tk/win/tkWinDefault.h (STk/g/b/36_tkWinDefau 1.1 644))
(Tk/win/tkWinCursor.c (STk/g/b/37_tkWinCurso 1.1 644))
(Tk/win/tkWinColor.c (STk/g/b/38_tkWinColor 1.1 644))
(Tk/win/tkWinClipboard.c (STk/g/b/39_tkWinClipb 1.1 644))
(Tk/win/tkWinButton.c (STk/g/b/40_tkWinButto 1.1 644))
(Tk/win/tkWin3d.c (STk/g/b/41_tkWin3d.c 1.1 644))
(Tk/win/tkWin32Dll.c (STk/g/b/42_tkWin32Dll 1.1 644))
(Tk/win/tkWin.h (STk/g/b/43_tkWin.h 1.1 644))
(Tk/win/stubs.c (STk/g/b/44_stubs.c 1.1 644))
(Tk/win/rmd.bat (STk/g/b/45_rmd.bat 1.1 644))
(Tk/win/rc/STk.ico (STk/i/b/47_STk.ico 1.1 644) :no-keywords)
(Tk/win/rc/buttons.bmp (STk/g/b/46_buttons.bm 1.1 644) :no-keywords)
(Tk/win/rc/wish.ico (STk/g/b/47_wish.ico 1.1 644) :no-keywords)
(Tk/win/rc/stk.rc (STk/i/b/48_stk.rc 1.1 644))
(Tk/win/rc/tk.ico (STk/g/b/48_tk.ico 1.1 644) :no-keywords)
(Tk/win/rc/cursor98.cur (STk/g/b/49_cursor98.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor96.cur (STk/g/b/50_cursor96.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor94.cur (STk/g/b/51_cursor94.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor92.cur (STk/h/b/0_cursor92.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor90.cur (STk/h/b/1_cursor90.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor8e.cur (STk/h/b/2_cursor8e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor8c.cur (STk/h/b/3_cursor8c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor8a.cur (STk/h/b/4_cursor8a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor88.cur (STk/h/b/5_cursor88.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor86.cur (STk/h/b/6_cursor86.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor84.cur (STk/h/b/7_cursor84.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor82.cur (STk/h/b/8_cursor82.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor80.cur (STk/h/b/9_cursor80.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor7e.cur (STk/h/b/10_cursor7e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor7c.cur (STk/h/b/11_cursor7c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor7a.cur (STk/h/b/12_cursor7a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor78.cur (STk/h/b/13_cursor78.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor76.cur (STk/h/b/14_cursor76.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor74.cur (STk/h/b/15_cursor74.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor72.cur (STk/h/b/16_cursor72.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor70.cur (STk/h/b/17_cursor70.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor6e.cur (STk/h/b/18_cursor6e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor6c.cur (STk/h/b/19_cursor6c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor6a.cur (STk/h/b/20_cursor6a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor68.cur (STk/h/b/21_cursor68.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor66.cur (STk/h/b/22_cursor66.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor64.cur (STk/h/b/23_cursor64.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor62.cur (STk/h/b/24_cursor62.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor60.cur (STk/h/b/25_cursor60.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor5e.cur (STk/h/b/26_cursor5e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor5c.cur (STk/h/b/27_cursor5c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor5a.cur (STk/h/b/28_cursor5a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor58.cur (STk/h/b/29_cursor58.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor56.cur (STk/h/b/30_cursor56.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor54.cur (STk/h/b/31_cursor54.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor52.cur (STk/h/b/32_cursor52.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor50.cur (STk/h/b/33_cursor50.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor4e.cur (STk/h/b/34_cursor4e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor4c.cur (STk/h/b/35_cursor4c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor4a.cur (STk/h/b/36_cursor4a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor48.cur (STk/h/b/37_cursor48.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor46.cur (STk/h/b/38_cursor46.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor44.cur (STk/h/b/39_cursor44.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor42.cur (STk/h/b/40_cursor42.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor40.cur (STk/h/b/41_cursor40.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor3e.cur (STk/h/b/42_cursor3e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor3c.cur (STk/h/b/43_cursor3c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor3a.cur (STk/h/b/44_cursor3a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor38.cur (STk/h/b/45_cursor38.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor36.cur (STk/h/b/46_cursor36.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor34.cur (STk/h/b/47_cursor34.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor32.cur (STk/h/b/48_cursor32.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor30.cur (STk/h/b/49_cursor30.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor2e.cur (STk/h/b/50_cursor2e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor2c.cur (STk/h/b/51_cursor2c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor2a.cur (STk/i/b/0_cursor2a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor28.cur (STk/i/b/1_cursor28.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor26.cur (STk/i/b/2_cursor26.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor24.cur (STk/i/b/3_cursor24.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor22.cur (STk/i/b/4_cursor22.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor20.cur (STk/i/b/5_cursor20.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor1e.cur (STk/i/b/6_cursor1e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor1c.cur (STk/i/b/7_cursor1c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor1a.cur (STk/i/b/8_cursor1a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor18.cur (STk/i/b/9_cursor18.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor16.cur (STk/i/b/10_cursor16.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor14.cur (STk/i/b/11_cursor14.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor12.cur (STk/i/b/12_cursor12.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor10.cur (STk/i/b/13_cursor10.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor0e.cur (STk/i/b/14_cursor0e.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor0c.cur (STk/i/b/15_cursor0c.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor0a.cur (STk/i/b/16_cursor0a.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor08.cur (STk/i/b/17_cursor08.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor06.cur (STk/i/b/18_cursor06.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor04.cur (STk/i/b/19_cursor04.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor02.cur (STk/i/b/20_cursor02.c 1.1 644) :no-keywords)
(Tk/win/rc/cursor00.cur (STk/i/b/21_cursor00.c 1.1 644) :no-keywords)
(Tk/win/rc/wish.rc (STk/i/b/22_wish.rc 1.1 644))
(Tk/win/rc/tk.rc (STk/i/b/23_tk.rc 1.1 644))
(Tk/win/mkd.bat (STk/i/b/24_mkd.bat 1.1 644))
(Tk/win/makefile.vc (STk/i/b/25_makefile.v 1.1 644))
(Tk/win/makefile.plg (STk/i/b/26_makefile.p 1.1 744))
(Tk/win/makefile.opt (STk/i/b/27_makefile.o 1.1 744) :no-keywords)
(Tk/win/makefile.ncb (STk/i/b/28_makefile.n 1.1 744) :no-keywords)
(Tk/win/makefile.dsw (STk/i/b/29_makefile.d 1.1 744))
(Tk/win/makefile.dsp (STk/i/b/30_makefile.d 1.1 744))
(Tk/win/makefile.bc (STk/i/b/31_makefile.b 1.1 644))
(Tk/win/license.terms (STk/i/b/32_license.te 1.1 644))
(Tk/win/README (STk/i/b/33_README 1.1 644))
(Win32/Release () :directory)
(Win32/STk.dsp (STk/i/b/38_STk.dsp 1.3 755))
(Win32/STk.dsw (STk/i/b/37_STk.dsw 1.1 755))
(Win32/STk.opt (STk/i/b/41_STk.opt 1.2 755) :no-keywords)
(Win32/STk.plg (STk/i/b/42_STk.plg 1.2 755))
(Win32/Win32libs () :directory)
(Win32/libgmp/Release () :directory)
(Win32/libgmp/libgmp.dsp (STk/i/b/43_libgmp.dsp 1.1 755))
(Win32/libtcl/Release () :directory)
(Win32/libtcl/libtcl.dsp (STk/i/b/44_libtcl.dsp 1.1 755))
(Win32/libtk/Release () :directory)
(Win32/libtk/libtk.dsp (STk/i/b/45_libtk.dsp 1.1 755))
)
(Merge-Parents)
(New-Merge-Parents)

2
STklos/%README
View File

@ -60,7 +60,7 @@ button 3 can be done with
and changing its value can be done with
(set! (font b3) "fixed")
(set! (font b3) '(Courier))
and associating a callback to button 1 can be done with the following
expression

2
STklos/README.html
View File

@ -59,7 +59,7 @@ Tcl/Tk names.
of&nbsp; button 3 can be done with
<UL><TT>(font b3)</TT></UL>
and changing its value can be done with
<UL>&nbsp;(<TT>set! (font b3) "fixed")</TT></UL>
<UL>&nbsp;(<TT>set! (font b3) '(Courier))</TT></UL>
and associating a callback to button 1 can be done with the following expression
<UL><TT>(set! (command b1) (lambda ()</TT>
<BR><TT>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;

6
STklos/Tk/Basics.stklos
View File

@ -11,11 +11,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: Basics.stklos 1.12 Sat, 06 Jun 1998 14:19:03 +0200 eg $
;;;; $Id: Basics.stklos 1.13 Wed, 23 Dec 1998 23:41:27 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 30-Mar-1993 15:39
;;;; Last file update: 1-Jun-1998 18:21
;;;; Last file update: 19-Dec-1998 19:05
(require "Tk-meta")
@ -102,7 +102,7 @@
(and (symbol-bound? id env) (Id->instance (eval id env)))))
(define-method Id->instance ((id <string>))
(Id->instance (sring->symbol id)))
(Id->instance (string->symbol id)))
(define-method Id ((self <widget>))
self)

22
STklos/Tk/Button.stklos
View File

@ -12,11 +12,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: Button.stklos 1.4 Mon, 27 Apr 1998 15:39:00 +0200 eg $
;;;; $Id: Button.stklos 1.5 Sun, 25 Oct 1998 22:52:31 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: 30-Mar-1993 15:39
;;;; Last file update: 27-Apr-1998 11:20
;;;; Last file update: 22-Oct-1998 22:53
(require "Basics")
@ -46,6 +46,15 @@
(define-class <Tk-simple-button> (<Label> <Tk-reactive>)
())
;;;
;;; Tk-simple-Buttons methods
;;;
(define-method flash ((self <Tk-simple-button>))
((slot-ref self 'Id) 'flash))
(define-method invoke ((self <Tk-simple-button>))
((slot-ref self 'Id) 'invoke))
;=============================================================================
;
; <Button>
@ -60,15 +69,6 @@
Tk:button)
;;;
;;; Buttons methods
;;;
(define-method flash ((self <Button>))
((slot-ref self 'Id) 'flash))
(define-method invoke ((self <Button>))
((slot-ref self 'Id) 'invoke))
;=============================================================================
;
; <Tk-complex-button>

60
STklos/Tk/Composite/Balloon.stklos
View File

@ -11,15 +11,15 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: Balloon.stklos 1.3 Thu, 10 Sep 1998 23:44:28 +0200 eg $
;;;; $Id: Balloon.stklos 1.4 Mon, 28 Dec 1998 23:05:11 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 23-Oct-1996 17:02
;;;; Last file update: 31-Aug-1998 16:18
;;;; Last file update: 27-Dec-1998 18:46
;;;;
(require "balloon")
(require "Basics")
(select-module STklos+Tk)
(export add-balloon)
@ -30,21 +30,11 @@
;
;=============================================================================
;;;;
;;;; Resources
;;;;
(option 'add "*HelpBalloon*Background" "#ffffb0" "widgetDefault")
(option 'add "*HelpBalloon*Font" "fixed" "widgetDefault")
(option 'add "*HelpBalloon*Relief" "flat" "widgetDefault")
(option 'add "*HelpBalloon*HighlightThickness" 0 "widgetDefault")
;;;;
;;;; Class definition
;;;;
(define-class <Help-Balloon> (<Tk-composite-toplevel> <Label>)
(define-class <Help-Balloon> (<Label>)
((label :accessor label-of)
(class :init-keyword :class
:init-form "HelpBalloon")
(delay :initform 1000 ; ms
:init-keyword :delay
:accessor delay)))
@ -53,49 +43,15 @@
;; Initialize-composite-widget
;;
(define-method initialize-composite-widget ((self <Help-balloon>) initargs parent)
(let ((l (make <Label> :parent parent)))
(next-method)
(make-transient parent)
;; Pack the label in the parent window
(pack (Id l) :expand #t :fill "both")
; Set true slots
(slot-set! self 'Id (slot-ref l 'Id))
(slot-set! self 'label l)))
(next-method)
(slot-set! self 'Id (slot-ref (find-balloon-help) 'Id)))
;;
;; Add-balloon
;;
(define-method add-balloon ((self <Help-Balloon>) who txt)
(define handler #f)
(define (display W txt)
(after 'cancel handler)
(let ((delay (delay self)))
(when (>= delay 0)
(set! handler
(after delay
(lambda ()
(let ((height (winfo 'height W))
(pos-y (winfo 'rooty W))
(top (frame-of self)))
;; Change the help text
(set! (text-of self) txt)
;; place the balloon just outside the widget
(set! (geometry top) (format #f "+~A+~A"
(winfo 'pointerx W)
(+ pos-y height 2)))
;; Deiconify
(deiconify top)
(raise top))))))))
(define (delete)
(withdraw (frame-of self))
(after 'cancel handler))
;; Associate new bindings to a "ballooned" widget
(bind who "<Enter>" (lambda () (display who txt)))
(bind who "<Leave>" (lambda () (delete))))
(add-balloon-help (Id who) txt (delay self) (background self)))
(provide "Balloon")

16
STklos/Tk/Composite/Filebox.stklos
View File

@ -1,7 +1,7 @@
;;;;
;;;; F i l e b o x . s t k -- File Box composite widget
;;;;
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; Permission to use, copy, and/or distribute this software and its
;;;; documentation for any purpose and without fee is hereby granted, provided
@ -11,11 +11,11 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: Filebox.stklos 1.7 Thu, 10 Sep 1998 23:44:28 +0200 eg $
;;;; $Id: Filebox.stklos 1.9 Mon, 01 Feb 1999 22:53:28 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: 22-Mar-1994 13:05
;;;; Last file update: 10-Sep-1998 16:16
;;;; Last file update: 1-Feb-1999 18:23
(require "unix")
(require "Basics")
@ -264,8 +264,7 @@
(slot-set! self 'ok-button (make <Button> :text "Ok" :parent f))
(slot-set! self 'canc-button (make <Button> :text "Cancel" :parent f))
(slot-set! self 'help-button (make <Button> :text "Help" :parent f))
(slot-set! self 'all-button (make <Check-button> :text "All"
:font "fixed" :parent f))
(slot-set! self 'all-button (make <Check-button> :text "All" :parent f))
;; Pack everybody
(pack [left-title-of self] [right-title-of self] :fill "x") ; lists titles
@ -306,7 +305,7 @@
(or (and (file-exists? file)
(not (file-is-directory? file)))
(and (Tk:message-box :type 'ok
:text (format #f "File ~S does not exists" file))
:message (format #f "File ~S does not exists" file))
#f)))
(define (file-write-validate fb file)
@ -315,11 +314,12 @@
(begin
(Tk:message-box
:type 'ok
:text (format #f "~S is a directory" file))
:message (format #f "~S is a directory" file))
#f)
(eqv? (Tk:message-box
:type 'yesno
:text (format #f "File ~S already exists\nOverwrite it?" file))
:message (format #f "File ~S already exists\nOverwrite it?"
file))
'yes))
#t))

Some files were not shown because too many files have changed in this diff Show More