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

Commit of 3.1.1 version

This commit is contained in:
Erick Gallesio 1996-09-27 12:29:02 +02:00
commit 831a9f5c47
1036 changed files with 313127 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
BINARY_DISTRIB Normal file
View File

@ -0,0 +1,31 @@
Binary distributions are available at ftp://kaolin.unice.fr/pub/Binary.
If you succeed in compiling a version for which no binary is available
on the previous site, you can probably help other people by sharing
your binary.
To make a machine-specific binary:
1. Type 'make binary-release' in the main distribution directory.
2. Create a README file for your distribution which indicates
the options you chose. A model of the README file is given below.
3. Place the binary archive (the .tar.gz) and the README file in
ftp://kaolin.unice.fr/pub/Incoming/
Thanks
______________________________________________________________________________
Sample README file for binary-release
-------------------------------------
Author: <place here your name>
Email: <and your email here>
Creation date: <insert date here>
X11 version used: X11R<???>
--------------------------------------------------
Comments:
--------------------------------------------------
Configuration:
<insert here the content of the file config.make>

243
CHANGES Normal file
View File

@ -0,0 +1,243 @@
09/26/96 Release 3.1.1
----------------------
This release is a bug correction release. It corrects a lot bugs.
A lot of theses bugs prevent to install it on some architectures.
Apart bugs:
- Version of Tk is now at Tk4.1p1 level (last stable version)
- a MS VC makefile is now provided for Win 32 thanks to
Caleb Deupree <cdeupree@erinet.com> (I have changed some things
from the Caleb file but cannot test them, I hope this is correct)
- Support for sockets on Win32 was done by Caleb Deupree on MS
VC. This should also work on BC++ but I'm not able to test it.
07/24/96 Release 3.1
--------------------
- Version of Tk is now at Tk4.1 level.
- STk run now on Win32!!!
Some details need a little more work (some oddities on file names
due to difference conventions between Unix and DOS, and things like
that). No socket support and no dynamic loading on Win32
- A complete documentation of STk widgets pages (both in nroff
and HTML format). The help command really allow you to browse
man pages now. Man pages are prefixed by "stk_" now to avoid confusion
with original Tk manual pages.
- STklos is now integrated to STk (it was dynamically loaded before).
This simplify its implementation and speed up generic functions:
o gf are now 2-4 time faster
o gf are now tail recursive
o the MOP for gf is now "public" (i.e. you can change the way
gf are called in Scheme -- it was not possible with previous
versions without using C).
- Port implementation is different: A port contains now its
input and output handler. New primitives to access the handler:
when-port-readable and when-port-writable.
BTW, The Tk function fileevent function is no more useful
(it is written in Scheme now for compatibility, but its usage
is deprecated). It may not be supported in a future release.
- New composite widgets: <Multiple-window> and <Inner-window>
which allow to have embedded windows. A multiple window
has a task bar below and allow to iconify inner-windows.
Some people think it looks like Win95 desktop ;-)
- pixmap extension doesn't require anymore the Xpm library. Code
is stolen from the Tix Library.
- New socket code which allow multiple concurrent connection
- Extended types can now have a compare function which is called
when eqv? or equal? is called. This modification should be
compatible with the previous extensions (I hope so)
- STklos: Two new methods: object-eqv? and object-equal? which are
called when applying eqv? or equal? to instances.
- A rewriting of bind-for-dragging canvas method. You can now specify
a :before-motion, which if it returns #f, forbid to move the selected
canvas item.
- New primitives:setenv!, posix-host-name, posix-domain-name,
posix-uname
- Option separator "--" allows to pass reserved keyword (sush as -help)
to a script. Option and parameter cannot be mixed anymore
(i.e. calling stk xyz -help ==> *argv* = ("xyz" "-help")
- HTML browser enhancement (support of the <FONT> tag with SIZE
and COLOR sub-tags. This must be compatible with the HTML spec.
- and of course many many bug corrections.
01/22/96 Release 3.0 (also called 3.0b2 by error)
~~~~~~~~~~~~~~~~~~~~
- Version of Tk is now at Tk4.0p2 level
- Support Pixmap images
- Strings can now contain null charters (printing of strings is more
friendly now in write mode
- Executable is now position independant(i.e. no path coded in hard in
the interpreter). STK_LIBRARY shell variable is no more necessary. We
can now make binary distributions.
- Signal can now be redirected to Scheme closures. The end of a GC
is seen as a signal.
- Trace on variable are changed (and re-work now): the associated trace
must be a thunk now.
- New option for buttons, checkbuttons, radiobuttons and entries:
:stringvalue.
This options tells if the value must be stringified or not.
For instance, with
(radiobutton '.c :text "Try" :variable 'x :stringvalue #f :value 100)
will set the "x" var to "100" whereas with
(radiobutton '.c :text "Try" :variable 'x :stringvalue #t :value 100)
value is set to the integer value 100
Default value for :stringvalue is #t for entries and #f for check and
radio buttons.
- stk-wtour demo is updated for STk 3.0
- In STklos, if a method M is defined and if it is already bound to
a procedure, the old procedure is called when no method is applicable.
Example:
(define-method car ((x <integer>)) (- x 1))
(car 10) ==> 9
(car (cons 'a 'b)) ==> a
As a consequence, this kind of method cannot call no-applicable-method
if parameters are not valid:
(car (vector 1 2)) ==> error car: wrong type of argument: #(1 2)
- Small change in the STklos hierarchy. <widget> is now a subclass of
<procedure> and its meta class is <procedure-metaclass>.
10/07/95 Release 3.0b1
~~~~~~~~~~~~~~~~~~~~~~
A lot of modifications. Briefly,
- Support of Tk4.0
- Closures are fully supported by Tk. That means that a callback can be
now a Scheme closure with its environment. GC problems with closures
and usage of the dirty "address-of" are definitively gone.
- HTML support (a browser is provided, should be extended to support
all HTML2.0)
- Documentation is now in HTML for the Tk commands (only a few commands
are ready for now, but they will be all defined in a near future).
- ....
07/15/95 Release 2.2
~~~~~~~~~~~~~~~~~~~~
This is the last release with Tk 3.6. Next release will integrate Tk 4.0
- Bug corrections
- Changing Makefiles and configure files for better dynamic loading
integration.
- Adding support for BLT-1.7. This library can be loaded dynamically
on system which support it
- New option which permit to change the initial amount of cells
- Uses really LESS memory.
- New GC. Now we have a set of heaps and a new heap is allocated as
soon as the global space is "nearly" filled.
- SLIB support (just type (require "slib") and after that process as
indicated in SLIB documentation
- Integration of the Suresh Srinivas STk-wtour demo.
- Adding support for Text in STklos: Definition of the <Text> class
(and companion <Text-tag> class).
- call/cc is now tail recursive. (Alas, methods and dynamic-wind are
not yet tail recursive).
- Better support for autoloading files
- Adding support for an exec function a` la Tcl (i.e. execute of a
unix process and keep its output in a Scheme string)
- General run-process for running Unix process were std{in,out,err}
can be redirected in files or in pipes.
- Some code has been rewritten to ease STk porting
- Adding support for regular expression pattern matching and
replacement
- There is now a light interpreter, called snow (for Scheme
NO Window); this is in fact the STk interpreter without Tk support.
This interpreter is an independant executable. It can be called
with the `snow' shell-script or by unsetting the DISPLAY variable.
- New organisation of intalled file to permit co-existence of
several version of STk or multi-architecture file sharing
- Dynamic loading support for NetBSD-1.0
- Dynamic loading support for HP
- Dynamic loading and dump support for FreeBsd.
- Dynamic loading for Linux (using ELF format or the DLD package)
- A mini interface builder (very simplistic, but usable)
- New contributions: A true Tetris game, a 8 queens simulation and
a demo of composite widgets.
- Every exported identifier now starts with the string "STk_" to
avoid name clashes when embedding the interpreter in an application.
- BSD sockets support
- Better integration with Emacs
- AMIB (A Mini Interface Builder)
- A lot of improvement in STklos
- .....
See the ChangeLog file for more information
==============================================================================
??/??/?? Release 2.1
~~~~~~~~~~~~~~~~~~~~
This is a major release version.
- STklos (the object layer) is now written in C. It is more than 150
times faster than before and it uses less memory (~ 1/100)!!!!
- Improvement of STklos
- STklos classes have been written for all the Tk library widgets
- Composites widgets can be easily defined in STklos. Access to those
widgets is identical to C written one.
- bindings can be now true lambda expression with their own
environment (rather than list which are evaluated in the global
environment).
- Hash tables have been added.
- Small constants are coded on a pointer rather than a cell
- Support for dynamic loading on SunOs (4 and 5). Dynamic loading
uses shared objects (it should work also on OSF1)
- Dump creates now smaller images.
- Modification of configure and Makefiles to correct of a lot
of installation problems.
- Runs on Solaris 2.3
- Bugs corrections
- Some modification to the error notifier
- Support of dynamic loading of shared objects on Solaris 1 & 2 (it
should work also on OSF1).
- ...
94/01/03 Release 2.0
~~~~~~~~~~~~~~~~~~~~
STk 2.0 contains a completly rewritten Scheme interpreter. This new
interpreter is
- R4RS
- faster than previous release (~ 3 or 4 times)
- less bugged (I hope :-) )
- implements integers (32 bits and bignum) and floats
- cleaner with macros
This version contains also a prototype of a graphical inspector which
permits to see/modify a variable value. For widgets variables it permits
to modify interactively their behaviour. However, it doesn't yet contain
a C rewritting of the object layer as it was planned. This will be done
in a (probably the) next release.
93/09/02 Release 1.00 (first public release)
~~~~~~~~~~~~~~~~~~~~~
Forget it :)

261
COMPILING-HINTS Normal file
View File

@ -0,0 +1,261 @@
This File contains a set of hints for compiling STk and the things
which have been reported about installation of STk. This file is very
incomplete and I hope to be able to make it growing.
If you experience a new port or confirm/infirm/add informations which are
specified here please send a mail to 'eg@unice.fr' (there is a blank form
at the end of this file)
If you succeed in compiling STk on an architecture for which there is no
binary release, please read the file BINARY_DISTRIB
______________________________________________________________________________
SunOs 4.1.x
______________________________________________________________________________
Compilation:
CC=gcc
CFLAGS=-O2
X11:
R5 and R6
Dynamic loading:
I was not able to make a version using dynamic loading and the gnu
loader. If your version of gcc use gld, you'll have probably to use the
--disable-dynload option during configuration. (Note: I said probably
since a lot of things don't work on this system which has a gcc with
gld. Everything seems very poorly installed on this system)
No problem with gcc and Sun ld.
Who:
Erick Gallesio (eg@unice.fr)
Tested:
Yes :)
Remarks:
The main system used for developping STk
______________________________________________________________________________
SunOs 5.3
______________________________________________________________________________
Compilation:
CC=gcc
CFLAGS=-O2
X11:
OpenWindows
Dynamic loading:
Should work. At least it seems to be conform to documentation :->
Must be
Who:
Erick Gallesio (eg@unice.fr)
Tested:
just make widget-demo
Remarks:
Some people have reported that they use dynamic loading but I can
remember who (and it was on 2.1).
______________________________________________________________________________
Linux 1.0.9 -> 2.0.0
______________________________________________________________________________
Compilation:
CC=gcc
CFLAGS=-O2
X11:
XFree3.1.2
Dynamic loading:
Dynamic loading is supported for DLD and ELF. (however DLD hqs not
been tested since a long time, I'm not sure it continues to work).
The configure script try to figure what type of dynamic loading
works for you and enable dynamic loading by default. With recent
kernels, it will probably be ELF.
Who:
Erick Gallesio (eg@unice.fr)
Tested:
yes
Remarks:
The other system used for developping STk.
______________________________________________________________________________
DEC Alpha OSF1 V2.0
______________________________________________________________________________
Compilation:
CC=cc Dont't use gcc 2.6 !!!!!!
CFLAGS=-O2
X11:
X11 R5
Dynamic loading:
Erik Ostrom <eostrom@radon.ccs.neu.edu> told me to use ld for
makeing the .so file. I quote him below:
"If SH_LOADER is "ld", you get a huge warning about all the
undefined symbols; but if it's "cc", ld just won't make the
.so file. I assume there's a way to get better results, but
this at least produced a working system."
Who:
Erick Gallesio (eg@unice.fr)
Tested:
Not a lot. Only the widget demo and some bignum tests.
No more core dump on undefined variable
Remarks:
Don't use gcc. STk worked with gcc prior 2.6. It doesn't work anymore
with this version of gcc. I have not investigated a lot with it but it seems
that gcc 2.6 is unable to compile the bignum stuff (it yields warning during
compilation whereas tthe code seems correct). Tests includes in the GMP
packages dont pass anymore. Consequently, all computation
which involve a bignum will be false (and could sometimes conduct to a core
dump).
I don't use this system.
______________________________________________________________________________
Dec 5xxx Ultix 4.2
______________________________________________________________________________
Compilation:
CC=gcc
CFLAGS=-O2
X11:
X11 R5
Dynamic loading:
Not supported
Who:
Erick Gallesio (eg@unice.fr)
Tested:
Widget demo work.
Remarks:
I don't use this sytem.
______________________________________________________________________________
HP 9000/735 (HP-UX 9.01)
______________________________________________________________________________
Compilation:
CC=cc
CFLAGS='-Ae -O'
X11:
????
Dynamic loading:
Dynamic loading is supported (support is due to Dipankar Gupta
<dg@hplb.hpl.hp.com>). This support has been sent to me as a patch
file over 2.1. It must be extended for newer versions (the only file
to modify is Src/dynload.c). Furthermore, options needed for
compilation dosen't seems clear for me. I have guessed some of them
but I may be wrong.
Who:
ottl@informatik.uni-muenchen.de
Tested:
Widget demo only (I think)
Remarks:
Other people have reported that STk work on HP. I don't know if they
have used it a lot. Every info is welcome.
______________________________________________________________________________
SCO
______________________________________________________________________________
Compilation:
???
X11:
???
Dynamic loading:
???
Who:
markd@grizzly.com
Tested:
???
Remarks:
Use ptar (pax tar) to untar the distribution rather than standard tar. It
seems that the standard tar doesn't handle correctly symbolic links.
______________________________________________________________________________
NetBSD 1.0
______________________________________________________________________________
Compilation:
???
X11:
XFree ????
Dynamic loading:
Yes. Contribution of Franke Ruediger (Ruediger.Franke@rz.tu-ilmenau.de)
Who:
Franke Ruediger
Tested:
???
Remarks:
????
______________________________________________________________________________
SGI Irix 5.3
______________________________________________________________________________
Compilation:
CC=gcc CFLAGS=-O2
X11:
X11R6
Dynamic loading:
Dynamic loading is supported
Who:
tiemann@cygnus.com
Tested:
compiled, ran all demos (stk and stklos)
Remarks:
______________________________________________________________________________
A new system (Mail this form to eg@unice.fr if you have made a new port)
______________________________________________________________________________
Compilation:
Indicate here the values of CC and CFLAGS you used
X11:
Indicate here the X11 version you used
Dynamic loading:
Indicate here if dynamic loading is supported and all info that seems
necessary for loading a file in a running interpreter.
Who:
your email or "Anonymous" if you don't want to bother yourself
with that anymore.
Tested:
How much you have tested STk (just compiled it, tested only the
demos, ...)
Remarks:
Everythink you think is relevant.

126
COPYRIGHTS Normal file
View File

@ -0,0 +1,126 @@
Since I'm not a lawyer, I don't know where to put copyrigth notices
and permission notices of softwares I use. Consequently I put them here in
hope it's sufficient....
Note:
STk licence seems not to be as clear as I hope. The main idea is
that you can do what you want with STk. You can even use it in
commercial products. The only restriction is that you must prevent me
if you intend to use it in a commercial product (so I can send you a
"written permission" for efectively using it). The goal is not to
restrict commercial applications but only to count them. If someone,
fluent in english and which like those aspects, can help me to make
things clearer...
==============================================================================
TK/TCL Copyright
----------------
Copyright (c) 1987-1993 The Regents of the University of California.
Copyright (c) 1994 Sun Microsystems, Inc.
This software is copyrighted by the Regents of the University of
California, Sun Microsystems, Inc., and other parties. The following
terms apply to all files associated with the software unless explicitly
disclaimed in individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.
RESTRICTED RIGHTS: Use, duplication or disclosure by the government
is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
of the Rights in Technical Data and Computer Software Clause as DFARS
252.227-7013 and FAR 52.227-19.
Siod Copyright
--------------
/* Scheme In One Defun, but in C this time.
* COPYRIGHT (c) 1988-1992 BY *
* PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
* ALL RIGHTS RESERVED *
Permission to use, copy, modify, distribute and sell this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all copies
and that both that copyright notice and this permission notice appear
in supporting documentation, and that the name of Paradigm Associates
Inc not be used in advertising or publicity pertaining to distribution
of the software without specific, written prior permission.
PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
PARADIGM BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
SOFTWARE.
*/
Tiny CLOS copyright
-------------------
;;; Copyright (c) 1992 Xerox Corporation.
;;;; All Rights Reserved.
;;;
;;; Use, reproduction, and preparation of derivative works are permitted.
;;; Any copy of this software or of any derivative work must include the
;;; above copyright notice of Xerox Corporation, this paragraph and the
;;; one after it. Any distribution of this software or derivative works
;;; must comply with all applicable United States export control laws.
;;;
;;; This software is made available AS IS, and XEROX CORPORATION DISCLAIMS
;;; ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;;; PURPOSE, AND NOTWITHSTANDING ANY OTHER PROVISION CONTAINED HEREIN, ANY
;;; LIABILITY FOR DAMAGES RESULTING FROM THE SOFTWARE OR ITS USE IS
;;; EXPRESSLY DISCLAIMED, WHETHER ARISING IN CONTRACT, TORT (INCLUDING
;;; NEGLIGENCE) OR STRICT LIABILITY, EVEN IF XEROX CORPORATION IS ADVISED
;;; OF THE POSSIBILITY OF SUCH DAMAGES.
and finally
STk Copyright
-------------
/*
* Copyright © 1993-1996 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.
*
* This software is a derivative work of other copyrighted softwares; the
* copyright notices of these softwares are placed in the file COPYRIGHTS
*
*/

1196
ChangeLog Normal file
View File

File diff suppressed because it is too large Load Diff

40
Contrib/%README Normal file
View File

@ -0,0 +1,40 @@
This directory contains contributions which have been sent to me.
Inspect
The STk-inspector (contributor Erick Fintzel -- fintzel@kaolin.unice.fr)
Pretty
A pretty printer (contributor Martine Follen -- mf@unice.fr)
Process
A set of new primitives to deal with Unix processes. This contribution will
be included in the core interpreter in the next release (contributors
Alexander Taranov, Grygory Niconov and David Tolpin -- tay@jet.msk.su,
gn@jet.msk.su and Dvd@CIM.Msk.SU)
Python
A patch which permits to communicate with a Python interpreter
(contibutor jredford@lehman.com)
Socket
An implementation of BSD-INET sockets and is known to run on
Solaris 1 and Linux. This is the starting point of current implementation.
Contributor: David Tolpin (dvd@pizza.msk.su)
Stetris
This is a falling block game not unlike tetris(tm) :). It is
implemented in STk just to prove it can be done, and as a challenge to
TCLers. (contributor Harvey J. Stein -- hjstein@math.huji.ac.il)
STk-wtour
A rewritting of the Andrew Payne Tcl/Tk wtour for STk.
This is excellent for learning basics od STk programming
(contributor Suresh Srinivas -- ssriniva@cs.indiana.edu)
Trace
A trace procedure (contributor Martine Follen -- mf@unice.fr)
Another contribution, called XS, (a Scheme graphical debugger) is also available
as a separate file on kaolin.unice.fr in the file ~ftp/pub/xscheme0.2.gz.

5
Contrib/Inspect/README Normal file
View File

@ -0,0 +1,5 @@
This directory contains the STk graphical Inspector. It is a first step toward
a true debugger (able to set breakpoints, to see the stack, ...).
This work is due to Eric Fintzel (fintzel@kaolin.unice.fr).
Hacked by Erick Gallesio (eg@unice.fr) for version 2 integration.

1
Contrib/Inspect/inspect-detail.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/inspect-detail.stk

1
Contrib/Inspect/inspect-help.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/inspect-help.stk

1
Contrib/Inspect/inspect-main.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/inspect-main.stk

1
Contrib/Inspect/inspect-misc.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/inspect-misc.stk

1
Contrib/Inspect/inspect-view.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/inspect-view.stk

1
Contrib/Pretty/pp.stk Symbolic link
View File

@ -0,0 +1 @@
../../Lib/pp.stk

628
Contrib/Process/process.c Normal file
View File

@ -0,0 +1,628 @@
#include "stk.h"
#include <fcntl.h>
#include <errno.h>
#include <sys/param.h>
#include <sys/wait.h>
#include <unistd.h>
#include <signal.h>
#define MAX_PROC_NUM 256 /*enough eh?*/
#define MAX_ARGS_NO 256
#define NO_REDIRECTION 0
#define REDIRECTION_BY_FILE 1
#define REDIRECTION_BY_STREAM 2
/******** SIGUSR1 handler *******/
static void su1_handler(){
/* printf("SIGUSR1 arrived\n"); */
}
/*********************************/
/**** Registering processes ****/
static SCM proc_arr[MAX_PROC_NUM];
static init_proc_table(){
int i;
for(i = 0; i<MAX_PROC_NUM; i++)
proc_arr[i] = ntruth;
}
static int find_process(SCM prc){
int i;
int ret = -1;
for(i = 0; i<MAX_PROC_NUM; i++){
if(prc==proc_arr[i]){
ret = i;
break;
}
}
return ret;
}
static int reg_process(SCM prc){
int i;
/* find slot */
i = find_process(ntruth);
if(i<0){
gc_for_newcell();
i = find_process(ntruth);
}
if (i < 0){
err("Too many processes", NIL);
return -1;
}
proc_arr[i] = prc;
return 0;
}
static
int find_slot(){
int i;
/* find slot */
i = find_process(ntruth);
if(i<0){
gc_for_newcell();
i = find_process(ntruth);
}
if (i < 0){
err("Too many processes", NIL);
return -1;
}
return i;
}
static int remove_process(SCM prc){
int i;
/* find slot */
i = find_process(prc);
if(i<0){
err("unregistered process", prc);
return -1;
}
proc_arr[i] = ntruth;
return 0;
}
/**** gc-helpers *****/
static void free_process( SCM process );
static void mark_process( SCM process );
static int tc_process;
static extended_scheme_type process_type = {
"process", /* name */
0, /* is_procp */
mark_process, /* gc_mark_fct */
free_process, /* gc_sweep_fct */
NULL, /* apply_fct */
NULL /* display_fct */
};
struct process_info {
int pid; /* pid */
char *commandLine; /* Cmdline used to start process */
char redirection[3]; /* Types of redirection */
struct obj *stream[3];
};
#define PROCESS(x) ((struct process_info *)(x->storage_as.extension.data))
#define PROCESSP(x) (TYPEP (x, tc_process))
#define NPROCESSP(x) (NTYPEP (x, tc_process))
#define PROCPID(x) PROCESS(x)->pid
extern char **sys_errlist;
static char *stdStreams[3] = {
"standard input", "standard output", "standard error",
};
static char *strName[3] = {
"stdin", "stdout", "stderr",
};
static PRIMITIVE
fork_process( SCM command, SCM args, SCM redirection, int run_async );
PRIMITIVE
run_process( SCM command, SCM args, SCM redirection ) {
return fork_process(command, args, redirection, 1);
}
PRIMITIVE
run_sync( SCM command, SCM args, SCM redirection ) {
return fork_process(command, args, redirection, 0);
}
static PRIMITIVE
fork_process( SCM command, SCM args, SCM redirection, int run_async ) {
SCM pinfo, arg, pnames, ptypes;
char *argv[MAX_ARGS_NO], msg[256], *files[3];
int argc, pid, i;
long flag;
int pipes[3][2];
int redirectionType[3];
struct process_info *info;
void *old_chld_sig_action;
int svMask, usermask; int ok;
int svMask1, mypid;
usermask = (sigmask(SIGUSR1));
/* Checking arguments and creating UNIX-style */
/* arguments list */
if( NSTRINGP( command ) )
err("run-process: bad program name", command);
i = find_slot();
if( i < 0)
return ntruth;
NEWCELL(pinfo, tc_process);
proc_arr[i] = pinfo;
info = (struct process_info *) malloc( sizeof( struct process_info ) );
PROCESS(pinfo) = info;
/*
*
* Initializing info structure
*
*/
info->commandLine = strdup(CHARS( command ) );
for( i = 0; i < 3; i++ ) {
info->redirection[i] = NO_REDIRECTION;
info->stream[i] = NIL;
}
argv[0] = CHARS( command );
for( argc = 1; argc < MAX_ARGS_NO && NNULLP( args ); ++argc ) {
if( NCONSP( args ) )
err("run-process: bad arguments list", args);
arg = CAR( args );
args = CDR( args );
if( NSTRINGP( arg ) ) {
/* In future, may be I implement conversion from */
/* non-string argument to the string, but today */
/* I don't want to do that :) */
err("run-process: bad argument -- must be string", arg);
}
argv[argc] = CHARS( arg );
}
if( argc == MAX_ARGS_NO )
err("run-process: too many arguments (limit is 256)", args);
argv[argc] = NULL;
/* Parsing redirection's list and creating communication */
if( NNULLP( redirection ) ) {
for( i = 0; i < 3; ++i ) {
if( NCONSP( redirection ) )
err("run-process: wrong redirection's list", redirection);
if( STRINGP( CAR( redirection ) ) ) {
info->redirection[i] = REDIRECTION_BY_FILE;
info->stream[i] = string_copy( CAR( redirection ) );
/* redirectionType[i] = REDIRECTION_BY_FILE;
files[i] = CHARS( CAR( redirection ) ); */
pipes[i][0] = open(CHARS( CAR( redirection ) ),
i == 0 ? O_RDONLY : O_WRONLY);
if( pipes[i][0] < 0 ) {
sprintf(msg, "run-process: can't redirect %s to file %s",
stdStreams[i], CHARS( CAR( redirection ) ));
err( msg, NIL );
}
redirection = CDR( redirection );
continue;
}
if( BOOLEANP( CAR( redirection ) ) ) {
if( CAR( redirection ) == truth ) {
if( pipe( pipes[i] ) < 0 ) {
sprintf(msg, "run-process: can't create stream for %s\n",
stdStreams[i]
);
perror("Process");
err( msg, NIL );
}
/* redirectionType[i] = REDIRECTION_BY_STREAM; */
info->redirection[i] = REDIRECTION_BY_STREAM;
}
redirection = CDR( redirection );
continue;
}
err("run-process: bad redirection type", CAR( redirection ));
}
}
/* set handler to catch SIGUSR1 */
signal(SIGUSR1,su1_handler);
/* block user1 signal till parent will be ready */
svMask1 = sigblock(usermask);
mypid = getpid();
/* Now, forking and catching the errors */
pid = fork();
if( pid < 0 ) {
char msg[256];
sprintf(msg,
"run-process: can't create child process because of (see stderr)"
);
perror("CHILD process");
err( msg, NIL );
}
/* Processing child's behavior */
if( pid == 0 ) {
if(run_async){
svMask = sigblock(usermask);
signal(SIGUSR1,su1_handler);
/* send notification to parent that I'm ready */
ok = kill(mypid,SIGUSR1);
if(ok < 0) perror( "Sending to parent");
sigpause(0);
sigsetmask(svMask);
/*
* fprintf(stderr, "Mask: %x\n", usermask);
* fprintf(stderr, "Child continues...");
* perror("Child:");
*/
setsid();
}
for( i = 0; i < 3; ++i ) {
switch( info->redirection[i] ) {
case REDIRECTION_BY_FILE:
dup2( pipes[i][0], i );
close( pipes[i][0] );
break;
case REDIRECTION_BY_STREAM:
dup2( pipes[i][ i == 0 ? 0 : 1], i );
close( pipes[i][0] );
close( pipes[i][1] );
break;
default:
break;
}
}
for( i = 3; i < NOFILE; ++i )
close( i );
/* And then, EXEC'ing... */
execvp( argv[0], argv );
/* Unfortunatelly, we can't exec this process -- but */
/* we can't tell 'bout this fact to our daddy. :( */
fprintf(stderr, "Can't exec!");
exit( 1 );
}
/* Ok, guys, we are still in the parent process. Making redirection */
/* and filling-up PROCESS structure */
PROCPID( pinfo ) = pid;
if(!run_async) waitpid(pid);
else {
for( i = 0; i < 3; ++i ) {
switch( info->redirection[i] ) {
case REDIRECTION_BY_FILE:
close( pipes[i][0] );
break;
case REDIRECTION_BY_STREAM:
close( pipes[i][ i == 0 ? 0 : 1 ] );
flag = no_interrupt(1);
NEWCELL( info->stream[i], i == 0 ? tc_oport : tc_iport );
if( (info->stream[i]->storage_as.port.f =
fdopen( pipes[i][ i == 0 ? 1 : 0],
i == 0 ? "w" : "r" )) == NULL )
err("process-input: can't FDOPEN stream", pinfo);
sprintf(msg, "*%s-%d*", strName[i], pid);
info->stream[i]->storage_as.port.name = must_malloc( strlen( msg ) + 1 );
strcpy( info->stream[i]->storage_as.port.name, msg );
no_interrupt( flag );
break;
default:
break;
}
}
/** all house keeping is done... notyfy child to go ***/
#if 1
sigpause(0); /* wait for child notification */
sigsetmask(svMask1);
/* notify child */
ok = kill(pid,SIGUSR1);
if(ok < 0) perror("Parent sigusr");
/* else fprintf(stderr, "Parent sending SIGUSR1 to %d\n",pid); */
#endif
}
PROCESS( pinfo ) = info;
return pinfo;
}
/*** INTERFACE ****/
PRIMITIVE
processp( SCM process ) {
return PROCESSP( process ) ? truth : ntruth;
}
PRIMITIVE
process_alivep( SCM process ) {
if( NPROCESSP( process ) )
err("process-alive?: wrong argument type", process);
return kill( PROCPID( process ), 0 ) == 0 ? truth : ntruth;
}
PRIMITIVE
process_pid( SCM process ) {
if( NPROCESSP( process ) )
err("process-pid: wrong argument type", process);
return makeinteger( PROCPID( process ) );
}
static char *rtFile = "*File*";
static char *rtStream = "*Stream*";
static char *rtNone = "*None*";
static PRIMITIVE
get_internal_redirection( SCM process, int i ) {
SCM rType, rName;
struct process_info *info;
if( NPROCESSP( process ) )
err("process-stream-type: wrong argument type", process);
info = PROCESS( process );
switch( info->redirection[i] ) {
case REDIRECTION_BY_FILE:
rType = makestrg( strlen( rtFile ), rtFile );
rName = string_copy( info->stream[i] );
break;
case NO_REDIRECTION:
rType = makestrg( strlen( rtNone ), rtNone );
rName = NIL;
break;
default: /* REDIRECTION_BY_STREAM */
rType = makestrg( strlen( rtStream ), rtStream );
rName = makestrg( strlen( stdStreams[i] ), stdStreams[i] );
break;
}
return cons( rType, rName );
}
/*** enumerate ***/
PRIMITIVE
process_list(){
int i;
SCM lst = NIL;
for(i = 0; i<MAX_PROC_NUM; i++)
if(proc_arr[i] != ntruth)
lst = cons(proc_arr[i],lst);
return lst;
}
PRIMITIVE
process_input_info( SCM process ) {
return get_internal_redirection( process, 0 );
}
PRIMITIVE
process_output_info( SCM process ) {
return get_internal_redirection( process, 1 );
}
PRIMITIVE
process_error_info( SCM process ) {
return get_internal_redirection( process, 2 );
}
PRIMITIVE
process_command( SCM process ) {
struct process_info *info;
if( NPROCESSP( process ) )
err("process-command: wrong argument type", process);
info = PROCESS( process );
return makestrg( strlen( info->commandLine ), info->commandLine );
}
/*
* Creating and returning ports to opened streams
*/
PRIMITIVE
process_input( SCM process ) {
struct process_info *info;
if( NPROCESSP( process ) )
err("process-input: wrong argument type", process);
info = PROCESS( process );
if( info->redirection[0] != REDIRECTION_BY_STREAM ) {
return NIL;
}
return info->stream[0];
}
PRIMITIVE
process_output( SCM process ) {
struct process_info *info;
if( NPROCESSP( process ) )
err("process-input: wrong argument type", process);
info = PROCESS( process );
if( info->redirection[1] != REDIRECTION_BY_STREAM ) {
return NIL;
}
return info->stream[1];
}
PRIMITIVE
process_error( SCM process ) {
struct process_info *info;
if( NPROCESSP( process ) )
err("process-input: wrong argument type", process);
info = PROCESS( process );
if( info->redirection[2] != REDIRECTION_BY_STREAM ) {
return NIL;
}
return info->stream[2];
}
void
mark_process( SCM process ){
struct process_info *info;
int i;
info = PROCESS(process);
for(i=0; i<3 ; i++)
gc_mark(info->stream[i]);
}
void
free_process( SCM process ) {
int i;
struct process_info *info;
info = PROCESS( process );
i = remove_process(process);
if(i < 0)
err("cannot unregister process", process);
if( info->commandLine )
free( info->commandLine );
for( i = 0; i < 3; ++i ) {
if( info->redirection[i] == REDIRECTION_BY_STREAM && info->stream[i] != NIL ) {
freeport( info->stream[i] );
}
}
free(info); /* A.T. ++ */
}
PRIMITIVE
process_kill( SCM process ) {
struct process_info *info;
int i;
if( NPROCESSP( process ) )
err("process-kill: wrong argument", process);
info = PROCESS( process );
#if 1
for( i = 0; i < 3; ++i ) {
if( info->redirection[i] == REDIRECTION_BY_STREAM &&
info->stream[i] != NIL ) {
freeport( info->stream[i] );
info->stream[i]=NIL;
}
}
#endif
kill( PROCPID( process ), 15 );
return truth;
}
/******* run-time initialization ********/
void init_process(void)
{
tc_process = add_new_type(&process_type);
init_proc_table();
add_new_primitive("run-process", tc_subr_3, run_process); /* + */
add_new_primitive("run-sync", tc_subr_3, run_sync); /* + */
add_new_primitive("process?", tc_subr_1, processp); /* + */
add_new_primitive("process-alive?", tc_subr_1, process_alivep); /* + */
add_new_primitive("process-input-info", tc_subr_1, process_input_info); /* + */
add_new_primitive("process-output-info", tc_subr_1, process_output_info); /* + */
add_new_primitive("process-error-info", tc_subr_1, process_error_info); /* + */
add_new_primitive("process-command", tc_subr_1, process_command); /* + */
add_new_primitive("process-pid", tc_subr_1, process_pid); /* + */
add_new_primitive("process-input", tc_subr_1, process_input); /* + */
add_new_primitive("process-output", tc_subr_1, process_output); /* + */
add_new_primitive("process-error", tc_subr_1, process_error); /* + */
add_new_primitive("process-kill", tc_subr_1,process_kill); /* + */
add_new_primitive("process-list", tc_subr_0,process_list); /* + */
}

50
Contrib/Process/process.h Normal file
View File

@ -0,0 +1,50 @@
/**
* Process.h - LISP implementation of UNIX processes
*
* Copyright (c) 1994 by Gregory Nickonov.
*
* 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.
*
* This software is a derivative work of other copyrighted softwares; the
* copyright notices of these softwares are placed in the file COPYRIGHTS
*
*
* Author: Gregory Nickonov, [gn@jet.msk.su]
* Creation date: 15-Jan-1994 11:40
* Last file update: 11-Jun-1994 22:07
*
* Made working by David Tolpin Dvd@CIM.Msk.SU
* Port to Dynaload STk2.1b,
* synchronization and registration
* mechanism by A.Taranov tay@jet.msk.su
*
*/
#ifndef __PROCESS_H__
#define __PROCESS_H__
PRIMITIVE processp( SCM process );
PRIMITIVE process_alivep( SCM process );
PRIMITIVE run_process( SCM command, SCM args, SCM redirection );
PRIMITIVE run_sync( SCM command, SCM args, SCM redirection );
PRIMITIVE process_kill( SCM process );
PRIMITIVE process_input( SCM process );
PRIMITIVE process_output( SCM process );
PRIMITIVE process_error( SCM process );
PRIMITIVE process_input_info( SCM process );
PRIMITIVE process_output_info( SCM process );
PRIMITIVE process_error_info( SCM process );
PRIMITIVE process_command( SCM process );
PRIMITIVE process_pid( SCM process );
#endif /* __PROCESS_H__ */

175
Contrib/Python/jredford-mail.txt Normal file
View File

@ -0,0 +1,175 @@
Herafter is an excerpt of a mail of jredford@lehman.com about Python/STk mail
I hope it will suffice to build a running system (I had no time to test it).
------------------
This is the file I added.. python-stk.c:
#include <stk.h>
#include <Py/allobjects.h>
#include <Py/pythonrun.h>
#include <Py/import.h>
PRIMITIVE python_init(void)
{
initall();
return UNDEFINED;
}
PRIMITIVE python(SCM string)
{
run_command(CHARS(string));
return UNDEFINED;
}
SCM convert(object *o)
{
if is_intobject(o) {
return makeinteger(getintvalue(o));
} else {
if is_floatobject(o) {
return makenumber(getfloatvalue(o));
} else {
if is_stringobject(o) {
return makestrg(getstringsize(o),getstringvalue(o));
} else {
if is_tupleobject(o) {
int i,j = gettuplesize(o);
SCM vec;
vec = makevect(j,makeinteger(0));
for (i = 0; i < j; i++) {
vector_set(vec, makeinteger(i), convert(gettupleitem(o,i)));
}
return vector2list(vec);
} else {
if is_listobject(o) {
int i,j = getlistsize(o);
SCM vec;
vec = makevect(j,makeinteger(0));
for (i = 0; i < j; i++) {
vector_set(vec, makeinteger(i), convert(getlistitem(o,i)));
}
return vector2list(vec);
}
}
}
}
}
return UNDEFINED;
}
PRIMITIVE python_value(SCM dict, SCM var)
{
object *m, *d, *v;
m = add_module(CHARS(dict));
if (m == NULL)
return UNDEFINED;
d = getmoduledict(m);
v = dictlookup(d,CHARS(var));
return convert(v);
}
char *
getprogramname()
{
return "stk";
}
END of file python-stk.c
The initall() should be done in init_python-stk(). You might know of a
better way to convert the data types, or to more efficiently make
lists. These were the calls that I found easilly. I also didnt know
how to typecheck the arguments passed. They should all be strings.
This is the summary of what I added to primitives.c
/*
*
* p r i m i t i v e s . c -- List of STk subrs
*/
#ifdef USE_PYTHON
extern PRIMITIVE python_init(void);
extern PRIMITIVE python(SCM string);
extern PRIMITIVE python_value(SCM dict, SCM var);
#endif
static struct Primitive Scheme_primitives[] = {
.
.
.
#ifdef USE_PYTHON
{"python-init", tc_subr_0, python_init},
{"python", tc_subr_1, python},
{"python-value", tc_subr_2, python_value},
#endif
.
.
.
An example.. well, I never used Tk before Stk, so Im not gonna do
anything too pretty.
#!/opt/stk/bin/stk -file
(python-init) ;This should really be (require "python") or (require "python-stk")
(python "import posix") ;Python is a module based language
(button ".b" :text "Press me" :borderwidth 2 :background "slate gray" :foreground "gold"
:command '(begin
(python "a = posix.listdir('.')")
(for-each (lambda (a) (.f.lb 'insert 99999 a))
(python-value "__main__" "a"))))
(frame ".f")
(listbox ".f.lb" :foreground "grey40" :background "grey70" :yscroll ".f.s 'set")
(scrollbar ".f.s" :relief "sunken" :command ".f.lb 'yview")
(pack .f.lb .f.s :side "right" :fill "y")
(pack .b .f)
Where this would populate a listbox with the filenames in the current
directory, everytime the button was pushed. posix.listdir() returns a
python 'list' type. __main__ is the name/alias of the primary module.
If I could figure out STk calling enough to use variable args, I'd
have made (python-value "a") assume a value of "__main__" for the
dict..
Makefile modifications:
# This isnt the default python dir, just what I use. should be a
# configure option.. --with-python=/opt/python
PYTHONDIR = /opt/python
PYTHONLIBPATH = $(PYTHONDIR)/lib/python/lib
PYTHONCFLAGS = -I$(PYTHONDIR)/include -I$(PYTHONDIR)/include/Py
PYTHONOBJ = python-stk.o
PYTHONLIB = $(PYLIBPATH)/libModules.a \
$(PYLIBPATH)/libPython.a \
$(PYLIBPATH)/libParser.a \
$(PYLIBPATH)/libObjects.a
PYTHONLIBS = -lreadline -ltermcap
LIBS = -lnsl -ldl $(PYTHONLIBS) -lm
...
/bin/rm -f primitives.o
make CFLAGS="$(CFLAGS) -DUSE_PYTHON" primitives.o
$(CC) -o stkp-bin -DUSE_PYTHON $(OBJ) $(PYTHONOBJ) -I$(PYTHONDIR)/include/Py -DNO_MAIN $(PYTHONLIBPATH)/config.c userinit.c $(ALLIBS) $(XLIBSW) $(PYTHONLIB) $(LIBS)
/bin/rm -f primitives.o
Removing primitives.c to recompile with -DUSE_PYTHON is a horrible
kludge, as I am sure you agree. The key thing is to also compile in
-DNO_MAIN $(PYLIBPATH)/config.c

7
Contrib/STk-wtour/CHANGES Normal file
View File

@ -0,0 +1,7 @@
Version 0.2 -- minor bug fixes and new lessons by Erick Gallesio (eg@unice.fr)
Version 0.1 -- original writing by Suresh Srinivas (ssriniva@cs.indiana.edu)
TODO
----
Integrate STklos lessons

35
Contrib/STk-wtour/README Normal file
View File

@ -0,0 +1,35 @@
Scheme/STk Widget Tour 0.2
--------------------------
This is a rewrite of the Tcl/Tk wtour2.0 in Scheme/STk. I wrote it
while I was learning the nuances of STk. I also avoided using the send
mechanisms to make it quicker/easier to learn (I had to set up all the
authentication stuff to have the Tcl/Tk wtour working).
Installing and Running
----------------------
To start the tour assume that the locations of the STk binary and library
in "stk-wtour" are correct. Once this is done, just type
% ./stk-wtour
Use the menus to navigate through different lessons. You can make changes
to the lesson source code; click on the Apply button to see the results of
the changes.
Acknowledgements and Notes
--------------------------
The original,excellent, tour of Tcl/Tk was due to Andrew Payne
(payne@crl.dec.com). I hope you enjoy the Scheme version
(Adding some STklos lessons is next in the set of things to do).
I've tested it on Silicon Graphics running IRIX 5.2 (They are
the coolest machines around, look them up).
Suresh Srinivas,
Graduate Student,
Parallel Computing Group,
Indiana University,
(ssriniva@cs.indiana.edu)
Thesis: Investigating large scale parallel programs.
Interests: Parallel Computing, Visualization, Scheming.

9
Contrib/STk-wtour/lessons/bind1.stk Normal file
View File

@ -0,0 +1,9 @@
;; Event binding
(entry '.e1 :relief "sunken")
(pack .e1 :expand #t :fill "x")
(bind .e1 "<Tab>" (lambda ()
(display "You pressed Tab!\n")))
(bind .e1 "<ButtonPress-2>" (lambda ()
(display "You pressed Button 2!\n")))

7
Contrib/STk-wtour/lessons/bind2.stk Normal file
View File