Compare commits
4
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a3029fb2a2 | ||
|
|
9ef82f3330 | ||
|
|
0d602bf400 | ||
|
|
f15bba555a |
@@ -4,7 +4,6 @@ compat/zlib/win64/zdll.lib
|
||||
compat/zlib/win64/zlib1.dll
|
||||
compat/zlib/win64/libz.dll.a
|
||||
compat/zlib/zlib.3.pdf
|
||||
tools/empty.zip
|
||||
*.bmp
|
||||
*.gif
|
||||
*.png
|
||||
@@ -1,3 +0,0 @@
|
||||
Important Note
|
||||
==========
|
||||
Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
|
||||
@@ -1,3 +0,0 @@
|
||||
Important Note
|
||||
==========
|
||||
Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
|
||||
@@ -12,6 +12,7 @@
|
||||
Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
|
||||
*/
|
||||
|
||||
|
||||
#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
|
||||
#ifndef __USE_FILE_OFFSET64
|
||||
#define __USE_FILE_OFFSET64
|
||||
@@ -38,7 +39,8 @@
|
||||
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
|
||||
#endif
|
||||
|
||||
#include "tinydir.h"
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
@@ -170,7 +172,6 @@ void do_banner()
|
||||
void do_help()
|
||||
{
|
||||
printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
|
||||
" -r Scan directories recursively\n" \
|
||||
" -o Overwrite existing file.zip\n" \
|
||||
" -a Append to existing file.zip\n" \
|
||||
" -0 Store only\n" \
|
||||
@@ -242,153 +243,12 @@ int isLargeFile(const char* filename)
|
||||
return largeFile;
|
||||
}
|
||||
|
||||
void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
|
||||
FILE * fin;
|
||||
int size_read;
|
||||
const char *savefilenameinzip;
|
||||
zip_fileinfo zi;
|
||||
unsigned long crcFile=0;
|
||||
int zip64 = 0;
|
||||
int err=0;
|
||||
int size_buf=WRITEBUFFERSIZE;
|
||||
unsigned char buf[WRITEBUFFERSIZE];
|
||||
zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
|
||||
zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
|
||||
zi.dosDate = 0;
|
||||
zi.internal_fa = 0;
|
||||
zi.external_fa = 0;
|
||||
filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
|
||||
|
||||
/*
|
||||
err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
|
||||
NULL,0,NULL,0,NULL / * comment * /,
|
||||
(opt_compress_level != 0) ? Z_DEFLATED : 0,
|
||||
opt_compress_level);
|
||||
*/
|
||||
if ((password != NULL) && (err==ZIP_OK))
|
||||
err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
|
||||
|
||||
zip64 = isLargeFile(filenameinzip);
|
||||
|
||||
/* The path name saved, should not include a leading slash. */
|
||||
/*if it did, windows/xp and dynazip couldn't read the zip file. */
|
||||
savefilenameinzip = filenameinzip;
|
||||
while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
|
||||
{
|
||||
savefilenameinzip++;
|
||||
}
|
||||
|
||||
/*should the zip file contain any path at all?*/
|
||||
if( opt_exclude_path )
|
||||
{
|
||||
const char *tmpptr;
|
||||
const char *lastslash = 0;
|
||||
for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
|
||||
{
|
||||
if( *tmpptr == '\\' || *tmpptr == '/')
|
||||
{
|
||||
lastslash = tmpptr;
|
||||
}
|
||||
}
|
||||
if( lastslash != NULL )
|
||||
{
|
||||
savefilenameinzip = lastslash+1; // base filename follows last slash.
|
||||
}
|
||||
}
|
||||
|
||||
/**/
|
||||
err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
|
||||
NULL,0,NULL,0,NULL /* comment*/,
|
||||
(opt_compress_level != 0) ? Z_DEFLATED : 0,
|
||||
opt_compress_level,0,
|
||||
/* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
|
||||
-MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
|
||||
password,crcFile, zip64);
|
||||
|
||||
if (err != ZIP_OK)
|
||||
printf("error in opening %s in zipfile\n",filenameinzip);
|
||||
else
|
||||
{
|
||||
fin = FOPEN_FUNC(filenameinzip,"rb");
|
||||
if (fin==NULL)
|
||||
{
|
||||
err=ZIP_ERRNO;
|
||||
printf("error in opening %s for reading\n",filenameinzip);
|
||||
}
|
||||
}
|
||||
|
||||
if (err == ZIP_OK)
|
||||
do
|
||||
{
|
||||
err = ZIP_OK;
|
||||
size_read = (int)fread(buf,1,size_buf,fin);
|
||||
if (size_read < size_buf)
|
||||
if (feof(fin)==0)
|
||||
{
|
||||
printf("error in reading %s\n",filenameinzip);
|
||||
err = ZIP_ERRNO;
|
||||
}
|
||||
|
||||
if (size_read>0)
|
||||
{
|
||||
err = zipWriteInFileInZip (zf,buf,size_read);
|
||||
if (err<0)
|
||||
{
|
||||
printf("error in writing %s in the zipfile\n",
|
||||
filenameinzip);
|
||||
}
|
||||
|
||||
}
|
||||
} while ((err == ZIP_OK) && (size_read>0));
|
||||
|
||||
if (fin)
|
||||
fclose(fin);
|
||||
|
||||
if (err<0)
|
||||
err=ZIP_ERRNO;
|
||||
else
|
||||
{
|
||||
err = zipCloseFileInZip(zf);
|
||||
if (err!=ZIP_OK)
|
||||
printf("error in closing %s in the zipfile\n",
|
||||
filenameinzip);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
|
||||
tinydir_dir dir;
|
||||
int i;
|
||||
char *newname[512];
|
||||
|
||||
tinydir_open_sorted(&dir, filenameinzip);
|
||||
|
||||
for (i = 0; i < dir.n_files; i++)
|
||||
{
|
||||
tinydir_file file;
|
||||
tinydir_readfile_n(&dir, &file, i);
|
||||
if(strcmp(file.name,".")==0) continue;
|
||||
if(strcmp(file.name,"..")==0) continue;
|
||||
sprintf(newname,"%s/%s",dir.path,file.name);
|
||||
if (file.is_dir)
|
||||
{
|
||||
addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
|
||||
} else {
|
||||
addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
|
||||
}
|
||||
}
|
||||
|
||||
tinydir_close(&dir);
|
||||
}
|
||||
|
||||
|
||||
int main(argc,argv)
|
||||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
int i;
|
||||
int opt_recursive=0;
|
||||
int opt_overwrite=1;
|
||||
int opt_overwrite=0;
|
||||
int opt_compress_level=Z_DEFAULT_COMPRESSION;
|
||||
int opt_exclude_path=0;
|
||||
int zipfilenamearg = 0;
|
||||
@@ -425,8 +285,7 @@ int main(argc,argv)
|
||||
opt_compress_level = c-'0';
|
||||
if ((c=='j') || (c=='J'))
|
||||
opt_exclude_path = 1;
|
||||
if ((c=='r') || (c=='R'))
|
||||
opt_recursive = 1;
|
||||
|
||||
if (((c=='p') || (c=='P')) && (i+1<argc))
|
||||
{
|
||||
password=argv[i+1];
|
||||
@@ -533,14 +392,117 @@ int main(argc,argv)
|
||||
((argv[i][1]=='o') || (argv[i][1]=='O') ||
|
||||
(argv[i][1]=='a') || (argv[i][1]=='A') ||
|
||||
(argv[i][1]=='p') || (argv[i][1]=='P') ||
|
||||
(argv[i][1]=='r') || (argv[i][1]=='R') ||
|
||||
((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
|
||||
(strlen(argv[i]) == 2)))
|
||||
{
|
||||
if(opt_recursive) {
|
||||
addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
|
||||
} else {
|
||||
addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
|
||||
FILE * fin;
|
||||
int size_read;
|
||||
const char* filenameinzip = argv[i];
|
||||
const char *savefilenameinzip;
|
||||
zip_fileinfo zi;
|
||||
unsigned long crcFile=0;
|
||||
int zip64 = 0;
|
||||
|
||||
zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
|
||||
zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
|
||||
zi.dosDate = 0;
|
||||
zi.internal_fa = 0;
|
||||
zi.external_fa = 0;
|
||||
filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
|
||||
|
||||
/*
|
||||
err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
|
||||
NULL,0,NULL,0,NULL / * comment * /,
|
||||
(opt_compress_level != 0) ? Z_DEFLATED : 0,
|
||||
opt_compress_level);
|
||||
*/
|
||||
if ((password != NULL) && (err==ZIP_OK))
|
||||
err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
|
||||
|
||||
zip64 = isLargeFile(filenameinzip);
|
||||
|
||||
/* The path name saved, should not include a leading slash. */
|
||||
/*if it did, windows/xp and dynazip couldn't read the zip file. */
|
||||
savefilenameinzip = filenameinzip;
|
||||
while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
|
||||
{
|
||||
savefilenameinzip++;
|
||||
}
|
||||
|
||||
/*should the zip file contain any path at all?*/
|
||||
if( opt_exclude_path )
|
||||
{
|
||||
const char *tmpptr;
|
||||
const char *lastslash = 0;
|
||||
for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
|
||||
{
|
||||
if( *tmpptr == '\\' || *tmpptr == '/')
|
||||
{
|
||||
lastslash = tmpptr;
|
||||
}
|
||||
}
|
||||
if( lastslash != NULL )
|
||||
{
|
||||
savefilenameinzip = lastslash+1; // base filename follows last slash.
|
||||
}
|
||||
}
|
||||
|
||||
/**/
|
||||
err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
|
||||
NULL,0,NULL,0,NULL /* comment*/,
|
||||
(opt_compress_level != 0) ? Z_DEFLATED : 0,
|
||||
opt_compress_level,0,
|
||||
/* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
|
||||
-MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
|
||||
password,crcFile, zip64);
|
||||
|
||||
if (err != ZIP_OK)
|
||||
printf("error in opening %s in zipfile\n",filenameinzip);
|
||||
else
|
||||
{
|
||||
fin = FOPEN_FUNC(filenameinzip,"rb");
|
||||
if (fin==NULL)
|
||||
{
|
||||
err=ZIP_ERRNO;
|
||||
printf("error in opening %s for reading\n",filenameinzip);
|
||||
}
|
||||
}
|
||||
|
||||
if (err == ZIP_OK)
|
||||
do
|
||||
{
|
||||
err = ZIP_OK;
|
||||
size_read = (int)fread(buf,1,size_buf,fin);
|
||||
if (size_read < size_buf)
|
||||
if (feof(fin)==0)
|
||||
{
|
||||
printf("error in reading %s\n",filenameinzip);
|
||||
err = ZIP_ERRNO;
|
||||
}
|
||||
|
||||
if (size_read>0)
|
||||
{
|
||||
err = zipWriteInFileInZip (zf,buf,size_read);
|
||||
if (err<0)
|
||||
{
|
||||
printf("error in writing %s in the zipfile\n",
|
||||
filenameinzip);
|
||||
}
|
||||
|
||||
}
|
||||
} while ((err == ZIP_OK) && (size_read>0));
|
||||
|
||||
if (fin)
|
||||
fclose(fin);
|
||||
|
||||
if (err<0)
|
||||
err=ZIP_ERRNO;
|
||||
else
|
||||
{
|
||||
err = zipCloseFileInZip(zf);
|
||||
if (err!=ZIP_OK)
|
||||
printf("error in closing %s in the zipfile\n",
|
||||
filenameinzip);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,816 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2013-2017, tinydir authors:
|
||||
- Cong Xu
|
||||
- Lautis Sun
|
||||
- Baudouin Feildel
|
||||
- Andargor <andargor@yahoo.com>
|
||||
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.
|
||||
|
||||
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 COPYRIGHT OWNER 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.
|
||||
*/
|
||||
#ifndef TINYDIR_H
|
||||
#define TINYDIR_H
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#if ((defined _UNICODE) && !(defined UNICODE))
|
||||
#define UNICODE
|
||||
#endif
|
||||
|
||||
#if ((defined UNICODE) && !(defined _UNICODE))
|
||||
#define _UNICODE
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#ifdef _MSC_VER
|
||||
# define WIN32_LEAN_AND_MEAN
|
||||
# include <windows.h>
|
||||
# include <tchar.h>
|
||||
# pragma warning(push)
|
||||
# pragma warning (disable : 4996)
|
||||
#else
|
||||
# include <dirent.h>
|
||||
# include <libgen.h>
|
||||
# include <sys/stat.h>
|
||||
# include <stddef.h>
|
||||
#endif
|
||||
#ifdef __MINGW32__
|
||||
# include <tchar.h>
|
||||
#endif
|
||||
|
||||
|
||||
/* types */
|
||||
|
||||
/* Windows UNICODE wide character support */
|
||||
#if defined _MSC_VER || defined __MINGW32__
|
||||
# define _tinydir_char_t TCHAR
|
||||
# define TINYDIR_STRING(s) _TEXT(s)
|
||||
# define _tinydir_strlen _tcslen
|
||||
# define _tinydir_strcpy _tcscpy
|
||||
# define _tinydir_strcat _tcscat
|
||||
# define _tinydir_strcmp _tcscmp
|
||||
# define _tinydir_strrchr _tcsrchr
|
||||
# define _tinydir_strncmp _tcsncmp
|
||||
#else
|
||||
# define _tinydir_char_t char
|
||||
# define TINYDIR_STRING(s) s
|
||||
# define _tinydir_strlen strlen
|
||||
# define _tinydir_strcpy strcpy
|
||||
# define _tinydir_strcat strcat
|
||||
# define _tinydir_strcmp strcmp
|
||||
# define _tinydir_strrchr strrchr
|
||||
# define _tinydir_strncmp strncmp
|
||||
#endif
|
||||
|
||||
#if (defined _MSC_VER || defined __MINGW32__)
|
||||
# include <windows.h>
|
||||
# define _TINYDIR_PATH_MAX MAX_PATH
|
||||
#elif defined __linux__
|
||||
# include <limits.h>
|
||||
# define _TINYDIR_PATH_MAX PATH_MAX
|
||||
#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
|
||||
# include <sys/param.h>
|
||||
# if defined(BSD)
|
||||
# include <limits.h>
|
||||
# define _TINYDIR_PATH_MAX PATH_MAX
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef _TINYDIR_PATH_MAX
|
||||
#define _TINYDIR_PATH_MAX 4096
|
||||
#endif
|
||||
|
||||
#ifdef _MSC_VER
|
||||
/* extra chars for the "\\*" mask */
|
||||
# define _TINYDIR_PATH_EXTRA 2
|
||||
#else
|
||||
# define _TINYDIR_PATH_EXTRA 0
|
||||
#endif
|
||||
|
||||
#define _TINYDIR_FILENAME_MAX 256
|
||||
|
||||
#if (defined _MSC_VER || defined __MINGW32__)
|
||||
#define _TINYDIR_DRIVE_MAX 3
|
||||
#endif
|
||||
|
||||
#ifdef _MSC_VER
|
||||
# define _TINYDIR_FUNC static __inline
|
||||
#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
|
||||
# define _TINYDIR_FUNC static __inline__
|
||||
#else
|
||||
# define _TINYDIR_FUNC static inline
|
||||
#endif
|
||||
|
||||
/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
|
||||
#ifdef TINYDIR_USE_READDIR_R
|
||||
|
||||
/* readdir_r is a POSIX-only function, and may not be available under various
|
||||
* environments/settings, e.g. MinGW. Use readdir fallback */
|
||||
#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
|
||||
_POSIX_SOURCE
|
||||
# define _TINYDIR_HAS_READDIR_R
|
||||
#endif
|
||||
#if _POSIX_C_SOURCE >= 200112L
|
||||
# define _TINYDIR_HAS_FPATHCONF
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
#if _BSD_SOURCE || _SVID_SOURCE || \
|
||||
(_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
|
||||
# define _TINYDIR_HAS_DIRFD
|
||||
# include <sys/types.h>
|
||||
#endif
|
||||
#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
|
||||
defined _PC_NAME_MAX
|
||||
# define _TINYDIR_USE_FPATHCONF
|
||||
#endif
|
||||
#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
|
||||
!(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
|
||||
# define _TINYDIR_USE_READDIR
|
||||
#endif
|
||||
|
||||
/* Use readdir by default */
|
||||
#else
|
||||
# define _TINYDIR_USE_READDIR
|
||||
#endif
|
||||
|
||||
/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
|
||||
#ifndef _MSC_VER
|
||||
#if (defined __MINGW32__) && (defined _UNICODE)
|
||||
#define _TINYDIR_DIR _WDIR
|
||||
#define _tinydir_dirent _wdirent
|
||||
#define _tinydir_opendir _wopendir
|
||||
#define _tinydir_readdir _wreaddir
|
||||
#define _tinydir_closedir _wclosedir
|
||||
#else
|
||||
#define _TINYDIR_DIR DIR
|
||||
#define _tinydir_dirent dirent
|
||||
#define _tinydir_opendir opendir
|
||||
#define _tinydir_readdir readdir
|
||||
#define _tinydir_closedir closedir
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
|
||||
#if defined(_TINYDIR_MALLOC) && defined(_TINYDIR_FREE)
|
||||
#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
|
||||
#else
|
||||
#error "Either define both alloc and free or none of them!"
|
||||
#endif
|
||||
|
||||
#if !defined(_TINYDIR_MALLOC)
|
||||
#define _TINYDIR_MALLOC(_size) malloc(_size)
|
||||
#define _TINYDIR_FREE(_ptr) free(_ptr)
|
||||
#endif /* !defined(_TINYDIR_MALLOC) */
|
||||
|
||||
typedef struct tinydir_file
|
||||
{
|
||||
_tinydir_char_t path[_TINYDIR_PATH_MAX];
|
||||
_tinydir_char_t name[_TINYDIR_FILENAME_MAX];
|
||||
_tinydir_char_t *extension;
|
||||
int is_dir;
|
||||
int is_reg;
|
||||
|
||||
#ifndef _MSC_VER
|
||||
#ifdef __MINGW32__
|
||||
struct _stat _s;
|
||||
#else
|
||||
struct stat _s;
|
||||
#endif
|
||||
#endif
|
||||
} tinydir_file;
|
||||
|
||||
typedef struct tinydir_dir
|
||||
{
|
||||
_tinydir_char_t path[_TINYDIR_PATH_MAX];
|
||||
int has_next;
|
||||
size_t n_files;
|
||||
|
||||
tinydir_file *_files;
|
||||
#ifdef _MSC_VER
|
||||
HANDLE _h;
|
||||
WIN32_FIND_DATA _f;
|
||||
#else
|
||||
_TINYDIR_DIR *_d;
|
||||
struct _tinydir_dirent *_e;
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
struct _tinydir_dirent *_ep;
|
||||
#endif
|
||||
#endif
|
||||
} tinydir_dir;
|
||||
|
||||
|
||||
/* declarations */
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
|
||||
_TINYDIR_FUNC
|
||||
void tinydir_close(tinydir_dir *dir);
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_next(tinydir_dir *dir);
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
|
||||
_TINYDIR_FUNC
|
||||
void _tinydir_get_ext(tinydir_file *file);
|
||||
_TINYDIR_FUNC
|
||||
int _tinydir_file_cmp(const void *a, const void *b);
|
||||
#ifndef _MSC_VER
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
_TINYDIR_FUNC
|
||||
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
/* definitions*/
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
|
||||
{
|
||||
#ifndef _MSC_VER
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
int error;
|
||||
int size; /* using int size */
|
||||
#endif
|
||||
#else
|
||||
_tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
|
||||
#endif
|
||||
_tinydir_char_t *pathp;
|
||||
|
||||
if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
|
||||
{
|
||||
errno = ENAMETOOLONG;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* initialise dir */
|
||||
dir->_files = NULL;
|
||||
#ifdef _MSC_VER
|
||||
dir->_h = INVALID_HANDLE_VALUE;
|
||||
#else
|
||||
dir->_d = NULL;
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
dir->_ep = NULL;
|
||||
#endif
|
||||
#endif
|
||||
tinydir_close(dir);
|
||||
|
||||
_tinydir_strcpy(dir->path, path);
|
||||
/* Remove trailing slashes */
|
||||
pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
|
||||
while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
|
||||
{
|
||||
*pathp = TINYDIR_STRING('\0');
|
||||
pathp++;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
_tinydir_strcpy(path_buf, dir->path);
|
||||
_tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
|
||||
#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
|
||||
dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
|
||||
#else
|
||||
dir->_h = FindFirstFile(path_buf, &dir->_f);
|
||||
#endif
|
||||
if (dir->_h == INVALID_HANDLE_VALUE)
|
||||
{
|
||||
errno = ENOENT;
|
||||
#else
|
||||
dir->_d = _tinydir_opendir(path);
|
||||
if (dir->_d == NULL)
|
||||
{
|
||||
#endif
|
||||
goto bail;
|
||||
}
|
||||
|
||||
/* read first file */
|
||||
dir->has_next = 1;
|
||||
#ifndef _MSC_VER
|
||||
#ifdef _TINYDIR_USE_READDIR
|
||||
dir->_e = _tinydir_readdir(dir->_d);
|
||||
#else
|
||||
/* allocate dirent buffer for readdir_r */
|
||||
size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
|
||||
if (size == -1) return -1;
|
||||
dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
|
||||
if (dir->_ep == NULL) return -1;
|
||||
|
||||
error = readdir_r(dir->_d, dir->_ep, &dir->_e);
|
||||
if (error != 0) return -1;
|
||||
#endif
|
||||
if (dir->_e == NULL)
|
||||
{
|
||||
dir->has_next = 0;
|
||||
}
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
|
||||
bail:
|
||||
tinydir_close(dir);
|
||||
return -1;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
|
||||
{
|
||||
/* Count the number of files first, to pre-allocate the files array */
|
||||
size_t n_files = 0;
|
||||
if (tinydir_open(dir, path) == -1)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
while (dir->has_next)
|
||||
{
|
||||
n_files++;
|
||||
if (tinydir_next(dir) == -1)
|
||||
{
|
||||
goto bail;
|
||||
}
|
||||
}
|
||||
tinydir_close(dir);
|
||||
|
||||
if (tinydir_open(dir, path) == -1)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
|
||||
dir->n_files = 0;
|
||||
dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
|
||||
if (dir->_files == NULL)
|
||||
{
|
||||
goto bail;
|
||||
}
|
||||
while (dir->has_next)
|
||||
{
|
||||
tinydir_file *p_file;
|
||||
dir->n_files++;
|
||||
|
||||
p_file = &dir->_files[dir->n_files - 1];
|
||||
if (tinydir_readfile(dir, p_file) == -1)
|
||||
{
|
||||
goto bail;
|
||||
}
|
||||
|
||||
if (tinydir_next(dir) == -1)
|
||||
{
|
||||
goto bail;
|
||||
}
|
||||
|
||||
/* Just in case the number of files has changed between the first and
|
||||
second reads, terminate without writing into unallocated memory */
|
||||
if (dir->n_files == n_files)
|
||||
{
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);
|
||||
|
||||
return 0;
|
||||
|
||||
bail:
|
||||
tinydir_close(dir);
|
||||
return -1;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
void tinydir_close(tinydir_dir *dir)
|
||||
{
|
||||
if (dir == NULL)
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
memset(dir->path, 0, sizeof(dir->path));
|
||||
dir->has_next = 0;
|
||||
dir->n_files = 0;
|
||||
_TINYDIR_FREE(dir->_files);
|
||||
dir->_files = NULL;
|
||||
#ifdef _MSC_VER
|
||||
if (dir->_h != INVALID_HANDLE_VALUE)
|
||||
{
|
||||
FindClose(dir->_h);
|
||||
}
|
||||
dir->_h = INVALID_HANDLE_VALUE;
|
||||
#else
|
||||
if (dir->_d)
|
||||
{
|
||||
_tinydir_closedir(dir->_d);
|
||||
}
|
||||
dir->_d = NULL;
|
||||
dir->_e = NULL;
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
_TINYDIR_FREE(dir->_ep);
|
||||
dir->_ep = NULL;
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_next(tinydir_dir *dir)
|
||||
{
|
||||
if (dir == NULL)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
if (!dir->has_next)
|
||||
{
|
||||
errno = ENOENT;
|
||||
return -1;
|
||||
}
|
||||
|
||||
#ifdef _MSC_VER
|
||||
if (FindNextFile(dir->_h, &dir->_f) == 0)
|
||||
#else
|
||||
#ifdef _TINYDIR_USE_READDIR
|
||||
dir->_e = _tinydir_readdir(dir->_d);
|
||||
#else
|
||||
if (dir->_ep == NULL)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
if (dir->_e == NULL)
|
||||
#endif
|
||||
{
|
||||
dir->has_next = 0;
|
||||
#ifdef _MSC_VER
|
||||
if (GetLastError() != ERROR_SUCCESS &&
|
||||
GetLastError() != ERROR_NO_MORE_FILES)
|
||||
{
|
||||
tinydir_close(dir);
|
||||
errno = EIO;
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
|
||||
{
|
||||
if (dir == NULL || file == NULL)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
#ifdef _MSC_VER
|
||||
if (dir->_h == INVALID_HANDLE_VALUE)
|
||||
#else
|
||||
if (dir->_e == NULL)
|
||||
#endif
|
||||
{
|
||||
errno = ENOENT;
|
||||
return -1;
|
||||
}
|
||||
if (_tinydir_strlen(dir->path) +
|
||||
_tinydir_strlen(
|
||||
#ifdef _MSC_VER
|
||||
dir->_f.cFileName
|
||||
#else
|
||||
dir->_e->d_name
|
||||
#endif
|
||||
) + 1 + _TINYDIR_PATH_EXTRA >=
|
||||
_TINYDIR_PATH_MAX)
|
||||
{
|
||||
/* the path for the file will be too long */
|
||||
errno = ENAMETOOLONG;
|
||||
return -1;
|
||||
}
|
||||
if (_tinydir_strlen(
|
||||
#ifdef _MSC_VER
|
||||
dir->_f.cFileName
|
||||
#else
|
||||
dir->_e->d_name
|
||||
#endif
|
||||
) >= _TINYDIR_FILENAME_MAX)
|
||||
{
|
||||
errno = ENAMETOOLONG;
|
||||
return -1;
|
||||
}
|
||||
|
||||
_tinydir_strcpy(file->path, dir->path);
|
||||
_tinydir_strcat(file->path, TINYDIR_STRING("/"));
|
||||
_tinydir_strcpy(file->name,
|
||||
#ifdef _MSC_VER
|
||||
dir->_f.cFileName
|
||||
#else
|
||||
dir->_e->d_name
|
||||
#endif
|
||||
);
|
||||
_tinydir_strcat(file->path, file->name);
|
||||
#ifndef _MSC_VER
|
||||
#ifdef __MINGW32__
|
||||
if (_tstat(
|
||||
#else
|
||||
if (stat(
|
||||
#endif
|
||||
file->path, &file->_s) == -1)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
_tinydir_get_ext(file);
|
||||
|
||||
file->is_dir =
|
||||
#ifdef _MSC_VER
|
||||
!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
|
||||
#else
|
||||
S_ISDIR(file->_s.st_mode);
|
||||
#endif
|
||||
file->is_reg =
|
||||
#ifdef _MSC_VER
|
||||
!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
|
||||
(
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
|
||||
#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
|
||||
#endif
|
||||
#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
|
||||
#endif
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
|
||||
!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
|
||||
#else
|
||||
S_ISREG(file->_s.st_mode);
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
|
||||
{
|
||||
if (dir == NULL || file == NULL)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
if (i >= dir->n_files)
|
||||
{
|
||||
errno = ENOENT;
|
||||
return -1;
|
||||
}
|
||||
|
||||
memcpy(file, &dir->_files[i], sizeof(tinydir_file));
|
||||
_tinydir_get_ext(file);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
|
||||
{
|
||||
_tinydir_char_t path[_TINYDIR_PATH_MAX];
|
||||
if (dir == NULL)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
if (i >= dir->n_files || !dir->_files[i].is_dir)
|
||||
{
|
||||
errno = ENOENT;
|
||||
return -1;
|
||||
}
|
||||
|
||||
_tinydir_strcpy(path, dir->_files[i].path);
|
||||
tinydir_close(dir);
|
||||
if (tinydir_open_sorted(dir, path) == -1)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Open a single file given its path */
|
||||
_TINYDIR_FUNC
|
||||
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
|
||||
{
|
||||
tinydir_dir dir;
|
||||
int result = 0;
|
||||
int found = 0;
|
||||
_tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
|
||||
_tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
|
||||
_tinydir_char_t *dir_name;
|
||||
_tinydir_char_t *base_name;
|
||||
#if (defined _MSC_VER || defined __MINGW32__)
|
||||
_tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
|
||||
_tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
|
||||
#endif
|
||||
|
||||
if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
|
||||
{
|
||||
errno = ENAMETOOLONG;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Get the parent path */
|
||||
#if (defined _MSC_VER || defined __MINGW32__)
|
||||
#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
|
||||
_tsplitpath_s(
|
||||
path,
|
||||
drive_buf, _TINYDIR_DRIVE_MAX,
|
||||
dir_name_buf, _TINYDIR_FILENAME_MAX,
|
||||
file_name_buf, _TINYDIR_FILENAME_MAX,
|
||||
ext_buf, _TINYDIR_FILENAME_MAX);
|
||||
#else
|
||||
_tsplitpath(
|
||||
path,
|
||||
drive_buf,
|
||||
dir_name_buf,
|
||||
file_name_buf,
|
||||
ext_buf);
|
||||
#endif
|
||||
|
||||
/* _splitpath_s not work fine with only filename and widechar support */
|
||||
#ifdef _UNICODE
|
||||
if (drive_buf[0] == L'\xFEFE')
|
||||
drive_buf[0] = '\0';
|
||||
if (dir_name_buf[0] == L'\xFEFE')
|
||||
dir_name_buf[0] = '\0';
|
||||
#endif
|
||||
|
||||
if (errno)
|
||||
{
|
||||
errno = EINVAL;
|
||||
return -1;
|
||||
}
|
||||
/* Emulate the behavior of dirname by returning "." for dir name if it's
|
||||
empty */
|
||||
if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
|
||||
{
|
||||
_tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
|
||||
}
|
||||
/* Concatenate the drive letter and dir name to form full dir name */
|
||||
_tinydir_strcat(drive_buf, dir_name_buf);
|
||||
dir_name = drive_buf;
|
||||
/* Concatenate the file name and extension to form base name */
|
||||
_tinydir_strcat(file_name_buf, ext_buf);
|
||||
base_name = file_name_buf;
|
||||
#else
|
||||
_tinydir_strcpy(dir_name_buf, path);
|
||||
dir_name = dirname(dir_name_buf);
|
||||
_tinydir_strcpy(file_name_buf, path);
|
||||
base_name =basename(file_name_buf);
|
||||
#endif
|
||||
|
||||
/* Open the parent directory */
|
||||
if (tinydir_open(&dir, dir_name) == -1)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Read through the parent directory and look for the file */
|
||||
while (dir.has_next)
|
||||
{
|
||||
if (tinydir_readfile(&dir, file) == -1)
|
||||
{
|
||||
result = -1;
|
||||
goto bail;
|
||||
}
|
||||
if (_tinydir_strcmp(file->name, base_name) == 0)
|
||||
{
|
||||
/* File found */
|
||||
found = 1;
|
||||
break;
|
||||
}
|
||||
tinydir_next(&dir);
|
||||
}
|
||||
if (!found)
|
||||
{
|
||||
result = -1;
|
||||
errno = ENOENT;
|
||||
}
|
||||
|
||||
bail:
|
||||
tinydir_close(&dir);
|
||||
return result;
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
void _tinydir_get_ext(tinydir_file *file)
|
||||
{
|
||||
_tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
|
||||
if (period == NULL)
|
||||
{
|
||||
file->extension = &(file->name[_tinydir_strlen(file->name)]);
|
||||
}
|
||||
else
|
||||
{
|
||||
file->extension = period + 1;
|
||||
}
|
||||
}
|
||||
|
||||
_TINYDIR_FUNC
|
||||
int _tinydir_file_cmp(const void *a, const void *b)
|
||||
{
|
||||
const tinydir_file *fa = (const tinydir_file *)a;
|
||||
const tinydir_file *fb = (const tinydir_file *)b;
|
||||
if (fa->is_dir != fb->is_dir)
|
||||
{
|
||||
return -(fa->is_dir - fb->is_dir);
|
||||
}
|
||||
return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
|
||||
}
|
||||
|
||||
#ifndef _MSC_VER
|
||||
#ifndef _TINYDIR_USE_READDIR
|
||||
/*
|
||||
The following authored by Ben Hutchings <ben@decadent.org.uk>
|
||||
from https://womble.decadent.org.uk/readdir_r-advisory.html
|
||||
*/
|
||||
/* Calculate the required buffer size (in bytes) for directory *
|
||||
* entries read from the given directory handle. Return -1 if this *
|
||||
* this cannot be done. *
|
||||
* *
|
||||
* This code does not trust values of NAME_MAX that are less than *
|
||||
* 255, since some systems (including at least HP-UX) incorrectly *
|
||||
* define it to be a smaller value. */
|
||||
_TINYDIR_FUNC
|
||||
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
|
||||
{
|
||||
long name_max;
|
||||
size_t name_end;
|
||||
/* parameter may be unused */
|
||||
(void)dirp;
|
||||
|
||||
#if defined _TINYDIR_USE_FPATHCONF
|
||||
name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
|
||||
if (name_max == -1)
|
||||
#if defined(NAME_MAX)
|
||||
name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
|
||||
#else
|
||||
return (size_t)(-1);
|
||||
#endif
|
||||
#elif defined(NAME_MAX)
|
||||
name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
|
||||
#else
|
||||
#error "buffer size for readdir_r cannot be determined"
|
||||
#endif
|
||||
name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
|
||||
return (name_end > sizeof(struct _tinydir_dirent) ?
|
||||
name_end : sizeof(struct _tinydir_dirent));
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
# if defined (_MSC_VER)
|
||||
# pragma warning(pop)
|
||||
# endif
|
||||
|
||||
#endif
|
||||
+1
-28
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
|
||||
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -42,14 +42,6 @@ void
|
||||
.sp
|
||||
Tcl_Command
|
||||
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
|
||||
.sp
|
||||
.VS "info cmdtype feature"
|
||||
void
|
||||
\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
|
||||
.sp
|
||||
const char *
|
||||
\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
|
||||
.VE "info cmdtype feature"
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_CmdDeleteProc *deleteProc in/out
|
||||
.AP Tcl_Interp *interp in
|
||||
@@ -73,9 +65,6 @@ Pointer to structure containing various information about a
|
||||
Tcl command.
|
||||
.AP Tcl_Obj *objPtr in
|
||||
Value containing the name of a Tcl command.
|
||||
.AP "const char" *typeName in
|
||||
Indicates the name of the type of command implementation associated
|
||||
with a particular \fIproc\fR, or NULL to break the association.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
@@ -307,22 +296,6 @@ is appended to the value specified by \fIobjPtr\fR.
|
||||
specified by the name in a \fBTcl_Obj\fR.
|
||||
The command name is resolved relative to the current namespace.
|
||||
Returns NULL if the command is not found.
|
||||
.PP
|
||||
.VS "info cmdtype feature"
|
||||
\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
|
||||
\fItypeName\fR argument) with a particular implementation function so that it
|
||||
can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
|
||||
called with a command token that information is wanted for and which returns
|
||||
the name of the type that was registered for the implementation function used
|
||||
for that command. (The lookup functionality is surfaced virtually directly in Tcl via
|
||||
\fBinfo cmdtype\fR.) If there is no function registered for a particular
|
||||
function, the result will be the string literal
|
||||
.QW \fBnative\fR .
|
||||
The registration of a name can be undone by registering a mapping to NULL
|
||||
instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
|
||||
string which was registered, and not a copy; use of a compile-time constant
|
||||
string is \fIstrongly recommended\fR.
|
||||
.VE "info cmdtype feature"
|
||||
.SH "SEE ALSO"
|
||||
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+13
-31
@@ -9,18 +9,18 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
|
||||
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tclOO.h>\fR
|
||||
.sp
|
||||
Tcl_Method
|
||||
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
|
||||
clientData\fR)
|
||||
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
|
||||
methodTypePtr, clientData\fR)
|
||||
.sp
|
||||
Tcl_Method
|
||||
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
|
||||
clientData\fR)
|
||||
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
|
||||
methodTypePtr, clientData\fR)
|
||||
.sp
|
||||
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
|
||||
.sp
|
||||
@@ -35,13 +35,8 @@ Tcl_Object
|
||||
Tcl_Obj *
|
||||
\fBTcl_MethodName\fR(\fImethod\fR)
|
||||
.sp
|
||||
.VS TIP500
|
||||
int
|
||||
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
|
||||
.VE TIP500
|
||||
.sp
|
||||
int
|
||||
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
|
||||
@@ -71,15 +66,10 @@ The class to create the method in.
|
||||
.AP Tcl_Obj *nameObj in
|
||||
The name of the method to create. Should not be NULL unless creating
|
||||
constructors or destructors.
|
||||
.AP int flags in
|
||||
A flag saying (currently) what the visibility of the method is. The supported
|
||||
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
|
||||
for backward compatibility) for an exported method,
|
||||
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
|
||||
compatibility) for a non-exported method,
|
||||
.VS TIP500
|
||||
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
|
||||
.VE TIP500
|
||||
.AP int isPublic in
|
||||
A flag saying what the visibility of the method is. The only supported public
|
||||
values of this flag are 0 for a non-exported method, and 1 for an exported
|
||||
method.
|
||||
.AP Tcl_MethodType *methodTypePtr in
|
||||
A description of the type of the method to create, or the type of method to
|
||||
compare against.
|
||||
@@ -115,12 +105,8 @@ Given a method, the entity that declared it can be found using
|
||||
attached to (or NULL if the method is not attached to any class) and
|
||||
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
|
||||
attached to (or NULL if the method is not attached to an object). The name of
|
||||
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
|
||||
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
|
||||
.VS TIP500
|
||||
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
|
||||
.VE TIP500
|
||||
The type of the method
|
||||
the method can be retrieved with \fBTcl_MethodName\fR and whether the method
|
||||
is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
|
||||
can also be introspected upon to a limited degree; the function
|
||||
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
|
||||
assigning the per-method \fIclientData\fR to the variable pointed to by
|
||||
@@ -131,12 +117,8 @@ Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
|
||||
which
|
||||
create a method attached to a class or an object respectively. In both cases,
|
||||
the \fInameObj\fR argument gives the name of the method to create, the
|
||||
\fIflags\fR argument states whether the method should be exported
|
||||
initially
|
||||
.VS TIP500
|
||||
or be marked as a private method,
|
||||
.VE TIP500
|
||||
the \fImethodTypePtr\fR argument describes the implementation of
|
||||
\fIisPublic\fR argument states whether the method should be exported
|
||||
initially, the \fImethodTypePtr\fR argument describes the implementation of
|
||||
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
|
||||
argument gives some implementation-specific data that is passed on to the
|
||||
implementation of the method when it is called.
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
.\"
|
||||
.\" Copyright (c) 2008 by Kevin B. Kenny.
|
||||
.\" Copyright (c) 2018 by Nathan Coulter.
|
||||
.\" Copyright (c) 2018 by Nathan Coulter.
|
||||
.\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
+1
-12
@@ -7,7 +7,7 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
|
||||
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -21,9 +21,6 @@ void
|
||||
void
|
||||
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
|
||||
.sp
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_PanicProc *panicProc
|
||||
.AP "const char*" format in
|
||||
@@ -57,14 +54,6 @@ message is sent to the debugger in stead. If the windows executable
|
||||
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
|
||||
system dialog box is used to display the panic message.
|
||||
.PP
|
||||
If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
|
||||
and you want to implicitly use the stderr channel of your
|
||||
application's C runtime (in stead of the stderr channel of the
|
||||
C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
|
||||
with \fBTcl_ConsolePanic\fR as its argument. On platforms which
|
||||
only have one C runtime (almost all platforms except Windows)
|
||||
\fBTcl_ConsolePanic\fR is equivalent to NULL.
|
||||
.PP
|
||||
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
|
||||
\fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the
|
||||
type \fBTcl_PanicProc\fR:
|
||||
|
||||
+71
-36
@@ -1,7 +1,6 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
|
||||
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
|
||||
'\" Copyright (c) 2018 Nathan Coulter.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -10,9 +9,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState,
|
||||
Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the
|
||||
state of an an interpreter.
|
||||
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -33,53 +30,91 @@ int
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_InterpState savedPtr
|
||||
.AP Tcl_Interp *interp in
|
||||
The interpreter for the operation.
|
||||
Interpreter for which state should be saved.
|
||||
.AP int status in
|
||||
The return code for the state.
|
||||
Return code value to save as part of interpreter state.
|
||||
.AP Tcl_InterpState state in
|
||||
A token for saved state.
|
||||
Saved state token to be restored or discarded.
|
||||
.AP Tcl_SavedResult *savedPtr in
|
||||
A pointer to storage for saved state.
|
||||
Pointer to location where interpreter result should be saved or restored.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
These routines save the state of an interpreter before a call to a routine such
|
||||
as \fBTcl_Eval\fR, and restore the state afterwards.
|
||||
These routines allows a C procedure to take a snapshot of the current
|
||||
state of an interpreter so that it can be restored after a call
|
||||
to \fBTcl_Eval\fR or some other routine that modifies the interpreter
|
||||
state. There are two triplets of routines meant to work together.
|
||||
.PP
|
||||
\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
|
||||
result of a script, including the resulting value, the return code passed as
|
||||
\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
|
||||
It returns a token for the saved state. The interpreter result is not reset
|
||||
and no interpreter state is changed.
|
||||
The first triplet stores the snapshot of interpreter state in
|
||||
an opaque token returned by \fBTcl_SaveInterpState\fR. That token
|
||||
value may then be passed back to one of \fBTcl_RestoreInterpState\fR
|
||||
or \fBTcl_DiscardInterpState\fR, depending on whether the interp
|
||||
state is to be restored. So long as one of the latter two routines
|
||||
is called, Tcl will take care of memory management.
|
||||
.PP
|
||||
\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
|
||||
returns the \fIstatus\fR originally passed in the corresponding call to
|
||||
\fBTcl_SaveInterpState\fR.
|
||||
The second triplet stores the snapshot of only the interpreter
|
||||
result (not its complete state) in memory allocated by the caller.
|
||||
These routines are passed a pointer to \fBTcl_SavedResult\fR
|
||||
that is used to store enough information to restore the interpreter result.
|
||||
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
|
||||
procedure. These routines do not save the state of any error
|
||||
information in the interpreter (e.g. the \fB\-errorcode\fR or
|
||||
\fB\-errorinfo\fR return options, when an error is in progress).
|
||||
.PP
|
||||
If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
|
||||
to release it. A token used to discard or restore state must not be used
|
||||
again.
|
||||
Because the routines \fBTcl_SaveInterpState\fR,
|
||||
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
|
||||
a superset of the functions provided by the other routines,
|
||||
any new code should only make use of the more powerful routines.
|
||||
The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
|
||||
and \fBTcl_DiscardResult\fR continue to exist only for the sake
|
||||
of existing programs that may already be using them.
|
||||
.PP
|
||||
\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are
|
||||
deprecated. Instead use \fBTcl_SaveInterpState\fR,
|
||||
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more
|
||||
capable.
|
||||
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
|
||||
interpreter state that make up the full result of script evaluation.
|
||||
This include the interpreter result, the return code (passed in
|
||||
as the \fIstatus\fR argument, and any return options, including
|
||||
\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
|
||||
This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
|
||||
The call to \fBTcl_SaveInterpState\fR does not itself change the
|
||||
state of the interpreter. Unlike \fBTcl_SaveResult\fR, it does
|
||||
not reset the interpreter.
|
||||
.PP
|
||||
\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location
|
||||
\fIstatePtr\fR points to and returns the interpreter result to its initial
|
||||
state. It does not save options such as \fB\-errorcode\fR or
|
||||
\fB\-errorinfo\fR.
|
||||
\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
|
||||
previously returned by \fBTcl_SaveInterpState\fR and restores the
|
||||
state of the interp to the state held in that snapshot. The return
|
||||
value of \fBTcl_RestoreInterpState\fR is the status value originally
|
||||
passed to \fBTcl_SaveInterpState\fR when the snapshot token was
|
||||
created.
|
||||
.PP
|
||||
\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and
|
||||
moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is
|
||||
then in an undefined state and must not be used until passed again to
|
||||
\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
|
||||
token previously returned by \fBTcl_SaveInterpState\fR when that
|
||||
snapshot is not to be restored to an interp.
|
||||
.PP
|
||||
The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
|
||||
must eventually be passed to either \fBTcl_RestoreInterpState\fR
|
||||
or \fBTcl_DiscardInterpState\fR to avoid a memory leak. Once
|
||||
the \fBTcl_InterpState\fR token is passed to one of them, the
|
||||
token is no longer valid and should not be used anymore.
|
||||
.PP
|
||||
\fBTcl_SaveResult\fR moves the string and value results
|
||||
of \fIinterp\fR into the location specified by \fIstatePtr\fR.
|
||||
\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
|
||||
leaves the result in its normal empty initialized state.
|
||||
.PP
|
||||
\fBTcl_RestoreResult\fR moves the string and value results from
|
||||
\fIstatePtr\fR back into \fIinterp\fR. Any result or error that was
|
||||
already in the interpreter will be cleared. The \fIstatePtr\fR is left
|
||||
in an uninitialized state and cannot be used until another call to
|
||||
\fBTcl_SaveResult\fR.
|
||||
.PP
|
||||
\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is
|
||||
then in an undefined state and must not be used until passed again to
|
||||
\fBTcl_DiscardResult\fR releases the saved interpreter state
|
||||
stored at \fBstatePtr\fR. The state structure is left in an
|
||||
uninitialized state and cannot be used until another call to
|
||||
\fBTcl_SaveResult\fR.
|
||||
.PP
|
||||
If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to
|
||||
release it.
|
||||
Once \fBTcl_SaveResult\fR is called to save the interpreter
|
||||
result, either \fBTcl_RestoreResult\fR or
|
||||
\fBTcl_DiscardResult\fR must be called to properly clean up the
|
||||
memory associated with the saved state.
|
||||
.SH KEYWORDS
|
||||
result, state, interp
|
||||
|
||||
+2
-3
@@ -37,7 +37,7 @@ Tcl_UniChar *
|
||||
Tcl_UniChar *
|
||||
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
|
||||
.sp
|
||||
int
|
||||
Tcl_UniChar
|
||||
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
|
||||
.sp
|
||||
int
|
||||
@@ -204,8 +204,7 @@ where the caller does not need the length of the unicode string
|
||||
representation.
|
||||
.PP
|
||||
\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
|
||||
value's Unicode representation. If the index is out of range or
|
||||
it references a low surrogate preceded by a high surrogate, it returns -1;
|
||||
value's Unicode representation.
|
||||
.PP
|
||||
\fBTcl_GetRange\fR returns a newly created value comprised of the
|
||||
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
|
||||
|
||||
+3
-3
@@ -13,13 +13,13 @@ Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
int
|
||||
Tcl_UniChar
|
||||
\fBTcl_UniCharToUpper\fR(\fIch\fR)
|
||||
.sp
|
||||
int
|
||||
Tcl_UniChar
|
||||
\fBTcl_UniCharToLower\fR(\fIch\fR)
|
||||
.sp
|
||||
int
|
||||
Tcl_UniChar
|
||||
\fBTcl_UniCharToTitle\fR(\fIch\fR)
|
||||
.sp
|
||||
int
|
||||
|
||||
@@ -63,7 +63,7 @@ const char *
|
||||
const char *
|
||||
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
|
||||
.sp
|
||||
int
|
||||
Tcl_UniChar
|
||||
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
|
||||
.sp
|
||||
const char *
|
||||
@@ -121,8 +121,8 @@ case-insensitive (1).
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
These routines convert between UTF-8 strings and Unicode characters. An
|
||||
Unicode character represented as an unsigned, fixed-size
|
||||
These routines convert between UTF-8 strings and Tcl_UniChars. A
|
||||
Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
|
||||
quantity. A UTF-8 character is a Unicode character represented as
|
||||
a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8
|
||||
sequence consists of a lead byte followed by some number of trail bytes.
|
||||
@@ -130,12 +130,9 @@ sequence consists of a lead byte followed by some number of trail bytes.
|
||||
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
|
||||
represent one Unicode character in the UTF-8 representation.
|
||||
.PP
|
||||
\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
|
||||
\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
|
||||
in starting at \fIbuf\fR. The return value is the number of bytes stored
|
||||
in \fIbuf\fR. If ch is an upper surrogate (range U+D800 - U+DBFF), then
|
||||
the return value will be 0 and nothing will be stored. If you still
|
||||
want to produce UTF-8 output for it (even though knowing it's an illegal
|
||||
code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.
|
||||
in \fIbuf\fR.
|
||||
.PP
|
||||
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
|
||||
and stores it as a Tcl_UniChar in \fI*chPtr\fR. The return value is the
|
||||
@@ -143,9 +140,6 @@ number of bytes read from \fIsrc\fR. The caller must ensure that the
|
||||
source buffer is long enough such that this routine does not run off the
|
||||
end and dereference non-existent or random memory; if the source buffer
|
||||
is known to be null-terminated, this will not happen. If the input is
|
||||
a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the
|
||||
cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR
|
||||
and returns 1. If the input is otherwise
|
||||
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
|
||||
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and
|
||||
0x00ff and return 1.
|
||||
@@ -206,7 +200,7 @@ of \fIlength\fR bytes is long enough to be decoded by
|
||||
\fBTcl_UtfToUniChar\fR, or 0 otherwise. This function does not guarantee
|
||||
that the UTF-8 string is properly formed. This routine is used by
|
||||
procedures that are operating on a byte at a time and need to know if a
|
||||
full Unicode character has been seen.
|
||||
full Tcl_UniChar has been seen.
|
||||
.PP
|
||||
\fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It
|
||||
returns the number of Tcl_UniChars that are represented by the UTF-8 string
|
||||
@@ -214,12 +208,12 @@ returns the number of Tcl_UniChars that are represented by the UTF-8 string
|
||||
length is negative, all bytes up to the first null byte are used.
|
||||
.PP
|
||||
\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It
|
||||
returns a pointer to the first occurrence of the Unicode character \fIch\fR
|
||||
returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
|
||||
in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is
|
||||
considered part of the UTF-8 string.
|
||||
.PP
|
||||
\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It
|
||||
returns a pointer to the last occurrence of the Unicode character \fIch\fR
|
||||
returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
|
||||
in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is
|
||||
considered part of the UTF-8 string.
|
||||
.PP
|
||||
|
||||
@@ -1,77 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2018 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH abstract n 0.3 TclOO "TclOO Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
oo::abstract \- a class that does not allow direct instances of itself
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBoo::abstract\fI method \fR?\fIarg ...\fR?
|
||||
.fi
|
||||
.SH "CLASS HIERARCHY"
|
||||
.nf
|
||||
\fBoo::object\fR
|
||||
\(-> \fBoo::class\fR
|
||||
\(-> \fBoo::abstract\fR
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
Abstract classes are classes that can contain definitions, but which cannot be
|
||||
directly manufactured; they are intended to only ever be inherited from and
|
||||
instantiated indirectly. The characteristic methods of \fBoo::class\fR
|
||||
(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
|
||||
\fBoo::abstract\fR.
|
||||
.PP
|
||||
Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
|
||||
.SS CONSTRUCTOR
|
||||
The \fBoo::abstract\fR class does not define an explicit constructor; this
|
||||
means that it is effectively the same as the constructor of the
|
||||
\fBoo::class\fR class.
|
||||
.SS DESTRUCTOR
|
||||
The \fBoo::abstract\fR class does not define an explicit destructor;
|
||||
destroying an instance of it is just like destroying an ordinary class (and
|
||||
will destroy all its subclasses).
|
||||
.SS "EXPORTED METHODS"
|
||||
The \fBoo::abstract\fR class defines no new exported methods.
|
||||
.SS "NON-EXPORTED METHODS"
|
||||
The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
|
||||
\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This example defines a simple class hierarchy and creates a new instance of
|
||||
it. It then invokes a method of the object before destroying the hierarchy and
|
||||
showing that the destruction is transitive.
|
||||
.PP
|
||||
.CS
|
||||
\fBoo::abstract\fR create fruit {
|
||||
method eat {} {
|
||||
puts "yummy!"
|
||||
}
|
||||
}
|
||||
oo::class create banana {
|
||||
superclass fruit
|
||||
method peel {} {
|
||||
puts "skin now off"
|
||||
}
|
||||
}
|
||||
set b [banana \fBnew\fR]
|
||||
$b peel \fI\(-> prints 'skin now off'\fR
|
||||
$b eat \fI\(-> prints 'yummy!'\fR
|
||||
set f [fruit new] \fI\(-> error 'unknown method "new"...'\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
oo::define(n), oo::object(n)
|
||||
.SH KEYWORDS
|
||||
abstract class, class, metaclass, object
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
+3
-9
@@ -20,11 +20,6 @@ Append all of the \fIvalue\fR arguments to the current value
|
||||
of variable \fIvarName\fR. If \fIvarName\fR does not exist,
|
||||
it is given a value equal to the concatenation of all the
|
||||
\fIvalue\fR arguments.
|
||||
.VS TIP508
|
||||
If \fIvarName\fR indicate an element that does not exist of an array that has
|
||||
a default value set, the concatenation of the default value and all the
|
||||
\fIvalue\fR arguments will be stored in the array element.
|
||||
.VE TIP508
|
||||
The result of this command is the new value stored in variable
|
||||
\fIvarName\fR.
|
||||
This command provides an efficient way to build up long
|
||||
@@ -49,7 +44,6 @@ puts $var
|
||||
concat(n), lappend(n)
|
||||
.SH KEYWORDS
|
||||
append, variable
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
|
||||
+1
-61
@@ -5,7 +5,7 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH array n 8.7 Tcl "Tcl Built-In Commands"
|
||||
.TH array n 8.3 Tcl "Tcl Built-In Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
@@ -36,53 +36,6 @@ with an empty name, since the return value from
|
||||
\fBarray nextelement\fR will not indicate whether the search
|
||||
has been completed.
|
||||
.TP
|
||||
\fBarray default \fIsubcommand arrayName args...\fR
|
||||
.VS TIP508
|
||||
Manages the default value of the array. Arrays initially have no default
|
||||
value, but this command allows you to set one; the default value will be
|
||||
returned when reading from an element of the array \farrayName\fR if the read
|
||||
would otherwise result in an error. Note that this may cause the \fBappend\fR,
|
||||
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
|
||||
relation to non-existing array elements.
|
||||
.RS
|
||||
.PP
|
||||
The \fIsubcommand\fR argument controls what exact operation will be performed
|
||||
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBarray default exists \fIarrayName\fR
|
||||
.VS TIP508
|
||||
This returns a boolean value indicating whether a default value has been set
|
||||
for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
|
||||
not exist. Raises an error if \fIarrayName\fR is an existing variable that is
|
||||
not an array.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBarray default get \fIarrayName\fR
|
||||
.VS TIP508
|
||||
This returns the current default value for the array \fIarrayName\fR. Raises
|
||||
an error if \fIarrayName\fR is an existing variable that is not an array, or
|
||||
if \fIarrayName\fR is an array without a default value.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBarray default set \fIarrayName value\fR
|
||||
.VS TIP508
|
||||
This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
|
||||
Returns the empty string. Raises an error if \fIarrayName\fR is an existing
|
||||
variable that is not an array, or if \fIarrayName\fR is an illegal name for an
|
||||
array. If \fIarrayName\fR does not currently exist, it is created as an empty
|
||||
array as well as having its default value set.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBarray default unset \fIarrayName\fR
|
||||
.VS TIP508
|
||||
This removes the default value for the array \fIarrayName\fR and returns the
|
||||
empty string. Does nothing if \fIarrayName\fR does not have a default
|
||||
value. Raises an error if \fIarrayName\fR is an existing variable that is not
|
||||
an array.
|
||||
.VE TIP508
|
||||
.RE
|
||||
.TP
|
||||
\fBarray donesearch \fIarrayName searchId\fR
|
||||
This command terminates an array search and destroys all the
|
||||
state associated with that search. \fISearchId\fR indicates
|
||||
@@ -94,15 +47,6 @@ been the return value from a previous invocation of
|
||||
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
|
||||
is no variable by that name or if it is a scalar variable.
|
||||
.TP
|
||||
\fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP
|
||||
The first argument is a two element list of variable names for the
|
||||
key and value of each entry in the array. The second argument is the
|
||||
array name to iterate over. The third argument is the body to execute
|
||||
for each key and value returned.
|
||||
The ordering of the returned keys is undefined.
|
||||
If an array element is deleted or a new array element is inserted during
|
||||
the \fIarray for\fP process, the command will terminate with an error.
|
||||
.TP
|
||||
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
|
||||
Returns a list containing pairs of elements. The first
|
||||
element in each pair is the name of an element in \fIarrayName\fR
|
||||
@@ -241,7 +185,3 @@ foreach color [lsort [\fBarray names\fR colorcount]] {
|
||||
list(n), string(n), variable(n), trace(n), foreach(n)
|
||||
.SH KEYWORDS
|
||||
array, element names, search
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
@@ -1,88 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2018 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH callback n 0.3 TclOO "TclOO Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
callback, mymethod \- generate callbacks to methods
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
|
||||
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
The \fBcallback\fR command,
|
||||
'\" Based on notes in the tcllib docs, we know the provenance of mymethod
|
||||
also called \fBmymethod\fR for compatibility with the ooutil and snit packages
|
||||
of Tcllib,
|
||||
and which should only be used from within the context of a call to a method
|
||||
(i.e. inside a method, constructor or destructor body) is used to generate a
|
||||
script fragment that will invoke the method, \fImethodName\fR, on the current
|
||||
object (as reported by \fBself\fR) when executed. Any additional arguments
|
||||
provided will be provided as leading arguments to the callback. The resulting
|
||||
script fragment shall be a proper list.
|
||||
.PP
|
||||
Note that it is up to the caller to ensure that the current object is able to
|
||||
handle the call of \fImethodName\fR; this command does not check that.
|
||||
\fImethodName\fR may refer to any exported or unexported method, but may not
|
||||
refer to a private method as those can only be invoked directly from within
|
||||
methods. If there is no such method present at the point when the callback is
|
||||
invoked, the standard \fBunknown\fR method handler will be called.
|
||||
.SH EXAMPLE
|
||||
This is a simple echo server class. The \fBcallback\fR command is used in two
|
||||
places, to arrange for the incoming socket connections to be handled by the
|
||||
\fIAccept\fR method, and to arrange for the incoming bytes on those
|
||||
connections to be handled by the \fIReceive\fR method.
|
||||
.PP
|
||||
.CS
|
||||
oo::class create EchoServer {
|
||||
variable server clients
|
||||
constructor {port} {
|
||||
set server [socket -server [\fBcallback\fR Accept] $port]
|
||||
set clients {}
|
||||
}
|
||||
destructor {
|
||||
chan close $server
|
||||
foreach client [dict keys $clients] {
|
||||
chan close $client
|
||||
}
|
||||
}
|
||||
|
||||
method Accept {channel clientAddress clientPort} {
|
||||
dict set clients $channel [dict create \e
|
||||
address $clientAddress port $clientPort]
|
||||
chan event $channel readable [\fBcallback\fR Receive $channel]
|
||||
}
|
||||
method Receive {channel} {
|
||||
if {[chan gets $channel line] >= 0} {
|
||||
my echo $channel $line
|
||||
} else {
|
||||
chan close $channel
|
||||
dict unset clients $channel
|
||||
}
|
||||
}
|
||||
|
||||
method echo {channel line} {
|
||||
dict with clients $channel {
|
||||
chan puts $channel \e
|
||||
[format {[%s:%d] %s} $address $port $line]
|
||||
}
|
||||
}
|
||||
}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
|
||||
.SH KEYWORDS
|
||||
callback, object
|
||||
.\" Local Variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
@@ -1,78 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2011-2015 Andreas Kupries
|
||||
'\" Copyright (c) 2018 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH classvariable n 0.3 TclOO "TclOO Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
classvariable \- create link from local variable to variable in class
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
The \fBclassvariable\fR command is available within methods. It takes a series
|
||||
of one or more variable names and makes them available in the method's scope;
|
||||
those variable names must not be qualified and must not refer to array
|
||||
elements. The originating scope for the variables is the namespace of the
|
||||
class that the method was defined by. In other words, the referenced variables
|
||||
are shared between all instances of that class.
|
||||
.PP
|
||||
Note: This command is equivalent to the command \fBtypevariable\fR provided by
|
||||
the snit package in tcllib for approximately the same purpose. If used in a
|
||||
method defined directly on a class instance (e.g., through the
|
||||
\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
|
||||
using:
|
||||
.PP
|
||||
.CS
|
||||
namespace upvar [namespace current] $var $var
|
||||
.CE
|
||||
.PP
|
||||
for each variable listed to \fBclassvariable\fR.
|
||||
.SH EXAMPLE
|
||||
This class counts how many instances of it have been made.
|
||||
.PP
|
||||
.CS
|
||||
oo::class create Counted {
|
||||
initialise {
|
||||
variable count 0
|
||||
}
|
||||
|
||||
variable number
|
||||
constructor {} {
|
||||
\fBclassvariable\fR count
|
||||
set number [incr count]
|
||||
}
|
||||
|
||||
method report {} {
|
||||
\fBclassvariable\fR count
|
||||
puts "This is instance $number of $count"
|
||||
}
|
||||
}
|
||||
|
||||
set a [Counted new]
|
||||
set b [Counted new]
|
||||
$a report
|
||||
\fI\(-> This is instance 1 of 2\fR
|
||||
set c [Counted new]
|
||||
$b report
|
||||
\fI\(-> This is instance 2 of 3\fR
|
||||
$c report
|
||||
\fI\(-> This is instance 3 of 3\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
|
||||
.SH KEYWORDS
|
||||
class, class variable, variable
|
||||
.\" Local Variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
-13
@@ -452,19 +452,6 @@ If this situation occurs, the first occurrence of the time is chosen.
|
||||
(For this reason, it is wise to have the input string contain the
|
||||
time zone when converting local times. This caveat does not apply to
|
||||
UTC times.)
|
||||
.PP
|
||||
If the interpretation of the groups yields an impossible time because
|
||||
a field is out of range, enough of that field's unit will be added to
|
||||
or subtracted from the time to bring it in range. Thus, if attempting to
|
||||
scan or format day 0 of the month, one day will be subtracted from day
|
||||
1 of the month, yielding the last day of the previous month.
|
||||
.PP
|
||||
If the interpretation of the groups yields an impossible time because
|
||||
a Daylight Saving Time change skips over that time, or an ambiguous
|
||||
time because a Daylight Saving Time change skips back so that the clock
|
||||
observes the given time twice, and no time zone specifier (\fB%z\fR
|
||||
or \fB%Z\fR) is present in the format, the time is interpreted as
|
||||
if the clock had not changed.
|
||||
.SH "FORMAT GROUPS"
|
||||
.PP
|
||||
The following format groups are recognized by the \fBclock scan\fR and
|
||||
|
||||
+44
-294
@@ -1,5 +1,5 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2007-2018 Donal K. Fellows
|
||||
'\" Copyright (c) 2007 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -39,27 +39,6 @@ used as the \fIdefScript\fR argument.
|
||||
The following commands are supported in the \fIdefScript\fR for
|
||||
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
|
||||
.TP
|
||||
\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
|
||||
.VS TIP478
|
||||
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
|
||||
omitted) promotes an existing method on the class object to be a class
|
||||
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
|
||||
the \fBmethod\fR definition, below.
|
||||
.RS
|
||||
.PP
|
||||
Class methods can be called on either the class itself or on the instances of
|
||||
that class. When they are called, the current object (see the \fBself\R and
|
||||
\fBmy\fR commands) is the class on which they are called or the class of the
|
||||
instance on which they are called, depending on whether they are called on the
|
||||
class or an instance of the class, respectively. If called on a subclass or
|
||||
instance of the subclass, the current object is the subclass.
|
||||
.PP
|
||||
In a private definition context, the methods as invoked on classes are
|
||||
\fInot\fR private, but the methods as invoked on instances of classes are
|
||||
private.
|
||||
.RE
|
||||
.VE TIP478
|
||||
.TP
|
||||
\fBconstructor\fI argList bodyScript\fR
|
||||
.
|
||||
This creates or updates the constructor for a class. The formal arguments to
|
||||
@@ -71,7 +50,7 @@ being constructed. Within the constructor, the \fBnext\fR command should be
|
||||
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
|
||||
string, the constructor will be deleted.
|
||||
.TP
|
||||
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
|
||||
\fBdeletemethod\fI name\fR ?\fIname ...\fR
|
||||
.
|
||||
This deletes each of the methods called \fIname\fR from a class. The methods
|
||||
must have previously existed in that class. Does not affect the superclasses
|
||||
@@ -103,14 +82,17 @@ by a superclass; subclass exports override superclass visibility, and may in
|
||||
turn be overridden by instances.
|
||||
.TP
|
||||
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of method names that are used to guard whether
|
||||
method call to instances of the class may be called and what the method's
|
||||
results are. Each \fImethodName\fR names a single filtering method (which may
|
||||
be exposed or not exposed); it is not an error for a non-existent method to be
|
||||
named since they may be defined by subclasses.
|
||||
.VS
|
||||
By default, this slot works by appending.
|
||||
.VE
|
||||
.TP
|
||||
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
|
||||
.
|
||||
@@ -123,22 +105,6 @@ fully-qualified, the command will be searched for in each object's namespace,
|
||||
using the instances' namespace's path, or by looking in the global namespace.
|
||||
The method will be exported if \fIname\fR starts with a lower-case letter, and
|
||||
non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private forwarded methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBinitialise\fI script\fR
|
||||
.TP
|
||||
\fBinitialize\fI script\fR
|
||||
.VS TIP478
|
||||
This evaluates \fIscript\fR in a context which supports local variables and
|
||||
where the current namespace is the instance namespace of the class object
|
||||
itself. This is useful for setting up, e.g., class-scoped variables.
|
||||
.VE TIP478
|
||||
.TP
|
||||
\fBmethod\fI name argList bodyScript\fR
|
||||
.
|
||||
@@ -151,40 +117,17 @@ be a namespace that is unique to the current object. The method will be
|
||||
exported if \fIname\fR starts with a lower-case letter, and non-exported
|
||||
otherwise; this behavior can be overridden via \fBexport\fR and
|
||||
\fBunexport\fR.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private procedure-like methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of additional classes that are to be mixed into
|
||||
all the instances of the class being defined. Each \fIclassName\fR argument
|
||||
names a single class that is to be mixed in.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.TP
|
||||
\fBprivate \fIcmd arg...\fR
|
||||
.TP
|
||||
\fBprivate \fIscript\fR
|
||||
.
|
||||
.VS TIP500
|
||||
This evaluates the \fIscript\fR (or the list of command and arguments given by
|
||||
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
|
||||
current class will be private definitions.
|
||||
.RS
|
||||
.PP
|
||||
The following class definition commands are affected by \fBprivate\fR:
|
||||
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
|
||||
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
|
||||
definition context is just a private definition context. All other definition
|
||||
commands have no difference in behavior when used in a private definition
|
||||
context.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.VE
|
||||
.TP
|
||||
\fBrenamemethod\fI fromName toName\fR
|
||||
.
|
||||
@@ -216,23 +159,21 @@ operates identically to
|
||||
If no arguments at all are used, this gives the name of the class currently
|
||||
being configured.
|
||||
.VE TIP470
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), the definitions on the class object will also be made in a private
|
||||
definition context.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
allows the alteration of the superclasses of the class being defined.
|
||||
Each \fIclassName\fR argument names one class that is to be a superclass of
|
||||
the defined class. Note that objects must not be changed from being classes to
|
||||
being non-classes or vice-versa, that an empty parent class is equivalent to
|
||||
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
|
||||
\fBoo::class\fR may not be modified.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.VE
|
||||
.TP
|
||||
\fBunexport\fI name \fR?\fIname ...\fR?
|
||||
.
|
||||
@@ -244,31 +185,18 @@ actually defined by a superclass; subclass unexports override superclass
|
||||
visibility, and may be overridden by instance unexports.
|
||||
.TP
|
||||
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
|
||||
variables to be automatically made
|
||||
available in the methods, constructor and destructor declared by the class
|
||||
being defined. Each variable name must not have any namespace
|
||||
separators and must not look like an array access. All variables will be
|
||||
actually present in the namespace of the instance object on which the method
|
||||
is executed. Note
|
||||
actually present in the instance object on which the method is executed. Note
|
||||
that the variable lists declared by a superclass or subclass are completely
|
||||
disjoint, as are variable lists declared by instances; the list of variable
|
||||
names is just for methods (and constructors and destructors) declared by this
|
||||
class. By default, this slot works by appending.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this slot manipulates the list of private variable bindings for this
|
||||
class. In a private variable binding, the name of the variable within the
|
||||
instance object is different to the name given in the definition; the name
|
||||
used in the definition is the name that you use to access the variable within
|
||||
the methods of this class, and the name of the variable in the instance
|
||||
namespace has a unique prefix that makes accidental use from other classes
|
||||
extremely unlikely.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE
|
||||
.SS "CONFIGURING OBJECTS"
|
||||
.PP
|
||||
The following commands are supported in the \fIdefScript\fR for
|
||||
@@ -295,15 +223,18 @@ being defined. Note that the methods themselves may be actually defined by a
|
||||
class or superclass; object exports override class visibility.
|
||||
.TP
|
||||
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of method names that are used to guard whether a
|
||||
method call to the object may be called and what the method's results are.
|
||||
Each \fImethodName\fR names a single filtering method (which may be exposed or
|
||||
not exposed); it is not an error for a non-existent method to be named. Note
|
||||
that the actual list of filters also depends on the filters set upon any
|
||||
classes that the object is an instance of.
|
||||
.VS
|
||||
By default, this slot works by appending.
|
||||
.VE
|
||||
.TP
|
||||
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
|
||||
.
|
||||
@@ -313,13 +244,6 @@ additional arguments, \fIarg\fR etc., added before those arguments specified
|
||||
by the caller of the method. Forwarded methods should be deleted using the
|
||||
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
|
||||
a lower-case letter, and non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private forwarded methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmethod\fI name argList bodyScript\fR
|
||||
.
|
||||
@@ -330,38 +254,17 @@ method will be \fIbodyScript\fR. When the body of the method is evaluated, the
|
||||
current namespace of the method will be a namespace that is unique to the
|
||||
object. The method will be exported if \fIname\fR starts with a lower-case
|
||||
letter, and non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private procedure-like methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates a per-object list of additional classes that are to be
|
||||
mixed into the object. Each argument, \fIclassName\fR, names a single class
|
||||
that is to be mixed in.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.TP
|
||||
\fBprivate \fIcmd arg...\fR
|
||||
.TP
|
||||
\fBprivate \fIscript\fR
|
||||
.VS TIP500
|
||||
This evaluates the \fIscript\fR (or the list of command and arguments given by
|
||||
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
|
||||
current object will be private definitions.
|
||||
.RS
|
||||
.PP
|
||||
The following class definition commands are affected by \fBprivate\fR:
|
||||
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
|
||||
\fBprivate\fR has no cumulative effect; the innermost definition context is
|
||||
just a private definition context. All other definition commands have no
|
||||
difference in behavior when used in a private definition context.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.VE
|
||||
.TP
|
||||
\fBrenamemethod\fI fromName toName\fR
|
||||
.
|
||||
@@ -372,6 +275,7 @@ that the object is an instance of. Does not change the export status of the
|
||||
method; if it was exported before, it will be afterwards.
|
||||
.TP
|
||||
\fBself \fR
|
||||
.
|
||||
.VS TIP470
|
||||
This gives the name of the object currently being configured.
|
||||
.VE TIP470
|
||||
@@ -385,70 +289,36 @@ object being defined. Note that the methods themselves may be actually defined
|
||||
by a class; instance unexports override class visibility.
|
||||
.TP
|
||||
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
|
||||
.
|
||||
.VS
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
|
||||
variables to be automatically made available in the methods declared by the
|
||||
object being defined. Each variable name must not have any namespace
|
||||
separators and must not look like an array access. All variables will be
|
||||
actually present in the namespace of the object on which the method is
|
||||
executed. Note that the
|
||||
actually present in the object on which the method is executed. Note that the
|
||||
variable lists declared by the classes and mixins of which the object is an
|
||||
instance are completely disjoint; the list of variable names is just for
|
||||
methods declared by this object. By default, this slot works by appending.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this slot manipulates the list of private variable bindings for this
|
||||
object. In a private variable binding, the name of the variable within the
|
||||
instance object is different to the name given in the definition; the name
|
||||
used in the definition is the name that you use to access the variable within
|
||||
the methods of this instance object, and the name of the variable in the
|
||||
instance namespace has a unique prefix that makes accidental use from
|
||||
superclass methods extremely unlikely.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.SH "PRIVATE METHODS"
|
||||
.VS TIP500
|
||||
When a class or instance has a private method, that private method can only be
|
||||
invoked from within methods of that class or instance. Other callers of the
|
||||
object's methods \fIcannot\fR invoke private methods, it is as if the private
|
||||
methods do not exist. However, a private method of a class \fIcan\fR be
|
||||
invoked from the class's methods when those methods are being used on another
|
||||
instance object; this means that a class can use them to coordinate behaviour
|
||||
between several instances of itself without interfering with how other
|
||||
classes (especially either subclasses or superclasses) interact. Private
|
||||
methods precede all mixed in classes in the method call order (as reported by
|
||||
\fBself call\fR).
|
||||
.VE TIP500
|
||||
.SH "SLOTTED DEFINITIONS"
|
||||
Some of the configurable definitions of a class or object are \fIslotted
|
||||
definitions\fR. This means that the configuration is implemented by a slot
|
||||
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
|
||||
of values (class names, variable names, etc.) that comprises the contents of
|
||||
the slot. The class defines five operations (as methods) that may be done on
|
||||
the slot. The class defines three operations (as methods) that may be done on
|
||||
the slot:
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
|
||||
.
|
||||
.VS
|
||||
This appends the given \fImember\fR elements to the slot definition.
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-clear\fR
|
||||
.
|
||||
.VS
|
||||
This sets the slot definition to the empty list.
|
||||
.TP
|
||||
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
|
||||
.VS TIP516
|
||||
This prepends the given \fImember\fR elements to the slot definition.
|
||||
.VE TIP516
|
||||
.TP
|
||||
\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
|
||||
.VS TIP516
|
||||
This removes the given \fImember\fR elements from the slot definition.
|
||||
.VE TIP516
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
|
||||
.
|
||||
.VS
|
||||
This replaces the slot definition with the given \fImember\fR elements.
|
||||
.PP
|
||||
A consequence of this is that any use of a slot's default operation where the
|
||||
@@ -461,55 +331,20 @@ which is forwarded to the default operation of the slot (thus, for the class
|
||||
slot, this is forwarded to
|
||||
.QW "\fBmy \-append\fR" ),
|
||||
and these methods which provide the implementation interface:
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fBGet\fR
|
||||
.
|
||||
Returns a list that is the current contents of the slot, but does not modify
|
||||
the slot. This method must always be called from a stack frame created by a
|
||||
call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
|
||||
return an error unless it is called from outside a definition context or with
|
||||
the wrong number of arguments.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP516
|
||||
The elements of the list should be fully resolved, if that is a meaningful
|
||||
concept to the slot.
|
||||
.VE TIP516
|
||||
.RE
|
||||
.TP
|
||||
\fIslot\fR \fBResolve\fR \fIslotElement\fR
|
||||
.VS TIP516
|
||||
Returns \fIslotElement\fR with a resolution operation applied to it, but does
|
||||
not modify the slot. For slots of simple strings, this is an operation that
|
||||
does nothing, whereas for slots of classes, this maps a class name to its
|
||||
fully-qualified class name. This method must always be called from a stack
|
||||
frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR. This
|
||||
method \fIshould not\fR return an error unless it is called from outside a
|
||||
definition context or with the wrong number of arguments; unresolvable
|
||||
arguments should be returned as is (as not all slot operations strictly
|
||||
require that values are resolvable to work).
|
||||
.RS
|
||||
.PP
|
||||
Implementations \fIshould not\fR enforce uniqueness and ordering constraints
|
||||
in this method; that is the responsibility of the \fBSet\fR method.
|
||||
.RE
|
||||
.VE TIP516
|
||||
.VS
|
||||
Returns a list that is the current contents of the slot. This method must
|
||||
always be called from a stack frame created by a call to \fBoo::define\fR or
|
||||
\fBoo::objdefine\fR.
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fBSet \fIelementList\fR
|
||||
.
|
||||
.VS
|
||||
Sets the contents of the slot to the list \fIelementList\fR and returns the
|
||||
empty string. This method must always be called from a stack frame created by
|
||||
a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an
|
||||
error if it rejects the change to the slot contents (e.g., because of invalid
|
||||
values) as well as if it is called from outside a definition context or with
|
||||
the wrong number of arguments.
|
||||
.RS
|
||||
.PP
|
||||
This method \fImay\fR reorder and filter the elements if this is necessary in
|
||||
order to satisfy the underlying constraints of the slot. (For example, slots
|
||||
of classes enforce a uniqueness constraint that places each element in the
|
||||
earliest location in the slot that it can.)
|
||||
.RE
|
||||
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
|
||||
.PP
|
||||
The implementation of these methods is slot-dependent (and responsible for
|
||||
accessing the correct part of the class or object definition). Slots also have
|
||||
@@ -517,14 +352,7 @@ an unknown method handler to tie all these pieces together, and they hide
|
||||
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
|
||||
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
|
||||
defining new operations whose names start with a hyphen.
|
||||
.PP
|
||||
.VS TIP516
|
||||
Most slot operations will initially \fBResolve\fR their argument list, combine
|
||||
it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
|
||||
Some operations omit one or both of the first two steps; omitting the third
|
||||
would result in an idempotent read-only operation (but the standard mechanism
|
||||
for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
|
||||
.VE TIP516
|
||||
.VE
|
||||
.SH EXAMPLES
|
||||
This example demonstrates how to use both forms of the \fBoo::define\fR and
|
||||
\fBoo::objdefine\fR commands (they work in the same way), as well as
|
||||
@@ -581,84 +409,6 @@ oo::class create B {
|
||||
inst m1 \fI\(-> prints "red brick"\fR
|
||||
inst m2 \fI\(-> prints "blue brick"\fR
|
||||
.CE
|
||||
.PP
|
||||
.VS TIP478
|
||||
This example shows how to create and use class variables. It is a class that
|
||||
counts how many instances of itself have been made.
|
||||
.PP
|
||||
.CS
|
||||
oo::class create Counted
|
||||
\fBoo::define\fR Counted {
|
||||
\fBinitialise\fR {
|
||||
variable count 0
|
||||
}
|
||||
|
||||
\fBvariable\fR number
|
||||
\fBconstructor\fR {} {
|
||||
classvariable count
|
||||
set number [incr count]
|
||||
}
|
||||
|
||||
\fBmethod\fR report {} {
|
||||
classvariable count
|
||||
puts "This is instance $number of $count"
|
||||
}
|
||||
}
|
||||
|
||||
set a [Counted new]
|
||||
set b [Counted new]
|
||||
$a report
|
||||
\fI\(-> This is instance 1 of 2\fR
|
||||
set c [Counted new]
|
||||
$b report
|
||||
\fI\(-> This is instance 2 of 3\fR
|
||||
$c report
|
||||
\fI\(-> This is instance 3 of 3\fR
|
||||
.CE
|
||||
.PP
|
||||
This example demonstrates how to use class methods. (Note that the constructor
|
||||
for \fBoo::class\fR calls \fBoo::define\fR on the class.)
|
||||
.PP
|
||||
.CS
|
||||
oo::class create DBTable {
|
||||
\fBclassmethod\fR find {description} {
|
||||
puts "DB: locate row from [self] matching $description"
|
||||
return [my new]
|
||||
}
|
||||
\fBclassmethod\fR insert {description} {
|
||||
puts "DB: create row in [self] matching $description"
|
||||
return [my new]
|
||||
}
|
||||
\fBmethod\fR update {description} {
|
||||
puts "DB: update row [self] with $description"
|
||||
}
|
||||
\fBmethod\fR delete {} {
|
||||
puts "DB: delete row [self]"
|
||||
my destroy; # Just delete the object, not the DB row
|
||||
}
|
||||
}
|
||||
|
||||
oo::class create Users {
|
||||
\fBsuperclass\fR DBTable
|
||||
}
|
||||
oo::class create Groups {
|
||||
\fBsuperclass\fR DBTable
|
||||
}
|
||||
|
||||
set u1 [Users insert "username=abc"]
|
||||
\fI\(-> DB: create row from ::Users matching username=abc\fR
|
||||
set u2 [Users insert "username=def"]
|
||||
\fI\(-> DB: create row from ::Users matching username=def\fR
|
||||
$u2 update "group=NULL"
|
||||
\fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
|
||||
$u1 delete
|
||||
\fI\(-> DB: delete row ::oo::Obj123\fR
|
||||
set g [Group find "groupname=webadmins"]
|
||||
\fI\(-> DB: locate row ::Group with groupname=webadmins\fR
|
||||
$g update "emailaddress=admins"
|
||||
\fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
|
||||
.CE
|
||||
.VE TIP478
|
||||
.SH "SEE ALSO"
|
||||
next(n), oo::class(n), oo::object(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
-35
@@ -27,11 +27,6 @@ key maps to in the dictionary value contained in the given variable,
|
||||
writing the resulting dictionary value back to that variable.
|
||||
Non-existent keys are treated as if they map to an empty string. The
|
||||
updated dictionary value is returned.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the appending operation.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBdict create \fR?\fIkey value ...\fR?
|
||||
.
|
||||
@@ -129,11 +124,6 @@ resulting dictionary value back to that variable. Non-existent keys
|
||||
are treated as if they map to 0. It is an error to increment a value
|
||||
for an existing key if that value is not an integer. The updated
|
||||
dictionary value is returned.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the incrementing operation.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBdict info \fIdictionaryValue\fR
|
||||
.
|
||||
@@ -159,11 +149,6 @@ keys are treated as if they map to an empty list, and it is legal for
|
||||
there to be no items to append to the list. It is an error for the
|
||||
value that the key maps to to not be representable as a list. The
|
||||
updated dictionary value is returned.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the list-appending operation.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
|
||||
.
|
||||
@@ -221,11 +206,6 @@ value and places an updated dictionary value in that variable
|
||||
containing a mapping from the given key to the given value. When
|
||||
multiple keys are present, this operation creates or updates a chain
|
||||
of nested dictionaries. The updated dictionary value is returned.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the value insert/update operation.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBdict size \fIdictionaryValue\fR
|
||||
.
|
||||
@@ -241,11 +221,6 @@ through nested dictionaries to the mapping to remove. At least one key
|
||||
must be specified, but the last key on the key-path need not exist.
|
||||
All other components on the path must exist. The updated dictionary
|
||||
value is returned.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the value remove operation.
|
||||
.VE TIP508
|
||||
.TP
|
||||
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
|
||||
.
|
||||
@@ -261,11 +236,6 @@ are silently discarded), even if the result of \fIbody\fR is an error
|
||||
or some other kind of exceptional exit. The result of \fBdict
|
||||
update\fR is (unless some kind of error occurs) the result of the
|
||||
evaluation of \fIbody\fR.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the update operation.
|
||||
.VE TIP508
|
||||
.RS
|
||||
.PP
|
||||
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
|
||||
@@ -300,11 +270,6 @@ dictionary be discarded, and this also happens if the contents of
|
||||
dictionaries no longer exists. The result of \fBdict with\fR is
|
||||
(unless some kind of error occurs) the result of the evaluation of
|
||||
\fIbody\fR.
|
||||
.VS TIP508
|
||||
If \fIdictionaryVarable\fR indicates an element that does not exist of an
|
||||
array that has a default value set, the default value and will be used as the
|
||||
value of the dictionary prior to the updating operation.
|
||||
.VE TIP508
|
||||
.RS
|
||||
.PP
|
||||
The variables are mapped in the scope enclosing the \fBdict with\fR;
|
||||
|
||||
+2
-2
@@ -38,8 +38,8 @@ Performs one of several encoding related operations, depending on
|
||||
.
|
||||
Convert \fIdata\fR to Unicode from the specified \fIencoding\fR. The
|
||||
characters in \fIdata\fR are treated as binary data where the lower
|
||||
8-bits of each character is taken as a single byte. The resulting
|
||||
sequence of bytes is treated as a string in the specified
|
||||
8-bits of each character is taken as a single byte. This binary data
|
||||
is decoded as a string in the specified
|
||||
\fIencoding\fR. If \fIencoding\fR is not specified, the current
|
||||
system encoding is used.
|
||||
.TP
|
||||
|
||||
-17
@@ -217,19 +217,6 @@ information is instead sent to the console, if one is present, or is
|
||||
discarded.
|
||||
.RS
|
||||
.PP
|
||||
Note that the current escape resp. quoting of arguments for windows works only
|
||||
with executables using CommandLineToArgv, CRT-library or similar, as well as
|
||||
with the windows batch files (excepting the newline, see below).
|
||||
Although it is the common escape algorithm, but, in fact, the way how the
|
||||
executable parses the command-line (resp. splits it into single arguments)
|
||||
is decisive.
|
||||
.PP
|
||||
Unfortunately, there is currently no way to supply newline character within
|
||||
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
|
||||
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
|
||||
(also the argument chain) on the first newline character.
|
||||
But it works properly with an executable (using CommandLineToArgv, etc).
|
||||
.PP
|
||||
The Tk console text widget does not provide real standard IO capabilities.
|
||||
Under Tk, when redirecting from standard input, all applications will see an
|
||||
immediate end-of-file; information redirected to standard output or standard
|
||||
@@ -422,10 +409,6 @@ that sometimes pop up:
|
||||
With the file \fIcmp.bat\fR looking something like:
|
||||
.PP
|
||||
.CS
|
||||
@gcc %*
|
||||
.CE
|
||||
or like another variant using single parameters:
|
||||
.CS
|
||||
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
|
||||
.CE
|
||||
.SS "WORKING WITH COMMAND BUILT-INS"
|
||||
|
||||
+9
-177
@@ -6,14 +6,14 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "http" n 2.9 http "Tcl Bundled Packages"
|
||||
.TH "http" n 2.7 http "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.SH SYNOPSIS
|
||||
\fBpackage require http ?2.8?\fR
|
||||
\fBpackage require http ?2.7?\fR
|
||||
.\" See Also -useragent option documentation in body!
|
||||
.sp
|
||||
\fB::http::config ?\fI\-option value\fR ...?
|
||||
@@ -22,8 +22,6 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
|
||||
.sp
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.sp
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.sp
|
||||
\fB::http::wait \fItoken\fR
|
||||
@@ -46,14 +44,12 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::register \fIproto port command\fR
|
||||
.sp
|
||||
\fB::http::registerError \fIport\fR ?\fImessage\fR?
|
||||
.sp
|
||||
\fB::http::unregister \fIproto\fR
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBhttp\fR package provides the client side of the HTTP/1.1
|
||||
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
|
||||
protocol, as defined in RFC 2616.
|
||||
The package implements the GET, POST, and HEAD operations
|
||||
of HTTP/1.1. It allows configuration of a proxy host to get through
|
||||
firewalls. The package is compatible with the \fBSafesock\fR security
|
||||
@@ -99,19 +95,6 @@ comma-separated list of mime type patterns that you are
|
||||
willing to receive. For example,
|
||||
.QW "image/gif, image/jpeg, text/*" .
|
||||
.TP
|
||||
\fB\-pipeline\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether HTTP/1.1 transactions on a persistent socket will be
|
||||
pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default
|
||||
is 1.
|
||||
.TP
|
||||
\fB\-postfresh\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether requests that use the \fBPOST\fR method will always use a
|
||||
fresh socket, overriding the \fB-keepalive\fR option of
|
||||
command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details.
|
||||
The default is 0.
|
||||
.TP
|
||||
\fB\-proxyhost\fR \fIhostname\fR
|
||||
.
|
||||
The name of the proxy host, if any. If this value is the
|
||||
@@ -133,47 +116,20 @@ an empty list. The default filter returns the values of the
|
||||
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
|
||||
non-empty.
|
||||
.TP
|
||||
\fB\-repost\fR \fIboolean\fR
|
||||
.
|
||||
Specifies what to do if a POST request over a persistent connection fails
|
||||
because the server has half-closed the connection. If boolean \fBtrue\fR, the
|
||||
request
|
||||
will be automatically retried; if boolean \fBfalse\fR it will not, and the
|
||||
application
|
||||
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
|
||||
retrying the POST. The value \fBtrue\fR should be used only under certain
|
||||
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
|
||||
default is 0.
|
||||
.TP
|
||||
\fB\-urlencoding\fR \fIencoding\fR
|
||||
.
|
||||
The \fIencoding\fR used for creating the x-url-encoded URLs with
|
||||
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
|
||||
The default is \fButf-8\fR, as specified by RFC
|
||||
\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
|
||||
2718. Prior to http 2.5 this was unspecified, and that behavior can be
|
||||
returned by specifying the empty string (\fB{}\fR), although
|
||||
\fIiso8859-1\fR is recommended to restore similar behavior but without the
|
||||
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
|
||||
throwing an error processing non-latin-1 characters.
|
||||
\fB::http::formatQuery\fR throwing an error processing non-latin-1
|
||||
characters.
|
||||
.TP
|
||||
\fB\-useragent\fR \fIstring\fR
|
||||
.
|
||||
The value of the User-Agent header in the HTTP request. In an unsafe
|
||||
interpreter, the default value depends upon the operating system, and
|
||||
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
|
||||
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
|
||||
A safe interpreter cannot determine its operating system, and so the default
|
||||
in a safe interpreter is to use a Windows 10 value with the current version
|
||||
numbers of \fBhttp\fR and \fBTcl\fR.
|
||||
.TP
|
||||
\fB\-zip\fR \fIboolean\fR
|
||||
.
|
||||
If the value is boolean \fBtrue\fR, then by default requests will send a header
|
||||
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
|
||||
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
|
||||
In either case the default can be overridden for an individual request by
|
||||
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
|
||||
of \fBhttp::geturl\fR. The default is 1.
|
||||
The value of the User-Agent header in the HTTP request. The default is
|
||||
.QW "\fBTcl http client package 2.7\fR" .
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
|
||||
@@ -271,7 +227,7 @@ Pragma: no-cache
|
||||
.TP
|
||||
\fB\-keepalive\fR \fIboolean\fR
|
||||
.
|
||||
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
|
||||
If true, attempt to keep the connection open for servicing
|
||||
multiple requests. Default is 0.
|
||||
.TP
|
||||
\fB\-method\fR \fItype\fR
|
||||
@@ -378,11 +334,6 @@ encodes the keys and values, and generates one string that has the
|
||||
proper & and = separators. The result is suitable for the
|
||||
\fB\-query\fR value passed to \fB::http::geturl\fR.
|
||||
.TP
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.
|
||||
This procedure does x-url-encoding of string. It takes a single argument and
|
||||
encodes it.
|
||||
.TP
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.
|
||||
This command resets the HTTP transaction identified by \fItoken\fR, if any.
|
||||
@@ -464,17 +415,6 @@ set token [::http::geturl https://my.secure.site/]
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
|
||||
.
|
||||
This procedure allows a registered protocol handler to deliver an error
|
||||
message for use by \fBhttp\fR. Calling this command does not raise an
|
||||
error. The command is useful when a registered protocol detects an problem
|
||||
(for example, an invalid TLS certificate) that will cause an error to
|
||||
propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a
|
||||
precise error message rather than a general one. The command returns the
|
||||
value provided by the last call with argument \fImessage\fR, or the empty
|
||||
string if no such call has been made.
|
||||
.TP
|
||||
\fB::http::unregister\fR \fIproto\fR
|
||||
.
|
||||
This procedure unregisters a protocol handler that was previously
|
||||
@@ -564,14 +504,6 @@ The following elements of
|
||||
the array are supported:
|
||||
.RS
|
||||
.TP
|
||||
\fBbinary\fR
|
||||
.
|
||||
This is boolean \fBtrue\fR if (after decoding any compression specified
|
||||
by the
|
||||
.QW "Content-Encoding"
|
||||
response header) the HTTP response is binary. It is boolean \fBfalse\fR
|
||||
if the HTTP response is text.
|
||||
.TP
|
||||
\fBbody\fR
|
||||
.
|
||||
The contents of the URL. This will be empty if the \fB\-channel\fR
|
||||
@@ -670,106 +602,6 @@ A copy of the \fBContent-Type\fR meta-data value.
|
||||
.
|
||||
The requested URL.
|
||||
.RE
|
||||
.SH "PERSISTENT CONNECTIONS"
|
||||
.PP
|
||||
.SS "BASICS"
|
||||
.PP
|
||||
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
|
||||
.PP
|
||||
A persistent connection allows multiple HTTP/1.1 transactions to be
|
||||
carried over the same TCP connection. Pipelining allows a
|
||||
client to make multiple requests over a persistent connection without
|
||||
waiting for each response. The server sends responses in the same order
|
||||
that the requests were received.
|
||||
.PP
|
||||
If a POST request fails to complete, typically user confirmation is
|
||||
needed before sending the request again. The user may wish to verify
|
||||
whether the server was modified by the failed POST request, before
|
||||
sending the same request again.
|
||||
.PP
|
||||
A HTTP request will use a persistent socket if the call to
|
||||
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
|
||||
pipelining where permitted if the \fBhttp::config\fR option
|
||||
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
|
||||
.PP
|
||||
The http package maintains no more than one persistent connection to each
|
||||
server (i.e. each value of
|
||||
.QW "domain:port" ).
|
||||
If \fBhttp::geturl\fR is called to make a request over a persistent
|
||||
connection while the connection is busy with another request, the new
|
||||
request will be held in a queue until the connection is free.
|
||||
.PP
|
||||
The http package does not support HTTP/1.0 persistent connections
|
||||
controlled by the \fBKeep-Alive\fR header.
|
||||
.SS "SPECIAL CASES"
|
||||
.PP
|
||||
This subsection discusses issues related to closure of the
|
||||
persistent connection by the server, automatic retry of failed requests,
|
||||
the special treatment necessary for POST requests, and the options for
|
||||
dealing with these cases.
|
||||
.PP
|
||||
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
|
||||
requests that use the POST method. If a POST uses a persistent
|
||||
connection and is not the first request on that connection,
|
||||
\fBhttp::geturl\fR waits until it has received the response for the previous
|
||||
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
|
||||
uses a new connection for each POST.
|
||||
.PP
|
||||
If the server is processing a number of pipelined requests, and sends a
|
||||
response header
|
||||
.QW "\fBConnection: close\fR"
|
||||
with one of the responses (other than the last), then subsequent responses
|
||||
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
|
||||
over a new connection.
|
||||
.PP
|
||||
A difficulty arises when a HTTP client sends a request over a persistent
|
||||
connection that has been idle for a while. The HTTP server may
|
||||
half-close an apparently idle connection while the client is sending a
|
||||
request, but before the request arrives at the server: in this case (an
|
||||
.QW "asynchronous close event" )
|
||||
the request will fail. The difficulty arises because the client cannot
|
||||
be certain whether the POST modified the state of the server. For HEAD or
|
||||
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
|
||||
the failed request. However, if the request was a POST, RFC 7230 forbids
|
||||
automatic retry by default, suggesting either user confirmation, or
|
||||
confirmation by user-agent software that has semantic understanding of
|
||||
the application. The \fBhttp::config\fR option \fB-repost\fR allows for
|
||||
either possibility.
|
||||
.PP
|
||||
Asynchronous close events can occur only in a short interval of time. The
|
||||
\fBhttp\fR package monitors each persistent connection for closure by the
|
||||
server. Upon detection, the connection is also closed at the client end,
|
||||
and subsequent requests will use a fresh connection.
|
||||
.PP
|
||||
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
|
||||
then it will both try to use an existing persistent connection
|
||||
(if one is available), and it will send the server a
|
||||
.QW "\fBConnection: keep-alive\fR"
|
||||
request header asking to keep the connection open for future requests.
|
||||
.PP
|
||||
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
|
||||
\fB-repost\fR relate to persistent connections.
|
||||
.PP
|
||||
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
|
||||
made
|
||||
over a persistent connection. POST requests will not be pipelined - if the
|
||||
POST is not the first transaction on the connection, its request will not
|
||||
be sent until the previous response has finished. GET and HEAD requests
|
||||
made after a POST will not be sent until the POST response has been
|
||||
delivered, and will not be sent if the POST fails.
|
||||
.PP
|
||||
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
|
||||
\fB-keepalive\fR, and always open a fresh connection for a POST request.
|
||||
.PP
|
||||
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
|
||||
that fails because it uses a persistent connection that the server has
|
||||
half-closed (an
|
||||
.QW "asynchronous close event" ).
|
||||
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
|
||||
\fIThe -repost option should be used only if the application understands
|
||||
that the retry is appropriate\fR - specifically, the application must know
|
||||
that if the failed POST successfully modified the state of the server, a repeat POST
|
||||
would have no adverse effect.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
This example creates a procedure to copy a URL to a file while printing a
|
||||
|
||||
@@ -27,11 +27,6 @@ and also returned as result.
|
||||
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
|
||||
to \fBincr\fR may be unset, and in that case, it will be set to
|
||||
the value \fIincrement\fR or to the default increment value of \fB1\fR.
|
||||
.VS TIP508
|
||||
If \fIvarName\fR indicate an element that does not exist of an array that has
|
||||
a default value set, the sum of the default value and the \fIincrement\fR (or
|
||||
1) will be stored in the array element.
|
||||
.VE TIP508
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
Add one to the contents of the variable \fIx\fR:
|
||||
@@ -64,7 +59,3 @@ an error if it is not):
|
||||
expr(n), set(n)
|
||||
.SH KEYWORDS
|
||||
add, increment, variable, value
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
+98
-188
@@ -35,51 +35,16 @@ Returns the body of procedure \fIprocname\fR. \fIProcname\fR must be
|
||||
the name of a Tcl command procedure.
|
||||
.TP
|
||||
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
|
||||
.
|
||||
.VS 8.6
|
||||
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
|
||||
described in \fBCLASS INTROSPECTION\fR below.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo cmdcount\fR
|
||||
.
|
||||
Returns a count of the total number of commands that have been invoked
|
||||
in this interpreter.
|
||||
.TP
|
||||
\fBinfo cmdtype \fIcommandName\fR
|
||||
.VS TIP426
|
||||
Returns a description of the kind of command named by \fIcommandName\fR. The
|
||||
supported types are:
|
||||
.RS
|
||||
.IP \fBalias\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
|
||||
safe interpreters can only see a subset of aliases (specifically those between
|
||||
two commands within themselves).
|
||||
.IP \fBcoroutine\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
|
||||
.IP \fBensemble\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
|
||||
.IP \fBimport\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
|
||||
.IP \fBnative\fR
|
||||
Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
|
||||
interface directly without further registration of the type of command.
|
||||
.IP \fBobject\fR
|
||||
Indicates that \fIcommandName\fR is the public command that represents an
|
||||
instance of \fBoo::object\fR or one of its subclasses.
|
||||
.IP \fBprivateObject\fR
|
||||
Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
|
||||
that represents an instance of \fBoo::object\fR or one of its subclasses.
|
||||
.IP \fBproc\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBproc\fR.
|
||||
.IP \fBslave\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
|
||||
.IP \fBzlibStream\fR
|
||||
Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
|
||||
.PP
|
||||
There may be other registered types as well; this is a set that is extensible
|
||||
at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
|
||||
.RE
|
||||
.VE TIP426
|
||||
.TP
|
||||
\fBinfo commands \fR?\fIpattern\fR?
|
||||
.
|
||||
If \fIpattern\fR is not specified,
|
||||
@@ -113,10 +78,11 @@ command is not complete, the script can delay evaluating it until additional
|
||||
lines have been typed to complete the command.
|
||||
.TP
|
||||
\fBinfo coroutine\fR
|
||||
.
|
||||
.VS 8.6
|
||||
Returns the name of the currently executing \fBcoroutine\fR, or the empty
|
||||
string if either no coroutine is currently executing, or the current coroutine
|
||||
has been deleted (but has not yet returned or yielded since deletion).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo default \fIprocname arg varname\fR
|
||||
.
|
||||
@@ -127,7 +93,7 @@ Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
|
||||
into variable \fIvarname\fR.
|
||||
.TP
|
||||
\fBinfo errorstack \fR?\fIinterp\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
Returns, in a form that is programmatically easy to parse, the function names
|
||||
and arguments at each level from the call stack of the last error in the given
|
||||
\fIinterp\fR, or in the current one if not specified.
|
||||
@@ -152,6 +118,7 @@ options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
|
||||
is a convenient way of retrieving it for uncaught errors at top-level in an
|
||||
interactive \fBtclsh\fR.
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo exists \fIvarName\fR
|
||||
.
|
||||
@@ -362,9 +329,10 @@ was invoked. If Tcl was unable to identify the file, then an empty
|
||||
string is returned.
|
||||
.TP
|
||||
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
|
||||
.
|
||||
.VS 8.6
|
||||
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
|
||||
described in \fBOBJECT INTROSPECTION\fR below.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo patchlevel\fR
|
||||
.
|
||||
@@ -431,22 +399,20 @@ Note that a currently-visible variable may not yet
|
||||
if it has not
|
||||
been set (e.g. a variable declared but not set by \fBvariable\fR).
|
||||
.SS "CLASS INTROSPECTION"
|
||||
.VS 8.6
|
||||
.PP
|
||||
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class call\fI class method\fR
|
||||
.
|
||||
.VS
|
||||
Returns a description of the method implementations that are used to provide a
|
||||
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
|
||||
(stereotypical instances being objects instantiated by a class without having
|
||||
any object-specific definitions added). This consists of a list of lists of
|
||||
four elements, where each sublist consists of a word that describes the
|
||||
general type of method implementation (being one of \fBmethod\fR for an
|
||||
ordinary method, \fBfilter\fR for an applied filter,
|
||||
.VS TIP500
|
||||
\fBprivate\fR for a private method,
|
||||
.VE TIP500
|
||||
and \fBunknown\fR for a
|
||||
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
|
||||
method that is invoked as part of unknown method handling), a word giving the
|
||||
name of the particular method invoked (which is always the same as
|
||||
\fImethod\fR for the \fBmethod\fR type, and
|
||||
@@ -457,149 +423,122 @@ implementation (see \fBinfo class methodtype\fR).
|
||||
.RS
|
||||
.PP
|
||||
Note that there is no inspection of whether the method implementations
|
||||
actually use \fBnext\fR to transfer control along the call chain,
|
||||
.VS TIP500
|
||||
and the call chains that this command files do not actually contain private
|
||||
methods.
|
||||
.VE TIP500
|
||||
actually use \fBnext\fR to transfer control along the call chain.
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class constructor\fI class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a description of the definition of the constructor of
|
||||
class \fIclass\fR. The definition is described as a two element list; the first
|
||||
element is the list of arguments to the constructor in a form suitable for
|
||||
passing to another call to \fBproc\fR or a method definition, and the second
|
||||
element is the body of the constructor. If no constructor is present, this
|
||||
returns the empty list.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class definition\fI class method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a description of the definition of the method named
|
||||
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
|
||||
list; the first element is the list of arguments to the method in a form
|
||||
suitable for passing to another call to \fBproc\fR or a method definition, and
|
||||
the second element is the body of the method.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class destructor\fI class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the body of the destructor of class \fIclass\fR. If no
|
||||
destructor is present, this returns the empty string.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class filters\fI class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the list of filter methods set on the class.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class forward\fI class method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the argument list for the method forwarding called
|
||||
\fImethod\fR that is set on the class called \fIclass\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of instances of class \fIclass\fR. If the
|
||||
optional \fIpattern\fR argument is present, it constrains the list of returned
|
||||
instances to those that match it according to the rules of \fBstring match\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all public (i.e. exported) methods of the
|
||||
class called \fIclass\fR. Any of the following \fIoption\fRs may be
|
||||
specified, controlling exactly which method names are returned:
|
||||
.RS
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-all\fR
|
||||
.
|
||||
If the \fB\-all\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will include those
|
||||
.VS 8.6
|
||||
If the \fB\-all\fR flag is given, the list of methods will include those
|
||||
methods defined not just by the class, but also by the class's superclasses
|
||||
and mixins.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-private\fR
|
||||
.
|
||||
If the \fB\-private\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will also include
|
||||
the non-exported methods of the class (and superclasses and
|
||||
.VS 8.6
|
||||
If the \fB\-private\fR flag is given, the list of methods will also include
|
||||
the private (i.e. non-exported) methods of the class (and superclasses and
|
||||
mixins, if \fB\-all\fR is also given).
|
||||
.VS TIP500
|
||||
Note that this naming is an unfortunate clash with true private methods; this
|
||||
option name is retained for backward compatibility.
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fB\-scope\fI scope\fR
|
||||
.VS TIP500
|
||||
Returns a list of all methods on \fIclass\fR that have the given visibility
|
||||
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
|
||||
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
|
||||
.RS
|
||||
.IP \fBpublic\fR 3
|
||||
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
|
||||
of this class) are to be returned.
|
||||
.IP \fBunexported\fR 3
|
||||
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
|
||||
be returned.
|
||||
.IP \fBprivate\fR 3
|
||||
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
|
||||
methods) are to be returned.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class methodtype\fI class method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a description of the type of implementation used for
|
||||
the method named \fImethod\fR of class \fIclass\fR. When the result is
|
||||
\fBmethod\fR, further information can be discovered with \fBinfo class
|
||||
definition\fR, and when the result is \fBforward\fR, further information can
|
||||
be discovered with \fBinfo class forward\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class mixins\fI class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all classes that have been mixed into the
|
||||
class named \fIclass\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
|
||||
the optional \fIpattern\fR argument is present, it constrains the list of
|
||||
returned classes to those that match it according to the rules of
|
||||
\fBstring match\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class superclasses\fI class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of direct superclasses of class \fIclass\fR in
|
||||
inheritance precedence order.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
|
||||
.
|
||||
\fBinfo class variables\fI class\fR
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all variables that have been declared for
|
||||
the class named \fIclass\fR (i.e. that are automatically present in the
|
||||
class's methods, constructor and destructor).
|
||||
.VS TIP500
|
||||
If the \fB\-private\fR option is specified, this lists the private variables
|
||||
declared instead.
|
||||
.VE TIP500
|
||||
.SS "OBJECT INTROSPECTION"
|
||||
.PP
|
||||
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object call\fI object method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
Returns a description of the method implementations that are used to provide
|
||||
\fIobject\fR's implementation of \fImethod\fR. This consists of a list of
|
||||
lists of four elements, where each sublist consists of a word that describes
|
||||
the general type of method implementation (being one of \fBmethod\fR for an
|
||||
ordinary method, \fBfilter\fR for an applied filter,
|
||||
.VS TIP500
|
||||
\fBprivate\fR for a private method,
|
||||
.VE TIP500
|
||||
and \fBunknown\fR for a
|
||||
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
|
||||
method that is invoked as part of unknown method handling), a word giving the
|
||||
name of the particular method invoked (which is always the same as
|
||||
\fImethod\fR for the \fBmethod\fR type, and
|
||||
@@ -611,160 +550,128 @@ implementation (see \fBinfo object methodtype\fR).
|
||||
.RS
|
||||
.PP
|
||||
Note that there is no inspection of whether the method implementations
|
||||
actually use \fBnext\fR to transfer control along the call chain,
|
||||
.VS TIP500
|
||||
and the call chains that this command files do not actually contain private
|
||||
methods.
|
||||
.VE TIP500
|
||||
actually use \fBnext\fR to transfer control along the call chain.
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object class\fI object\fR ?\fIclassName\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
If \fIclassName\fR is unspecified, this subcommand returns class of the
|
||||
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
|
||||
boolean value indicating whether the \fIobject\fR is of that class.
|
||||
.TP
|
||||
\fBinfo object creationid\fI object\fR
|
||||
.VS TIP500
|
||||
Returns the unique creation identifier for the \fIobject\fR object. This
|
||||
creation identifier is unique to the object (within a Tcl interpreter) and
|
||||
cannot be controlled at object creation time or altered afterwards.
|
||||
.RS
|
||||
.PP
|
||||
\fIImplementation note:\fR the creation identifier is used to generate unique
|
||||
identifiers associated with the object, especially for private variables.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object definition\fI object method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a description of the definition of the method named
|
||||
\fImethod\fR of object \fIobject\fR. The definition is described as a two
|
||||
element list; the first element is the list of arguments to the method in a
|
||||
form suitable for passing to another call to \fBproc\fR or a method definition,
|
||||
and the second element is the body of the method.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object filters\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the list of filter methods set on the object.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object forward\fI object method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the argument list for the method forwarding called
|
||||
\fImethod\fR that is set on the object called \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand tests whether an object belongs to a particular category,
|
||||
returning a boolean value that indicates whether the \fIobject\fR argument
|
||||
meets the criteria for the category. The supported categories are:
|
||||
.VE 8.6
|
||||
.RS
|
||||
.TP
|
||||
\fBinfo object isa class\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This returns whether \fIobject\fR is a class (i.e. an instance of
|
||||
\fBoo::class\fR or one of its subclasses).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa metaclass\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This returns whether \fIobject\fR is a class that can manufacture classes
|
||||
(i.e. is \fBoo::class\fR or a subclass of it).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa mixin\fI object class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa object\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This returns whether \fIobject\fR really is an object.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa typeof\fI object class\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
|
||||
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
|
||||
direct or indirect).
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all public (i.e. exported) methods of the
|
||||
object called \fIobject\fR. Any of the following \fIoption\fRs may be
|
||||
specified, controlling exactly which method names are returned:
|
||||
.RS
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-all\fR
|
||||
.
|
||||
If the \fB\-all\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will include those
|
||||
.VS 8.6
|
||||
If the \fB\-all\fR flag is given, the list of methods will include those
|
||||
methods defined not just by the object, but also by the object's class and
|
||||
mixins, plus the superclasses of those classes.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-private\fR
|
||||
.
|
||||
If the \fB\-private\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will also include
|
||||
the non-exported methods of the object (and classes, if
|
||||
.VS 8.6
|
||||
If the \fB\-private\fR flag is given, the list of methods will also include
|
||||
the private (i.e. non-exported) methods of the object (and classes, if
|
||||
\fB\-all\fR is also given).
|
||||
.VS TIP500
|
||||
Note that this naming is an unfortunate clash with true private methods; this
|
||||
option name is retained for backward compatibility.
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fB\-scope\fI scope\fR
|
||||
.VS TIP500
|
||||
Returns a list of all methods on \fIobject\fR that have the given visibility
|
||||
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
|
||||
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
|
||||
.RS
|
||||
.IP \fBpublic\fR 3
|
||||
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
|
||||
returned.
|
||||
.IP \fBunexported\fR 3
|
||||
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
|
||||
be returned.
|
||||
.IP \fBprivate\fR 3
|
||||
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
|
||||
instance methods) are to be returned.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object methodtype\fI object method\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a description of the type of implementation used for
|
||||
the method named \fImethod\fR of object \fIobject\fR. When the result is
|
||||
\fBmethod\fR, further information can be discovered with \fBinfo object
|
||||
definition\fR, and when the result is \fBforward\fR, further information can
|
||||
be discovered with \fBinfo object forward\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object mixins\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all classes that have been mixed into the
|
||||
object named \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object namespace\fI object\fR
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns the name of the internal namespace of the object named
|
||||
\fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
|
||||
.
|
||||
\fBinfo object variables\fI object\fR
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all variables that have been declared for
|
||||
the object named \fIobject\fR (i.e. that are automatically present in the
|
||||
object's methods).
|
||||
.VS TIP500
|
||||
If the \fB\-private\fR option is specified, this lists the private variables
|
||||
declared instead.
|
||||
.VE TIP500
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
|
||||
.
|
||||
.VS 8.6
|
||||
This subcommand returns a list of all variables in the private namespace of
|
||||
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
|
||||
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
|
||||
@@ -773,6 +680,7 @@ from the list returned by \fBinfo object variables\fR; that can include
|
||||
variables that are currently unset, whereas this can include variables that
|
||||
are not automatically included by any of \fIobject\fR's methods (or those of
|
||||
its class, superclasses or mixins).
|
||||
.VE 8.6
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This command prints out a procedure suitable for saving in a Tcl
|
||||
@@ -795,6 +703,7 @@ proc printProc {procName} {
|
||||
}
|
||||
.CE
|
||||
.SS "EXAMPLES WITH OBJECTS"
|
||||
.VS 8.6
|
||||
.PP
|
||||
Every object necessarily knows what its class is; this information is
|
||||
trivially extractable through introspection:
|
||||
@@ -815,10 +724,8 @@ method and get how it is defined. This procedure illustrates how:
|
||||
proc getDef {obj method} {
|
||||
foreach inf [\fBinfo object call\fR $obj $method] {
|
||||
lassign $inf calltype name locus methodtype
|
||||
|
||||
# Assume no forwards or filters, and hence no $calltype
|
||||
# or $methodtype checks...
|
||||
|
||||
if {$locus eq "object"} {
|
||||
return [\fBinfo object definition\fR $obj $name]
|
||||
} else {
|
||||
@@ -841,9 +748,7 @@ proc getDef {obj method} {
|
||||
# Assume no forwards
|
||||
return [\fBinfo object definition\fR $obj $method]
|
||||
}
|
||||
|
||||
set cls [\fBinfo object class\fR $obj]
|
||||
|
||||
while {$method ni [\fBinfo class methods\fR $cls]} {
|
||||
# Assume the simple case
|
||||
set cls [lindex [\fBinfo class superclass\fR $cls] 0]
|
||||
@@ -851,17 +756,22 @@ proc getDef {obj method} {
|
||||
error "no definition for $method"
|
||||
}
|
||||
}
|
||||
|
||||
# Assume no forwards
|
||||
return [\fBinfo class definition\fR $cls $method]
|
||||
}
|
||||
.CE
|
||||
.VE 8.6
|
||||
.SH "SEE ALSO"
|
||||
.VS 8.6
|
||||
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
|
||||
.VE 8.6
|
||||
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
|
||||
.SH KEYWORDS
|
||||
command, information, interpreter, introspection, level, namespace,
|
||||
object, procedure, variable
|
||||
.VS 8.6
|
||||
object,
|
||||
.VE 8.6
|
||||
procedure, variable
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" fill-column: 78
|
||||
|
||||
@@ -22,12 +22,6 @@ and appends each of the \fIvalue\fR arguments to that list as a separate
|
||||
element, with spaces between elements.
|
||||
If \fIvarName\fR does not exist, it is created as a list with elements
|
||||
given by the \fIvalue\fR arguments.
|
||||
.VS TIP508
|
||||
If \fIvarName\fR indicate an element that does not exist of an array that has
|
||||
a default value set, list that is comprised of the default value with all the
|
||||
\fIvalue\fR arguments appended as elements will be stored in the array
|
||||
element.
|
||||
.VE TIP508
|
||||
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
|
||||
are appended as list elements rather than raw text.
|
||||
This command provides a relatively efficient way to build up
|
||||
@@ -53,7 +47,3 @@ list(n), lindex(n), linsert(n), llength(n), lset(n),
|
||||
lsort(n), lrange(n)
|
||||
.SH KEYWORDS
|
||||
append, element, list, variable
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
-124
@@ -1,124 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2011-2015 Andreas Kupries
|
||||
'\" Copyright (c) 2018 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH link n 0.3 TclOO "TclOO Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
link \- create link from command to method of object
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBlink\fR \fImethodName\fR ?\fI...\fR?
|
||||
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
The \fBlink\fR command is available within methods. It takes a series of one
|
||||
or more method names (\fImethodName ...\fR) and/or pairs of command- and
|
||||
method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
|
||||
available as commands without requiring the explicit use of the name of the
|
||||
object or the \fBmy\fR command. The method does not need to exist at the time
|
||||
that the link is made; if the link command is invoked when the method does not
|
||||
exist, the standard \fBunknown\fR method handling system is used.
|
||||
.PP
|
||||
The command name under which the method becomes available defaults to the
|
||||
method name, except where explicitly specified through an alias/method pair.
|
||||
Formally, every argument must be a list; if the list has two elements, the
|
||||
first element is the name of the command to create and the second element is
|
||||
the name of the method of the current object to which the command links;
|
||||
otherwise, the name of the command and the name of the method are the same
|
||||
string (the first element of the list).
|
||||
.PP
|
||||
If the name of the command is not a fully-qualified command name, it will be
|
||||
resolved with respect to the current namespace (i.e., the object namespace).
|
||||
.SH EXAMPLES
|
||||
This demonstrates linking a single method in various ways. First it makes a
|
||||
simple link, then a renamed link, then an external link. Note that the method
|
||||
itself is unexported, but that it can still be called directly from outside
|
||||
the class.
|
||||
.PP
|
||||
.CS
|
||||
oo::class create ABC {
|
||||
method Foo {} {
|
||||
puts "This is Foo in [self]"
|
||||
}
|
||||
|
||||
constructor {} {
|
||||
\fBlink\fR Foo
|
||||
# The method foo is now directly accessible as foo here
|
||||
\fBlink\fR {bar Foo}
|
||||
# The method foo is now directly accessible as bar
|
||||
\fBlink\fR {::ExternalCall Foo}
|
||||
# The method foo is now directly accessible in the global
|
||||
# namespace as ExternalCall
|
||||
}
|
||||
|
||||
method grill {} {
|
||||
puts "Step 1:"
|
||||
Foo
|
||||
puts "Step 2:"
|
||||
bar
|
||||
}
|
||||
}
|
||||
|
||||
ABC create abc
|
||||
abc grill
|
||||
\fI\(-> Step 1:\fR
|
||||
\fI\(-> This is foo in ::abc\fR
|
||||
\fI\(-> Step 2:\fR
|
||||
\fI\(-> This is foo in ::abc\fR
|
||||
# Direct access via the linked command
|
||||
puts "Step 3:"; ExternalCall
|
||||
\fI\(-> Step 3:\fR
|
||||
\fI\(-> This is foo in ::abc\fR
|
||||
.CE
|
||||
.PP
|
||||
This example shows that multiple linked commands can be made in a call to
|
||||
\fBlink\fR, and that they can handle arguments.
|
||||
.PP
|
||||
.CS
|
||||
oo::class create Ex {
|
||||
constructor {} {
|
||||
\fBlink\fR a b c
|
||||
# The methods a, b, and c (defined below) are all now
|
||||
# directly acessible within methods under their own names.
|
||||
}
|
||||
|
||||
method a {} {
|
||||
puts "This is a"
|
||||
}
|
||||
method b {x} {
|
||||
puts "This is b($x)"
|
||||
}
|
||||
method c {y z} {
|
||||
puts "This is c($y,$z)"
|
||||
}
|
||||
|
||||
method call {p q r} {
|
||||
a
|
||||
b $p
|
||||
c $q $r
|
||||
}
|
||||
}
|
||||
|
||||
set o [Ex new]
|
||||
$o 3 5 7
|
||||
\fI\(-> This is a\fR
|
||||
\fI\(-> This is b(3)\fR
|
||||
\fI\(-> This is c(5,7)\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
interp(n), my(n), oo::class(n), oo::define(n)
|
||||
.SH KEYWORDS
|
||||
command, method, object
|
||||
.\" Local Variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
+2
-32
@@ -30,26 +30,13 @@ list, and \fBend\fR refers to the last element of the list.
|
||||
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
|
||||
.PP
|
||||
If \fIfirst\fR is less than zero, it is considered to refer to before the
|
||||
first element of the list.
|
||||
.VS TIP505
|
||||
If \fIfirst\fR indicates a position greater than the index of the last element
|
||||
of the list, it is treated as if it is an index one greater than the last
|
||||
element. This allows this command to append elements to the list.
|
||||
.VE TIP505
|
||||
For non-empty lists, the element indicated
|
||||
by \fIfirst\fR must exist, or \fIfirst\fR must indicate before the
|
||||
first element of the list. For non-empty lists, the element indicated
|
||||
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
|
||||
start of the list.
|
||||
.PP
|
||||
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
|
||||
will be inserted into the list before the point specified by \fIfirst\fR
|
||||
with no elements being deleted.
|
||||
.VS TIP505
|
||||
If \fIlast\fR is greater than the index of the last item of the list, it is
|
||||
treated as if it is an index one greater than the last element. This means
|
||||
that if it is also greater than than \fIfirst\fR, all elements from
|
||||
\fIfirst\fR to the end of the list will be replaced, and otherwise the
|
||||
elements will be appended.
|
||||
.VE TIP505
|
||||
.PP
|
||||
The \fIelement\fR arguments specify zero or more new arguments to
|
||||
be added to the list in place of those that were deleted.
|
||||
@@ -91,26 +78,9 @@ proc lremove {listVariable value} {
|
||||
set var [\fBlreplace\fR $var $idx $idx]
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.VS TIP505
|
||||
Adding elements to the end of the list; note that \fBend+2\fR will initially
|
||||
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
|
||||
than the index of the final item so they behave identically:
|
||||
.PP
|
||||
.CS
|
||||
% set var {a b c d e}
|
||||
a b c d e
|
||||
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
|
||||
a b c d e f g h i
|
||||
.CE
|
||||
.VE TIP505
|
||||
.SH "SEE ALSO"
|
||||
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
|
||||
lset(n), lrange(n), lsort(n),
|
||||
string(n)
|
||||
.SH KEYWORDS
|
||||
element, list, replace
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
+1
-1
@@ -128,8 +128,8 @@ Given several source strings, \fB::msgcat::mcmax\fR returns the length
|
||||
of the longest translated string. This is useful when designing
|
||||
localized GUIs, which may require that all buttons, for example, be a
|
||||
fixed width (which will be the width of the widest button).
|
||||
.VS "TIP 412"
|
||||
.TP
|
||||
.VS "TIP 412"
|
||||
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
|
||||
.
|
||||
Return true, if there is a translation for the given \fIsrc-string\fR.
|
||||
|
||||
@@ -9,45 +9,25 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
my, myclass \- invoke any method of current object or its class
|
||||
my \- invoke any method of current object
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBmy\fI methodName\fR ?\fIarg ...\fR?
|
||||
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBmy\fR command is used to allow methods of objects to invoke methods
|
||||
of the object (or its class),
|
||||
.VS TIP478
|
||||
and he \fBmyclass\fR command is used to allow methods of objects to invoke
|
||||
methods of the current class of the object \fIas an object\fR.
|
||||
.VE TIP478
|
||||
In particular, the set of valid values for
|
||||
The \fBmy\fR command is used to allow methods of objects to invoke any method
|
||||
of the object (or its class). In particular, the set of valid values for
|
||||
\fImethodName\fR is the set of all methods supported by an object and its
|
||||
superclasses, including those that are not exported
|
||||
.VS TIP500
|
||||
and private methods of the object or class when used within another method
|
||||
defined by that object or class.
|
||||
.VE TIP500
|
||||
superclasses, including those that are not exported. The object upon which the
|
||||
method is invoked is always the one that is the current context of the method
|
||||
(i.e. the object that is returned by \fBself object\fR) from which the
|
||||
\fBmy\fR command is invoked.
|
||||
.PP
|
||||
The object upon which the method is invoked via \fBmy\fR is the one that owns
|
||||
the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
|
||||
remains if the command is renamed), which is the currently invoked object by
|
||||
default.
|
||||
.VS TIP478
|
||||
Similarly, the object on which the method is invoked via \fBmyclass\fR is the
|
||||
object that is the current class of the object that owns the namespace that
|
||||
the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
|
||||
link remains even if the command is renamed into another namespace, and
|
||||
defaults to being the manufacturing class of the current object.
|
||||
.VE TIP478
|
||||
.PP
|
||||
Each object has its own \fBmy\fR and \fBmyclass\fR commands, contained in its
|
||||
instance namespace.
|
||||
Each object has its own \fBmy\fR command, contained in its instance namespace.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
|
||||
@@ -60,71 +40,16 @@ oo::class create c {
|
||||
puts [incr counter]
|
||||
}
|
||||
}
|
||||
|
||||
c create o
|
||||
o count \fI\(-> prints "1"\fR
|
||||
o count \fI\(-> prints "2"\fR
|
||||
o count \fI\(-> prints "3"\fR
|
||||
.CE
|
||||
.PP
|
||||
This example shows how you can use \fBmy\fR to make callbacks to private
|
||||
methods from outside the object (from a \fBtrace\fR), using
|
||||
\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
|
||||
command for the recommended way of doing this.)
|
||||
.PP
|
||||
.CS
|
||||
oo::class create HasCallback {
|
||||
method makeCallback {} {
|
||||
return [namespace code {
|
||||
\fBmy\fR Callback
|
||||
}]
|
||||
}
|
||||
|
||||
method Callback {args} {
|
||||
puts "callback: $args"
|
||||
}
|
||||
}
|
||||
|
||||
set o [HasCallback new]
|
||||
trace add variable xyz write [$o makeCallback]
|
||||
set xyz "called" \fI\(-> prints "callback: xyz {} write"\fR
|
||||
.CE
|
||||
.PP
|
||||
.VS TIP478
|
||||
This example shows how to access a private method of a class from an instance
|
||||
of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
|
||||
a higher level interface for doing this.)
|
||||
.PP
|
||||
.CS
|
||||
oo::class create CountedSteps {
|
||||
self {
|
||||
variable count
|
||||
method Count {} {
|
||||
return [incr count]
|
||||
}
|
||||
}
|
||||
method advanceTwice {} {
|
||||
puts "in [self] step A: [\fBmyclass\fR Count]"
|
||||
puts "in [self] step B: [\fBmyclass\fR Count]"
|
||||
}
|
||||
}
|
||||
|
||||
CountedSteps create x
|
||||
CountedSteps create y
|
||||
x advanceTwice \fI\(-> prints "in ::x step A: 1"\fR
|
||||
\fI\(-> prints "in ::x step B: 2"\fR
|
||||
y advanceTwice \fI\(-> prints "in ::y step A: 3"\fR
|
||||
\fI\(-> prints "in ::y step B: 4"\fR
|
||||
x advanceTwice \fI\(-> prints "in ::x step A: 5"\fR
|
||||
\fI\(-> prints "in ::x step B: 6"\fR
|
||||
y advanceTwice \fI\(-> prints "in ::y step A: 7"\fR
|
||||
\fI\(-> prints "in ::y step B: 8"\fR
|
||||
.CE
|
||||
.VE TIP478
|
||||
.SH "SEE ALSO"
|
||||
next(n), oo::object(n), self(n)
|
||||
.SH KEYWORDS
|
||||
method, method visibility, object, private method, public method
|
||||
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
|
||||
@@ -112,7 +112,6 @@ oo::class create theSuperclass {
|
||||
puts "in the superclass, args = $args"
|
||||
}
|
||||
}
|
||||
|
||||
oo::class create theSubclass {
|
||||
superclass theSuperclass
|
||||
method example {args} {
|
||||
@@ -122,7 +121,6 @@ oo::class create theSubclass {
|
||||
puts "after chaining from subclass"
|
||||
}
|
||||
}
|
||||
|
||||
theSubclass create obj
|
||||
oo::objdefine obj method example args {
|
||||
puts "per-object method, args = $args"
|
||||
@@ -169,7 +167,6 @@ oo::class create cache {
|
||||
\fI# Compute value, insert into cache, and return it\fR
|
||||
return [set ValueCache($key) [\fBnext\fR {*}$args]]
|
||||
}
|
||||
|
||||
method flushCache {} {
|
||||
my variable ValueCache
|
||||
unset ValueCache
|
||||
@@ -181,12 +178,10 @@ oo::class create cache {
|
||||
oo::object create demo
|
||||
oo::objdefine demo {
|
||||
mixin cache
|
||||
|
||||
method compute {a b c} {
|
||||
after 3000 \fI;# Simulate deep thought\fR
|
||||
return [expr {$a + $b * $c}]
|
||||
}
|
||||
|
||||
method compute2 {a b c} {
|
||||
after 3000 \fI;# Simulate deep thought\fR
|
||||
return [expr {$a * $b + $c}]
|
||||
|
||||
-131
@@ -1,131 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2017 Frederic Bonnet.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH process n 8.7 Tcl "Tcl Built-In Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
tcl::process \- Subprocess management
|
||||
.SH SYNOPSIS
|
||||
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
This command provides a way to manage subprocesses created by the \fBopen\fR
|
||||
and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
|
||||
.TP
|
||||
\fB::tcl::process list\fR
|
||||
.
|
||||
Returns the list of subprocess PIDs.
|
||||
.TP
|
||||
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
|
||||
.
|
||||
Returns a dictionary mapping subprocess PIDs to their respective status. If
|
||||
\fIpids\fR is specified as a list of PIDs then the command only returns the
|
||||
status of the matching subprocesses if they exist, and raises an error
|
||||
otherwise. For active processes, the status is an empty value. For terminated
|
||||
processes, the status is a list with the following format:
|
||||
.QW "{code ?\fImsg errorCode\fR?}" ,
|
||||
where:
|
||||
.RS
|
||||
.TP
|
||||
\fBcode\fR\0
|
||||
.
|
||||
is a standard Tcl return code,
|
||||
.TP
|
||||
\fBmsg\fR\0
|
||||
.
|
||||
is the human-readable error message,
|
||||
.TP
|
||||
\fBerrorCode\fR\0
|
||||
.
|
||||
uses the same format as the \fBerrorCode\fR global variable
|
||||
.RE
|
||||
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
|
||||
terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
|
||||
this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
|
||||
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
|
||||
.RS
|
||||
.PP
|
||||
Additionally, \fB::tcl::process status\fR accepts the following switches:
|
||||
.TP
|
||||
\fB\-wait\fR\0
|
||||
.
|
||||
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
|
||||
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
|
||||
is specified as a list of PIDs then the command waits until the status of the
|
||||
matching subprocesses are available. If \fBpids\fR is not specified then it
|
||||
waits for all known subprocesses.
|
||||
.TP
|
||||
\fB\-\|\-\fR
|
||||
.
|
||||
Marks the end of switches. The argument following this one will
|
||||
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
|
||||
.RE
|
||||
.TP
|
||||
\fB::tcl::process purge ?\fIpids\fR?
|
||||
.
|
||||
Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
|
||||
specified as a list of PIDs then the command only cleanup data for the matching
|
||||
subprocesses if they exist, and raises an error otherwise. If the process is
|
||||
still active then it does nothing.
|
||||
.TP
|
||||
\fB::tcl::process autopurge ?\fIflag\fR?
|
||||
.
|
||||
Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
|
||||
activates or deactivate autopurge. In all cases it returns the current status as
|
||||
a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
|
||||
each time the exec command is executed or a pipe channel created by open is
|
||||
closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
|
||||
explicitly. By default autopurge is active.
|
||||
.RE
|
||||
.SH "EXAMPLES"
|
||||
.PP
|
||||
.CS
|
||||
\fB::tcl::process autopurge\fR
|
||||
\fI\(-> true\fR
|
||||
\fB::tcl::process autopurge\fR false
|
||||
\fI\(-> false\fR
|
||||
|
||||
set pid1 [exec command1 a b c | command2 d e f &]
|
||||
\fI\(-> 123 456\fR
|
||||
set chan [open "|command1 a b c | command2 d e f"]
|
||||
\fI\(-> file123\fR
|
||||
set pid2 [pid $chan]
|
||||
\fI\(-> 789 1011\fR
|
||||
|
||||
\fB::tcl::process list\fR
|
||||
\fI\(-> 123 456 789 1011\fR
|
||||
|
||||
\fB::tcl::process status\fR
|
||||
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR
|
||||
|
||||
\fB::tcl::process status\fR 123
|
||||
\fI\(-> 123 0\fR
|
||||
|
||||
\fB::tcl::process status\fR 1011
|
||||
\fI\(-> 1011 {}\fR
|
||||
|
||||
\fB::tcl::process status\fR -wait
|
||||
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
|
||||
|
||||
\fB::tcl::process status\fR 1011
|
||||
\fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
|
||||
|
||||
\fB::tcl::process purge\fR
|
||||
exec command1 1 2 3 &
|
||||
\fI\(-> 1213\fR
|
||||
\fB::tcl::process list\fR
|
||||
\fI\(-> 1213\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
|
||||
.SH "KEYWORDS"
|
||||
background, child, detach, process, wait
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
+1
-6
@@ -32,12 +32,7 @@ implement the current call chain. The first element is the same as would be
|
||||
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
|
||||
also reports useful values from within constructors and destructors, whose
|
||||
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
|
||||
respectively,
|
||||
.VS TIP500
|
||||
and for private methods, which are described as being \fBprivate\fR instead of
|
||||
being a \fBmethod\fR),
|
||||
.VE TIP500
|
||||
and the second element is an index into the first element's
|
||||
respectively), and the second element is an index into the first element's
|
||||
list that indicates which actual implementation is currently executing (the
|
||||
first implementation to execute is always at index 0).
|
||||
.TP
|
||||
|
||||
@@ -1,99 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2018 Donal K. Fellows
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH singleton n 0.3 TclOO "TclOO Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
oo::singleton \- a class that does only allows one instance of itself
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBoo::singleton\fI method \fR?\fIarg ...\fR?
|
||||
.fi
|
||||
.SH "CLASS HIERARCHY"
|
||||
.nf
|
||||
\fBoo::object\fR
|
||||
\(-> \fBoo::class\fR
|
||||
\(-> \fBoo::singleton\fR
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
Singleton classes are classes that only permit at most one instance of
|
||||
themselves to exist. They unexport the \fBcreate\fR and
|
||||
\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
|
||||
so that it only makes a new instance if there is no existing instance. It is
|
||||
not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
|
||||
inherited. It is not recommended that a singleton class's constructor take any
|
||||
arguments.
|
||||
.PP
|
||||
Instances have their\fB destroy\fR method overridden with a method that always
|
||||
returns an error in order to discourage destruction of the object, but
|
||||
destruction remains possible if strictly necessary (e.g., by destroying the
|
||||
class or using \fBrename\fR to delete it). They also have a (non-exported)
|
||||
\fB<cloned>\fR method defined on them that similarly always returns errors to
|
||||
make attempts to use the singleton instance with \fBoo::copy\fR fail.
|
||||
.SS CONSTRUCTOR
|
||||
The \fBoo::singleton\fR class does not define an explicit constructor; this
|
||||
means that it is effectively the same as the constructor of the
|
||||
\fBoo::class\fR class.
|
||||
.SS DESTRUCTOR
|
||||
The \fBoo::singleton\fR class does not define an explicit destructor;
|
||||
destroying an instance of it is just like destroying an ordinary class (and
|
||||
will destroy the singleton object).
|
||||
.SS "EXPORTED METHODS"
|
||||
.TP
|
||||
\fIcls \fBnew \fR?\fIarg ...\fR?
|
||||
.
|
||||
This returns the current instance of the singleton class, if one exists, and
|
||||
creates a new instance only if there is no existing instance. The additional
|
||||
arguments, \fIarg ...\fR, are only used if a new instance is actually
|
||||
manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
|
||||
method.
|
||||
.RS
|
||||
.PP
|
||||
This is an override of the behaviour of a superclass's method with an
|
||||
identical call signature to the superclass's implementation.
|
||||
.RE
|
||||
.SS "NON-EXPORTED METHODS"
|
||||
The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
|
||||
\fBcreateWithNamespace\fR are unexported; callers should not assume that they
|
||||
have control over either the name or the namespace name of the singleton instance.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
This example demonstrates that there is only one instance even though the
|
||||
\fBnew\fR method is called three times.
|
||||
.PP
|
||||
.CS
|
||||
\fBoo::singleton\fR create Highlander {
|
||||
method say {} {
|
||||
puts "there can be only one"
|
||||
}
|
||||
}
|
||||
|
||||
set h1 [Highlander new]
|
||||
set h2 [Highlander new]
|
||||
if {$h1 eq $h2} {
|
||||
puts "equal objects" \fI\(-> prints "equal objects"\fR
|
||||
}
|
||||
set h3 [Highlander new]
|
||||
if {$h1 eq $h3} {
|
||||
puts "equal objects" \fI\(-> prints "equal objects"\fR
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
Note that the name of the instance of the singleton is not guaranteed to be
|
||||
anything in particular.
|
||||
.SH "SEE ALSO"
|
||||
oo::class(n)
|
||||
.SH KEYWORDS
|
||||
class, metaclass, object, single instance
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
@@ -143,15 +143,6 @@ incomplete commands.
|
||||
.SH "STANDARD CHANNELS"
|
||||
.PP
|
||||
See \fBTcl_StandardChannels\fR for more explanations.
|
||||
.SH ZIPVFS
|
||||
.PP
|
||||
When a zipfile is concatenated to the end of a \fBtclsh\fR, on
|
||||
startup the contents of the zip archive will be mounted as the
|
||||
virtual file system /zvfs. If a top level directory tcl8.6 is
|
||||
present in the zip archive, it will become the directory loaded
|
||||
as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
|
||||
in the top level directory of the zip archive, it will be sourced
|
||||
instead of the shell's normal command line handing.
|
||||
.SH "SEE ALSO"
|
||||
auto_path(n), encoding(n), env(n), fconfigure(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+2
-2
@@ -24,9 +24,9 @@ the result of that evaluation.
|
||||
If \fIlevel\fR is an integer then
|
||||
it gives a distance (up the procedure calling stack) to move before
|
||||
executing the command. If \fIlevel\fR consists of \fB#\fR followed by
|
||||
a integer then the level gives an absolute level. If \fIlevel\fR
|
||||
a number then the number gives an absolute level number. If \fIlevel\fR
|
||||
is omitted then it defaults to \fB1\fR. \fILevel\fR cannot be
|
||||
defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
|
||||
defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
|
||||
.PP
|
||||
For example, suppose that procedure \fBa\fR was invoked
|
||||
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
|
||||
|
||||
-70
@@ -1,70 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
|
||||
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
|
||||
'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com>
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount, \- handle ZIP files as VFS
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
.sp
|
||||
int
|
||||
\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR)
|
||||
.SH ARGUMENTS
|
||||
.AP "int" *argc in
|
||||
Number of command line arguments from main()
|
||||
.AP "char" ***argv in
|
||||
Pointer to an array of strings containing the command
|
||||
line arguments to main()
|
||||
.AS Tcl_Interp **termPtr
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter in which the zip file system is mounted. The interpreter's result is
|
||||
modified to hold the result or error message from the script.
|
||||
.AP "const char" *zipname in
|
||||
Name of a zipfile.
|
||||
.AP "const char" *mntpt in
|
||||
Name of a mount point.
|
||||
.AP "const char" *passwd in
|
||||
An (optional) password.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
\fBTclZipfs_AppHook()\fR is a utility function to perform standard
|
||||
application initialization procedures. If the current application has
|
||||
a mountable zip file system, that file system is mounted under \fIZIPROOT\fR\fB/app\fR.
|
||||
If a file named \fBmain.tcl\fR is located in that file system, it is treated
|
||||
as the startup script for the process. If the file \fIZIPROOT\fR\fB/app/tcl_library/init.tcl\fR
|
||||
is present, \fBtcl_library\fR is set to \fIZIPROOT\fR\fB/app/tcl_library.
|
||||
.PP
|
||||
On Windows, \fBTclZipfs_AppHook()\fR has a slightly different signature, it uses
|
||||
WCHAR in stead of char. As a result, it only works if your application is compiled
|
||||
using -DUNICODE.
|
||||
.PP
|
||||
If the \fBtcl_library\fR was not found in the application, the system will then search for it
|
||||
as either a VFS attached to the application dynamic library, or as a zip archive named
|
||||
libtcl_\fIMAJOR\fR_\fIMINOR\fR_\fIpatchLevel\fR.zip either in the present working directory
|
||||
or in the standard tcl install location.
|
||||
.PP
|
||||
\fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount
|
||||
point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR.
|
||||
Errors during that process are reported in the interpreter \fIinterp\fR.
|
||||
If \fImountpoint\fR is a NULL pointer, information on all currently mounted
|
||||
ZIP file systems is written into \fIinterp\fR's result as a sequence of
|
||||
mount points and ZIP file names.
|
||||
.PP
|
||||
\fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR,
|
||||
i.e. it unmounts the mounted ZIP file system at \fImountpoint\fR. Errors are
|
||||
reported in the interpreter \fIinterp\fR.
|
||||
.SH KEYWORDS
|
||||
compress, filesystem, zip
|
||||
-125
@@ -1,125 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
|
||||
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
|
||||
'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH zipfs n 1.0 Zipfs "zipfs Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
zipfs \- Mount and work with ZIP files within Tcl
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fBpackage require zipfs \fR?\fB1.0\fR?
|
||||
.sp
|
||||
\fBzipfs exists\fR \fIfilename\fR
|
||||
\fBzipfs find\fR \fIdir\fR
|
||||
\fBzipfs info\fR \fIfilename\fR
|
||||
\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
|
||||
\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
|
||||
\fBzipfs mkkey\fR \fIpassword\fR
|
||||
\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
|
||||
\fBzipfs mount\fR \fI?mountpoint?\fR \fI?zipfile?\fR \fI?password?\fR
|
||||
\fBzipfs root\fR
|
||||
\fBzipfs unmount\fR \fImountpoint\fR
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBzipfs\fR package provides tcl with the ability to mount
|
||||
the contents of a zip file as a virtual file system.
|
||||
.TP
|
||||
\fBzipfs exists\fR \fIfilename\fR
|
||||
.
|
||||
Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
|
||||
.TP
|
||||
\fBzipfs find\fR \fIdir\fR
|
||||
.
|
||||
Recursively lists files including and below the directory \fIdir\fR.
|
||||
The result list consists of relative path names starting from the
|
||||
given directory. This command is also used by the \fBzipfs mkzip\fR
|
||||
and \fBzipfs mkimg\fR commands.
|
||||
.TP
|
||||
\fBzipfs info\fR \fIfile\fR
|
||||
.
|
||||
Return information about the given file in the mounted zipfs. The information
|
||||
consists of (1) the name of the ZIP archive file that contains the file,
|
||||
(2) the size of the file after decompressions, (3) the compressed size of
|
||||
the file, and (4) the offset of the compressed data in the ZIP archive file.
|
||||
.RS
|
||||
.PP
|
||||
Note: querying the mount point gives the start of zip data offset in (4),
|
||||
which can be used to truncate the zip info off an executable.
|
||||
.RE
|
||||
.TP
|
||||
\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
|
||||
.
|
||||
Return a list of all files in the mounted zipfs. The order of the names
|
||||
in the list is arbitrary.
|
||||
.TP
|
||||
\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
|
||||
.
|
||||
Creates an image (potentially a new executable file) similar to
|
||||
\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified,
|
||||
this file is prepended in front of the ZIP archive, otherwise the file
|
||||
returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of
|
||||
the running process) is used. If the \fIpassword\fR parameter is not empty,
|
||||
an obfuscated version of that password is placed between the image and ZIP
|
||||
chunks of the output file and the contents of the ZIP chunk are protected
|
||||
with that password.
|
||||
.RS
|
||||
.PP
|
||||
Caution: highly experimental, not usable on Android, only partially tested
|
||||
on Linux and Windows.
|
||||
.RE
|
||||
.TP
|
||||
\fBzipfs mkkey\fR \fIpassword\fR
|
||||
.
|
||||
For the clear text \fIpassword\fR argument an obfuscated string version
|
||||
is returned with the same format used in the \fBzipfs mkimg\fR command.
|
||||
.TP
|
||||
\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
|
||||
.
|
||||
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
|
||||
directory \fIindir\fR (contained regular files only) with optional ZIP
|
||||
password \fIpassword\fR. While processing the files below \fIindir\fR the
|
||||
optional file name prefix given in \fIstrip\fR is stripped off the beginning
|
||||
of the respective file name.
|
||||
.RS
|
||||
.PP
|
||||
Caution: the choice of the \fIindir\fR parameter
|
||||
(less the optional stripped prefix) determines the later root name of the
|
||||
archive's content.
|
||||
.RE
|
||||
.TP
|
||||
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
|
||||
.
|
||||
The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS.
|
||||
After this command executes, files contained in \fIzipfile\fR
|
||||
will appear to Tcl to be regular files at the mount point.
|
||||
.RS
|
||||
.PP
|
||||
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.
|
||||
With no \fImountpoint\fR, return all zipfile/mount pairs.
|
||||
If \fImountpoint\fR is specified as an empty string, mount on file path.
|
||||
.RE
|
||||
.TP
|
||||
\fBzipfs root\fR
|
||||
Returns a constant string which indicates the mount point for zipfs volumes
|
||||
for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/
|
||||
.RE
|
||||
.TP
|
||||
\fBzipfs unmount \fImountpoint\fR
|
||||
.
|
||||
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
|
||||
.SH "SEE ALSO"
|
||||
tclsh(1), file(n), zlib(n)
|
||||
.SH "KEYWORDS"
|
||||
compress, filesystem, zip
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
+259
-265
@@ -137,8 +137,8 @@ static const crange alphaRangeTable[] = {
|
||||
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
|
||||
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
|
||||
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
|
||||
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
|
||||
{0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
|
||||
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
|
||||
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
|
||||
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
|
||||
{0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
|
||||
@@ -165,42 +165,45 @@ static const crange alphaRangeTable[] = {
|
||||
{0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
|
||||
{0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
|
||||
{0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
|
||||
{0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
|
||||
{0x1820, 0x1877}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
|
||||
{0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
|
||||
{0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
|
||||
{0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
|
||||
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba},
|
||||
{0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf},
|
||||
{0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
|
||||
{0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc},
|
||||
{0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb},
|
||||
{0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c},
|
||||
{0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139},
|
||||
{0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
|
||||
{0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67},
|
||||
{0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
|
||||
{0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
|
||||
{0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f},
|
||||
{0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e},
|
||||
{0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef},
|
||||
{0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f},
|
||||
{0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f},
|
||||
{0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
|
||||
{0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
|
||||
{0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
|
||||
{0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
|
||||
{0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
|
||||
{0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
|
||||
{0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
|
||||
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65},
|
||||
{0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
|
||||
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
|
||||
{0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
|
||||
{0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
|
||||
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
|
||||
{0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
|
||||
{0xffda, 0xffdc}
|
||||
#if CHRBITS > 16
|
||||
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec},
|
||||
{0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
|
||||
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
|
||||
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
|
||||
{0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
|
||||
{0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
|
||||
{0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
|
||||
{0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
|
||||
{0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
|
||||
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
|
||||
{0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
|
||||
{0x3105, 0x312e}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
|
||||
{0x3400, 0x4db5}, {0x4e00, 0x9fea}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
|
||||
{0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
|
||||
{0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae},
|
||||
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
|
||||
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
|
||||
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
|
||||
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
|
||||
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
|
||||
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
|
||||
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
|
||||
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
|
||||
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
|
||||
{0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
|
||||
{0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
|
||||
{0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
|
||||
{0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
|
||||
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
|
||||
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
|
||||
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
|
||||
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
|
||||
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
|
||||
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
|
||||
@@ -209,25 +212,23 @@ static const crange alphaRangeTable[] = {
|
||||
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
|
||||
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
|
||||
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
|
||||
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
|
||||
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
|
||||
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
|
||||
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
|
||||
{0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
|
||||
{0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
|
||||
{0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
|
||||
{0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
|
||||
{0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
|
||||
{0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae},
|
||||
{0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a},
|
||||
{0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
|
||||
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
|
||||
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
|
||||
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
|
||||
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
|
||||
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
|
||||
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
|
||||
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
|
||||
{0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
|
||||
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65},
|
||||
{0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
|
||||
{0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
|
||||
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
|
||||
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
|
||||
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
|
||||
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
|
||||
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
|
||||
{0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
|
||||
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
@@ -263,18 +264,17 @@ static const chr alphaCharTable[] = {
|
||||
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
|
||||
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
|
||||
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
|
||||
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1,
|
||||
0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43,
|
||||
0xfb44
|
||||
#if CHRBITS > 16
|
||||
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
|
||||
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
|
||||
0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
|
||||
0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644,
|
||||
0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46,
|
||||
0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2,
|
||||
0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
|
||||
0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
|
||||
0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
|
||||
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
|
||||
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
|
||||
0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
|
||||
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
|
||||
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
|
||||
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
|
||||
0x1ee64, 0x1ee7e
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -288,7 +288,7 @@ static const crange controlRangeTable[] = {
|
||||
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
|
||||
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
|
||||
{0xfff9, 0xfffb}
|
||||
#if CHRBITS > 16
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
|
||||
{0x100000, 0x10fffd}
|
||||
#endif
|
||||
@@ -298,8 +298,8 @@ static const crange controlRangeTable[] = {
|
||||
|
||||
static const chr controlCharTable[] = {
|
||||
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
|
||||
#if CHRBITS > 16
|
||||
,0x110bd, 0x110cd, 0xe0001
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x110bd, 0xe0001
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -320,12 +320,12 @@ static const crange digitRangeTable[] = {
|
||||
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
|
||||
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
|
||||
{0xff10, 0xff19}
|
||||
#if CHRBITS > 16
|
||||
,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
|
||||
{0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
|
||||
{0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
|
||||
{0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
|
||||
{0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
|
||||
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
|
||||
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
|
||||
{0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
|
||||
{0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -348,20 +348,19 @@ static const crange punctRangeTable[] = {
|
||||
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
|
||||
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
|
||||
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
|
||||
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
|
||||
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
|
||||
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
|
||||
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
|
||||
{0xff5f, 0xff65}
|
||||
#if CHRBITS > 16
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
|
||||
{0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
|
||||
{0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d},
|
||||
{0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c},
|
||||
{0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2},
|
||||
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a},
|
||||
{0x1da87, 0x1da8b}
|
||||
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
|
||||
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
|
||||
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
|
||||
{0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
|
||||
{0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -372,20 +371,18 @@ static const chr punctCharTable[] = {
|
||||
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
|
||||
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
|
||||
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
|
||||
0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14,
|
||||
0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c,
|
||||
0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
|
||||
0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
|
||||
0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
|
||||
0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
|
||||
0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
|
||||
0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
|
||||
0xff5b, 0xff5d
|
||||
#if CHRBITS > 16
|
||||
0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
|
||||
0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
|
||||
0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
|
||||
0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
|
||||
0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
|
||||
0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
|
||||
0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
|
||||
0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
|
||||
0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f,
|
||||
0x1e95e, 0x1e95f
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
|
||||
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -416,25 +413,25 @@ static const crange lowerRangeTable[] = {
|
||||
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
|
||||
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
|
||||
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
|
||||
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
|
||||
{0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
|
||||
{0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
|
||||
{0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
|
||||
{0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
|
||||
{0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
|
||||
{0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
|
||||
{0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
|
||||
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65},
|
||||
{0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
|
||||
#if CHRBITS > 16
|
||||
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
|
||||
{0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
|
||||
{0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
|
||||
{0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
|
||||
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
|
||||
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
|
||||
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
|
||||
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
|
||||
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
|
||||
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
|
||||
{0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
|
||||
{0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
|
||||
{0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
|
||||
{0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
|
||||
{0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
|
||||
{0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
|
||||
{0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
|
||||
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
|
||||
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
|
||||
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
|
||||
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
|
||||
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
|
||||
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
|
||||
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -504,8 +501,8 @@ static const chr lowerCharTable[] = {
|
||||
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
|
||||
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
|
||||
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
|
||||
0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa
|
||||
#if CHRBITS > 16
|
||||
0xa7b5, 0xa7b7, 0xa7fa
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1d4bb, 0x1d7cb
|
||||
#endif
|
||||
};
|
||||
@@ -521,22 +518,20 @@ static const crange upperRangeTable[] = {
|
||||
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
|
||||
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
|
||||
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
|
||||
{0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
|
||||
{0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
|
||||
{0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
|
||||
{0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
|
||||
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
|
||||
{0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
|
||||
{0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
|
||||
#if CHRBITS > 16
|
||||
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
|
||||
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
|
||||
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
|
||||
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
|
||||
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
|
||||
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
|
||||
{0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
|
||||
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
|
||||
{0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
|
||||
{0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
|
||||
{0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
|
||||
{0x1e900, 0x1e921}
|
||||
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
|
||||
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
|
||||
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
|
||||
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -605,9 +600,8 @@ static const chr upperCharTable[] = {
|
||||
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
|
||||
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
|
||||
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
|
||||
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
|
||||
0xa7b8
|
||||
#if CHRBITS > 16
|
||||
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
|
||||
0x1d539, 0x1d546, 0x1d7ca
|
||||
#endif
|
||||
@@ -622,80 +616,85 @@ static const chr upperCharTable[] = {
|
||||
static const crange graphRangeTable[] = {
|
||||
{0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
|
||||
{0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
|
||||
{0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
|
||||
{0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
|
||||
{0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
|
||||
{0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
|
||||
{0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
|
||||
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
|
||||
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83},
|
||||
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
|
||||
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
|
||||
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
|
||||
{0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
|
||||
{0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
|
||||
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
|
||||
{0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
|
||||
{0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
|
||||
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
|
||||
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c},
|
||||
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
|
||||
{0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
|
||||
{0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
|
||||
{0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
|
||||
{0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
|
||||
{0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
|
||||
{0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97},
|
||||
{0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd},
|
||||
{0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf},
|
||||
{0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc},
|
||||
{0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248},
|
||||
{0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
|
||||
{0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
|
||||
{0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
|
||||
{0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5},
|
||||
{0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
|
||||
{0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
|
||||
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
|
||||
{0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878},
|
||||
{0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
|
||||
{0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
|
||||
{0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
|
||||
{0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
|
||||
{0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
|
||||
{0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba},
|
||||
{0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15},
|
||||
{0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
|
||||
{0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
|
||||
{0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
|
||||
{0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c},
|
||||
{0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426},
|
||||
{0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8},
|
||||
{0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
|
||||
{0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
|
||||
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
|
||||
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a},
|
||||
{0x8a0, 0x8b4}, {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983},
|
||||
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
|
||||
{0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fd},
|
||||
{0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
|
||||
{0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75},
|
||||
{0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
|
||||
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9},
|
||||
{0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff},
|
||||
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
|
||||
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
|
||||
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
|
||||
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
|
||||
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
|
||||
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
|
||||
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
|
||||
{0xc66, 0xc6f}, {0xc78, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
|
||||
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
|
||||
{0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
|
||||
{0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44},
|
||||
{0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f},
|
||||
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
|
||||
{0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4},
|
||||
{0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f},
|
||||
{0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4},
|
||||
{0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47},
|
||||
{0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc},
|
||||
{0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d},
|
||||
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
|
||||
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
|
||||
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
|
||||
{0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
|
||||
{0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c},
|
||||
{0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c},
|
||||
{0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9},
|
||||
{0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa},
|
||||
{0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b},
|
||||
{0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
|
||||
{0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c},
|
||||
{0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe},
|
||||
{0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
|
||||
{0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf9},
|
||||
{0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
|
||||
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
|
||||
{0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
|
||||
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
|
||||
{0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
|
||||
{0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
|
||||
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
|
||||
{0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
|
||||
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
|
||||
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
|
||||
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
|
||||
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9},
|
||||
{0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
|
||||
{0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
|
||||
{0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
|
||||
{0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
|
||||
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
|
||||
{0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
|
||||
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
|
||||
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
|
||||
{0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
|
||||
{0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
|
||||
{0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
|
||||
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
|
||||
{0xffe0, 0xffe6}, {0xffe8, 0xffee}
|
||||
#if CHRBITS > 16
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {0xa000, 0xa48c},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
|
||||
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
|
||||
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
|
||||
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
|
||||
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
|
||||
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
|
||||
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
|
||||
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
|
||||
{0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
|
||||
{0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
|
||||
{0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
|
||||
{0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
|
||||
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
|
||||
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
|
||||
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
|
||||
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
|
||||
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
|
||||
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
|
||||
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
|
||||
@@ -706,85 +705,80 @@ static const crange graphRangeTable[] = {
|
||||
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
|
||||
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
|
||||
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
|
||||
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
|
||||
{0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
|
||||
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
|
||||
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
|
||||
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
|
||||
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
|
||||
{0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d},
|
||||
{0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8},
|
||||
{0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176},
|
||||
{0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211},
|
||||
{0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
|
||||
{0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303},
|
||||
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
|
||||
{0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c},
|
||||
{0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9},
|
||||
{0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659},
|
||||
{0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a},
|
||||
{0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2},
|
||||
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8},
|
||||
{0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
|
||||
{0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
|
||||
{0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
|
||||
{0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
|
||||
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
|
||||
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
|
||||
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
|
||||
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
|
||||
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
|
||||
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
|
||||
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
|
||||
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
|
||||
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
|
||||
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
|
||||
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
|
||||
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
|
||||
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
|
||||
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
|
||||
{0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
|
||||
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
|
||||
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
|
||||
{0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
|
||||
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
|
||||
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
|
||||
{0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
|
||||
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
|
||||
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
|
||||
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
|
||||
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
|
||||
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
|
||||
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
|
||||
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
|
||||
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
|
||||
{0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
|
||||
{0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
|
||||
{0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4},
|
||||
{0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8},
|
||||
{0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887},
|
||||
{0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970},
|
||||
{0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2},
|
||||
{0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
|
||||
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d},
|
||||
{0xe0100, 0xe01ef}
|
||||
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
|
||||
{0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
|
||||
{0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
|
||||
{0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
|
||||
{0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
|
||||
{0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
|
||||
{0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
|
||||
{0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
|
||||
{0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
|
||||
{0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
|
||||
{0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
|
||||
{0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
|
||||
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
|
||||
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
|
||||
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
|
||||
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
|
||||
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
|
||||
{0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
|
||||
{0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
|
||||
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
|
||||
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
|
||||
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
|
||||
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
|
||||
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
#endif
|
||||
};
|
||||
|
||||
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
|
||||
|
||||
static const chr graphCharTable[] = {
|
||||
0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
|
||||
0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
|
||||
0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
|
||||
0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
|
||||
0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
|
||||
0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
|
||||
0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87,
|
||||
0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7,
|
||||
0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d,
|
||||
0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41,
|
||||
0xfb43, 0xfb44, 0xfffc, 0xfffd
|
||||
#if CHRBITS > 16
|
||||
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
|
||||
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
|
||||
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
|
||||
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
|
||||
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
|
||||
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
|
||||
0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
|
||||
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
|
||||
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
|
||||
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
|
||||
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
|
||||
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08,
|
||||
0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e,
|
||||
0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
|
||||
0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
|
||||
0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
|
||||
0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
|
||||
0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
|
||||
0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
|
||||
0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
|
||||
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
|
||||
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
|
||||
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
+1
-1
@@ -91,7 +91,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */
|
||||
#if TCL_UTF_MAX > 4
|
||||
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
|
||||
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
|
||||
#define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
|
||||
#define CHR_MAX 0xffffffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
|
||||
#else
|
||||
#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
|
||||
#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
|
||||
|
||||
+31
-56
@@ -104,7 +104,7 @@ declare 20 {
|
||||
declare 21 {
|
||||
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
|
||||
}
|
||||
declare 22 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 22 {
|
||||
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
|
||||
}
|
||||
declare 23 {
|
||||
@@ -119,7 +119,7 @@ declare 25 {
|
||||
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
|
||||
const char *file, int line)
|
||||
}
|
||||
declare 26 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 26 {
|
||||
Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
|
||||
}
|
||||
declare 27 {
|
||||
@@ -152,7 +152,7 @@ declare 35 {
|
||||
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
double *doublePtr)
|
||||
}
|
||||
declare 36 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 36 {
|
||||
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
|
||||
}
|
||||
@@ -198,7 +198,7 @@ declare 48 {
|
||||
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
|
||||
int count, int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 49 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 49 {
|
||||
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
|
||||
}
|
||||
declare 50 {
|
||||
@@ -207,13 +207,13 @@ declare 50 {
|
||||
declare 51 {
|
||||
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
|
||||
}
|
||||
declare 52 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 52 {
|
||||
Tcl_Obj *Tcl_NewIntObj(int intValue)
|
||||
}
|
||||
declare 53 {
|
||||
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 54 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 54 {
|
||||
Tcl_Obj *Tcl_NewLongObj(long longValue)
|
||||
}
|
||||
declare 55 {
|
||||
@@ -222,7 +222,7 @@ declare 55 {
|
||||
declare 56 {
|
||||
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
|
||||
}
|
||||
declare 57 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 57 {
|
||||
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
|
||||
}
|
||||
declare 58 {
|
||||
@@ -235,13 +235,13 @@ declare 59 {
|
||||
declare 60 {
|
||||
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
|
||||
}
|
||||
declare 61 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 61 {
|
||||
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
|
||||
}
|
||||
declare 62 {
|
||||
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 63 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 63 {
|
||||
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
|
||||
}
|
||||
declare 64 {
|
||||
@@ -250,10 +250,10 @@ declare 64 {
|
||||
declare 65 {
|
||||
void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
|
||||
}
|
||||
declare 66 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 66 {
|
||||
void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
|
||||
}
|
||||
declare 67 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 67 {
|
||||
void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
|
||||
int length)
|
||||
}
|
||||
@@ -472,7 +472,7 @@ declare 129 {
|
||||
declare 130 {
|
||||
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
|
||||
}
|
||||
declare 131 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 131 {
|
||||
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 132 {
|
||||
@@ -624,7 +624,7 @@ declare 173 {
|
||||
declare 174 {
|
||||
const char *Tcl_GetStringResult(Tcl_Interp *interp)
|
||||
}
|
||||
declare 175 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 175 {
|
||||
const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags)
|
||||
}
|
||||
@@ -635,7 +635,7 @@ declare 176 {
|
||||
declare 177 {
|
||||
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
|
||||
}
|
||||
declare 178 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 178 {
|
||||
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 179 {
|
||||
@@ -834,7 +834,7 @@ declare 235 {
|
||||
declare 236 {
|
||||
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
|
||||
}
|
||||
declare 237 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 237 {
|
||||
const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags)
|
||||
}
|
||||
@@ -869,7 +869,7 @@ declare 245 {
|
||||
declare 246 {deprecated {}} {
|
||||
int Tcl_TellOld(Tcl_Channel chan)
|
||||
}
|
||||
declare 247 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 247 {
|
||||
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
|
||||
Tcl_VarTraceProc *proc, ClientData clientData)
|
||||
}
|
||||
@@ -890,14 +890,14 @@ declare 251 {
|
||||
declare 252 {
|
||||
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
|
||||
}
|
||||
declare 253 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 253 {
|
||||
int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
|
||||
}
|
||||
declare 254 {
|
||||
int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
|
||||
int flags)
|
||||
}
|
||||
declare 255 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 255 {
|
||||
void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
|
||||
Tcl_VarTraceProc *proc, ClientData clientData)
|
||||
}
|
||||
@@ -909,7 +909,7 @@ declare 256 {
|
||||
declare 257 {
|
||||
void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
|
||||
}
|
||||
declare 258 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 258 {
|
||||
int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
|
||||
const char *varName, const char *localName, int flags)
|
||||
}
|
||||
@@ -920,7 +920,7 @@ declare 259 {
|
||||
declare 260 {
|
||||
int Tcl_VarEval(Tcl_Interp *interp, ...)
|
||||
}
|
||||
declare 261 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 261 {
|
||||
ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
|
||||
int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
|
||||
}
|
||||
@@ -955,7 +955,7 @@ declare 270 {
|
||||
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr)
|
||||
}
|
||||
declare 271 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 271 {
|
||||
const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
@@ -964,12 +964,12 @@ declare 272 {
|
||||
const char *name, const char *version, int exact,
|
||||
void *clientDataPtr)
|
||||
}
|
||||
declare 273 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 273 {
|
||||
int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
const char *version)
|
||||
}
|
||||
# TIP #268: The internally used new Require function is in slot 573.
|
||||
declare 274 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 274 {
|
||||
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
@@ -1145,16 +1145,16 @@ declare 319 {
|
||||
Tcl_QueuePosition position)
|
||||
}
|
||||
declare 320 {
|
||||
int Tcl_UniCharAtIndex(const char *src, int index)
|
||||
Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
|
||||
}
|
||||
declare 321 {
|
||||
int Tcl_UniCharToLower(int ch)
|
||||
Tcl_UniChar Tcl_UniCharToLower(int ch)
|
||||
}
|
||||
declare 322 {
|
||||
int Tcl_UniCharToTitle(int ch)
|
||||
Tcl_UniChar Tcl_UniCharToTitle(int ch)
|
||||
}
|
||||
declare 323 {
|
||||
int Tcl_UniCharToUpper(int ch)
|
||||
Tcl_UniChar Tcl_UniCharToUpper(int ch)
|
||||
}
|
||||
declare 324 {
|
||||
int Tcl_UniCharToUtf(int ch, char *buf)
|
||||
@@ -1348,9 +1348,9 @@ declare 380 {
|
||||
int Tcl_GetCharLength(Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 381 {
|
||||
int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
|
||||
Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
|
||||
}
|
||||
declare 382 {deprecated {No longer in use, changed to macro}} {
|
||||
declare 382 {
|
||||
Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 383 {
|
||||
@@ -2330,31 +2330,10 @@ declare 631 {
|
||||
ClientData callbackData)
|
||||
}
|
||||
|
||||
# TIP #430
|
||||
declare 632 {
|
||||
int TclZipfs_Mount(
|
||||
Tcl_Interp *interp,
|
||||
const char *mntpt,
|
||||
const char *zipname,
|
||||
const char *passwd)
|
||||
}
|
||||
declare 633 {
|
||||
int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
|
||||
}
|
||||
declare 634 {
|
||||
Tcl_Obj *TclZipfs_TclLibrary(void)
|
||||
}
|
||||
declare 635 {
|
||||
int TclZipfs_Mount_Buffer(
|
||||
Tcl_Interp *interp,
|
||||
const char *mntpt,
|
||||
unsigned char *data,
|
||||
size_t datalen,
|
||||
int copy)
|
||||
}
|
||||
|
||||
# ----- BASELINE -- FOR -- 8.7.0 ----- #
|
||||
|
||||
|
||||
|
||||
##############################################################################
|
||||
|
||||
# Define the platform specific public Tcl interface. These functions are only
|
||||
@@ -2399,10 +2378,6 @@ declare 1 macosx {
|
||||
export {
|
||||
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
|
||||
}
|
||||
export {
|
||||
void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
|
||||
Tcl_Interp *interp)
|
||||
}
|
||||
export {
|
||||
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact)
|
||||
|
||||
+34
-20
@@ -89,10 +89,6 @@ extern "C" {
|
||||
# define JOIN(a,b) JOIN1(a,b)
|
||||
# define JOIN1(a,b) a##b
|
||||
#endif
|
||||
|
||||
#ifndef TCL_THREADS
|
||||
# define TCL_THREADS 1
|
||||
#endif
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
@@ -107,10 +103,15 @@ extern "C" {
|
||||
#ifndef RC_INVOKED
|
||||
|
||||
/*
|
||||
* Special macro to define mutexes.
|
||||
* Special macro to define mutexes, that doesn't do anything if we are not
|
||||
* using threads.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
|
||||
#else
|
||||
#define TCL_DECLARE_MUTEX(name)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
|
||||
@@ -2145,16 +2146,16 @@ typedef struct Tcl_EncodingType {
|
||||
|
||||
/*
|
||||
* The maximum number of bytes that are necessary to represent a single
|
||||
* Unicode character in UTF-8. The valid values are 4 and 6
|
||||
* (or perhaps 1 if we want to support a non-unicode enabled core). If 4,
|
||||
* then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
|
||||
* Unicode character in UTF-8. The valid values should be 3, 4 or 6
|
||||
* (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
|
||||
* 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
|
||||
* then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
|
||||
* is the default and recommended mode. UCS-4 is experimental and not
|
||||
* recommended. It works for the core, but most extensions expect UCS-2.
|
||||
*/
|
||||
|
||||
#ifndef TCL_UTF_MAX
|
||||
#define TCL_UTF_MAX 4
|
||||
#define TCL_UTF_MAX 3
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -2344,10 +2345,10 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following constant is used to test for older versions of Tcl in the
|
||||
* stubs tables. If TCL_UTF_MAX>4 use a different value.
|
||||
* stubs tables.
|
||||
*/
|
||||
|
||||
#define TCL_STUB_MAGIC ((int) 0xFCA3BACF + (TCL_UTF_MAX>4))
|
||||
#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
|
||||
|
||||
/*
|
||||
* The following function is required to be defined in all stubs aware
|
||||
@@ -2360,11 +2361,6 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact, int magic);
|
||||
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
const char *version, int epoch, int revision);
|
||||
#if defined(_WIN32)
|
||||
TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
|
||||
#else
|
||||
# define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
|
||||
#endif
|
||||
|
||||
#ifdef USE_TCL_STUBS
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
@@ -2396,15 +2392,12 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
*/
|
||||
|
||||
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
|
||||
(((Tcl_SetPanicProc)(Tcl_ConsolePanic), Tcl_CreateInterp)()))
|
||||
((Tcl_CreateInterp)()))
|
||||
EXTERN void Tcl_MainEx(int argc, char **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
|
||||
const char *version, int exact);
|
||||
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
#ifndef _WIN32
|
||||
EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2557,6 +2550,27 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
|
||||
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
|
||||
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Macros that eliminate the overhead of the thread synchronization functions
|
||||
* when compiling without thread support.
|
||||
*/
|
||||
|
||||
#ifndef TCL_THREADS
|
||||
#undef Tcl_MutexLock
|
||||
#define Tcl_MutexLock(mutexPtr)
|
||||
#undef Tcl_MutexUnlock
|
||||
#define Tcl_MutexUnlock(mutexPtr)
|
||||
#undef Tcl_MutexFinalize
|
||||
#define Tcl_MutexFinalize(mutexPtr)
|
||||
#undef Tcl_ConditionNotify
|
||||
#define Tcl_ConditionNotify(condPtr)
|
||||
#undef Tcl_ConditionWait
|
||||
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
|
||||
#undef Tcl_ConditionFinalize
|
||||
#define Tcl_ConditionFinalize(condPtr)
|
||||
#endif /* TCL_THREADS */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Deprecated Tcl functions:
|
||||
|
||||
+3
-3
@@ -22,7 +22,7 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)
|
||||
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
|
||||
|
||||
#if USE_TCLALLOC
|
||||
|
||||
@@ -121,7 +121,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */
|
||||
* variable.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
static Tcl_Mutex *allocMutexPtr;
|
||||
#endif
|
||||
static int allocInit = 0;
|
||||
@@ -171,7 +171,7 @@ TclInitAlloc(void)
|
||||
{
|
||||
if (!allocInit) {
|
||||
allocInit = 1;
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
allocMutexPtr = Tcl_GetAllocMutex();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -2253,7 +2253,7 @@ GetListIndexOperand(
|
||||
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
/* Convert to an integer, advance to the next token and return. */
|
||||
/*
|
||||
* NOTE: Indexing a list with an index before it yields the
|
||||
|
||||
+91
-152
@@ -71,18 +71,7 @@ typedef struct {
|
||||
} CancelInfo;
|
||||
static Tcl_HashTable cancelTable;
|
||||
static int cancelTableInitialized = 0; /* 0 means not yet initialized. */
|
||||
TCL_DECLARE_MUTEX(cancelLock);
|
||||
|
||||
/*
|
||||
* Table used to map command implementation functions to a human-readable type
|
||||
* name, for [info type]. The keys in the table are function addresses, and
|
||||
* the values in the table are static char* containing strings in Tcl's
|
||||
* internal encoding (almost UTF-8).
|
||||
*/
|
||||
|
||||
static Tcl_HashTable commandTypeTable;
|
||||
static int commandTypeInit = 0;
|
||||
TCL_DECLARE_MUTEX(commandTypeLock);
|
||||
TCL_DECLARE_MUTEX(cancelLock)
|
||||
|
||||
/*
|
||||
* Declarations for managing contexts for non-recursive coroutines. Contexts
|
||||
@@ -442,13 +431,6 @@ TclFinalizeEvaluation(void)
|
||||
cancelTableInitialized = 0;
|
||||
}
|
||||
Tcl_MutexUnlock(&cancelLock);
|
||||
|
||||
Tcl_MutexLock(&commandTypeLock);
|
||||
if (commandTypeInit) {
|
||||
Tcl_DeleteHashTable(&commandTypeTable);
|
||||
commandTypeInit = 0;
|
||||
}
|
||||
Tcl_MutexUnlock(&commandTypeLock);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -522,23 +504,9 @@ Tcl_CreateInterp(void)
|
||||
Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
|
||||
cancelTableInitialized = 1;
|
||||
}
|
||||
|
||||
Tcl_MutexUnlock(&cancelLock);
|
||||
}
|
||||
|
||||
if (commandTypeInit == 0) {
|
||||
TclRegisterCommandTypeName(TclObjInterpProc, "proc");
|
||||
TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
|
||||
TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
|
||||
TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
|
||||
TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
|
||||
TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
|
||||
TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
|
||||
TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
|
||||
TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
|
||||
TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
|
||||
}
|
||||
|
||||
/*
|
||||
* Initialize support for namespaces and create the global namespace
|
||||
* (whose name is ""; an alias is "::"). This also initializes the Tcl
|
||||
@@ -781,7 +749,7 @@ Tcl_CreateInterp(void)
|
||||
* cache was already initialised by the call to alloc the interp struct.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
iPtr->allocCache = TclpGetAllocCache();
|
||||
#else
|
||||
iPtr->allocCache = NULL;
|
||||
@@ -996,7 +964,7 @@ Tcl_CreateInterp(void)
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
TclpSetVariables(interp);
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* The existence of the "threaded" element of the tcl_platform array
|
||||
* indicates that this particular Tcl shell has been compiled with threads
|
||||
@@ -1031,9 +999,6 @@ Tcl_CreateInterp(void)
|
||||
if (TclZlibInit(interp) != TCL_OK) {
|
||||
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
|
||||
}
|
||||
if (TclZipfs_Init(interp) != TCL_OK) {
|
||||
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
|
||||
}
|
||||
#endif
|
||||
|
||||
TOP_CB(iPtr) = NULL;
|
||||
@@ -1049,71 +1014,6 @@ DeleteOpCmdClientData(
|
||||
ckfree(occdPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* ---------------------------------------------------------------------
|
||||
*
|
||||
* TclRegisterCommandTypeName, TclGetCommandTypeName --
|
||||
*
|
||||
* Command type registration and lookup mechanism. Everything is keyed by
|
||||
* the Tcl_ObjCmdProc for the command, and that is used as the *key* into
|
||||
* the hash table that maps to constant strings that are names. (It is
|
||||
* recommended that those names be ASCII.)
|
||||
*
|
||||
* ---------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclRegisterCommandTypeName(
|
||||
Tcl_ObjCmdProc *implementationProc,
|
||||
const char *nameStr)
|
||||
{
|
||||
Tcl_HashEntry *hPtr;
|
||||
|
||||
Tcl_MutexLock(&commandTypeLock);
|
||||
if (commandTypeInit == 0) {
|
||||
Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
|
||||
commandTypeInit = 1;
|
||||
}
|
||||
if (nameStr != NULL) {
|
||||
int isNew;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&commandTypeTable,
|
||||
(void *) implementationProc, &isNew);
|
||||
Tcl_SetHashValue(hPtr, (void *) nameStr);
|
||||
} else {
|
||||
hPtr = Tcl_FindHashEntry(&commandTypeTable,
|
||||
(void *) implementationProc);
|
||||
if (hPtr != NULL) {
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
}
|
||||
Tcl_MutexUnlock(&commandTypeLock);
|
||||
}
|
||||
|
||||
const char *
|
||||
TclGetCommandTypeName(
|
||||
Tcl_Command command)
|
||||
{
|
||||
Command *cmdPtr = (Command *) command;
|
||||
void *procPtr = cmdPtr->objProc;
|
||||
const char *name = "native";
|
||||
|
||||
if (procPtr == NULL) {
|
||||
procPtr = cmdPtr->nreProc;
|
||||
}
|
||||
Tcl_MutexLock(&commandTypeLock);
|
||||
if (commandTypeInit) {
|
||||
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);
|
||||
|
||||
if (hPtr && Tcl_GetHashValue(hPtr)) {
|
||||
name = (const char *) Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
}
|
||||
Tcl_MutexUnlock(&commandTypeLock);
|
||||
|
||||
return name;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2395,33 +2295,30 @@ Tcl_CreateObjCommand(
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclCreateObjCommandInNs(
|
||||
TclCreateObjCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName, /* Name of command, without any namespace
|
||||
* components. */
|
||||
const char *cmdName, /* Name of command, without any namespace components */
|
||||
Tcl_Namespace *namespace, /* The namespace to create the command in */
|
||||
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
|
||||
* name. */
|
||||
ClientData clientData, /* Arbitrary value to pass to object
|
||||
* function. */
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
Tcl_CmdDeleteProc *deleteProc
|
||||
/* If not NULL, gives a function to call when
|
||||
* this command is deleted. */
|
||||
{
|
||||
) {
|
||||
int deleted = 0, isNew = 0;
|
||||
Command *cmdPtr;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
ImportedCmdData *dataPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Namespace *nsPtr = (Namespace *) namespace;
|
||||
|
||||
/*
|
||||
* If the command name we seek to create already exists, we need to delete
|
||||
* that first. That can be tricky in the presence of traces. Loop until we
|
||||
* no longer find an existing command in the way, or until we've deleted
|
||||
* one command and that didn't finish the job.
|
||||
* If the command name we seek to create already exists, we need to
|
||||
* delete that first. That can be tricky in the presence of traces.
|
||||
* Loop until we no longer find an existing command in the way, or
|
||||
* until we've deleted one command and that didn't finish the job.
|
||||
*/
|
||||
|
||||
while (1) {
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
|
||||
|
||||
@@ -2433,18 +2330,16 @@ TclCreateObjCommandInNs(
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* An existing command conflicts. Try to delete it.
|
||||
*/
|
||||
|
||||
/* An existing command conflicts. Try to delete it.. */
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/*
|
||||
* [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
|
||||
* behavior is kept under particular circumstances to accommodate
|
||||
* deployed binaries of the "tclcompiler" program
|
||||
* http://sourceforge.net/projects/tclpro/
|
||||
* that crash if the bug is fixed.
|
||||
* [***] This is wrong. See Tcl Bug a16752c252.
|
||||
* However, this buggy behavior is kept under particular
|
||||
* circumstances to accommodate deployed binaries of the
|
||||
* "tclcompiler" program. http://sourceforge.net/projects/tclpro/
|
||||
* that crash if the bug is fixed.
|
||||
*/
|
||||
|
||||
if (cmdPtr->objProc == TclInvokeStringCommand
|
||||
@@ -2468,15 +2363,12 @@ TclCreateObjCommandInNs(
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
}
|
||||
|
||||
/*
|
||||
* Make sure namespace doesn't get deallocated.
|
||||
*/
|
||||
|
||||
/* Make sure namespace doesn't get deallocated. */
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
|
||||
nsPtr = (Namespace *) TclEnsureNamespace(interp,
|
||||
(Tcl_Namespace *) cmdPtr->nsPtr);
|
||||
(Tcl_Namespace *)cmdPtr->nsPtr);
|
||||
TclNsDecrRefCount(cmdPtr->nsPtr);
|
||||
|
||||
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
|
||||
@@ -2488,9 +2380,9 @@ TclCreateObjCommandInNs(
|
||||
}
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away the
|
||||
* new command (if we try to delete it again, we could get stuck in an
|
||||
* infinite loop).
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
*/
|
||||
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
@@ -2545,7 +2437,6 @@ TclCreateObjCommandInNs(
|
||||
cmdPtr->importRefPtr = oldRefPtr;
|
||||
while (oldRefPtr != NULL) {
|
||||
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
|
||||
dataPtr = refCmdPtr->objClientData;
|
||||
dataPtr->realCmdPtr = cmdPtr;
|
||||
oldRefPtr = oldRefPtr->nextPtr;
|
||||
@@ -7613,7 +7504,7 @@ ExprAbsFunc(
|
||||
}
|
||||
}
|
||||
goto unChanged;
|
||||
} else if (l == WIDE_MIN) {
|
||||
} else if (l == LLONG_MIN) {
|
||||
TclInitBignumFromWideInt(&big, l);
|
||||
goto tooLarge;
|
||||
}
|
||||
@@ -7738,7 +7629,7 @@ ExprEntierFunc(
|
||||
|
||||
if (type == TCL_NUMBER_DOUBLE) {
|
||||
d = *((const double *) ptr);
|
||||
if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
|
||||
if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
|
||||
mp_int big;
|
||||
|
||||
if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
|
||||
@@ -7748,9 +7639,9 @@ ExprEntierFunc(
|
||||
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
|
||||
return TCL_OK;
|
||||
} else {
|
||||
Tcl_WideInt result = (Tcl_WideInt) d;
|
||||
long result = (long) d;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
@@ -7780,14 +7671,27 @@ ExprIntFunc(
|
||||
int objc, /* Actual parameter count. */
|
||||
Tcl_Obj *const *objv) /* Actual parameter vector. */
|
||||
{
|
||||
Tcl_WideInt wResult;
|
||||
long iResult;
|
||||
Tcl_Obj *objPtr;
|
||||
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objPtr = Tcl_GetObjResult(interp);
|
||||
TclGetWideBitsFromObj(NULL, objPtr, &wResult);
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj((long)wResult));
|
||||
if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
|
||||
/*
|
||||
* Truncate the bignum; keep only bits in long range.
|
||||
*/
|
||||
|
||||
mp_int big;
|
||||
|
||||
Tcl_GetBignumFromObj(NULL, objPtr, &big);
|
||||
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
|
||||
objPtr = Tcl_NewBignumObj(&big);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
TclGetLongFromObj(NULL, objPtr, &iResult);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -7800,11 +7704,26 @@ ExprWideFunc(
|
||||
Tcl_Obj *const *objv) /* Actual parameter vector. */
|
||||
{
|
||||
Tcl_WideInt wResult;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
|
||||
objPtr = Tcl_GetObjResult(interp);
|
||||
if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
|
||||
/*
|
||||
* Truncate the bignum; keep only bits in wide int range.
|
||||
*/
|
||||
|
||||
mp_int big;
|
||||
|
||||
Tcl_GetBignumFromObj(NULL, objPtr, &big);
|
||||
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
|
||||
objPtr = Tcl_NewBignumObj(&big);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
TclGetWideIntFromObj(NULL, objPtr, &wResult);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -7907,7 +7826,7 @@ ExprRandFunc(
|
||||
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
|
||||
*/
|
||||
|
||||
iPtr->randSeed &= 0x7fffffff;
|
||||
iPtr->randSeed &= (unsigned long) 0x7fffffff;
|
||||
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
|
||||
iPtr->randSeed ^= 123459876;
|
||||
}
|
||||
@@ -8051,7 +7970,7 @@ ExprSrandFunc(
|
||||
Tcl_Obj *const *objv) /* Parameter vector. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */
|
||||
long i = 0; /* Initialized to avoid compiler warning. */
|
||||
|
||||
/*
|
||||
* Convert argument and use it to reset the seed.
|
||||
@@ -8062,8 +7981,20 @@ ExprSrandFunc(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
|
||||
Tcl_Obj *objPtr;
|
||||
mp_int big;
|
||||
|
||||
if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
|
||||
/* TODO: more ::errorInfo here? or in caller? */
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
|
||||
objPtr = Tcl_NewBignumObj(&big);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
TclGetLongFromObj(NULL, objPtr, &i);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -8072,7 +8003,8 @@ ExprSrandFunc(
|
||||
*/
|
||||
|
||||
iPtr->flags |= RAND_SEED_INITIALIZED;
|
||||
iPtr->randSeed = (long) w & 0x7fffffff;
|
||||
iPtr->randSeed = i;
|
||||
iPtr->randSeed &= (unsigned long) 0x7fffffff;
|
||||
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
|
||||
iPtr->randSeed ^= 123459876;
|
||||
}
|
||||
@@ -8344,26 +8276,23 @@ Tcl_NRCreateCommand(
|
||||
* this command is deleted. */
|
||||
{
|
||||
Command *cmdPtr = (Command *)
|
||||
Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
|
||||
deleteProc);
|
||||
Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
|
||||
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclNRCreateCommandInNs(
|
||||
TclNRCreateCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
{
|
||||
Tcl_CmdDeleteProc *deleteProc) {
|
||||
Command *cmdPtr = (Command *)
|
||||
TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
|
||||
deleteProc);
|
||||
TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
|
||||
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
@@ -8467,6 +8396,7 @@ TclPushTailcallPoint(
|
||||
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
|
||||
((Interp *) interp)->numLevels++;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -8502,6 +8432,7 @@ TclSetTailcall(
|
||||
}
|
||||
runPtr->data[1] = listPtr;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -8559,18 +8490,25 @@ TclNRTailcallObjCmd(
|
||||
if (objc > 1) {
|
||||
Tcl_Obj *listPtr, *nsObjPtr;
|
||||
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
|
||||
Tcl_Namespace *ns1Ptr;
|
||||
|
||||
/* The tailcall data is in a Tcl list: the first element is the
|
||||
* namespace, the rest the command to be tailcalled. */
|
||||
|
||||
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
listPtr = Tcl_NewListObj(objc, objv);
|
||||
|
||||
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|
||||
|| (nsPtr != ns1Ptr)) {
|
||||
Tcl_Panic("Tailcall failed to find the proper namespace");
|
||||
}
|
||||
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
|
||||
|
||||
iPtr->varFramePtr->tailcallPtr = listPtr;
|
||||
}
|
||||
return TCL_RETURN;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -8638,6 +8576,7 @@ TclNRReleaseValues(
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Tcl_NRAddCallback(
|
||||
|
||||
+18
-17
@@ -1963,6 +1963,7 @@ FormatNumber(
|
||||
Tcl_Obj *src, /* Number to format. */
|
||||
unsigned char **cursorPtr) /* Pointer to index into destination buffer. */
|
||||
{
|
||||
long value;
|
||||
double dvalue;
|
||||
Tcl_WideInt wvalue;
|
||||
float fvalue;
|
||||
@@ -2024,7 +2025,7 @@ FormatNumber(
|
||||
case 'w':
|
||||
case 'W':
|
||||
case 'm':
|
||||
if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
|
||||
if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (NeedReversing(type)) {
|
||||
@@ -2054,19 +2055,19 @@ FormatNumber(
|
||||
case 'i':
|
||||
case 'I':
|
||||
case 'n':
|
||||
if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
|
||||
if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (NeedReversing(type)) {
|
||||
*(*cursorPtr)++ = UCHAR(wvalue);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 16);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 24);
|
||||
*(*cursorPtr)++ = UCHAR(value);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 16);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 24);
|
||||
} else {
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 24);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 16);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 24);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 16);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(value);
|
||||
}
|
||||
return TCL_OK;
|
||||
|
||||
@@ -2076,15 +2077,15 @@ FormatNumber(
|
||||
case 's':
|
||||
case 'S':
|
||||
case 't':
|
||||
if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
|
||||
if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (NeedReversing(type)) {
|
||||
*(*cursorPtr)++ = UCHAR(wvalue);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(value);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 8);
|
||||
} else {
|
||||
*(*cursorPtr)++ = UCHAR(wvalue >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(wvalue);
|
||||
*(*cursorPtr)++ = UCHAR(value >> 8);
|
||||
*(*cursorPtr)++ = UCHAR(value);
|
||||
}
|
||||
return TCL_OK;
|
||||
|
||||
@@ -2092,10 +2093,10 @@ FormatNumber(
|
||||
* 8-bit integer values.
|
||||
*/
|
||||
case 'c':
|
||||
if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
|
||||
if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*(*cursorPtr)++ = UCHAR(wvalue);
|
||||
*(*cursorPtr)++ = UCHAR(value);
|
||||
return TCL_OK;
|
||||
|
||||
default:
|
||||
|
||||
@@ -156,7 +156,7 @@ TclInitDbCkalloc(void)
|
||||
if (!ckallocInit) {
|
||||
ckallocInit = 1;
|
||||
ckallocMutexPtr = Tcl_GetAllocMutex();
|
||||
#if !TCL_THREADS
|
||||
#ifndef TCL_THREADS
|
||||
/* Silence compiler warning */
|
||||
(void)ckallocMutexPtr;
|
||||
#endif
|
||||
|
||||
+61
-4
@@ -513,6 +513,63 @@ Tcl_ContinueObjCmd(
|
||||
return TCL_CONTINUE;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EncodingObjCmd --
|
||||
*
|
||||
* This command manipulates encodings.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* See the user documentation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_EncodingObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int index;
|
||||
|
||||
static const char *const optionStrings[] = {
|
||||
"convertfrom", "convertto", "dirs", "names", "system",
|
||||
NULL
|
||||
};
|
||||
enum options {
|
||||
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
|
||||
&index) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
switch ((enum options) index) {
|
||||
case ENC_CONVERTTO:
|
||||
return EncodingConverttoObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_CONVERTFROM:
|
||||
return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_DIRS:
|
||||
return EncodingDirsObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_NAMES:
|
||||
return EncodingNamesObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_SYSTEM:
|
||||
return EncodingSystemObjCmd(dummy, interp, objc, objv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
@@ -1398,9 +1455,9 @@ FileAttrAccessTimeCmd(
|
||||
* platforms. [Bug 698146]
|
||||
*/
|
||||
|
||||
Tcl_WideInt newTime;
|
||||
long newTime;
|
||||
|
||||
if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
|
||||
if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1479,9 +1536,9 @@ FileAttrModifyTimeCmd(
|
||||
* platforms. [Bug 698146]
|
||||
*/
|
||||
|
||||
Tcl_WideInt newTime;
|
||||
long newTime;
|
||||
|
||||
if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
|
||||
if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
+16
-62
@@ -138,8 +138,6 @@ static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
|
||||
@@ -158,7 +156,6 @@ static const EnsembleImplMap defaultInfoMap[] = {
|
||||
{"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
|
||||
{"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
|
||||
{"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0},
|
||||
{"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
|
||||
@@ -2132,60 +2129,6 @@ InfoTclVersionCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* InfoCmdTypeCmd --
|
||||
*
|
||||
* Called to implement the "info cmdtype" command that returns the type
|
||||
* of a given command. Handles the following syntax:
|
||||
*
|
||||
* info cmdtype cmdName
|
||||
*
|
||||
* Results:
|
||||
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
|
||||
*
|
||||
* Side effects:
|
||||
* Returns a type name. If there is an error, the result is an error
|
||||
* message.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
InfoCmdTypeCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Command command;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "commandName");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
|
||||
TCL_LEAVE_ERR_MSG);
|
||||
if (command == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* There's one special case: safe slave interpreters can't see aliases as
|
||||
* aliases as they're part of the security mechanisms.
|
||||
*/
|
||||
|
||||
if (Tcl_IsSafe(interp)
|
||||
&& (((Command *) command)->objProc == TclAliasObjCmd)) {
|
||||
Tcl_AppendResult(interp, "native", NULL);
|
||||
} else {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2787,10 +2730,21 @@ Tcl_LreplaceObjCmd(
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
if (first > listLen) {
|
||||
first = listLen;
|
||||
}
|
||||
|
||||
/*
|
||||
* Complain if the user asked for a start element that is greater than the
|
||||
* list length. This won't ever trigger for the "end-*" case as that will
|
||||
* be properly constrained by TclGetIntForIndex because we use listLen-1
|
||||
* (to allow for replacing the last elem).
|
||||
*/
|
||||
|
||||
if ((first >= listLen) && (listLen > 0)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %s", TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (last >= listLen) {
|
||||
last = listLen - 1;
|
||||
}
|
||||
@@ -3379,7 +3333,7 @@ Tcl_LsearchObjCmd(
|
||||
* sense in doing this when the match sense is inverted.
|
||||
*/
|
||||
|
||||
/*
|
||||
/*
|
||||
* With -stride, lower, upper and i are kept as multiples of groupSize.
|
||||
*/
|
||||
|
||||
@@ -4061,7 +4015,7 @@ Tcl_LsortObjCmd(
|
||||
/*
|
||||
* Do not shrink the actual memory block used; that doesn't
|
||||
* work with TclStackAlloc-allocated memory. [Bug 2918962]
|
||||
*
|
||||
*
|
||||
* TODO: Consider a pointer increment to replace this
|
||||
* array shift.
|
||||
*/
|
||||
|
||||
+184
-59
@@ -491,7 +491,7 @@ Tcl_RegsubObjCmd(
|
||||
Tcl_RegExp regExpr;
|
||||
Tcl_RegExpInfo info;
|
||||
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
|
||||
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;
|
||||
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
|
||||
|
||||
static const char *const options[] = {
|
||||
"-all", "-command", "-expanded", "-line",
|
||||
@@ -597,9 +597,9 @@ Tcl_RegsubObjCmd(
|
||||
* slightly modified version of the one pair STR_MAP code.
|
||||
*/
|
||||
|
||||
int slen, nocase, wsrclc;
|
||||
int slen, nocase;
|
||||
int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
|
||||
Tcl_UniChar *p;
|
||||
Tcl_UniChar *p, wsrclc;
|
||||
|
||||
numMatches = 0;
|
||||
nocase = (cflags & TCL_REG_NOCASE);
|
||||
@@ -1220,7 +1220,7 @@ Tcl_SplitObjCmd(
|
||||
len = TclUtfToUniChar(stringPtr, &ch);
|
||||
fullchar = ch;
|
||||
|
||||
#if TCL_UTF_MAX <= 4
|
||||
#if TCL_UTF_MAX == 4
|
||||
if (!len) {
|
||||
len += TclUtfToUniChar(stringPtr, &ch);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
|
||||
@@ -1419,7 +1419,7 @@ StringIndexCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the char length to calculate what 'end' means.
|
||||
* Get the char length to calulate what 'end' means.
|
||||
*/
|
||||
|
||||
length = Tcl_GetCharLength(objv[1]);
|
||||
@@ -1428,11 +1428,7 @@ StringIndexCmd(
|
||||
}
|
||||
|
||||
if ((index >= 0) && (index < length)) {
|
||||
int ch = Tcl_GetUniChar(objv[1], index);
|
||||
|
||||
if (ch == -1) {
|
||||
return TCL_OK;
|
||||
}
|
||||
Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
|
||||
|
||||
/*
|
||||
* If we have a ByteArray object, we're careful to generate a new
|
||||
@@ -1444,12 +1440,9 @@ StringIndexCmd(
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[4];
|
||||
char buf[TCL_UTF_MAX];
|
||||
|
||||
length = Tcl_UniCharToUtf(ch, buf);
|
||||
if (!length) {
|
||||
length = Tcl_UniCharToUtf(-1, buf);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
|
||||
}
|
||||
}
|
||||
@@ -1810,7 +1803,7 @@ StringIsCmd(
|
||||
int fullchar;
|
||||
length2 = TclUtfToUniChar(string1, &ch);
|
||||
fullchar = ch;
|
||||
#if TCL_UTF_MAX <= 4
|
||||
#if TCL_UTF_MAX == 4
|
||||
if (!length2) {
|
||||
length2 = TclUtfToUniChar(string1, &ch);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
|
||||
@@ -2004,8 +1997,8 @@ StringMapCmd(
|
||||
* larger strings.
|
||||
*/
|
||||
|
||||
int mapLen, u2lc;
|
||||
Tcl_UniChar *mapString;
|
||||
int mapLen;
|
||||
Tcl_UniChar *mapString, u2lc;
|
||||
|
||||
ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
|
||||
p = ustring1;
|
||||
@@ -2036,8 +2029,8 @@ StringMapCmd(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
Tcl_UniChar **mapStrings;
|
||||
int *mapLens, *u2lc = NULL;
|
||||
Tcl_UniChar **mapStrings, *u2lc = NULL;
|
||||
int *mapLens;
|
||||
|
||||
/*
|
||||
* Precompute pointers to the unicode string and length. This saves us
|
||||
@@ -2049,7 +2042,7 @@ StringMapCmd(
|
||||
mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
|
||||
mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
|
||||
if (nocase) {
|
||||
u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
|
||||
u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
|
||||
}
|
||||
for (index = 0; index < mapElemc; index++) {
|
||||
mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
|
||||
@@ -2549,8 +2542,10 @@ StringEqualCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
const char *string2;
|
||||
int length, i, match, nocase = 0, reqlength = -1;
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
@@ -2560,11 +2555,11 @@ StringEqualCmd(
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length);
|
||||
if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
nocase = 1;
|
||||
} else if ((length > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length)) {
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
@@ -2589,7 +2584,78 @@ StringEqualCmd(
|
||||
|
||||
objv += objc-2;
|
||||
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
if ((reqlength < 0) && (length1 != length2)) {
|
||||
match = 1; /* This will be reversed below. */
|
||||
} else {
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it
|
||||
* to length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = length1 - length2;
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
|
||||
return TCL_OK;
|
||||
@@ -2626,31 +2692,11 @@ StringCmpCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
int match, nocase, reqlength, status;
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
|
||||
status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
}
|
||||
|
||||
objv += objc-2;
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int TclStringCmpOpts(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[], /* Argument objects. */
|
||||
int *nocase,
|
||||
int *reqlength)
|
||||
{
|
||||
int i, length;
|
||||
const char *string;
|
||||
|
||||
*reqlength = -1;
|
||||
*nocase = 0;
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
@@ -2659,27 +2705,106 @@ int TclStringCmpOpts(
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string = TclGetStringFromObj(objv[i], &length);
|
||||
if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) {
|
||||
*nocase = 1;
|
||||
} else if ((length > 1)
|
||||
&& !strncmp(string, "-length", (size_t)length)) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
nocase = 1;
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
|
||||
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad option \"%s\": must be -nocase or -length",
|
||||
string));
|
||||
string2));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
|
||||
string, NULL);
|
||||
string2, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* From now on, we only access the two objects at the end of the argument
|
||||
* array.
|
||||
*/
|
||||
|
||||
objv += objc-2;
|
||||
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it to
|
||||
* length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = length1 - length2;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
+3
-15
@@ -322,22 +322,11 @@ TclCompileArraySetCmd(
|
||||
*/
|
||||
|
||||
if (isDataValid && !isDataEven) {
|
||||
/* Abandon custom compile and let invocation raise the error */
|
||||
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
|
||||
goto done;
|
||||
|
||||
/*
|
||||
* We used to compile to the bytecode that would throw the error,
|
||||
* but that was wrong because it would not invoke the array trace
|
||||
* on the variable.
|
||||
*
|
||||
PushStringLiteral(envPtr, "list must have an even number of elements");
|
||||
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
|
||||
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
|
||||
TclEmitInt4( 0, envPtr);
|
||||
goto done;
|
||||
*
|
||||
*/
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -415,10 +404,6 @@ TclCompileArraySetCmd(
|
||||
* Start issuing instructions to write to the array.
|
||||
*/
|
||||
|
||||
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
|
||||
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
|
||||
|
||||
CompileWord(envPtr, dataTokenPtr, interp, 2);
|
||||
if (!isDataLiteral || !isDataValid) {
|
||||
/*
|
||||
@@ -443,6 +428,9 @@ TclCompileArraySetCmd(
|
||||
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
|
||||
}
|
||||
|
||||
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
|
||||
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
|
||||
offsetBack = CurrentOffset(envPtr);
|
||||
Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
|
||||
|
||||
+77
-28
@@ -27,6 +27,7 @@ static void CompileReturnInternal(CompileEnv *envPtr,
|
||||
Tcl_Obj *returnOpts);
|
||||
static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -34,7 +35,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
* TclGetIndexFromToken --
|
||||
*
|
||||
* Parse a token to determine if an index value is known at
|
||||
* compile time.
|
||||
* compile time.
|
||||
*
|
||||
* Returns:
|
||||
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
|
||||
@@ -126,12 +127,9 @@ TclCompileGlobalCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* TODO: Consider what value can pass through the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord() likely does not
|
||||
* apply here. Push known value instead.
|
||||
*/
|
||||
|
||||
/* TODO: Consider what value can pass through the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
|
||||
}
|
||||
@@ -272,7 +270,7 @@ TclCompileIfCmd(
|
||||
jumpIndex = jumpFalseFixupArray.next;
|
||||
jumpFalseFixupArray.next++;
|
||||
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
|
||||
jumpFalseFixupArray.fixup + jumpIndex);
|
||||
jumpFalseFixupArray.fixup+jumpIndex);
|
||||
}
|
||||
code = TCL_OK;
|
||||
}
|
||||
@@ -319,7 +317,7 @@ TclCompileIfCmd(
|
||||
}
|
||||
jumpEndFixupArray.next++;
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
|
||||
jumpEndFixupArray.fixup + jumpIndex);
|
||||
jumpEndFixupArray.fixup+jumpIndex);
|
||||
|
||||
/*
|
||||
* Fix the target of the jumpFalse after the test. Generate a 4
|
||||
@@ -331,7 +329,7 @@ TclCompileIfCmd(
|
||||
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
if (TclFixupForwardJumpToHere(envPtr,
|
||||
jumpFalseFixupArray.fixup + jumpIndex, 120)) {
|
||||
jumpFalseFixupArray.fixup+jumpIndex, 120)) {
|
||||
/*
|
||||
* Adjust the code offset for the proceeding jump to the end
|
||||
* of the "if" command.
|
||||
@@ -414,7 +412,7 @@ TclCompileIfCmd(
|
||||
for (j = jumpEndFixupArray.next; j > 0; j--) {
|
||||
jumpIndex = (j - 1); /* i.e. process the closest jump first. */
|
||||
if (TclFixupForwardJumpToHere(envPtr,
|
||||
jumpEndFixupArray.fixup + jumpIndex, 127)) {
|
||||
jumpEndFixupArray.fixup+jumpIndex, 127)) {
|
||||
/*
|
||||
* Adjust the immediately preceeding "ifFalse" jump. We moved it's
|
||||
* target (just after this jump) down three bytes.
|
||||
@@ -922,7 +920,7 @@ TclCompileLappendCmd(
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i);
|
||||
valueTokenPtr = TokenAfter(valueTokenPtr);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
|
||||
@@ -999,7 +997,7 @@ TclCompileLassignCmd(
|
||||
*/
|
||||
|
||||
PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
|
||||
&isScalar, idx + 2);
|
||||
&isScalar, idx+2);
|
||||
|
||||
/*
|
||||
* Emit instructions to get the idx'th item out of the list value on
|
||||
@@ -1416,7 +1414,7 @@ TclCompileLinsertCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, i - 3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST, i-3, envPtr);
|
||||
|
||||
if (idx == TCL_INDEX_START) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
@@ -1441,7 +1439,7 @@ TclCompileLinsertCmd(
|
||||
}
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx - 1, envPtr);
|
||||
TclEmitInt4( idx-1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
@@ -1474,7 +1472,7 @@ TclCompileLreplaceCmd(
|
||||
{
|
||||
Tcl_Token *tokenPtr, *listTokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int idx1, idx2, i;
|
||||
int idx1, idx2, i, offset, offset2;
|
||||
int emptyPrefix=1, suffixStart = 0;
|
||||
|
||||
if (parsePtr->numWords < 4) {
|
||||
@@ -1494,6 +1492,23 @@ TclCompileLreplaceCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* idx1, idx2 are the conventional encoded forms of the tokens parsed
|
||||
* as all forms of index values. Values of idx1 that come before the
|
||||
* list are treated the same as if they were the start of the list.
|
||||
* Values of idx2 that come after the list are treated the same as if
|
||||
* they were the end of the list.
|
||||
*/
|
||||
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
/*
|
||||
* [lreplace] treats idx1 value end+1 differently from end+2, etc.
|
||||
* The operand encoding cannot distinguish them, so we must bail
|
||||
* out to direct evaluation.
|
||||
*/
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* General structure of the [lreplace] result is
|
||||
* prefix replacement suffix
|
||||
@@ -1505,9 +1520,7 @@ TclCompileLreplaceCmd(
|
||||
* we must defer to direct evaluation.
|
||||
*/
|
||||
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
suffixStart = idx1;
|
||||
} else if (idx2 == TCL_INDEX_BEFORE) {
|
||||
if (idx2 == TCL_INDEX_BEFORE) {
|
||||
suffixStart = idx1;
|
||||
} else if (idx2 == TCL_INDEX_END) {
|
||||
suffixStart = TCL_INDEX_AFTER;
|
||||
@@ -1538,6 +1551,42 @@ TclCompileLreplaceCmd(
|
||||
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* [lreplace] raises an error when idx1 points after the list, but
|
||||
* only when the list is not empty. This is maximum stupidity.
|
||||
*
|
||||
* TODO: TIP this nonsense away!
|
||||
*/
|
||||
if (idx1 >= TCL_INDEX_START) {
|
||||
if (emptyPrefix) {
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
|
||||
/* List is not empty */
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
|
||||
NULL), envPtr);
|
||||
TclEmitOpcode( INST_GT, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
|
||||
|
||||
/* Idx1 >= list length ===> raise an error */
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
}
|
||||
|
||||
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
|
||||
/*
|
||||
@@ -2185,7 +2234,7 @@ TclCompileRegexpCmd(
|
||||
}
|
||||
|
||||
if (!simple) {
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2193,7 +2242,7 @@ TclCompileRegexpCmd(
|
||||
*/
|
||||
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
|
||||
|
||||
if (simple) {
|
||||
if (exact && !nocase) {
|
||||
@@ -2377,7 +2426,7 @@ TclCompileRegsubCmd(
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
bytes = TclGetStringFromObj(replacementObj, &len);
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
|
||||
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
|
||||
TclEmitOpcode( INST_STR_MAP, envPtr);
|
||||
|
||||
done:
|
||||
@@ -2506,7 +2555,7 @@ TclCompileReturnCmd(
|
||||
*/
|
||||
|
||||
if (explicitResult) {
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
|
||||
} else {
|
||||
/*
|
||||
* No explict result argument, so default result is empty string.
|
||||
@@ -2584,7 +2633,7 @@ TclCompileReturnCmd(
|
||||
*/
|
||||
|
||||
if (explicitResult) {
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
|
||||
} else {
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
@@ -2815,12 +2864,12 @@ TclCompileVariableCmd(
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
|
||||
|
||||
if (i + 1 < numWords) {
|
||||
if (i+1 < numWords) {
|
||||
/*
|
||||
* A value has been given: set the variable, pop the value
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i + 1);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i+1);
|
||||
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
@@ -2896,7 +2945,7 @@ IndexTailVarIfKnown(
|
||||
tailName = TclGetStringFromObj(tailPtr, &len);
|
||||
|
||||
if (len) {
|
||||
if (*(tailName + len - 1) == ')') {
|
||||
if (*(tailName+len-1) == ')') {
|
||||
/*
|
||||
* Possible array: bail out
|
||||
*/
|
||||
@@ -2910,7 +2959,7 @@ IndexTailVarIfKnown(
|
||||
*/
|
||||
|
||||
for (p = tailName + len -1; p > tailName; p--) {
|
||||
if ((*p == ':') && (*(p - 1) == ':')) {
|
||||
if ((*p == ':') && (*(p-1) == ':')) {
|
||||
p++;
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1002,13 +1002,13 @@ TclCompileStringReplaceCmd(
|
||||
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
/* Bytecode to compute/push string argument being replaced */
|
||||
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* Check for first index known and useful at compile time.
|
||||
* Check for first index known and useful at compile time.
|
||||
*/
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
|
||||
@@ -1017,7 +1017,7 @@ TclCompileStringReplaceCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for last index known and useful at compile time.
|
||||
* Check for last index known and useful at compile time.
|
||||
*/
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
|
||||
@@ -1025,7 +1025,7 @@ TclCompileStringReplaceCmd(
|
||||
goto genericReplace;
|
||||
}
|
||||
|
||||
/*
|
||||
/*
|
||||
* [string replace] is an odd bird. For many arguments it is
|
||||
* a conventional substring replacer. However it also goes out
|
||||
* of its way to become a no-op for many cases where it would be
|
||||
@@ -1108,12 +1108,12 @@ TclCompileStringReplaceCmd(
|
||||
* Finally we need, third:
|
||||
*
|
||||
* (first <= last)
|
||||
*
|
||||
*
|
||||
* Considered in combination with the constraints we already have,
|
||||
* we see that we can proceed when (first == TCL_INDEX_BEFORE)
|
||||
* or (last == TCL_INDEX_AFTER). These also permit simplification
|
||||
* of the prefix|replace|suffix construction. The other constraints,
|
||||
* though, interfere with getting a guarantee that first <= last.
|
||||
* though, interfere with getting a guarantee that first <= last.
|
||||
*/
|
||||
|
||||
if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
|
||||
@@ -1141,7 +1141,7 @@ TclCompileStringReplaceCmd(
|
||||
/* FLOW THROUGH TO genericReplace */
|
||||
|
||||
} else {
|
||||
/*
|
||||
/*
|
||||
* When we have no replacement string to worry about, we may
|
||||
* have more luck, because the forbidden empty string replacements
|
||||
* are harmless when they are replaced by another empty string.
|
||||
|
||||
+1
-1
@@ -1348,7 +1348,7 @@ yyparse (info)
|
||||
int yychar;
|
||||
|
||||
/* The semantic value of the look-ahead symbol. */
|
||||
YYSTYPE yylval = {0};
|
||||
YYSTYPE yylval;
|
||||
|
||||
/* Number of syntax errors so far. */
|
||||
int yynerrs;
|
||||
|
||||
+63
-111
@@ -119,8 +119,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
|
||||
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
|
||||
int line);
|
||||
/* 22 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
|
||||
EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
|
||||
int line);
|
||||
/* 23 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
|
||||
@@ -132,8 +131,7 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
|
||||
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
|
||||
const char *file, int line);
|
||||
/* 26 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
|
||||
EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
|
||||
int line);
|
||||
/* 27 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
|
||||
@@ -160,8 +158,7 @@ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
|
||||
EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, double *doublePtr);
|
||||
/* 36 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_GetIndexFromObj(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, const char *const *tablePtr,
|
||||
const char *msg, int flags, int *indexPtr);
|
||||
/* 37 */
|
||||
@@ -201,28 +198,24 @@ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, int first, int count,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
/* 49 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
|
||||
EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
|
||||
/* 50 */
|
||||
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
|
||||
int length);
|
||||
/* 51 */
|
||||
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
|
||||
/* 52 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_Obj * Tcl_NewIntObj(int intValue);
|
||||
EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
|
||||
/* 53 */
|
||||
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
|
||||
/* 54 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_Obj * Tcl_NewLongObj(long longValue);
|
||||
EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
|
||||
/* 55 */
|
||||
EXTERN Tcl_Obj * Tcl_NewObj(void);
|
||||
/* 56 */
|
||||
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
|
||||
/* 57 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
|
||||
EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
|
||||
/* 58 */
|
||||
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
|
||||
/* 59 */
|
||||
@@ -231,26 +224,22 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
|
||||
/* 60 */
|
||||
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
|
||||
/* 61 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
|
||||
EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
|
||||
/* 62 */
|
||||
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* 63 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
|
||||
EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
|
||||
/* 64 */
|
||||
EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
|
||||
/* 65 */
|
||||
EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
|
||||
int length);
|
||||
/* 66 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_AddErrorInfo(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp,
|
||||
const char *message);
|
||||
/* 67 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
|
||||
const char *message, int length);
|
||||
/* 68 */
|
||||
EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp);
|
||||
@@ -433,8 +422,7 @@ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
|
||||
EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
|
||||
const char *fileName);
|
||||
/* 131 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
/* 132 */
|
||||
EXTERN void Tcl_EventuallyFree(ClientData clientData,
|
||||
Tcl_FreeProc *freeProc);
|
||||
@@ -561,8 +549,7 @@ EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
|
||||
/* 174 */
|
||||
EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp);
|
||||
/* 175 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags);
|
||||
/* 176 */
|
||||
EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
@@ -571,8 +558,7 @@ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
|
||||
const char *command);
|
||||
/* 178 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_GlobalEvalObj(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 179 */
|
||||
EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
|
||||
@@ -727,8 +713,7 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
|
||||
/* 236 */
|
||||
EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
|
||||
/* 237 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags);
|
||||
/* 238 */
|
||||
EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
@@ -758,8 +743,7 @@ EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_TellOld(Tcl_Channel chan);
|
||||
/* 247 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
|
||||
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags, Tcl_VarTraceProc *proc,
|
||||
ClientData clientData);
|
||||
/* 248 */
|
||||
@@ -780,15 +764,13 @@ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 253 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
|
||||
EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags);
|
||||
/* 254 */
|
||||
EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, int flags);
|
||||
/* 255 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
void Tcl_UntraceVar(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_UntraceVar(Tcl_Interp *interp,
|
||||
const char *varName, int flags,
|
||||
Tcl_VarTraceProc *proc,
|
||||
ClientData clientData);
|
||||
@@ -801,8 +783,7 @@ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp,
|
||||
const char *varName);
|
||||
/* 258 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
|
||||
EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
|
||||
const char *varName, const char *localName,
|
||||
int flags);
|
||||
/* 259 */
|
||||
@@ -812,8 +793,7 @@ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
|
||||
/* 260 */
|
||||
EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...);
|
||||
/* 261 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
|
||||
EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
|
||||
const char *varName, int flags,
|
||||
Tcl_VarTraceProc *procPtr,
|
||||
ClientData prevClientData);
|
||||
@@ -845,20 +825,17 @@ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
|
||||
EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr);
|
||||
/* 271 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
/* 272 */
|
||||
EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact, void *clientDataPtr);
|
||||
/* 273 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
const char *version);
|
||||
/* 274 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
/* 275 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
@@ -985,13 +962,13 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId);
|
||||
EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
|
||||
Tcl_Event *evPtr, Tcl_QueuePosition position);
|
||||
/* 320 */
|
||||
EXTERN int Tcl_UniCharAtIndex(const char *src, int index);
|
||||
EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index);
|
||||
/* 321 */
|
||||
EXTERN int Tcl_UniCharToLower(int ch);
|
||||
EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch);
|
||||
/* 322 */
|
||||
EXTERN int Tcl_UniCharToTitle(int ch);
|
||||
EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch);
|
||||
/* 323 */
|
||||
EXTERN int Tcl_UniCharToUpper(int ch);
|
||||
EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
|
||||
/* 324 */
|
||||
EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
|
||||
/* 325 */
|
||||
@@ -1146,10 +1123,9 @@ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
|
||||
/* 380 */
|
||||
EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr);
|
||||
/* 381 */
|
||||
EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
|
||||
EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
|
||||
/* 382 */
|
||||
TCL_DEPRECATED("No longer in use, changed to macro")
|
||||
Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
|
||||
EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
|
||||
/* 383 */
|
||||
EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
|
||||
/* 384 */
|
||||
@@ -1862,18 +1838,6 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp,
|
||||
unsigned int flags,
|
||||
Tcl_TcpAcceptProc *acceptProc,
|
||||
ClientData callbackData);
|
||||
/* 632 */
|
||||
EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt,
|
||||
const char *zipname, const char *passwd);
|
||||
/* 633 */
|
||||
EXTERN int TclZipfs_Unmount(Tcl_Interp *interp,
|
||||
const char *zipname);
|
||||
/* 634 */
|
||||
EXTERN Tcl_Obj * TclZipfs_TclLibrary(void);
|
||||
/* 635 */
|
||||
EXTERN int TclZipfs_Mount_Buffer(Tcl_Interp *interp,
|
||||
const char *mntpt, unsigned char *data,
|
||||
size_t datalen, int copy);
|
||||
|
||||
typedef struct {
|
||||
const struct TclPlatStubs *tclPlatStubs;
|
||||
@@ -1923,11 +1887,11 @@ typedef struct TclStubs {
|
||||
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
|
||||
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
|
||||
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
|
||||
Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
|
||||
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
|
||||
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
|
||||
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
|
||||
Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
|
||||
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
|
||||
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
|
||||
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
|
||||
@@ -1937,7 +1901,7 @@ typedef struct TclStubs {
|
||||
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
|
||||
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
|
||||
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
|
||||
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
|
||||
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
|
||||
@@ -1950,25 +1914,25 @@ typedef struct TclStubs {
|
||||
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
|
||||
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
|
||||
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
|
||||
Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
|
||||
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
|
||||
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
|
||||
Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
|
||||
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
|
||||
Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
|
||||
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
|
||||
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
|
||||
void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
|
||||
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
|
||||
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
|
||||
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
|
||||
void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
|
||||
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
|
||||
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
|
||||
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
|
||||
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
|
||||
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
|
||||
void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
|
||||
void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
|
||||
void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
|
||||
void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
|
||||
@@ -2032,7 +1996,7 @@ typedef struct TclStubs {
|
||||
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
|
||||
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
|
||||
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
|
||||
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
|
||||
TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
|
||||
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
|
||||
@@ -2084,10 +2048,10 @@ typedef struct TclStubs {
|
||||
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
|
||||
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
|
||||
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
|
||||
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
|
||||
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
|
||||
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
|
||||
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
|
||||
@@ -2146,7 +2110,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
|
||||
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
|
||||
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
|
||||
const char * (*tcl_SignalId) (int sig); /* 239 */
|
||||
const char * (*tcl_SignalMsg) (int sig); /* 240 */
|
||||
@@ -2156,21 +2120,21 @@ typedef struct TclStubs {
|
||||
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
|
||||
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
|
||||
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
|
||||
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
|
||||
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
|
||||
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
|
||||
int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
|
||||
void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
|
||||
int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
|
||||
int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
|
||||
int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
|
||||
void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
|
||||
void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
|
||||
void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
|
||||
int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
|
||||
int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
|
||||
int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
|
||||
ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
|
||||
ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
|
||||
int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
|
||||
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
|
||||
@@ -2180,10 +2144,10 @@ typedef struct TclStubs {
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
|
||||
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
|
||||
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
|
||||
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
|
||||
TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
|
||||
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
|
||||
@@ -2229,10 +2193,10 @@ typedef struct TclStubs {
|
||||
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
|
||||
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
|
||||
void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
|
||||
int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
|
||||
int (*tcl_UniCharToLower) (int ch); /* 321 */
|
||||
int (*tcl_UniCharToTitle) (int ch); /* 322 */
|
||||
int (*tcl_UniCharToUpper) (int ch); /* 323 */
|
||||
Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
|
||||
Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
|
||||
Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
|
||||
Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
|
||||
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
|
||||
const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
|
||||
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
|
||||
@@ -2290,8 +2254,8 @@ typedef struct TclStubs {
|
||||
Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
|
||||
void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
|
||||
int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
|
||||
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
|
||||
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
|
||||
Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
|
||||
Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
|
||||
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
|
||||
void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
|
||||
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
|
||||
@@ -2541,10 +2505,6 @@ typedef struct TclStubs {
|
||||
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
|
||||
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
|
||||
Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
|
||||
int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); /* 632 */
|
||||
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */
|
||||
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
|
||||
int (*tclZipfs_Mount_Buffer) (Tcl_Interp *interp, const char *mntpt, unsigned char *data, size_t datalen, int copy); /* 635 */
|
||||
} TclStubs;
|
||||
|
||||
extern const TclStubs *tclStubsPtr;
|
||||
@@ -3839,14 +3799,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
|
||||
#define Tcl_OpenTcpServerEx \
|
||||
(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
|
||||
#define TclZipfs_Mount \
|
||||
(tclStubsPtr->tclZipfs_Mount) /* 632 */
|
||||
#define TclZipfs_Unmount \
|
||||
(tclStubsPtr->tclZipfs_Unmount) /* 633 */
|
||||
#define TclZipfs_TclLibrary \
|
||||
(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
|
||||
#define TclZipfs_Mount_Buffer \
|
||||
(tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
@@ -3858,12 +3810,15 @@ extern const TclStubs *tclStubsPtr;
|
||||
# undef Tcl_GetStringResult
|
||||
# undef Tcl_Init
|
||||
# undef Tcl_SetPanicProc
|
||||
# undef Tcl_SetVar
|
||||
# undef Tcl_ObjSetVar2
|
||||
# undef Tcl_StaticPackage
|
||||
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
|
||||
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
|
||||
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
|
||||
# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
|
||||
# define Tcl_SetVar(interp, varName, newValue, flags) \
|
||||
(tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
|
||||
# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
|
||||
(tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
|
||||
#endif
|
||||
@@ -3873,7 +3828,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
# define Tcl_MainEx Tcl_MainExW
|
||||
EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv);
|
||||
#endif
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
@@ -4020,11 +3974,9 @@ extern const TclStubs *tclStubsPtr;
|
||||
#undef Tcl_DbNewLongObj
|
||||
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
|
||||
#undef Tcl_SetIntObj
|
||||
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value))
|
||||
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
|
||||
#undef Tcl_SetLongObj
|
||||
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value))
|
||||
#undef Tcl_GetUnicode
|
||||
#define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL)
|
||||
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
|
||||
|
||||
/*
|
||||
* Deprecated Tcl procedures:
|
||||
|
||||
@@ -153,7 +153,7 @@ typedef struct Dict {
|
||||
* must be assignable as well as readable.
|
||||
*/
|
||||
|
||||
#define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1)
|
||||
#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
|
||||
|
||||
/*
|
||||
* The structure below defines the dictionary object type by means of
|
||||
|
||||
@@ -894,7 +894,7 @@ PrintSourceToObj(
|
||||
Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
|
||||
i += 10;
|
||||
} else
|
||||
#else
|
||||
#elif TCL_UTF_MAX > 3
|
||||
/* If len == 0, this means we have a char > 0xffff, resulting in
|
||||
* TclUtfToUniChar producing a surrogate pair. We want to output
|
||||
* this pair as a single Unicode character.
|
||||
|
||||
+4
-21
@@ -2359,15 +2359,8 @@ UtfToUtfProc(
|
||||
src += 1;
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
} else {
|
||||
int len = TclUtfToUniChar(src, chPtr);
|
||||
src += len;
|
||||
src += TclUtfToUniChar(src, chPtr);
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
#if TCL_UTF_MAX <= 4
|
||||
if (!len) {
|
||||
src += TclUtfToUniChar(src, chPtr);
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2773,7 +2766,7 @@ TableFromUtfProc(
|
||||
}
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
|
||||
#if TCL_UTF_MAX > 4
|
||||
#if TCL_UTF_MAX > 3
|
||||
/*
|
||||
* This prevents a crash condition. More evaluation is required for
|
||||
* full support of int Tcl_UniChar. [Bug 1004065]
|
||||
@@ -2782,10 +2775,6 @@ TableFromUtfProc(
|
||||
if (ch & 0xffff0000) {
|
||||
word = 0;
|
||||
} else
|
||||
#else
|
||||
if (!len) {
|
||||
word = 0;
|
||||
} else
|
||||
#endif
|
||||
word = fromUnicode[(ch >> 8)][ch & 0xff];
|
||||
|
||||
@@ -2983,18 +2972,12 @@ Iso88591FromUtfProc(
|
||||
* Check for illegal characters.
|
||||
*/
|
||||
|
||||
if (ch > 0xff
|
||||
#if TCL_UTF_MAX <= 4
|
||||
|| !len
|
||||
#endif
|
||||
) {
|
||||
if (ch > 0xff) {
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
break;
|
||||
}
|
||||
#if TCL_UTF_MAX <= 4
|
||||
if (!len) len = 4;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Plunge on, using '?' as a fallback character.
|
||||
*/
|
||||
|
||||
+71
-76
@@ -21,6 +21,8 @@ static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr);
|
||||
static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
|
||||
EnsembleConfig *ensemblePtr, int objc,
|
||||
Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
|
||||
static int NsEnsembleImplementationCmd(ClientData clientData,
|
||||
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
|
||||
static int NsEnsembleImplementationCmdNR(ClientData clientData,
|
||||
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
|
||||
static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
|
||||
@@ -85,8 +87,8 @@ static const Tcl_ObjType ensembleCmdType = {
|
||||
};
|
||||
|
||||
/*
|
||||
* The internal rep for caching ensemble subcommand lookups and spelling
|
||||
* corrections.
|
||||
* The internal rep for caching ensemble subcommand lookups and
|
||||
* spell corrections.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
@@ -96,9 +98,10 @@ typedef struct {
|
||||
Command *token; /* Reference to the command for which this
|
||||
* structure is a cache of the resolution. */
|
||||
Tcl_Obj *fix; /* Corrected spelling, if needed. */
|
||||
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
|
||||
* table. */
|
||||
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
|
||||
* hash table. */
|
||||
} EnsembleCmdRep;
|
||||
|
||||
|
||||
static inline Tcl_Obj *
|
||||
NewNsObj(
|
||||
@@ -108,8 +111,9 @@ NewNsObj(
|
||||
|
||||
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
|
||||
return Tcl_NewStringObj("::", 2);
|
||||
} else {
|
||||
return Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
}
|
||||
return Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -143,7 +147,7 @@ TclNamespaceEnsembleCmd(
|
||||
{
|
||||
Tcl_Namespace *namespacePtr;
|
||||
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
|
||||
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
|
||||
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
|
||||
Tcl_Command token;
|
||||
Tcl_DictSearch search;
|
||||
Tcl_Obj *listObj;
|
||||
@@ -298,8 +302,7 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
|
||||
newList);
|
||||
}
|
||||
Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
|
||||
&done);
|
||||
Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
|
||||
} while (!done);
|
||||
|
||||
if (allocatedMapFlag) {
|
||||
@@ -333,8 +336,8 @@ TclNamespaceEnsembleCmd(
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, cxtPtr,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
|
||||
&actualCxtPtr, &simpleName);
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
|
||||
&simpleName);
|
||||
|
||||
/*
|
||||
* Create the ensemble. Note that this might delete another ensemble
|
||||
@@ -344,8 +347,8 @@ TclNamespaceEnsembleCmd(
|
||||
*/
|
||||
|
||||
token = TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
|
||||
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
|
||||
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
|
||||
@@ -573,8 +576,7 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_AppendStringsToObj(newCmd, "::", NULL);
|
||||
}
|
||||
Tcl_AppendObjToObj(newCmd, listv[0]);
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
|
||||
&newCmd);
|
||||
Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
}
|
||||
@@ -648,13 +650,15 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_Command
|
||||
TclCreateEnsembleInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *name, /* Simple name of command to create (no
|
||||
* namespace components). */
|
||||
Tcl_Namespace *nameNsPtr, /* Name of namespace to create the command
|
||||
* in. */
|
||||
Tcl_Namespace *ensembleNsPtr,
|
||||
/* Name of the namespace for the ensemble. */
|
||||
int flags)
|
||||
|
||||
const char *name, /* Simple name of command to create (no */
|
||||
/* namespace components). */
|
||||
Tcl_Namespace /* Name of namespace to create the command in. */
|
||||
*nameNsPtr,
|
||||
Tcl_Namespace
|
||||
*ensembleNsPtr, /* Name of the namespace for the ensemble. */
|
||||
int flags
|
||||
)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
@@ -662,8 +666,8 @@ TclCreateEnsembleInNs(
|
||||
|
||||
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
|
||||
token = TclNRCreateCommandInNs(interp, name,
|
||||
(Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
|
||||
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
|
||||
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
|
||||
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
|
||||
if (token == NULL) {
|
||||
ckfree(ensemblePtr);
|
||||
return NULL;
|
||||
@@ -697,15 +701,18 @@ TclCreateEnsembleInNs(
|
||||
}
|
||||
|
||||
return ensemblePtr->token;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CreateEnsemble
|
||||
*
|
||||
* Create a simple ensemble attached to the given namespace. Deprecated
|
||||
* (internally) by TclCreateEnsembleInNs.
|
||||
* Create a simple ensemble attached to the given namespace.
|
||||
*
|
||||
* Deprecated by TclCreateEnsembleInNs.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
@@ -725,8 +732,8 @@ Tcl_CreateEnsemble(
|
||||
Tcl_Namespace *namespacePtr,
|
||||
int flags)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
|
||||
*actualNsPtr;
|
||||
Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
|
||||
*actualNsPtr;
|
||||
const char * simpleName;
|
||||
|
||||
if (nsPtr == NULL) {
|
||||
@@ -734,10 +741,11 @@ Tcl_CreateEnsemble(
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
|
||||
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
|
||||
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
|
||||
return TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -766,7 +774,7 @@ Tcl_SetEnsembleSubcommandList(
|
||||
EnsembleConfig *ensemblePtr;
|
||||
Tcl_Obj *oldList;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
|
||||
@@ -842,7 +850,7 @@ Tcl_SetEnsembleParameterList(
|
||||
Tcl_Obj *oldList;
|
||||
int length;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
|
||||
@@ -918,7 +926,7 @@ Tcl_SetEnsembleMappingDict(
|
||||
EnsembleConfig *ensemblePtr;
|
||||
Tcl_Obj *oldDict;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
|
||||
@@ -1017,7 +1025,7 @@ Tcl_SetEnsembleUnknownHandler(
|
||||
EnsembleConfig *ensemblePtr;
|
||||
Tcl_Obj *oldList;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
|
||||
@@ -1083,7 +1091,7 @@ Tcl_SetEnsembleFlags(
|
||||
EnsembleConfig *ensemblePtr;
|
||||
int wasCompiled;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
|
||||
@@ -1159,7 +1167,7 @@ Tcl_GetEnsembleSubcommandList(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1201,7 +1209,7 @@ Tcl_GetEnsembleParameterList(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1243,7 +1251,7 @@ Tcl_GetEnsembleMappingDict(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1284,7 +1292,7 @@ Tcl_GetEnsembleUnknownHandler(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1325,7 +1333,7 @@ Tcl_GetEnsembleFlags(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1366,7 +1374,7 @@ Tcl_GetEnsembleNamespace(
|
||||
Command *cmdPtr = (Command *) token;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command is not an ensemble", -1));
|
||||
@@ -1416,7 +1424,7 @@ Tcl_FindEnsemble(
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
/*
|
||||
* Reuse existing infrastructure for following import link chains
|
||||
* rather than duplicating it.
|
||||
@@ -1424,8 +1432,7 @@ Tcl_FindEnsemble(
|
||||
|
||||
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
|
||||
|
||||
if (cmdPtr == NULL
|
||||
|| cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"\"%s\" is not an ensemble command",
|
||||
@@ -1463,11 +1470,11 @@ Tcl_IsEnsemble(
|
||||
{
|
||||
Command *cmdPtr = (Command *) token;
|
||||
|
||||
if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
|
||||
return 1;
|
||||
}
|
||||
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
|
||||
if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
|
||||
if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
@@ -1638,7 +1645,7 @@ TclMakeEnsemble(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclEnsembleImplementationCmd --
|
||||
* NsEnsembleImplementationCmd --
|
||||
*
|
||||
* Implements an ensemble of commands (being those exported by a
|
||||
* namespace other than the global namespace) as a command with the same
|
||||
@@ -1657,8 +1664,8 @@ TclMakeEnsemble(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclEnsembleImplementationCmd(
|
||||
static int
|
||||
NsEnsembleImplementationCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
@@ -2110,27 +2117,22 @@ TclSpellFix(
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compute the valid length of the ensemble root.
|
||||
*/
|
||||
/* Compute the valid length of the ensemble root */
|
||||
|
||||
size = iPtr->ensembleRewrite.numRemovedObjs + objc
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
/*
|
||||
* Awful casting abuse here...
|
||||
*/
|
||||
/* Awful casting abuse here */
|
||||
search = (Tcl_Obj *const *) search[1];
|
||||
}
|
||||
|
||||
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
|
||||
/*
|
||||
* Misspelled value was inserted. We cannot directly jump to the bad
|
||||
* value, but have to search.
|
||||
* Misspelled value was inserted. We cannot directly jump
|
||||
* to the bad value, but have to search.
|
||||
*/
|
||||
|
||||
idx = 1;
|
||||
while (idx < size) {
|
||||
if (search[idx] == bad) {
|
||||
@@ -2154,14 +2156,13 @@ TclSpellFix(
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
store = (Tcl_Obj **) search[2];
|
||||
} else {
|
||||
store = (Tcl_Obj **)search[2];
|
||||
} else {
|
||||
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
|
||||
|
||||
tmp[0] = NULL;
|
||||
tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));
|
||||
tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
|
||||
|
||||
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
|
||||
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
|
||||
@@ -2588,9 +2589,7 @@ BuildEnsembleConfig(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Usual case where we can freely act on the list and dict.
|
||||
*/
|
||||
/* Usual case where we can freely act on the list and dict. */
|
||||
|
||||
for (i = 0; i < subc; i++) {
|
||||
name = TclGetString(subv[i]);
|
||||
@@ -2599,10 +2598,7 @@ BuildEnsembleConfig(
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* Lookup target in the dictionary.
|
||||
*/
|
||||
|
||||
/* Lookup target in the dictionary */
|
||||
if (mapDict) {
|
||||
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
|
||||
if (target) {
|
||||
@@ -2614,11 +2610,10 @@ BuildEnsembleConfig(
|
||||
|
||||
/*
|
||||
* target was not in the dictionary so map onto the namespace.
|
||||
* Note in this case that we do not guarantee that the command
|
||||
* is actually there; that is the programmer's responsibility
|
||||
* (or [::unknown] of course).
|
||||
* Note in this case that we do not guarantee that the
|
||||
* command is actually there; that is the programmer's
|
||||
* responsibility (or [::unknown] of course).
|
||||
*/
|
||||
|
||||
cmdObj = Tcl_NewStringObj(name, -1);
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
|
||||
+1
-12
@@ -723,25 +723,14 @@ TclFinalizeEnvironment(void)
|
||||
* strings. This may leak more memory that strictly necessary, since some
|
||||
* of the strings may no longer be in the environment. However,
|
||||
* determining which ones are ok to delete is n-squared, and is pretty
|
||||
* unlikely, so we don't bother. However, in the case of DPURIFY, just
|
||||
* free all strings in the cache.
|
||||
* unlikely, so we don't bother.
|
||||
*/
|
||||
|
||||
if (env.cache) {
|
||||
#ifdef PURIFY
|
||||
int i;
|
||||
for (i = 0; i < env.cacheSize; i++) {
|
||||
ckfree(env.cache[i]);
|
||||
}
|
||||
#endif
|
||||
ckfree(env.cache);
|
||||
env.cache = NULL;
|
||||
env.cacheSize = 0;
|
||||
#ifndef USE_PUTENV
|
||||
if ((env.ourEnviron != NULL)) {
|
||||
ckfree(env.ourEnviron);
|
||||
env.ourEnviron = NULL;
|
||||
}
|
||||
env.ourEnvironSize = 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
+5
-5
@@ -100,7 +100,7 @@ typedef struct ThreadSpecificData {
|
||||
} ThreadSpecificData;
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
typedef struct {
|
||||
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
|
||||
ClientData clientData; /* The one argument to Main() */
|
||||
@@ -1043,7 +1043,7 @@ TclInitSubsystems(void)
|
||||
#if USE_TCLALLOC
|
||||
TclInitAlloc(); /* Process wide mutex init */
|
||||
#endif
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
TclInitThreadAlloc(); /* Setup thread allocator caches */
|
||||
#endif
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
@@ -1220,7 +1220,7 @@ Tcl_Finalize(void)
|
||||
* Close down the thread-specific object allocator.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
TclFinalizeThreadAlloc();
|
||||
#endif
|
||||
|
||||
@@ -1538,7 +1538,7 @@ Tcl_UpdateObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1601,7 +1601,7 @@ Tcl_CreateThread(
|
||||
int flags) /* Flags controlling behaviour of the new
|
||||
* thread. */
|
||||
{
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
|
||||
int result;
|
||||
|
||||
|
||||
+118
-47
@@ -3890,8 +3890,7 @@ TEBCresume(
|
||||
}
|
||||
TRACE(("%s %u \"%.30s\" => ",
|
||||
(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
|
||||
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
|
||||
&& !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
|
||||
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
|
||||
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
|
||||
if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
|
||||
/*
|
||||
@@ -4016,12 +4015,17 @@ TEBCresume(
|
||||
varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
|
||||
/*createPart1*/0, /*createPart2*/0, &arrayPtr);
|
||||
doArrayExists:
|
||||
DECACHE_STACK_INFO();
|
||||
result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd);
|
||||
CACHE_STACK_INFO();
|
||||
if (result == TCL_ERROR) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
|
||||
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
|
||||
DECACHE_STACK_INFO();
|
||||
result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
|
||||
NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
|
||||
TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
|
||||
CACHE_STACK_INFO();
|
||||
if (result == TCL_ERROR) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
}
|
||||
if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
|
||||
objResultPtr = TCONST(1);
|
||||
@@ -4070,7 +4074,10 @@ TEBCresume(
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
TclInitArrayVar(varPtr);
|
||||
TclSetVarArray(varPtr);
|
||||
varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
|
||||
TclInitVarHashTable(varPtr->value.tablePtr,
|
||||
TclGetVarNsPtr(varPtr));
|
||||
#ifdef TCL_COMPILE_DEBUG
|
||||
TRACE_APPEND(("done\n"));
|
||||
} else {
|
||||
@@ -4961,7 +4968,7 @@ TEBCresume(
|
||||
|
||||
/* Decode index value operands. */
|
||||
|
||||
/*
|
||||
/*
|
||||
assert ( toIdx != TCL_INDEX_AFTER);
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
@@ -5085,10 +5092,88 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
{
|
||||
if (valuePtr == value2Ptr) {
|
||||
match = 0;
|
||||
} else {
|
||||
/*
|
||||
* We only need to check (in)equality when we have equal length
|
||||
* strings. We can use memcmp in all (n)eq cases because we
|
||||
* don't need to worry about lexical LE/BE variance.
|
||||
*/
|
||||
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
memCmpFn_t memCmpFn;
|
||||
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
|
||||
|| (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
|
||||
match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
|
||||
|
||||
if (TclIsPureByteArray(valuePtr)
|
||||
&& TclIsPureByteArray(value2Ptr)) {
|
||||
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
|
||||
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = memcmp;
|
||||
} else if ((valuePtr->typePtr == &tclStringType)
|
||||
&& (value2Ptr->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of
|
||||
* String type. If the char length == byte length, we can do a
|
||||
* memcmp. In benchmark testing this proved the most efficient
|
||||
* check between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
s1len = Tcl_GetCharLength(valuePtr);
|
||||
s2len = Tcl_GetCharLength(value2Ptr);
|
||||
if ((s1len == valuePtr->length)
|
||||
&& (valuePtr->bytes != NULL)
|
||||
&& (s2len == value2Ptr->length)
|
||||
&& (value2Ptr->bytes != NULL)) {
|
||||
s1 = valuePtr->bytes;
|
||||
s2 = value2Ptr->bytes;
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
s1 = (char *) Tcl_GetUnicode(valuePtr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
#endif
|
||||
) {
|
||||
memCmpFn = memcmp;
|
||||
s1len *= sizeof(Tcl_UniChar);
|
||||
s2len *= sizeof(Tcl_UniChar);
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* strcmp can't do a simple memcmp in order to handle the
|
||||
* special Tcl \xC0\x80 null encoding for utf-8.
|
||||
*/
|
||||
|
||||
s1 = TclGetStringFromObj(valuePtr, &s1len);
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
if (checkEq) {
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
|
||||
}
|
||||
}
|
||||
|
||||
if (checkEq && (s1len != s2len)) {
|
||||
match = 1;
|
||||
} else {
|
||||
/*
|
||||
* The comparison function should compare up to the minimum
|
||||
* byte length only.
|
||||
*/
|
||||
match = memCmpFn(s1, s2,
|
||||
(size_t) ((s1len < s2len) ? s1len : s2len));
|
||||
if (match == 0) {
|
||||
match = s1len - s2len;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -5212,23 +5297,17 @@ TEBCresume(
|
||||
objResultPtr = Tcl_NewStringObj((const char *)
|
||||
valuePtr->bytes+index, 1);
|
||||
} else {
|
||||
char buf[4];
|
||||
int ch = Tcl_GetUniChar(valuePtr, index);
|
||||
char buf[TCL_UTF_MAX];
|
||||
Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
|
||||
|
||||
/*
|
||||
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
|
||||
* but creating the object as a string seems to be faster in
|
||||
* practical use.
|
||||
*/
|
||||
if (ch == -1) {
|
||||
objResultPtr = Tcl_NewObj();
|
||||
} else {
|
||||
length = Tcl_UniCharToUtf(ch, buf);
|
||||
if (!length) {
|
||||
length = Tcl_UniCharToUtf(-1, buf);
|
||||
}
|
||||
objResultPtr = Tcl_NewStringObj(buf, length);
|
||||
}
|
||||
|
||||
length = Tcl_UniCharToUtf(ch, buf);
|
||||
objResultPtr = Tcl_NewStringObj(buf, length);
|
||||
}
|
||||
|
||||
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
|
||||
@@ -5632,17 +5711,17 @@ TEBCresume(
|
||||
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
|
||||
type1 = 0;
|
||||
} else if (type1 == TCL_NUMBER_WIDE) {
|
||||
/* value is between WIDE_MIN and WIDE_MAX */
|
||||
/* value is between LLONG_MIN and LLONG_MAX */
|
||||
/* [string is integer] is -UINT_MAX to UINT_MAX range */
|
||||
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
|
||||
/* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
|
||||
int i;
|
||||
|
||||
if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
|
||||
type1 = TCL_NUMBER_LONG;
|
||||
}
|
||||
} else if (type1 == TCL_NUMBER_BIG) {
|
||||
/* value is an integer outside the WIDE_MIN to WIDE_MAX range */
|
||||
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
|
||||
/* value is an integer outside the LLONG_MIN to LLONG_MAX range */
|
||||
/* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
|
||||
Tcl_WideInt w;
|
||||
|
||||
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
|
||||
@@ -5664,14 +5743,6 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
/*
|
||||
Try to determine, without triggering generation of a string
|
||||
representation, whether one value is not a number.
|
||||
*/
|
||||
if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
|
||||
goto stringCompare;
|
||||
}
|
||||
|
||||
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
|
||||
|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
|
||||
/*
|
||||
@@ -6058,9 +6129,9 @@ TEBCresume(
|
||||
TRACE(("%s %s => DIVIDE BY ZERO\n",
|
||||
O2S(valuePtr), O2S(value2Ptr)));
|
||||
goto divideByZero;
|
||||
} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
|
||||
} else if ((w1 == LLONG_MIN) && (w2 == -1)) {
|
||||
/*
|
||||
* Can't represent (-WIDE_MIN) as a Tcl_WideInt.
|
||||
* Can't represent (-LLONG_MIN) as a Tcl_WideInt.
|
||||
*/
|
||||
|
||||
goto overflow;
|
||||
@@ -6193,7 +6264,7 @@ TEBCresume(
|
||||
NEXT_INST_F(1, 0, 0);
|
||||
case TCL_NUMBER_WIDE:
|
||||
w1 = *((const Tcl_WideInt *) ptr1);
|
||||
if (w1 != WIDE_MIN) {
|
||||
if (w1 != LLONG_MIN) {
|
||||
if (Tcl_IsShared(valuePtr)) {
|
||||
TclNewIntObj(objResultPtr, -w1);
|
||||
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
|
||||
@@ -8667,10 +8738,10 @@ ExecuteExtendedBinaryMathOp(
|
||||
}
|
||||
|
||||
/*
|
||||
* Need a bignum to represent (WIDE_MIN / -1)
|
||||
* Need a bignum to represent (LLONG_MIN / -1)
|
||||
*/
|
||||
|
||||
if ((w1 == WIDE_MIN) && (w2 == -1)) {
|
||||
if ((w1 == LLONG_MIN) && (w2 == -1)) {
|
||||
goto overflowBasic;
|
||||
}
|
||||
wResult = w1 / w2;
|
||||
@@ -8773,7 +8844,7 @@ ExecuteExtendedUnaryMathOp(
|
||||
DOUBLE_RESULT(-(*((const double *) ptr)));
|
||||
case TCL_NUMBER_WIDE:
|
||||
w = *((const Tcl_WideInt *) ptr);
|
||||
if (w != WIDE_MIN) {
|
||||
if (w != LLONG_MIN) {
|
||||
WIDE_RESULT(-w);
|
||||
}
|
||||
TclInitBignumFromWideInt(&big, w);
|
||||
@@ -8859,10 +8930,10 @@ TclCompareTwoNumbers(
|
||||
* integer comparison can tell the difference.
|
||||
*/
|
||||
|
||||
if (d2 < (double)WIDE_MIN) {
|
||||
if (d2 < (double)LLONG_MIN) {
|
||||
return MP_GT;
|
||||
}
|
||||
if (d2 > (double)WIDE_MAX) {
|
||||
if (d2 > (double)LLONG_MAX) {
|
||||
return MP_LT;
|
||||
}
|
||||
w2 = (Tcl_WideInt) d2;
|
||||
@@ -8892,10 +8963,10 @@ TclCompareTwoNumbers(
|
||||
|| w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
|
||||
goto doubleCompare;
|
||||
}
|
||||
if (d1 < (double)WIDE_MIN) {
|
||||
if (d1 < (double)LLONG_MIN) {
|
||||
return MP_LT;
|
||||
}
|
||||
if (d1 > (double)WIDE_MAX) {
|
||||
if (d1 > (double)LLONG_MAX) {
|
||||
return MP_GT;
|
||||
}
|
||||
w1 = (Tcl_WideInt) d1;
|
||||
@@ -8905,7 +8976,7 @@ TclCompareTwoNumbers(
|
||||
return (d1 > 0.0) ? MP_GT : MP_LT;
|
||||
}
|
||||
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
|
||||
if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
|
||||
if ((d1 < (double)LLONG_MAX) && (d1 > (double)LLONG_MIN)) {
|
||||
if (mp_isneg(&big2)) {
|
||||
compare = MP_GT;
|
||||
} else {
|
||||
@@ -8938,7 +9009,7 @@ TclCompareTwoNumbers(
|
||||
mp_clear(&big1);
|
||||
return compare;
|
||||
}
|
||||
if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
|
||||
if ((d2 < (double)LLONG_MAX) && (d2 > (double)LLONG_MIN)) {
|
||||
compare = mp_cmp_d(&big1, 0);
|
||||
mp_clear(&big1);
|
||||
return compare;
|
||||
|
||||
+24
-30
@@ -240,13 +240,9 @@ TclFileMakeDirsCmd(
|
||||
break;
|
||||
}
|
||||
for (j = 0; j < pobjc; j++) {
|
||||
int errCount = 2;
|
||||
|
||||
target = Tcl_FSJoinPath(split, j + 1);
|
||||
Tcl_IncrRefCount(target);
|
||||
|
||||
createDir:
|
||||
|
||||
/*
|
||||
* Call Tcl_FSStat() so that if target is a symlink that points to
|
||||
* a directory we will create subdirectories in that directory.
|
||||
@@ -273,25 +269,23 @@ TclFileMakeDirsCmd(
|
||||
* subdirectory.
|
||||
*/
|
||||
|
||||
if (errno == EEXIST) {
|
||||
/* Be aware other workers could delete it immediately after
|
||||
* creation, so give this worker still one chance (repeat once),
|
||||
* see [270f78ca95] for description of the race-condition.
|
||||
* Don't repeat the create always (to avoid endless loop). */
|
||||
if (--errCount > 0) {
|
||||
goto createDir;
|
||||
}
|
||||
/* Already tried, with delete in-between directly after
|
||||
* creation, so just continue (assume created successful). */
|
||||
goto nextPart;
|
||||
}
|
||||
if (errno != EEXIST) {
|
||||
errfile = target;
|
||||
goto done;
|
||||
} else if ((Tcl_FSStat(target, &statBuf) == 0)
|
||||
&& S_ISDIR(statBuf.st_mode)) {
|
||||
/*
|
||||
* It is a directory that wasn't there before, so keep
|
||||
* going without error.
|
||||
*/
|
||||
|
||||
/* return with error */
|
||||
errfile = target;
|
||||
goto done;
|
||||
Tcl_ResetResult(interp);
|
||||
} else {
|
||||
errfile = target;
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
|
||||
nextPart:
|
||||
/*
|
||||
* Forget about this sub-path.
|
||||
*/
|
||||
@@ -369,7 +363,14 @@ TclFileDeleteCmd(
|
||||
*/
|
||||
|
||||
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
|
||||
result = TCL_ERROR;
|
||||
/*
|
||||
* Trying to delete a file that does not exist is not considered
|
||||
* an error, just a no-op
|
||||
*/
|
||||
|
||||
if (errno != ENOENT) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else if (S_ISDIR(statBuf.st_mode)) {
|
||||
/*
|
||||
* We own a reference count on errorBuffer, if it was set as a
|
||||
@@ -405,20 +406,13 @@ TclFileDeleteCmd(
|
||||
}
|
||||
|
||||
if (result != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Avoid possible race condition (file/directory deleted after call
|
||||
* of lstat), so bypass ENOENT because not an error, just a no-op
|
||||
*/
|
||||
if (errno == ENOENT) {
|
||||
result = TCL_OK;
|
||||
continue;
|
||||
}
|
||||
/*
|
||||
* It is important that we break on error, otherwise we might end
|
||||
* up owning reference counts on numerous errorBuffers.
|
||||
*/
|
||||
result = TCL_ERROR;
|
||||
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1881,7 +1881,7 @@ TclGlob(
|
||||
separators = "/\\";
|
||||
|
||||
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
|
||||
if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
|
||||
if (pathPrefix == NULL && tail[0] == '/') {
|
||||
pathPrefix = Tcl_NewStringObj(tail, 1);
|
||||
tail++;
|
||||
Tcl_IncrRefCount(pathPrefix);
|
||||
|
||||
+17
-17
@@ -482,13 +482,13 @@ ChanSeek(
|
||||
offset, mode, errnoPtr);
|
||||
}
|
||||
|
||||
if (offset<LONG_MIN || offset>LONG_MAX) {
|
||||
if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
|
||||
*errnoPtr = EOVERFLOW;
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
return chanPtr->typePtr->seekProc(chanPtr->instanceData,
|
||||
offset, mode, errnoPtr);
|
||||
return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
|
||||
Tcl_WideAsLong(offset), mode, errnoPtr));
|
||||
}
|
||||
|
||||
static inline void
|
||||
@@ -6953,7 +6953,7 @@ Tcl_Seek(
|
||||
* non-blocking mode after the seek. */
|
||||
|
||||
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -6964,7 +6964,7 @@ Tcl_Seek(
|
||||
*/
|
||||
|
||||
if (CheckForDeadChannel(NULL, statePtr)) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -6980,7 +6980,7 @@ Tcl_Seek(
|
||||
|
||||
if (chanPtr->typePtr->seekProc == NULL) {
|
||||
Tcl_SetErrno(EINVAL);
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -6993,7 +6993,7 @@ Tcl_Seek(
|
||||
|
||||
if ((inputBuffered != 0) && (outputBuffered != 0)) {
|
||||
Tcl_SetErrno(EFAULT);
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -7036,7 +7036,7 @@ Tcl_Seek(
|
||||
wasAsync = 1;
|
||||
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
|
||||
if (result != 0) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
ResetFlag(statePtr, CHANNEL_NONBLOCKING);
|
||||
if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
|
||||
@@ -7061,7 +7061,7 @@ Tcl_Seek(
|
||||
*/
|
||||
|
||||
curPos = ChanSeek(chanPtr, offset, mode, &result);
|
||||
if (curPos == -1) {
|
||||
if (curPos == Tcl_LongAsWide(-1)) {
|
||||
Tcl_SetErrno(result);
|
||||
}
|
||||
}
|
||||
@@ -7077,7 +7077,7 @@ Tcl_Seek(
|
||||
SetFlag(statePtr, CHANNEL_NONBLOCKING);
|
||||
result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
|
||||
if (result != 0) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -7117,7 +7117,7 @@ Tcl_Tell(
|
||||
Tcl_WideInt curPos; /* Position on device. */
|
||||
|
||||
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -7128,7 +7128,7 @@ Tcl_Tell(
|
||||
*/
|
||||
|
||||
if (CheckForDeadChannel(NULL, statePtr)) {
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -7144,7 +7144,7 @@ Tcl_Tell(
|
||||
|
||||
if (chanPtr->typePtr->seekProc == NULL) {
|
||||
Tcl_SetErrno(EINVAL);
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -7161,10 +7161,10 @@ Tcl_Tell(
|
||||
* wideSeekProc if that is available and non-NULL...
|
||||
*/
|
||||
|
||||
curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
|
||||
if (curPos == -1) {
|
||||
curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
|
||||
if (curPos == Tcl_LongAsWide(-1)) {
|
||||
Tcl_SetErrno(result);
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
if (inputBuffered != 0) {
|
||||
|
||||
+2
-2
@@ -559,7 +559,7 @@ Tcl_SeekObjCmd(
|
||||
|
||||
TclChannelPreserve(chan);
|
||||
result = Tcl_Seek(chan, offset, mode);
|
||||
if (result == -1) {
|
||||
if (result == Tcl_LongAsWide(-1)) {
|
||||
/*
|
||||
* TIP #219.
|
||||
* Capture error messages put by the driver into the bypass area and
|
||||
@@ -1913,7 +1913,7 @@ ChanTruncateObjCmd(
|
||||
*/
|
||||
|
||||
length = Tcl_Tell(chan);
|
||||
if (length == -1) {
|
||||
if (length == Tcl_WideAsLong(-1)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not determine current location in \"%s\": %s",
|
||||
TclGetString(objv[1]), Tcl_PosixError(interp)));
|
||||
|
||||
+7
-6
@@ -910,7 +910,7 @@ TransformWideSeekProc(
|
||||
Tcl_ChannelWideSeekProc(parentType);
|
||||
ClientData parentData = Tcl_GetChannelInstanceData(parent);
|
||||
|
||||
if ((offset == 0) && (mode == SEEK_CUR)) {
|
||||
if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
|
||||
/*
|
||||
* This is no seek but a request to tell the caller the current
|
||||
* location. Simply pass the request down.
|
||||
@@ -920,7 +920,8 @@ TransformWideSeekProc(
|
||||
return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
|
||||
}
|
||||
|
||||
return parentSeekProc(parentData, 0, mode, errorCodePtr);
|
||||
return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
|
||||
errorCodePtr));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -960,13 +961,13 @@ TransformWideSeekProc(
|
||||
* to go out of the representable range.
|
||||
*/
|
||||
|
||||
if (offset<LONG_MIN || offset>LONG_MAX) {
|
||||
if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
|
||||
*errorCodePtr = EOVERFLOW;
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
return parentSeekProc(parentData, offset,
|
||||
mode, errorCodePtr);
|
||||
return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
|
||||
mode, errorCodePtr));
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+27
-27
@@ -39,7 +39,7 @@ static int ReflectOutput(ClientData clientData, const char *buf,
|
||||
int toWrite, int *errorCodePtr);
|
||||
static void ReflectWatch(ClientData clientData, int mask);
|
||||
static int ReflectBlock(ClientData clientData, int mode);
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
static void ReflectThread(ClientData clientData, int action);
|
||||
static int ReflectEventRun(Tcl_Event *ev, int flags);
|
||||
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
|
||||
@@ -76,7 +76,7 @@ static const Tcl_ChannelType tclRChannelType = {
|
||||
NULL, /* Flush channel. Not used by core. NULL'able */
|
||||
NULL, /* Handle events. NULL'able */
|
||||
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
ReflectThread, /* thread action, tracking owner */
|
||||
#else
|
||||
NULL, /* thread action */
|
||||
@@ -97,7 +97,7 @@ typedef struct {
|
||||
* interpreter/thread containing its Tcl
|
||||
* command is gone.
|
||||
*/
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
|
||||
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
|
||||
#endif
|
||||
@@ -201,7 +201,7 @@ typedef enum {
|
||||
#define NEGIMPL(a,b)
|
||||
#define HAS(x,f) (x & FLAG(f))
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* Thread specific types and structures.
|
||||
*
|
||||
@@ -451,7 +451,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
|
||||
static const char *msg_write_toomuch = "{write wrote more than requested}";
|
||||
static const char *msg_write_nothing = "{write wrote nothing}";
|
||||
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
static const char *msg_send_originlost = "{Channel thread lost}";
|
||||
#endif /* TCL_THREADS */
|
||||
static const char *msg_send_dstlost = "{Owner lost}";
|
||||
@@ -706,7 +706,7 @@ TclChanCreateObjCmd(
|
||||
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, chan);
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rcmPtr = GetThreadReflectedChannelMap();
|
||||
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
|
||||
&isNew);
|
||||
@@ -750,7 +750,7 @@ TclChanCreateObjCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
typedef struct {
|
||||
Tcl_Event header;
|
||||
ReflectedChannel *rcPtr;
|
||||
@@ -917,11 +917,11 @@ TclChanPostEventObjCmd(
|
||||
* We have the channel and the events to post.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->owner == rcPtr->thread) {
|
||||
#endif
|
||||
Tcl_NotifyChannel(chan, events);
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
} else {
|
||||
ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
|
||||
|
||||
@@ -1137,7 +1137,7 @@ ReflectClose(
|
||||
* if lost?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1169,7 +1169,7 @@ ReflectClose(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1216,7 +1216,7 @@ ReflectClose(
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
}
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rcmPtr = GetThreadReflectedChannelMap();
|
||||
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
|
||||
Tcl_GetChannelName(rcPtr->chan));
|
||||
@@ -1267,7 +1267,7 @@ ReflectInput(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1373,7 +1373,7 @@ ReflectOutput(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1502,7 +1502,7 @@ ReflectSeekWide(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1544,7 +1544,7 @@ ReflectSeekWide(
|
||||
goto invalid;
|
||||
}
|
||||
|
||||
if (newLoc < 0) {
|
||||
if (newLoc < Tcl_LongAsWide(0)) {
|
||||
SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
|
||||
goto invalid;
|
||||
}
|
||||
@@ -1576,7 +1576,7 @@ ReflectSeek(
|
||||
* routine.
|
||||
*/
|
||||
|
||||
return ReflectSeekWide(clientData, offset, seekMode,
|
||||
return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
|
||||
errorCodePtr);
|
||||
}
|
||||
|
||||
@@ -1625,7 +1625,7 @@ ReflectWatch(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1683,7 +1683,7 @@ ReflectBlock(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1719,7 +1719,7 @@ ReflectBlock(
|
||||
return errorNum;
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1789,7 +1789,7 @@ ReflectSetOption(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1868,7 +1868,7 @@ ReflectGetOption(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
int opcode;
|
||||
ForwardParam p;
|
||||
@@ -2131,7 +2131,7 @@ NewReflectedChannel(
|
||||
rcPtr->chan = NULL;
|
||||
rcPtr->interp = interp;
|
||||
rcPtr->dead = 0;
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rcPtr->thread = Tcl_GetCurrentThread();
|
||||
#endif
|
||||
rcPtr->mode = mode;
|
||||
@@ -2506,7 +2506,7 @@ DeleteReflectedChannelMap(
|
||||
Tcl_HashEntry *hPtr; /* Search variable. */
|
||||
ReflectedChannel *rcPtr;
|
||||
Tcl_Channel chan;
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardingEvent *evPtr;
|
||||
ForwardParam *paramPtr;
|
||||
@@ -2536,7 +2536,7 @@ DeleteReflectedChannelMap(
|
||||
Tcl_DeleteHashTable(&rcmPtr->map);
|
||||
ckfree(&rcmPtr->map);
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* The origin interpreter for one or more reflected channels is gone.
|
||||
*/
|
||||
@@ -2622,7 +2622,7 @@ DeleteReflectedChannelMap(
|
||||
#endif
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3079,7 +3079,7 @@ ForwardProc(
|
||||
Tcl_WideInt newLoc;
|
||||
|
||||
if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
|
||||
if (newLoc < 0) {
|
||||
if (newLoc < Tcl_LongAsWide(0)) {
|
||||
ForwardSetStaticError(paramPtr, msg_seek_beforestart);
|
||||
paramPtr->seek.offset = -1;
|
||||
} else {
|
||||
|
||||
+28
-27
@@ -127,7 +127,7 @@ typedef struct {
|
||||
* in the argv, see below. The separate field
|
||||
* gives us direct access, needed when working
|
||||
* with the reflection maps. */
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
|
||||
#endif
|
||||
|
||||
@@ -220,7 +220,7 @@ typedef enum {
|
||||
#define NEGIMPL(a,b)
|
||||
#define HAS(x,f) (x & FLAG(f))
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* Thread specific types and structures.
|
||||
*
|
||||
@@ -438,7 +438,7 @@ static void DeleteReflectedTransformMap(ClientData clientData,
|
||||
|
||||
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
|
||||
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
static const char *msg_send_originlost = "{Channel thread lost}";
|
||||
static const char *msg_send_dstlost = "{Owner lost}";
|
||||
#endif /* TCL_THREADS */
|
||||
@@ -699,7 +699,7 @@ TclChanPushObjCmd(
|
||||
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, rtPtr);
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rtmPtr = GetThreadReflectedTransformMap();
|
||||
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
|
||||
Tcl_SetHashValue(hPtr, rtPtr);
|
||||
@@ -911,7 +911,7 @@ ReflectClose(
|
||||
* if lost?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -938,7 +938,7 @@ ReflectClose(
|
||||
|
||||
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
|
||||
if (!TransformDrain(rtPtr, &errorCode)) {
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
Tcl_EventuallyFree(rtPtr,
|
||||
(Tcl_FreeProc *) FreeReflectedTransform);
|
||||
@@ -952,7 +952,7 @@ ReflectClose(
|
||||
|
||||
if (HAS(rtPtr->methods, METH_FLUSH)) {
|
||||
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
Tcl_EventuallyFree(rtPtr,
|
||||
(Tcl_FreeProc *) FreeReflectedTransform);
|
||||
@@ -968,7 +968,7 @@ ReflectClose(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1025,7 +1025,7 @@ ReflectClose(
|
||||
* under a channel by deleting the owning thread.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rtmPtr = GetThreadReflectedTransformMap();
|
||||
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
|
||||
if (hPtr) {
|
||||
@@ -1340,7 +1340,7 @@ ReflectSeekWide(
|
||||
|
||||
if (seekProc == NULL) {
|
||||
Tcl_SetErrno(EINVAL);
|
||||
return -1;
|
||||
return Tcl_LongAsWide(-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1390,15 +1390,16 @@ ReflectSeekWide(
|
||||
parent->typePtr->wideSeekProc != NULL) {
|
||||
curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
|
||||
seekMode, errorCodePtr);
|
||||
} else if (offset < LONG_MIN || offset > LONG_MAX) {
|
||||
} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
|
||||
offset > Tcl_LongAsWide(LONG_MAX)) {
|
||||
*errorCodePtr = EOVERFLOW;
|
||||
curPos = -1;
|
||||
curPos = Tcl_LongAsWide(-1);
|
||||
} else {
|
||||
curPos = parent->typePtr->seekProc(
|
||||
parent->instanceData, offset, seekMode,
|
||||
errorCodePtr);
|
||||
curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
|
||||
parent->instanceData, Tcl_WideAsLong(offset), seekMode,
|
||||
errorCodePtr));
|
||||
}
|
||||
if (curPos == -1) {
|
||||
if (curPos == Tcl_LongAsWide(-1)) {
|
||||
Tcl_SetErrno(*errorCodePtr);
|
||||
}
|
||||
|
||||
@@ -1421,7 +1422,7 @@ ReflectSeek(
|
||||
* routine.
|
||||
*/
|
||||
|
||||
return ReflectSeekWide(clientData, offset, seekMode,
|
||||
return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
|
||||
errorCodePtr);
|
||||
}
|
||||
|
||||
@@ -1766,7 +1767,7 @@ NewReflectedTransform(
|
||||
|
||||
rtPtr->chan = NULL;
|
||||
rtPtr->methods = 0;
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
rtPtr->thread = Tcl_GetCurrentThread();
|
||||
#endif
|
||||
rtPtr->parent = parentChan;
|
||||
@@ -2151,7 +2152,7 @@ DeleteReflectedTransformMap(
|
||||
Tcl_HashSearch hSearch; /* Search variable. */
|
||||
Tcl_HashEntry *hPtr; /* Search variable. */
|
||||
ReflectedTransform *rtPtr;
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardingEvent *evPtr;
|
||||
ForwardParam *paramPtr;
|
||||
@@ -2181,7 +2182,7 @@ DeleteReflectedTransformMap(
|
||||
Tcl_DeleteHashTable(&rtmPtr->map);
|
||||
ckfree(&rtmPtr->map);
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* The origin interpreter for one or more reflected channels is gone.
|
||||
*/
|
||||
@@ -2253,7 +2254,7 @@ DeleteReflectedTransformMap(
|
||||
#endif /* TCL_THREADS */
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3087,7 +3088,7 @@ TransformRead(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3143,7 +3144,7 @@ TransformWrite(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3209,7 +3210,7 @@ TransformDrain(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3259,7 +3260,7 @@ TransformFlush(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3314,7 +3315,7 @@ TransformClear(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3346,7 +3347,7 @@ TransformLimit(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
|
||||
+1
-1
@@ -11,7 +11,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#if defined(_WIN32)
|
||||
#if defined(_WIN32) && defined(UNICODE)
|
||||
/*
|
||||
* On Windows, we need to do proper Unicode->UTF-8 conversion.
|
||||
*/
|
||||
|
||||
+43
-53
@@ -139,6 +139,7 @@ Tcl_FSRenameFileProc TclpObjRenameFile;
|
||||
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
|
||||
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
|
||||
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
|
||||
Tcl_FSUnloadFileProc TclpUnloadFile;
|
||||
Tcl_FSLinkProc TclpObjLink;
|
||||
Tcl_FSListVolumesProc TclpObjListVolumes;
|
||||
|
||||
@@ -275,8 +276,8 @@ Tcl_Stat(
|
||||
Tcl_WideInt tmp1, tmp2, tmp3 = 0;
|
||||
|
||||
# define OUT_OF_RANGE(x) \
|
||||
(((Tcl_WideInt)(x)) < LONG_MIN || \
|
||||
((Tcl_WideInt)(x)) > LONG_MAX)
|
||||
(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
|
||||
((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
|
||||
# define OUT_OF_URANGE(x) \
|
||||
(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
|
||||
|
||||
@@ -1390,62 +1391,31 @@ TclFSNormalizeToUniquePath(
|
||||
{
|
||||
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
|
||||
|
||||
int i;
|
||||
int isVfsPath = 0;
|
||||
char *path;
|
||||
|
||||
/*
|
||||
* Paths starting with a UNC prefix whose final character is a colon
|
||||
* are reserved for VFS use. These names can not conflict with real
|
||||
* UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx
|
||||
* and rfc3986's definition of reg-name.
|
||||
*
|
||||
* We check these first to avoid useless calls to the native filesystem's
|
||||
* normalizePathProc.
|
||||
* Call each of the "normalise path" functions in succession. This is a
|
||||
* special case, in which if we have a native filesystem handler, we call
|
||||
* it first. This is because the root of Tcl's filesystem is always a
|
||||
* native filesystem (i.e., '/' on unix is native).
|
||||
*/
|
||||
path = Tcl_GetStringFromObj(pathPtr, &i);
|
||||
|
||||
if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
|
||||
|| (path[0] == '\\' && path[1] == '\\') ) ) {
|
||||
for ( i = 2; ; i++) {
|
||||
if (path[i] == '\0') break;
|
||||
if (path[i] == path[0]) break;
|
||||
}
|
||||
--i;
|
||||
if (path[i] == ':') isVfsPath = 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Call each of the "normalise path" functions in succession.
|
||||
*/
|
||||
firstFsRecPtr = FsGetFirstFilesystem();
|
||||
|
||||
Claim();
|
||||
|
||||
if (!isVfsPath) {
|
||||
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
|
||||
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* If we have a native filesystem handler, we call it first. This is
|
||||
* because the root of Tcl's filesystem is always a native filesystem
|
||||
* (i.e., '/' on unix is native).
|
||||
* TODO: Assume that we always find the native file system; it should
|
||||
* always be there...
|
||||
*/
|
||||
|
||||
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
|
||||
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* TODO: Assume that we always find the native file system; it should
|
||||
* always be there...
|
||||
*/
|
||||
|
||||
if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
|
||||
startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
|
||||
startAt);
|
||||
}
|
||||
break;
|
||||
if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
|
||||
startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
|
||||
startAt);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
|
||||
@@ -3184,8 +3154,8 @@ Tcl_FSLoadFile(
|
||||
* present and set to true (any integer > 0) then the unlink is skipped.
|
||||
*/
|
||||
|
||||
static int
|
||||
skipUnlink(
|
||||
int
|
||||
TclSkipUnlink(
|
||||
Tcl_Obj *shlibFile)
|
||||
{
|
||||
/*
|
||||
@@ -3227,8 +3197,8 @@ skipUnlink(
|
||||
#ifndef AUFS_SUPER_MAGIC
|
||||
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
|
||||
#endif /* AUFS_SUPER_MAGIC */
|
||||
if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
|
||||
&& (fs.f_type == AUFS_SUPER_MAGIC)) {
|
||||
if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
|
||||
(fs.f_type == AUFS_SUPER_MAGIC)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
@@ -3443,7 +3413,7 @@ Tcl_LoadFile(
|
||||
* avoids any worries about leaving the copy laying around on exit.
|
||||
*/
|
||||
|
||||
if (!skipUnlink(copyToPtr) &&
|
||||
if (!TclSkipUnlink(copyToPtr) &&
|
||||
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
|
||||
Tcl_DecrRefCount(copyToPtr);
|
||||
|
||||
@@ -3712,10 +3682,30 @@ Tcl_FSUnloadFile(
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclpUnloadFile(handle);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpUnloadFile --
|
||||
*
|
||||
* Unloads a library given its handle
|
||||
*
|
||||
* This function was once filesystem-specific, but has been made portable by
|
||||
* having TclpDlopen return a structure that includes procedure pointers.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclpUnloadFile(
|
||||
Tcl_LoadHandle handle)
|
||||
{
|
||||
if (handle->unloadFileProcPtr != NULL) {
|
||||
handle->unloadFileProcPtr(handle);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -1075,7 +1075,7 @@ declare 9 win {
|
||||
}
|
||||
# new for 8.4.20+/8.5.12+ Cygwin only
|
||||
declare 10 win {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Removed in 8.3.1 (for Win32s only):
|
||||
#declare 10 win {
|
||||
@@ -1212,7 +1212,7 @@ declare 9 unix {
|
||||
# Added in 8.4:
|
||||
|
||||
declare 10 unix {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Slots 11 and 12 are forwarders for functions that were promoted to
|
||||
# generic Stubs
|
||||
|
||||
+41
-112
@@ -38,23 +38,6 @@
|
||||
|
||||
#define AVOID_HACKS_FOR_ITCL 1
|
||||
|
||||
|
||||
/*
|
||||
* Used to tag functions that are only to be visible within the module being
|
||||
* built and not outside it (where this is supported by the linker).
|
||||
* Also used in the platform-specific *Port.h files.
|
||||
*/
|
||||
|
||||
#ifndef MODULE_SCOPE
|
||||
# ifdef __cplusplus
|
||||
# define MODULE_SCOPE extern "C"
|
||||
# else
|
||||
# define MODULE_SCOPE extern
|
||||
# endif
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* Common include files needed by most of the Tcl source files are included
|
||||
* here, so that system-dependent personalizations for the include files only
|
||||
@@ -111,6 +94,19 @@ typedef int ptrdiff_t;
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Used to tag functions that are only to be visible within the module being
|
||||
* built and not outside it (where this is supported by the linker).
|
||||
*/
|
||||
|
||||
#ifndef MODULE_SCOPE
|
||||
# ifdef __cplusplus
|
||||
# define MODULE_SCOPE extern "C"
|
||||
# else
|
||||
# define MODULE_SCOPE extern
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Macros used to cast between pointers and integers (e.g. when storing an int
|
||||
* in ClientData), on 64-bit architectures they avoid gcc warning about "cast
|
||||
@@ -140,26 +136,6 @@ typedef int ptrdiff_t;
|
||||
# define vsnprintf _vsnprintf
|
||||
#endif
|
||||
|
||||
#if !defined(TCL_THREADS)
|
||||
# define TCL_THREADS 1
|
||||
#endif
|
||||
#if !TCL_THREADS
|
||||
# undef TCL_DECLARE_MUTEX
|
||||
# define TCL_DECLARE_MUTEX(name)
|
||||
# undef Tcl_MutexLock
|
||||
# define Tcl_MutexLock(mutexPtr)
|
||||
# undef Tcl_MutexUnlock
|
||||
# define Tcl_MutexUnlock(mutexPtr)
|
||||
# undef Tcl_MutexFinalize
|
||||
# define Tcl_MutexFinalize(mutexPtr)
|
||||
# undef Tcl_ConditionNotify
|
||||
# define Tcl_ConditionNotify(condPtr)
|
||||
# undef Tcl_ConditionWait
|
||||
# define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
|
||||
# undef Tcl_ConditionFinalize
|
||||
# define Tcl_ConditionFinalize(condPtr)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following procedures allow namespaces to be customized to support
|
||||
* special name resolution rules for commands/variables.
|
||||
@@ -1170,10 +1146,6 @@ typedef struct CallFrame {
|
||||
* field contains an Object reference that has
|
||||
* been confirmed to refer to a class. Part of
|
||||
* TIP#257. */
|
||||
#define FRAME_IS_PRIVATE_DEFINE 0x10
|
||||
/* Marks this frame as being used for private
|
||||
* declarations with [oo::define]. Usually
|
||||
* OR'd with FRAME_IS_OO_DEFINE. TIP#500. */
|
||||
|
||||
/*
|
||||
* TIP #280
|
||||
@@ -2788,10 +2760,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
|
||||
|
||||
MODULE_SCOPE char tclEmptyString;
|
||||
|
||||
enum CheckEmptyStringResult {
|
||||
TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
|
||||
};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Procedures shared among Tcl modules but not used by the outside world,
|
||||
@@ -2921,6 +2889,8 @@ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
|
||||
CmdFrame *cfPtr);
|
||||
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
|
||||
CmdFrame **cfPtrPtr, int *wordPtr);
|
||||
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
|
||||
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
|
||||
MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
|
||||
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
int strLen, const unsigned char *pattern,
|
||||
@@ -2928,11 +2898,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
MODULE_SCOPE double TclCeil(const mp_int *a);
|
||||
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
|
||||
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
|
||||
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
|
||||
Var *arrayPtr, Tcl_Obj *name, int index);
|
||||
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
|
||||
const char *value);
|
||||
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
@@ -2948,13 +2915,19 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
|
||||
Tcl_Obj *originObjPtr);
|
||||
MODULE_SCOPE int TclConvertElement(const char *src, int length,
|
||||
char *dst, int flags);
|
||||
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc, ClientData clientData,
|
||||
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
|
||||
const char *name, Tcl_Namespace *nameNamespacePtr,
|
||||
Tcl_Namespace *ensembleNamespacePtr, int flags);
|
||||
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *nameNamespacePtr,
|
||||
Tcl_Namespace *ensembleNamespacePtr,
|
||||
int flags);
|
||||
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
|
||||
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
|
||||
const char *dict, int dictLength,
|
||||
@@ -2981,9 +2954,9 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
|
||||
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
|
||||
Tcl_DString *toAppendPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
|
||||
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv, int objc, int *objcPtr);
|
||||
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
|
||||
Tcl_Namespace *namespacePtr);
|
||||
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
|
||||
MODULE_SCOPE void TclFinalizeAsync(void);
|
||||
@@ -3011,11 +2984,15 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
|
||||
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
|
||||
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
|
||||
const char *attributeName, int *indexPtr);
|
||||
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
|
||||
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
|
||||
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
const char *encodingName);
|
||||
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
|
||||
@@ -3041,8 +3018,6 @@ MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
|
||||
MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp,
|
||||
const char *targetName,
|
||||
const char *packageName);
|
||||
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
|
||||
Tcl_WideInt *);
|
||||
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
|
||||
Tcl_Obj *unquotedPrefix, int globFlags,
|
||||
Tcl_GlobTypeData *types);
|
||||
@@ -3198,8 +3173,7 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
|
||||
Tcl_Obj *cmdPrefix);
|
||||
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
|
||||
mp_int *bignumValue);
|
||||
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
Command *cmdPtr);
|
||||
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
|
||||
@@ -3211,12 +3185,6 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
|
||||
Tcl_Obj *bad, Tcl_Obj *fix);
|
||||
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
|
||||
int numBytes);
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
|
||||
int checkEq, int nocase, int reqlength);
|
||||
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[], int *nocase,
|
||||
int *reqlength);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
@@ -3238,10 +3206,6 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
|
||||
const char *trim, int numTrim);
|
||||
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
|
||||
const char *trim, int numTrim);
|
||||
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
|
||||
MODULE_SCOPE void TclRegisterCommandTypeName(
|
||||
Tcl_ObjCmdProc *implementationProc,
|
||||
const char *nameStr);
|
||||
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCount(int ch);
|
||||
@@ -3265,20 +3229,12 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
|
||||
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
|
||||
#endif
|
||||
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclZipfsInit(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclZipfsMount(Tcl_Interp *interp, const char *zipname,
|
||||
const char *mntpt, const char *passwd);
|
||||
MODULE_SCOPE int TclZipfsUnmount(Tcl_Interp *interp, const char *zipname);
|
||||
MODULE_SCOPE void * TclpThreadCreateKey(void);
|
||||
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
|
||||
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
|
||||
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
|
||||
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
|
||||
const char *msg, int length);
|
||||
/* Tip 430 */
|
||||
MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclZipfs_SafeInit(Tcl_Interp *interp);
|
||||
|
||||
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -4117,19 +4073,6 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
|
||||
MODULE_SCOPE int TclFullFinalizationRequested(void);
|
||||
|
||||
/*
|
||||
* Just for the purposes of command-type registration.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;
|
||||
|
||||
/*
|
||||
* TIP #462.
|
||||
*/
|
||||
@@ -4144,7 +4087,7 @@ typedef enum TclProcessWaitStatus {
|
||||
TCL_PROCESS_EXITED = 1, /* Process has exited. */
|
||||
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
|
||||
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
|
||||
TCL_PROCESS_UNKNOWN_STATUS = 4
|
||||
TCL_PROCESS_UNKNOWN_STATUS = 4
|
||||
/* Child wait status didn't make sense. */
|
||||
} TclProcessWaitStatus;
|
||||
|
||||
@@ -4154,13 +4097,6 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
|
||||
int *codePtr, Tcl_Obj **msgObjPtr,
|
||||
Tcl_Obj **errorObjPtr);
|
||||
|
||||
/*
|
||||
* TIP #508: [array default]
|
||||
*/
|
||||
|
||||
MODULE_SCOPE void TclInitArrayVar(Var *arrayPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr);
|
||||
|
||||
/*
|
||||
* Utility routines for encoding index values as integers. Used by both
|
||||
* some of the command compilers and by [lsort] and [lsearch].
|
||||
@@ -4262,10 +4198,6 @@ typedef const char *TclDTraceStr;
|
||||
} \
|
||||
}
|
||||
|
||||
#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
|
||||
# define USE_THREAD_ALLOC 1
|
||||
#endif
|
||||
|
||||
#if defined(PURIFY)
|
||||
|
||||
/*
|
||||
@@ -4283,7 +4215,7 @@ typedef const char *TclDTraceStr;
|
||||
|
||||
#undef USE_THREAD_ALLOC
|
||||
#undef USE_TCLALLOC
|
||||
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
|
||||
/*
|
||||
* The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
|
||||
@@ -4348,7 +4280,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
|
||||
# define USE_TCLALLOC 0
|
||||
#endif
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/* declared in tclObj.c */
|
||||
MODULE_SCOPE Tcl_Mutex tclObjMutex;
|
||||
#endif
|
||||
@@ -4608,9 +4540,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
|
||||
#define TclIsPureDict(objPtr) \
|
||||
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
|
||||
@@ -13,6 +13,11 @@
|
||||
#ifndef _TCLINTPLATDECLS
|
||||
#define _TCLINTPLATDECLS
|
||||
|
||||
#ifdef _WIN32
|
||||
# define Tcl_DirEntry void
|
||||
# define DIR void
|
||||
#endif
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
# define TCL_STORAGE_CLASS DLLEXPORT
|
||||
@@ -67,7 +72,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
@@ -124,7 +129,7 @@ EXTERN int TclpGetPid(Tcl_Pid pid);
|
||||
/* 9 */
|
||||
EXTERN int TclWinGetPlatformId(void);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
@@ -201,7 +206,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
@@ -264,7 +269,7 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
@@ -297,7 +302,7 @@ typedef struct TclIntPlatStubs {
|
||||
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
|
||||
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
|
||||
int (*tclWinGetPlatformId) (void); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 12 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
|
||||
@@ -330,7 +335,7 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
|
||||
+20
-90
@@ -222,6 +222,9 @@ static int AliasDelete(Tcl_Interp *interp,
|
||||
static int AliasDescribe(Tcl_Interp *interp,
|
||||
Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
|
||||
static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
|
||||
static int AliasObjCmd(ClientData dummy,
|
||||
Tcl_Interp *currentInterp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int AliasNRCmd(ClientData dummy,
|
||||
Tcl_Interp *currentInterp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -254,6 +257,8 @@ static int SlaveInvokeHidden(Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int SlaveMarkTrusted(Tcl_Interp *interp,
|
||||
Tcl_Interp *slaveInterp);
|
||||
static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static void SlaveObjCmdDeleteProc(ClientData clientData);
|
||||
static int SlaveRecursionLimit(Tcl_Interp *interp,
|
||||
Tcl_Interp *slaveInterp, int objc,
|
||||
@@ -397,7 +402,6 @@ Tcl_Init(
|
||||
" set scripts {{set tcl_library}}\n"
|
||||
" } else {\n"
|
||||
" set scripts {}\n"
|
||||
" lappend scripts {zipfs tcl_library}\n"
|
||||
" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
|
||||
" lappend scripts {set env(TCL_LIBRARY)}\n"
|
||||
" lappend scripts {\n"
|
||||
@@ -1414,8 +1418,7 @@ TclPreventAliasLoop(
|
||||
* create or rename the command.
|
||||
*/
|
||||
|
||||
if (cmdPtr->objProc != TclAliasObjCmd
|
||||
&& cmdPtr->objProc != TclLocalAliasObjCmd) {
|
||||
if (cmdPtr->objProc != AliasObjCmd) {
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1470,8 +1473,7 @@ TclPreventAliasLoop(
|
||||
* Otherwise we do not have a loop.
|
||||
*/
|
||||
|
||||
if (aliasCmdPtr->objProc != TclAliasObjCmd
|
||||
&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
|
||||
if (aliasCmdPtr->objProc != AliasObjCmd) {
|
||||
return TCL_OK;
|
||||
}
|
||||
nextAliasPtr = aliasCmdPtr->objClientData;
|
||||
@@ -1537,12 +1539,12 @@ AliasCreate(
|
||||
|
||||
if (slaveInterp == masterInterp) {
|
||||
aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
|
||||
TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
|
||||
aliasPtr, AliasObjCmdDeleteProc);
|
||||
} else {
|
||||
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
|
||||
TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
|
||||
TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
|
||||
AliasObjCmdDeleteProc);
|
||||
} else {
|
||||
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
|
||||
TclGetString(namePtr), AliasObjCmd, aliasPtr,
|
||||
AliasObjCmdDeleteProc);
|
||||
}
|
||||
|
||||
if (TclPreventAliasLoop(interp, slaveInterp,
|
||||
@@ -1778,7 +1780,7 @@ AliasList(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclAliasObjCmd, TclLocalAliasObjCmd --
|
||||
* AliasObjCmd --
|
||||
*
|
||||
* This is the function that services invocations of aliases in a slave
|
||||
* interpreter. One such command exists for each alias. When invoked,
|
||||
@@ -1786,11 +1788,6 @@ AliasList(
|
||||
* master interpreter as designated by the Alias record associated with
|
||||
* this command.
|
||||
*
|
||||
* TclLocalAliasObjCmd is a stripped down version used when the source
|
||||
* and target interpreters of the alias are the same. That lets a number
|
||||
* of safety precautions be avoided: the state is much more precisely
|
||||
* known.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
@@ -1850,8 +1847,8 @@ AliasNRCmd(
|
||||
return Tcl_NREvalObj(interp, listPtr, flags);
|
||||
}
|
||||
|
||||
int
|
||||
TclAliasObjCmd(
|
||||
static int
|
||||
AliasObjCmd(
|
||||
ClientData clientData, /* Alias record. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
@@ -1940,73 +1937,6 @@ TclAliasObjCmd(
|
||||
return result;
|
||||
#undef ALIAS_CMDV_PREALLOC
|
||||
}
|
||||
|
||||
int
|
||||
TclLocalAliasObjCmd(
|
||||
ClientData clientData, /* Alias record. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument vector. */
|
||||
{
|
||||
#define ALIAS_CMDV_PREALLOC 10
|
||||
Alias *aliasPtr = clientData;
|
||||
int result, prefc, cmdc, i;
|
||||
Tcl_Obj **prefv, **cmdv;
|
||||
Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int isRootEnsemble;
|
||||
|
||||
/*
|
||||
* Append the arguments to the command prefix and invoke the command in
|
||||
* the global namespace.
|
||||
*/
|
||||
|
||||
prefc = aliasPtr->objc;
|
||||
prefv = &aliasPtr->objPtr;
|
||||
cmdc = prefc + objc - 1;
|
||||
if (cmdc <= ALIAS_CMDV_PREALLOC) {
|
||||
cmdv = cmdArr;
|
||||
} else {
|
||||
cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
|
||||
}
|
||||
|
||||
memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
|
||||
memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
|
||||
|
||||
for (i=0; i<cmdc; i++) {
|
||||
Tcl_IncrRefCount(cmdv[i]);
|
||||
}
|
||||
|
||||
/*
|
||||
* Use the ensemble rewriting machinery to ensure correct error messages:
|
||||
* only the source command should show, not the full target prefix.
|
||||
*/
|
||||
|
||||
isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);
|
||||
|
||||
/*
|
||||
* Execute the target command in the target interpreter.
|
||||
*/
|
||||
|
||||
result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);
|
||||
|
||||
/*
|
||||
* Clean up the ensemble rewrite info if we set it in the first place.
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
|
||||
}
|
||||
|
||||
for (i=0; i<cmdc; i++) {
|
||||
Tcl_DecrRefCount(cmdv[i]);
|
||||
}
|
||||
if (cmdv != cmdArr) {
|
||||
TclStackFree(interp, cmdv);
|
||||
}
|
||||
return result;
|
||||
#undef ALIAS_CMDV_PREALLOC
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -2446,7 +2376,7 @@ SlaveCreate(
|
||||
slavePtr->slaveEntryPtr = hPtr;
|
||||
slavePtr->slaveInterp = slaveInterp;
|
||||
slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
|
||||
TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
|
||||
SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
|
||||
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
|
||||
Tcl_SetHashValue(hPtr, slavePtr);
|
||||
Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
|
||||
@@ -2514,7 +2444,7 @@ SlaveCreate(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclSlaveObjCmd --
|
||||
* SlaveObjCmd --
|
||||
*
|
||||
* Command to manipulate an interpreter, e.g. to send commands to it to
|
||||
* be evaluated. One such command exists for each slave interpreter.
|
||||
@@ -2528,8 +2458,8 @@ SlaveCreate(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclSlaveObjCmd(
|
||||
static int
|
||||
SlaveObjCmd(
|
||||
ClientData clientData, /* Slave interpreter. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
@@ -2561,7 +2491,7 @@ NRSlaveCmd(
|
||||
};
|
||||
|
||||
if (slaveInterp == NULL) {
|
||||
Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
|
||||
Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
|
||||
}
|
||||
|
||||
if (objc < 2) {
|
||||
|
||||
+6
-4
@@ -89,6 +89,8 @@ static char * EstablishErrorInfoTraces(ClientData clientData,
|
||||
static void FreeNsNameInternalRep(Tcl_Obj *objPtr);
|
||||
static int GetNamespaceFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
|
||||
static int InvokeImportedCmd(ClientData clientData,
|
||||
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
|
||||
static int InvokeImportedNRCmd(ClientData clientData,
|
||||
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
|
||||
static int NamespaceChildrenCmd(ClientData dummy,
|
||||
@@ -1764,7 +1766,7 @@ DoImport(
|
||||
|
||||
dataPtr = ckalloc(sizeof(ImportedCmdData));
|
||||
importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
|
||||
TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
|
||||
InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
|
||||
DeleteImportedCmd);
|
||||
dataPtr->realCmdPtr = cmdPtr;
|
||||
dataPtr->selfPtr = (Command *) importedCmd;
|
||||
@@ -1985,7 +1987,7 @@ TclGetOriginalCommand(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclInvokeImportedCmd --
|
||||
* InvokeImportedCmd --
|
||||
*
|
||||
* Invoked by Tcl whenever the user calls an imported command that was
|
||||
* created by Tcl_Import. Finds the "real" command (in another
|
||||
@@ -2016,8 +2018,8 @@ InvokeImportedNRCmd(
|
||||
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
|
||||
}
|
||||
|
||||
int
|
||||
TclInvokeImportedCmd(
|
||||
static int
|
||||
InvokeImportedCmd(
|
||||
ClientData clientData, /* Points to the imported command's
|
||||
* ImportedCmdData structure. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
|
||||
+100
-145
@@ -31,7 +31,6 @@ static const struct {
|
||||
{"export", TclOODefineExportObjCmd, 0},
|
||||
{"forward", TclOODefineForwardObjCmd, 0},
|
||||
{"method", TclOODefineMethodObjCmd, 0},
|
||||
{"private", TclOODefinePrivateObjCmd, 0},
|
||||
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
|
||||
{"self", TclOODefineSelfObjCmd, 0},
|
||||
{"unexport", TclOODefineUnexportObjCmd, 0},
|
||||
@@ -42,7 +41,6 @@ static const struct {
|
||||
{"export", TclOODefineExportObjCmd, 1},
|
||||
{"forward", TclOODefineForwardObjCmd, 1},
|
||||
{"method", TclOODefineMethodObjCmd, 1},
|
||||
{"private", TclOODefinePrivateObjCmd, 1},
|
||||
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
|
||||
{"self", TclOODefineObjSelfObjCmd, 0},
|
||||
{"unexport", TclOODefineUnexportObjCmd, 1},
|
||||
@@ -90,16 +88,18 @@ static inline void RemoveClass(Class **list, int num, int idx);
|
||||
static inline void RemoveObject(Object **list, int num, int idx);
|
||||
static inline void SquelchCachedName(Object *oPtr);
|
||||
|
||||
static int PublicObjectCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
static int PublicNRObjectCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
static int PrivateObjectCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
static int PrivateNRObjectCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
static int MyClassNRObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
static void MyClassDeleted(ClientData clientData);
|
||||
|
||||
/*
|
||||
* Methods in the oo::object and oo::class classes. First, we define a helper
|
||||
@@ -150,10 +150,65 @@ static const char *initScript =
|
||||
/* " tcloo.tcl OO_LIBRARY oo::library;"; */
|
||||
|
||||
/*
|
||||
* The scripted part of the definitions of TclOO.
|
||||
* The scripted part of the definitions of slots.
|
||||
*/
|
||||
|
||||
#include "tclOOScript.h"
|
||||
static const char *slotScript =
|
||||
"::oo::define ::oo::Slot {\n"
|
||||
" method Get {} {error unimplemented}\n"
|
||||
" method Set list {error unimplemented}\n"
|
||||
" method -set args {\n"
|
||||
" uplevel 1 [list [namespace which my] Set $args]\n"
|
||||
" }\n"
|
||||
" method -append args {\n"
|
||||
" uplevel 1 [list [namespace which my] Set [list"
|
||||
" {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
|
||||
" }\n"
|
||||
" method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
|
||||
" forward --default-operation my -append\n"
|
||||
" method unknown {args} {\n"
|
||||
" set def --default-operation\n"
|
||||
" if {[llength $args] == 0} {\n"
|
||||
" return [uplevel 1 [list [namespace which my] $def]]\n"
|
||||
" } elseif {![string match -* [lindex $args 0]]} {\n"
|
||||
" return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
|
||||
" }\n"
|
||||
" next {*}$args\n"
|
||||
" }\n"
|
||||
" export -set -append -clear\n"
|
||||
" unexport unknown destroy\n"
|
||||
"}\n"
|
||||
"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
|
||||
"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
|
||||
"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";
|
||||
|
||||
/*
|
||||
* The body of the <cloned> method of oo::object.
|
||||
*/
|
||||
|
||||
static const char *clonedBody =
|
||||
"foreach p [info procs [info object namespace $originObject]::*] {"
|
||||
" set args [info args $p];"
|
||||
" set idx -1;"
|
||||
" foreach a $args {"
|
||||
" lset args [incr idx] "
|
||||
" [if {[info default $p $a d]} {list $a $d} {list $a}]"
|
||||
" };"
|
||||
" set b [info body $p];"
|
||||
" set p [namespace tail $p];"
|
||||
" proc $p $args $b;"
|
||||
"};"
|
||||
"foreach v [info vars [info object namespace $originObject]::*] {"
|
||||
" upvar 0 $v vOrigin;"
|
||||
" namespace upvar [namespace current] [namespace tail $v] vNew;"
|
||||
" if {[info exists vOrigin]} {"
|
||||
" if {[array exists vOrigin]} {"
|
||||
" array set vNew [array get vOrigin];"
|
||||
" } else {"
|
||||
" set vNew $vOrigin;"
|
||||
" }"
|
||||
" }"
|
||||
"}";
|
||||
|
||||
/*
|
||||
* The actual definition of the variable holding the TclOO stub table.
|
||||
@@ -303,7 +358,7 @@ InitFoundation(
|
||||
ThreadLocalData *tsdPtr =
|
||||
Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
|
||||
Foundation *fPtr = ckalloc(sizeof(Foundation));
|
||||
Tcl_Obj *namePtr;
|
||||
Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
|
||||
Tcl_DString buffer;
|
||||
Command *cmdPtr;
|
||||
int i;
|
||||
@@ -382,6 +437,18 @@ InitFoundation(
|
||||
TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the default <cloned> method implementation, used when 'oo::copy'
|
||||
* is called to finish the copying of one object to another.
|
||||
*/
|
||||
|
||||
TclNewLiteralStringObj(argsPtr, "originObject");
|
||||
Tcl_IncrRefCount(argsPtr);
|
||||
bodyPtr = Tcl_NewStringObj(clonedBody, -1);
|
||||
TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
|
||||
bodyPtr, NULL);
|
||||
TclDecrRefCount(argsPtr);
|
||||
|
||||
/*
|
||||
* Finish setting up the class of classes by marking the 'new' method as
|
||||
* private; classes, unlike general objects, must have explicit names. We
|
||||
@@ -422,12 +489,7 @@ InitFoundation(
|
||||
if (TclOODefineSlots(fPtr) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Evaluate the remaining definitions, which are a compiled-in Tcl script.
|
||||
*/
|
||||
|
||||
return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
|
||||
return Tcl_EvalEx(interp, slotScript, -1, 0);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -712,9 +774,10 @@ AllocObject(
|
||||
if (nsPtr->parentPtr != NULL) {
|
||||
nsPtr = nsPtr->parentPtr;
|
||||
}
|
||||
|
||||
}
|
||||
oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
|
||||
(Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);
|
||||
(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
|
||||
|
||||
/*
|
||||
* Add the NRE command and trace directly. While this breaks a number of
|
||||
@@ -731,10 +794,7 @@ AllocObject(
|
||||
tracePtr->refCount = 1;
|
||||
|
||||
oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
|
||||
TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
|
||||
oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
|
||||
oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
|
||||
MyClassDeleted);
|
||||
PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
|
||||
return oPtr;
|
||||
}
|
||||
|
||||
@@ -762,12 +822,12 @@ SquelchCachedName(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* MyDeleted, MyClassDeleted --
|
||||
* MyDeleted --
|
||||
*
|
||||
* These callbacks are triggered when the object's [my] or [myclass]
|
||||
* commands are deleted by any mechanism. They just mark the object as
|
||||
* not having a [my] command or [myclass] command, and so prevent cleanup
|
||||
* of those commands when the object itself is deleted.
|
||||
* This callback is triggered when the object's [my] command is deleted
|
||||
* by any mechanism. It just marks the object as not having a [my]
|
||||
* command, and so prevents cleanup of that when the object itself is
|
||||
* deleted.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -781,14 +841,6 @@ MyDeleted(
|
||||
|
||||
oPtr->myCommand = NULL;
|
||||
}
|
||||
|
||||
static void
|
||||
MyClassDeleted(
|
||||
ClientData clientData)
|
||||
{
|
||||
Object *oPtr = clientData;
|
||||
oPtr->myclassCommand = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -941,7 +993,6 @@ ReleaseClassContents(
|
||||
Method *mPtr;
|
||||
Foundation *fPtr = oPtr->fPtr;
|
||||
Tcl_Obj *variableObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
|
||||
/*
|
||||
* Sanity check!
|
||||
@@ -1048,14 +1099,6 @@ ReleaseClassContents(
|
||||
ckfree(clsPtr->variables.list);
|
||||
}
|
||||
|
||||
FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
|
||||
TclDecrRefCount(privateVariable->variableObj);
|
||||
TclDecrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
if (i) {
|
||||
ckfree(clsPtr->privateVariables.list);
|
||||
}
|
||||
|
||||
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
|
||||
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
|
||||
}
|
||||
@@ -1085,7 +1128,6 @@ ObjectNamespaceDeleted(
|
||||
Class *mixinPtr;
|
||||
Method *mPtr;
|
||||
Tcl_Obj *filterObj, *variableObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
Tcl_Interp *interp = oPtr->fPtr->interp;
|
||||
int i;
|
||||
|
||||
@@ -1120,7 +1162,7 @@ ObjectNamespaceDeleted(
|
||||
|
||||
if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
|
||||
CallContext *contextPtr =
|
||||
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
|
||||
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
|
||||
int result;
|
||||
|
||||
Tcl_InterpState state;
|
||||
@@ -1161,9 +1203,6 @@ ObjectNamespaceDeleted(
|
||||
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
|
||||
}
|
||||
|
||||
if (oPtr->myclassCommand) {
|
||||
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
|
||||
}
|
||||
if (oPtr->myCommand) {
|
||||
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
|
||||
}
|
||||
@@ -1209,14 +1248,6 @@ ObjectNamespaceDeleted(
|
||||
ckfree(oPtr->variables.list);
|
||||
}
|
||||
|
||||
FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
|
||||
TclDecrRefCount(privateVariable->variableObj);
|
||||
TclDecrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
if (i) {
|
||||
ckfree(oPtr->privateVariables.list);
|
||||
}
|
||||
|
||||
if (oPtr->chainCache) {
|
||||
TclOODeleteChainCache(oPtr->chainCache);
|
||||
}
|
||||
@@ -1600,7 +1631,7 @@ Tcl_NewObjectInstance(
|
||||
|
||||
if (objc >= 0) {
|
||||
CallContext *contextPtr =
|
||||
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
|
||||
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
|
||||
|
||||
if (contextPtr != NULL) {
|
||||
int isRoot, result;
|
||||
@@ -1673,7 +1704,7 @@ TclNRNewObjectInstance(
|
||||
*objectPtr = (Tcl_Object) oPtr;
|
||||
return TCL_OK;
|
||||
}
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
|
||||
if (contextPtr == NULL) {
|
||||
*objectPtr = (Tcl_Object) oPtr;
|
||||
return TCL_OK;
|
||||
@@ -1853,7 +1884,6 @@ Tcl_CopyObjectInstance(
|
||||
Class *mixinPtr;
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
|
||||
PrivateVariableMapping *privateVariable;
|
||||
int i, result;
|
||||
|
||||
/*
|
||||
@@ -1923,7 +1953,7 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's variable resolution lists to the new object.
|
||||
* Copy the object's variable resolution list to the new object.
|
||||
*/
|
||||
|
||||
DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
|
||||
@@ -1931,13 +1961,6 @@ Tcl_CopyObjectInstance(
|
||||
Tcl_IncrRefCount(variableObj);
|
||||
}
|
||||
|
||||
DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
|
||||
PrivateVariableMapping);
|
||||
FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
|
||||
Tcl_IncrRefCount(privateVariable->variableObj);
|
||||
Tcl_IncrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's flags to the new object, clearing those that must be
|
||||
* kept object-local. The duplicate is never deleted at this point, nor is
|
||||
@@ -2026,7 +2049,7 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the source class's variable resolution lists.
|
||||
* Copy the source class's variable resolution list.
|
||||
*/
|
||||
|
||||
DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
|
||||
@@ -2034,13 +2057,6 @@ Tcl_CopyObjectInstance(
|
||||
Tcl_IncrRefCount(variableObj);
|
||||
}
|
||||
|
||||
DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
|
||||
PrivateVariableMapping);
|
||||
FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
|
||||
Tcl_IncrRefCount(privateVariable->variableObj);
|
||||
Tcl_IncrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
|
||||
/*
|
||||
* Duplicate the source class's mixins (which cannot be circular
|
||||
* references to the duplicate).
|
||||
@@ -2113,8 +2129,7 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
|
||||
NULL, NULL);
|
||||
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
|
||||
if (contextPtr) {
|
||||
args[0] = TclOOObjectName(interp, o2Ptr);
|
||||
args[1] = oPtr->fPtr->clonedName;
|
||||
@@ -2402,7 +2417,7 @@ Tcl_ObjectSetMetadata(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
|
||||
* PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
|
||||
*
|
||||
* Main entry point for object invocations. The Public* and Private*
|
||||
* wrapper functions (implementations of both object instance commands
|
||||
@@ -2412,8 +2427,8 @@ Tcl_ObjectSetMetadata(
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOOPublicObjectCmd(
|
||||
static int
|
||||
PublicObjectCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
@@ -2433,8 +2448,8 @@ PublicNRObjectCmd(
|
||||
NULL);
|
||||
}
|
||||
|
||||
int
|
||||
TclOOPrivateObjectCmd(
|
||||
static int
|
||||
PrivateObjectCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
@@ -2484,43 +2499,6 @@ TclOOInvokeObject(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOMyClassObjCmd, MyClassNRObjCmd --
|
||||
*
|
||||
* Special trap door to allow an object to delegate simply to its class.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOOMyClassObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
|
||||
}
|
||||
|
||||
static int
|
||||
MyClassNRObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = clientData;
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
|
||||
NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2548,9 +2526,6 @@ TclOOObjectCmdCore(
|
||||
{
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *methodNamePtr;
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
Object *callerObjPtr = NULL;
|
||||
Class *callerClsPtr = NULL;
|
||||
int result;
|
||||
|
||||
/*
|
||||
@@ -2564,24 +2539,6 @@ TclOOObjectCmdCore(
|
||||
goto noMapping;
|
||||
}
|
||||
|
||||
/*
|
||||
* Determine if we're in a context that can see the extra, private methods
|
||||
* in this class.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
CallContext *callerContextPtr = framePtr->clientData;
|
||||
Method *callerMethodPtr =
|
||||
callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
|
||||
|
||||
if (callerMethodPtr->declaringObjectPtr) {
|
||||
callerObjPtr = callerMethodPtr->declaringObjectPtr;
|
||||
}
|
||||
if (callerMethodPtr->declaringClassPtr) {
|
||||
callerClsPtr = callerMethodPtr->declaringClassPtr;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Give plugged in code a chance to remap the method name.
|
||||
*/
|
||||
@@ -2609,8 +2566,7 @@ TclOOObjectCmdCore(
|
||||
|
||||
Tcl_IncrRefCount(mappedMethodName);
|
||||
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
|
||||
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
|
||||
callerClsPtr, methodNamePtr);
|
||||
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
|
||||
TclDecrRefCount(mappedMethodName);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2627,8 +2583,7 @@ TclOOObjectCmdCore(
|
||||
|
||||
noMapping:
|
||||
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
|
||||
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
|
||||
callerClsPtr, NULL);
|
||||
flags | (oPtr->flags & FILTER_HANDLING), NULL);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"impossible to invoke method \"%s\": no defined method or"
|
||||
@@ -2878,9 +2833,9 @@ Tcl_GetObjectFromObj(
|
||||
if (cmdPtr == NULL) {
|
||||
goto notAnObject;
|
||||
}
|
||||
if (cmdPtr->objProc != TclOOPublicObjectCmd) {
|
||||
if (cmdPtr->objProc != PublicObjectCmd) {
|
||||
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
|
||||
if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
|
||||
if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
|
||||
goto notAnObject;
|
||||
}
|
||||
}
|
||||
|
||||
+2
-5
@@ -58,12 +58,12 @@ declare 10 {
|
||||
}
|
||||
declare 11 {
|
||||
Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
|
||||
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
|
||||
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData)
|
||||
}
|
||||
declare 12 {
|
||||
Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
|
||||
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData)
|
||||
}
|
||||
declare 13 {
|
||||
@@ -126,9 +126,6 @@ declare 27 {
|
||||
declare 28 {
|
||||
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
|
||||
}
|
||||
declare 29 {
|
||||
int Tcl_MethodIsPrivate(Tcl_Method method)
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# Private API, exposed to support advanced OO systems that plug in on top of
|
||||
|
||||
@@ -99,15 +99,6 @@ typedef struct {
|
||||
*/
|
||||
|
||||
#define TCL_OO_METHOD_VERSION_CURRENT 1
|
||||
|
||||
/*
|
||||
* Visibility constants for the flags parameter to Tcl_NewMethod and
|
||||
* Tcl_NewInstanceMethod.
|
||||
*/
|
||||
|
||||
#define TCL_OO_METHOD_PUBLIC 1
|
||||
#define TCL_OO_METHOD_UNEXPORTED 0
|
||||
#define TCL_OO_METHOD_PRIVATE 0x20
|
||||
|
||||
/*
|
||||
* The type of some object (or class) metadata. This describes how to delete
|
||||
|
||||
+19
-113
@@ -83,7 +83,7 @@ TclOO_Class_Constructor(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
Tcl_Obj **invoke, *nameObj;
|
||||
Tcl_Obj **invoke;
|
||||
|
||||
if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
|
||||
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
||||
@@ -93,17 +93,6 @@ TclOO_Class_Constructor(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Make the class definition delegate. This is special; it doesn't reenter
|
||||
* here (and the class definition delegate doesn't run any constructors).
|
||||
*/
|
||||
|
||||
nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
|
||||
Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
|
||||
Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
|
||||
TclGetString(nameObj), NULL, -1, NULL, -1);
|
||||
Tcl_DecrRefCount(nameObj);
|
||||
|
||||
/*
|
||||
* Delegate to [oo::define] to do the work.
|
||||
*/
|
||||
@@ -122,7 +111,7 @@ TclOO_Class_Constructor(
|
||||
Tcl_IncrRefCount(invoke[1]);
|
||||
Tcl_IncrRefCount(invoke[2]);
|
||||
TclNRAddCallback(interp, DecrRefsPostClassConstructor,
|
||||
invoke, oPtr, NULL, NULL);
|
||||
invoke, NULL, NULL, NULL);
|
||||
|
||||
/*
|
||||
* Tricky point: do not want the extra reported level in the Tcl stack
|
||||
@@ -139,27 +128,12 @@ DecrRefsPostClassConstructor(
|
||||
int result)
|
||||
{
|
||||
Tcl_Obj **invoke = data[0];
|
||||
Object *oPtr = data[1];
|
||||
Tcl_InterpState saved;
|
||||
int code;
|
||||
|
||||
TclDecrRefCount(invoke[0]);
|
||||
TclDecrRefCount(invoke[1]);
|
||||
TclDecrRefCount(invoke[2]);
|
||||
invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
|
||||
invoke[1] = TclOOObjectName(interp, oPtr);
|
||||
Tcl_IncrRefCount(invoke[0]);
|
||||
Tcl_IncrRefCount(invoke[1]);
|
||||
saved = Tcl_SaveInterpState(interp, result);
|
||||
code = Tcl_EvalObjv(interp, 2, invoke, 0);
|
||||
TclDecrRefCount(invoke[0]);
|
||||
TclDecrRefCount(invoke[1]);
|
||||
ckfree(invoke);
|
||||
if (code != TCL_OK) {
|
||||
Tcl_DiscardInterpState(saved);
|
||||
return code;
|
||||
}
|
||||
return Tcl_RestoreInterpState(interp, saved);
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -373,8 +347,7 @@ TclOO_Object_Destroy(
|
||||
}
|
||||
if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
|
||||
oPtr->flags |= DESTRUCTOR_CALLED;
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
|
||||
NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
|
||||
if (contextPtr != NULL) {
|
||||
contextPtr->callPtr->flags |= DESTRUCTOR;
|
||||
contextPtr->skip = 0;
|
||||
@@ -526,12 +499,9 @@ TclOO_Object_Unknown(
|
||||
Tcl_Obj *const *objv) /* The actual arguments. */
|
||||
{
|
||||
CallContext *contextPtr = (CallContext *) context;
|
||||
Object *callerObj = NULL;
|
||||
Class *callerCls = NULL;
|
||||
Object *oPtr = contextPtr->oPtr;
|
||||
const char **methodNames;
|
||||
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
Tcl_Obj *errorMsg;
|
||||
|
||||
/*
|
||||
@@ -545,32 +515,11 @@ TclOO_Object_Unknown(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Determine if the calling context should know about extra private
|
||||
* methods, and if so, which.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
CallContext *callerContext = framePtr->clientData;
|
||||
Method *mPtr = callerContext->callPtr->chain[
|
||||
callerContext->index].mPtr;
|
||||
|
||||
if (mPtr->declaringObjectPtr) {
|
||||
if (oPtr == mPtr->declaringObjectPtr) {
|
||||
callerObj = mPtr->declaringObjectPtr;
|
||||
}
|
||||
} else {
|
||||
if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
|
||||
callerCls = mPtr->declaringClassPtr;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the list of methods that we want to know about.
|
||||
*/
|
||||
|
||||
numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
|
||||
numMethodNames = TclOOGetSortedMethodList(oPtr,
|
||||
contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
|
||||
|
||||
/*
|
||||
@@ -735,7 +684,6 @@ TclOO_Object_VarName(
|
||||
{
|
||||
Var *varPtr, *aryVar;
|
||||
Tcl_Obj *varNamePtr, *argPtr;
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
const char *arg;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
@@ -761,58 +709,6 @@ TclOO_Object_VarName(
|
||||
Tcl_Namespace *namespacePtr =
|
||||
Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
|
||||
|
||||
/*
|
||||
* Private method handling. [TIP 500]
|
||||
*
|
||||
* If we're in a context that can see some private methods of an
|
||||
* object, we may need to precede a variable name with its prefix.
|
||||
* This is a little tricky as we need to check through the inheritance
|
||||
* hierarchy when the method was declared by a class to see if the
|
||||
* current object is an instance of that class.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
CallContext *callerContext = framePtr->clientData;
|
||||
Method *mPtr = callerContext->callPtr->chain[
|
||||
callerContext->index].mPtr;
|
||||
PrivateVariableMapping *pvPtr;
|
||||
int i;
|
||||
|
||||
if (mPtr->declaringObjectPtr == oPtr) {
|
||||
FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
|
||||
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
|
||||
Tcl_GetString(argPtr))) {
|
||||
argPtr = pvPtr->fullNameObj;
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (mPtr->declaringClassPtr &&
|
||||
mPtr->declaringClassPtr->privateVariables.num) {
|
||||
Class *clsPtr = mPtr->declaringClassPtr;
|
||||
int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
|
||||
Class *mixinCls;
|
||||
|
||||
if (!isInstance) {
|
||||
FOREACH(mixinCls, oPtr->mixins) {
|
||||
if (TclOOIsReachable(clsPtr, mixinCls)) {
|
||||
isInstance = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (isInstance) {
|
||||
FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
|
||||
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
|
||||
Tcl_GetString(argPtr))) {
|
||||
argPtr = pvPtr->fullNameObj;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
|
||||
Tcl_AppendToObj(varNamePtr, "::", 2);
|
||||
Tcl_AppendObjToObj(varNamePtr, argPtr);
|
||||
@@ -833,16 +729,26 @@ TclOO_Object_VarName(
|
||||
|
||||
varNamePtr = Tcl_NewObj();
|
||||
if (aryVar != NULL) {
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch search;
|
||||
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
|
||||
|
||||
/*
|
||||
* WARNING! This code pokes inside the implementation of hash tables!
|
||||
*/
|
||||
|
||||
Tcl_AppendToObj(varNamePtr, "(", -1);
|
||||
Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
|
||||
varPtr)->entry.key.objPtr);
|
||||
Tcl_AppendToObj(varNamePtr, ")", -1);
|
||||
hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
|
||||
&search);
|
||||
while (hPtr != NULL) {
|
||||
if (varPtr == Tcl_GetHashValue(hPtr)) {
|
||||
Tcl_AppendToObj(varNamePtr, "(", -1);
|
||||
Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
|
||||
Tcl_AppendToObj(varNamePtr, ")", -1);
|
||||
break;
|
||||
}
|
||||
hPtr = Tcl_NextHashEntry(&search);
|
||||
}
|
||||
} else {
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
|
||||
}
|
||||
|
||||
+209
-467
@@ -45,28 +45,6 @@ struct ChainBuilder {
|
||||
(((flags) & OBJECT_MIXIN) || \
|
||||
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
|
||||
|
||||
/*
|
||||
* Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
|
||||
* Itcl's special type of private.
|
||||
*/
|
||||
|
||||
#define IS_PUBLIC(mPtr) \
|
||||
(((mPtr)->flags & PUBLIC_METHOD) != 0)
|
||||
#define IS_UNEXPORTED(mPtr) \
|
||||
(((mPtr)->flags & SCOPE_FLAGS) == 0)
|
||||
#define IS_ITCLPRIVATE(mPtr) \
|
||||
(((mPtr)->flags & PRIVATE_METHOD) != 0)
|
||||
#define IS_PRIVATE(mPtr) \
|
||||
(((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
|
||||
#define WANT_PUBLIC(flags) \
|
||||
(((flags) & PUBLIC_METHOD) != 0)
|
||||
#define WANT_UNEXPORTED(flags) \
|
||||
(((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
|
||||
#define WANT_ITCLPRIVATE(flags) \
|
||||
(((flags) & PRIVATE_METHOD) != 0)
|
||||
#define WANT_PRIVATE(flags) \
|
||||
(((flags) & TRUE_PRIVATE_METHOD) != 0)
|
||||
|
||||
/*
|
||||
* Function declarations for things defined in this file.
|
||||
*/
|
||||
@@ -81,26 +59,12 @@ static inline void AddMethodToCallChain(Method *const mPtr,
|
||||
struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters,
|
||||
Class *const filterDecl, int flags);
|
||||
static inline int AddInstancePrivateToCallContext(Object *const oPtr,
|
||||
Tcl_Obj *const methodNameObj,
|
||||
struct ChainBuilder *const cbPtr, int flags);
|
||||
static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr,
|
||||
Method *mPtr, Tcl_HashTable *namesPtr);
|
||||
static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
|
||||
Tcl_HashTable *namesPtr);
|
||||
static inline int AddSimpleChainToCallContext(Object *const oPtr,
|
||||
Class *const contextCls,
|
||||
static inline void AddSimpleChainToCallContext(Object *const oPtr,
|
||||
Tcl_Obj *const methodNameObj,
|
||||
struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters, int flags,
|
||||
Class *const filterDecl);
|
||||
static int AddPrivatesFromClassChainToCallContext(Class *classPtr,
|
||||
Class *const contextCls,
|
||||
Tcl_Obj *const methodNameObj,
|
||||
struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters, int flags,
|
||||
Class *const filterDecl);
|
||||
static int AddSimpleClassChainToCallContext(Class *classPtr,
|
||||
static void AddSimpleClassChainToCallContext(Class *classPtr,
|
||||
Tcl_Obj *const methodNameObj,
|
||||
struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters, int flags,
|
||||
@@ -113,8 +77,6 @@ static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
|
||||
int flags, int reuseMask);
|
||||
static Tcl_NRPostProc ResetFilterFlags;
|
||||
static Tcl_NRPostProc SetFilterFlags;
|
||||
static int SortMethodNames(Tcl_HashTable *namesPtr, int flags,
|
||||
const char ***stringsPtr);
|
||||
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
|
||||
|
||||
/*
|
||||
@@ -404,14 +366,6 @@ FinalizeMethodRefs(
|
||||
int
|
||||
TclOOGetSortedMethodList(
|
||||
Object *oPtr, /* The object to get the method names for. */
|
||||
Object *contextObj, /* From what context object we are inquiring.
|
||||
* NULL when the context shouldn't see
|
||||
* object-level private methods. Note that
|
||||
* flags can override this. */
|
||||
Class *contextCls, /* From what context class we are inquiring.
|
||||
* NULL when the context shouldn't see
|
||||
* class-level private methods. Note that
|
||||
* flags can override this. */
|
||||
int flags, /* Whether we just want the public method
|
||||
* names. */
|
||||
const char ***stringsPtr) /* Where to write a pointer to the array of
|
||||
@@ -424,10 +378,12 @@ TclOOGetSortedMethodList(
|
||||
* at. Is set-like in nature and keyed by
|
||||
* pointer to class. */
|
||||
FOREACH_HASH_DECLS;
|
||||
int i, numStrings;
|
||||
int i;
|
||||
Class *mixinPtr;
|
||||
Tcl_Obj *namePtr;
|
||||
Method *mPtr;
|
||||
int isWantedIn;
|
||||
void *isWanted;
|
||||
|
||||
Tcl_InitObjHashTable(&names);
|
||||
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
|
||||
@@ -444,13 +400,18 @@ TclOOGetSortedMethodList(
|
||||
|
||||
if (oPtr->methodsPtr) {
|
||||
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
int isNew;
|
||||
|
||||
if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
|
||||
continue;
|
||||
}
|
||||
if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
|
||||
continue;
|
||||
hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
|
||||
if (isNew) {
|
||||
isWantedIn = ((!(flags & PUBLIC_METHOD)
|
||||
|| mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
|
||||
isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
|
||||
}
|
||||
AddStandardMethodName(flags, namePtr, mPtr, &names);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -458,26 +419,29 @@ TclOOGetSortedMethodList(
|
||||
* Process method names due to private methods on the object's class.
|
||||
*/
|
||||
|
||||
if (WANT_UNEXPORTED(flags)) {
|
||||
if (flags & PRIVATE_METHOD) {
|
||||
FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
|
||||
if (IS_UNEXPORTED(mPtr)) {
|
||||
AddStandardMethodName(flags, namePtr, mPtr, &names);
|
||||
if (mPtr->flags & PRIVATE_METHOD) {
|
||||
int isNew;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
|
||||
if (isNew) {
|
||||
isWantedIn = IN_LIST;
|
||||
if (mPtr->typePtr == NULL) {
|
||||
isWantedIn |= NO_IMPLEMENTATION;
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
|
||||
} else if (mPtr->typePtr != NULL) {
|
||||
isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
|
||||
if (isWantedIn & NO_IMPLEMENTATION) {
|
||||
isWantedIn &= ~NO_IMPLEMENTATION;
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Process method names due to private methods on the context's object or
|
||||
* class. Which must be correct if either are not NULL.
|
||||
*/
|
||||
|
||||
if (contextObj && contextObj->methodsPtr) {
|
||||
AddPrivateMethodNames(contextObj->methodsPtr, &names);
|
||||
}
|
||||
if (contextCls) {
|
||||
AddPrivateMethodNames(&contextCls->classMethods, &names);
|
||||
}
|
||||
|
||||
/*
|
||||
* Process (normal) method names from the class hierarchy and the mixin
|
||||
* hierarchy.
|
||||
@@ -485,19 +449,54 @@ TclOOGetSortedMethodList(
|
||||
|
||||
AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
|
||||
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
|
||||
&examinedClasses);
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(&examinedClasses);
|
||||
|
||||
/*
|
||||
* Tidy up, sort the names and resolve finally whether we really want
|
||||
* them (processing export layering).
|
||||
* See how many (visible) method names there are. If none, we do not (and
|
||||
* should not) try to sort the list of them.
|
||||
*/
|
||||
|
||||
Tcl_DeleteHashTable(&examinedClasses);
|
||||
numStrings = SortMethodNames(&names, flags, stringsPtr);
|
||||
i = 0;
|
||||
if (names.numEntries != 0) {
|
||||
const char **strings;
|
||||
|
||||
/*
|
||||
* We need to build the list of methods to sort. We will be using
|
||||
* qsort() for this, because it is very unlikely that the list will be
|
||||
* heavily sorted when it is long enough to matter.
|
||||
*/
|
||||
|
||||
strings = ckalloc(sizeof(char *) * names.numEntries);
|
||||
FOREACH_HASH(namePtr, isWanted, &names) {
|
||||
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
|
||||
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
|
||||
continue;
|
||||
}
|
||||
strings[i++] = TclGetString(namePtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Note that 'i' may well be less than names.numEntries when we are
|
||||
* dealing with public method names.
|
||||
*/
|
||||
|
||||
if (i > 0) {
|
||||
if (i > 1) {
|
||||
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
|
||||
}
|
||||
*stringsPtr = strings;
|
||||
} else {
|
||||
ckfree(strings);
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(&names);
|
||||
return numStrings;
|
||||
return i;
|
||||
}
|
||||
|
||||
int
|
||||
@@ -514,7 +513,10 @@ TclOOGetSortedClassMethodList(
|
||||
/* Used to track what classes have been looked
|
||||
* at. Is set-like in nature and keyed by
|
||||
* pointer to class. */
|
||||
int numStrings;
|
||||
FOREACH_HASH_DECLS;
|
||||
int i;
|
||||
Tcl_Obj *namePtr;
|
||||
void *isWanted;
|
||||
|
||||
Tcl_InitObjHashTable(&names);
|
||||
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
|
||||
@@ -526,101 +528,51 @@ TclOOGetSortedClassMethodList(
|
||||
AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
|
||||
Tcl_DeleteHashTable(&examinedClasses);
|
||||
|
||||
/*
|
||||
* Process private method names if we should. [TIP 500]
|
||||
*/
|
||||
|
||||
if (WANT_PRIVATE(flags)) {
|
||||
AddPrivateMethodNames(&clsPtr->classMethods, &names);
|
||||
flags &= ~TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
|
||||
/*
|
||||
* Tidy up, sort the names and resolve finally whether we really want
|
||||
* them (processing export layering).
|
||||
*/
|
||||
|
||||
numStrings = SortMethodNames(&names, flags, stringsPtr);
|
||||
Tcl_DeleteHashTable(&names);
|
||||
return numStrings;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* SortMethodNames --
|
||||
*
|
||||
* Shared helper for TclOOGetSortedMethodList etc. that knows the method
|
||||
* sorting rules.
|
||||
*
|
||||
* Returns:
|
||||
* The length of the sorted list.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
SortMethodNames(
|
||||
Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains
|
||||
* whether the names are wanted and under what
|
||||
* circumstances. */
|
||||
int flags, /* Whether we are looking for unexported
|
||||
* methods. Full private methods are handled
|
||||
* on insertion to the table. */
|
||||
const char ***stringsPtr) /* Where to store the sorted list of strings
|
||||
* that we produce. ckalloced() */
|
||||
{
|
||||
const char **strings;
|
||||
FOREACH_HASH_DECLS;
|
||||
Tcl_Obj *namePtr;
|
||||
void *isWanted;
|
||||
int i = 0;
|
||||
|
||||
/*
|
||||
* See how many (visible) method names there are. If none, we do not (and
|
||||
* should not) try to sort the list of them.
|
||||
*/
|
||||
|
||||
if (namesPtr->numEntries == 0) {
|
||||
*stringsPtr = NULL;
|
||||
return 0;
|
||||
}
|
||||
i = 0;
|
||||
if (names.numEntries != 0) {
|
||||
const char **strings;
|
||||
|
||||
/*
|
||||
* We need to build the list of methods to sort. We will be using qsort()
|
||||
* for this, because it is very unlikely that the list will be heavily
|
||||
* sorted when it is long enough to matter.
|
||||
*/
|
||||
/*
|
||||
* We need to build the list of methods to sort. We will be using
|
||||
* qsort() for this, because it is very unlikely that the list will be
|
||||
* heavily sorted when it is long enough to matter.
|
||||
*/
|
||||
|
||||
strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
|
||||
FOREACH_HASH(namePtr, isWanted, namesPtr) {
|
||||
if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
|
||||
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
|
||||
continue;
|
||||
strings = ckalloc(sizeof(char *) * names.numEntries);
|
||||
FOREACH_HASH(namePtr, isWanted, &names) {
|
||||
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
|
||||
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
|
||||
continue;
|
||||
}
|
||||
strings[i++] = TclGetString(namePtr);
|
||||
}
|
||||
strings[i++] = TclGetString(namePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Note that 'i' may well be less than names.numEntries when we are
|
||||
* dealing with public method names.
|
||||
*/
|
||||
|
||||
if (i > 0) {
|
||||
if (i > 1) {
|
||||
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
|
||||
}
|
||||
*stringsPtr = strings;
|
||||
} else {
|
||||
ckfree(strings);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Note that 'i' may well be less than names.numEntries when we are
|
||||
* dealing with public method names. We don't sort unless there's at least
|
||||
* two method names.
|
||||
*/
|
||||
|
||||
if (i > 0) {
|
||||
if (i > 1) {
|
||||
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
|
||||
}
|
||||
*stringsPtr = strings;
|
||||
} else {
|
||||
ckfree(strings);
|
||||
*stringsPtr = NULL;
|
||||
}
|
||||
Tcl_DeleteHashTable(&names);
|
||||
return i;
|
||||
}
|
||||
|
||||
/* Comparator for SortMethodNames */
|
||||
/* Comparator for GetSortedMethodList */
|
||||
static int
|
||||
CmpStr(
|
||||
const void *ptr1,
|
||||
@@ -629,7 +581,7 @@ CmpStr(
|
||||
const char **strPtr1 = (const char **) ptr1;
|
||||
const char **strPtr2 = (const char **) ptr2;
|
||||
|
||||
return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
|
||||
return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -662,8 +614,6 @@ AddClassMethodNames(
|
||||
* pointers to the classes, and the values are
|
||||
* immaterial. */
|
||||
{
|
||||
int i;
|
||||
|
||||
/*
|
||||
* If we've already started looking at this class, stop working on it now
|
||||
* to prevent repeated work.
|
||||
@@ -694,6 +644,7 @@ AddClassMethodNames(
|
||||
|
||||
if (clsPtr->mixins.num != 0) {
|
||||
Class *mixinPtr;
|
||||
int i;
|
||||
|
||||
FOREACH(mixinPtr, clsPtr->mixins) {
|
||||
if (mixinPtr != clsPtr) {
|
||||
@@ -704,7 +655,20 @@ AddClassMethodNames(
|
||||
}
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
|
||||
AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
|
||||
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
if (isNew) {
|
||||
int isWanted = (!(flags & PUBLIC_METHOD)
|
||||
|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
|
||||
|
||||
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
|
||||
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
|
||||
&& mPtr->typePtr != NULL) {
|
||||
int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
|
||||
|
||||
isWanted &= ~NO_IMPLEMENTATION;
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
|
||||
}
|
||||
}
|
||||
|
||||
if (clsPtr->superclasses.num != 1) {
|
||||
@@ -714,6 +678,7 @@ AddClassMethodNames(
|
||||
}
|
||||
if (clsPtr->superclasses.num != 0) {
|
||||
Class *superPtr;
|
||||
int i;
|
||||
|
||||
FOREACH(superPtr, clsPtr->superclasses) {
|
||||
AddClassMethodNames(superPtr, flags, namesPtr,
|
||||
@@ -722,105 +687,6 @@ AddClassMethodNames(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* AddPrivateMethodNames, AddStandardMethodName --
|
||||
*
|
||||
* Factored-out helpers for the sorted name list production functions.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline void
|
||||
AddPrivateMethodNames(
|
||||
Tcl_HashTable *methodsTablePtr,
|
||||
Tcl_HashTable *namesPtr)
|
||||
{
|
||||
FOREACH_HASH_DECLS;
|
||||
Method *mPtr;
|
||||
Tcl_Obj *namePtr;
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
int isNew;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static inline void
|
||||
AddStandardMethodName(
|
||||
int flags,
|
||||
Tcl_Obj *namePtr,
|
||||
Method *mPtr,
|
||||
Tcl_HashTable *namesPtr)
|
||||
{
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
int isNew;
|
||||
Tcl_HashEntry *hPtr =
|
||||
Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
|
||||
if (isNew) {
|
||||
int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
|
||||
? IN_LIST : 0;
|
||||
|
||||
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
|
||||
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
|
||||
&& mPtr->typePtr != NULL) {
|
||||
int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
|
||||
|
||||
isWanted &= ~NO_IMPLEMENTATION;
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#undef IN_LIST
|
||||
#undef NO_IMPLEMENTATION
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* AddInstancePrivateToCallContext --
|
||||
*
|
||||
* Add private methods from the instance. Called when the calling Tcl
|
||||
* context is a TclOO method declared by an object that is the same as
|
||||
* the current object. Returns true iff a private method was actually
|
||||
* found and added to the call chain (as this suppresses caching).
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
AddInstancePrivateToCallContext(
|
||||
Object *const oPtr, /* Object to add call chain entries for. */
|
||||
Tcl_Obj *const methodName, /* Name of method to add the call chain
|
||||
* entries for. */
|
||||
struct ChainBuilder *const cbPtr,
|
||||
/* Where to add the call chain entries. */
|
||||
int flags) /* What sort of call chain are we building. */
|
||||
{
|
||||
Tcl_HashEntry *hPtr;
|
||||
Method *mPtr;
|
||||
int donePrivate = 0;
|
||||
|
||||
if (oPtr->methodsPtr) {
|
||||
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
|
||||
if (hPtr != NULL) {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
|
||||
donePrivate = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
return donePrivate;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -829,17 +695,14 @@ AddInstancePrivateToCallContext(
|
||||
* The core of the call-chain construction engine, this handles calling a
|
||||
* particular method on a particular object. Note that filters and
|
||||
* unknown handling are already handled by the logic that uses this
|
||||
* function. Returns true if a private method was one of those found.
|
||||
* function.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
static inline void
|
||||
AddSimpleChainToCallContext(
|
||||
Object *const oPtr, /* Object to add call chain entries for. */
|
||||
Class *const contextCls, /* Context class; the currently considered
|
||||
* class is equal to this, private methods may
|
||||
* also be added. [TIP 500] */
|
||||
Tcl_Obj *const methodNameObj,
|
||||
/* Name of method to add the call chain
|
||||
* entries for. */
|
||||
@@ -853,62 +716,44 @@ AddSimpleChainToCallContext(
|
||||
* NULL, either the filter was declared by the
|
||||
* object or this isn't a filter. */
|
||||
{
|
||||
int i, foundPrivate = 0, blockedUnexported = 0;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Method *mPtr;
|
||||
int i;
|
||||
|
||||
if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
|
||||
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
|
||||
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
|
||||
(char *) methodNameObj);
|
||||
|
||||
if (hPtr != NULL) {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
if (WANT_PUBLIC(flags)) {
|
||||
if (!IS_PUBLIC(mPtr)) {
|
||||
blockedUnexported = 1;
|
||||
} else {
|
||||
flags |= DEFINITE_PUBLIC;
|
||||
}
|
||||
Method *mPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (flags & PUBLIC_METHOD) {
|
||||
if (!(mPtr->flags & PUBLIC_METHOD)) {
|
||||
return;
|
||||
} else {
|
||||
flags |= DEFINITE_PROTECTED;
|
||||
flags |= DEFINITE_PUBLIC;
|
||||
}
|
||||
} else {
|
||||
flags |= DEFINITE_PROTECTED;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!(flags & SPECIAL)) {
|
||||
Tcl_HashEntry *hPtr;
|
||||
Class *mixinPtr;
|
||||
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
if (contextCls) {
|
||||
foundPrivate |= AddPrivatesFromClassChainToCallContext(
|
||||
mixinPtr, contextCls, methodNameObj, cbPtr,
|
||||
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
|
||||
}
|
||||
foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
|
||||
methodNameObj, cbPtr, doneFilters,
|
||||
flags | TRAVERSED_MIXIN, filterDecl);
|
||||
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
|
||||
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
|
||||
}
|
||||
if (oPtr->methodsPtr && !blockedUnexported) {
|
||||
if (oPtr->methodsPtr) {
|
||||
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
|
||||
if (hPtr != NULL) {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
|
||||
flags);
|
||||
}
|
||||
AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
|
||||
doneFilters, filterDecl, flags);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (contextCls) {
|
||||
foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
|
||||
contextCls, methodNameObj, cbPtr, doneFilters, flags,
|
||||
filterDecl);
|
||||
}
|
||||
if (!blockedUnexported) {
|
||||
foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
|
||||
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
|
||||
}
|
||||
return foundPrivate;
|
||||
AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
|
||||
doneFilters, flags, filterDecl);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -971,8 +816,8 @@ AddMethodToCallChain(
|
||||
* should be sufficient for [incr Tcl] support though.
|
||||
*/
|
||||
|
||||
if (!WANT_UNEXPORTED(callPtr->flags)
|
||||
&& IS_UNEXPORTED(mPtr)
|
||||
if (!(callPtr->flags & PRIVATE_METHOD)
|
||||
&& (mPtr->flags & PRIVATE_METHOD)
|
||||
&& (mPtr->declaringClassPtr != NULL)
|
||||
&& (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
|
||||
return;
|
||||
@@ -1013,7 +858,7 @@ AddMethodToCallChain(
|
||||
|
||||
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
|
||||
callPtr->chain =
|
||||
ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
|
||||
ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
|
||||
memcpy(callPtr->chain, callPtr->staticChain,
|
||||
sizeof(struct MInvoke) * callPtr->numChain);
|
||||
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
|
||||
@@ -1112,12 +957,6 @@ TclOOGetCallContext(
|
||||
* Only the bits PUBLIC_METHOD, CONSTRUCTOR,
|
||||
* PRIVATE_METHOD, DESTRUCTOR and
|
||||
* FILTER_HANDLING are useful. */
|
||||
Object *contextObj, /* Context object; when equal to oPtr, it
|
||||
* means that private methods may also be
|
||||
* added. [TIP 500] */
|
||||
Class *contextCls, /* Context class; the currently considered
|
||||
* class is equal to this, private methods may
|
||||
* also be added. [TIP 500] */
|
||||
Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
|
||||
* to be in the same object as the
|
||||
* methodNameObj. */
|
||||
@@ -1125,7 +964,7 @@ TclOOGetCallContext(
|
||||
CallContext *contextPtr;
|
||||
CallChain *callPtr;
|
||||
struct ChainBuilder cb;
|
||||
int i, count, doFilters, donePrivate = 0;
|
||||
int i, count, doFilters;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashTable doneFilters;
|
||||
|
||||
@@ -1165,7 +1004,7 @@ TclOOGetCallContext(
|
||||
* the object, and in the class).
|
||||
*/
|
||||
|
||||
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
|
||||
|
||||
if (cacheInThisObj->typePtr == &methodNameType) {
|
||||
callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
|
||||
@@ -1217,11 +1056,10 @@ TclOOGetCallContext(
|
||||
*/
|
||||
|
||||
if (flags & FORCE_UNKNOWN) {
|
||||
AddSimpleChainToCallContext(oPtr, NULL,
|
||||
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
|
||||
NULL);
|
||||
AddSimpleChainToCallContext(oPtr, NULL,
|
||||
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, 0, NULL);
|
||||
callPtr->flags |= OO_UNKNOWN_METHOD;
|
||||
callPtr->epoch = -1;
|
||||
if (callPtr->numChain == 0) {
|
||||
@@ -1250,10 +1088,10 @@ TclOOGetCallContext(
|
||||
OBJECT_MIXIN);
|
||||
}
|
||||
FOREACH(filterObj, oPtr->filters) {
|
||||
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
|
||||
filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
|
||||
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
|
||||
filterObj, &cb, &doneFilters, 0, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
|
||||
BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
|
||||
NULL);
|
||||
}
|
||||
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
|
||||
BUILDING_MIXINS);
|
||||
@@ -1268,15 +1106,9 @@ TclOOGetCallContext(
|
||||
* handle class mixins right.
|
||||
*/
|
||||
|
||||
if (oPtr == contextObj) {
|
||||
donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
|
||||
&cb, flags);
|
||||
donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
|
||||
}
|
||||
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
|
||||
methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
|
||||
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
|
||||
methodNameObj, &cb, NULL, flags, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
|
||||
flags|BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
|
||||
|
||||
/*
|
||||
* Check to see if the method has no implementation. If so, we probably
|
||||
@@ -1294,18 +1126,17 @@ TclOOGetCallContext(
|
||||
TclOODeleteChain(callPtr);
|
||||
return NULL;
|
||||
}
|
||||
AddSimpleChainToCallContext(oPtr, NULL,
|
||||
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
|
||||
NULL);
|
||||
AddSimpleChainToCallContext(oPtr, NULL,
|
||||
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, 0, NULL);
|
||||
callPtr->flags |= OO_UNKNOWN_METHOD;
|
||||
callPtr->epoch = -1;
|
||||
if (count == callPtr->numChain) {
|
||||
TclOODeleteChain(callPtr);
|
||||
return NULL;
|
||||
}
|
||||
} else if (doFilters && !donePrivate) {
|
||||
} else if (doFilters) {
|
||||
if (hPtr == NULL) {
|
||||
if (oPtr->flags & USE_CLASS_CACHE) {
|
||||
if (oPtr->selfCls->classChainCache == NULL) {
|
||||
@@ -1411,7 +1242,8 @@ TclOOGetStereotypeCallChain(
|
||||
hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
|
||||
(char *) methodNameObj);
|
||||
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
|
||||
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
const int reuseMask =
|
||||
((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
|
||||
|
||||
callPtr = Tcl_GetHashValue(hPtr);
|
||||
if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
|
||||
@@ -1455,10 +1287,9 @@ TclOOGetStereotypeCallChain(
|
||||
* Add the actual method implementations.
|
||||
*/
|
||||
|
||||
AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
|
||||
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
|
||||
flags|BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
|
||||
NULL);
|
||||
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
|
||||
|
||||
/*
|
||||
* Check to see if the method has no implementation. If so, we probably
|
||||
@@ -1467,10 +1298,10 @@ TclOOGetStereotypeCallChain(
|
||||
*/
|
||||
|
||||
if (count == callPtr->numChain) {
|
||||
AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
|
||||
&cb, NULL, 0, NULL);
|
||||
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
|
||||
NULL, BUILDING_MIXINS, NULL);
|
||||
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
|
||||
NULL, 0, NULL);
|
||||
callPtr->flags |= OO_UNKNOWN_METHOD;
|
||||
callPtr->epoch = -1;
|
||||
if (count == callPtr->numChain) {
|
||||
@@ -1550,9 +1381,9 @@ AddClassFiltersToCallContext(
|
||||
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
|
||||
&isNew);
|
||||
if (isNew) {
|
||||
AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
|
||||
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
|
||||
doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
|
||||
AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
|
||||
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
|
||||
doneFilters, clearedFlags, clsPtr);
|
||||
}
|
||||
}
|
||||
@@ -1579,22 +1410,18 @@ AddClassFiltersToCallContext(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* AddPrivatesFromClassChainToCallContext --
|
||||
* AddSimpleClassChainToCallContext --
|
||||
*
|
||||
* Helper for AddSimpleChainToCallContext that is used to find private
|
||||
* methds and add them to the call chain. Returns true when a private
|
||||
* method is found and added. [TIP 500]
|
||||
* Construct a call-chain from a class hierarchy.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
AddPrivatesFromClassChainToCallContext(
|
||||
static void
|
||||
AddSimpleClassChainToCallContext(
|
||||
Class *classPtr, /* Class to add the call chain entries for. */
|
||||
Class *const contextCls, /* Context class; the currently considered
|
||||
* class is equal to this, private methods may
|
||||
* also be added. */
|
||||
Tcl_Obj *const methodName, /* Name of method to add the call chain
|
||||
Tcl_Obj *const methodNameObj,
|
||||
/* Name of method to add the call chain
|
||||
* entries for. */
|
||||
struct ChainBuilder *const cbPtr,
|
||||
/* Where to add the call chain entries. */
|
||||
@@ -1619,86 +1446,8 @@ AddPrivatesFromClassChainToCallContext(
|
||||
|
||||
tailRecurse:
|
||||
FOREACH(superPtr, classPtr->mixins) {
|
||||
if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
|
||||
methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
|
||||
filterDecl)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (classPtr == contextCls) {
|
||||
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
|
||||
(char *) methodName);
|
||||
|
||||
if (hPtr != NULL) {
|
||||
register Method *mPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
|
||||
flags);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
switch (classPtr->superclasses.num) {
|
||||
case 1:
|
||||
classPtr = classPtr->superclasses.list[0];
|
||||
goto tailRecurse;
|
||||
default:
|
||||
FOREACH(superPtr, classPtr->superclasses) {
|
||||
if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
|
||||
methodName, cbPtr, doneFilters, flags, filterDecl)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
case 0:
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* AddSimpleClassChainToCallContext --
|
||||
*
|
||||
* Construct a call-chain from a class hierarchy.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
AddSimpleClassChainToCallContext(
|
||||
Class *classPtr, /* Class to add the call chain entries for. */
|
||||
Tcl_Obj *const methodNameObj,
|
||||
/* Name of method to add the call chain
|
||||
* entries for. */
|
||||
struct ChainBuilder *const cbPtr,
|
||||
/* Where to add the call chain entries. */
|
||||
Tcl_HashTable *const doneFilters,
|
||||
/* Where to record what call chain entries
|
||||
* have been processed. */
|
||||
int flags, /* What sort of call chain are we building. */
|
||||
Class *const filterDecl) /* The class that declared the filter. If
|
||||
* NULL, either the filter was declared by the
|
||||
* object or this isn't a filter. */
|
||||
{
|
||||
int i, privateDanger = 0;
|
||||
Class *superPtr;
|
||||
|
||||
/*
|
||||
* We hard-code the tail-recursive form. It's by far the most common case
|
||||
* *and* it is much more gentle on the stack.
|
||||
*
|
||||
* Note that mixins must be processed before the main class hierarchy.
|
||||
* [Bug 1998221]
|
||||
*/
|
||||
|
||||
tailRecurse:
|
||||
FOREACH(superPtr, classPtr->mixins) {
|
||||
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
|
||||
methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
|
||||
filterDecl);
|
||||
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
|
||||
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
|
||||
}
|
||||
|
||||
if (flags & CONSTRUCTOR) {
|
||||
@@ -1712,26 +1461,21 @@ AddSimpleClassChainToCallContext(
|
||||
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
|
||||
(char *) methodNameObj);
|
||||
|
||||
if (classPtr->flags & HAS_PRIVATE_METHODS) {
|
||||
privateDanger |= 1;
|
||||
}
|
||||
if (hPtr != NULL) {
|
||||
register Method *mPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
if (!(flags & KNOWN_STATE)) {
|
||||
if (flags & PUBLIC_METHOD) {
|
||||
if (!IS_PUBLIC(mPtr)) {
|
||||
return privateDanger;
|
||||
}
|
||||
if (!(flags & KNOWN_STATE)) {
|
||||
if (flags & PUBLIC_METHOD) {
|
||||
if (mPtr->flags & PUBLIC_METHOD) {
|
||||
flags |= DEFINITE_PUBLIC;
|
||||
} else {
|
||||
flags |= DEFINITE_PROTECTED;
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
flags |= DEFINITE_PROTECTED;
|
||||
}
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
|
||||
flags);
|
||||
}
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1741,11 +1485,11 @@ AddSimpleClassChainToCallContext(
|
||||
goto tailRecurse;
|
||||
default:
|
||||
FOREACH(superPtr, classPtr->superclasses) {
|
||||
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
|
||||
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
|
||||
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
|
||||
doneFilters, flags, filterDecl);
|
||||
}
|
||||
case 0:
|
||||
return privateDanger;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1765,7 +1509,7 @@ TclOORenderCallChain(
|
||||
Tcl_Interp *interp,
|
||||
CallChain *callPtr)
|
||||
{
|
||||
Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
|
||||
Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
|
||||
Tcl_Obj *resultObj, *descObjs[4], **objv;
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
int i;
|
||||
@@ -1774,14 +1518,12 @@ TclOORenderCallChain(
|
||||
* Allocate the literals (potentially) used in our description.
|
||||
*/
|
||||
|
||||
TclNewLiteralStringObj(filterLiteral, "filter");
|
||||
filterLiteral = Tcl_NewStringObj("filter", -1);
|
||||
Tcl_IncrRefCount(filterLiteral);
|
||||
TclNewLiteralStringObj(methodLiteral, "method");
|
||||
methodLiteral = Tcl_NewStringObj("method", -1);
|
||||
Tcl_IncrRefCount(methodLiteral);
|
||||
TclNewLiteralStringObj(objectLiteral, "object");
|
||||
objectLiteral = Tcl_NewStringObj("object", -1);
|
||||
Tcl_IncrRefCount(objectLiteral);
|
||||
TclNewLiteralStringObj(privateLiteral, "private");
|
||||
Tcl_IncrRefCount(privateLiteral);
|
||||
|
||||
/*
|
||||
* Do the actual construction of the descriptions. They consist of a list
|
||||
@@ -1799,15 +1541,16 @@ TclOORenderCallChain(
|
||||
for (i=0 ; i<callPtr->numChain ; i++) {
|
||||
struct MInvoke *miPtr = &callPtr->chain[i];
|
||||
|
||||
descObjs[0] =
|
||||
miPtr->isFilter ? filterLiteral :
|
||||
callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
|
||||
IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
|
||||
methodLiteral;
|
||||
descObjs[1] =
|
||||
callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
|
||||
callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
|
||||
miPtr->mPtr->namePtr;
|
||||
descObjs[0] = miPtr->isFilter
|
||||
? filterLiteral
|
||||
: callPtr->flags & OO_UNKNOWN_METHOD
|
||||
? fPtr->unknownMethodNameObj
|
||||
: methodLiteral;
|
||||
descObjs[1] = callPtr->flags & CONSTRUCTOR
|
||||
? fPtr->constructorName
|
||||
: callPtr->flags & DESTRUCTOR
|
||||
? fPtr->destructorName
|
||||
: miPtr->mPtr->namePtr;
|
||||
descObjs[2] = miPtr->mPtr->declaringClassPtr
|
||||
? Tcl_GetObjectName(interp,
|
||||
(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
|
||||
@@ -1825,7 +1568,6 @@ TclOORenderCallChain(
|
||||
Tcl_DecrRefCount(filterLiteral);
|
||||
Tcl_DecrRefCount(methodLiteral);
|
||||
Tcl_DecrRefCount(objectLiteral);
|
||||
Tcl_DecrRefCount(privateLiteral);
|
||||
|
||||
/*
|
||||
* Finish building the description and return it.
|
||||
|
||||
@@ -59,11 +59,11 @@ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
|
||||
/* 11 */
|
||||
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
|
||||
Tcl_Object object, Tcl_Obj *nameObj,
|
||||
int flags, const Tcl_MethodType *typePtr,
|
||||
int isPublic, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 12 */
|
||||
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
Tcl_Obj *nameObj, int flags,
|
||||
Tcl_Obj *nameObj, int isPublic,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 13 */
|
||||
@@ -116,8 +116,6 @@ TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
|
||||
/* 28 */
|
||||
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
|
||||
Tcl_Object object);
|
||||
/* 29 */
|
||||
TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
|
||||
|
||||
typedef struct {
|
||||
const struct TclOOIntStubs *tclOOIntStubs;
|
||||
@@ -138,8 +136,8 @@ typedef struct TclOOStubs {
|
||||
int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
|
||||
int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
|
||||
Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
|
||||
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
|
||||
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
|
||||
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
|
||||
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
|
||||
Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
|
||||
int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
|
||||
int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
|
||||
@@ -156,7 +154,6 @@ typedef struct TclOOStubs {
|
||||
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
|
||||
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
|
||||
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
|
||||
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
|
||||
} TclOOStubs;
|
||||
|
||||
extern const TclOOStubs *tclOOStubsPtr;
|
||||
@@ -229,8 +226,6 @@ extern const TclOOStubs *tclOOStubsPtr;
|
||||
(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
|
||||
#define Tcl_GetObjectName \
|
||||
(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
|
||||
#define Tcl_MethodIsPrivate \
|
||||
(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */
|
||||
|
||||
#endif /* defined(USE_TCLOO_STUBS) */
|
||||
|
||||
|
||||
+173
-359
@@ -16,12 +16,6 @@
|
||||
#include "tclInt.h"
|
||||
#include "tclOOInt.h"
|
||||
|
||||
/*
|
||||
* The actual value used to mark private declaration frames.
|
||||
*/
|
||||
|
||||
#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)
|
||||
|
||||
/*
|
||||
* The maximum length of fully-qualified object name to use in an errorinfo
|
||||
* message. Longer than this will be curtailed.
|
||||
@@ -37,17 +31,14 @@ struct DeclaredSlot {
|
||||
const char *name;
|
||||
const Tcl_MethodType getterType;
|
||||
const Tcl_MethodType setterType;
|
||||
const Tcl_MethodType resolverType;
|
||||
};
|
||||
|
||||
#define SLOT(name,getter,setter,resolver) \
|
||||
#define SLOT(name,getter,setter) \
|
||||
{"::oo::" name, \
|
||||
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
|
||||
getter, NULL, NULL}, \
|
||||
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
|
||||
setter, NULL, NULL}, \
|
||||
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
|
||||
resolver, NULL, NULL}}
|
||||
setter, NULL, NULL}}
|
||||
|
||||
/*
|
||||
* Forward declarations.
|
||||
@@ -112,53 +103,21 @@ static int ObjVarsGet(ClientData clientData,
|
||||
static int ObjVarsSet(ClientData clientData,
|
||||
Tcl_Interp *interp, Tcl_ObjectContext context,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
static int ResolveClass(ClientData clientData,
|
||||
Tcl_Interp *interp, Tcl_ObjectContext context,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
|
||||
/*
|
||||
* Now define the slots used in declarations.
|
||||
*/
|
||||
|
||||
static const struct DeclaredSlot slots[] = {
|
||||
SLOT("define::filter", ClassFilterGet, ClassFilterSet, NULL),
|
||||
SLOT("define::mixin", ClassMixinGet, ClassMixinSet, ResolveClass),
|
||||
SLOT("define::superclass", ClassSuperGet, ClassSuperSet, ResolveClass),
|
||||
SLOT("define::variable", ClassVarsGet, ClassVarsSet, NULL),
|
||||
SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet, NULL),
|
||||
SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet, ResolveClass),
|
||||
SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet, NULL),
|
||||
{NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
|
||||
SLOT("define::filter", ClassFilterGet, ClassFilterSet),
|
||||
SLOT("define::mixin", ClassMixinGet, ClassMixinSet),
|
||||
SLOT("define::superclass", ClassSuperGet, ClassSuperSet),
|
||||
SLOT("define::variable", ClassVarsGet, ClassVarsSet),
|
||||
SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet),
|
||||
SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet),
|
||||
SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet),
|
||||
{NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
|
||||
};
|
||||
|
||||
/*
|
||||
* How to build the in-namespace name of a private variable. This is a pattern
|
||||
* used with Tcl_ObjPrintf().
|
||||
*/
|
||||
|
||||
#define PRIVATE_VARIABLE_PATTERN "%d : %s"
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* IsPrivateDefine --
|
||||
*
|
||||
* Extracts whether the current context is handling private definitions.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
IsPrivateDefine(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (!iPtr->varFramePtr) {
|
||||
return 0;
|
||||
}
|
||||
return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -457,123 +416,6 @@ TclOOClassSetMixins(
|
||||
BumpGlobalEpoch(interp, classPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* InstallStandardVariableMapping, InstallPrivateVariableMapping --
|
||||
*
|
||||
* Helpers for installing standard and private variable maps.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
static inline void
|
||||
InstallStandardVariableMapping(
|
||||
VariableNameList *vnlPtr,
|
||||
int varc,
|
||||
Tcl_Obj *const *varv)
|
||||
{
|
||||
Tcl_Obj *variableObj;
|
||||
int i, n, created;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH(variableObj, *vnlPtr) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(vnlPtr->list);
|
||||
} else if (i) {
|
||||
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
vnlPtr->num = 0;
|
||||
if (varc > 0) {
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
vnlPtr->list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
vnlPtr->num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
if (n != varc) {
|
||||
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
|
||||
}
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
}
|
||||
|
||||
static inline void
|
||||
InstallPrivateVariableMapping(
|
||||
PrivateVariableList *pvlPtr,
|
||||
int varc,
|
||||
Tcl_Obj *const *varv,
|
||||
int creationEpoch)
|
||||
{
|
||||
PrivateVariableMapping *privatePtr;
|
||||
int i, n, created;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH_STRUCT(privatePtr, *pvlPtr) {
|
||||
Tcl_DecrRefCount(privatePtr->variableObj);
|
||||
Tcl_DecrRefCount(privatePtr->fullNameObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(pvlPtr->list);
|
||||
} else if (i) {
|
||||
pvlPtr->list = ckrealloc(pvlPtr->list,
|
||||
sizeof(PrivateVariableMapping) * varc);
|
||||
} else {
|
||||
pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
|
||||
}
|
||||
}
|
||||
|
||||
pvlPtr->num = 0;
|
||||
if (varc > 0) {
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
privatePtr = &(pvlPtr->list[n++]);
|
||||
privatePtr->variableObj = varv[i];
|
||||
privatePtr->fullNameObj = Tcl_ObjPrintf(
|
||||
PRIVATE_VARIABLE_PATTERN,
|
||||
creationEpoch, Tcl_GetString(varv[i]));
|
||||
Tcl_IncrRefCount(privatePtr->fullNameObj);
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
pvlPtr->num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
if (n != varc) {
|
||||
pvlPtr->list = ckrealloc(pvlPtr->list,
|
||||
sizeof(PrivateVariableMapping) * n);
|
||||
}
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -866,8 +708,7 @@ TclOOGetDefineCmdContext(
|
||||
Tcl_Object object;
|
||||
|
||||
if ((iPtr->varFramePtr == NULL)
|
||||
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
|
||||
&& iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
|
||||
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"this command may only be called from within the context of"
|
||||
" an ::oo::define or ::oo::objdefine command", -1));
|
||||
@@ -908,8 +749,7 @@ GetClassInOuterContext(
|
||||
Object *oPtr;
|
||||
CallFrame *savedFramePtr = iPtr->varFramePtr;
|
||||
|
||||
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
|
||||
|| iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
|
||||
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
|
||||
if (iPtr->varFramePtr->callerVarPtr == NULL) {
|
||||
Tcl_Panic("getting outer context when already in global context");
|
||||
}
|
||||
@@ -1198,7 +1038,7 @@ TclOODefineSelfObjCmd(
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
Object *oPtr;
|
||||
int result, private;
|
||||
int result;
|
||||
|
||||
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
if (oPtr == NULL) {
|
||||
@@ -1210,8 +1050,6 @@ TclOODefineSelfObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
private = IsPrivateDefine(interp);
|
||||
|
||||
/*
|
||||
* Make the oo::objdefine namespace the current namespace and evaluate the
|
||||
* command(s).
|
||||
@@ -1220,9 +1058,6 @@ TclOODefineSelfObjCmd(
|
||||
if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (private) {
|
||||
((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
|
||||
}
|
||||
|
||||
AddRef(oPtr);
|
||||
if (objc == 2) {
|
||||
@@ -1230,7 +1065,7 @@ TclOODefineSelfObjCmd(
|
||||
|
||||
Tcl_IncrRefCount(objNameObj);
|
||||
result = TclEvalObjEx(interp, objv[1], 0,
|
||||
((Interp *)interp)->cmdFramePtr, 1);
|
||||
((Interp *)interp)->cmdFramePtr, 2);
|
||||
if (result == TCL_ERROR) {
|
||||
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
|
||||
}
|
||||
@@ -1282,79 +1117,6 @@ TclOODefineObjSelfObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefinePrivateObjCmd --
|
||||
*
|
||||
* Implementation of the "private" subcommand of the "oo::define"
|
||||
* and "oo::objdefine" commands.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOODefinePrivateObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
int isInstancePrivate = (clientData != NULL);
|
||||
/* Just so that we can generate the correct
|
||||
* error message depending on the context of
|
||||
* usage of this function. */
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int saved; /* The saved flag. We restore it on exit so
|
||||
* that [private private ...] doesn't make
|
||||
* things go weird. */
|
||||
int result;
|
||||
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Change the frame type flag while evaluating the body.
|
||||
*/
|
||||
|
||||
saved = iPtr->varFramePtr->isProcCallFrame;
|
||||
iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
|
||||
|
||||
/*
|
||||
* Evaluate the body; standard pattern.
|
||||
*/
|
||||
|
||||
AddRef(oPtr);
|
||||
if (objc == 2) {
|
||||
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
|
||||
|
||||
Tcl_IncrRefCount(objNameObj);
|
||||
result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
|
||||
if (result == TCL_ERROR) {
|
||||
GenerateErrorInfo(interp, oPtr, objNameObj,
|
||||
isInstancePrivate ? "object" : "class");
|
||||
}
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
|
||||
1, objc, objv);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the frame type flag to what it was previously.
|
||||
*/
|
||||
|
||||
iPtr->varFramePtr->isProcCallFrame = saved;
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1698,9 +1460,8 @@ TclOODefineExportObjCmd(
|
||||
} else {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
|
||||
if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
|
||||
mPtr->flags |= PUBLIC_METHOD;
|
||||
mPtr->flags &= ~TRUE_PRIVATE_METHOD;
|
||||
changed = 1;
|
||||
}
|
||||
}
|
||||
@@ -1760,9 +1521,6 @@ TclOODefineForwardObjCmd(
|
||||
}
|
||||
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
|
||||
? PUBLIC_METHOD : 0;
|
||||
if (IsPrivateDefine(interp)) {
|
||||
isPublic = TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the method structure.
|
||||
@@ -1822,9 +1580,6 @@ TclOODefineMethodObjCmd(
|
||||
}
|
||||
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
|
||||
? PUBLIC_METHOD : 0;
|
||||
if (IsPrivateDefine(interp)) {
|
||||
isPublic = TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the method by using the right back-end API.
|
||||
@@ -1844,6 +1599,70 @@ TclOODefineMethodObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineMixinObjCmd --
|
||||
*
|
||||
* Implementation of the "mixin" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOODefineMixinObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
const int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
int isInstanceMixin = (clientData != NULL);
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Class **mixins;
|
||||
int i;
|
||||
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (!isInstanceMixin && !oPtr->classPtr) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"attempt to misuse API", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
|
||||
|
||||
for (i=1 ; i<objc ; i++) {
|
||||
Class *clsPtr = GetClassInOuterContext(interp, objv[i],
|
||||
"may only mix in classes");
|
||||
|
||||
if (clsPtr == NULL) {
|
||||
goto freeAndError;
|
||||
}
|
||||
if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"may not mix a class into itself", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
|
||||
goto freeAndError;
|
||||
}
|
||||
mixins[i-1] = clsPtr;
|
||||
}
|
||||
|
||||
if (isInstanceMixin) {
|
||||
TclOOObjectSetMixins(oPtr, objc-1, mixins);
|
||||
} else {
|
||||
TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
|
||||
}
|
||||
|
||||
TclStackFree(interp, mixins);
|
||||
return TCL_OK;
|
||||
|
||||
freeAndError:
|
||||
TclStackFree(interp, mixins);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1976,8 +1795,8 @@ TclOODefineUnexportObjCmd(
|
||||
} else {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
|
||||
mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
|
||||
if (isNew || mPtr->flags & PUBLIC_METHOD) {
|
||||
mPtr->flags &= ~PUBLIC_METHOD;
|
||||
changed = 1;
|
||||
}
|
||||
}
|
||||
@@ -2069,7 +1888,6 @@ TclOODefineSlots(
|
||||
const struct DeclaredSlot *slotInfoPtr;
|
||||
Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
|
||||
Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
|
||||
Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
|
||||
Class *slotCls;
|
||||
|
||||
slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
|
||||
@@ -2079,10 +1897,9 @@ TclOODefineSlots(
|
||||
}
|
||||
Tcl_IncrRefCount(getName);
|
||||
Tcl_IncrRefCount(setName);
|
||||
Tcl_IncrRefCount(resolveName);
|
||||
for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
|
||||
Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
|
||||
(Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);
|
||||
(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
|
||||
|
||||
if (slotObject == NULL) {
|
||||
continue;
|
||||
@@ -2091,14 +1908,9 @@ TclOODefineSlots(
|
||||
&slotInfoPtr->getterType, NULL);
|
||||
Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
|
||||
&slotInfoPtr->setterType, NULL);
|
||||
if (slotInfoPtr->resolverType.callProc) {
|
||||
Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
|
||||
&slotInfoPtr->resolverType, NULL);
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(getName);
|
||||
Tcl_DecrRefCount(setName);
|
||||
Tcl_DecrRefCount(resolveName);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2476,7 +2288,7 @@ ClassVarsGet(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Tcl_Obj *resultObj;
|
||||
Tcl_Obj *resultObj, *variableObj;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
||||
@@ -2494,18 +2306,8 @@ ClassVarsGet(
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (IsPrivateDefine(interp)) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -2521,7 +2323,7 @@ ClassVarsSet(
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int varc;
|
||||
Tcl_Obj **varv;
|
||||
Tcl_Obj **varv, *variableObj;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
@@ -2562,11 +2364,49 @@ ClassVarsSet(
|
||||
}
|
||||
}
|
||||
|
||||
if (IsPrivateDefine(interp)) {
|
||||
InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
|
||||
varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
|
||||
} else {
|
||||
InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(oPtr->classPtr->variables.list);
|
||||
} else if (i) {
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->classPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
|
||||
oPtr->classPtr->variables.num = 0;
|
||||
if (varc > 0) {
|
||||
int created, n;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
oPtr->classPtr->variables.list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
oPtr->classPtr->variables.num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->classPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * n);
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2745,7 +2585,7 @@ ObjVarsGet(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Tcl_Obj *resultObj;
|
||||
Tcl_Obj *resultObj, *variableObj;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
||||
@@ -2757,18 +2597,8 @@ ObjVarsGet(
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (IsPrivateDefine(interp)) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -2784,7 +2614,7 @@ ObjVarsSet(
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int varc, i;
|
||||
Tcl_Obj **varv;
|
||||
Tcl_Obj **varv, *variableObj;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
||||
@@ -2817,66 +2647,50 @@ ObjVarsSet(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
if (IsPrivateDefine(interp)) {
|
||||
InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
|
||||
oPtr->creationEpoch);
|
||||
} else {
|
||||
InstallStandardVariableMapping(&oPtr->variables, varc, varv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ResolveClass --
|
||||
*
|
||||
* Implementation of the "Resolve" support method for some slots (those
|
||||
* that are slots around a list of classes). This resolves possible class
|
||||
* names to their fully-qualified names if possible.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
ResolveClass(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
Tcl_ObjectContext context,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
int idx = Tcl_ObjectContextSkippedArgs(context);
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Class *clsPtr;
|
||||
|
||||
/*
|
||||
* Check if were called wrongly. The definition context isn't used...
|
||||
* except that GetClassInOuterContext() assumes that it is there.
|
||||
*/
|
||||
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
} else if (objc != idx + 1) {
|
||||
Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
|
||||
return TCL_ERROR;
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
|
||||
/*
|
||||
* Resolve the class if possible. If not, remove any resolution error and
|
||||
* return what we've got anyway as the failure might not be fatal overall.
|
||||
*/
|
||||
|
||||
clsPtr = GetClassInOuterContext(interp, objv[idx],
|
||||
"USER SHOULD NOT SEE THIS MESSAGE");
|
||||
if (clsPtr == NULL) {
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_SetObjResult(interp, objv[idx]);
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(oPtr->variables.list);
|
||||
} else if (i) {
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
oPtr->variables.num = 0;
|
||||
if (varc > 0) {
|
||||
int created, n;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
oPtr->variables.list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
oPtr->variables.num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * n);
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
+27
-165
@@ -22,7 +22,6 @@ static Tcl_ObjCmdProc InfoObjectClassCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectDefnCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectForwardCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectIdCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectIsACmd;
|
||||
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
|
||||
@@ -51,7 +50,6 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd;
|
||||
static const EnsembleImplMap infoObjectCmds[] = {
|
||||
{"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
|
||||
{"creationid", InfoObjectIdCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
@@ -60,7 +58,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
|
||||
{"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
|
||||
{"variables", InfoObjectVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
@@ -82,7 +80,7 @@ static const EnsembleImplMap infoClassCmds[] = {
|
||||
{"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoClassVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
|
||||
@@ -519,22 +517,15 @@ InfoObjectMethodsCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
|
||||
int flag = PUBLIC_METHOD, recurse = 0;
|
||||
FOREACH_HASH_DECLS;
|
||||
Tcl_Obj *namePtr, *resultObj;
|
||||
Method *mPtr;
|
||||
static const char *const options[] = {
|
||||
"-all", "-localprivate", "-private", "-scope", NULL
|
||||
"-all", "-localprivate", "-private", NULL
|
||||
};
|
||||
enum Options {
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
||||
};
|
||||
static const char *const scopes[] = {
|
||||
"private", "public", "unexported"
|
||||
};
|
||||
enum Scopes {
|
||||
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
|
||||
SCOPE_LOCALPRIVATE
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -563,45 +554,14 @@ InfoObjectMethodsCmd(
|
||||
case OPT_PRIVATE:
|
||||
flag = 0;
|
||||
break;
|
||||
case OPT_SCOPE:
|
||||
if (++i >= objc) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"missing option for -scope"));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
|
||||
&scope) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (scope != -1) {
|
||||
recurse = 0;
|
||||
switch (scope) {
|
||||
case SCOPE_PRIVATE:
|
||||
flag = TRUE_PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_PUBLIC:
|
||||
flag = PUBLIC_METHOD;
|
||||
break;
|
||||
case SCOPE_LOCALPRIVATE:
|
||||
flag = PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_UNEXPORTED:
|
||||
flag = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (recurse) {
|
||||
const char **names;
|
||||
int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
|
||||
&names);
|
||||
int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
|
||||
|
||||
for (i=0 ; i<numNames ; i++) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj,
|
||||
@@ -612,7 +572,7 @@ InfoObjectMethodsCmd(
|
||||
}
|
||||
} else if (oPtr->methodsPtr) {
|
||||
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
|
||||
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
|
||||
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
|
||||
}
|
||||
}
|
||||
@@ -721,38 +681,6 @@ InfoObjectMixinsCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* InfoObjectIdCmd --
|
||||
*
|
||||
* Implements [info object creationid $objName]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
InfoObjectIdCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -791,7 +719,7 @@ InfoObjectNsCmd(
|
||||
*
|
||||
* InfoObjectVariablesCmd --
|
||||
*
|
||||
* Implements [info object variables $objName ?-private?]
|
||||
* Implements [info object variables $objName]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -804,37 +732,21 @@ InfoObjectVariablesCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
Tcl_Obj *resultObj;
|
||||
int i, private = 0;
|
||||
Tcl_Obj *variableObj, *resultObj;
|
||||
int i;
|
||||
|
||||
if (objc != 2 && objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 3) {
|
||||
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
private = 1;
|
||||
}
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (private) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -1216,7 +1128,7 @@ InfoClassInstancesCmd(
|
||||
*
|
||||
* InfoClassMethodsCmd --
|
||||
*
|
||||
* Implements [info class methods $clsName ?options...?]
|
||||
* Implements [info class methods $clsName ?-private?]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1228,21 +1140,15 @@ InfoClassMethodsCmd(
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
|
||||
int flag = PUBLIC_METHOD, recurse = 0;
|
||||
Tcl_Obj *namePtr, *resultObj;
|
||||
Method *mPtr;
|
||||
Class *clsPtr;
|
||||
static const char *const options[] = {
|
||||
"-all", "-localprivate", "-private", "-scope", NULL
|
||||
"-all", "-localprivate", "-private", NULL
|
||||
};
|
||||
enum Options {
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
||||
};
|
||||
static const char *const scopes[] = {
|
||||
"private", "public", "unexported"
|
||||
};
|
||||
enum Scopes {
|
||||
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -1271,36 +1177,9 @@ InfoClassMethodsCmd(
|
||||
case OPT_PRIVATE:
|
||||
flag = 0;
|
||||
break;
|
||||
case OPT_SCOPE:
|
||||
if (++i >= objc) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"missing option for -scope"));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
|
||||
&scope) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (scope != -1) {
|
||||
recurse = 0;
|
||||
switch (scope) {
|
||||
case SCOPE_PRIVATE:
|
||||
flag = TRUE_PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_PUBLIC:
|
||||
flag = PUBLIC_METHOD;
|
||||
break;
|
||||
case SCOPE_UNEXPORTED:
|
||||
flag = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (recurse) {
|
||||
@@ -1318,7 +1197,7 @@ InfoClassMethodsCmd(
|
||||
FOREACH_HASH_DECLS;
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
|
||||
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
|
||||
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
|
||||
}
|
||||
}
|
||||
@@ -1520,7 +1399,7 @@ InfoClassSupersCmd(
|
||||
*
|
||||
* InfoClassVariablesCmd --
|
||||
*
|
||||
* Implements [info class variables $clsName ?-private?]
|
||||
* Implements [info class variables $clsName]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1533,37 +1412,21 @@ InfoClassVariablesCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Class *clsPtr;
|
||||
Tcl_Obj *resultObj;
|
||||
int i, private = 0;
|
||||
Tcl_Obj *variableObj, *resultObj;
|
||||
int i;
|
||||
|
||||
if (objc != 2 && objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "className");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 3) {
|
||||
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
private = 1;
|
||||
}
|
||||
clsPtr = GetClassFromObj(interp, objv[1]);
|
||||
if (clsPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (private) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, clsPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
FOREACH(variableObj, clsPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -1602,8 +1465,7 @@ InfoObjectCallCmd(
|
||||
* Get the call context and render its call chain.
|
||||
*/
|
||||
|
||||
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
|
||||
NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"cannot construct any call chain", -1));
|
||||
|
||||
+5
-57
@@ -124,18 +124,6 @@ typedef struct ForwardMethod {
|
||||
* non-empty list. */
|
||||
} ForwardMethod;
|
||||
|
||||
/*
|
||||
* Structure used in private variable mappings. Describes the mapping of a
|
||||
* single variable from the user's local name to the system's storage name.
|
||||
* [TIP #500]
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
Tcl_Obj *variableObj; /* Name used within methods. This is the part
|
||||
* that is properly under user control. */
|
||||
Tcl_Obj *fullNameObj; /* Name used at the instance namespace level. */
|
||||
} PrivateVariableMapping;
|
||||
|
||||
/*
|
||||
* Helper definitions that declare a "list" array. The two varieties are
|
||||
* either optimized for simplicity (in the case that the whole array is
|
||||
@@ -153,13 +141,6 @@ typedef struct {
|
||||
#define LIST_DYNAMIC(listType_t) \
|
||||
struct { int num, size; listType_t *list; }
|
||||
|
||||
/*
|
||||
* These types are needed in function arguments.
|
||||
*/
|
||||
|
||||
typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
|
||||
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
|
||||
|
||||
/*
|
||||
* Now, the definition of what an object actually is.
|
||||
*/
|
||||
@@ -205,12 +186,7 @@ typedef struct Object {
|
||||
Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
|
||||
/* Function to allow remapping of method
|
||||
* names. For itcl-ng. */
|
||||
VariableNameList variables;
|
||||
PrivateVariableList privateVariables;
|
||||
/* Configurations for the variable resolver
|
||||
* used inside methods. */
|
||||
Tcl_Command myclassCommand; /* Reference to this object's class dispatcher
|
||||
* command. */
|
||||
LIST_STATIC(Tcl_Obj *) variables;
|
||||
} Object;
|
||||
|
||||
#define OBJECT_DELETED 1 /* Flag to say that an object has been
|
||||
@@ -238,10 +214,6 @@ typedef struct Object {
|
||||
* other spots). */
|
||||
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
|
||||
* unknown method handler at that point. */
|
||||
#define HAS_PRIVATE_METHODS 0x20000
|
||||
/* Object/class has (or had) private methods,
|
||||
* and so shouldn't be cached so
|
||||
* aggressively. */
|
||||
|
||||
/*
|
||||
* And the definition of a class. Note that every class also has an associated
|
||||
@@ -296,10 +268,7 @@ typedef struct Class {
|
||||
* object doesn't override with its own mixins
|
||||
* (and filters and method implementations for
|
||||
* when getting method chains). */
|
||||
VariableNameList variables;
|
||||
PrivateVariableList privateVariables;
|
||||
/* Configurations for the variable resolver
|
||||
* used inside methods. */
|
||||
LIST_STATIC(Tcl_Obj *) variables;
|
||||
} Class;
|
||||
|
||||
/*
|
||||
@@ -401,15 +370,10 @@ typedef struct CallContext {
|
||||
|
||||
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
|
||||
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
|
||||
* only) method. Supports itcl. */
|
||||
* only) method. */
|
||||
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
|
||||
#define CONSTRUCTOR 0x08 /* This is a constructor. */
|
||||
#define DESTRUCTOR 0x10 /* This is a destructor. */
|
||||
#define TRUE_PRIVATE_METHOD 0x20
|
||||
/* This is a private method only accessible
|
||||
* from other methods defined on this class
|
||||
* or instance. [TIP #500] */
|
||||
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
|
||||
|
||||
/*
|
||||
* Structure containing definition information about basic class methods.
|
||||
@@ -467,9 +431,6 @@ MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
|
||||
MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
@@ -543,7 +504,6 @@ MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
|
||||
MODULE_SCOPE void TclOODelMethodRef(Method *method);
|
||||
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
|
||||
Tcl_Obj *methodNameObj, int flags,
|
||||
Object *contextObjPtr, Class *contextClsPtr,
|
||||
Tcl_Obj *cacheInThisObj);
|
||||
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
|
||||
Tcl_Obj *methodNameObj, int flags);
|
||||
@@ -553,8 +513,7 @@ MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
|
||||
MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
|
||||
int flags, const char ***stringsPtr);
|
||||
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr,
|
||||
Object *contextObj, Class *contextCls, int flags,
|
||||
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
|
||||
const char ***stringsPtr);
|
||||
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
|
||||
@@ -599,24 +558,13 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
|
||||
#define FOREACH(var,ary) \
|
||||
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
|
||||
continue; \
|
||||
} else if (var = (ary).list[i], 1)
|
||||
|
||||
/*
|
||||
* A variation where the array is an array of structs. There's no issue with
|
||||
* possible NULLs; every element of the array will be iterated over and the
|
||||
* varable set to a pointer to each of those elements in turn.
|
||||
* REQUIRES DECLARATION: int i;
|
||||
*/
|
||||
|
||||
#define FOREACH_STRUCT(var,ary) \
|
||||
for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)
|
||||
} else if (var = (ary).list[i], 1)
|
||||
|
||||
/*
|
||||
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
|
||||
* sets up the declarations needed for the main macro, FOREACH_HASH, which
|
||||
* does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
|
||||
* only iterates over values.
|
||||
* REQUIRES DECLARATION: FOREACH_HASH_DECLS;
|
||||
*/
|
||||
|
||||
#define FOREACH_HASH_DECLS \
|
||||
|
||||
+3
-36
@@ -186,11 +186,7 @@ Tcl_NewInstanceMethod(
|
||||
mPtr->declaringObjectPtr = oPtr;
|
||||
mPtr->declaringClassPtr = NULL;
|
||||
if (flags) {
|
||||
mPtr->flags |= flags &
|
||||
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
|
||||
if (flags & TRUE_PRIVATE_METHOD) {
|
||||
oPtr->flags |= HAS_PRIVATE_METHODS;
|
||||
}
|
||||
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
|
||||
}
|
||||
oPtr->epoch++;
|
||||
return (Tcl_Method) mPtr;
|
||||
@@ -254,11 +250,7 @@ Tcl_NewMethod(
|
||||
mPtr->declaringObjectPtr = NULL;
|
||||
mPtr->declaringClassPtr = clsPtr;
|
||||
if (flags) {
|
||||
mPtr->flags |= flags &
|
||||
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
|
||||
if (flags & TRUE_PRIVATE_METHOD) {
|
||||
clsPtr->flags |= HAS_PRIVATE_METHODS;
|
||||
}
|
||||
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
|
||||
}
|
||||
|
||||
return (Tcl_Method) mPtr;
|
||||
@@ -936,7 +928,7 @@ PushMethodCallFrame(
|
||||
* variables used in methods. The compiled variable resolver is more
|
||||
* important, but both are needed as it is possible to have a variable
|
||||
* that is only referred to in ways that aren't compilable and we can't
|
||||
* force LVT presence. [TIP #320, #500]
|
||||
* force LVT presence. [TIP #320]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -994,7 +986,6 @@ ProcedureMethodCompiledVarConnect(
|
||||
CallFrame *framePtr = iPtr->varFramePtr;
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *variableObj;
|
||||
PrivateVariableMapping *privateVar;
|
||||
Tcl_HashEntry *hPtr;
|
||||
int i, isNew, cacheIt, varLen, len;
|
||||
const char *match, *varName;
|
||||
@@ -1028,15 +1019,6 @@ ProcedureMethodCompiledVarConnect(
|
||||
varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
|
||||
if (contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr != NULL) {
|
||||
FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr->privateVariables) {
|
||||
match = TclGetStringFromObj(privateVar->variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
variableObj = privateVar->fullNameObj;
|
||||
cacheIt = 0;
|
||||
goto gotMatch;
|
||||
}
|
||||
}
|
||||
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr->variables) {
|
||||
match = TclGetStringFromObj(variableObj, &len);
|
||||
@@ -1046,14 +1028,6 @@ ProcedureMethodCompiledVarConnect(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
|
||||
match = TclGetStringFromObj(privateVar->variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
variableObj = privateVar->fullNameObj;
|
||||
cacheIt = 1;
|
||||
goto gotMatch;
|
||||
}
|
||||
}
|
||||
FOREACH(variableObj, contextPtr->oPtr->variables) {
|
||||
match = TclGetStringFromObj(variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
@@ -1699,13 +1673,6 @@ Tcl_MethodIsPublic(
|
||||
{
|
||||
return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
|
||||
}
|
||||
|
||||
int
|
||||
Tcl_MethodIsPrivate(
|
||||
Tcl_Method method)
|
||||
{
|
||||
return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Extended method construction for itcl-ng.
|
||||
|
||||
@@ -1,263 +0,0 @@
|
||||
/*
|
||||
* tclOOScript.h --
|
||||
*
|
||||
* This file contains support scripts for TclOO. They are defined here so
|
||||
* that the code can be definitely run even in safe interpreters; TclOO's
|
||||
* core setup is safe.
|
||||
*
|
||||
* Copyright (c) 2012-2018 Donal K. Fellows
|
||||
* Copyright (c) 2013 Andreas Kupries
|
||||
* Copyright (c) 2017 Gerald Lester
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#ifndef TCL_OO_SCRIPT_H
|
||||
#define TCL_OO_SCRIPT_H
|
||||
|
||||
/*
|
||||
* The scripted part of the definitions of TclOO.
|
||||
*
|
||||
* Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
|
||||
* contains the commented version of everything; *this* file is automatically
|
||||
* generated.
|
||||
*/
|
||||
|
||||
static const char *tclOOSetupScript =
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
"::namespace eval ::oo {\n"
|
||||
"\t::namespace path {}\n"
|
||||
"\tnamespace eval Helpers {\n"
|
||||
"\t\t::namespace path {}\n"
|
||||
"\t\tproc callback {method args} {\n"
|
||||
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
|
||||
"\t\t}\n"
|
||||
"\t\tnamespace export callback\n"
|
||||
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
|
||||
"\t\tnamespace export -clear\n"
|
||||
"\t\trename tmp::callback mymethod\n"
|
||||
"\t\tnamespace delete tmp\n"
|
||||
"\t\tproc classvariable {name args} {\n"
|
||||
"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
|
||||
"\t\t\tforeach v [list $name {*}$args] {\n"
|
||||
"\t\t\t\tif {[string match *(*) $v]} {\n"
|
||||
"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
|
||||
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
|
||||
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t\tif {[string match *::* $v]} {\n"
|
||||
"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
|
||||
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
|
||||
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t\tlappend vs $v $v\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
|
||||
"\t\t}\n"
|
||||
"\t\tproc link {args} {\n"
|
||||
"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
|
||||
"\t\t\tforeach link $args {\n"
|
||||
"\t\t\t\tif {[llength $link] == 2} {\n"
|
||||
"\t\t\t\t\tlassign $link src dst\n"
|
||||
"\t\t\t\t} elseif {[llength $link] == 1} {\n"
|
||||
"\t\t\t\t\tlassign $link src\n"
|
||||
"\t\t\t\t\tset dst $src\n"
|
||||
"\t\t\t\t} else {\n"
|
||||
"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
|
||||
"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t\tif {![string match ::* $src]} {\n"
|
||||
"\t\t\t\t\tset src [string cat $ns :: $src]\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
|
||||
"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
|
||||
"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\treturn\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tproc UnlinkLinkedCommand {cmd args} {\n"
|
||||
"\t\tif {[namespace which $cmd] ne {}} {\n"
|
||||
"\t\t\trename $cmd {}\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tproc DelegateName {class} {\n"
|
||||
"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
|
||||
"\t}\n"
|
||||
"\tproc MixinClassDelegates {class} {\n"
|
||||
"\t\tif {![info object isa class $class]} {\n"
|
||||
"\t\t\treturn\n"
|
||||
"\t\t}\n"
|
||||
"\t\tset delegate [DelegateName $class]\n"
|
||||
"\t\tif {![info object isa class $delegate]} {\n"
|
||||
"\t\t\treturn\n"
|
||||
"\t\t}\n"
|
||||
"\t\tforeach c [info class superclass $class] {\n"
|
||||
"\t\t\tset d [DelegateName $c]\n"
|
||||
"\t\t\tif {![info object isa class $d]} {\n"
|
||||
"\t\t\t\tcontinue\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\tdefine $delegate superclass -append $d\n"
|
||||
"\t\t}\n"
|
||||
"\t\tobjdefine $class mixin -append $delegate\n"
|
||||
"\t}\n"
|
||||
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
|
||||
"\t\tset originDelegate [DelegateName $originObject]\n"
|
||||
"\t\tset targetDelegate [DelegateName $targetObject]\n"
|
||||
"\t\tif {\n"
|
||||
"\t\t\t[info object isa class $originDelegate]\n"
|
||||
"\t\t\t&& ![info object isa class $targetDelegate]\n"
|
||||
"\t\t} then {\n"
|
||||
"\t\t\tcopy $originDelegate $targetDelegate\n"
|
||||
"\t\t\tobjdefine $targetObject mixin -set \\\n"
|
||||
"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
|
||||
"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
|
||||
"\t\t\t\t}]\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tproc define::classmethod {name {args {}} {body {}}} {\n"
|
||||
"\t\t::set argc [::llength [::info level 0]]\n"
|
||||
"\t\t::if {$argc == 3} {\n"
|
||||
"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
|
||||
"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
|
||||
"\t\t\t\t[::lindex [::info level 0] 0]]\n"
|
||||
"\t\t}\n"
|
||||
"\t\t::set cls [::uplevel 1 self]\n"
|
||||
"\t\t::if {$argc == 4} {\n"
|
||||
"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
|
||||
"\t\t}\n"
|
||||
"\t\t::tailcall forward $name myclass $name\n"
|
||||
"\t}\n"
|
||||
"\tproc define::initialise {body} {\n"
|
||||
"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
|
||||
"\t\t::tailcall apply [::list {} $body $clsns]\n"
|
||||
"\t}\n"
|
||||
"\tnamespace eval define {\n"
|
||||
"\t\t::namespace export initialise\n"
|
||||
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
|
||||
"\t\t::namespace export -clear\n"
|
||||
"\t\t::rename tmp::initialise initialize\n"
|
||||
"\t\t::namespace delete tmp\n"
|
||||
"\t}\n"
|
||||
"\tdefine Slot {\n"
|
||||
"\t\tmethod Get {} {\n"
|
||||
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod Set list {\n"
|
||||
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod Resolve list {\n"
|
||||
"\t\t\treturn $list\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -set args {\n"
|
||||
"\t\t\tset my [namespace which my]\n"
|
||||
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
|
||||
"\t\t\ttailcall my Set $args\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -append args {\n"
|
||||
"\t\t\tset my [namespace which my]\n"
|
||||
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
|
||||
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
|
||||
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -clear {} {tailcall my Set {}}\n"
|
||||
"\t\tmethod -prepend args {\n"
|
||||
"\t\t\tset my [namespace which my]\n"
|
||||
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
|
||||
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
|
||||
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -remove args {\n"
|
||||
"\t\t\tset my [namespace which my]\n"
|
||||
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
|
||||
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
|
||||
"\t\t\ttailcall my Set [lmap val $current {\n"
|
||||
"\t\t\t\tif {$val in $args} continue else {set val}\n"
|
||||
"\t\t\t}]\n"
|
||||
"\t\t}\n"
|
||||
"\t\tforward --default-operation my -append\n"
|
||||
"\t\tmethod unknown {args} {\n"
|
||||
"\t\t\tset def --default-operation\n"
|
||||
"\t\t\tif {[llength $args] == 0} {\n"
|
||||
"\t\t\t\ttailcall my $def\n"
|
||||
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
|
||||
"\t\t\t\ttailcall my $def {*}$args\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\tnext {*}$args\n"
|
||||
"\t\t}\n"
|
||||
"\t\texport -set -append -clear -prepend -remove\n"
|
||||
"\t\tunexport unknown destroy\n"
|
||||
"\t}\n"
|
||||
"\tobjdefine define::superclass forward --default-operation my -set\n"
|
||||
"\tobjdefine define::mixin forward --default-operation my -set\n"
|
||||
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
|
||||
"\tdefine object method <cloned> {originObject} {\n"
|
||||
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
|
||||
"\t\t\tset args [info args $p]\n"
|
||||
"\t\t\tset idx -1\n"
|
||||
"\t\t\tforeach a $args {\n"
|
||||
"\t\t\t\tif {[info default $p $a d]} {\n"
|
||||
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
|
||||
"\t\t\t\t} else {\n"
|
||||
"\t\t\t\t\tlset args [incr idx] [list $a]\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\tset b [info body $p]\n"
|
||||
"\t\t\tset p [namespace tail $p]\n"
|
||||
"\t\t\tproc $p $args $b\n"
|
||||
"\t\t}\n"
|
||||
"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
|
||||
"\t\t\tupvar 0 $v vOrigin\n"
|
||||
"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
|
||||
"\t\t\tif {[info exists vOrigin]} {\n"
|
||||
"\t\t\t\tif {[array exists vOrigin]} {\n"
|
||||
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
|
||||
"\t\t\t\t} else {\n"
|
||||
"\t\t\t\t\tset vNew $vOrigin\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tdefine class method <cloned> {originObject} {\n"
|
||||
"\t\tnext $originObject\n"
|
||||
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
|
||||
"\t}\n"
|
||||
"\tclass create singleton {\n"
|
||||
"\t\tsuperclass class\n"
|
||||
"\t\tvariable object\n"
|
||||
"\t\tunexport create createWithNamespace\n"
|
||||
"\t\tmethod new args {\n"
|
||||
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
|
||||
"\t\t\t\tset object [next {*}$args]\n"
|
||||
"\t\t\t\t::oo::objdefine $object {\n"
|
||||
"\t\t\t\t\tmethod destroy {} {\n"
|
||||
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
|
||||
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
|
||||
"\t\t\t\t\t}\n"
|
||||
"\t\t\t\t\tmethod <cloned> {originObject} {\n"
|
||||
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
|
||||
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
|
||||
"\t\t\t\t\t}\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\treturn $object\n"
|
||||
"\t\t}\n"
|
||||
"\t}\n"
|
||||
"\tclass create abstract {\n"
|
||||
"\t\tsuperclass class\n"
|
||||
"\t\tunexport create createWithNamespace new\n"
|
||||
"\t}\n"
|
||||
"}\n"
|
||||
/* !END!: Do not edit above this line. */
|
||||
;
|
||||
|
||||
#endif /* TCL_OO_SCRIPT_H */
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
@@ -1,456 +0,0 @@
|
||||
# tclOOScript.h --
|
||||
#
|
||||
# This file contains support scripts for TclOO. They are defined here so
|
||||
# that the code can be definitely run even in safe interpreters; TclOO's
|
||||
# core setup is safe.
|
||||
#
|
||||
# Copyright (c) 2012-2018 Donal K. Fellows
|
||||
# Copyright (c) 2013 Andreas Kupries
|
||||
# Copyright (c) 2017 Gerald Lester
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
::namespace eval ::oo {
|
||||
::namespace path {}
|
||||
|
||||
#
|
||||
# Commands that are made available to objects by default.
|
||||
#
|
||||
namespace eval Helpers {
|
||||
::namespace path {}
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# callback, mymethod --
|
||||
#
|
||||
# Create a script prefix that calls a method on the current
|
||||
# object. Same operation, two names.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
proc callback {method args} {
|
||||
list [uplevel 1 {::namespace which my}] $method {*}$args
|
||||
}
|
||||
|
||||
# Make the [callback] command appear as [mymethod] too.
|
||||
namespace export callback
|
||||
namespace eval tmp {namespace import ::oo::Helpers::callback}
|
||||
namespace export -clear
|
||||
rename tmp::callback mymethod
|
||||
namespace delete tmp
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# classvariable --
|
||||
#
|
||||
# Link to a variable in the class of the current object.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
proc classvariable {name args} {
|
||||
# Get a reference to the class's namespace
|
||||
set ns [info object namespace [uplevel 1 {self class}]]
|
||||
# Double up the list of variable names
|
||||
foreach v [list $name {*}$args] {
|
||||
if {[string match *(*) $v]} {
|
||||
set reason "can't create a scalar variable that looks like an array element"
|
||||
return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
|
||||
[format {bad variable name "%s": %s} $v $reason]
|
||||
}
|
||||
if {[string match *::* $v]} {
|
||||
set reason "can't create a local variable with a namespace separator in it"
|
||||
return -code error -errorcode {TCL UPVAR INVERTED} \
|
||||
[format {bad variable name "%s": %s} $v $reason]
|
||||
}
|
||||
lappend vs $v $v
|
||||
}
|
||||
# Lastly, link the caller's local variables to the class's variables
|
||||
tailcall namespace upvar $ns {*}$vs
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# link --
|
||||
#
|
||||
# Make a command that invokes a method on the current object.
|
||||
# The name of the command and the name of the method match by
|
||||
# default.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
proc link {args} {
|
||||
set ns [uplevel 1 {::namespace current}]
|
||||
foreach link $args {
|
||||
if {[llength $link] == 2} {
|
||||
lassign $link src dst
|
||||
} elseif {[llength $link] == 1} {
|
||||
lassign $link src
|
||||
set dst $src
|
||||
} else {
|
||||
return -code error -errorcode {TCLOO CMDLINK FORMAT} \
|
||||
"bad link description; must only have one or two elements"
|
||||
}
|
||||
if {![string match ::* $src]} {
|
||||
set src [string cat $ns :: $src]
|
||||
}
|
||||
interp alias {} $src {} ${ns}::my $dst
|
||||
trace add command ${ns}::my delete [list \
|
||||
::oo::UnlinkLinkedCommand $src]
|
||||
}
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# UnlinkLinkedCommand --
|
||||
#
|
||||
# Callback used to remove linked command when the underlying mechanism
|
||||
# that supports it is deleted.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc UnlinkLinkedCommand {cmd args} {
|
||||
if {[namespace which $cmd] ne {}} {
|
||||
rename $cmd {}
|
||||
}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# DelegateName --
|
||||
#
|
||||
# Utility that gets the name of the class delegate for a class. It's
|
||||
# trivial, but makes working with them much easier as delegate names are
|
||||
# intentionally hard to create by accident.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc DelegateName {class} {
|
||||
string cat [info object namespace $class] {:: oo ::delegate}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# MixinClassDelegates --
|
||||
#
|
||||
# Support code called *after* [oo::define] inside the constructor of a
|
||||
# class that patches in the appropriate class delegates.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc MixinClassDelegates {class} {
|
||||
if {![info object isa class $class]} {
|
||||
return
|
||||
}
|
||||
set delegate [DelegateName $class]
|
||||
if {![info object isa class $delegate]} {
|
||||
return
|
||||
}
|
||||
foreach c [info class superclass $class] {
|
||||
set d [DelegateName $c]
|
||||
if {![info object isa class $d]} {
|
||||
continue
|
||||
}
|
||||
define $delegate superclass -append $d
|
||||
}
|
||||
objdefine $class mixin -append $delegate
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# UpdateClassDelegatesAfterClone --
|
||||
#
|
||||
# Support code that is like [MixinClassDelegates] except for when a
|
||||
# class is cloned.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc UpdateClassDelegatesAfterClone {originObject targetObject} {
|
||||
# Rebuild the class inheritance delegation class
|
||||
set originDelegate [DelegateName $originObject]
|
||||
set targetDelegate [DelegateName $targetObject]
|
||||
if {
|
||||
[info object isa class $originDelegate]
|
||||
&& ![info object isa class $targetDelegate]
|
||||
} then {
|
||||
copy $originDelegate $targetDelegate
|
||||
objdefine $targetObject mixin -set \
|
||||
{*}[lmap c [info object mixin $targetObject] {
|
||||
if {$c eq $originDelegate} {set targetDelegate} {set c}
|
||||
}]
|
||||
}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::define::classmethod --
|
||||
#
|
||||
# Defines a class method. See define(n) for details.
|
||||
#
|
||||
# Note that the ::oo::define namespace is semi-public and a bit weird
|
||||
# anyway, so we don't regard the namespace path as being under control:
|
||||
# fully qualified names are used for everything.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc define::classmethod {name {args {}} {body {}}} {
|
||||
# Create the method on the class if the caller gave arguments and body
|
||||
::set argc [::llength [::info level 0]]
|
||||
::if {$argc == 3} {
|
||||
::return -code error -errorcode {TCL WRONGARGS} [::format \
|
||||
{wrong # args: should be "%s name ?args body?"} \
|
||||
[::lindex [::info level 0] 0]]
|
||||
}
|
||||
::set cls [::uplevel 1 self]
|
||||
::if {$argc == 4} {
|
||||
::oo::define [::oo::DelegateName $cls] method $name $args $body
|
||||
}
|
||||
# Make the connection by forwarding
|
||||
::tailcall forward $name myclass $name
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::define::initialise, oo::define::initialize --
|
||||
#
|
||||
# Do specific initialisation for a class. See define(n) for details.
|
||||
#
|
||||
# Note that the ::oo::define namespace is semi-public and a bit weird
|
||||
# anyway, so we don't regard the namespace path as being under control:
|
||||
# fully qualified names are used for everything.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
proc define::initialise {body} {
|
||||
::set clsns [::info object namespace [::uplevel 1 self]]
|
||||
::tailcall apply [::list {} $body $clsns]
|
||||
}
|
||||
|
||||
# Make the [initialise] definition appear as [initialize] too
|
||||
namespace eval define {
|
||||
::namespace export initialise
|
||||
::namespace eval tmp {::namespace import ::oo::define::initialise}
|
||||
::namespace export -clear
|
||||
::rename tmp::initialise initialize
|
||||
::namespace delete tmp
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# Slot --
|
||||
#
|
||||
# The class of slot operations, which are basically lists at the low
|
||||
# level of TclOO; this provides a more consistent interface to them.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
define Slot {
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# Slot Get --
|
||||
#
|
||||
# Basic slot getter. Retrieves the contents of the slot.
|
||||
# Particular slots must provide concrete non-erroring
|
||||
# implementation.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
method Get {} {
|
||||
return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# Slot Set --
|
||||
#
|
||||
# Basic slot setter. Sets the contents of the slot. Particular
|
||||
# slots must provide concrete non-erroring implementation.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
method Set list {
|
||||
return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# Slot Resolve --
|
||||
#
|
||||
# Helper that lets a slot convert a list of arguments of a
|
||||
# particular type to their canonical forms. Defaults to doing
|
||||
# nothing (suitable for simple strings).
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
method Resolve list {
|
||||
return $list
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
#
|
||||
# Slot -set, -append, -clear, --default-operation --
|
||||
#
|
||||
# Standard public slot operations. If a slot can't figure out
|
||||
# what method to call directly, it uses --default-operation.
|
||||
#
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
method -set args {
|
||||
set my [namespace which my]
|
||||
set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
|
||||
tailcall my Set $args
|
||||
}
|
||||
method -append args {
|
||||
set my [namespace which my]
|
||||
set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
|
||||
set current [uplevel 1 [list $my Get]]
|
||||
tailcall my Set [list {*}$current {*}$args]
|
||||
}
|
||||
method -clear {} {tailcall my Set {}}
|
||||
method -prepend args {
|
||||
set my [namespace which my]
|
||||
set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
|
||||
set current [uplevel 1 [list $my Get]]
|
||||
tailcall my Set [list {*}$args {*}$current]
|
||||
}
|
||||
method -remove args {
|
||||
set my [namespace which my]
|
||||
set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
|
||||
set current [uplevel 1 [list $my Get]]
|
||||
tailcall my Set [lmap val $current {
|
||||
if {$val in $args} continue else {set val}
|
||||
}]
|
||||
}
|
||||
|
||||
# Default handling
|
||||
forward --default-operation my -append
|
||||
method unknown {args} {
|
||||
set def --default-operation
|
||||
if {[llength $args] == 0} {
|
||||
tailcall my $def
|
||||
} elseif {![string match -* [lindex $args 0]]} {
|
||||
tailcall my $def {*}$args
|
||||
}
|
||||
next {*}$args
|
||||
}
|
||||
|
||||
# Set up what is exported and what isn't
|
||||
export -set -append -clear -prepend -remove
|
||||
unexport unknown destroy
|
||||
}
|
||||
|
||||
# Set the default operation differently for these slots
|
||||
objdefine define::superclass forward --default-operation my -set
|
||||
objdefine define::mixin forward --default-operation my -set
|
||||
objdefine objdefine::mixin forward --default-operation my -set
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::object <cloned> --
|
||||
#
|
||||
# Handler for cloning objects that clones basic bits (only!) of the
|
||||
# object's namespace. Non-procedures, traces, sub-namespaces, etc. need
|
||||
# more complex (and class-specific) handling.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
define object method <cloned> {originObject} {
|
||||
# Copy over the procedures from the original namespace
|
||||
foreach p [info procs [info object namespace $originObject]::*] {
|
||||
set args [info args $p]
|
||||
set idx -1
|
||||
foreach a $args {
|
||||
if {[info default $p $a d]} {
|
||||
lset args [incr idx] [list $a $d]
|
||||
} else {
|
||||
lset args [incr idx] [list $a]
|
||||
}
|
||||
}
|
||||
set b [info body $p]
|
||||
set p [namespace tail $p]
|
||||
proc $p $args $b
|
||||
}
|
||||
# Copy over the variables from the original namespace
|
||||
foreach v [info vars [info object namespace $originObject]::*] {
|
||||
upvar 0 $v vOrigin
|
||||
namespace upvar [namespace current] [namespace tail $v] vNew
|
||||
if {[info exists vOrigin]} {
|
||||
if {[array exists vOrigin]} {
|
||||
array set vNew [array get vOrigin]
|
||||
} else {
|
||||
set vNew $vOrigin
|
||||
}
|
||||
}
|
||||
}
|
||||
# General commands, sub-namespaces and advancd variable config (traces,
|
||||
# etc) are *not* copied over. Classes that want that should do it
|
||||
# themselves.
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::class <cloned> --
|
||||
#
|
||||
# Handler for cloning classes, which fixes up the delegates.
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
define class method <cloned> {originObject} {
|
||||
next $originObject
|
||||
# Rebuild the class inheritance delegation class
|
||||
::oo::UpdateClassDelegatesAfterClone $originObject [self]
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::singleton --
|
||||
#
|
||||
# A metaclass that is used to make classes that only permit one instance
|
||||
# of them to exist. See singleton(n).
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
class create singleton {
|
||||
superclass class
|
||||
variable object
|
||||
unexport create createWithNamespace
|
||||
method new args {
|
||||
if {![info exists object] || ![info object isa object $object]} {
|
||||
set object [next {*}$args]
|
||||
::oo::objdefine $object {
|
||||
method destroy {} {
|
||||
::return -code error -errorcode {TCLOO SINGLETON} \
|
||||
"may not destroy a singleton object"
|
||||
}
|
||||
method <cloned> {originObject} {
|
||||
::return -code error -errorcode {TCLOO SINGLETON} \
|
||||
"may not clone a singleton object"
|
||||
}
|
||||
}
|
||||
}
|
||||
return $object
|
||||
}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
#
|
||||
# oo::abstract --
|
||||
#
|
||||
# A metaclass that is used to make classes that can't be directly
|
||||
# instantiated. See abstract(n).
|
||||
#
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
class create abstract {
|
||||
superclass class
|
||||
unexport create createWithNamespace new
|
||||
}
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# c-basic-offset: 4
|
||||
# fill-column: 78
|
||||
# End:
|
||||
@@ -73,7 +73,6 @@ const TclOOStubs tclOOStubs = {
|
||||
Tcl_ClassSetConstructor, /* 26 */
|
||||
Tcl_ClassSetDestructor, /* 27 */
|
||||
Tcl_GetObjectName, /* 28 */
|
||||
Tcl_MethodIsPrivate, /* 29 */
|
||||
};
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
+40
-127
@@ -37,7 +37,7 @@ Tcl_Obj *tclFreeObjList = NULL;
|
||||
* TclNewObj macro, however, so must be visible.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
MODULE_SCOPE Tcl_Mutex tclObjMutex;
|
||||
Tcl_Mutex tclObjMutex;
|
||||
#endif
|
||||
@@ -50,7 +50,7 @@ Tcl_Mutex tclObjMutex;
|
||||
|
||||
char tclEmptyString = '\0';
|
||||
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
/*
|
||||
* Structure for tracking the source file and line number where a given
|
||||
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
|
||||
@@ -87,7 +87,7 @@ typedef struct {
|
||||
* tclCompile.h for the definition of this
|
||||
* structure, and for references to all
|
||||
* related places in the core. */
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
|
||||
* that a Tcl_Obj was not allocated by some
|
||||
* other thread. */
|
||||
@@ -156,7 +156,7 @@ typedef struct PendingObjData {
|
||||
/*
|
||||
* Macro to set up the local reference to the deletion context.
|
||||
*/
|
||||
#if !TCL_THREADS
|
||||
#ifndef TCL_THREADS
|
||||
static PendingObjData pendingObjData;
|
||||
#define ObjInitDeletionContext(contextPtr) \
|
||||
PendingObjData *const contextPtr = &pendingObjData
|
||||
@@ -452,7 +452,7 @@ TclInitObjSubsystem(void)
|
||||
void
|
||||
TclFinalizeThreadObjects(void)
|
||||
{
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch hSearch;
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
@@ -1009,7 +1009,7 @@ void
|
||||
TclDbDumpActiveObjects(
|
||||
FILE *outFile)
|
||||
{
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
Tcl_HashSearch hSearch;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashTable *tablePtr;
|
||||
@@ -1069,7 +1069,7 @@ TclDbInitNewObj(
|
||||
objPtr->length = 0;
|
||||
objPtr->typePtr = NULL;
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* Add entry to a thread local map used to check if a Tcl_Obj was
|
||||
* allocated by the currently executing thread.
|
||||
@@ -1305,7 +1305,7 @@ TclFreeObj(
|
||||
|
||||
ObjInitDeletionContext(context);
|
||||
|
||||
#if TCL_THREADS
|
||||
# ifdef TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -1632,30 +1632,32 @@ Tcl_GetString(
|
||||
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
|
||||
* be returned. */
|
||||
{
|
||||
if (objPtr->bytes == NULL) {
|
||||
if (objPtr->bytes != NULL) {
|
||||
return objPtr->bytes;
|
||||
}
|
||||
|
||||
/*
|
||||
* Note we do not check for objPtr->typePtr == NULL. An invariant of
|
||||
* a properly maintained Tcl_Obj is that at least one of objPtr->bytes
|
||||
* and objPtr->typePtr must not be NULL. If broken extensions fail to
|
||||
* maintain that invariant, we can crash here.
|
||||
*/
|
||||
|
||||
if (objPtr->typePtr->updateStringProc == NULL) {
|
||||
/*
|
||||
* Note we do not check for objPtr->typePtr == NULL. An invariant
|
||||
* of a properly maintained Tcl_Obj is that at least one of
|
||||
* objPtr->bytes and objPtr->typePtr must not be NULL. If broken
|
||||
* extensions fail to maintain that invariant, we can crash here.
|
||||
* Those Tcl_ObjTypes which choose not to define an updateStringProc
|
||||
* must be written in such a way that (objPtr->bytes) never becomes
|
||||
* NULL. This panic was added in Tcl 8.1.
|
||||
*/
|
||||
|
||||
if (objPtr->typePtr->updateStringProc == NULL) {
|
||||
/*
|
||||
* Those Tcl_ObjTypes which choose not to define an
|
||||
* updateStringProc must be written in such a way that
|
||||
* (objPtr->bytes) never becomes NULL.
|
||||
*/
|
||||
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
objPtr->typePtr->updateStringProc(objPtr);
|
||||
if (objPtr->bytes == NULL || objPtr->length < 0
|
||||
|| objPtr->bytes[objPtr->length] != '\0') {
|
||||
Tcl_Panic("UpdateStringProc for type '%s' "
|
||||
"failed to create a valid string rep",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
objPtr->typePtr->updateStringProc(objPtr);
|
||||
if (objPtr->bytes == NULL || objPtr->length < 0
|
||||
|| objPtr->bytes[objPtr->length] != '\0') {
|
||||
Tcl_Panic("UpdateStringProc for type '%s' "
|
||||
"failed to create a valid string rep", objPtr->typePtr->name);
|
||||
}
|
||||
return objPtr->bytes;
|
||||
}
|
||||
@@ -1691,31 +1693,8 @@ Tcl_GetStringFromObj(
|
||||
* rep's byte array length should * be stored.
|
||||
* If NULL, no length is stored. */
|
||||
{
|
||||
if (objPtr->bytes == NULL) {
|
||||
/*
|
||||
* Note we do not check for objPtr->typePtr == NULL. An invariant
|
||||
* of a properly maintained Tcl_Obj is that at least one of
|
||||
* objPtr->bytes and objPtr->typePtr must not be NULL. If broken
|
||||
* extensions fail to maintain that invariant, we can crash here.
|
||||
*/
|
||||
(void) TclGetString(objPtr);
|
||||
|
||||
if (objPtr->typePtr->updateStringProc == NULL) {
|
||||
/*
|
||||
* Those Tcl_ObjTypes which choose not to define an
|
||||
* updateStringProc must be written in such a way that
|
||||
* (objPtr->bytes) never becomes NULL.
|
||||
*/
|
||||
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
objPtr->typePtr->updateStringProc(objPtr);
|
||||
if (objPtr->bytes == NULL || objPtr->length < 0
|
||||
|| objPtr->bytes[objPtr->length] != '\0') {
|
||||
Tcl_Panic("UpdateStringProc for type '%s' "
|
||||
"failed to create a valid string rep",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
}
|
||||
if (lengthPtr != NULL) {
|
||||
*lengthPtr = objPtr->length;
|
||||
}
|
||||
@@ -2807,7 +2786,7 @@ Tcl_GetLongFromObj(
|
||||
|
||||
if (w >= -(Tcl_WideInt)(ULONG_MAX)
|
||||
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
|
||||
*longPtr = (long) w;
|
||||
*longPtr = Tcl_WideAsLong(w);
|
||||
return TCL_OK;
|
||||
}
|
||||
goto tooLarge;
|
||||
@@ -2833,9 +2812,10 @@ Tcl_GetLongFromObj(
|
||||
mp_int big;
|
||||
|
||||
UNPACK_BIGNUM(objPtr, big);
|
||||
if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
|
||||
if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
|
||||
/ DIGIT_BIT) {
|
||||
unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
|
||||
unsigned long value = 0, numBytes = sizeof(long);
|
||||
long scratch;
|
||||
unsigned char *bytes = (unsigned char *) &scratch;
|
||||
|
||||
if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
|
||||
@@ -3103,73 +3083,6 @@ Tcl_GetWideIntFromObj(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclGetWideBitsFromObj --
|
||||
*
|
||||
* Attempt to return a wide integer from the Tcl object "objPtr". If the
|
||||
* object is not already a int, double or bignum, an attempt will be made
|
||||
* to convert it to one of these. Out-of-range values don't result in an
|
||||
* error, but only the least significant 64 bits will be returned.
|
||||
*
|
||||
* Results:
|
||||
* The return value is a standard Tcl object result. If an error occurs
|
||||
* during conversion, an error message is left in the interpreter's
|
||||
* result unless "interp" is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* If the object is not already an int, double or bignum object, the
|
||||
* conversion will free any old internal representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclGetWideBitsFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
Tcl_Obj *objPtr, /* Object from which to get a wide int. */
|
||||
Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*wideIntPtr = objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected integer but got \"%s\"",
|
||||
TclGetString(objPtr)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
mp_int big;
|
||||
|
||||
Tcl_WideUInt value = 0, scratch;
|
||||
unsigned long numBytes = sizeof(Tcl_WideInt);
|
||||
unsigned char *bytes = (unsigned char *) &scratch;
|
||||
|
||||
Tcl_GetBignumFromObj(NULL, objPtr, &big);
|
||||
mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
|
||||
mp_to_unsigned_bin_n(&big, bytes, &numBytes);
|
||||
while (numBytes-- > 0) {
|
||||
value = (value << CHAR_BIT) | *bytes++;
|
||||
}
|
||||
if (big.sign) {
|
||||
value = -value;
|
||||
}
|
||||
*wideIntPtr = (Tcl_WideInt) value;
|
||||
mp_clear(&big);
|
||||
return TCL_OK;
|
||||
}
|
||||
} while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
|
||||
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3536,7 +3449,7 @@ Tcl_SetBignumObj(
|
||||
while (numBytes-- > 0) {
|
||||
value = (value << CHAR_BIT) | *bytes++;
|
||||
}
|
||||
if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
|
||||
if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
|
||||
goto tooLargeForWide;
|
||||
}
|
||||
if (bignumValue->sign) {
|
||||
@@ -3685,7 +3598,7 @@ Tcl_DbIncrRefCount(
|
||||
Tcl_Panic("incrementing refCount of previously disposed object");
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
# ifdef TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -3748,7 +3661,7 @@ Tcl_DbDecrRefCount(
|
||||
Tcl_Panic("decrementing refCount of previously disposed object");
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
# ifdef TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -3813,7 +3726,7 @@ Tcl_DbIsShared(
|
||||
Tcl_Panic("checking whether previously disposed object is shared");
|
||||
}
|
||||
|
||||
#if TCL_THREADS
|
||||
# ifdef TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
|
||||
+2
-3
@@ -23,8 +23,8 @@
|
||||
* procedure.
|
||||
*/
|
||||
|
||||
#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
|
||||
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
|
||||
#if defined(__CYGWIN__)
|
||||
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
|
||||
#else
|
||||
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
|
||||
#endif
|
||||
@@ -45,7 +45,6 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetPanicProc
|
||||
void
|
||||
Tcl_SetPanicProc(
|
||||
TCL_NORETURN1 Tcl_PanicProc *proc)
|
||||
|
||||
+1
-6
@@ -979,12 +979,7 @@ TclParseBackslash(
|
||||
if (readPtr != NULL) {
|
||||
*readPtr = count;
|
||||
}
|
||||
count = Tcl_UniCharToUtf(result, dst);
|
||||
if (!count) {
|
||||
/* Special case for handling upper surrogates. */
|
||||
count = Tcl_UniCharToUtf(-1, dst);
|
||||
}
|
||||
return count;
|
||||
return Tcl_UniCharToUtf(result, dst);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+1
-1
@@ -577,7 +577,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
|
||||
char *availVersion, *bestVersion, *bestStableVersion;
|
||||
/* Internal rep. of versions */
|
||||
int availStable, satisfies;
|
||||
int availStable, satisfies;
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
|
||||
@@ -40,7 +40,7 @@
|
||||
* configuration information.
|
||||
*/
|
||||
|
||||
#if TCL_THREADS
|
||||
#ifdef TCL_THREADS
|
||||
# define CFG_THREADED "1"
|
||||
#else
|
||||
# define CFG_THREADED "0"
|
||||
@@ -105,8 +105,6 @@ static Tcl_Config const cfg[] = {
|
||||
{"scriptdir,runtime", CFG_RUNTIME_SCRDIR},
|
||||
{"includedir,runtime", CFG_RUNTIME_INCDIR},
|
||||
{"docdir,runtime", CFG_RUNTIME_DOCDIR},
|
||||
{"dllfile,runtime", CFG_RUNTIME_DLLFILE},
|
||||
{"zipfile,runtime", CFG_RUNTIME_ZIPFILE},
|
||||
|
||||
/* Installation paths to various stuff */
|
||||
|
||||
|
||||
+15
-3
@@ -24,8 +24,20 @@
|
||||
#endif
|
||||
#include "tcl.h"
|
||||
|
||||
#define UWIDE_MAX ((Tcl_WideUInt)-1)
|
||||
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
|
||||
#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))
|
||||
#if !defined(LLONG_MIN)
|
||||
# ifdef TCL_WIDE_INT_IS_LONG
|
||||
# define LLONG_MIN LONG_MIN
|
||||
# else
|
||||
# ifdef LLONG_BIT
|
||||
# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
|
||||
# else
|
||||
/* Assume we're on a system with a 64-bit 'long long' type */
|
||||
# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
|
||||
# endif
|
||||
# endif
|
||||
/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
|
||||
# define LLONG_MAX (~LLONG_MIN)
|
||||
#endif
|
||||
|
||||
|
||||
#endif /* _TCLPORT */
|
||||
|
||||
+79
-53
@@ -505,11 +505,10 @@ TclCreateProc(
|
||||
goto procError;
|
||||
}
|
||||
|
||||
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
|
||||
nameLength = Tcl_NumUtfChars(argname, plen);
|
||||
nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
|
||||
if (fieldCount == 2) {
|
||||
const char * value = TclGetString(fieldValues[1]);
|
||||
valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
|
||||
valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
|
||||
fieldValues[1]->length);
|
||||
} else {
|
||||
valueLength = 0;
|
||||
}
|
||||
@@ -518,6 +517,7 @@ TclCreateProc(
|
||||
* Check that the formal parameter name is a scalar.
|
||||
*/
|
||||
|
||||
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
|
||||
argnamei = argname;
|
||||
argnamelast = argname[plen-1];
|
||||
while (plen--) {
|
||||
@@ -611,7 +611,7 @@ TclCreateProc(
|
||||
procPtr->lastLocalPtr = localPtr;
|
||||
}
|
||||
localPtr->nextPtr = NULL;
|
||||
localPtr->nameLength = nameLength;
|
||||
localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
|
||||
localPtr->frameIndex = i;
|
||||
localPtr->flags = VAR_ARGUMENT;
|
||||
localPtr->resolveInfo = NULL;
|
||||
@@ -688,15 +688,51 @@ TclGetFrame(
|
||||
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
|
||||
* global frame indicated). */
|
||||
{
|
||||
int result;
|
||||
Tcl_Obj obj;
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
int curLevel, level, result;
|
||||
CallFrame *framePtr;
|
||||
|
||||
obj.bytes = (char *) name;
|
||||
obj.length = strlen(name);
|
||||
obj.typePtr = NULL;
|
||||
result = TclObjGetFrame(interp, &obj, framePtrPtr);
|
||||
TclFreeIntRep(&obj);
|
||||
return result;
|
||||
/*
|
||||
* Parse string to figure out which level number to go to.
|
||||
*/
|
||||
|
||||
result = 1;
|
||||
curLevel = iPtr->varFramePtr->level;
|
||||
if (*name== '#') {
|
||||
if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
|
||||
goto levelError;
|
||||
}
|
||||
} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
|
||||
if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
|
||||
goto levelError;
|
||||
}
|
||||
level = curLevel - level;
|
||||
} else {
|
||||
level = curLevel - 1;
|
||||
result = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Figure out which frame to use, and return it to the caller.
|
||||
*/
|
||||
|
||||
for (framePtr = iPtr->varFramePtr; framePtr != NULL;
|
||||
framePtr = framePtr->callerVarPtr) {
|
||||
if (framePtr->level == level) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (framePtr == NULL) {
|
||||
goto levelError;
|
||||
}
|
||||
|
||||
*framePtrPtr = framePtr;
|
||||
return result;
|
||||
|
||||
levelError:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -734,7 +770,6 @@ TclObjGetFrame(
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
int curLevel, level, result;
|
||||
const char *name = NULL;
|
||||
Tcl_WideInt w;
|
||||
|
||||
/*
|
||||
* Parse object to figure out which level number to go to.
|
||||
@@ -750,33 +785,25 @@ TclObjGetFrame(
|
||||
|
||||
if (objPtr == NULL) {
|
||||
/* Do nothing */
|
||||
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
|
||||
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
|
||||
if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
|
||||
result = -1;
|
||||
} else {
|
||||
level = curLevel - level;
|
||||
result = 1;
|
||||
}
|
||||
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
|
||||
&& (level >= 0)) {
|
||||
level = curLevel - level;
|
||||
result = 1;
|
||||
} else if (objPtr->typePtr == &levelReferenceType) {
|
||||
level = (int) objPtr->internalRep.wideValue;
|
||||
result = 1;
|
||||
} else {
|
||||
name = TclGetString(objPtr);
|
||||
if (name[0] == '#') {
|
||||
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
|
||||
if (level < 0 || (level > 0 && name[1] == '-')) {
|
||||
result = -1;
|
||||
} else {
|
||||
TclFreeIntRep(objPtr);
|
||||
objPtr->typePtr = &levelReferenceType;
|
||||
objPtr->internalRep.wideValue = level;
|
||||
result = 1;
|
||||
}
|
||||
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
|
||||
TclFreeIntRep(objPtr);
|
||||
objPtr->typePtr = &levelReferenceType;
|
||||
objPtr->internalRep.wideValue = level;
|
||||
result = 1;
|
||||
} else {
|
||||
result = -1;
|
||||
}
|
||||
} else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
|
||||
} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
|
||||
/*
|
||||
* If this were an integer, we'd have succeeded already.
|
||||
* Docs say we have to treat this as a 'bad level' error.
|
||||
@@ -787,6 +814,7 @@ TclObjGetFrame(
|
||||
|
||||
if (result == 0) {
|
||||
level = curLevel - 1;
|
||||
name = "1";
|
||||
}
|
||||
if (result != -1) {
|
||||
if (level >= 0) {
|
||||
@@ -799,11 +827,11 @@ TclObjGetFrame(
|
||||
}
|
||||
}
|
||||
}
|
||||
if (name == NULL) {
|
||||
name = TclGetString(objPtr);
|
||||
}
|
||||
}
|
||||
|
||||
if (name == NULL) {
|
||||
name = TclGetString(objPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
|
||||
return -1;
|
||||
@@ -1007,6 +1035,7 @@ ProcWrongNumArgs(
|
||||
{
|
||||
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
|
||||
register Proc *procPtr = framePtr->procPtr;
|
||||
register Var *defPtr;
|
||||
int localCt = procPtr->numCompiledLocals, numArgs, i;
|
||||
Tcl_Obj **desiredObjs;
|
||||
const char *final = NULL;
|
||||
@@ -1030,26 +1059,23 @@ ProcWrongNumArgs(
|
||||
}
|
||||
Tcl_IncrRefCount(desiredObjs[0]);
|
||||
|
||||
if (localCt > 0) {
|
||||
register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
}
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
+35
-35
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* tclProcess.c --
|
||||
*
|
||||
* This file implements the "tcl::process" ensemble for subprocess
|
||||
* This file implements the "tcl::process" ensemble for subprocess
|
||||
* management as defined by TIP #462.
|
||||
*
|
||||
* Copyright (c) 2017 Frederic Bonnet.
|
||||
@@ -13,14 +13,14 @@
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
* Autopurge flag. Process-global because of the way Tcl manages child
|
||||
* Autopurge flag. Process-global because of the way Tcl manages child
|
||||
* processes (see tclPipe.c).
|
||||
*/
|
||||
|
||||
static int autopurge = 1; /* Autopurge flag. */
|
||||
|
||||
/*
|
||||
* Hash tables that keeps track of all child process statuses. Keys are the
|
||||
* Hash tables that keeps track of all child process statuses. Keys are the
|
||||
* child process ids and resolved pids, values are (ProcessInfo *).
|
||||
*/
|
||||
|
||||
@@ -29,7 +29,7 @@ typedef struct ProcessInfo {
|
||||
int resolvedPid; /* Resolved process id. */
|
||||
int purge; /* Purge eventualy. */
|
||||
TclProcessWaitStatus status;/* Process status. */
|
||||
int code; /* Error code, exit status or signal
|
||||
int code; /* Error code, exit status or signal
|
||||
number. */
|
||||
Tcl_Obj *msg; /* Error message. */
|
||||
Tcl_Obj *error; /* Error code. */
|
||||
@@ -47,7 +47,7 @@ static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
|
||||
int resolvedPid);
|
||||
static void FreeProcessInfo(ProcessInfo *info);
|
||||
static int RefreshProcessInfo(ProcessInfo *info, int options);
|
||||
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
|
||||
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
|
||||
int options, int *codePtr, Tcl_Obj **msgPtr,
|
||||
Tcl_Obj **errorObjPtr);
|
||||
static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info);
|
||||
@@ -160,7 +160,7 @@ RefreshProcessInfo(
|
||||
* Refresh & store status.
|
||||
*/
|
||||
|
||||
info->status = WaitProcessStatus(info->pid, info->resolvedPid,
|
||||
info->status = WaitProcessStatus(info->pid, info->resolvedPid,
|
||||
options, &info->code, &info->msg, &info->error);
|
||||
if (info->msg) Tcl_IncrRefCount(info->msg);
|
||||
if (info->error) Tcl_IncrRefCount(info->error);
|
||||
@@ -214,7 +214,7 @@ WaitProcessStatus(
|
||||
/*
|
||||
* No change.
|
||||
*/
|
||||
|
||||
|
||||
return TCL_PROCESS_UNCHANGED;
|
||||
}
|
||||
|
||||
@@ -370,7 +370,7 @@ BuildProcessStatusObj(
|
||||
/*
|
||||
* Normal exit, return TCL_OK.
|
||||
*/
|
||||
|
||||
|
||||
return Tcl_NewIntObj(TCL_OK);
|
||||
}
|
||||
|
||||
@@ -388,7 +388,7 @@ BuildProcessStatusObj(
|
||||
*
|
||||
* ProcessListObjCmd --
|
||||
*
|
||||
* This function implements the 'tcl::process list' Tcl command.
|
||||
* This function implements the 'tcl::process list' Tcl command.
|
||||
* Refer to the user documentation for details on what it does.
|
||||
*
|
||||
* Results:
|
||||
@@ -423,10 +423,10 @@ ProcessListObjCmd(
|
||||
|
||||
list = Tcl_NewListObj(0, NULL);
|
||||
Tcl_MutexLock(&infoTablesMutex);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
|
||||
info = (ProcessInfo *) Tcl_GetHashValue(entry);
|
||||
Tcl_ListObjAppendElement(interp, list,
|
||||
Tcl_ListObjAppendElement(interp, list,
|
||||
Tcl_NewIntObj(info->resolvedPid));
|
||||
}
|
||||
Tcl_MutexUnlock(&infoTablesMutex);
|
||||
@@ -438,7 +438,7 @@ ProcessListObjCmd(
|
||||
*
|
||||
* ProcessStatusObjCmd --
|
||||
*
|
||||
* This function implements the 'tcl::process status' Tcl command.
|
||||
* This function implements the 'tcl::process status' Tcl command.
|
||||
* Refer to the user documentation for details on what it does.
|
||||
*
|
||||
* Results:
|
||||
@@ -504,7 +504,7 @@ ProcessStatusObjCmd(
|
||||
|
||||
dict = Tcl_NewDictObj();
|
||||
Tcl_MutexLock(&infoTablesMutex);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
|
||||
info = (ProcessInfo *) Tcl_GetHashValue(entry);
|
||||
RefreshProcessInfo(info, options);
|
||||
@@ -513,7 +513,7 @@ ProcessStatusObjCmd(
|
||||
/*
|
||||
* Purge entry.
|
||||
*/
|
||||
|
||||
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
@@ -523,7 +523,7 @@ ProcessStatusObjCmd(
|
||||
* Add to result.
|
||||
*/
|
||||
|
||||
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
|
||||
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
|
||||
BuildProcessStatusObj(info));
|
||||
}
|
||||
}
|
||||
@@ -532,7 +532,7 @@ ProcessStatusObjCmd(
|
||||
/*
|
||||
* Only return statuses of provided processes.
|
||||
*/
|
||||
|
||||
|
||||
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
@@ -552,10 +552,10 @@ ProcessStatusObjCmd(
|
||||
/*
|
||||
* Skip unknown process.
|
||||
*/
|
||||
|
||||
|
||||
continue;
|
||||
}
|
||||
|
||||
|
||||
info = (ProcessInfo *) Tcl_GetHashValue(entry);
|
||||
RefreshProcessInfo(info, options);
|
||||
|
||||
@@ -563,7 +563,7 @@ ProcessStatusObjCmd(
|
||||
/*
|
||||
* Purge entry.
|
||||
*/
|
||||
|
||||
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
@@ -573,7 +573,7 @@ ProcessStatusObjCmd(
|
||||
* Add to result.
|
||||
*/
|
||||
|
||||
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
|
||||
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
|
||||
BuildProcessStatusObj(info));
|
||||
}
|
||||
}
|
||||
@@ -587,7 +587,7 @@ ProcessStatusObjCmd(
|
||||
*
|
||||
* ProcessPurgeObjCmd --
|
||||
*
|
||||
* This function implements the 'tcl::process purge' Tcl command.
|
||||
* This function implements the 'tcl::process purge' Tcl command.
|
||||
* Refer to the user documentation for details on what it does.
|
||||
*
|
||||
* Results:
|
||||
@@ -632,7 +632,7 @@ ProcessPurgeObjCmd(
|
||||
*/
|
||||
|
||||
Tcl_MutexLock(&infoTablesMutex);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
|
||||
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
|
||||
info = (ProcessInfo *) Tcl_GetHashValue(entry);
|
||||
if (info->purge) {
|
||||
@@ -647,7 +647,7 @@ ProcessPurgeObjCmd(
|
||||
/*
|
||||
* Purge only provided processes.
|
||||
*/
|
||||
|
||||
|
||||
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
@@ -665,7 +665,7 @@ ProcessPurgeObjCmd(
|
||||
/*
|
||||
* Skip unknown process.
|
||||
*/
|
||||
|
||||
|
||||
continue;
|
||||
}
|
||||
|
||||
@@ -687,7 +687,7 @@ ProcessPurgeObjCmd(
|
||||
*
|
||||
* ProcessAutopurgeObjCmd --
|
||||
*
|
||||
* This function implements the 'tcl::process autopurge' Tcl command.
|
||||
* This function implements the 'tcl::process autopurge' Tcl command.
|
||||
* Refer to the user documentation for details on what it does.
|
||||
*
|
||||
* Results:
|
||||
@@ -715,7 +715,7 @@ ProcessAutopurgeObjCmd(
|
||||
/*
|
||||
* Set given value.
|
||||
*/
|
||||
|
||||
|
||||
int flag;
|
||||
int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
|
||||
if (result != TCL_OK) {
|
||||
@@ -725,8 +725,8 @@ ProcessAutopurgeObjCmd(
|
||||
autopurge = !!flag;
|
||||
}
|
||||
|
||||
/*
|
||||
* Return current value.
|
||||
/*
|
||||
* Return current value.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
|
||||
@@ -821,9 +821,9 @@ TclProcessCreated(
|
||||
/*
|
||||
* Pid was reused, free old info and reuse structure.
|
||||
*/
|
||||
|
||||
|
||||
info = (ProcessInfo *) Tcl_GetHashValue(entry);
|
||||
entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
|
||||
entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
|
||||
INT2PTR(resolvedPid));
|
||||
if (entry2) Tcl_DeleteHashEntry(entry2);
|
||||
FreeProcessInfo(info);
|
||||
@@ -893,8 +893,8 @@ TclProcessWait(
|
||||
/*
|
||||
* Unknown process, just call WaitProcessStatus and return.
|
||||
*/
|
||||
|
||||
result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
|
||||
|
||||
result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
|
||||
msgObjPtr, errorObjPtr);
|
||||
if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
|
||||
if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
|
||||
@@ -909,7 +909,7 @@ TclProcessWait(
|
||||
* so report no change.
|
||||
*/
|
||||
Tcl_MutexUnlock(&infoTablesMutex);
|
||||
|
||||
|
||||
return TCL_PROCESS_UNCHANGED;
|
||||
}
|
||||
|
||||
@@ -919,7 +919,7 @@ TclProcessWait(
|
||||
* No change, stop there.
|
||||
*/
|
||||
Tcl_MutexUnlock(&infoTablesMutex);
|
||||
|
||||
|
||||
return TCL_PROCESS_UNCHANGED;
|
||||
}
|
||||
|
||||
@@ -940,7 +940,7 @@ TclProcessWait(
|
||||
*/
|
||||
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
|
||||
entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
|
||||
INT2PTR(info->resolvedPid));
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
FreeProcessInfo(info);
|
||||
|
||||
+2
-2
@@ -926,9 +926,9 @@ Tcl_ScanObjCmd(
|
||||
}
|
||||
if (flags & SCAN_LONGER) {
|
||||
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
|
||||
wideValue = WIDE_MAX;
|
||||
wideValue = LLONG_MAX;
|
||||
if (TclGetString(objPtr)[0] == '-') {
|
||||
wideValue = WIDE_MIN;
|
||||
wideValue = LLONG_MIN;
|
||||
}
|
||||
}
|
||||
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
|
||||
|
||||
+2
-2
@@ -4543,7 +4543,7 @@ Tcl_InitBignumFromDouble(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
fract = frexp(d, &expt);
|
||||
fract = frexp(d,&expt);
|
||||
if (expt <= 0) {
|
||||
mp_init(b);
|
||||
mp_zero(b);
|
||||
@@ -4883,7 +4883,7 @@ Pow10TimesFrExp(
|
||||
* Multiply by 10**exponent.
|
||||
*/
|
||||
|
||||
retval = frexp(retval * pow10vals[exponent & 0xf], &j);
|
||||
retval = frexp(retval * pow10vals[exponent&0xf], &j);
|
||||
expt += j;
|
||||
for (i=4; i<9; ++i) {
|
||||
if (exponent & (1<<i)) {
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user