Commit 734c05e5 by lvzhengyang

successfully call tclreadline in Main.cc

parent 4fb2afb8
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
## TODO ## TODO
* add OpenDB * add OpenDB
* with swig
## DONE ## DONE
......
libtclreadline_la-tclreadline.lo: tclreadline.c \
/usr/include/stdc-predef.h config.h \
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tcl.h /usr/include/stdio.h \
/usr/include/features.h /usr/include/sys/cdefs.h \
/usr/include/bits/wordsize.h /usr/include/gnu/stubs.h \
/usr/include/gnu/stubs-64.h \
/tools/cluster-software/gcc/gcc-9.3.0/lib/gcc/x86_64-pc-linux-gnu/9.3.0/include/stddef.h \
/usr/include/bits/types.h /usr/include/bits/typesizes.h \
/usr/include/libio.h /usr/include/_G_config.h /usr/include/wchar.h \
/tools/cluster-software/gcc/gcc-9.3.0/lib/gcc/x86_64-pc-linux-gnu/9.3.0/include/stdarg.h \
/usr/include/bits/stdio_lim.h /usr/include/bits/sys_errlist.h \
/usr/include/bits/stdio.h \
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tclDecls.h \
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tclPlatDecls.h \
/usr/include/stdlib.h /usr/include/bits/waitflags.h \
/usr/include/bits/waitstatus.h /usr/include/endian.h \
/usr/include/bits/endian.h /usr/include/bits/byteswap.h \
/usr/include/bits/byteswap-16.h /usr/include/sys/types.h \
/usr/include/time.h /usr/include/sys/select.h /usr/include/bits/select.h \
/usr/include/bits/sigset.h /usr/include/bits/time.h \
/usr/include/sys/sysmacros.h /usr/include/bits/pthreadtypes.h \
/usr/include/alloca.h /usr/include/bits/stdlib-float.h \
/usr/include/string.h /usr/include/xlocale.h /usr/include/bits/string.h \
/usr/include/bits/string2.h /usr/include/readline/readline.h \
/usr/include/readline/rlstdc.h /usr/include/readline/rltypedefs.h \
/usr/include/readline/keymaps.h /usr/include/readline/chardefs.h \
/usr/include/ctype.h /usr/include/strings.h \
/usr/include/readline/tilde.h /usr/include/readline/history.h \
tclreadline.h
/usr/include/stdc-predef.h:
config.h:
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tcl.h:
/usr/include/stdio.h:
/usr/include/features.h:
/usr/include/sys/cdefs.h:
/usr/include/bits/wordsize.h:
/usr/include/gnu/stubs.h:
/usr/include/gnu/stubs-64.h:
/tools/cluster-software/gcc/gcc-9.3.0/lib/gcc/x86_64-pc-linux-gnu/9.3.0/include/stddef.h:
/usr/include/bits/types.h:
/usr/include/bits/typesizes.h:
/usr/include/libio.h:
/usr/include/_G_config.h:
/usr/include/wchar.h:
/tools/cluster-software/gcc/gcc-9.3.0/lib/gcc/x86_64-pc-linux-gnu/9.3.0/include/stdarg.h:
/usr/include/bits/stdio_lim.h:
/usr/include/bits/sys_errlist.h:
/usr/include/bits/stdio.h:
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tclDecls.h:
/workspace/S/lvzhengyang/MiniEDA/pkgs/include/tclPlatDecls.h:
/usr/include/stdlib.h:
/usr/include/bits/waitflags.h:
/usr/include/bits/waitstatus.h:
/usr/include/endian.h:
/usr/include/bits/endian.h:
/usr/include/bits/byteswap.h:
/usr/include/bits/byteswap-16.h:
/usr/include/sys/types.h:
/usr/include/time.h:
/usr/include/sys/select.h:
/usr/include/bits/select.h:
/usr/include/bits/sigset.h:
/usr/include/bits/time.h:
/usr/include/sys/sysmacros.h:
/usr/include/bits/pthreadtypes.h:
/usr/include/alloca.h:
/usr/include/bits/stdlib-float.h:
/usr/include/string.h:
/usr/include/xlocale.h:
/usr/include/bits/string.h:
/usr/include/bits/string2.h:
/usr/include/readline/readline.h:
/usr/include/readline/rlstdc.h:
/usr/include/readline/rltypedefs.h:
/usr/include/readline/keymaps.h:
/usr/include/readline/chardefs.h:
/usr/include/ctype.h:
/usr/include/strings.h:
/usr/include/readline/tilde.h:
/usr/include/readline/history.h:
tclreadline.h:
config.h
config.log
config.status
pkgIndex.tcl
tclreadline.h
tclreadline.n
tclreadlineInit.tcl
tclreadlineSetup.tcl
Makefile
../libtclreadline.la
\ No newline at end of file
# libtclreadline.la - a libtool library file
# Generated by libtool (GNU libtool) 2.4.6
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# The name that we can dlopen(3).
dlname='libtclreadline-2.3.8.so'
# Names of this library.
library_names='libtclreadline-2.3.8.so libtclreadline-2.3.8.so libtclreadline.so'
# The name of the static archive.
old_library=''
# Linker flags that cannot go in dependency_libs.
inherited_linker_flags=''
# Libraries that this one depends upon.
dependency_libs=' -L/workspace/S/lvzhengyang/MiniEDA/pkgs//lib -ltcl8.6 -lreadline'
# Names of additional weak libraries provided by this library
weak_library_names=''
# Version information for libtclreadline.
current=0
age=0
revision=0
# Is this an already installed library?
installed=yes
# Should we warn about portability when linking against -modules?
shouldnotlink=no
# Files to dlopen/dlpreopen
dlopen=''
dlpreopen=''
# Directory that this library needs to be installed in:
libdir='/workspace/S/lvzhengyang/MiniEDA/pkgs/lib'
libtclreadline-2.3.8.so
\ No newline at end of file
language: c
sudo: true
os:
- linux
- osx
addons:
apt:
packages:
- expect
- lib64readline6-dev
- libtool
before_install:
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew update; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install tcl-tk; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew link --force --overwrite tcl-tk; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install readline; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then mkdir -p /usr/local; ln -s /usr/local/opt/tcl-tk/include /usr/local/include/tcl8.6; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then cp /usr/local/opt/tcl-tk/lib/libtcl* /usr/local/lib; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then ln -s /usr/local/opt/tcl-tk/bin/tclsh8.6 /usr/local/bin/tclsh; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then ln -s /usr/local/opt/tcl-tk/bin/tclsh8.6 /usr/local/bin/tclsh8.6; fi
script:
- autoreconf -vif
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then ./configure --with-readline-includes=/usr/local/Cellar/readline/7.0.3_1/include --with-readline-library=/usr/local/Cellar/readline/7.0.3_1/lib --with-tcl=/usr/local/opt/tcl-tk/lib --with-tcl-includes=/usr/local/opt/tcl-tk/include; fi
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then /usr/bin/libtoolize --install; fi
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then /bin/sh -x ./autogen.sh; fi
- make
- sudo make install
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then tclsh tests.tcl; fi
Johannes Zellner <johannes@zellner.org> http://www.zellner.org/
Mark Patton <mpatton@jhu.edu>
Quentin Minster <quentin@minster.io>
dbohdan <dbohdan@dbohdan.com>
Massimo Dal Zotto <dz@debian.org>
Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of Johannes Zellner nor the names of contributors
to this software may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2001-08-10 Johannes Zellner <johannes@zellner.org>
* added Massimo to AUTHORS
2001-08-10 Massimo Dal Zotto <dz@debian.org>
* In tclreadlineSetup.tcl.in prefixed all global variables with
package prefix to avoid polluting the global namespace.
Removed also the global unused variable "a".
2001-01-10 Johannes Zellner <johannes@zellner.org>
* configure.in: changed the check for readline/readline.h / readline.h
2000-12-08 Johannes Zellner <johannes@zellner.org>
* reordered Makefile.am so that it always includes
tclshrl.c,wishrl.c into the distribution.
2000-12-08 Johannes Zellner <johannes@zellner.org>
* reenabled wishrl and tclshrl via configure switches
2000-11-19 Johannes Zellner <johannes@zellner.org>
* configure.in: moved the tlib check before the libreadline check
2000-09-20 Johannes Zellner <johannes@zellner.org>
* made tclreadline.h installing to ${prefix}/include
2000-08-27 Johannes Zellner <johannes@zellner.org>
* added Mark to AUTHORS :)
2000-08-27 Mark Patton <mpatton@jhu.edu>
* converted tclreadline::readline to be an object
command. This was the simplest way to fix the
Tcl_Obj mem leak.
* added the command readline text and readline update
that retrieve the current input and redraw it respecively.
2000-07-27 Johannes Zellner <johannes@zellner.org>
* configure.in: changed a == to = in a sh test
(reported by "Daniel O'Connor" <darius@dons.net.au>)
2000-07-03 Johannes Zellner <johannes@zellner.org>
* Makefile.am: included EXTRA_DIST so that it compiles from `dist'
2000-07-01 Johannes Zellner <johannes@zellner.org>
* switched to automake
* small fix so that itcl config switches are correctly completed.
## -*- automake -*-
## FILE: Makefile.am
## $Id$
## ---
## tclreadline -- gnu readline for tcl
## https://github.com/flightaware/tclreadline/
## Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
## This software is copyright under the BSD license.
## ---
## AUTOMAKE_OPTIONS = foreign
lib_LTLIBRARIES = libtclreadline.la
libtclreadline_la_SOURCES = config.h tclreadline.c tclreadline.h
include_HEADERS = tclreadline.h
INCLUDES = -I$(TCL_INCLUDE_DIR) -I$(READLINE_INCLUDE_DIR)
if !USE_TCL_STUBS
libtclreadline_la_CFLAGS = -Wall
else
libtclreadline_la_CFLAGS = -Wall -DUSE_TCL_STUBS
endif
if !USE_TCL_STUBS
libtclreadline_la_LIBADD = $(TCL_LIB_SPEC)
else
libtclreadline_la_LIBADD = $(TCL_STUB_LIB_SPEC)
endif
libtclreadline_la_LDFLAGS = -release $(MAJOR).$(MINOR).$(PATCHLEVEL)
tclrldir = @TCLRL_DIR@
tclrl_SCRIPTS = pkgIndex.tcl tclreadlineCompleter.tcl tclreadlineInit.tcl tclreadlineSetup.tcl
INSTALL_SCRIPT = ${INSTALL_DATA}
EXTRA_DIST = \
tclreadlineCompleter.tcl \
aux/config.guess \
aux/config.sub \
aux/install-sh \
aux/ltconfig \
aux/ltmain.sh \
aux/missing \
aux/mkinstalldirs
if STATIC_TCLSHRL
static_tclshrl = tclshrl
tclshrl_LDADD = libtclreadline.la $(TCL_LIB_SPEC)
tclshrl_LDFLAGS = -static
endif
if STATIC_WISHRL
static_wishrl = wishrl
wishrl_LDADD = libtclreadline.la $(TCL_LIB_SPEC) $(TK_LIB_SPEC)
wishrl_LDFLAGS = -static
endif
bin_PROGRAMS = $(static_tclshrl) $(static_wishrl)
tclshrl_SOURCES = tclshrl.c
wishrl_SOURCES = wishrl.c
man_MANS = tclreadline.n
#
# tclreadline configure for FreeBSD
#
libtoolize --force --install --copy
aclocal
autoheader
automake --force-missing --add-missing --copy
autoconf
./configure --with-tcl=/usr/local/lib/tcl8.6 --with-tcl-includes=/usr/local/include/tcl8.6 --mandir=/usr/local/man
#--enable-symbols
[![Build Status](https://travis-ci.org/flightaware/tclreadline.svg?branch=master)](https://travis-ci.org/flightaware/tclreadline)
# tclreadline -- gnu readline for tcl
Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
This software is copyright under the BSD license.
tclreadline
Introduction
===============
This directory contains the sources and documentation for tclreadline,
which builds a connection between tcl and the gnu readline.
Documentation
================
The tclreadline.n nroff man page in this release contains the reference
manual entries for tclreadline. If you only want to use tclreadline as
a tool for interactive script development, you don't have to read this
manual page at all. Simply change your .tclshrc according to the section
later in this file.
Compiling and installing tclreadline
=======================================
This release will probably only build under UNIX (Linux).
Before trying to compile tclreadline you should do the following things:
1. Make sure you have tcl 8.0 or higher.
tclreadline relies on a proper tcl installation:
It uses the tclConfig.sh file, which should reside somewhere
in /usr/local/lib/ or /usr/local/lib/tcl8.0/...
2. Make sure you have gnu readline 2.2 or higher.
tclreadline uses the gnu readline callback handler, which
wasn't implemented in early releases.
3. The usual `./configure; make; make install` sequence should do the rest.
4. Optionally (or additionally) you can build the executables
tclshrl and / or wishrl which are a readline enhanced replacement
for tclsh and wish. To compile these executable you should type
./configure --enable-tclshrl --enable-wishrl
(or one of these if you want just tclshrl or wishrl).
NOTE that these executables need an installed version of
tclreadline because they need some script files to run
so you can't test tclshrl/wishrl before installing
the tclreadline scripts.
Building statically linked executables is DISCOURAGED
but necessary on systems which don't support shared libs.
Using tclreadline for interactive tcl scripting.
================================================
copy the sample.tclshrc to $HOME/.tclshrc. If you use another interpreter
like wish, you should copy the file sample.tclshrc to $HOME/.wishrc
(or whatever the manual page of your interpreter says.) If you have
installed tclreadline properly, you are just ready to start:
start your favorite interpreter. The tclreadlineSetup.tcl script
does the rest.
YOU TYPE: YOU GET:
=== SCENARIO 1 ===
puts $<tab> puts $
+ a list of all variables ...
puts $t<tab> puts $t
+ a list of all variables
beginning with t ...
puts $tcl_pl<tab> puts $tcl_platform(
+ a list of all array names of
tcl_platform
puts $tcl_platform(b<tab> puts $tcl_platform(byteOrder)
=== SCENARIO 2 ===
button .b button .b
.b co<tab> .b configure
.b co<tab><tab> .b configure
+ a list of all button options ...
.b co<tab><tab>-r<tab> .b configure -relief
.b co<tab><tab>-r<tab>g<tab> .b configure -relief groove
* detect availability of rl_extend_line_buffer() in configure
(for tclreadline.c)
* translate those
+ reimplement wishrl & tclshrl
+ history_truncate_file(int n, char* historyfile)
verwenden, um nur eine begrenze Zahl zu schreiben.
+ wenn nur ein array Element von a vorliegt,
wird trotzdem nur auf $a( completed. --> ändern.
+ history_expansion mit <Tab> (z.B. !$).
+ ist $bla das erste Wort eines Befehls, so sollte vor
der completion die Variable ersetzt werden, um den
completer herauszufinden.
+ den script completern den level mitgeben ?
# -*- mode: ruby -*-
# vi: set ft=ruby :
# Vagrantfile API/syntax version. Don't touch unless you know what you're doing!
VAGRANTFILE_API_VERSION = "2"
Vagrant.configure(VAGRANTFILE_API_VERSION) do |config|
config.vm.box = "debian/contrib-jessie64"
config.vm.provision :shell, path: "provision-vagrant-vm.sh", run: "always"
config.vm.provider :virtualbox do |vb|
vb.customize ["modifyvm", :id, "--memory", "384"]
end
end
This source diff could not be displayed because it is too large. You can view the blob instead.
#!/bin/sh
# FILE: autogen.sh
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---
srcdir=`dirname $0`
test -z "$srcdir" && srcdir=.
ORIGDIR=`pwd`
cd $srcdir
PROJECT=tclreadline
TEST_TYPE=-f
FILE=tclreadline.c
DIE=0
# optionally feature libtoolize
(libtoolize --version) < /dev/null > /dev/null 2>&1 && libtoolize --install
(autoconf --version) < /dev/null > /dev/null 2>&1 || {
echo
echo "You must have autoconf installed to compile $PROJECT."
echo "Download the appropriate package for your distribution,"
echo "or get the source tarball at ftp://ftp.gnu.org/pub/gnu/"
DIE=1
}
(automake --version) < /dev/null > /dev/null 2>&1 || {
echo
echo "You must have automake installed to compile $PROJECT."
echo "Get ftp://sourceware.cygnus.com/pub/automake/automake-1.4.tar.gz"
echo "(or a newer version if it is available)"
DIE=1
}
if test "$DIE" -eq 1; then
exit 1
fi
test $TEST_TYPE $FILE || {
echo "You must run this script in the top-level $PROJECT directory"
exit 1
}
case $CC in
*xlc | *xlc\ * | *lcc | *lcc\ *)
am_opt=--include-deps
;;
esac
aclocal $ACLOCAL_FLAGS
# optionally feature autoheader
(autoheader --version) < /dev/null > /dev/null 2>&1 && autoheader
automake -a $am_opt
autoconf
cd $ORIGDIR
if test -z "$NOCONFIGURE"; then
if test -z "$*"; then
echo "I am going to run ./configure with no arguments - if you wish "
echo "to pass any to it, please specify them on the $0 command line."
fi
$srcdir/configure --enable-maintainer-mode "$@"
fi
#! /bin/sh
# Wrapper for compilers which do not understand '-c -o'.
scriptversion=2018-03-07.03; # UTC
# Copyright (C) 1999-2018 Free Software Foundation, Inc.
# Written by Tom Tromey <tromey@cygnus.com>.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# This file is maintained in Automake, please report
# bugs to <bug-automake@gnu.org> or send patches to
# <automake-patches@gnu.org>.
nl='
'
# We need space, tab and new line, in precisely that order. Quoting is
# there to prevent tools from complaining about whitespace usage.
IFS=" "" $nl"
file_conv=
# func_file_conv build_file lazy
# Convert a $build file to $host form and store it in $file
# Currently only supports Windows hosts. If the determined conversion
# type is listed in (the comma separated) LAZY, no conversion will
# take place.
func_file_conv ()
{
file=$1
case $file in
/ | /[!/]*) # absolute file, and not a UNC file
if test -z "$file_conv"; then
# lazily determine how to convert abs files
case `uname -s` in
MINGW*)
file_conv=mingw
;;
CYGWIN*)
file_conv=cygwin
;;
*)
file_conv=wine
;;
esac
fi
case $file_conv/,$2, in
*,$file_conv,*)
;;
mingw/*)
file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'`
;;
cygwin/*)
file=`cygpath -m "$file" || echo "$file"`
;;
wine/*)
file=`winepath -w "$file" || echo "$file"`
;;
esac
;;
esac
}
# func_cl_dashL linkdir
# Make cl look for libraries in LINKDIR
func_cl_dashL ()
{
func_file_conv "$1"
if test -z "$lib_path"; then
lib_path=$file
else
lib_path="$lib_path;$file"
fi
linker_opts="$linker_opts -LIBPATH:$file"
}
# func_cl_dashl library
# Do a library search-path lookup for cl
func_cl_dashl ()
{
lib=$1
found=no
save_IFS=$IFS
IFS=';'
for dir in $lib_path $LIB
do
IFS=$save_IFS
if $shared && test -f "$dir/$lib.dll.lib"; then
found=yes
lib=$dir/$lib.dll.lib
break
fi
if test -f "$dir/$lib.lib"; then
found=yes
lib=$dir/$lib.lib
break
fi
if test -f "$dir/lib$lib.a"; then
found=yes
lib=$dir/lib$lib.a
break
fi
done
IFS=$save_IFS
if test "$found" != yes; then
lib=$lib.lib
fi
}
# func_cl_wrapper cl arg...
# Adjust compile command to suit cl
func_cl_wrapper ()
{
# Assume a capable shell
lib_path=
shared=:
linker_opts=
for arg
do
if test -n "$eat"; then
eat=
else
case $1 in
-o)
# configure might choose to run compile as 'compile cc -o foo foo.c'.
eat=1
case $2 in
*.o | *.[oO][bB][jJ])
func_file_conv "$2"
set x "$@" -Fo"$file"
shift
;;
*)
func_file_conv "$2"
set x "$@" -Fe"$file"
shift
;;
esac
;;
-I)
eat=1
func_file_conv "$2" mingw
set x "$@" -I"$file"
shift
;;
-I*)
func_file_conv "${1#-I}" mingw
set x "$@" -I"$file"
shift
;;
-l)
eat=1
func_cl_dashl "$2"
set x "$@" "$lib"
shift
;;
-l*)
func_cl_dashl "${1#-l}"
set x "$@" "$lib"
shift
;;
-L)
eat=1
func_cl_dashL "$2"
;;
-L*)
func_cl_dashL "${1#-L}"
;;
-static)
shared=false
;;
-Wl,*)
arg=${1#-Wl,}
save_ifs="$IFS"; IFS=','
for flag in $arg; do
IFS="$save_ifs"
linker_opts="$linker_opts $flag"
done
IFS="$save_ifs"
;;
-Xlinker)
eat=1
linker_opts="$linker_opts $2"
;;
-*)
set x "$@" "$1"
shift
;;
*.cc | *.CC | *.cxx | *.CXX | *.[cC]++)
func_file_conv "$1"
set x "$@" -Tp"$file"
shift
;;
*.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO])
func_file_conv "$1" mingw
set x "$@" "$file"
shift
;;
*)
set x "$@" "$1"
shift
;;
esac
fi
shift
done
if test -n "$linker_opts"; then
linker_opts="-link$linker_opts"
fi
exec "$@" $linker_opts
exit 1
}
eat=
case $1 in
'')
echo "$0: No command. Try '$0 --help' for more information." 1>&2
exit 1;
;;
-h | --h*)
cat <<\EOF
Usage: compile [--help] [--version] PROGRAM [ARGS]
Wrapper for compilers which do not understand '-c -o'.
Remove '-o dest.o' from ARGS, run PROGRAM with the remaining
arguments, and rename the output as expected.
If you are trying to build a whole package this is not the
right script to run: please start by reading the file 'INSTALL'.
Report bugs to <bug-automake@gnu.org>.
EOF
exit $?
;;
-v | --v*)
echo "compile $scriptversion"
exit $?
;;
cl | *[/\\]cl | cl.exe | *[/\\]cl.exe | \
icl | *[/\\]icl | icl.exe | *[/\\]icl.exe )
func_cl_wrapper "$@" # Doesn't return...
;;
esac
ofile=
cfile=
for arg
do
if test -n "$eat"; then
eat=
else
case $1 in
-o)
# configure might choose to run compile as 'compile cc -o foo foo.c'.
# So we strip '-o arg' only if arg is an object.
eat=1
case $2 in
*.o | *.obj)
ofile=$2
;;
*)
set x "$@" -o "$2"
shift
;;
esac
;;
*.c)
cfile=$1
set x "$@" "$1"
shift
;;
*)
set x "$@" "$1"
shift
;;
esac
fi
shift
done
if test -z "$ofile" || test -z "$cfile"; then
# If no '-o' option was seen then we might have been invoked from a
# pattern rule where we don't need one. That is ok -- this is a
# normal compilation that the losing compiler can handle. If no
# '.c' file was seen then we are probably linking. That is also
# ok.
exec "$@"
fi
# Name of file we expect compiler to create.
cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'`
# Create the lock directory.
# Note: use '[/\\:.-]' here to ensure that we don't use the same name
# that we are using for the .o file. Also, base the name on the expected
# object file name, since that is what matters with a parallel build.
lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d
while true; do
if mkdir "$lockdir" >/dev/null 2>&1; then
break
fi
sleep 1
done
# FIXME: race condition here if user kills between mkdir and trap.
trap "rmdir '$lockdir'; exit 1" 1 2 15
# Run the compile.
"$@"
ret=$?
if test -f "$cofile"; then
test "$cofile" = "$ofile" || mv "$cofile" "$ofile"
elif test -f "${cofile}bj"; then
test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile"
fi
rmdir "$lockdir"
exit $ret
# Local Variables:
# mode: shell-script
# sh-indentation: 2
# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:
This source diff could not be displayed because it is too large. You can view the blob instead.
#! /bin/sh
# Common wrapper for a few potentially missing GNU programs.
scriptversion=2018-03-07.03; # UTC
# Copyright (C) 1996-2018 Free Software Foundation, Inc.
# Originally written by Fran,cois Pinard <pinard@iro.umontreal.ca>, 1996.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
if test $# -eq 0; then
echo 1>&2 "Try '$0 --help' for more information"
exit 1
fi
case $1 in
--is-lightweight)
# Used by our autoconf macros to check whether the available missing
# script is modern enough.
exit 0
;;
--run)
# Back-compat with the calling convention used by older automake.
shift
;;
-h|--h|--he|--hel|--help)
echo "\
$0 [OPTION]... PROGRAM [ARGUMENT]...
Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due
to PROGRAM being missing or too old.
Options:
-h, --help display this help and exit
-v, --version output version information and exit
Supported PROGRAM values:
aclocal autoconf autoheader autom4te automake makeinfo
bison yacc flex lex help2man
Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and
'g' are ignored when checking the name.
Send bug reports to <bug-automake@gnu.org>."
exit $?
;;
-v|--v|--ve|--ver|--vers|--versi|--versio|--version)
echo "missing $scriptversion (GNU Automake)"
exit $?
;;
-*)
echo 1>&2 "$0: unknown '$1' option"
echo 1>&2 "Try '$0 --help' for more information"
exit 1
;;
esac
# Run the given program, remember its exit status.
"$@"; st=$?
# If it succeeded, we are done.
test $st -eq 0 && exit 0
# Also exit now if we it failed (or wasn't found), and '--version' was
# passed; such an option is passed most likely to detect whether the
# program is present and works.
case $2 in --version|--help) exit $st;; esac
# Exit code 63 means version mismatch. This often happens when the user
# tries to use an ancient version of a tool on a file that requires a
# minimum version.
if test $st -eq 63; then
msg="probably too old"
elif test $st -eq 127; then
# Program was missing.
msg="missing on your system"
else
# Program was found and executed, but failed. Give up.
exit $st
fi
perl_URL=https://www.perl.org/
flex_URL=https://github.com/westes/flex
gnu_software_URL=https://www.gnu.org/software
program_details ()
{
case $1 in
aclocal|automake)
echo "The '$1' program is part of the GNU Automake package:"
echo "<$gnu_software_URL/automake>"
echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/autoconf>"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
autoconf|autom4te|autoheader)
echo "The '$1' program is part of the GNU Autoconf package:"
echo "<$gnu_software_URL/autoconf/>"
echo "It also requires GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
esac
}
give_advice ()
{
# Normalize program name to check for.
normalized_program=`echo "$1" | sed '
s/^gnu-//; t
s/^gnu//; t
s/^g//; t'`
printf '%s\n' "'$1' is $msg."
configure_deps="'configure.ac' or m4 files included by 'configure.ac'"
case $normalized_program in
autoconf*)
echo "You should only need it if you modified 'configure.ac',"
echo "or m4 files included by it."
program_details 'autoconf'
;;
autoheader*)
echo "You should only need it if you modified 'acconfig.h' or"
echo "$configure_deps."
program_details 'autoheader'
;;
automake*)
echo "You should only need it if you modified 'Makefile.am' or"
echo "$configure_deps."
program_details 'automake'
;;
aclocal*)
echo "You should only need it if you modified 'acinclude.m4' or"
echo "$configure_deps."
program_details 'aclocal'
;;
autom4te*)
echo "You might have modified some maintainer files that require"
echo "the 'autom4te' program to be rebuilt."
program_details 'autom4te'
;;
bison*|yacc*)
echo "You should only need it if you modified a '.y' file."
echo "You may want to install the GNU Bison package:"
echo "<$gnu_software_URL/bison/>"
;;
lex*|flex*)
echo "You should only need it if you modified a '.l' file."
echo "You may want to install the Fast Lexical Analyzer package:"
echo "<$flex_URL>"
;;
help2man*)
echo "You should only need it if you modified a dependency" \
"of a man page."
echo "You may want to install the GNU Help2man package:"
echo "<$gnu_software_URL/help2man/>"
;;
makeinfo*)
echo "You should only need it if you modified a '.texi' file, or"
echo "any other file indirectly affecting the aspect of the manual."
echo "You might want to install the Texinfo package:"
echo "<$gnu_software_URL/texinfo/>"
echo "The spurious makeinfo call might also be the consequence of"
echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might"
echo "want to install GNU make:"
echo "<$gnu_software_URL/make/>"
;;
*)
echo "You might have modified some files without having the proper"
echo "tools for further handling them. Check the 'README' file, it"
echo "often tells you about the needed prerequisites for installing"
echo "this package. You may also peek at any GNU archive site, in"
echo "case some other package contains this missing '$1' program."
;;
esac
}
give_advice "$1" | sed -e '1s/^/WARNING: /' \
-e '2,$s/^/ /' >&2
# Propagate the correct exit status (expected to be 127 for a program
# not found, 63 for a program that failed due to version mismatch).
exit $st
# Local variables:
# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:
#!/usr/local/bin/tclsh
# FILE: aux/tcltags
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---
set tags [open "tags" a+]
#set tags stdout
#_BoxHandle Z_Box.c /^int _BoxHandle (Box *boxPtr, Tcl_Interp *interp, int argc, char **argv)$/;" f
foreach file "$argv" {
if {[file exists $file]} {
set source [open $file r]
if {$source == 0} {
continue
}
while {"[gets $source line]" != -1} {
if [regexp \
"^\(proc|class|body|configbody\)\[ \t\]*\(\[^ \t\]*\)\[ \t\]"\
"$line" all junk proc] {
set tail [namespace tail $proc]
puts $tags "$proc\t$file\t/^$line$/;\"\tf"
puts $tags "$tail\t$file\t/^$line$/;\"\tf"
}
}
close $source
}
}
close $tags
#!/usr/local/bin/tclsh
# ==================================================================
# FILE: aux/vimtags
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ==================================================================
if [file readable tags] {
set tags [open tags r]
set vim [open tags.vim w]
while {[gets $tags line] != -1} {
if [regexp "^\(\[^ !\]*\)\[ \]" $line all proc] {
set proc [string trim $proc]
if {$proc != ""} {
puts $vim "syntax keyword Tag $proc"
}
}
}
close $tags
close $vim
}
/* config.h.in. Generated from configure.ac by autoheader. */
/* Define if rl_cleanup_after_signal is resolved in libreadline. */
#undef CLEANUP_AFER_SIGNAL
/* Define if EXECUTING_MACRO_NAME is resolved in libreadline. */
#undef EXECUTING_MACRO_HACK
/* Define the name of the executing macro variable in libreadline. */
#undef EXECUTING_MACRO_NAME
/* Define to 1 if you have the <dlfcn.h> header file. */
#undef HAVE_DLFCN_H
/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
/* Define to 1 if you have the <stdint.h> header file. */
#undef HAVE_STDINT_H
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H
/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H
/* Define to 1 if you have the <sys/stat.h> header file. */
#undef HAVE_SYS_STAT_H
/* Define to 1 if you have the <sys/types.h> header file. */
#undef HAVE_SYS_TYPES_H
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
/* Define to the sub-directory where libtool stores uninstalled libraries. */
#undef LT_OBJDIR
/* Name of package */
#undef PACKAGE
/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT
/* Define to the full name of this package. */
#undef PACKAGE_NAME
/* Define to the full name and version of this package. */
#undef PACKAGE_STRING
/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME
/* Define to the home page for this package. */
#undef PACKAGE_URL
/* Define to the version of this package. */
#undef PACKAGE_VERSION
/* Define if we have libreadline. */
#undef READLINE_LIBRARY
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Version number of package */
#undef VERSION
/* Define to empty if `const' does not conform to ANSI C. */
#undef const
This source diff could not be displayed because it is too large. You can view the blob instead.
dnl -*- autoconf -*-
dnl FILE: configure.in
dnl $Id$
dnl ---
dnl tclreadline -- gnu readline for tcl
dnl https://github.com/flightaware/tclreadline/
dnl Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
dnl This software is copyright under the BSD license.
dnl ---
AC_INIT([tclreadline], [2.3.8])
AC_CONFIG_SRCDIR([tclreadline.c])
AC_CONFIG_HEADERS(config.h)
AC_PREREQ(2.13)
AC_REVISION($Revision$)
AC_CONFIG_AUX_DIR(./aux)
MAJOR="`echo 'AC_PACKAGE_VERSION' | cut -d. -f 1`"
MINOR="`echo 'AC_PACKAGE_VERSION' | cut -d. -f 2`"
PATCHLEVEL="`echo 'AC_PACKAGE_VERSION' | cut -d. -f 3`"
VERSION=$MAJOR.$MINOR
PATCHLEVEL_STR=$VERSION.$PATCHLEVEL
AC_SUBST(MAJOR)
AC_SUBST(MINOR)
AC_SUBST(PATCHLEVEL)
AC_SUBST(VERSION)
AC_SUBST(PATCHLEVEL_STR)
AM_INIT_AUTOMAKE([foreign])
AC_PROG_MAKE_SET
dnl AM_INIT_AUTOMAKE(tclreadline, $VERSION)
AC_CANONICAL_HOST
AC_PROG_CC
AC_EXEEXT
dnl AC_LIBTOOL_DLOPEN
AM_PROG_LIBTOOL
AC_SUBST(LIBTOOL_DEPS)
AC_C_CONST
AC_PROG_INSTALL
AC_PROG_RANLIB
AC_PROG_LN_S
# -- WHICH TCL TO USE
AC_ARG_WITH(
tcl,
[ --with-tcl=DIR where to look for tclConfig.sh],
tcl_search=$withval,
tcl_search=""
)
AC_MSG_CHECKING([which tclConfig.sh to use])
TCL_LIB_DIR=""
for dir in $tcl_search /usr/lib /usr/local/lib $exec_prefix/lib /usr/local/lib/unix /opt/tcl/lib; do
if test -r $dir/tclConfig.sh; then
TCL_LIB_DIR=$dir
break
fi
done
if test -z "$TCL_LIB_DIR"; then
AC_MSG_ERROR(Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system.)
fi
. $TCL_LIB_DIR/tclConfig.sh
AC_MSG_RESULT($TCL_LIB_DIR/tclConfig.sh)
AC_MSG_CHECKING([for your tcl version])
AC_MSG_RESULT([$TCL_VERSION, patchlevel $TCL_PATCH_LEVEL])
# Check, if tcl_version is > 8.0
if test $TCL_MAJOR_VERSION -lt 8; then
AC_MSG_ERROR(need tcl 8.0 or higher.)
fi
# -- WHICH TK TO USE
AC_ARG_WITH(
tk,
[ --with-tk=DIR where to look for tkConfig.sh],
tk_search=$withval,
tk_search=""
)
if test x$tk_search != xno; then
AC_MSG_CHECKING([which tkConfig.sh to use])
TK_LIB_DIR=""
for dir in $tk_search $tcl_search /usr/lib /usr/local/lib $exec_prefix/lib /usr/local/lib/unix /opt/tcl/lib; do
if test -r $dir/tkConfig.sh; then
TK_LIB_DIR=$dir
break
fi
done
if test -z "$TK_LIB_DIR"; then
AC_MSG_ERROR(Can't find Tk libraries. Use --with-tk to specify the directory containing tkConfig.sh on your system.)
fi
. $TK_LIB_DIR/tkConfig.sh
AC_MSG_RESULT($TK_LIB_DIR/tkConfig.sh)
AC_MSG_CHECKING([for your tk version])
AC_MSG_RESULT([$TK_VERSION, patchlevel $TK_PATCH_LEVEL])
# Check, if tk_version is > 8.0
if test $TK_MAJOR_VERSION -lt 8; then
AC_MSG_ERROR(need tk 8.0 or higher.)
fi
fi
# -----------------------------------------------------------------------
# Set up a new default --prefix.
# -----------------------------------------------------------------------
# this is the default anyway:
# AC_PREFIX_DEFAULT(/usr/local)
if test "${prefix}" = "NONE"; then
prefix=$TCL_PREFIX
fi
TCLRL_LIBDIR="${prefix}/lib"
AC_SUBST(TCLRL_LIBDIR)
TCLRL_DIR="${TCLRL_LIBDIR}/tclreadline$VERSION"
AC_SUBST(TCLRL_DIR)
# HEADERS
AC_HEADER_STDC
AC_CHECK_HEADERS(string.h)
#--------------------------------------------------------------------
# Check for tcl.h
#--------------------------------------------------------------------
AC_ARG_WITH(tcl-includes,
[ --with-tcl-includes=DIR where to look for tcl.h],
tcl_includes=$withval, tcl_includes=$prefix/include)
AC_MSG_CHECKING([where to look for tcl.h])
TCL_INCLUDE_DIR=""
for dir in $tcl_includes $prefix/include/ ${TCL_INCLUDE_SPEC#-I} /usr/include; do
if test -r $dir/tcl.h; then
TCL_INCLUDE_DIR=$dir
break
fi
done
if test -z "$TCL_INCLUDE_DIR"; then
AC_MSG_ERROR([
Can't find tcl.h. Use --with-tcl-includes to specify the directory
containing tcl.h on your system.])
else
AC_MSG_RESULT($TCL_INCLUDE_DIR/tcl.h)
fi
#--------------------------------------------------------------------
# Check for readline.h
#--------------------------------------------------------------------
AC_ARG_WITH(readline-includes,
[ --with-readline-includes=DIR readline include files in DIR],
rl_includes=$withval, rl_includes="")
dnl look for readline/readline.h
dnl ^^^^^^^^
AC_MSG_CHECKING([where to look for readline.h])
READLINE_INCLUDE_DIR=""
for dir in $rl_includes /usr/local/include /usr/include ; do
if test -r $dir/readline/readline.h; then
READLINE_INCLUDE_DIR=$dir
break
fi
done
dnl look directly in the include dirs for readline.h
if test -z "$READLINE_INCLUDE_DIR"; then
for dir in $rl_includes /usr/local/include /usr/include ; do
if test -r $dir/readline.h; then
READLINE_INCLUDE_DIR=$dir
AC_DEFINE_UNQUOTED(READLINE_LIBRARY, 1, [ Define if we have libreadline. ])
break
fi
done
fi
if test -z "$READLINE_INCLUDE_DIR"; then
AC_MSG_ERROR([
Can't find readline.h.
Use --with-readline-includes to specify the directory
containing readline.h on your system.])
fi
AC_ARG_WITH(readline-library,
[ --with-readline-library=DIR
lib spec to readline (e.g. '-L/usr/local/lib -lreadline')],
LIBS="$LIBS $withval",
AC_SEARCH_LIBS(rl_callback_read_char, readline, ,
AC_MSG_RESULT([
Your readline version does not support readline's alternate interface.
Please upgrade to readline >= 2.2 and retry.
])
exit
)
)
# check for readline's rl_executing_macro
# (could be macro.c's private variable _rl_executing_macro).
AC_CHECK_DECL(rl_executing_macro
, AC_DEFINE(EXECUTING_MACRO_NAME, rl_executing_macro,
[ Define the name of the executing macro variable in libreadline. ])
, AC_MSG_CHECKING([for _rl_executing_macro in -lreadline])
AC_TRY_LINK(,[
extern char* _rl_executing_macro;
_rl_executing_macro = (char*) 0;
]
, AC_MSG_RESULT(yes)
AC_DEFINE(EXECUTING_MACRO_HACK, 1,
[ Define if EXECUTING_MACRO_NAME is resolved in libreadline. ])
AC_DEFINE(EXECUTING_MACRO_NAME, _rl_executing_macro,
[ Define the name of the executing macro variable in libreadline. ])
, AC_MSG_RESULT(no))
, [AC_INCLUDES_DEFAULT
#include "$READLINE_INCLUDE_DIR/readline.h"])
# check for readline's rl_cleanup_after_signal
AC_MSG_CHECKING([for rl_cleanup_after_signal() in -lreadline])
AC_TRY_LINK(,[
extern void rl_cleanup_after_signal();
rl_cleanup_after_signal();
],
AC_MSG_RESULT(yes);
AC_DEFINE(CLEANUP_AFER_SIGNAL, 1,
[ Define if rl_cleanup_after_signal is resolved in libreadline. ]),
AC_MSG_RESULT(no))
AC_MSG_CHECKING([for the readline version number])
AC_TRY_RUN([
#include <stdio.h>
int main () {
FILE *fp = fopen("conftestversion", "w");
extern char *rl_library_version;
fprintf(fp, "%s", rl_library_version);
close(fp);
return 0;
}],
READLINE_VERSION=`cat conftestversion`
AC_MSG_RESULT($READLINE_VERSION),
AC_MSG_RESULT(failed),
AC_MSG_RESULT(no cross compiling)
)
AC_ARG_ENABLE(tclstub,
[ --enable-tclstub build with TCL stub library],
[dnl action if given
case "${enableval}" in
yes) enable_tclstub=true ;;
no) enable_tclstub=false ;;
*) AC_MSG_ERROR(bad value ${enableval} for --enable-tclstub) ;;
esac
],
[dnl action if not given
enable_tclstub=false
]
)
AM_CONDITIONAL(USE_TCL_STUBS, test x$enable_tclstub = xtrue)
AC_ARG_ENABLE(tclshrl,
[ --enable-tclshrl build statically linked tclshrl],
[dnl action if given
case "${enableval}" in
yes) enable_static=true ;;
no) enable_static=false ;;
*) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;;
esac
],
[dnl action if not given
enable_static=false
]
)
AM_CONDITIONAL(STATIC_TCLSHRL, test x$enable_static = xtrue)
AC_ARG_ENABLE(wishrl,
[ --enable-wishrl build statically linked wishrl],
[dnl action if given
case "${enableval}" in
yes)
enable_static=true
dnl source the tkConfig.sh which defines TK_LIB_SPEC
. $TK_LIB_DIR/tkConfig.sh
AC_SUBST(TK_LIB_SPEC)
;;
no) enable_static=false ;;
*) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;;
esac
],
[dnl action if not given
enable_static=false
]
)
AM_CONDITIONAL(STATIC_WISHRL, test x$enable_static = xtrue)
AC_SUBST(TCL_INCLUDE_DIR)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(READLINE_INCLUDE_DIR)
AC_OUTPUT(Makefile tclreadline.h tclreadlineInit.tcl tclreadlineSetup.tcl tclreadline.n pkgIndex.tcl)
# libtclreadline.la - a libtool library file
# Generated by libtool (GNU libtool) 2.4.6
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# The name that we can dlopen(3).
dlname='libtclreadline-2.3.8.so'
# Names of this library.
library_names='libtclreadline-2.3.8.so libtclreadline-2.3.8.so libtclreadline.so'
# The name of the static archive.
old_library=''
# Linker flags that cannot go in dependency_libs.
inherited_linker_flags=''
# Libraries that this one depends upon.
dependency_libs=' -L/workspace/S/lvzhengyang/MiniEDA/pkgs//lib -ltcl8.6 -lreadline'
# Names of additional weak libraries provided by this library
weak_library_names=''
# Version information for libtclreadline.
current=0
age=0
revision=0
# Is this an already installed library?
installed=no
# Should we warn about portability when linking against -modules?
shouldnotlink=no
# Files to dlopen/dlpreopen
dlopen=''
dlpreopen=''
# Directory that this library needs to be installed in:
libdir='/workspace/S/lvzhengyang/MiniEDA/pkgs/lib'
# libtclreadline_la-tclreadline.lo - a libtool object file
# Generated by libtool (GNU libtool) 2.4.6
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# Name of the PIC object.
pic_object='.libs/libtclreadline_la-tclreadline.o'
# Name of the non-PIC object
non_pic_object=none
This source diff could not be displayed because it is too large. You can view the blob instead.
# FILE: pkgIndex.tcl.in
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---
package ifneeded tclreadline @VERSION@ \
[list source [file join $dir tclreadlineInit.tcl]]
#! /bin/sh
set -e
sudo apt-get update
sudo apt-get install -y \
autoconf \
build-essential \
expect \
itcl3 \
libreadline6 \
libreadline6-dev \
libtool \
tcl \
tcl-dev
cd /vagrant
autoreconf -fvi
./configure --with-tcl-includes=/usr/include/tcl
make
sudo make install
#!/bin/sh
# FILE: sample.tclshrc
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---
# exec with tclsh \
exec tclsh "$0" "$@"
if {$tcl_interactive} {
package require tclreadline
# uncomment the following if block, if you
# want `ls' executed after every `cd'. (This was
# the default up to 0.8 == tclreadline_version.)
#
# if {"" == [info procs cd]} {
# catch {rename ::tclreadline::Cd ""}
# rename cd ::tclreadline::Cd
# proc cd {args} {
# if {[catch {eval ::tclreadline::Cd $args} message]} {
# puts stderr "$message"
# }
# tclreadline::ls
# }
# }
# uncomment the following line to use
# tclreadline's fancy ls proc.
#
# namespace import tclreadline::ls
# tclreadline::Print is on (`yes') by default.
# This mimics the command echoing like in the
# non-readline interactive tclsh.
# If you don't like this, uncomment the following
# line.
#
# tclreadline::Print no
# uncomment the folling line, if you want
# to change tclreadline's print behaviour
# frequently with less typing.
#
# namespace import tclreadline::Print
# store maximal this much lines in the history file
#
set tclreadline::historyLength 200
# disable tclreadline's script completer
#
# ::tclreadline::readline customcompleter ""
# automatically save the history after every
# command (instead of when cleanly exiting)
set tclreadline::autosave 1
# go to tclrealdine's main loop.
#
tclreadline::Loop
}
# vim:set ft=tcl:
/* ================================================================== *
* FILE: tclreadline.h.in
* $Id$
* ---
* tclreadline -- gnu readline for tcl
* https://github.com/flightaware/tclreadline/
* Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
* This software is copyright under the BSD license.
* ================================================================== */
#ifndef TCLREADLINE_H_
#define TCLREADLINE_H_
#include <tcl.h>
#define TCLRL_LIBRARY "@TCLRL_DIR@"
/* VERSION STRINGS */
#define TCLRL_VERSION_STR "@VERSION@"
#define TCLRL_PATCHLEVEL_STR "@PATCHLEVEL_STR@"
/* VERSION NUMBERS */
#define TCLRL_MAJOR @MAJOR@
#define TCLRL_MINOR @MINOR@
#define TCLRL_PATCHLEVEL @PATCHLEVEL@
#ifdef __cplusplus
extern "C" {
#endif
int Tclreadline_Init(Tcl_Interp *interp);
int Tclreadline_SafeInit(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif
#endif /* TCLREADLINE_H_ */
This source diff could not be displayed because it is too large. You can view the blob instead.
# FILE: tclreadlineInit.tcl.in
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# This software is copyright under the BSD license.
# ---
package provide tclreadline @VERSION@
namespace eval tclreadline:: {
namespace export Init
}
proc ::tclreadline::Init {} {
uplevel #0 {
if {![info exists tclreadline::library]} {
set msg ""
foreach dirname {@TCLRL_LIBDIR@ [file dirname [info script]]} {
if {[catch {load [file join $dirname libtclreadline[info sharedlibextension]]} msg] == 0} {
set msg ""
break
}
}
if {$msg != ""} {
puts stderr $msg
exit 2
}
}
}
}
tclreadline::Init
::tclreadline::readline customcompleter ::tclreadline::ScriptCompleter
source [file join [file dirname [info script]] tclreadlineSetup.tcl]
set auto_index(::tclreadline::ScriptCompleter) \
[list source [file join [file dirname [info script]] tclreadlineCompleter.tcl]]
/* ================================================================== *
* FILE: tclshrl.c
* $Id$
* ---
* tclreadline -- gnu readline for tcl
* https://github.com/flightaware/tclreadline/
* Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
* This software is copyright under the BSD license.
* ================================================================== */
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
#include <stdlib.h>
#include <tcl.h>
#include <tclreadline.h>
extern int Tclreadline_Init(Tcl_Interp *interp);
extern int Tclreadline_SafeInit(Tcl_Interp *interp);
int
TclreadlineAppInit(Tcl_Interp* interp)
{
char file[0xff];
int status;
if (TCL_ERROR == Tcl_Init(interp)) {
return TCL_ERROR;
}
if (TCL_ERROR == Tclreadline_Init(interp)) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "tclreadline",
Tclreadline_Init, Tclreadline_SafeInit);
#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION == 4)
tcl_RcFileName = "~/.tclshrc";
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif
sprintf(file, "%s/tclreadlineInit.tcl", TCLRL_LIBRARY);
if ((status = Tcl_EvalFile(interp, file))) {
fprintf(stderr, "(TclreadlineAppInit) unable to eval %s\n", file);
exit (EXIT_FAILURE);
}
return TCL_OK;
}
int
main(int argc, char *argv[])
{
Tcl_Main(argc, argv, TclreadlineAppInit);
return EXIT_SUCCESS;
}
#! /usr/bin/env tclsh
# -*- tclsh -*-
# FILE: tests.tcl
# $Id$
# ---
# tclreadline -- gnu readline for tcl
# https://github.com/flightaware/tclreadline/
# Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
# Copyright (c) 2016, dbohdan <dbohdan@dbohdan.com>
# This software is copyright under the BSD license.
# ---
package require Expect
package require tcltest
::tcltest::configure {*}$::argv
::tcltest::testConstraint itcl3 [expr {
![catch { package require Itcl 3.0 }]
}]
::tcltest::testConstraint itcl4 [expr {
![catch { package require itcl 4.0 }]
}]
::tcltest::testConstraint itcl [expr {
[::tcltest::testConstraint itcl3] || [::tcltest::testConstraint itcl4]
}]
::tcltest::testConstraint tcloo [expr {
![catch { package require TclOO 1.0 }]
}]
set prompt {% }
set tclshrc [file join $::env(HOME) .tclshrc]
proc setup {} {
match_max 100000
set ::timeout 2
expect_before {
timeout {
error {timed out}
}
invalid {
error {invalid command}
}
}
if {[file exists $::tclshrc]} {
file rename $::tclshrc ${::tclshrc}.renamed
}
trap {
send \x03
cleanup
exit 1
} {SIGINT SIGHUP}
puts \n----
uplevel #0 spawn [info nameofexecutable]
send "package require tclreadline\r"
expect -exact $::prompt
send "::tclreadline::Loop\r"
expect -exact \]
}
proc cleanup {} {
send \rexit\r
if {![file exists $::tclshrc] && [file exists $::tclshrc.renamed]} {
file rename $::tclshrc.renamed ${::tclshrc}
}
}
proc send_nl args {
send [join $args \r]\r
}
tcltest::test basic-1.1 {::tclreadline::Loop} \
-setup setup \
-cleanup cleanup \
-body {}
tcltest::test namespace-1.1 {namespace path completion} \
-setup setup \
-cleanup cleanup \
-body {
send_nl \
{namespace eval ::foo {}} \
{namespace eval ::foo::bar {}}
expect -exact \]
send "namespace eval ::foo\t"
expect -exact ::bar
}
tcltest::test variable-1.1 {variable namespace path completion} \
-setup setup \
-cleanup cleanup \
-body {
send_nl \
{namespace eval ::bar {}} \
{set ::bar::baz value1}
expect -exact \]
send "set ::bar\t"
expect -exact ::baz
}
tcltest::test variable-1.2 {partial variable name completion after '$'} \
-setup setup \
-cleanup cleanup \
-body {
send_nl {set foo 5}
expect -exact \]
send "lindex \$f\t"
expect -exact foo
send \r
expect 5
}
tcltest::test variable-1.3 {empty variable name completion after '$'} \
-setup setup \
-cleanup cleanup \
-body {
send_nl {set bar 5}
expect -exact \]
send "puts \$\t"
sleep 0.2
send \t
expect -exact bar
}
tcltest::test itcl-1.1 {itcl method name completion} \
-constraints itcl \
-setup setup \
-cleanup cleanup \
-body {
send_nl {
# Prefer [incr Tcl] 4.
if {[catch {package require itcl}]} {
package require Itcl
}
}
send_nl {
::itcl::class cls {
public variable opt
method aleph {} {}
method beth {} {}
}
}
expect -exact \]
send_nl {cls obj}
expect -exact \]
send "obj a\t"
sleep 0.2
send \t
expect -exact aleph
}
tcltest::test itcl-2.1 {itcl method argument hints} \
-constraints itcl \
-setup setup \
-cleanup cleanup \
-body {
send_nl {
# Prefer [incr Tcl] 4.
if {[catch {package require itcl}]} {
package require Itcl
}
}
send_nl {
::itcl::class cls {
method foo {bar baz quux asdf} {}
}
}
expect -exact \]
send_nl {cls obj}
expect -exact \]
send "obj foo \t"
sleep 0.2
send \t
expect -exact <bar>
send "arg1 \t"
sleep 0.2
send \t
expect -exact <baz>
send "arg2 \t"
sleep 0.2
send \t
expect -exact <quux>
send "arg3 \t"
sleep 0.2
send \t
expect -exact <asdf>
}
tcltest::test itcl-3.1 {itcl option name completion for cget and configure} \
-constraints itcl \
-setup setup \
-cleanup cleanup \
-body {
send_nl {
# Prefer [incr Tcl] 4.
if {[catch {package require itcl}]} {
package require Itcl
}
}
send_nl {
::itcl::class cls {
public variable opt
method aleph {} {}
method beth {} {}
}
}
expect -exact \]
send_nl {cls obj}
expect -exact \]
send "obj cget -o\t"
sleep 0.2
send \t
expect -exact -opt
send \r
send "obj configure -o\t"
expect -exact -opt
}
tcltest::test itcl-4.1 {itcl wrong method name} \
-constraints itcl \
-setup setup \
-cleanup cleanup \
-body {
set ::timeout 1
send_nl {
# Prefer [incr Tcl] 4.
if {[catch {package require itcl}]} {
package require Itcl
}
}
send_nl {
::itcl::class cls {
method foo {} {}
}
}
expect -exact \]
send_nl {cls obj}
expect -exact \]
send "obj nope \t"
expect {
{error during evaluation} {
error {error during evaluation}
}
}
} -returnCodes 1 -result {timed out}
tcltest::test tcloo-1.1 {TclOO method name completion} \
-constraints tcloo \
-setup setup \
-cleanup cleanup \
-body {
send_nl {package require TclOO}
send_nl {::oo::class create cls { method bar {} {}; method baz {} {} }}
expect -exact \]
send_nl {set quux [cls new]}
expect -exact \]
send "\$quux \t"
sleep 0.2
send \t\r
expect -glob "*bar*baz*"
}
tcltest::test tcloo-2.1 {TclOO method argument hints} \
-constraints tcloo \
-setup setup \
-cleanup cleanup \
-body {
send_nl {
::oo::class create ::cls {
method foo {bar baz quux asdf} {}
}
}
expect -exact \]
send_nl {set obj [::cls new]}
expect -exact \]
send "\$obj foo \t"
sleep 0.2
send \t
expect -exact <bar>
send "arg1 \t"
sleep 0.2
send \t
expect -exact <baz>
send "arg2 \t"
sleep 0.2
send \t
expect -exact <quux>
send "arg3 \t"
sleep 0.2
send \t
expect -exact <asdf>
}
tcltest::test tcloo-3.1 {TclOO wrong method name} \
-constraints tcloo \
-setup setup \
-cleanup cleanup \
-body {
set ::timeout 1
send_nl {
::oo::class create cls {
method foo {} {}
}
}
expect -exact \]
send_nl {set obj [cls new]}
expect -exact \]
send "\$obj nope \t"
sleep 0.2
send \t
expect {
{error during evaluation} {
error {error during evaluation}
}
}
} -returnCodes 1 -result {timed out}
# Exit with a nonzero status if there are failed tests.
set failed [expr {$tcltest::numTests(Failed) > 0}]
tcltest::cleanupTests
if {$failed} {
exit 1
}
/* ================================================================== *
* FILE: wishrl.c
* $Id$
* ---
* tclreadline -- gnu readline for tcl
* https://github.com/flightaware/tclreadline/
* Copyright (c) 1998 - 2014, Johannes Zellner <johannes@zellner.org>
* This software is copyright under the BSD license.
* ================================================================== */
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
#include <stdlib.h>
#include <tcl.h>
#include <tk.h>
#include <tclreadline.h>
extern int Tclreadline_Init(Tcl_Interp *interp);
extern int Tclreadline_SafeInit(Tcl_Interp *interp);
int
TclreadlineAppInit(Tcl_Interp* interp)
{
char file[0xff];
int status;
if (TCL_ERROR == Tcl_Init(interp)) {
return TCL_ERROR;
}
if (TCL_ERROR == Tk_Init(interp)) {
return TCL_ERROR;
}
if (TCL_ERROR == Tclreadline_Init(interp)) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "tclreadline",
Tclreadline_Init, Tclreadline_SafeInit);
#if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION == 4)
tcl_RcFileName = "~/.wishrc";
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
#endif
sprintf(file, "%s/tclreadlineInit.tcl", TCLRL_LIBRARY);
if ((status = Tcl_EvalFile(interp, file))) {
fprintf(stderr, "(TclreadlineAppInit) unable to eval %s\n", file);
exit (EXIT_FAILURE);
}
return TCL_OK;
}
int
main(int argc, char *argv[])
{
Tk_Main(argc, argv, TclreadlineAppInit);
return EXIT_SUCCESS;
}
# CVS default ignores begin
tags
TAGS
.make.state
.nse_depinfo
*~
#*
.#*
,*
_$*
*$
*.old
*.bak
*.BAK
*.orig
*.rej
.del-*
*.a
*.olb
*.o
*.obj
*.so
*.dylib
*.exe
*.Z
*.elc
*.ln
core
# CVS default ignores end
Makefile
autom4te.cache
config.log
config.status
pkgIndex.tcl
language: c
sudo: true
os:
- linux
- osx
before_install:
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew update; fi
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install tcl-tk; fi
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo apt-get update -qq; fi
- if [[ "$TRAVIS_OS_NAME" == "linux" ]]; then sudo apt-get install tcl8.6-dev -y; fi
script:
- autoreconf -vi
- if [ -f /usr/local/opt/tcl-tk/lib/tclConfig.sh ]; then ./configure --with-tcl=/usr/local/opt/tcl-tk/lib --prefix=/usr/local; else ./configure; fi
- make
- sudo make install
- make test
#
# This makes sure that TEA knows about all the necessary bits and stuffs them into configure from configure.in
#
autoreconf
#
# This keeps configure honest if you have both clang and gcc installed
#
CC=clang CXX=clang++ ./configure --prefix=/usr/local --with-tcl=/usr/local/lib/tcl8.6
# Then "make clean" and "make"
[![Build Status](https://travis-ci.org/flightaware/tclx.svg?branch=master)](https://travis-ci.org/flightaware/tclx)
# Extended Tcl (TclX)
## Introduction
Extended Tcl (TclX), is an extension to Tcl, the Tool Command Language invented by Dr. John Ousterhout. Tcl is a powerful, yet simple embeddable programming language. Extended Tcl is oriented towards system programming tasks and large application development. TclX provides additional interfaces to the operating system, and adds many new programming constructs, text manipulation tools, and debugging tools.
TclX is upwardly compatible with Tcl. You take the Extended Tcl package, add it to Tcl, and from that you get Extended Tcl. Tcl can be obtained at
http://www.tcl.tk/ or http://tcl.sourceforge.net/
Extended Tcl runs on most Unix-like systems and Windows.
While this TclX distribution is tested with Tcl 8.4 and Tk 8.4, it should with Tcl 8.3+. Please check the Extended Tcl homepage at
http://tclx.sourceforge.net/
for the latest release and information.
Extended Tcl was designed and implemented by Karl Lehenbauer and Mark Diekhans, with help in the earliest stages from Peter da Silva. TclX 8.4 work was done by Jeff Hobbs at ActiveState.
TclX 8.4 differs from its predecessors in that it is based more on the idea of TclX as an extension to Tcl, and not an alternate environment. There is no TkX and no stand-alone shells are built.
As with Tcl, all of Extended Tcl is freely redistributable, including for commercial use and resale (BSD-style license).
## Building and installing TclX
1. Uncompress and unpack the distribution
ON UNIX/MAC:
gzip -cd tclx<version>.tar.gz | tar xf -
ON WINDOWS:
use something like WinZip to unpack the archive.
This will create a subdirectory tclx<version> with all the files in it.
2. Configure
ON UNIX/MAC:
cd tclx<version>
./configure
TclX is TEA-based and uses information left in tclConfig.sh when you built tcl. This file will be found in $exec_prefix/lib/. You might set the --prefix and --exec-prefix options of configure if you don't want the default (/usr/local). If building on multiple unix platforms, the following is recommended to isolate build conflicts:
mkdir <builddir>/<platform>
cd !$
/path/to/tclx<version>/configure
ON WINDOWS:
TclX supports building in the cygwin/msys environment on Windows based on TEA (http://www.tcl.tk/doc/tea/). Inside this environment, you build the same as on Unix.
Otherwise, hack makefile.vc until it works and compile. It was not updated for TclX 8.4. It has problems executing wish from a path with a space in it, but the DLL builds just fine.
3. Make and Install
ON UNIX/MAC or WINDOWS with cygwin/msys:
make
make test (OPTIONAL)
make install
ON WINDOWS (makefile.vc):
nmake -f makefile.vc
nmake -f makefile.vc test (OPTIONAL)
nmake -f makefile.vc install
TclX is built to comply to the latest tcl package conventions.
## changes in TclX 8.4
* Restructure of the sources and build system
* Removal of TkX extension
## Features added by Extended Tcl
Here is a summary of the features added by Extended Tcl. For more details on the commands and functionality provided by Extended Tcl, see the manual page man/TclX.man.
* Keyed lists, a type of list that provides functionality similar to C structures.
* A command tracing facility for debugging and a performance profiler.
* Unix access commands provide access to many Unix system calls, including process management.
* File control and status commands provide added facilities for accessing and manipulating open files.
* File scanning facility that provides awk-like functionality.
* Extended list manipulation commands.
* Extended string and character manipulation commands.
* X/PG based internationalization commands.
* Advanced Tcl code library facility that is oriented towards building large applications. It is compatible with standard Tcl auto-loading.
* Additional general programming commands.
* Restricted use in a safe interpreter.
* Support for binary data in most commands.
## Manual pages
Man pages in nroff/troff format are provided for all of Tcl and the extensions in the doc directory. Start with the TclX.n manual.
## Extended Tcl version naming
Extended Tcl version numbering has been changed to track the Tcl/Tk version numbering roughly.
## Linking applications and extension with TclX
There are three basic approaches to linking TclX into applications or with other extensions:
* Dynamically load the C code using either 'package require' or the 'load' command.
* Linking TclX into an application based on the standard Tcl or Tk shells (tclsh or wish) or based on your own startup.
See the TclX_Init.3 manual page for more details. The pkg_mkIndex does not generate a pkgIndex.tcl file that works with TclX. See TclX_Init.3 for instructions on how to setup a pkgIndex.tcl file for use with the package require command. There is no need to dynamically load libtkx, its only there to support wishx and applications that want wishx's signal handling.
TclX will build and install a pkgIndex.tcl that will be automatically found by Tcl if TclX is installed in the same location.
## Support for Extended Tcl
We are committed to providing continuing support for Extended Tcl. Please send questions, bug reports, and bug fixes to:
http://tclx.sourceforge.net/
Use news:comp.lang.tcl for discussion about TclX development.
## Where to get it
Extended Tcl can be downloaded from the SF TclX release files area:
http://tclx.sourceforge.net/
Refer to the above site for bug database and other support forums.
## Thanks
A big thanks to all of the Extended Tcl users from all over the world who have helped us debug problems and given us valuable suggestions. A special thanks to John Ousterhout, his students at Berkeley, and (more recently) his teams at Sun Microsystems and Scriptics, for Tcl, Tk and all the support they have given us.
Thanks to Michael E. Shorter, Christopher M. Sedore, Philip Chow, and Kirk Benson for their initial work on porting TclX to MS Windows.
Thanks to Jan Nijtmans of Plus Patch fame for helping to get shared library support working for several system.
#
# Include the TEA standard macro set
#
builtin(include,tclconfig/tcl.m4)
#
# Add here whatever m4 macros you want to define for your package
#
/*
* Copyright (c) 1987, 1993, 1994
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#if defined(LIBC_SCCS) && !defined(lint)
static char sccsid[] = "@(#)getopt.c 8.2 (Berkeley) 4/2/94";
#endif /* LIBC_SCCS and not lint */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifndef WIN32
extern char *__progname;
#endif
int opterr = 1, /* if error message should be printed */
optind = 1, /* index into parent argv vector */
optopt, /* character checked for validity */
optreset; /* reset getopt */
char *optarg; /* argument associated with option */
#define BADCH (int)'?'
#define BADARG (int)':'
#define EMSG ""
/*
* getopt --
* Parse argc/argv argument vector.
*/
int
getopt(nargc, nargv, ostr)
int nargc;
char * const *nargv;
const char *ostr;
{
static char *place = EMSG; /* option letter processing */
char *oli; /* option letter list index */
if (optreset || !*place) { /* update scanning pointer */
optreset = 0;
if (optind >= nargc || *(place = nargv[optind]) != '-') {
place = EMSG;
return (EOF);
}
if (place[1] && *++place == '-') { /* found "--" */
++optind;
place = EMSG;
return (EOF);
}
} /* option letter okay? */
if ((optopt = (int)*place++) == (int)':' ||
!(oli = strchr(ostr, optopt))) {
/*
* if the user didn't specify '-' as an option,
* assume it means EOF.
*/
if (optopt == (int)'-')
return (EOF);
if (!*place)
++optind;
if (opterr && *ostr != ':')
#ifndef WIN32
(void)fprintf(stderr,
"%s: illegal option -- %c\n", __progname, optopt);
#else
(void)fprintf(stderr,
"illegal option -- %c\n", optopt);
#endif
return (BADCH);
}
if (*++oli != ':') { /* don't need argument */
optarg = NULL;
if (!*place)
++optind;
}
else { /* need an argument */
if (*place) /* no white space */
optarg = place;
else if (nargc <= ++optind) { /* no arg */
place = EMSG;
if (*ostr == ':')
return (BADARG);
if (opterr)
#ifndef WIN32
(void)fprintf(stderr,
"%s: option requires an argument -- %c\n",
__progname, optopt);
#else
(void)fprintf(stderr,
"option requires an argument -- %c\n",
optopt);
#endif
return (BADCH);
}
else /* white space */
optarg = nargv[optind];
place = EMSG;
++optind;
}
return (optopt); /* dump back option letter */
}
/* vim: set ts=4 sw=4 sts=4 et : */
/* rename.c -- file renaming routine for systems without rename(2)
*
* Written by reading the System V Interface Definition, not the code.
*
* Totally public domain. (Author unknown)
*
*/
int rename(from,to)
register char *from, *to;
{
(void) unlink(to);
if (link(from, to) < 0)
return(-1);
(void) unlink(from);
return(0);
}
/* vim: set ts=4 sw=4 sts=4 et : */
This source diff could not be displayed because it is too large. You can view the blob instead.
$Id: CONVERSION-NOTES,v 8.1 1997/06/12 21:08:01 markd Exp $
Notes on converting to the new object system:
Since the old system is supported, we recommend changing the names of
routines as you port them. That way, also, you will catch any errors
in header files or calls.
Hopefully your application has tests that can be run as routines are
upgraded. We recommend that you make your changes one command at a
time and then test, to not get into the problem of breaking things
so much that they won't come up, or at least if you do, that you have
a pretty good idea where the problem is because your changes are
localized to the area you were just working on.
As for a naming convention, we are fairly much following Tcl's.
For example, TclX's TclX_CtypeCommand became TclX_CtypeObjCommand.
C COMMAND CALLING ARGUMENTS HAVE CHANGED
Object commands still take four arguments, but now instead of the
argument vector being a pointer to an array of pointers to char *
it is now a pointer to an array of pointers of Tcl_Obj *'s, Tcl
objects.
Thus,
int
TclX_LassignCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
...became...
int
TclX_LassignObjCmd (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj **objv;
You will then of course need to edit your .h files that contain the
prototypes for these functions.
CALL TO INSTALL THE COMMAND HAS CHANGE
Next the call to create the command within Tcl has changed:
Tcl_CreateCommand (interp, "fcntl", Tcl_FcntlCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
...becomes...
Tcl_CreateObjCommand (interp, "fcntl", -1,
Tcl_FcntlObjCmd, (ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
The "-1" is the length of the command name where, if negative, it means
that the name stops at the first null byte (a standard C string).
(The groundwork has been laid for Tcl to be fully eight bit clean,
including being able to handle null bytes, and this is part of it.
It's unlikely you'd have a command name that contained a null byte,
however, so we feel fairly safe in using -1.)
RETURNING ERRORS HAS CHANGED
Now routines either return errors the old way or the new way. The old
way you built up errors by manipulating interp->result, through
commands like Tcl_AddErrInfo, Tcl_SetResult, etc. Object-based commands
return object results. If an object command tries to return a result
the old way, no result will be returned at all!
.\"
.\" Handles.man
.\"
.\" Extended Tcl handle facility.
.\"----------------------------------------------------------------------------
.\" Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
.\"
.\" Permission to use, copy, modify, and distribute this software and its
.\" documentation for any purpose and without fee is hereby granted, provided
.\" that the above copyright notice appear in all copies. Karl Lehenbauer and
.\" Mark Diekhans make no representations about the suitability of this
.\" software for any purpose. It is provided "as is" without express or
.\" implied warranty.
.\"----------------------------------------------------------------------------
.\" $Id: Handles.3,v 8.2 1999/03/31 06:37:41 markd Exp $
.\"----------------------------------------------------------------------------
.\"
.TH Handles TCL "" "Tcl"
.ad b
.BS
.SH NAME
Tcl_HandleAlloc, Tcl_HandleFree, Tcl_HandleTblInit, Tcl_HandleTblRelease, Tcl_HandleTblUseCount, Tcl_HandleWalk, Tcl_HandleXlate \- Dynamic, handle addressable tables.
.SH SYNOPSIS
.PP
.nf
.ft CW
#include <tclExtend.h>
void_pt
Tcl_HandleTblInit (const char *handleBase,
int entrySize,
int initEntries);
int
Tcl_HandleTblUseCount (void_pt headerPtr,
int amount);
void
Tcl_HandleTblRelease (void_pt headerPtr);
void_pt
Tcl_HandleAlloc (void_pt headerPtr,
char *handlePtr);
void_pt
Tcl_HandleXlate (Tcl_Interp *interp,
void_pt headerPtr,
const char *handle);
void_pt
Tcl_HandleWalk (void_pt headerPtr,
int *walkKeyPtr);
void
Tcl_WalkKeyToHandle (void_pt headerPtr,
int walkKey,
char *handlePtr);
void
Tcl_HandleFree (void_pt headerPtr,
void_pt entryPtr);
.ft R
.fi
'
.SH DESCRIPTION
.PP
The Tcl handle facility provides a way to manage table entries that may be
referenced by a textual handle from Tcl code. This is provided for
applications that need to create data structures in one command, return a
reference (i.e. pointer) to that particular data structure and then access
that data structure in other commands. An example application is file handles.
.PP
A handle consists of a base name, which is some unique, meaningful name, such
as `\fBfile\fR' and a numeric value appended to the base name (e.g. `file3').
The handle facility is designed to provide a standard mechanism for building
Tcl commands that allocate and access table entries based on an entry index.
The tables are expanded when needed, consequently pointers to entries should
not be kept, as they will become invalid when the table is expanded. If the
table entries are large or pointers must be kept to the entries, then the
the entries should be allocated separately and pointers kept in the handle
table. A use count is kept on the table. This use count is intended to
determine when a table shared by multiple commands is to be release.
'
.SS Tcl_HandleTblInit
Create and initialize a Tcl dynamic handle table. The use count on the
table is set to one.
.PP
Parameters:
.RS 2
\fBo \fIhandleBase\fR - The base name of the handle, the handle will be
returned in the form "baseNN", where NN is the table entry number.
.br
\fBo \fIentrySize\fR - The size of an entry, in bytes.
.br
\fBo \fIinitEntries\fR - Initial size of the table, in entries.
.RE
.PP
Returns:
.RS 2
A pointer to the table header.
.RE
'
.SS Tcl_HandleTblUseCount
.PP
Alter the handle table use count by the specified amount, which can be
positive or negative. Amount may be zero to retrieve the use count.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - Pointer to the table header.
.br
\fBo \fIamount\fR - The amount to alter the use count by.
.RE
.PP
Returns:
.RS 2
The resulting use count.
.RE
'
.SS Tcl_HandleTblRelease
.PP
Decrement the use count on a Tcl dynamic handle table. If the count
goes to zero or negative, then release the table.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - Pointer to the table header.
.RE
'
.SS Tcl_HandleAlloc
.PP
Allocate an entry and associate a handle with it.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - A pointer to the table header.
.br
\fBo \fIhandlePtr\fR - Buffer to return handle in. It must be big enough to
hold the name.
.RE
.PP
Returns:
.RS 2
A pointer to the allocated entry (user part).
.RE
'
.SS Tcl_HandleXlate
.PP
Translate a handle to a entry pointer.
.PP
Parameters:
.RS 2
\fBo \fIinterp\fR - A error message may be returned in result.
.br
\fBo \fIheaderPtr\fR - A pointer to the table header.
.sp
o \fIhandle\fR - The handle assigned to the entry.
.RE
.PP
Returns:
.RS 2
A pointer to the entry, or NULL if an error occurred.
.RE
'
.SS Tcl_HandleWalk
.PP
Walk through and find every allocated entry in a table. Entries may
be deallocated during a walk, but should not be allocated.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - A pointer to the table header.
.br
\fBo \fIwalkKeyPtr\fR - Pointer to a variable to use to keep track of the
place in the table. The variable should be initialized to -1 before
the first call.
.RE
Returns:
.RS 2
A pointer to the next allocated entry, or NULL if there are not more.
.RE
'
.SS Tcl_WalkKeyToHandle
.PP
Convert a walk key, as returned from a call to Tcl_HandleWalk into a
handle. The Tcl_HandleWalk must have succeeded.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - A pointer to the table header.
.br
\fBo \fIwalkKey\fR - The walk key.
.br
\fBo \fIhandlePtr\fR - Buffer to return handle in. It must be big enough to
hold the name.
.RE
'
.SS Tcl_HandleFree
.PP
Frees a handle table entry.
.PP
Parameters:
.RS 2
\fBo \fIheaderPtr\fR - A pointer to the table header.
.br
\fBo \fIentryPtr\fR - Entry to free.
.RE
.\"
.\" Keylist.man
.\"
.\" Extended Tcl keyed lists commands.
.\"----------------------------------------------------------------------------
.\" Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
.\"
.\" Permission to use, copy, modify, and distribute this software and its
.\" documentation for any purpose and without fee is hereby granted, provided
.\" that the above copyright notice appear in all copies. Karl Lehenbauer and
.\" Mark Diekhans make no representations about the suitability of this
.\" software for any purpose. It is provided "as is" without express or
.\" implied warranty.
.\"----------------------------------------------------------------------------
.\" $Id$
.\"----------------------------------------------------------------------------
.\"
.TH "Tcl_GetKeyedListKeys" TCL "" "Tcl"
.ad b
.SH NAME
TclX_NewKeyedListObj, TclX_KeyedListGet, TclX_KeyedListSet, TclX_KeyedListDelete, TclX_KeyedListGetKeys - Keyed list management routines.
.SH SYNOPSIS
.PP
.nf
.ft CW
#include <tclExtend.h>
Tcl_Obj *
TclX_NewKeyedListObj (void);
int
TclX_KeyedListGet (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj **valuePtrPtr);
int
TclX_KeyedListSet (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj *valuePtr);
int
TclX_KeyedListDelete (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key);
int
TclX_KeyedListGetKeys (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj **listObjPtrPtr);
.ft R
.fi
'
.SH DESCRIPTION
.PP
These routines perform operations on keyed lists. See the \fIExtended Tcl\fR
man page for a description of keyed lists.
.SS TclX_NewKeyedListObj
.PP
Create and initialize a new keyed list object.
.PP
Returns:
.RS 2
A pointer to the object.
.RE
'
.SS TclX_KeyedListGet
.PP
Retrieve a key value from a keyed list.
.PP
Parameters:
.RS 2
\fBo \fIinterp\fR - Error message will be return in result if there is an
error.
.br
\fBo \fIkeylPtr\fR - Keyed list object to get key from.
.br
\fBo \fIkey\fR - The name of the key to extract. Will recusively process
sub-keys seperated by `.'.
.br
\fBo \fIvalueObjPtrPtr\fR - If the key is found, a pointer to the key object
is returned here. NULL is returned if the key is not present.
.br
.RE
.PP
Returns:
.RS 2
\fBo \fBTCL_OK\fR - If the key value was returned.
.br
\fBo \fBTCL_BREAK\fR - If the key was not found.
.br
\fBo \fBTCL_ERROR\fR - If an error occured.
.br
.RE
'
.SS TclX_KeyedListSet
.PP
Set a key value in keyed list object.
.PP
Parameters:
.RS 2
\fBo \fIinterp\fR - Error message will be return in result object.
.br
\fBo \fIkeylPtr\fR - Keyed list object to update.
.br
\fBo \fIkey\fR - The name of the key to extract. Will recusively process
sub-key seperated by `.'.
.br
\fBo \fIvalueObjPtr\fR - The value to set for the key.
.br
.RE
.PP
Returns:
.RS 2
TCL_OK or TCL_ERROR.
.RE
'
.SS TclX_KeyedListDelete
.PP
Delete a key value from keyed list.
.PP
Parameters:
.RS 2
\fBo \fIinterp\fR - Error message will be return in result if there is an
error.
.br
\fBo \fIkeylPtr\fR - Keyed list object to update.
.br
\fBo \fIkey\fR - The name of the key to extract. Will recusively process
sub-key seperated by `.'.
.br
.RE
.PP
Returns:
.RS 2
\fBo \fBTCL_OK\fR - If the key was deleted.
.br
\fBo \fBTCL_BREAK\fR - If the key was not found.
.br
\fBo \fBTCL_ERROR\fR - If an error occured.
.br
.RE
'
.SS TclX_KeyedListGetKeys
.PP
Retrieve a list of keyed list keys.
.PP
Parameters:
.RS 2
\fBo \fIinterp\fR - Error message will be return in result if there is an
error.
.br
\fBo \fIkeylPtr\fR - Keyed list object to get key from.
.br
\fBo \fIkey\fR - The name of the key to get the sub keys for. NULL or empty
to retrieve all top level keys.
.br
\fBo \fIlistObjPtrPtr\fR - List object is returned here with key as values.
.RE
.PP
Returns:
.RS 2
\fBo \fBTCL_OK\fR - If the zero or more key where returned.
.br
\fBo \fBTCL_BREAK\fR - If the key was not found.
.br
\fBo \fBTCL_ERROR\fR - If an error occured.
.br
.RE
'
This source diff could not be displayed because it is too large. You can view the blob instead.
.\"
.\" TclXInit.3
.\"
.\" Extended Tcl initialization functions.
.\"----------------------------------------------------------------------------
.\" Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
.\"
.\" Permission to use, copy, modify, and distribute this software and its
.\" documentation for any purpose and without fee is hereby granted, provided
.\" that the above copyright notice appear in all copies. Karl Lehenbauer and
.\" Mark Diekhans make no representations about the suitability of this
.\" software for any purpose. It is provided "as is" without express or
.\" implied warranty.
.\"----------------------------------------------------------------------------
.\" $Id$
.\"----------------------------------------------------------------------------
.\"
.TH "TclXInit" TCL "" "Tcl"
.ad b
.SH NAME
Tclx_Init, Tclxcmd_Init, TclX_Main, Tkx_Init, TkX_Main - Extended Tcl initialization.
'
.SH SYNOPSIS
.nf
.ft CW
-ltclx -ltcl
#include "tclExtend.h"
int
Tclx_Init (Tcl_Interp *interp);
int
Tclxcmd_Init (Tcl_Interp *interp);
int
void
TclX_Main (int argc,
char **argv,
Tcl_AppInitProc *appInitProc);
int
Tkx_Init (Tcl_Interp *interp);
void
TkX_Main (int argc,
char **argv,
Tcl_AppInitProc *appInitProc);
void
TclX_SetAppInfo (int defaultValues,
char *appName,
char *appLongName,
char *appVersion,
int appPatchlevel);
.ft R
.fi
.SH DESCRIPTION
These functions are used to initialize Extended Tcl and applications based
on Extended Tcl. This manual page also discusses various issues and approaches
of integrating TclX into other applications.
'
.SS "Tclx_Init"
.PP
Initializes Extended Tcl, adding the extended command set to the interpreter.
This is called from \fBTcl_AppInit\fR. This function must be called after
the \fBTcl_Init\fR function. In addition to the standard command set, it
enables use of tlib packages libraries and makes the standard TclX library
available.
.PP
Parameters
.RS 2
\fBo \fIinterp\fR - A pointer to the interpreter to add the commands to.
.RE
.PP
Returns:
.RS 2
\fBTCL_OK\fR if all is ok, \fBTCL_ERROR\fR if an error occurred.
.RE
'
.SS "Tclxcmd_Init"
.PP
Add the TclX command set to the interpreter, with the exception of the
TclX library management commands. This is normally called by
\fBTclx_Init\fR and should only be used if you don't want the TclX library
handling.
.PP
Parameters
.RS 2
\fBo \fIinterp\fR - A pointer to the interpreter to add the commands to.
.RE
.PP
Returns:
.RS 2
\fBTCL_OK\fR if all is ok, \fBTCL_ERROR\fR if an error occurred.
.RE
'
.SS TclX_Main
.PP
This function parses the command line according to the TclX shell
specification (Unix shell compatible).
It creates an interpreter and calls the specified function \fBappInitProc\fR
to initialize any application specific commands.
It then either evaluates the command of script specified on the command line
or enters an interactive command loop.
This procedure never returns, it exits the process when it's done. Using
the TclX shell also gives you SIGINT handling in interactive shells.
'
.SS "Tkx_Init"
.PP
Initializes Extended Tcl Tk environment.
This is called from \fBTcl_AppInit\fR after the \fBTk_Init\fR function.
.PP
Parameters
.RS 2
\fBo \fIinterp\fR - A pointer to the interpreter to add the commands to.
.RE
.PP
Returns:
.RS 2
\fBTCL_OK\fR if all is ok, \fBTCL_ERROR\fR if an error occurred.
.RE
'
.SS TkX_Main
.PP
This function parses the command line according to the wish shell
specification.
It creates an interpreter and calls the specified function \fBappInitProc\fR
to initialize any application specific commands.
It then either evaluates the command of script specified on the command line
or enters an interactive command loop.
This procedure never returns, it exits the process when it's done. Using
the TclX wish shell gives you SIGINT handling in interactive shells,
otherwise it is identical to standard wish.
'
.SS TclX_SetAppInfo
.PP
Store the application information returned by infox.
.PP
Parameters
.RS 2
\fBo \fIdefaultValues\fR - If true, then the values are assigned only if they
are not already defined (defaulted). If false, the values are always
set.
.br
\fBo \fIappName\fR - Application symbolic name.
.br
\fBo \fIappLongName\fR - Long, natural language application name.
.br
\fBo \fIappVersion\fR - Version number of the application.
.br
\fBo \fIappPatchlevel\fR - Patch level of the application. If less than
zero, don't change.
.RE
.PP
String pointers are saved without copying, don't release the memory.
If the arguments are NULL, don't change the values.
'
.SH "DYNAMIC LOADING OF TCLX"
.PP
TclX can be dynamically loaded on systems that support shared libraries and
the load command. This can be done using either the \fBload\fR or
the \fBpackage require\fR commands. If \fBpackage require\fR is to be used,
a \fBpkgIndex,tcl\fR must be constructed.
The \fBpkg_mkIndex\fR does not generate a pkgIndex.tcl file that works with
TclX. Instead a command similar to
.sp
.RS 2
.ft CW
package ifneeded Tclx 7.5.0 "load $dir/libtclx.so"
.ft R
.RE
.sp
should be placed in the directory containing the TclX shared library. A
prototype \fBpkgIndex,tcl\fR file is build by TclX and is installed in the
run time directory under the name \fBpkgIndex,proto\fR. This file can't be
used as-is, but should be renamed and copied or combined with an existing
\fBpkgIndex,tcl\fR in the directory containing the shared library.
.PP
There is no need to dynamically load \fBlibtkx.so\fR, since it only contains
support for \fBwishx\fR.
.SH "INTEGRATING TCLX WITH OTHER EXTENSIONS AND APPLICATIONS"
.PP
The main aspects to integrating TclX with into an application is to
decide if the application is based on the standard Tcl/Tk shells or the
TclX shells. If the standard shells are desired, then all that is
necessary is to call \fBTclx_Init\fR after \fBTcl_Init\fR and
\fBTkx_Init\fR after \fBTk_Init\fR. This functionality may also be
dynamically loaded.
.PP
To get the TclX shell in a Tcl only application, with the \fBtcl\fR command
functionality, call \fBTclX_Main\fR from the \fBmain\fR function instead of
\fBTcl_Main\fR.
This shell has arguments conforming to other Unix shells and SIGINT signal
handling when interactive,.
.PP
To get the Tclx shell in a Tk application, with the \fBwishx\fR command
functionality, call \fBTkX_Main\fR from the \fBmain\fR function instead of
\fBTk_Main\fR.
This shell has SIGINT signal handling when interactive,
/*
* tclExtend.h
*
* External declarations for the extended Tcl library.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclExtend.h,v 1.4 2002/09/26 00:19:18 hobbs Exp $
*-----------------------------------------------------------------------------
*/
#ifndef TCLEXTEND_H
#define TCLEXTEND_H
#include <stdio.h>
#include "tcl.h"
/*
* The following is needed on Windows to deal with export/import of DLL
* functions. See tcl???/win/README.
*/
#if defined(BUILD_tclx) || defined(BUILD_TCLX)
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif
/*
* The TCLX_DEBUG flag turns on asserts etc. Its an internal flag, however
* its normally true for alpha and beta release and false for final releases,
* so we put the flag right by the version numbers in hopes that we will
* remember to change it.
#define TCLX_DEBUG
*/
#define TCLX_PATCHLEVEL 0
/*
* Generic void pointer.
*/
typedef void *void_pt;
/*
* Flags to command loop functions.
*/
#define TCLX_CMDL_INTERACTIVE (1<<0)
#define TCLX_CMDL_EXIT_ON_EOF (1<<1)
/*
* Application signal error handler. Called after normal signal processing,
* when a signal results in an error. Its main purpose in life is to allow
* interactive command loops to clear their input buffer on SIGINT. This is
* not currently a generic interface, but should be. Only one maybe active.
* This is an undocumented interface. Its in the external file in case
* someone needs this facility. It might change in the future. Let us
* know if you need this functionality.
*/
typedef int
(*TclX_AppSignalErrorHandler) (Tcl_Interp *interp,
ClientData clientData,
int background,
int signalNum);
/*
* Exported TclX initialization functions.
*/
EXTERN int Tclx_Init (Tcl_Interp *interp);
EXTERN int Tclx_SafeInit (Tcl_Interp *interp);
EXTERN int Tclx_InitStandAlone (Tcl_Interp *interp);
EXTERN void TclX_PrintResult (Tcl_Interp *interp,
int intResult,
char *checkCmd);
EXTERN void TclX_SetupSigInt (void);
EXTERN void TclX_SetAppSignalErrorHandler (
TclX_AppSignalErrorHandler errorFunc, ClientData clientData);
EXTERN void TclX_SetAppInfo (int defaultValues,
char *appName,
char *appLongName,
char *appVersion,
int appPatchlevel);
EXTERN void TclX_SplitWinCmdLine (int *argcPtr, char ***argvPtr);
/*
* Exported utility functions.
*/
EXTERN void TclX_AppendObjResult TCL_VARARGS_DEF(Tcl_Interp *, interpArg);
EXTERN char * TclX_DownShift (char *targetStr, CONST char *sourceStr);
EXTERN int TclX_StrToInt (CONST char *string, int base, int *intPtr);
EXTERN int TclX_StrToUnsigned (CONST char *string,
int base,
unsigned *unsignedPtr);
EXTERN char * TclX_UpShift (char *targetStr,
CONST char *sourceStr);
/*
* Exported keyed list object manipulation functions.
*/
EXTERN Tcl_Obj * TclX_NewKeyedListObj (void);
EXTERN int TclX_KeyedListGet (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj **valuePtrPtr);
EXTERN int TclX_KeyedListSet (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj *valuePtr);
EXTERN int TclX_KeyedListDelete (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key);
EXTERN int TclX_KeyedListGetKeys (Tcl_Interp *interp,
Tcl_Obj *keylPtr,
char *key,
Tcl_Obj **listObjPtrPtr);
/*
* Exported handle table manipulation functions.
*/
EXTERN void_pt TclX_HandleAlloc (void_pt headerPtr,
char *handlePtr);
EXTERN void TclX_HandleFree (void_pt headerPtr,
void_pt entryPtr);
EXTERN void_pt TclX_HandleTblInit (CONST char *handleBase,
int entrySize,
int initEntries);
EXTERN void TclX_HandleTblRelease (void_pt headerPtr);
EXTERN int TclX_HandleTblUseCount (void_pt headerPtr,
int amount);
EXTERN void_pt TclX_HandleWalk (void_pt headerPtr,
int *walkKeyPtr);
EXTERN void TclX_WalkKeyToHandle (void_pt headerPtr,
int walkKey,
char *handlePtr);
EXTERN void_pt TclX_HandleXlate (Tcl_Interp *interp,
void_pt headerPtr,
CONST char *handle);
EXTERN void_pt TclX_HandleXlateObj (Tcl_Interp *interp,
void_pt headerPtr,
Tcl_Obj *handleObj);
/*
* Command loop functions.
*/
EXTERN int TclX_CommandLoop (Tcl_Interp *interp,
int options,
char *endCommand,
char *prompt1,
char *prompt2);
EXTERN int TclX_AsyncCommandLoop (Tcl_Interp *interp,
int options,
char *endCommand,
char *prompt1,
char *prompt2);
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#endif
/* vim: set ts=4 sw=4 sts=4 et : */
/*
* tclXcoalesce.c --
*
* coalesce Tcl commands.
*-----------------------------------------------------------------------------
* Copyright 2017 - 2019 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
*/
#include "tclExtdInt.h"
/*-----------------------------------------------------------------------------
* TclX_CoalesceObjCmd --
* Implements the TCL coalesce command:
* coalesce ?-default value? var ?var...?
*
* Results:
* The value of the first existing variable is returned.
* If no variables exist, the default value is returned.
*
*-----------------------------------------------------------------------------
*/
static int
TclX_CoalesceObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
int i;
Tcl_Obj *val;
int start = 1;
if (objc < 2) {
badargs:
return TclX_WrongArgs (interp, objv [0], "?-default value? var ?var...?");
}
/* is -default specified? if so, handle */
char *first = Tcl_GetString (objv[1]);
if (STREQU (first, "-default")) {
if (objc < 4) goto badargs;
start = 3;
}
/* iterate through the variable list */
for (i = start; i < objc; i++) {
/* if the var exists, return its value */
if ((val = Tcl_ObjGetVar2 (interp, objv [i], NULL, 0)) != NULL) {
Tcl_SetObjResult (interp, val);
return TCL_OK;
}
}
/* none of the vars exist, if no default was specified, return an empty string */
if (start == 1) {
Tcl_SetObjResult (interp, Tcl_NewObj ());
return TCL_OK;
}
/* none of the vars exist and a default was specified, return it*/
Tcl_SetObjResult (interp, objv[start - 1]);
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* TclX_CoalesceInit --
* Initialize the coalesce command.
*-----------------------------------------------------------------------------
*/
void
TclX_CoalesceInit (Tcl_Interp *interp)
{
Tcl_CreateObjCommand (interp,
"coalesce",
TclX_CoalesceObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"tcl::mathfunc::coalesce",
TclX_CoalesceObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
}
/* vim: set ts=4 sw=4 sts=4 et : */
/*
* tclXdup.c
*
* Extended Tcl dup command.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclXdup.c,v 1.2 2002/09/26 00:19:18 hobbs Exp $
*-----------------------------------------------------------------------------
*/
#include "tclExtdInt.h"
/*
* Prototypes of internal functions.
*/
static int
DupChannelOptions (Tcl_Interp *interp,
Tcl_Channel srcChannel,
Tcl_Channel targetChannel);
static Tcl_Channel
DupFileChannel (Tcl_Interp *interp,
char *srcFileId,
char *targetFileId);
static int
TclX_DupObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
/*-----------------------------------------------------------------------------
* DupChannelOptions --
*
* Set the channel options of one channel to those of another.
*
* Parameters:
* o interp (I) - Errors returned in result.
* o srcChannel (I) - Channel to get the options.
* o targetChannel (I) - Channel to set the options on.
* Result:
* TCL_OK or TCL_ERROR;
*-----------------------------------------------------------------------------
*/
static int
DupChannelOptions (Tcl_Interp *interp,
Tcl_Channel srcChannel,
Tcl_Channel targetChannel)
{
Tcl_DString strValues;
const char *option, *value, **optArgv = NULL;
int optArgc, idx;
Tcl_DStringInit (&strValues);
if (Tcl_GetChannelOption (interp, srcChannel, NULL, &strValues) != TCL_OK) {
goto errorExit;
}
/*
* Split the list for each name/value pair and set the new channel.
* Only modify blocking if its not the default, as setting blocking on
* standard files generates an error on some systems. Skip options
* that can't be set.
*/
if (Tcl_SplitList(interp, strValues.string, &optArgc, &optArgv) != TCL_OK) {
goto errorExit;
}
if ((optArgc % 2) != 0) {
panic("channel didn't return keyword/value pairs");
}
for (idx = 0; idx < optArgc; idx += 2) {
option = optArgv[idx];
value = optArgv[idx+1];
if (STREQU (option, "-blocking") && (value [0] != '0')) {
continue;
}
if (STREQU (option, "-peername") || STREQU (option, "-sockname")) {
continue;
}
if (Tcl_SetChannelOption (interp, targetChannel, option,
value) != TCL_OK) {
goto errorExit;
}
}
Tcl_DStringFree (&strValues);
if (optArgv != NULL) {
ckfree((char *)optArgv);
}
return TCL_OK;
errorExit:
Tcl_DStringFree (&strValues);
if (optArgv != NULL) {
ckfree((char *)optArgv);
}
return TCL_ERROR;
}
/*-----------------------------------------------------------------------------
* DupFileChannel --
* Do common work for all platforms for duplicate a channel
*
* Parameters:
* o interp (I) - If an error occures, the error message is in result.
* o srcChannelId (I) - The id of the channel to dup.
* o targetChannelId (I) - The id for the new file. NULL if any id maybe
* used.
* Returns:
* The unregistered channel, or NULL if an error occurs.
*-----------------------------------------------------------------------------
*/
static Tcl_Channel
DupFileChannel (Tcl_Interp *interp, char *srcChannelId, char *targetChannelId)
{
Tcl_Channel srcChannel, newChannel = NULL;
const Tcl_ChannelType *channelType;
int mode;
srcChannel = Tcl_GetChannel (interp, srcChannelId, &mode);
if (srcChannel == NULL) {
return NULL;
}
channelType = Tcl_GetChannelType (srcChannel);
if (STREQU (channelType->typeName, "pipe")) {
TclX_AppendObjResult (interp, "can not \"dup\" a Tcl command ",
"pipeline created with the \"open\" command",
(char *) NULL);
return NULL;
}
/*
* If writable, flush out the buffer.
*/
if (mode & TCL_WRITABLE) {
if (Tcl_Flush (srcChannel) == TCL_ERROR)
goto posixError;
}
/*
* Use OS dependent function to actually dup the channel.
*/
newChannel = TclXOSDupChannel (interp, srcChannel, mode, targetChannelId);
if (newChannel == NULL)
return NULL;
/*
* If the channel is open for reading and seekable, seek the new channel
* to the same position. Tcl_Tell returns -1 if seek is not supported.
*/
if (mode & TCL_READABLE) {
int seekOffset = (int) Tcl_Tell (srcChannel);
if (seekOffset >= 0) {
if (Tcl_Seek (newChannel, seekOffset, SEEK_SET) < 0)
goto posixError;
}
}
if (DupChannelOptions (interp, srcChannel, newChannel) != TCL_OK)
goto errorExit;
return newChannel;
posixError:
Tcl_ResetResult (interp);
TclX_AppendObjResult (interp, "dup of \"", srcChannelId, "\" failed: ",
Tcl_PosixError (interp), (char *) NULL);
errorExit:
if (newChannel != NULL) {
Tcl_Close (NULL, newChannel);
}
return NULL;
}
/*-----------------------------------------------------------------------------
* TclX_DupObjCmd --
* Implements the dup TCL command:
* dup channelId ?targetChannelId?
*-----------------------------------------------------------------------------
*/
static int
TclX_DupObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
Tcl_Channel newChannel;
int bindFnum, fnum;
char *srcChannelId, *targetChannelId;
if ((objc < 2) || (objc > 3)) {
return TclX_WrongArgs (interp, objv [0],
"channelId ?targetChannelId?");
}
/*
* If a number is supplied, bind it to a file handle rather than doing
* a dup.
*/
if (objv [1]->typePtr == Tcl_GetObjType ("int")) {
bindFnum = TRUE;
} else {
srcChannelId = Tcl_GetStringFromObj (objv [1], NULL);
if (ISDIGIT (srcChannelId [0])) {
if (Tcl_ConvertToType (interp, objv [1],
Tcl_GetObjType ("int")) != TCL_OK)
goto badFnum;
bindFnum = TRUE;
} else {
bindFnum = FALSE;
}
}
if (bindFnum) {
if (objc != 2)
goto bind2ndArg;
if (Tcl_GetIntFromObj (interp, objv [1], &fnum) != TCL_OK)
return TCL_ERROR;
newChannel = TclXOSBindOpenFile (interp, fnum);
} else {
if (objc > 2) {
targetChannelId = Tcl_GetStringFromObj (objv [2], NULL);
} else {
targetChannelId = NULL;
}
newChannel = DupFileChannel (interp,
srcChannelId,
targetChannelId);
}
if (newChannel == NULL)
return TCL_ERROR;
Tcl_RegisterChannel (interp, newChannel);
Tcl_SetStringObj (Tcl_GetObjResult (interp),
Tcl_GetChannelName (newChannel), -1);
return TCL_OK;
badFnum:
Tcl_ResetResult (interp);
TclX_AppendObjResult (interp, "invalid integer file number \"",
Tcl_GetStringFromObj (objv [1], NULL),
"\", expected unsigned integer or Tcl file id",
(char *) NULL);
return TCL_ERROR;
bind2ndArg:
TclX_AppendObjResult (interp, "the second argument, targetChannelId, ",
"is not allow when binding a file number to ",
"a Tcl channel", (char *) NULL);
return TCL_ERROR;
}
/*-----------------------------------------------------------------------------
* TclX_DupInit --
* Initialize the dip command in an interpreter.
*
* Parameters:
* o interp - Interpreter to add commandsto.
*-----------------------------------------------------------------------------
*/
void
TclX_DupInit (Tcl_Interp *interp)
{
Tcl_CreateObjCommand (interp,
"dup",
TclX_DupObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
}
/* vim: set ts=4 sw=4 sts=4 et : */
/*
* tclXflock.c
*
* Extended Tcl flock and funlock commands.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclXflock.c,v 8.7 1999/03/31 06:37:44 markd Exp $
*-----------------------------------------------------------------------------
*/
/* FIX: Need to add an interface to F_GETLK */
#include "tclExtdInt.h"
/*
* Prototypes of internal functions.
*/
static int
ParseLockUnlockArgs (Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[],
int argIdx,
TclX_FlockInfo *lockInfoPtr);
static int
TclX_FlockObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
static int
TclX_FunlockObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
/*-----------------------------------------------------------------------------
* ParseLockUnlockArgs --
*
* Parse the positional arguments common to both the flock and funlock
* commands:
* ... fileId ?start? ?length? ?origin?
*
* Parameters:
* o interp - Pointer to the interpreter, errors returned in result.
* o objc - Count of arguments supplied to the comment.
* o objv - Commant argument vector.
* o argIdx - Index of the first common agument to parse.
* o access - Set of TCL_READABLE or TCL_WRITABLE or zero to
* not do error checking.
* o lockInfoPtr - Lock info structure, start, length and whence are
* initialized by this routine. The access and block fields should already
* be filled in.
* Returns:
* TCL_OK or TCL_ERROR.
*-----------------------------------------------------------------------------
*/
static int
ParseLockUnlockArgs (Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[],
int argIdx,
TclX_FlockInfo *lockInfoPtr)
{
lockInfoPtr->start = 0;
lockInfoPtr->len = 0;
lockInfoPtr->whence = 0;
lockInfoPtr->channel = TclX_GetOpenChannelObj (interp, objv [argIdx],
lockInfoPtr->access);
if (lockInfoPtr->channel == NULL)
return TCL_ERROR;
argIdx++;
if ((argIdx < objc) && !TclX_IsNullObj (objv [argIdx])) {
if (TclX_GetOffsetFromObj (interp, objv [argIdx],
&lockInfoPtr->start) != TCL_OK)
return TCL_ERROR;
}
argIdx++;
if ((argIdx < objc) && !TclX_IsNullObj (objv [argIdx])) {
if (TclX_GetOffsetFromObj (interp, objv [argIdx],
&lockInfoPtr->len) != TCL_OK)
return TCL_ERROR;
}
argIdx++;
if (argIdx < objc) {
char *originStr = Tcl_GetStringFromObj (objv [argIdx], NULL);
if (STREQU (originStr, "start")) {
lockInfoPtr->whence = 0;
} else if (STREQU (originStr, "current")) {
lockInfoPtr->whence = 1;
} else if (STREQU (originStr, "end")) {
lockInfoPtr->whence = 2;
} else {
TclX_AppendObjResult (interp, "bad origin \"", originStr,
"\": should be \"start\", \"current\", ",
"or \"end\"", (char *) NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* TclX_FlockCmd --
*
* Implements the `flock' Tcl command:
* flock ?-read|-write? ?-nowait? fileId ?start? ?length? ?origin?
*-----------------------------------------------------------------------------
*/
static int
TclX_FlockObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
int argIdx;
TclX_FlockInfo lockInfo;
if (objc < 2)
goto invalidArgs;
lockInfo.access = 0;
lockInfo.block = TRUE;
/*
* Parse off the options.
*/
for (argIdx = 1; argIdx < objc; argIdx++) {
char *optStr = Tcl_GetStringFromObj (objv [argIdx], NULL);
if (optStr [0] != '-')
break;
if (STREQU (optStr, "-read")) {
lockInfo.access |= TCL_READABLE;
continue;
}
if (STREQU (optStr, "-write")) {
lockInfo.access |= TCL_WRITABLE;
continue;
}
if (STREQU (optStr, "-nowait")) {
lockInfo.block = FALSE;
continue;
}
TclX_AppendObjResult (interp, "invalid option \"", optStr,
"\" expected one of \"-read\", \"-write\", or ",
"\"-nowait\"", (char *) NULL);
return TCL_ERROR;
}
if (lockInfo.access == (TCL_READABLE | TCL_WRITABLE)) {
TclX_AppendObjResult (interp,
"can not specify both \"-read\" and \"-write\"",
(char *) NULL);
return TCL_ERROR;
}
if (lockInfo.access == 0)
lockInfo.access = TCL_WRITABLE;
/*
* Make sure there are enough arguments left and then parse the
* positional ones.
*/
if ((argIdx > objc - 1) || (argIdx < objc - 4))
goto invalidArgs;
if (ParseLockUnlockArgs (interp, objc, objv, argIdx, &lockInfo) != TCL_OK)
return TCL_ERROR;
if (TclXOSFlock (interp, &lockInfo) != TCL_OK)
return TCL_ERROR;
if (!lockInfo.block) {
Tcl_SetBooleanObj (Tcl_GetObjResult (interp),
lockInfo.gotLock);
}
return TCL_OK;
/*
* Code to return error messages.
*/
invalidArgs:
return TclX_WrongArgs (interp, objv [0],
"?-read|-write? ?-nowait? fileId ?start? ?length? ?origin?");
}
/*-----------------------------------------------------------------------------
* TclX_FunlockCmd --
*
* Implements the `funlock' Tcl command:
* funlock fileId ?start? ?length? ?origin?
*-----------------------------------------------------------------------------
*/
static int
TclX_FunlockObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
TclX_FlockInfo lockInfo;
if ((objc < 2) || (objc > 5)) {
return TclX_WrongArgs (interp, objv [0],
"fileId ?start? ?length? ?origin?");
}
lockInfo.access = 0; /* Read or write */
if (ParseLockUnlockArgs (interp, objc, objv, 1, &lockInfo) != TCL_OK)
return TCL_ERROR;
return TclXOSFunlock (interp, &lockInfo);
}
/*-----------------------------------------------------------------------------
* TclX_FlockInit --
* Initialize the flock and funlock command.
*-----------------------------------------------------------------------------
*/
void
TclX_FlockInit (Tcl_Interp *interp)
{
Tcl_CreateObjCommand (interp,
"flock",
TclX_FlockObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
Tcl_CreateObjCommand (interp,
"funlock",
TclX_FunlockObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
}
/* vim: set ts=4 sw=4 sts=4 et : */
/*
* tclXinit.c --
*
* Extended Tcl initialzation and initialization utilitied.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclXinit.c,v 1.3 2002/04/03 02:50:35 hobbs Exp $
*-----------------------------------------------------------------------------
*/
#include "tclExtdInt.h"
/*
* Tcl procedure to search for an init for TclX startup file.
*/
static char initScript[] = "if {[info proc ::tclx::Init]==\"\"} {\n\
namespace eval ::tclx {}\n\
proc ::tclx::Init {} {\n"
#ifdef MAC_TCL
" source -rsrc tclx.tcl\n"
#else
" global tclx_library\n\
tcl_findLibrary tclx " PACKAGE_VERSION " " FULL_VERSION " tclx.tcl TCLX_LIBRARY tclx_library\n"
#endif
" }\n\
}\n\
::tclx::Init";
/*
* Prototypes of internal functions.
*/
static int Tclxcmd_Init (Tcl_Interp *interp);
/*-----------------------------------------------------------------------------
* Tclx_Init --
*
* Initialize all Extended Tcl commands, set auto_path and source the
* Tcl init file.
*-----------------------------------------------------------------------------
*/
int
Tclx_Init (Tcl_Interp *interp)
{
if (Tclx_SafeInit(interp) != TCL_OK) {
return TCL_ERROR;
}
if ((Tcl_EvalEx(interp, initScript, -1,
TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) != TCL_OK)
|| (TclX_LibraryInit(interp) != TCL_OK)) {
Tcl_AddErrorInfo(interp, "\n (in TclX_Init)");
return TCL_ERROR;
}
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* Tclx_SafeInit --
*
* Initialize safe Extended Tcl commands.
*-----------------------------------------------------------------------------
*/
int
Tclx_SafeInit (Tcl_Interp *interp)
{
if (
#ifdef USE_TCL_STUBS
(Tcl_InitStubs(interp, "8.0", 0) == NULL)
#else
(Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL)
#endif
|| (Tclxcmd_Init(interp) != TCL_OK)
|| (Tcl_PkgProvide(interp, "Tclx", PACKAGE_VERSION) != TCL_OK)
) {
Tcl_AddErrorInfo (interp, "\n (in TclX_SafeInit)");
return TCL_ERROR;
}
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* Tclxcmd_Init --
*
* Add the Extended Tcl commands to the specified interpreter (except for
* the library commands that override that standard Tcl procedures). This
* does no other startup.
*-----------------------------------------------------------------------------
*/
static int
Tclxcmd_Init (Tcl_Interp *interp)
{
/*
* These are ok in safe interps.
*/
TclX_SetAppInfo(TRUE, "TclX", "Extended Tcl",
PACKAGE_VERSION, TCLX_PATCHLEVEL);
TclX_BsearchInit (interp);
TclX_CoalesceInit (interp);
TclX_FstatInit (interp);
TclX_FlockInit (interp);
TclX_FilescanInit (interp);
TclX_GeneralInit (interp);
TclX_IdInit (interp);
TclX_KeyedListInit (interp);
TclX_LgetsInit (interp);
TclX_ListInit (interp);
TclX_MathInit (interp);
TclX_ProfileInit (interp);
TclX_SelectInit (interp);
TclX_StringInit (interp);
TclX_ChannelFdInit(interp);
if (!Tcl_IsSafe(interp)) {
/*
* Add these only in trusted interps.
*/
TclX_ChmodInit (interp);
TclX_CmdloopInit (interp);
TclX_DebugInit (interp);
TclX_DupInit (interp);
TclX_FcntlInit (interp);
TclX_FilecmdsInit (interp);
TclX_FstatInit (interp);
TclX_MsgCatInit (interp);
TclX_ProcessInit (interp);
TclX_SignalInit (interp);
TclX_OsCmdsInit (interp);
TclX_PlatformCmdsInit (interp);
TclX_SocketInit (interp);
TclX_ServerInit (interp);
}
return TCL_OK;
}
/* vim: set ts=4 sw=4 sts=4 et : */
/*
* tclXprocess.c --
*
* Tcl command to create and manage processes.
*-----------------------------------------------------------------------------
* Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
*
* Permission to use, copy, modify, and distribute this software and its
* documentation for any purpose and without fee is hereby granted, provided
* that the above copyright notice appear in all copies. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: tclXprocess.c,v 8.11 2001/05/19 16:45:23 andreas_kupries Exp $
*-----------------------------------------------------------------------------
*/
#include "tclExtdInt.h"
/*
* These are needed for wait command even if waitpid is not available.
*/
#ifndef WNOHANG
# define WNOHANG 1
#endif
#ifndef WUNTRACED
# define WUNTRACED 2
#endif
static int
TclX_ExeclObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
static int
TclX_ForkObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
static int
TclX_WaitObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
/*-----------------------------------------------------------------------------
* TclX_ForkObjCmd --
* Implements the TclX fork command:
* fork
*-----------------------------------------------------------------------------
*/
static int
TclX_ForkObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
if (objc != 1)
return TclX_WrongArgs (interp, objv [0], "");
return TclXOSfork (interp, objv [0]);
}
/*-----------------------------------------------------------------------------
* TclX_ExeclObjCmd --
* Implements the TCL execl command:
* execl ?-argv0 ? prog ?argList?
*-----------------------------------------------------------------------------
*/
static int
TclX_ExeclObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
#define STATIC_ARG_SIZE 12
char *staticArgv [STATIC_ARG_SIZE];
char **argList = staticArgv;
int nextArg = 1;
char *argStr;
int argObjc;
Tcl_Obj **argObjv;
char *path, *argv0 = NULL;
int idx, status;
Tcl_DString pathBuf;
status = TCL_ERROR; /* assume the worst */
if (objc < 2)
goto wrongArgs;
argStr = Tcl_GetStringFromObj (objv [nextArg], NULL);
if (STREQU (argStr, "-argv0")) {
nextArg++;
if (nextArg == objc)
goto wrongArgs;
argv0 = Tcl_GetStringFromObj (objv [nextArg++], NULL);
}
if ((nextArg == objc) || (nextArg < objc - 2))
goto wrongArgs;
/*
* Get path or command name.
*/
Tcl_DStringInit (&pathBuf);
path = Tcl_TranslateFileName (interp,
Tcl_GetStringFromObj (objv [nextArg++],
NULL),
&pathBuf);
if (path == NULL)
goto exitPoint;
/*
* If arg list is supplied, split it and build up the arguments to pass.
* otherwise, just supply argv[0]. Must be NULL terminated.
*/
if (nextArg == objc) {
argList [1] = NULL;
} else {
if (Tcl_ListObjGetElements (interp, objv [nextArg++],
&argObjc, &argObjv) != TCL_OK)
goto exitPoint;
if (argObjc > STATIC_ARG_SIZE - 2)
argList = (char **) ckalloc ((argObjc + 1) * sizeof (char **));
for (idx = 0; idx < argObjc; idx++) {
argList [idx + 1] = Tcl_GetStringFromObj (argObjv [idx], NULL);
}
argList [argObjc + 1] = NULL;
}
if (argv0 != NULL) {
argList [0] = argv0;
} else {
argList [0] = path; /* Program name */
}
status = TclXOSexecl (interp, path, argList);
exitPoint:
if (argList != staticArgv)
ckfree ((char *) argList);
Tcl_DStringFree (&pathBuf);
return status;
wrongArgs:
TclX_WrongArgs (interp, objv [0], "?-argv0 argv0? prog ?argList?");
return TCL_ERROR;
}
/*-----------------------------------------------------------------------------
* TclX_WaitObjCmd --
* Implements the TCL wait command:
* wait ?-nohang? ?-untraced? ?-pgroup? ?pid?
*-----------------------------------------------------------------------------
*/
static int
TclX_WaitObjCmd (ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
int idx, options = 0, pgroup = FALSE;
char *argStr;
pid_t returnedPid, pid;
int tmpPid, status;
Tcl_Obj *resultList [3];
for (idx = 1; idx < objc; idx++) {
argStr = Tcl_GetStringFromObj (objv [idx], NULL);
if (argStr [0] != '-')
break;
if (STREQU (argStr, "-nohang")) {
if (options & WNOHANG)
goto usage;
options |= WNOHANG;
continue;
}
if (STREQU (argStr, "-untraced")) {
if (options & WUNTRACED)
goto usage;
options |= WUNTRACED;
continue;
}
if (STREQU (argStr, "-pgroup")) {
if (pgroup)
goto usage;
pgroup = TRUE;
continue;
}
goto usage; /* None match */
}
/*
* Check for more than one non-minus argument. If ok, convert pid,
* if supplied.
*/
if (idx < objc - 1)
goto usage;
if (idx < objc) {
if (Tcl_GetIntFromObj (interp, objv [idx], &tmpPid) != TCL_OK) {
Tcl_ResetResult (interp);
goto invalidPid;
}
if (tmpPid <= 0)
goto negativePid;
pid = tmpPid;
if (pid != tmpPid)
goto invalidPid;
} else {
pid = -1; /* pid or pgroup not supplied */
}
/*
* Versions that don't have real waitpid have limited functionality.
*/
#ifdef NO_WAITPID
if ((options != 0) || pgroup) {
TclX_AppendObjResult (interp, "The \"-nohang\", \"-untraced\" and ",
"\"-pgroup\" options are not available on this ",
"system", (char *) NULL);
return TCL_ERROR;
}
#endif
if (pgroup) {
if (pid > 0)
pid = -pid;
else
pid = 0;
}
returnedPid = (pid_t) TCLX_WAITPID (pid, (int *) (&status), options);
if (returnedPid < 0) {
Tcl_SetErrno(errno);
TclX_AppendObjResult (interp, "wait for process failed: ",
Tcl_PosixError (interp), (char *) NULL);
return TCL_ERROR;
}
/*
* If no process was available, return an empty status. Otherwise return
* a list contain the PID and why it stopped.
*/
if (returnedPid == 0)
return TCL_OK;
resultList [0] = Tcl_NewIntObj (returnedPid);
if (WIFEXITED (status)) {
resultList [1] = Tcl_NewStringObj ("EXIT", -1);
resultList [2] = Tcl_NewIntObj (WEXITSTATUS (status));
} else if (WIFSIGNALED (status)) {
resultList [1] = Tcl_NewStringObj ("SIG", -1);
resultList [2] = Tcl_NewStringObj (Tcl_SignalId (WTERMSIG (status)),
-1);
} else if (WIFSTOPPED (status)) {
resultList [1] = Tcl_NewStringObj ("STOP", -1);
resultList [2] = Tcl_NewStringObj (Tcl_SignalId (WSTOPSIG (status)),
-1);
}
Tcl_SetListObj (Tcl_GetObjResult (interp), 3, resultList);
return TCL_OK;
usage:
TclX_WrongArgs (interp, objv [0], "?-nohang? ?-untraced? ?-pgroup? ?pid?");
return TCL_ERROR;
invalidPid:
TclX_AppendObjResult (interp, "invalid pid or process group id \"",
Tcl_GetStringFromObj (objv [idx], NULL),
"\"", (char *) NULL);
return TCL_ERROR;
negativePid:
TclX_AppendObjResult (interp, "pid or process group id must be greater ",
"than zero", (char *) NULL);
return TCL_ERROR;
}
/*-----------------------------------------------------------------------------
* TclX_ProcessInit --
* Initialize process commands.
*-----------------------------------------------------------------------------
*/
void
TclX_ProcessInit (Tcl_Interp *interp)
{
Tcl_CreateObjCommand (interp,
"execl",
TclX_ExeclObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
/* Avoid conflict with "expect".
*/
TclX_CreateObjCommand (interp,
"fork",
TclX_ForkObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL, 0);
TclX_CreateObjCommand (interp,
"wait",
TclX_WaitObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL, 0);
}
/* vim: set ts=4 sw=4 sts=4 et : */
This source diff could not be displayed because it is too large. You can view the blob instead.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment