Compare commits

..
Author SHA1 Message Date
gahr a3029fb2a2 Better rephrasing (ii) 2018-04-13 12:38:41 +00:00
gahr 9ef82f3330 Reduce diff 2018-04-13 12:33:11 +00:00
gahr 0d602bf400 Better rephrasing 2018-04-13 12:31:33 +00:00
gahr f15bba555a Fix documentation for [encoding convertfrom] 2018-04-13 09:36:08 +00:00
240 changed files with 6363 additions and 24657 deletions
-1
View File
@@ -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
-3
View File
@@ -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.
-3
View File
@@ -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.
+113 -151
View File
@@ -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);
}
}
}
-816
View File
@@ -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
View File
@@ -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
View File
@@ -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 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
+8 -14
View File
@@ -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
-77
View File
@@ -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
View File
@@ -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
View File
@@ -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:
-88
View File
@@ -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:
-78
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
-9
View File
@@ -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
View File
@@ -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
-10
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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 -84
View File
@@ -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
-5
View File
@@ -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
View File
@@ -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
View File
@@ -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
-99
View File
@@ -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:
-9
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
}
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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:
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
}
+7 -7
View File
@@ -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
View File
@@ -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
View File
@@ -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:
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
}
}
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
}
/*
+2 -2
View File
@@ -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
View File
@@ -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))
/*
*----------------------------------------------------------------
+11 -6
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
-9
View File
@@ -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
View File
@@ -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
View File
@@ -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.
+4 -9
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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.
-263
View File
@@ -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:
*/
-456
View File
@@ -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:
-1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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];
+1 -3
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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