Commit of 3.99.3 version

This commit is contained in:
Erick Gallesio 1998-09-30 13:11:02 +02:00
parent dd57fe2b2a
commit fd0f8b8984
254 changed files with 41301 additions and 18704 deletions

27
CHANGES
View File

@ -1,3 +1,30 @@
30/09/98 Release 3.99.3
-----------------------
Mains changes/modifications since 3.99.2 are:
* Tk level is 8.0.3 (the latest stable Tk release)
* New STklos Classes:
+ <Hierarchy-tree> and <Hierarchy-item> to draw
hierarchy such as files/directories, class/metaclasses ...
+ <Notepad> to define ... notepads
+ <Scheme-text> which extends <Text> to "font-lockify"
Scheme buffers
* Method and generic function editor
* A class browser (type "(class-browser)" to access it)
* some new manual pages
* Base64 Encoding/Decoding extension
* Locale extension to treat strings and character using locale information
* Better installation scripts (+ some corrections)
* Bug corrections
06/09/98 Release 3.99.2
-----------------------

224
ChangeLog
View File

@ -1,3 +1,222 @@
1998-09-27 Erick Gallesio <eg@unice.fr>
* Src/toplevel.c (init_interpreter): *stk-library* is now
initialized here instead in the Tk initialization procedure
(implying that this variable is now defined in snow).
* Tk version is now 8.0.3. The stable version of Tk8.0
1998-09-26 Erick Gallesio <eg@unice.fr>
* Demos/classbrowse.stklos: New Demo of the class browser
* Lib/class-browser.stklos: New file. This is class browser which
fully use the MOP to display various informations about classes,
such as their methods or their slots. Accessing to a class is done
through a panel which shows the complete class hierarchy
* Lib/method-editor.stklos: New file: Editor for methods and
generic functions
* Demos/widget.stk: Code of the various demo of the big widget
program are now "font-locked".
* STklos/Tk/Composite/Schemetext.stklos: New class: <Scheme-text>.
This is a subclass of <Scroll-text> specialize for Scheme
programs. For now, only Emacs like "font-locking" is done by this
widget.
* Tk/generic/tkText.c (TextSearchCmd): Added environment
management to the Text searches.
1998-09-25 Erick Gallesio <eg@unice.fr>
* Src/tcl-lib.c (Tcl_CreateInterp): Cache of regexp was not
correctly initialized.
* STklos/Tk/Composite/Multiwin.stklos: Border width of a Mutiple
window is fixed to 0. Otherwise, displacement of inner windows is
"chaotic". This particularly occurs when the user has a default
border-width defined in its Xdefaults file.
1998-09-19 Erick Gallesio <eg@unice.fr>
* Extensions/locale.c: New file. This extensions implement string
and character comparisons using locale. The new functions are of
the form string-lo<?, string-lo-ci=?, and so on...
* Src/str.c (stringcomp): Bug in stringcomp with 8bit characters.
We had (char<? #\é #\e) => #f whereas (string<? "é" "e") => #t
Comparison is now done on unsigned chars.
1998-09-17 Erick Gallesio <eg@unice.fr>
* Src/argv.c (STk_process_argc_argv): Processing of argument has
been rewritten.
1998-09-16 Erick Gallesio <eg@unice.fr>
* Src/number.c (_STk_do_addition): Bug correction (two small
giving a bignum in some cases).
1998-09-10 Erick Gallesio <eg@unice.fr>
* Lib/tk-unix.stk: completely rewritten.
* Doc/Manual/choose-color.n:
* Doc/Manual/message-box.n: New manual pages
* STklos/Tk/Tk-classes.stklos : The standard Tk dialog were not
exported correctly.
1998-09-09 Erick Gallesio <eg@unice.fr>
* Big code cleanup on all STk code. There were problems with
Alpha, and I hope that this cleanup, will ease to find the
problems.
1998-08-31 Erick Gallesio <eg@unice.fr>
* Tk/unix/tkUnixSend.c (TkGetInterpNames): Bug correction: If the
number of running intrepreters was 1, the command (winfo 'interps)
returned a strings instead of a list of length 1.
* Src/toplevel.c (repl_driver): The interpreter cannot be executed
if the DISPLAY variable is not set and the option -no-tk has not
been used. This should avoid me a lot of mail from people which
install STk and complain of weird message when launching the
demos...
* Src/eval.c (STk_eval): Call to apply without parameter
(i.e. [apply]) yields an error. This was a long standing bug
signalled by Josh Mc Donald in 1995!!!
1998-08-29 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Toplevel.stklos: Two new methods make-transient and
place-toplevel.
* STklos/stklos.stk (class-methods): New function, which return
all the methods which have a given class (or a descendant) in its
specializers.
1998-08-25 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Composite/Notepad.stklos: New file which define a
Note-pad class.
* Demos/stklos-widgets.stklos: Added <Notepad> demo
1998-08-24 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Composite/Hierarchy.stklos: New file which define 2
new classes: <Hierarchy-tree> and <Hierarchy-item> which allow to
display any kind of hierarchy (see the source file for 3 examples
of use).
* Demos/stklos-widgets.stklos: Added <hierarchy-tree> demo
1998-08-23 Erick Gallesio <eg@unice.fr>
* Tk/generic/tkBind.c (Tk_CreateBinding, FreeTclBinding): Bug
correction: Bindings on item canvas, were not properly
garbaged. BTW, the way for keeping track of closures used in
bindings has been simplified.
* Tk/generic/tkCmds.c (Tk_BindCmd): Adaptated to the new scheme
for bindings.
1998-08-20 Erick Gallesio <eg@unice.fr>
* STklos/Tk/Scrollbar.stklos: Adding exportation of
STk:{h|v}-scroll-side and STk:{h|v}-scroll-side-set!
1998-07-28 Erick Gallesio <eg@unice.fr>
* STklos/stklos.stk (compute-get-n-set): Signaling that an
allocation scheme is unknown is now done in a method which
discriminate on <object> instead of <class>. This greatly
simplifies the usage of meta-classes which use multiple
inheritance (old code implicitly suppose that a meta-class has a
CPL of the form [ ... <class> <object> <top>]. With this
modification, <class> can appear before an "ante-penultiem"
position.
1998-07-27 Erick Gallesio <eg@unice.fr>
* Utils/STk.spec.in: Modified to be more architecture independent
(as far as possible). In particular Linux PPC should work
(inspired from a STk.spec file given by Philippe Laliberte
<arsphl@oeil.qc.ca>).
1998-07-25 Erick Gallesio <eg@unice.fr>
* Tk/unix/tkUnixWm.c: Make the result of (wm 'state ...)
consistent. It was, depending the cases, a string or a
symbol. This is always a string now. THIS COULD BREAK EXISTING
CODE!
* Lib/tk-init.stk (*start-withdrawn*): One example of code broken
by previous modification...
1998-07-22 Erick Gallesio <eg@unice.fr>
* Src/Makefile.in (install.stk.libs): The tcl-glue.h and tk-glue.h
files were not installed when doing a "make
install.libs". Corrected now. Thanks to Vincent Granet
<vg@unice.fr> for signalling it.
1998-07-20 Erick Gallesio <eg@unice.fr>
* Src/print.c (printlist_star): Buggy when printing some simple
dotted pair. The patch was provided by Ian Wild
<ian.wild@eurocontrol.be>.
* Tk/generic/tkFont.c (GetAttributeInfoObj): Bug when reporting
boolean font attributes. Bug signalled by Vincent Granet
<vg@unice.fr>
* Extensions/base64.c: New file which provides base64 file
encoding and decoding (base64-encoding and base64-decoding)
* Lib/base64.stk: New file which load the base64 extension. It
also provides the functions (base64-encoding-string and
base64-decoding-string)
1998-07-19 Erick Gallesio <eg@unice.fr>
* Src/cont.c (STk_throw): Bug correction: continuation escape
procedures couldn't take an arbitrary number of arguments. Thanks
to Michael N. Livshin <mike@olan.com> for the patch.
1998-07-17 Erick Gallesio <eg@unice.fr>
* Makefile.in: Modified so that all the install paths are relative
to the value of "prefix". This seems to be useful for people using
STOW. Suggestion made by Michael N. Livshin <mike@olan.com>.
1998-07-15 Erick Gallesio <eg@unice.fr>
* Extensions/hash.c (hash_table_put): Another bug in the hash
table is corrected. Code for putting values in hash tables whose
hash function is given by the user has been rewritten. Thanks to
Brian Denheyer <briand@northwest.com> for pointing this bug.
1998-07-14 Erick Gallesio <eg@unice.fr>
* Suppression of the background bitmap for the Web pages. It was
not easily readable on 8bits displays. Even HTML is hard to port !!
1998-06-27 Erick Gallesio <eg@unice.fr>
* Doc/Reference/Appendix-F.tex: Correction of a "bug" for the
emacs auto-mode-alist variable initialization (signalled by
craig dry <ra0531@email.sps.mot.com>)
1998-06-09 Erick Gallesio <eg@unice.fr>
* Release 3.99.2
@ -275,8 +494,9 @@ Mon Feb 2 22:47:52 1998 Erick Gallesio <eg@unice.fr>
Sun Feb 1 19:16:46 1998 Erick Gallesio <eg@unice.fr>
* Lib/tk-unix.stk: New file for the definition of standard messages
box. They are simulated on Unix and will be natve (someday) on Windows.
* Lib/tk-unix.stk: New file for the definition of standard
messages box. They are simulated on Unix and will be native
(someday) on Windows.
* STklos/Tk/MsgBox.stklos: New Classes: <Tk-message-box>

View File

@ -10,7 +10,7 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: animate.stk 1.1 Tue, 10 Mar 1998 20:43:37 +0000 eg $
;;;; $Id: animate.stk 1.1 Tue, 10 Mar 1998 21:43:37 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 9-Mar-1998 18:51

View File

@ -10,7 +10,7 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: puzzle.stk 1.1 Tue, 10 Mar 1998 20:43:37 +0000 eg $
;;;; $Id: puzzle.stk 1.1 Tue, 10 Mar 1998 21:43:37 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 9-Mar-1998 21:11

View File

@ -330,6 +330,15 @@
<u>Comment</u>: Here again, what is interesting in this demo is not what
it does, nothing specially fancy, but how it is easy to
program, IMHO.
<p><li>
<b>classbrowse.stklos</b>
This demo shows the STklos class browser.
<br>
<u>Run with</u>:
<A expr=(run "classbrowse.stklos")>
../Src/test-stk -f classbrowse.stklos</a>
<br>
</ul>
<h4>2.2 STklos widgets</h4>
@ -435,7 +444,7 @@
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
<!-- Created: Sun Mar 1 15:56:45 CET 1998 -->
<!-- hhmts start -->
Last modified: Mon Mar 9 19:15:46 CET 1998
Last modified: Sat Sep 26 18:44:39 CEST 1998
<!-- hhmts end -->
</body>
</html>

View File

@ -8,7 +8,7 @@
;;;; 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 07:28:39 +0000 eg $
;;;; $Id: browse.stk 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Aug-1993 17:33

View File

@ -7,7 +7,7 @@
;;;; directory and allows you to open files or subdirectories by
;;;; double-clicking.
;;;;
;;;; $Id: browse.stklos 1.2 Mon, 16 Feb 1998 07:28:39 +0000 eg $
;;;; $Id: browse.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Aug-1993 17:33

View File

@ -13,7 +13,7 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: calc.stklos 1.2 Mon, 16 Feb 1998 07:28:39 +0000 eg $
;;;; $Id: calc.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 6-Apr-1995 18:11

22
Demos/classbrowse.stklos Executable file
View File

@ -0,0 +1,22 @@
#!/bin/sh
:;exec /usr/local/bin/stk -f "$0" "$@"
;;;; classbrowse.stk -- Demonstration of the STk class browser
;;;;
;;;; Copyright © 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
;;;; 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: classbrowse.stklos 1.1 Sat, 26 Sep 1998 19:19:52 +0200 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Sep-1998 19:12
;;;; Last file update: 26-Sep-1998 19:13
;; A Demo which is quite easy to write
(class-browser *top-root*)

View File

@ -16,7 +16,7 @@
;;;; 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 07:28:39 +0000 eg $
;;;; $Id: filebox.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: 12-Jun-1994 11:24

View File

@ -23,9 +23,11 @@
File-box
Gauge
Help-Balloon
Hierarchy-Tree
Labeled-Entry
Labeled-Frame
Multiple-Window
Notepad
Paned
Scroll-Canvas
Scroll-Listbox
@ -217,3 +219,53 @@
(slot-set! g 'value i)
(after 5)
(update))))
;=============================================================================
(define (demo-hierarchy-tree)
(let* ((top (make <Toplevel> :title "Hierarchy Tree Demo"))
(T (make <Hierarchy-tree> :parent top :width 400 :height 300)))
(pack T :expand #t :fill "both")
(define d1 (add-node T #f "dir1"))
(define d2 (add-node T #f "dir2"))
(define d3 (add-node T d1 "dir3"))
(add-leave T d1 "file2")
(add-leave T d1 "file1")
(add-leave T d3 "file3")
(add-leave T d2 "file4")))
;=============================================================================
(define (demo-notepad)
;;
;; Fist define the actions associated to the tab
;;
(define (Host parent tab)
(unless (page tab) ; First call. Create the interface
(let* ((f (make <Frame> :parent parent :border-width 3
:background "darkgray" :relief "groove"))
(b1 (make <Labeled-Entry> :parent f :title "Host: "))
(b2 (make <Labeled-Entry> :parent f :title "Port: ")))
(pack b1 b2 :fill 'x :padx 10 :pady 10)
(set! (page tab) f)))
(pack (page tab) :padx 10 :pady 10 :fill "both" :expand #t))
(define (Mess parent tab)
(unless (page tab) ; First call. Create the interface
(let ((m (make <Message> :parent parent :border-width 3
:relief "groove" :background "darkgray" :aspect 300
:justify "center" :font "10x20"
:text "This is a simple demonstration.")))
(pack m :expand #t :fill "both")
(set! (page tab) m)))
(pack (page tab) :padx 10 :pady 10 :fill "both" :expand #t))
(let* ((top (make <Toplevel> :title "Note Pad Widget Demo"))
(f (make <NotePad> :parent top :width 450 :height 150)))
(pack f :expand #t :fill "both" :padx 2 :pady 2)
(make <Notepad-Tab> :parent f :text "host1" :action Host)
(make <Notepad-Tab> :parent f :text "host2" :action Host)
(make <Notepad-Tab> :parent f :text "Multi-line\nlabel" :action Mess)
(make <Notepad-Tab> :parent f :bitmap "questhead" :width 30 :action Host)))

View File

@ -13,7 +13,7 @@
;;;; permission of the copyright holder.
;;;; This software is provided ``as is'' without express or implied warranty.
;;;;
;;;; $Id: term.stk 1.2 Mon, 16 Feb 1998 07:28:39 +0000 eg $
;;;; $Id: term.stk 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 7-Oct-1995 10:39

View File

@ -68,7 +68,7 @@
(let* ((top (make <Toplevel> :title (format #f "Demo code: ~A" file)
:geometry "+400+400"))
(but (make <Frame> :parent top))
(txt (make <Scroll-Text> :parent top :wrap "none"
(txt (make <Scheme-text> :parent top :wrap "none"
:h-scroll-side "bottom" :width 85 :height 30 :font "fixed"
:value (exec (string-append "cat " file)))))

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -8,7 +8,7 @@
%%EndComments
%DVIPSCommandLine: dvips -f Isotas96.dvi
%DVIPSParameters: dpi=600, comments removed
%DVIPSSource: TeX output 1998.06.09:0933
%DVIPSSource: TeX output 1998.09.30:1358
%%BeginProcSet: tex.pro
/TeXDict 250 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N
/X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72

View File

@ -28,10 +28,12 @@
'\" .CE
'\" End code excerpt.
'\"
'\" .VS ?br?
'\" .VS ?version? ?br?
'\" Begin vertical sidebar, for use in marking newly-changed parts
'\" of man pages. If an argument is present, then a line break is
'\" forced before starting the sidebar.
'\" of man pages. The first argument is ignored and used for recording
'\" the version when the .VS was added, so that the sidebars can be
'\" found and removed when they reach a certain age. If another argument
'\" is present, then a line break is forced before starting the sidebar.
'\"
'\" .VE
'\" End of vertical sidebar.
@ -133,7 +135,7 @@
'\" # ^Y = starting y location
'\" # ^v = 1 (for troff; for nroff this doesn't matter)
.de VS
.if !"\\$1"" .br
.if !"\\$2"" .br
.mk ^Y
.ie n 'mc \s12\(br\s0
.el .nr ^v 1u

View File

@ -256,7 +256,7 @@ For each item that meets the constraints specified by
\fItag\fR to the list of tags associated with the item if it
isn't already present on that list.
It is possible that no items will satisfy the constraints
given by \fIsearchSpec and \fIarg\fRs, in which case the
given by \fIsearchSpec\fR and \fIarg\fRs, in which case the
procedure has no effect.
This procedure returns an empty list as result.
\fISearchSpec\fR and \fIarg\fR's may take any of the following

49
Doc/Manual/choose-color.n Normal file
View File

@ -0,0 +1,49 @@
'\" Color=Green
'\"
'\" Derived from a document with following copyright
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" SCCS: @(#) chooseColor.n 1.4 96/09/19 17:01:44
'\"
.so STk-man.macros
.TH Tk:choose-color n 4.2 STk "STk procedure"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Tk:choose-color \- pops up a dialog box for the user to select a color.
.PP
.SH SYNOPSIS
\fB(tk:choose-Color \fR?\fIoption value ...\fR?)
.BE
.SH DESCRIPTION
.PP
This procedure is part of the STk library.
The procedure \fBTk:choose-color\fR pops up a dialog box for the
user to select a color. The following \fIoption\-value\fR pairs are
possible as command line arguments:
.TP
\fB:initial-color\fR \fIcolor\fR
Specifies the color to display in the color dialog when it pops
up.
.TP
\fB:title\fR \fItitleString\fR
Specifies a string to display as the title of the dialog box. If this
option is not specified, then an empty title will be displayed.
.LP
If the user selects a color, \fBTk:choose-color\fR will return the
name of the color. If the
user cancels the operation, \fBTk:choose-color\fR will return
\fB#f\fR
.SH EXAMPLE
.CS
(pack (button '.b :text "foo"
:bg (Tk:choose-color :initial-color "gray"
:title "Choose color")))
.CE

View File

@ -34,7 +34,7 @@ any of the values allowed for the \fIsequence\fR argument to the
If \fIvirtual\fR is already defined, the new physical event sequences
add to the existing sequences for the event.
.TP
(\fBevent 'delete "<<\fIvirtual\fB>>" \fR?\fIsequence \fIsequence ...\fR?)
(\fBevent 'delete "<<\fIvirtual\fB>>" \fR?\fIsequence\fR \fIsequence ...\fR?)
Deletes each of the \fIsequence\fRs from those associated with
the virtual event given by \fIvirtual\fR.
\fIVirtual\fR may be any string value and \fIsequence\fR may have

View File

@ -116,7 +116,7 @@ The platform-specific name of a font, interpreted by the graphics server.
This also includes, under X, an XLFD (see [4]) for which a single ``\fB*\fR''
character was used to elide more than one field in the middle of the
name. See PLATFORM-SPECIFIC issues for a list of the system fonts.
.VS 1
.VS 8.0 br
.TP
[3] \fIfamily \fR?\fIsize\fR? ?\fIstyle\fR? ?\fIstyle ...\fR?
.

View File

@ -9,7 +9,7 @@
'\" @(#) frame.n 1.23 95/08/12 17:35:08
'\"
.so STk-man.macros
.TH frame n 4.0 STk "Tk Built-In Commands"
.TH frame n 8.0 STk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@ -45,7 +45,7 @@ If the \fBcolormap\fR option is not specified, the new window
uses the same colormap as its parent.
This option may not be changed with the \fBconfigure\fR
widget procedure.
.VS br
.VS "" br
.OP :container container Container container
The value must be a boolean. If true, it means that this window will
be used as a container in which some other application will be embedded

View File

@ -96,8 +96,11 @@ Indicates the anchor point for the selection, which is set with the
.TP 12
\fBend\fR
Indicates the end of the listbox.
For some procedures this means just after the last element;
for other procedures it means the last element.
.VS
For most procedure this refers to the last element in the listbox,
but for a few procedure such as \fBindex\fR and \fBinsert\fR
it refers to the element just after the last one.
.VE
.TP 12
\fB@\fIx\fB,\fIy\fR
Indicates the element that covers the point in the listbox window
@ -124,6 +127,10 @@ procedures are possible for listbox widgets:
.TP
(\fIwidget\-name '\fBactivate\fR \fIindex\fR)
Sets the active element to the one indicated by \fIindex\fR.
.VS 8.0
If \fIindex\fR is outside the range of elements in the listbox
then the closest element is activated.
.VE
The active element is drawn with an underline when the widget
has the input focus, and its index may be retrieved with the
index \fBactive\fR.
@ -136,7 +143,11 @@ of the upper-left corner of the screen area covered by the text
(specified in pixels relative to the widget) and the last two
elements give the width and height of the area, in pixels.
If no part of the element given by \fIindex\fR is visible on the
screen then the result is an empty list; if the element is
screen,
.VS 8.0
or if \fIindex\fR refers to a non-existent element,
.VE
then the result is an empty list; if the element is
partially visible, the result gives the full area of the element,
including any parts that are not visible.
.TP
@ -178,7 +189,10 @@ to delete. If \fIlast\fR isn't specified it defaults to
.TP
(\fIwidget\-name '\fBget \fIfirst\fR \fIlast\fR)
If \fIlast\fR is omitted, returns the contents of the listbox
element indicated by \fIfirst\fR.
element indicated by \fIfirst\fR,
.VS 8.0
or an empty list if \fIfirst\fR refers to a non-existent element.
.VE
If \fIlast\fR is specified, the procedure returns a list whose elements
are all of the listbox elements between \fIfirst\fR and \fIlast\fR,
inclusive.
@ -186,8 +200,11 @@ Both \fIfirst\fR and \fIlast\fR may have any of the standard
forms for indices.
.TP
(\fIwidget\-name '\fBindex \fIindex\fR)
Returns a decimal string giving the integer index value that
corresponds to \fIindex\fR.
Returns the integer index value that corresponds to \fIindex\fR.
.VS 8.0
If \fIindex\fR is \fBend\fR the return value is a count of the number
of elements in the listbox (not the index of the last element).
.VE
.TP
(\fIwidget\-name '\fBinsert \fIindex \fR?\fIelement element ...\fR?)
Inserts zero or more new elements in the list just before the
@ -236,6 +253,10 @@ has several forms, depending on \fIoption\fR:
.TP
(\fIwidget\-name \fB'selection 'anchor \fIindex\fR)
Sets the selection anchor to the element given by \fIindex\fR.
.VS 8.0
If \fIindex\fR refers to a non-existent element, then the closest
element is used.
.VE
The selection anchor is the end of the selection that is fixed
while dragging out a selection with the mouse.
The index \fBanchor\fR may be used to refer to the anchor

View File

@ -94,3 +94,5 @@ Hereafter are simple uses of the \fBSTk:make-dialog\fR procedure
(list "baz" (lambda ()
(display "baz\n")))))
.CE
.SH SEE ALSO
message-box

90
Doc/Manual/message-box.n Normal file
View File

@ -0,0 +1,90 @@
'\" Color=Green
'\"
'\" Derived from a document with following copyright
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" SCCS: @(#) messageBox.n 1.5 96/09/19 17:02:40
'\"
.so STk-man.macros
.TH Tk:message-box n 4.2 STk "STk procedure"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Tk:message-box \- pops up a message window and waits for user response.
.SH SYNOPSIS
\fB(Tk:message-box \fR?\fIoption value ...\fR?)
.BE
.SH DESCRIPTION
.PP
This procedure creates and displays a message window with an
application-specified message, an icon and a set of buttons. Each of
the buttons in the message window is identified by a unique symbolic
name (see the \fB:type\fR options). After the message window is
popped up, \fBTk:message-box\fR waits for the user to select one of the
buttons. Then it returns the symbolic name of the selected button.
The following option-value pairs are supported:
.TP
\fB:default\fR \fIname\fR
\fIName\fR gives the symbolic name of the default button for
this message window ('ok', 'cancel', and so on). See \fB:type\fR
for a list of the symbolic names. If the message box has just one
button it will automatically be made the default, otherwise if this
option is not specified, there won't be any default button.
.TP
\fB:icon\fR \fIiconImage\fR
Specifies an icon to display. \fIIconImage\fR must be one of the
following: \fBerror\fR, \fBinfo\fR, \fBquestion\fR or
\fBwarning\fR. If this option is not specified, then no icon will be
displayed.
.TP
\fB:message\fR \fIstring\fR
Specifies the message to display in this message box.
\fB:title\fR \fItitleString\fR
Specifies a string to display as the title of the message box. The
default value is an empty string.
.TP
\fB:type\fR \fIpredefinedType\fR
Arranges for a predefined set of buttons to be displayed. The
following values are possible for \fIpredefinedType\fR:
.RS
.TP 18
\fBAbortRetryIgnore\fR
Displays three buttons whose symbolic names are \fBabort\fR,
\fBretry\fR and \fBignore\fR.
.TP 18
\fBOk\fR
Displays one button whose symbolic name is \fBok\fR.
.TP 18
\fBOkCancel\fR
Displays two buttons whose symbolic names are \fBok\fR and \fBcancel\fR.
.TP 18
\fBRetryCancel\fR
Displays two buttons whose symbolic names are \fBretry\fR and \fBcancel\fR.
.TP 18
\fBYesNo\fR
Displays two buttons whose symbolic names are \fByes\fR and \fBno\fR.
.TP 18
\fBYesNoCancel\fR
Displays three buttons whose symbolic names are \fByes\fR, \fBno\fR
and \fBcancel\fR.
.RE
.PP
.SH EXAMPLE
.CS
(let ((answer (Tk:message-box :message "Really quit?"
:type 'YesNo
:icon 'question)))
(case answer
((yes) (exit))
(else (Tk:message-box :message "I know you like this application!"
:type 'Ok))))
.CE
.SH SEE ALSO
make-dialog

View File

@ -39,6 +39,12 @@ Like all images, photos are created using the \fBimage create\fR
command.
Photos support the following \fIoptions\fR:
.TP
\fB\:channel \fIchannelId\fR
\fIchannelId\fR gives the name of a port open for reading which is to be
read to supply data for the photo image. The data format in the port
must be one of those for which there is an image format handler that
can read data from a file or port.
.TP
\fB:data \fIstring\fR
Specifies the contents of the image as a string. The format of the
string must be one of those for which there is an image file format
@ -53,7 +59,8 @@ Specifies the name of the file format for the data specified with the
\fB:file \fIname\fR
\fIname\fR gives the name of a file that is to be read to supply data
for the photo image. The file format must be one of those for which
there is an image file format handler that can read data from a file.
there is an image file format handler that can read data from a file or
port.
.TP
\fB:gamma \fIvalue\fR
Specifies that the colors allocated for displaying this image in a

View File

@ -204,7 +204,7 @@ document. 1.0 refers to the end of the document, 0.333
refers to a point one-third of the way through the document,
and so on.
.TP
'\fBscroll \fInumber '\fBunit\fR
'\fBscroll \fInumber '\fBunits\fR
The widget should adjust its view by \fInumber\fR units.
The units are defined in whatever way makes sense for the widget,
such as characters or lines in a text widget.
@ -212,7 +212,7 @@ such as characters or lines in a text widget.
the top or left of the window, or \-1, which means that one unit
should scroll off the bottom or right of the window.
.TP
'\fBscroll \fInumber '\fBpage\fR
'\fBscroll \fInumber '\fBpages\fR
The widget should adjust its view by \fInumber\fR pages.
It is up to the widget to define the meaning of a page; typically
it is slightly less than what fits in the window, so that there

View File

@ -21,7 +21,7 @@
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
'\" $Id: stk.1 1.2 Mon, 20 Apr 1998 20:15:01 +0000 eg $
'\" $Id: stk.1 1.2 Mon, 20 Apr 1998 22:15:01 +0200 eg $
'\"
.so STk-man.macros
.TH STk 1 4.0 STk "January_1998"

View File

@ -1,6 +1,6 @@
%!PS-Adobe-3.0
%%Creator: groff version 1.11
%%CreationDate: Mon Apr 20 10:54:40 1998
%%CreationDate: Mon Sep 14 15:35:30 1998
%%DocumentNeededResources: font Times-Roman
%%+ font Times-Bold
%%+ font Times-Italic

View File

@ -974,7 +974,7 @@ there are multiple marks at the same index.
These semantics mean that the \fBmark next\fP operation can be used to
step through all the marks in a text widget in the same order
as the mark information returned by the \fBdump\fP operation.
If a mark has been set to the special \fBend\fB index,
If a mark has been set to the special \fBend\fP index,
then it appears to be \fIafter\fP \fBend\fP with respect to the \fBmark next\fP operation.
An empty list is returned if there are no marks after \fIindex\fR.
.TP
@ -1064,6 +1064,8 @@ The argument following \fB:count\fR gives the name of a variable;
if a match is found, the number of characters in the matching
range will be stored in the variable.
.TP
\fB:environment\fI env\fR
The argument following \fB:environment\fR gives the definition environment of the variable counting matches (i.e. the one given to the \fB:count\fR option).
\fB:\-\fR
This switch has no effect except to terminate the list of switches:
the next argument will be treated as \fIpattern\fR even if it starts

View File

@ -3,21 +3,32 @@
%
% Author: Erick Gallesio [eg@unice.fr]
% Creation date: 21-Dec-1997 20:09
% Last file update: 9-Jun-1998 09:33
% Last file update: 30-Sep-1998 13:56
%
\section*{Introduction}
This appendix lists the main differences\footnote{ Only the
differences which affect the language or new ports are reported here.
In particular, internal changes, packages written in Scheme or
performance enhancement are not discussed here.} among 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.
differences which affect the language or new ports are reported
here. In particular, internal changes, packages written in Scheme,
STklos or performance enhancements are not discussed here.} among
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.3}
\small{\emph{Release date: 09/30/98}}
Mains changes/modifications since 3.99.2 are:
\begin{itemize}
\item Tk version is 8.0.3
\item Base64 Encoding/Decoding extension
\item Locale extension to treat strings and character using locale
information
\end{itemize}
\section*{Release 3.99.1}
\section*{Release 3.99.2}
\small{\emph{Release date: 04/27/98}}
Mainly a bugs correcting release.

View File

@ -3,7 +3,7 @@
%
% Author: Erick Gallesio [eg@unice.fr]
% Creation date: 21-Dec-1994 12:05
% Last file update: 6-Apr-1998 11:17
% Last file update: 27-Jun-1998 10:12
%
\section{Introduction}
@ -98,9 +98,11 @@ consists to add the following lines in your .{\tt emacs} startup file.
;; Add the '.stk' and '.stklos' suffix in the auto-mode-alist Emacs
;; variable. Setting this variable permits to automagically place the
;; buffer in scheme-mode.
(setq-default auto-mode-alist (append auto-mode-alist
("\\.stk$" . scheme-mode)
("\\.stklos$" . scheme-mode)))
(setq auto-mode-alist
(append '(("\\.scm$" . scheme-mode)
("\\.stk$" . scheme-mode)
("\\.stklos$" . scheme-mode))
auto-mode-alist))
\end{verbatim}
\end{quote}

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@ -30,6 +30,7 @@ Other extensions are more "useful":
- socket.c: simple support (and hence limited) for sockets. It allows you
to make simple clients and servers program using TCP/IP
- sregexp.c Regular expressions
- base64. c provide base64 file endoding and decoding.
For more informations on extension building, read the document

View File

@ -12,7 +12,7 @@
#
# Author: Erick Gallesio [eg@kaolin.unice.fr]
# Creation date: 6-Mar-1994 15:49
# Last file update: 2-Jun-1998 17:44
# Last file update: 20-Jul-1998 19:37
include ../config.make
@ -34,7 +34,8 @@ CFLAGS= $(SH_CCFLAGS) $(STKCFLAGS) $(DFLGS) -DUSE_TK @DEFS@ \
all: $(EXTRA_OBJ)
chmod 0755 stk-genmake
# Following lines are needed for weird make commands. Use Gnu make....
# Following lines are needed for weird make commands.
# You really should use Gnu make....
hash.$(SH_SUFFIX): hash.o
sregexp.$(SH_SUFFIX): sregexp.o
process.$(SH_SUFFIX): process.o
@ -43,6 +44,7 @@ posix.$(SH_SUFFIX): posix.o
html.$(SH_SUFFIX): html.o
pixmap.$(SH_SUFFIX): pixmap.o
jpeg.$(SH_SUFFIX): jpeg.o
base64.$(SH_SUFFIX): base64.o
examples: $(EXAMPLES)
install:

132
Extensions/base64.c Normal file
View File

@ -0,0 +1,132 @@
/*
*
* b a s e 6 4 . c -- Base64 support for STk
*
* Copyright © 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
* 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.
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 20-Jul-1998 12:19
* Last file update: 20-Jul-1998 19:40
*/
#include <stk.h>
#include <ctype.h>
static char table[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
static char rev_table[128];
#define OutChar(c, f) {Putc((c), (f)); if (++count>=72) {Putc('\n', (f)); count=0;}}
static void initialize_rev_table(void)
{
char *p;
int count = 0;
for (p = table; *p; p++) rev_table[*p] = count++;
}
static void encode(FILE *f, FILE *g)
{
int c, state, count, old;
state = old = count = 0;
while ((c = Getc(f)) != EOF) {
switch (++state) {
case 1: OutChar(table[(c>>2) & 0x3f], g);
break;
case 2: OutChar(table[((old<<4) & 0x30) | ((c>>4) & 0x0f)], g);
break;
case 3: OutChar(table[((old<<2) & 0x3c) | ((c>>6) & 0x03)], g);
OutChar(table[c & 0x3f], g);
state = 0;
break;
}
old = c;
}
switch (state) {
case 0: /* nothing */;
case 1: OutChar(table[(old<<4) & 0x30], g);
OutChar('=', g);
OutChar('=', g);
break;
case 2: OutChar(table[(old<<2) & 0x3c], g);
OutChar('=', g);
break;
}
}
static void decode(FILE *f, FILE *g)
{
static int initialized = 0;
int c, bits, group, j;
if (!initialized) {
initialize_rev_table();
initialized = 1;
}
group = 0; j = 18;
while ((c = Getc(f)) != EOF) {
if (c != '\n') {
if (c != '=') {
bits = rev_table[c];
group |= bits << j;
}
j -= 6;
if (j < 0) {
c = (group&0xff0000) >> 16; if (c) Putc(c, g);
c = (group&0x00ff00) >> 8; if (c) Putc(c, g);
c = (group&0x0000ff); if (c) Putc(c, g);
group = 0;
j = 18;
}
}
}
}
static PRIMITIVE base64_encode(SCM f, SCM g)
{
ENTER_PRIMITIVE("base64-encode");
if (!INP(f)) Serror("bad input port", f);
if (g == UNBOUND)
g = STk_curr_oport;
else
if (!OUTP(g)) Serror("bad output port", g);
encode(PORT_FILE(f), PORT_FILE(g));
return UNDEFINED;
}
static PRIMITIVE base64_decode(SCM f, SCM g)
{
ENTER_PRIMITIVE("base64-decode");
if (!INP(f)) Serror("bad input port", f);
if (g == UNBOUND)
g = STk_curr_oport;
else
if (!OUTP(g)) Serror("bad output port", g);
decode(PORT_FILE(f), PORT_FILE(g));
return UNDEFINED;
}
PRIMITIVE STk_init_base64(void)
{
STk_add_new_primitive("base64-decode", tc_subr_1_or_2, base64_decode);
STk_add_new_primitive("base64-encode", tc_subr_1_or_2, base64_encode);
return UNDEFINED;
}

View File

@ -2,7 +2,7 @@
*
* h a s h . c -- Hash Tables
*
* 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
@ -19,7 +19,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 17-Jan-1994 17:49
* Last file update: 31-Dec-1997 15:36
* Last file update: 15-Jul-1998 17:34
*/
#include <stk.h>
@ -263,22 +263,22 @@ static PRIMITIVE hash_table_put(SCM ht, SCM key, SCM val)
break;
case hash_comp:
index = Apply(HASH_SXHASH(ht), LIST1(key));
entry = Tcl_CreateHashEntry(HASH_H(ht), (char *) index, &new);
Tcl_SetHashValue(entry, NIL); /* To avoid GC problems in further allocations
* Thanks to S. Calvo <sarah@grammatech.com> */
if (new)
Tcl_SetHashValue(entry, LIST1(Cons(key, val)));
else {
SCM old = (SCM) Tcl_GetHashValue(entry);
if ((entry=Tcl_FindHashEntry(HASH_H(ht), (char *) index)) != NULL) {
SCM old = (SCM) Tcl_GetHashValue(entry); /* waz here */
SCM tmp = find_key(key, old, HASH_COMP(ht));
if (tmp) {
CAR(tmp) = key;
CDR(tmp) = val;
CAR(tmp) = key; /* Generally useless. But we don't master the hash fct */
CDR(tmp) = val; /* (i.e. it can have side-effects) */
}
else
Tcl_SetHashValue(entry, Cons(Cons(key, val), old));
}
else { /* new bucket */
SCM tmp = LIST1(Cons(key, val)); /* place it in tmp to avoid GC problems */
entry = Tcl_CreateHashEntry(HASH_H(ht), (char *) index, &new);
Tcl_SetHashValue(entry, tmp);
}
break;
}
return UNDEFINED;

View File

@ -7,7 +7,7 @@
* Department of Computer Science,
* University of California, Berkeley
*
* $Id: jpeg.c 1.1 Sat, 03 Jan 1998 12:46:25 +0000 eg $
* $Id: jpeg.c 1.1 Sat, 03 Jan 1998 13:46:25 +0100 eg $
*
* Parts of this file are based on code under the following
* copyrights. Include these copyrights if you do anything

190
Extensions/locale.c Normal file
View File

@ -0,0 +1,190 @@
/*
*
* l o c a l e . c -- Locale management
*
*
* 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
* 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: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 19-Sep-1998 12:01
* Last file update: 19-Sep-1998 15:02
*
*
*/
#include <locale.h>
#include <stdlib.h>
#include "stk.h"
static char bad_string_message[] = "comparing strings: bad string";
static char bad_char_message[] = "comparing chars: bad char";
static char *locale_name = "";
/*==== Utilities ====*/
static int compare(unsigned char c1, unsigned char c2)
{
unsigned char s1[2] = " ";
unsigned char s2[2] = " ";
/* This is really UGLY but can we write it in a cleaner way using
* only pure ANSI-C primitives? */
*s1 = c1; *s2 = c2;
return strcoll((char *)s1, (char *)s2);
}
static int stringcomp(SCM s1, SCM s2)
{
register int l1, l2;
register char *str1, *str2;
if (NSTRINGP(s1)) Err(bad_string_message, s1);
if (NSTRINGP(s2)) Err(bad_string_message, s2);
for (l1=STRSIZE(s1), str1=CHARS(s1), l2=STRSIZE(s2), str2=CHARS(s2);
l1 && l2;
l1--, str1++, l2--, str2++)
if (*str1 != *str2)
return compare((unsigned char) *str1,
(unsigned char) *str2);
/* l1 == 0 || l2 == 0 */
return l1 ? +1 : (l2 ? -1 : 0);
}
static int stringcompci(SCM s1, SCM s2)
{
register int l1, l2;
register char *str1, *str2;
if (NSTRINGP(s1)) Err(bad_string_message, s1);
if (NSTRINGP(s2)) Err(bad_string_message, s2);
for (l1=STRSIZE(s1), str1=CHARS(s1), l2=STRSIZE(s2), str2=CHARS(s2);
l1 && l2;
l1--, str1++, l2--, str2++)
if (tolower(*str1) != tolower(*str2))
return compare((unsigned char) tolower(*str1),
(unsigned char) tolower(*str2));
/* l1 == 0 || l2 == 0 */
return l1 ? +1 : (l2 ? -1 : 0);
}
static int charcomp(SCM c1, SCM c2)
{
if (NCHARP(c1)) Err(bad_char_message, c1);
if (NCHARP(c2)) Err(bad_char_message, c2);
return compare(CHAR(c1), CHAR(c2));
}
static int charcompci(SCM c1, SCM c2)
{
if (NCHARP(c1)) Err(bad_char_message, c1);
if (NCHARP(c2)) Err(bad_char_message, c2);
return compare((unsigned char) tolower(CHAR(c1)),
(unsigned char) tolower(CHAR(c2)));
}
/*==== Primitives ====*/
static PRIMITIVE set_locale(SCM locale)
{
char *res;
ENTER_PRIMITIVE("set-locale!");
if (!STRINGP(locale)) Serror("bad string", locale);
if ((res=setlocale(LC_ALL, CHARS(locale))) == NULL)
Serror("bad locale", locale);
locale_name = res;
return STk_makestring(res);
}
static PRIMITIVE get_locale(void)
{
return STk_makestring(locale_name);
}
static PRIMITIVE eq (SCM s1,SCM s2){return (stringcomp(s1,s2)==0)? Truth: Ntruth;}
static PRIMITIVE lt (SCM s1,SCM s2){return (stringcomp(s1,s2)<0) ? Truth: Ntruth;}
static PRIMITIVE gt (SCM s1,SCM s2){return (stringcomp(s1,s2)>0) ? Truth: Ntruth;}
static PRIMITIVE le (SCM s1,SCM s2){return (stringcomp(s1,s2)<=0)? Truth: Ntruth;}
static PRIMITIVE ge (SCM s1,SCM s2){return (stringcomp(s1,s2)>=0)? Truth: Ntruth;}
static PRIMITIVE eqci(SCM s1,SCM s2){return (stringcompci(s1,s2)==0)? Truth:Ntruth;}
static PRIMITIVE ltci(SCM s1,SCM s2){return (stringcompci(s1,s2)<0) ? Truth:Ntruth;}
static PRIMITIVE gtci(SCM s1,SCM s2){return (stringcompci(s1,s2)>0) ? Truth:Ntruth;}
static PRIMITIVE leci(SCM s1,SCM s2){return (stringcompci(s1,s2)<=0)? Truth:Ntruth;}
static PRIMITIVE geci(SCM s1,SCM s2){return (stringcompci(s1,s2)>=0)? Truth:Ntruth;}
static PRIMITIVE Ceq (SCM c1, SCM c2){return (charcomp(c1,c2)==0) ? Truth: Ntruth;}
static PRIMITIVE Clt (SCM c1, SCM c2){return (charcomp(c1,c2)<0) ? Truth: Ntruth;}
static PRIMITIVE Cgt (SCM c1, SCM c2){return (charcomp(c1,c2)>0) ? Truth: Ntruth;}
static PRIMITIVE Cle (SCM c1, SCM c2){return (charcomp(c1,c2)<=0) ? Truth: Ntruth;}
static PRIMITIVE Cge (SCM c1, SCM c2){return (charcomp(c1,c2)>=0) ? Truth: Ntruth;}
static PRIMITIVE Ceqci(SCM c1, SCM c2){return (charcompci(c1,c2)==0)? Truth:Ntruth;}
static PRIMITIVE Cltci(SCM c1, SCM c2){return (charcompci(c1,c2)<0) ? Truth:Ntruth;}
static PRIMITIVE Cgtci(SCM c1, SCM c2){return (charcompci(c1,c2)>0) ? Truth:Ntruth;}
static PRIMITIVE Cleci(SCM c1, SCM c2){return (charcompci(c1,c2)<=0)? Truth:Ntruth;}
static PRIMITIVE Cgeci(SCM c1, SCM c2){return (charcompci(c1,c2)>=0)? Truth:Ntruth;}
PRIMITIVE STk_init_locale(void)
{
char *lang = getenv("LANG");
STk_add_new_primitive("set-locale!", tc_subr_1, set_locale);
STk_add_new_primitive("get-locale", tc_subr_0, get_locale);
STk_add_new_primitive("string-lo=?", tc_subr_2, eq);
STk_add_new_primitive("string-lo<?", tc_subr_2, lt);
STk_add_new_primitive("string-lo>?", tc_subr_2, gt);