Index: /branches/vendor/third/perl/perlio.h =================================================================== --- /branches/vendor/third/perl/perlio.h (revision 18449) +++ /branches/vendor/third/perl/perlio.h (revision 20074) @@ -1,5 +1,6 @@ /* perlio.h * - * Copyright (c) 1997-2002, Larry Wall + * Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, + * by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -108,4 +109,5 @@ const char *mode, SV *arg); extern void PerlIO_pop(pTHX_ PerlIO *f); +extern AV* PerlIO_get_layers(pTHX_ PerlIO *f); extern void PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param); @@ -194,4 +196,11 @@ START_EXTERN_C +#ifndef __attribute__format__ +#ifdef CHECK_FORMAT +#define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z))) +#else +#define __attribute__format__(x,y,z) +#endif +#endif #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ @@ -207,5 +216,5 @@ #ifndef PerlIO_stdoutf extern int PerlIO_stdoutf(const char *, ...) - __attribute__ ((__format__(__printf__, 1, 2))); + __attribute__format__(__printf__, 1, 2); #endif #ifndef PerlIO_puts @@ -267,9 +276,9 @@ #ifndef PerlIO_printf extern int PerlIO_printf(PerlIO *, const char *, ...) - __attribute__ ((__format__(__printf__, 2, 3))); + __attribute__format__(__printf__, 2, 3); #endif #ifndef PerlIO_sprintf extern int PerlIO_sprintf(char *, int, const char *, ...) - __attribute__ ((__format__(__printf__, 3, 4))); + __attribute__format__(__printf__, 3, 4); #endif #ifndef PerlIO_vprintf Index: /branches/vendor/third/perl/uconfig.h =================================================================== --- /branches/vendor/third/perl/uconfig.h (revision 18449) +++ /branches/vendor/third/perl/uconfig.h (revision 20074) @@ -8,5 +8,5 @@ * For a more permanent change edit uconfig.sh and rerun config_h.SH. * - * $Id: uconfig.h,v 1.1.1.1 2003-01-10 13:46:11 zacheiss Exp $ + * $Id: uconfig.h,v 1.1.1.2 2004-02-09 19:02:48 zacheiss Exp $ */ @@ -33,13 +33,4 @@ /*#define HAS_ALARM / **/ -/* HASATTRIBUTE: - * This symbol indicates the C compiler can check for function attributes, - * such as printf formats. This is normally only supported by GNU cc. - */ -/*#define HASATTRIBUTE / **/ -#ifndef HASATTRIBUTE -#define __attribute__(_arg_) -#endif - /* HAS_BCMP: * This symbol is defined if the bcmp() routine is available to @@ -371,5 +362,5 @@ * . See I_DIRENT. */ -/*#define HAS_READDIR / **/ +#define HAS_READDIR /**/ /* HAS_SEEKDIR: @@ -402,5 +393,5 @@ * trick. */ -/*#define HAS_RENAME / **/ +#define HAS_RENAME /**/ /* HAS_RMDIR: @@ -673,5 +664,5 @@ * portably declare your directory entries. */ -/*#define I_DIRENT / **/ +#define I_DIRENT /**/ /*#define DIRNAMLEN / **/ #define Direntry_t struct dirent @@ -748,5 +739,5 @@ * be included. */ -/*#define I_STDLIB / **/ +#define I_STDLIB /**/ /* I_STRING: @@ -944,17 +935,4 @@ /*#define I_SYS_SECURITY / **/ -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -/* OSVERS: - * This symbol contains the version of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "unknown" /**/ -#define OSVERS "" /**/ - /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a @@ -967,51 +945,4 @@ #define MEM_ALIGNBYTES 4 #endif - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for . It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define ARCHLIB "/usr/local/lib/perl5/5.7/unknown" / **/ -/*#define ARCHLIB_EXP "/usr/local/lib/perl5/5.7/unknown" / **/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "unknown" /**/ - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. - */ -/*#define HAS_ATOLF / **/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. - */ -/*#define HAS_ATOLL / **/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "/usr/local/bin" /**/ -#define BIN_EXP "" /**/ /* BYTEORDER: @@ -1058,6 +989,493 @@ #endif /* NeXT */ +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +/*#define CASTI32 / **/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + * 4 = couldn't cast in argument expression list + */ +/*#define CASTNEGFLOAT / **/ +#define CASTFLAGS 0 /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +/*#define VOID_CLOSEDIR / **/ + +/* HAS_FD_SET: + * This symbol, when defined, indicates presence of the fd_set typedef + * in + */ +/*#define HAS_FD_SET / **/ + +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * The usual values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) + +/* HAS_GETPAGESIZE: + * This symbol, if defined, indicates that the getpagesize system call + * is available to get system page size, which is the granularity of + * many memory management calls. + */ +/*#define HAS_GETPAGESIZE / **/ + +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. A better check is to use + * the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc. + */ +/*#define HAS_GNULIBC / **/ +#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) +# define _GNU_SOURCE +#endif +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +/*#define HAS_ISASCII / **/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN / **/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 / **/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Normally, you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_BCOPY / **/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. If you need to + * copy overlapping memory blocks, you should check HAS_MEMMOVE and + * use memmove() instead, if available. + */ +/*#define HAS_SAFE_MEMCPY / **/ + +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +/*#define HAS_SANE_MEMCMP / **/ + +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION / **/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP / **/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +/* STDIO_PTR_LVAL_SETS_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n has the side effect of decreasing the + * value of File_cnt(fp) by n. + */ +/* STDIO_PTR_LVAL_NOCHANGE_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n leaves File_cnt(fp) unchanged. + */ +/*#define USE_STDIO_PTR / **/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_IO_read_ptr) +/*#define STDIO_PTR_LVALUE / **/ +#define FILE_cnt(fp) ((fp)->_IO_read_end - (fp)->_IO_read_ptr) +/*#define STDIO_CNT_LVALUE / **/ +/*#define STDIO_PTR_LVAL_SETS_CNT / **/ +/*#define STDIO_PTR_LVAL_NOCHANGE_CNT / **/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +/*#define USE_STDIO_BASE / **/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_IO_read_base) +#define FILE_bufsiz(fp) ((fp)->_IO_read_end - (fp)->_IO_read_base) +#endif + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF / **/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +/* HAS_TM_TM_ZONE: + * This symbol, if defined, indicates to the C program that + * the struct tm has a tm_zone field. + */ +/* HAS_TM_TM_GMTOFF: + * This symbol, if defined, indicates to the C program that + * the struct tm has a tm_gmtoff field. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME / **/ +/*#define I_SYS_TIME_KERNEL / **/ +/*#define HAS_TM_TM_ZONE / **/ +/*#define HAS_TM_TM_GMTOFF / **/ + +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#undef EOF_NONBLOCK + +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). + */ +#define PTRSIZE 4 /**/ + +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in its headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15)) /**/ +#define Rand_seed_t int /**/ +#define seedDrand01(x) srand((Rand_seed_t)x) /**/ +#define RANDBITS 48 /**/ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#define SSize_t int /* signed count of bytes */ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC / **/ + +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for . It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define ARCHLIB "/usr/local/lib/perl5/5.7/unknown" / **/ +/*#define ARCHLIB_EXP "/usr/local/lib/perl5/5.7/unknown" / **/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "/usr/local/bin" /**/ +#define BIN_EXP "" /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST NULL /**/ + +/* INSTALL_USR_BIN_PERL: + * This symbol, if defined, indicates that Perl is to be installed + * also as /usr/bin/perl. + */ +/*#define INSTALL_USR_BIN_PERL / **/ + +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +/*#define PERL_OTHERLIBDIRS "" / **/ + +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "/usr/local/lib/perl5/5.7" /**/ +#define PRIVLIB_EXP "/usr/local/lib/perl5/5.7" /**/ + +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITEARCH "" /**/ +#define SITEARCH_EXP "" /**/ + +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. + */ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/* SITELIB_STEM: + * This define is SITELIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ +#define SITELIB "" /**/ +#define SITELIB_EXP "" /**/ +#define SITELIB_STEM "" /**/ + +/* PERL_VENDORARCH: + * If defined, this symbol contains the name of a private library. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. + * It may have a ~ on the front. + * The standard distribution will put nothing in this directory. + * Vendors who distribute perl may wish to place their own + * architecture-dependent modules and extensions in this directory with + * MakeMaker Makefile.PL INSTALLDIRS=vendor + * or equivalent. See INSTALL for details. + */ +/* PERL_VENDORARCH_EXP: + * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/*#define PERL_VENDORARCH "" / **/ +/*#define PERL_VENDORARCH_EXP "" / **/ + +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +/* PERL_VENDORLIB_STEM: + * This define is PERL_VENDORLIB_EXP with any trailing version-specific component + * removed. The elements in inc_version_list (inc_version_list.U) can + * be tacked onto this variable to generate a list of directories to search. + */ +/*#define PERL_VENDORLIB_EXP "" / **/ +/*#define PERL_VENDORLIB_STEM "" / **/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +/* OSVERS: + * This symbol contains the version of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "unknown" /**/ +#define OSVERS "" /**/ + /* CAT2: - * This macro catenates 2 tokens together. + * This macro concatenates 2 tokens together. */ /* STRINGIFY: @@ -1079,5 +1497,5 @@ #endif #if 42 != 1 && 42 != 42 -# include "Bletch: How does this C preprocessor catenate tokens?" +# include "Bletch: How does this C preprocessor concatenate tokens?" #endif @@ -1112,10 +1530,4 @@ #define CPPLAST "" -/* HAS__FWALK: - * This symbol, if defined, indicates that the _fwalk system call is - * available to apply a function to all the file handles. - */ -/*#define HAS__FWALK / **/ - /* HAS_ACCESS: * This manifest constant lets the C program know that the access() @@ -1125,37 +1537,751 @@ /*#define HAS_ACCESS / **/ -/* HAS_ASCTIME_R: - * This symbol, if defined, indicates that the asctime_r routine - * is available to asctime re-entrantly. - */ -/* ASCTIME_R_PROTO: - * This symbol encodes the prototype of asctime_r. - * It is zero if d_asctime_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r - * is defined. - */ -/*#define HAS_ASCTIME_R / **/ -#define ASCTIME_R_PROTO 0 /**/ - -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. - */ -/*#define CASTI32 / **/ - -/* CASTNEGFLOAT: - * This symbol is defined if the C compiler can cast negative - * numbers to unsigned longs, ints and shorts. - */ -/* CASTFLAGS: - * This symbol contains flags that say what difficulties the compiler - * has casting odd floating values to unsigned long: - * 0 = ok - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - * 4 = couldn't cast in argument expression list - */ -/*#define CASTNEGFLOAT / **/ -#define CASTFLAGS 0 /**/ +/* HASATTRIBUTE: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. This is normally only supported by GNU cc. + */ +/*#define HASATTRIBUTE / **/ +#ifndef HASATTRIBUTE +#ifdef __attribute__ +#undef __attribute__ +#endif +#define __attribute__(_arg_) +#endif + +/* HAS_CRYPT: + * This symbol, if defined, indicates that the crypt routine is available + * to encrypt passwords and the like. + */ +/*#define HAS_CRYPT / **/ + +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +/*#define HAS_CSH / **/ +#ifdef HAS_CSH +#define CSH "" /**/ +#endif + +/* SETUID_SCRIPTS_ARE_SECURE_NOW: + * This symbol, if defined, indicates that the bug that prevents + * setuid scripts from being secure is not present in this kernel. + */ +/* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ +/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/ +/*#define DOSUID / **/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +/*#define HAS_ENDGRENT / **/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +/*#define HAS_ENDHOSTENT / **/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +/*#define HAS_ENDNETENT / **/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +/*#define HAS_ENDPROTOENT / **/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +/*#define HAS_ENDPWENT / **/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +/*#define HAS_ENDSERVENT / **/ + +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +/*#define FLEXFILENAMES / **/ + +/* HAS_GETGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for sequential access of the group database. + */ +/*#define HAS_GETGRENT / **/ + +/* HAS_GETHOSTBYADDR: + * This symbol, if defined, indicates that the gethostbyaddr() routine is + * available to look up hosts by their IP addresses. + */ +/*#define HAS_GETHOSTBYADDR / **/ + +/* HAS_GETHOSTBYNAME: + * This symbol, if defined, indicates that the gethostbyname() routine is + * available to look up host names in some data base or other. + */ +/*#define HAS_GETHOSTBYNAME / **/ + +/* HAS_GETHOSTENT: + * This symbol, if defined, indicates that the gethostent() routine is + * available to look up host names in some data base or another. + */ +/*#define HAS_GETHOSTENT / **/ + +/* HAS_GETHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * gethostname() routine to derive the host name. See also HAS_UNAME + * and PHOSTNAME. + */ +/* HAS_UNAME: + * This symbol, if defined, indicates that the C program may use the + * uname() routine to derive the host name. See also HAS_GETHOSTNAME + * and PHOSTNAME. + */ +/* PHOSTNAME: + * This symbol, if defined, indicates the command to feed to the + * popen() routine to derive the host name. See also HAS_GETHOSTNAME + * and HAS_UNAME. Note that the command uses a fully qualified path, + * so that it is safe even if used by a process with super-user + * privileges. + */ +/* HAS_PHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * contents of PHOSTNAME as a command to feed to the popen() routine + * to derive the host name. + */ +/*#define HAS_GETHOSTNAME / **/ +/*#define HAS_UNAME / **/ +/*#define HAS_PHOSTNAME / **/ +#ifdef HAS_PHOSTNAME +#define PHOSTNAME "" /* How to get the host name */ +#endif + +/* HAS_GETNETBYADDR: + * This symbol, if defined, indicates that the getnetbyaddr() routine is + * available to look up networks by their IP addresses. + */ +/*#define HAS_GETNETBYADDR / **/ + +/* HAS_GETNETBYNAME: + * This symbol, if defined, indicates that the getnetbyname() routine is + * available to look up networks by their names. + */ +/*#define HAS_GETNETBYNAME / **/ + +/* HAS_GETNETENT: + * This symbol, if defined, indicates that the getnetent() routine is + * available to look up network names in some data base or another. + */ +/*#define HAS_GETNETENT / **/ + +/* HAS_GETPROTOENT: + * This symbol, if defined, indicates that the getprotoent() routine is + * available to look up protocols in some data base or another. + */ +/*#define HAS_GETPROTOENT / **/ + +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. + */ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +/*#define HAS_GETPGRP / **/ +/*#define USE_BSD_GETPGRP / **/ + +/* HAS_GETPROTOBYNAME: + * This symbol, if defined, indicates that the getprotobyname() + * routine is available to look up protocols by their name. + */ +/* HAS_GETPROTOBYNUMBER: + * This symbol, if defined, indicates that the getprotobynumber() + * routine is available to look up protocols by their number. + */ +/*#define HAS_GETPROTOBYNAME / **/ +/*#define HAS_GETPROTOBYNUMBER / **/ + +/* HAS_GETPWENT: + * This symbol, if defined, indicates that the getpwent routine is + * available for sequential access of the passwd database. + * If this is not available, the older getpw() function may be available. + */ +/*#define HAS_GETPWENT / **/ + +/* HAS_GETSERVENT: + * This symbol, if defined, indicates that the getservent() routine is + * available to look up network services in some data base or another. + */ +/*#define HAS_GETSERVENT / **/ + +/* HAS_GETSERVBYNAME: + * This symbol, if defined, indicates that the getservbyname() + * routine is available to look up services by their name. + */ +/* HAS_GETSERVBYPORT: + * This symbol, if defined, indicates that the getservbyport() + * routine is available to look up services by their port. + */ +/*#define HAS_GETSERVBYNAME / **/ +/*#define HAS_GETSERVBYPORT / **/ + +/* HAS_HTONL: + * This symbol, if defined, indicates that the htonl() routine (and + * friends htons() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_HTONS: + * This symbol, if defined, indicates that the htons() routine (and + * friends htonl() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHL: + * This symbol, if defined, indicates that the ntohl() routine (and + * friends htonl() htons() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHS: + * This symbol, if defined, indicates that the ntohs() routine (and + * friends htonl() htons() ntohl()) are available to do network + * order byte swapping. + */ +/*#define HAS_HTONL / **/ +/*#define HAS_HTONS / **/ +/*#define HAS_NTOHL / **/ +/*#define HAS_NTOHS / **/ + +/* HAS_LONG_DOUBLE: + * This symbol will be defined if the C compiler supports long + * doubles. + */ +/* LONG_DOUBLESIZE: + * This symbol contains the size of a long double, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long doubles. + */ +/*#define HAS_LONG_DOUBLE / **/ +#ifdef HAS_LONG_DOUBLE +#define LONG_DOUBLESIZE 8 /**/ +#endif + +/* HAS_LONG_LONG: + * This symbol will be defined if the C compiler supports long long. + */ +/* LONGLONGSIZE: + * This symbol contains the size of a long long, so that the + * C preprocessor can make decisions based on it. It is only + * defined if the system supports long long. + */ +/*#define HAS_LONG_LONG / **/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 8 /**/ +#endif + +/* HAS_MEMCHR: + * This symbol, if defined, indicates that the memchr routine is available + * to locate characters within a C string. + */ +/*#define HAS_MEMCHR / **/ + +/* HAS_MKSTEMP: + * This symbol, if defined, indicates that the mkstemp routine is + * available to exclusively create and open a uniquely named + * temporary file. + */ +/*#define HAS_MKSTEMP / **/ + +/* HAS_MMAP: + * This symbol, if defined, indicates that the mmap system call is + * available to map a file into memory. + */ +/* Mmap_t: + * This symbol holds the return type of the mmap() system call + * (and simultaneously the type of the first argument). + * Usually set to 'void *' or 'cadd_t'. + */ +/*#define HAS_MMAP / **/ +#define Mmap_t /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG / **/ + +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +/*#define HAS_SEM / **/ + +/* HAS_SETGRENT: + * This symbol, if defined, indicates that the setgrent routine is + * available for initializing sequential access of the group database. + */ +/*#define HAS_SETGRENT / **/ + +/* HAS_SETGROUPS: + * This symbol, if defined, indicates that the setgroups() routine is + * available to set the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +/*#define HAS_SETGROUPS / **/ + +/* HAS_SETHOSTENT: + * This symbol, if defined, indicates that the sethostent() routine is + * available. + */ +/*#define HAS_SETHOSTENT / **/ + +/* HAS_SETNETENT: + * This symbol, if defined, indicates that the setnetent() routine is + * available. + */ +/*#define HAS_SETNETENT / **/ + +/* HAS_SETPROTOENT: + * This symbol, if defined, indicates that the setprotoent() routine is + * available. + */ +/*#define HAS_SETPROTOENT / **/ + +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. + */ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +/*#define HAS_SETPGRP / **/ +/*#define USE_BSD_SETPGRP / **/ + +/* HAS_SETPWENT: + * This symbol, if defined, indicates that the setpwent routine is + * available for initializing sequential access of the passwd database. + */ +/*#define HAS_SETPWENT / **/ + +/* HAS_SETSERVENT: + * This symbol, if defined, indicates that the setservent() routine is + * available. + */ +/*#define HAS_SETSERVENT / **/ + +/* HAS_SETVBUF: + * This symbol, if defined, indicates that the setvbuf routine is + * available to change buffering on an open stdio stream. + * to a line-buffered mode. + */ +/*#define HAS_SETVBUF / **/ + +/* HAS_SHM: + * This symbol, if defined, indicates that the entire shm*(2) library is + * supported. + */ +/*#define HAS_SHM / **/ + +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. + */ +/* HAS_SHMAT_PROTOTYPE: + * This symbol, if defined, indicates that the sys/shm.h includes + * a prototype for shmat(). Otherwise, it is up to the program to + * guess one. Shmat_t shmat(int, Shmat_t, int) is a good guess, + * but not always right so it should be emitted by the program only + * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. + */ +#define Shmat_t void * /**/ +/*#define HAS_SHMAT_PROTOTYPE / **/ + +/* HAS_SOCKET: + * This symbol, if defined, indicates that the BSD socket interface is + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +/* HAS_MSG_CTRUNC: + * This symbol, if defined, indicates that the MSG_CTRUNC is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_DONTROUTE: + * This symbol, if defined, indicates that the MSG_DONTROUTE is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_OOB: + * This symbol, if defined, indicates that the MSG_OOB is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_PEEK: + * This symbol, if defined, indicates that the MSG_PEEK is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_MSG_PROXY: + * This symbol, if defined, indicates that the MSG_PROXY is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/* HAS_SCM_RIGHTS: + * This symbol, if defined, indicates that the SCM_RIGHTS is supported. + * Checking just with #ifdef might not be enough because this symbol + * has been known to be an enum. + */ +/*#define HAS_SOCKET / **/ +/*#define HAS_SOCKETPAIR / **/ +/*#define HAS_MSG_CTRUNC / **/ +/*#define HAS_MSG_DONTROUTE / **/ +/*#define HAS_MSG_OOB / **/ +/*#define HAS_MSG_PEEK / **/ +/*#define HAS_MSG_PROXY / **/ +/*#define HAS_SCM_RIGHTS / **/ + +/* USE_STAT_BLOCKS: + * This symbol is defined if this system has a stat structure declaring + * st_blksize and st_blocks. + */ +#ifndef USE_STAT_BLOCKS +/*#define USE_STAT_BLOCKS / **/ +#endif + +/* HAS_STRERROR: + * This symbol, if defined, indicates that the strerror routine is + * available to translate error numbers to strings. See the writeup + * of Strerror() in this file before you try to define your own. + */ +/* HAS_SYS_ERRLIST: + * This symbol, if defined, indicates that the sys_errlist array is + * available to translate error numbers to strings. The extern int + * sys_nerr gives the size of that table. + */ +/* Strerror: + * This preprocessor symbol is defined as a macro if strerror() is + * not available to translate error numbers to strings but sys_errlist[] + * array is there. + */ +/*#define HAS_STRERROR / **/ +/*#define HAS_SYS_ERRLIST / **/ +#define Strerror(e) strerror(e) + +/* HAS_STRTOUL: + * This symbol, if defined, indicates that the strtoul routine is + * available to provide conversion of strings to unsigned long. + */ +#define HAS_STRTOUL /**/ + +/* HAS_UNION_SEMUN: + * This symbol, if defined, indicates that the union semun is + * defined by including . If not, the user code + * probably needs to define it as: + * union semun { + * int val; + * struct semid_ds *buf; + * unsigned short *array; + * } + */ +/* USE_SEMCTL_SEMUN: + * This symbol, if defined, indicates that union semun is + * used for semctl IPC_STAT. + */ +/* USE_SEMCTL_SEMID_DS: + * This symbol, if defined, indicates that struct semid_ds * is + * used for semctl IPC_STAT. + */ +/*#define HAS_UNION_SEMUN / **/ +/*#define USE_SEMCTL_SEMUN / **/ +/*#define USE_SEMCTL_SEMID_DS / **/ + +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. + */ +/*#define HAS_VFORK / **/ + +/* Signal_t: + * This symbol's value is either "void" or "int", corresponding to the + * appropriate return type of a signal handler. Thus, you can declare + * a signal handler using "Signal_t (*handler)()", and define the + * handler using "Signal_t handler(sig)". + */ +#define Signal_t int /* Signal handler's return type */ + +/* Groups_t: + * This symbol holds the type used for the second argument to + * getgroups() and setgroups(). Usually, this is the same as + * gidtype (gid_t) , but sometimes it isn't. + * It can be int, ushort, gid_t, etc... + * It may be necessary to include to get any + * typedef'ed information. This is only required if you have + * getgroups() or setgroups().. + */ +#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) +#define Groups_t int /* Type for 2nd arg to [sg]etgroups() */ +#endif + +/* I_GRP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* GRPASSWD: + * This symbol, if defined, indicates to the C program that struct group + * in contains gr_passwd. + */ +/*#define I_GRP / **/ +/*#define GRPASSWD / **/ + +/* I_NDBM: + * This symbol, if defined, indicates that exists and should + * be included. + */ +/*#define I_NDBM / **/ + +/* I_NETDB: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_NETDB / **/ + +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/* PWGECOS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_gecos. + */ +/* PWPASSWD: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_passwd. + */ +/*#define I_PWD / **/ +/*#define PWQUOTA / **/ +/*#define PWAGE / **/ +/*#define PWCHANGE / **/ +/*#define PWCLASS / **/ +/*#define PWEXPIRE / **/ +/*#define PWCOMMENT / **/ +/*#define PWGECOS / **/ +/*#define PWPASSWD / **/ + +/* I_SYSUIO: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYSUIO / **/ + +/* I_STDARG: + * This symbol, if defined, indicates that exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#define I_STDARG /**/ +/*#define I_VARARGS / **/ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ +/* Malloc_t: + * This symbol is the type of pointer returned by malloc and realloc. + */ +#define Malloc_t void * /**/ +#define Free_t int /**/ + +/* MYMALLOC: + * This symbol, if defined, indicates that we're using our own malloc. + */ +/*#define MYMALLOC / **/ + +/* CAN_PROTOTYPE: + * If defined, this macro indicates that the C compiler can handle + * function prototypes. + */ +/* _: + * This macro is used to declare function parameters for folks who want + * to make declarations with prototypes using a different style than + * the above macros. Use double parentheses. For example: + * + * int main _((int argc, char *argv[])); + */ +/*#define CAN_PROTOTYPE / **/ +#ifdef CAN_PROTOTYPE +#define _(args) args +#else +#define _(args) () +#endif + +/* SH_PATH: + * This symbol contains the full pathname to the shell used on this + * on this system to execute Bourne shell scripts. Usually, this will be + * /bin/sh, though it's possible that some systems will have /bin/ksh, + * /bin/pdksh, /bin/ash, /bin/bash, or even something such as + * D:/bin/sh.exe. + */ +#define SH_PATH "" /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_name_init list. + * Note that this variable is initialized from the sig_name_init, + * not from sig_name (which is unused). + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name_init list. + * Note that this variable is initialized from the sig_num_init, + * not from sig_num (which is unused). + */ +/* SIG_SIZE: + * This variable contains the number of elements of the SIG_NAME + * and SIG_NUM arrays, excluding the final NULL entry. + */ +#define SIG_NAME 0 /**/ +#define SIG_NUM 0 /**/ +#define SIG_SIZE 1 /**/ + +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". + */ +#define STDCHAR char /**/ + +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED 1 +#endif +#define VOIDFLAGS 1 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + +/* USE_CROSS_COMPILE: + * This symbol, if defined, indicates that Perl is being cross-compiled. + */ +/* PERL_TARGETARCH: + * This symbol, if defined, indicates the target architecture + * Perl has been cross-compiled to. Undefined if not a cross-compile. + */ +#ifndef USE_CROSS_COMPILE +/*#define USE_CROSS_COMPILE / **/ +#define PERL_TARGETARCH "" /**/ +#endif + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF / **/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL / **/ + +/* HAS__FWALK: + * This symbol, if defined, indicates that the _fwalk system call is + * available to apply a function to all the file handles. + */ +/*#define HAS__FWALK / **/ + +/* HAS_AINTL: + * This symbol, if defined, indicates that the aintl routine is + * available. If copysignl is also present we can emulate modfl. + */ +/*#define HAS_AINTL / **/ /* HAS_CLASS: @@ -1177,10 +2303,4 @@ /*#define HAS_CLASS / **/ -/* VOID_CLOSEDIR: - * This symbol, if defined, indicates that the closedir() routine - * does not return a value. - */ -/*#define VOID_CLOSEDIR / **/ - /* HAS_STRUCT_CMSGHDR: * This symbol, if defined, indicates that the struct cmsghdr @@ -1189,40 +2309,23 @@ /*#define HAS_STRUCT_CMSGHDR / **/ -/* HAS_CRYPT_R: - * This symbol, if defined, indicates that the crypt_r routine - * is available to crypt re-entrantly. - */ -/* CRYPT_R_PROTO: - * This symbol encodes the prototype of crypt_r. - * It is zero if d_crypt_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r - * is defined. - */ -/*#define HAS_CRYPT_R / **/ -#define CRYPT_R_PROTO 0 /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -/*#define HAS_CSH / **/ -#ifdef HAS_CSH -#define CSH "" /**/ -#endif - -/* HAS_CTIME_R: - * This symbol, if defined, indicates that the ctime_r routine - * is available to ctime re-entrantly. - */ -/* CTIME_R_PROTO: - * This symbol encodes the prototype of ctime_r. - * It is zero if d_ctime_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r - * is defined. - */ -/*#define HAS_CTIME_R / **/ -#define CTIME_R_PROTO 0 /**/ +/* HAS_COPYSIGNL: + * This symbol, if defined, indicates that the copysignl routine is + * available. If aintl is also present we can emulate modfl. + */ +/*#define HAS_COPYSIGNL / **/ + +/* HAS_DBMINIT_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the dbminit() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int dbminit(char *); + */ +/*#define HAS_DBMINIT_PROTO / **/ + +/* HAS_DIRFD: + * This manifest constant lets the C program know that dirfd + * is available. + */ +/*#define HAS_DIRFD / **/ /* DLSYM_NEEDS_UNDERSCORE: @@ -1234,86 +2337,9 @@ /*#define DLSYM_NEEDS_UNDERSCORE / **/ -/* HAS_DRAND48_R: - * This symbol, if defined, indicates that the drand48_r routine - * is available to drand48 re-entrantly. - */ -/* DRAND48_R_PROTO: - * This symbol encodes the prototype of drand48_r. - * It is zero if d_drand48_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r - * is defined. - */ -/*#define HAS_DRAND48_R / **/ -#define DRAND48_R_PROTO 0 /**/ - -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48(void); - */ -/*#define HAS_DRAND48_PROTO / **/ - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -/*#define HAS_ENDGRENT / **/ - -/* HAS_ENDGRENT_R: - * This symbol, if defined, indicates that the endgrent_r routine - * is available to endgrent re-entrantly. - */ -/* ENDGRENT_R_PROTO: - * This symbol encodes the prototype of endgrent_r. - * It is zero if d_endgrent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r - * is defined. - */ -/*#define HAS_ENDGRENT_R / **/ -#define ENDGRENT_R_PROTO 0 /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -/*#define HAS_ENDHOSTENT / **/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -/*#define HAS_ENDNETENT / **/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -/*#define HAS_ENDPROTOENT / **/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -/*#define HAS_ENDPWENT / **/ - -/* HAS_ENDPWENT_R: - * This symbol, if defined, indicates that the endpwent_r routine - * is available to endpwent re-entrantly. - */ -/* ENDPWENT_R_PROTO: - * This symbol encodes the prototype of endpwent_r. - * It is zero if d_endpwent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r - * is defined. - */ -/*#define HAS_ENDPWENT_R / **/ -#define ENDPWENT_R_PROTO 0 /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -/*#define HAS_ENDSERVENT / **/ +/* HAS_FAST_STDIO: + * This symbol, if defined, indicates that the "fast stdio" + * is available to manipulate the stdio buffers directly. + */ +/*#define HAS_FAST_STDIO / **/ /* HAS_FCHDIR: @@ -1330,10 +2356,4 @@ /*#define FCNTL_CAN_LOCK / **/ -/* HAS_FD_SET: - * This symbol, when defined, indicates presence of the fd_set typedef - * in - */ -/*#define HAS_FD_SET / **/ - /* HAS_FINITE: * This symbol, if defined, indicates that the finite routine is @@ -1349,9 +2369,11 @@ /*#define HAS_FINITEL / **/ -/* FLEXFILENAMES: - * This symbol, if defined, indicates that the system supports filenames - * longer than 14 characters. - */ -/*#define FLEXFILENAMES / **/ +/* HAS_FLOCK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the flock() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int flock(int, int); + */ +/*#define HAS_FLOCK_PROTO / **/ /* HAS_FP_CLASS: @@ -1405,4 +2427,22 @@ /*#define HAS_FPCLASSIFY / **/ +/* HAS_FPCLASSL: + * This symbol, if defined, indicates that the fpclassl routine is + * available to classify long doubles. Available for example in IRIX. + * The returned values are defined in and are: + * + * FP_SNAN signaling NaN + * FP_QNAN quiet NaN + * FP_NINF negative infinity + * FP_PINF positive infinity + * FP_NDENORM negative denormalized non-zero + * FP_PDENORM positive denormalized non-zero + * FP_NZERO negative zero + * FP_PZERO positive zero + * FP_NNORM negative normalized non-zero + * FP_PNORM positive normalized non-zero + */ +/*#define HAS_FPCLASSL / **/ + /* HAS_FPOS64_T: * This symbol will be defined if the C compiler supports fpos64_t. @@ -1448,21 +2488,4 @@ /*#define HAS_FTELLO / **/ -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. Arguments for the Gconvert - * macro are: value, number of digits, whether trailing zeros should - * be retained, and the output buffer. - * The usual values are: - * d_Gconvert='gconvert((x),(n),(t),(b))' - * d_Gconvert='gcvt((x),(n),(b))' - * d_Gconvert='sprintf((b),"%.*g",(n),(x))' - * The last two assume trailing zeros should not be kept. - */ -#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) - /* HAS_GETCWD: * This symbol, if defined, indicates that the getcwd routine is @@ -1483,104 +2506,4 @@ /*#define HAS_GETFSSTAT / **/ -/* HAS_GETGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for sequential access of the group database. - */ -/*#define HAS_GETGRENT / **/ - -/* HAS_GETGRENT_R: - * This symbol, if defined, indicates that the getgrent_r routine - * is available to getgrent re-entrantly. - */ -/* GETGRENT_R_PROTO: - * This symbol encodes the prototype of getgrent_r. - * It is zero if d_getgrent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r - * is defined. - */ -/*#define HAS_GETGRENT_R / **/ -#define GETGRENT_R_PROTO 0 /**/ - -/* HAS_GETGRGID_R: - * This symbol, if defined, indicates that the getgrgid_r routine - * is available to getgrgid re-entrantly. - */ -/* GETGRGID_R_PROTO: - * This symbol encodes the prototype of getgrgid_r. - * It is zero if d_getgrgid_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r - * is defined. - */ -/*#define HAS_GETGRGID_R / **/ -#define GETGRGID_R_PROTO 0 /**/ - -/* HAS_GETGRNAM_R: - * This symbol, if defined, indicates that the getgrnam_r routine - * is available to getgrnam re-entrantly. - */ -/* GETGRNAM_R_PROTO: - * This symbol encodes the prototype of getgrnam_r. - * It is zero if d_getgrnam_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r - * is defined. - */ -/*#define HAS_GETGRNAM_R / **/ -#define GETGRNAM_R_PROTO 0 /**/ - -/* HAS_GETHOSTBYADDR: - * This symbol, if defined, indicates that the gethostbyaddr() routine is - * available to look up hosts by their IP addresses. - */ -/*#define HAS_GETHOSTBYADDR / **/ - -/* HAS_GETHOSTBYNAME: - * This symbol, if defined, indicates that the gethostbyname() routine is - * available to look up host names in some data base or other. - */ -/*#define HAS_GETHOSTBYNAME / **/ - -/* HAS_GETHOSTENT: - * This symbol, if defined, indicates that the gethostent() routine is - * available to look up host names in some data base or another. - */ -/*#define HAS_GETHOSTENT / **/ - -/* HAS_GETHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * gethostname() routine to derive the host name. See also HAS_UNAME - * and PHOSTNAME. - */ -/* HAS_UNAME: - * This symbol, if defined, indicates that the C program may use the - * uname() routine to derive the host name. See also HAS_GETHOSTNAME - * and PHOSTNAME. - */ -/* PHOSTNAME: - * This symbol, if defined, indicates the command to feed to the - * popen() routine to derive the host name. See also HAS_GETHOSTNAME - * and HAS_UNAME. Note that the command uses a fully qualified path, - * so that it is safe even if used by a process with super-user - * privileges. - */ -/* HAS_PHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * contents of PHOSTNAME as a command to feed to the popen() routine - * to derive the host name. - */ -/*#define HAS_GETHOSTNAME / **/ -/*#define HAS_UNAME / **/ -/*#define HAS_PHOSTNAME / **/ -#ifdef HAS_PHOSTNAME -#define PHOSTNAME "" /* How to get the host name */ -#endif - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETHOST_PROTOS / **/ - /* HAS_GETITIMER: * This symbol, if defined, indicates that the getitimer routine is @@ -1589,17 +2512,4 @@ /*#define HAS_GETITIMER / **/ -/* HAS_GETLOGIN_R: - * This symbol, if defined, indicates that the getlogin_r routine - * is available to getlogin re-entrantly. - */ -/* GETLOGIN_R_PROTO: - * This symbol encodes the prototype of getlogin_r. - * It is zero if d_getlogin_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r - * is defined. - */ -/*#define HAS_GETLOGIN_R / **/ -#define GETLOGIN_R_PROTO 0 /**/ - /* HAS_GETMNT: * This symbol, if defined, indicates that the getmnt routine is @@ -1614,73 +2524,4 @@ /*#define HAS_GETMNTENT / **/ -/* HAS_GETNETBYADDR: - * This symbol, if defined, indicates that the getnetbyaddr() routine is - * available to look up networks by their IP addresses. - */ -/*#define HAS_GETNETBYADDR / **/ - -/* HAS_GETNETBYNAME: - * This symbol, if defined, indicates that the getnetbyname() routine is - * available to look up networks by their names. - */ -/*#define HAS_GETNETBYNAME / **/ - -/* HAS_GETNETENT: - * This symbol, if defined, indicates that the getnetent() routine is - * available to look up network names in some data base or another. - */ -/*#define HAS_GETNETENT / **/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETNET_PROTOS / **/ - -/* HAS_GETPAGESIZE: - * This symbol, if defined, indicates that the getpagesize system call - * is available to get system page size, which is the granularity of - * many memory management calls. - */ -/*#define HAS_GETPAGESIZE / **/ - -/* HAS_GETPROTOENT: - * This symbol, if defined, indicates that the getprotoent() routine is - * available to look up protocols in some data base or another. - */ -/*#define HAS_GETPROTOENT / **/ - -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -/* USE_BSD_GETPGRP: - * This symbol, if defined, indicates that getpgrp needs one - * arguments whereas USG one needs none. - */ -/*#define HAS_GETPGRP / **/ -/*#define USE_BSD_GETPGRP / **/ - -/* HAS_GETPROTOBYNAME: - * This symbol, if defined, indicates that the getprotobyname() - * routine is available to look up protocols by their name. - */ -/* HAS_GETPROTOBYNUMBER: - * This symbol, if defined, indicates that the getprotobynumber() - * routine is available to look up protocols by their number. - */ -/*#define HAS_GETPROTOBYNAME / **/ -/*#define HAS_GETPROTOBYNUMBER / **/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETPROTO_PROTOS / **/ - /* HAS_GETPRPWNAM: * This symbol, if defined, indicates that the getprpwnam system call is @@ -1689,64 +2530,4 @@ /*#define HAS_GETPRPWNAM / **/ -/* HAS_GETPWENT: - * This symbol, if defined, indicates that the getpwent routine is - * available for sequential access of the passwd database. - * If this is not available, the older getpw() function may be available. - */ -/*#define HAS_GETPWENT / **/ - -/* HAS_GETPWENT_R: - * This symbol, if defined, indicates that the getpwent_r routine - * is available to getpwent re-entrantly. - */ -/* GETPWENT_R_PROTO: - * This symbol encodes the prototype of getpwent_r. - * It is zero if d_getpwent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r - * is defined. - */ -/*#define HAS_GETPWENT_R / **/ -#define GETPWENT_R_PROTO 0 /**/ - -/* HAS_GETPWNAM_R: - * This symbol, if defined, indicates that the getpwnam_r routine - * is available to getpwnam re-entrantly. - */ -/* GETPWNAM_R_PROTO: - * This symbol encodes the prototype of getpwnam_r. - * It is zero if d_getpwnam_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r - * is defined. - */ -/*#define HAS_GETPWNAM_R / **/ -#define GETPWNAM_R_PROTO 0 /**/ - -/* HAS_GETPWUID_R: - * This symbol, if defined, indicates that the getpwuid_r routine - * is available to getpwuid re-entrantly. - */ -/* GETPWUID_R_PROTO: - * This symbol encodes the prototype of getpwuid_r. - * It is zero if d_getpwuid_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r - * is defined. - */ -/*#define HAS_GETPWUID_R / **/ -#define GETPWUID_R_PROTO 0 /**/ - -/* HAS_GETSERVENT: - * This symbol, if defined, indicates that the getservent() routine is - * available to look up network services in some data base or another. - */ -/*#define HAS_GETSERVENT / **/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETSERV_PROTOS / **/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is @@ -1755,50 +2536,4 @@ /*#define HAS_GETSPNAM / **/ -/* HAS_GETSPNAM_R: - * This symbol, if defined, indicates that the getspnam_r routine - * is available to getspnam re-entrantly. - */ -/* GETSPNAM_R_PROTO: - * This symbol encodes the prototype of getspnam_r. - * It is zero if d_getspnam_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r - * is defined. - */ -/*#define HAS_GETSPNAM_R / **/ -#define GETSPNAM_R_PROTO 0 /**/ - -/* HAS_GETSERVBYNAME: - * This symbol, if defined, indicates that the getservbyname() - * routine is available to look up services by their name. - */ -/* HAS_GETSERVBYPORT: - * This symbol, if defined, indicates that the getservbyport() - * routine is available to look up services by their port. - */ -/*#define HAS_GETSERVBYNAME / **/ -/*#define HAS_GETSERVBYPORT / **/ - -/* HAS_GMTIME_R: - * This symbol, if defined, indicates that the gmtime_r routine - * is available to gmtime re-entrantly. - */ -/* GMTIME_R_PROTO: - * This symbol encodes the prototype of gmtime_r. - * It is zero if d_gmtime_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r - * is defined. - */ -/*#define HAS_GMTIME_R / **/ -#define GMTIME_R_PROTO 0 /**/ - -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. A better check is to use - * the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc. - */ -/*#define HAS_GNULIBC / **/ -#if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) -# define _GNU_SOURCE -#endif /* HAS_HASMNTOPT: * This symbol, if defined, indicates that the hasmntopt routine is @@ -1807,28 +2542,9 @@ /*#define HAS_HASMNTOPT / **/ -/* HAS_HTONL: - * This symbol, if defined, indicates that the htonl() routine (and - * friends htons() ntohl() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_HTONS: - * This symbol, if defined, indicates that the htons() routine (and - * friends htonl() ntohl() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_NTOHL: - * This symbol, if defined, indicates that the ntohl() routine (and - * friends htonl() htons() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_NTOHS: - * This symbol, if defined, indicates that the ntohs() routine (and - * friends htonl() htons() ntohl()) are available to do network - * order byte swapping. - */ -/*#define HAS_HTONL / **/ -/*#define HAS_HTONS / **/ -/*#define HAS_NTOHL / **/ -/*#define HAS_NTOHS / **/ +/* HAS_ILOGBL: + * This symbol, if defined, indicates that the ilogbl routine is + * available. If scalbnl is also present we can emulate frexpl. + */ +/*#define HAS_ILOGBL / **/ /* HAS_INT64_T: @@ -1839,10 +2555,4 @@ /*#define HAS_INT64_T / **/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -/*#define HAS_ISASCII / **/ - /* HAS_ISFINITE: * This symbol, if defined, indicates that the isfinite routine is @@ -1868,11 +2578,4 @@ */ /*#define HAS_ISNANL / **/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*#define HAS_LCHOWN / **/ /* HAS_LDBL_DIG: @@ -1884,52 +2587,4 @@ /*#define HAS_LDBL_DIG / * */ -/* HAS_LOCALTIME_R: - * This symbol, if defined, indicates that the localtime_r routine - * is available to localtime re-entrantly. - */ -/* LOCALTIME_R_PROTO: - * This symbol encodes the prototype of localtime_r. - * It is zero if d_localtime_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r - * is defined. - */ -/*#define HAS_LOCALTIME_R / **/ -#define LOCALTIME_R_PROTO 0 /**/ - -/* HAS_LONG_DOUBLE: - * This symbol will be defined if the C compiler supports long - * doubles. - */ -/* LONG_DOUBLESIZE: - * This symbol contains the size of a long double, so that the - * C preprocessor can make decisions based on it. It is only - * defined if the system supports long doubles. - */ -/*#define HAS_LONG_DOUBLE / **/ -#ifdef HAS_LONG_DOUBLE -#define LONG_DOUBLESIZE 8 /**/ -#endif - -/* HAS_LONG_LONG: - * This symbol will be defined if the C compiler supports long long. - */ -/* LONGLONGSIZE: - * This symbol contains the size of a long long, so that the - * C preprocessor can make decisions based on it. It is only - * defined if the system supports long long. - */ -/*#define HAS_LONG_LONG / **/ -#ifdef HAS_LONG_LONG -#define LONGLONGSIZE 8 /**/ -#endif - -/* HAS_LSEEK_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the lseek() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern off_t lseek(int, off_t, int); - */ -/*#define HAS_LSEEK_PROTO / **/ - /* HAS_MADVISE: * This symbol, if defined, indicates that the madvise system call is @@ -1938,10 +2593,4 @@ /*#define HAS_MADVISE / **/ -/* HAS_MEMCHR: - * This symbol, if defined, indicates that the memchr routine is available - * to locate characters within a C string. - */ -/*#define HAS_MEMCHR / **/ - /* HAS_MKDTEMP: * This symbol, if defined, indicates that the mkdtemp routine is @@ -1949,11 +2598,4 @@ */ /*#define HAS_MKDTEMP / **/ - -/* HAS_MKSTEMP: - * This symbol, if defined, indicates that the mkstemp routine is - * available to exclusively create and open a uniquely named - * temporary file. - */ -/*#define HAS_MKSTEMP / **/ /* HAS_MKSTEMPS: @@ -1964,20 +2606,13 @@ /*#define HAS_MKSTEMPS / **/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. - */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. - */ -/*#define HAS_MMAP / **/ -#define Mmap_t /**/ - /* HAS_MODFL: * This symbol, if defined, indicates that the modfl routine is * available to split a long double x into a fractional part f and * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +/* HAS_MODFL_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the modfl() function. Otherwise, it is up + * to the program to supply one. */ /* HAS_MODFL_POW32_BUG: @@ -1989,4 +2624,5 @@ */ /*#define HAS_MODFL / **/ +/*#define HAS_MODFL_PROTO / **/ /*#define HAS_MODFL_POW32_BUG / **/ @@ -1997,10 +2633,4 @@ /*#define HAS_MPROTECT / **/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). - */ -/*#define HAS_MSG / **/ - /* HAS_STRUCT_MSGHDR: * This symbol, if defined, indicates that the struct msghdr @@ -2009,4 +2639,11 @@ /*#define HAS_STRUCT_MSGHDR / **/ +/* HAS_NL_LANGINFO: + * This symbol, if defined, indicates that the nl_langinfo routine is + * available to return local data. You will also need + * and therefore I_LANGINFO. + */ +/*#define HAS_NL_LANGINFO / **/ + /* HAS_OFF64_T: * This symbol will be defined if the C compiler supports off64_t. @@ -2014,64 +2651,24 @@ /*#define HAS_OFF64_T / **/ -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -/*#define HAS_OPEN3 / **/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD / **/ -#define SCHED_YIELD sched_yield() /**/ -/*#define HAS_SCHED_YIELD / **/ - -/* HAS_RANDOM_R: - * This symbol, if defined, indicates that the random_r routine - * is available to random re-entrantly. - */ -/* RANDOM_R_PROTO: - * This symbol encodes the prototype of random_r. - * It is zero if d_random_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r - * is defined. - */ -/*#define HAS_RANDOM_R / **/ -#define RANDOM_R_PROTO 0 /**/ - -/* HAS_READDIR_R: - * This symbol, if defined, indicates that the readdir_r routine - * is available to readdir re-entrantly. - */ -/* READDIR_R_PROTO: - * This symbol encodes the prototype of readdir_r. - * It is zero if d_readdir_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r - * is defined. - */ -/*#define HAS_READDIR_R / **/ -#define READDIR_R_PROTO 0 /**/ +/* HAS_PROCSELFEXE: + * This symbol is defined if PROCSELFEXE_PATH is a symlink + * to the absolute pathname of the executing program. + */ +/* PROCSELFEXE_PATH: + * If HAS_PROCSELFEXE is defined this symbol is the filename + * of the symbolic link pointing to the absolute pathname of + * the executing program. + */ +/*#define HAS_PROCSELFEXE / **/ +#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH) +#define PROCSELFEXE_PATH /**/ +#endif + +/* HAS_PTHREAD_ATTR_SETSCOPE: + * This symbol, if defined, indicates that the pthread_attr_setscope + * system call is available to set the contention scope attribute of + * a thread attribute object. + */ +/*#define HAS_PTHREAD_ATTR_SETSCOPE / **/ /* HAS_READV: @@ -2087,27 +2684,4 @@ */ /*#define HAS_RECVMSG / **/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Normally, you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_BCOPY / **/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. If you need to - * copy overlapping memory blocks, you should check HAS_MEMMOVE and - * use memmove() instead, if available. - */ -/*#define HAS_SAFE_MEMCPY / **/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -/*#define HAS_SANE_MEMCMP / **/ /* HAS_SBRK_PROTO: @@ -2120,9 +2694,9 @@ /*#define HAS_SBRK_PROTO / **/ -/* HAS_SEM: - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/*#define HAS_SEM / **/ +/* HAS_SCALBNL: + * This symbol, if defined, indicates that the scalbnl routine is + * available. If ilogbl is also present we can emulate frexpl. + */ +/*#define HAS_SCALBNL / **/ /* HAS_SENDMSG: @@ -2132,36 +2706,4 @@ /*#define HAS_SENDMSG / **/ -/* HAS_SETGRENT: - * This symbol, if defined, indicates that the setgrent routine is - * available for initializing sequential access of the group database. - */ -/*#define HAS_SETGRENT / **/ - -/* HAS_SETGRENT_R: - * This symbol, if defined, indicates that the setgrent_r routine - * is available to setgrent re-entrantly. - */ -/* SETGRENT_R_PROTO: - * This symbol encodes the prototype of setgrent_r. - * It is zero if d_setgrent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r - * is defined. - */ -/*#define HAS_SETGRENT_R / **/ -#define SETGRENT_R_PROTO 0 /**/ - -/* HAS_SETGROUPS: - * This symbol, if defined, indicates that the setgroups() routine is - * available to set the list of process groups. If unavailable, multiple - * groups are probably not supported. - */ -/*#define HAS_SETGROUPS / **/ - -/* HAS_SETHOSTENT: - * This symbol, if defined, indicates that the sethostent() routine is - * available. - */ -/*#define HAS_SETHOSTENT / **/ - /* HAS_SETITIMER: * This symbol, if defined, indicates that the setitimer routine is @@ -2170,28 +2712,4 @@ /*#define HAS_SETITIMER / **/ -/* HAS_SETNETENT: - * This symbol, if defined, indicates that the setnetent() routine is - * available. - */ -/*#define HAS_SETNETENT / **/ - -/* HAS_SETPROTOENT: - * This symbol, if defined, indicates that the setprotoent() routine is - * available. - */ -/*#define HAS_SETPROTOENT / **/ - -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -/* USE_BSD_SETPGRP: - * This symbol, if defined, indicates that setpgrp needs two - * arguments whereas USG one needs none. See also HAS_SETPGID - * for a POSIX interface. - */ -/*#define HAS_SETPGRP / **/ -/*#define USE_BSD_SETPGRP / **/ - /* HAS_SETPROCTITLE: * This symbol, if defined, indicates that the setproctitle routine is @@ -2200,36 +2718,4 @@ /*#define HAS_SETPROCTITLE / **/ -/* HAS_SETPWENT: - * This symbol, if defined, indicates that the setpwent routine is - * available for initializing sequential access of the passwd database. - */ -/*#define HAS_SETPWENT / **/ - -/* HAS_SETPWENT_R: - * This symbol, if defined, indicates that the setpwent_r routine - * is available to setpwent re-entrantly. - */ -/* SETPWENT_R_PROTO: - * This symbol encodes the prototype of setpwent_r. - * It is zero if d_setpwent_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r - * is defined. - */ -/*#define HAS_SETPWENT_R / **/ -#define SETPWENT_R_PROTO 0 /**/ - -/* HAS_SETSERVENT: - * This symbol, if defined, indicates that the setservent() routine is - * available. - */ -/*#define HAS_SETSERVENT / **/ - -/* HAS_SETVBUF: - * This symbol, if defined, indicates that the setvbuf routine is - * available to change buffering on an open stdio stream. - * to a line-buffered mode. - */ -/*#define HAS_SETVBUF / **/ - /* USE_SFIO: * This symbol, if defined, indicates that sfio should @@ -2238,93 +2724,24 @@ /*#define USE_SFIO / **/ -/* HAS_SHM: - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -/*#define HAS_SHM / **/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*#define HAS_SIGACTION / **/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*#define HAS_SIGSETJMP / **/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* HAS_SOCKET: - * This symbol, if defined, indicates that the BSD socket interface is - * supported. - */ -/* HAS_SOCKETPAIR: - * This symbol, if defined, indicates that the BSD socketpair() call is - * supported. - */ -/* HAS_MSG_CTRUNC: - * This symbol, if defined, indicates that the MSG_CTRUNC is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_DONTROUTE: - * This symbol, if defined, indicates that the MSG_DONTROUTE is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_OOB: - * This symbol, if defined, indicates that the MSG_OOB is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_PEEK: - * This symbol, if defined, indicates that the MSG_PEEK is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_PROXY: - * This symbol, if defined, indicates that the MSG_PROXY is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_SCM_RIGHTS: - * This symbol, if defined, indicates that the SCM_RIGHTS is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/*#define HAS_SOCKET / **/ -/*#define HAS_SOCKETPAIR / **/ -/*#define HAS_MSG_CTRUNC / **/ -/*#define HAS_MSG_DONTROUTE / **/ -/*#define HAS_MSG_OOB / **/ -/*#define HAS_MSG_PEEK / **/ -/*#define HAS_MSG_PROXY / **/ -/*#define HAS_SCM_RIGHTS / **/ +/* HAS_SIGPROCMASK: + * This symbol, if defined, indicates that the sigprocmask + * system call is available to examine or change the signal mask + * of the calling process. + */ +/*#define HAS_SIGPROCMASK / **/ + +/* HAS_SOCKATMARK: + * This symbol, if defined, indicates that the sockatmark routine is + * available to test whether a socket is at the out-of-band mark. + */ +/*#define HAS_SOCKATMARK / **/ + +/* HAS_SOCKATMARK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the sockatmark() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int sockatmark(int); + */ +/*#define HAS_SOCKATMARK_PROTO / **/ /* HAS_SOCKS5_INIT: @@ -2340,37 +2757,19 @@ /*#define HAS_SQRTL / **/ -/* HAS_SRAND48_R: - * This symbol, if defined, indicates that the srand48_r routine - * is available to srand48 re-entrantly. - */ -/* SRAND48_R_PROTO: - * This symbol encodes the prototype of srand48_r. - * It is zero if d_srand48_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r - * is defined. - */ -/*#define HAS_SRAND48_R / **/ -#define SRAND48_R_PROTO 0 /**/ - -/* HAS_SRANDOM_R: - * This symbol, if defined, indicates that the srandom_r routine - * is available to srandom re-entrantly. - */ -/* SRANDOM_R_PROTO: - * This symbol encodes the prototype of srandom_r. - * It is zero if d_srandom_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r - * is defined. - */ -/*#define HAS_SRANDOM_R / **/ -#define SRANDOM_R_PROTO 0 /**/ - -/* USE_STAT_BLOCKS: - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -#ifndef USE_STAT_BLOCKS -/*#define USE_STAT_BLOCKS / **/ -#endif +/* HAS_SETRESGID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresgid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresgid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESGID_PROTO / **/ + +/* HAS_SETRESUID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresuid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESUID_PROTO / **/ /* HAS_STRUCT_STATFS_F_FLAGS: @@ -2397,105 +2796,9 @@ /*#define HAS_FSTATVFS / **/ -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -/* STDIO_PTR_LVAL_SETS_CNT: - * This symbol is defined if using the FILE_ptr macro as an lvalue - * to increase the pointer by n has the side effect of decreasing the - * value of File_cnt(fp) by n. - */ -/* STDIO_PTR_LVAL_NOCHANGE_CNT: - * This symbol is defined if using the FILE_ptr macro as an lvalue - * to increase the pointer by n leaves File_cnt(fp) unchanged. - */ -/*#define USE_STDIO_PTR / **/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_IO_read_ptr) -/*#define STDIO_PTR_LVALUE / **/ -#define FILE_cnt(fp) ((fp)->_IO_read_end - (fp)->_IO_read_ptr) -/*#define STDIO_CNT_LVALUE / **/ -/*#define STDIO_PTR_LVAL_SETS_CNT / **/ -/*#define STDIO_PTR_LVAL_NOCHANGE_CNT / **/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -/*#define USE_STDIO_BASE / **/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_IO_read_base) -#define FILE_bufsiz(fp) ((fp)->_IO_read_end - (fp)->_IO_read_base) -#endif - -/* HAS_STRERROR: - * This symbol, if defined, indicates that the strerror routine is - * available to translate error numbers to strings. See the writeup - * of Strerror() in this file before you try to define your own. - */ -/* HAS_SYS_ERRLIST: - * This symbol, if defined, indicates that the sys_errlist array is - * available to translate error numbers to strings. The extern int - * sys_nerr gives the size of that table. - */ -/* Strerror: - * This preprocessor symbol is defined as a macro if strerror() is - * not available to translate error numbers to strings but sys_errlist[] - * array is there. - */ -/*#define HAS_STRERROR / **/ -/*#define HAS_SYS_ERRLIST / **/ -#define Strerror(e) strerror(e) - -/* HAS_STRERROR_R: - * This symbol, if defined, indicates that the strerror_r routine - * is available to strerror re-entrantly. - */ -/* STRERROR_R_PROTO: - * This symbol encodes the prototype of strerror_r. - * It is zero if d_strerror_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r - * is defined. - */ -/*#define HAS_STRERROR_R / **/ -#define STRERROR_R_PROTO 0 /**/ +/* HAS_STRFTIME: + * This symbol, if defined, indicates that the strftime routine is + * available to do time formatting. + */ +/*#define HAS_STRFTIME / **/ /* HAS_STRTOLD: @@ -2517,10 +2820,4 @@ /*#define HAS_STRTOQ / **/ -/* HAS_STRTOUL: - * This symbol, if defined, indicates that the strtoul routine is - * available to provide conversion of strings to unsigned long. - */ -/*#define HAS_STRTOUL / **/ - /* HAS_STRTOULL: * This symbol, if defined, indicates that the strtoull routine is @@ -2534,4 +2831,13 @@ */ /*#define HAS_STRTOUQ / **/ + +/* HAS_SYSCALL_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the syscall() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int syscall(int, ...); + * extern int syscall(long, ...); + */ +/*#define HAS_SYSCALL_PROTO / **/ /* HAS_TELLDIR_PROTO: @@ -2543,34 +2849,11 @@ /*#define HAS_TELLDIR_PROTO / **/ -/* HAS_TIME: - * This symbol, if defined, indicates that the time() routine exists. - */ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define HAS_TIME /**/ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -/*#define HAS_TIMES / **/ - -/* HAS_TMPNAM_R: - * This symbol, if defined, indicates that the tmpnam_r routine - * is available to tmpnam re-entrantly. - */ -/* TMPNAM_R_PROTO: - * This symbol encodes the prototype of tmpnam_r. - * It is zero if d_tmpnam_r is undef, and one of the - * REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r - * is defined. - */ -/*#define HAS_TMPNAM_R / **/ -#define TMPNAM_R_PROTO 0 /**/ +/* U32_ALIGNMENT_REQUIRED: + * This symbol, if defined, indicates that you must access + * character data through U32-aligned pointers. + */ +#ifndef U32_ALIGNMENT_REQUIRED +#define U32_ALIGNMENT_REQUIRED /**/ +#endif /* HAS_UALARM: @@ -2579,26 +2862,4 @@ */ /*#define HAS_UALARM / **/ - -/* HAS_UNION_SEMUN: - * This symbol, if defined, indicates that the union semun is - * defined by including . If not, the user code - * probably needs to define it as: - * union semun { - * int val; - * struct semid_ds *buf; - * unsigned short *array; - * } - */ -/* USE_SEMCTL_SEMUN: - * This symbol, if defined, indicates that union semun is - * used for semctl IPC_STAT. - */ -/* USE_SEMCTL_SEMID_DS: - * This symbol, if defined, indicates that struct semid_ds * is - * used for semctl IPC_STAT. - */ -/*#define HAS_UNION_SEMUN / **/ -/*#define USE_SEMCTL_SEMUN / **/ -/*#define USE_SEMCTL_SEMID_DS / **/ /* HAS_UNORDERED: @@ -2609,4 +2870,12 @@ /*#define HAS_UNORDERED / **/ +/* HAS_USLEEP_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the usleep() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int usleep(useconds_t); + */ +/*#define HAS_USLEEP_PROTO / **/ + /* HAS_USTAT: * This symbol, if defined, indicates that the ustat system call is @@ -2615,31 +2884,4 @@ /*#define HAS_USTAT / **/ -/* HAS_VFORK: - * This symbol, if defined, indicates that vfork() exists. - */ -/*#define HAS_VFORK / **/ - -/* Signal_t: - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return type of a signal handler. Thus, you can declare - * a signal handler using "Signal_t (*handler)()", and define the - * handler using "Signal_t handler(sig)". - */ -#define Signal_t int /* Signal handler's return type */ - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF / **/ - /* HAS_WRITEV: * This symbol, if defined, indicates that the writev routine is @@ -2653,16 +2895,4 @@ */ /*#define USE_DYNAMIC_LOADING / **/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC / **/ /* FFLUSH_NULL: @@ -2680,48 +2910,9 @@ /*#define FFLUSH_ALL / **/ -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t int /* File position type */ - -/* Gid_t_f: - * This symbol defines the format string used for printing a Gid_t. - */ -#define Gid_t_f "lu" /**/ - -/* Gid_t_sign: - * This symbol holds the signedess of a Gid_t. - * 1 for unsigned, -1 for signed. - */ -#define Gid_t_sign 1 /* GID sign */ - -/* Gid_t_size: - * This symbol holds the size of a Gid_t in bytes. - */ -#define Gid_t_size 4 /* GID size */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * gid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t int /* Type for getgid(), etc... */ - -/* Groups_t: - * This symbol holds the type used for the second argument to - * getgroups() and setgroups(). Usually, this is the same as - * gidtype (gid_t) , but sometimes it isn't. - * It can be int, ushort, gid_t, etc... - * It may be necessary to include to get any - * typedef'ed information. This is only required if you have - * getgroups() or setgroups().. - */ -#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) -#define Groups_t int /* Type for 2nd arg to [sg]etgroups() */ -#endif +/* I_CRYPT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_CRYPT / **/ /* DB_Prefix_t: @@ -2755,4 +2946,10 @@ #define DB_VERSION_PATCH_CFG /**/ +/* I_FP: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_FP / **/ + /* I_FP_CLASS: * This symbol, if defined, indicates that exists and @@ -2761,15 +2958,4 @@ /*#define I_FP_CLASS / **/ -/* I_GRP: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* GRPASSWD: - * This symbol, if defined, indicates to the C program that struct group - * in contains gr_passwd. - */ -/*#define I_GRP / **/ -/*#define GRPASSWD / **/ - /* I_IEEEFP: * This symbol, if defined, indicates that exists and @@ -2784,4 +2970,10 @@ /*#define I_INTTYPES / **/ +/* I_LANGINFO: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_LANGINFO / **/ + /* I_LIBUTIL: * This symbol, if defined, indicates that exists and @@ -2790,10 +2982,4 @@ /*#define I_LIBUTIL / **/ -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_MACH_CTHREADS / **/ - /* I_MNTENT: * This symbol, if defined, indicates that exists and @@ -2802,10 +2988,4 @@ /*#define I_MNTENT / **/ -/* I_NETDB: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_NETDB / **/ - /* I_NETINET_TCP: * This symbol, if defined, indicates to the C program that it should @@ -2826,56 +3006,4 @@ /*#define I_PROT / **/ -/* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_PTHREAD / **/ - -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_age. - */ -/* PWCHANGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_change. - */ -/* PWCLASS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_class. - */ -/* PWEXPIRE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_expire. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -/* PWGECOS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_gecos. - */ -/* PWPASSWD: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_passwd. - */ -/*#define I_PWD / **/ -/*#define PWQUOTA / **/ -/*#define PWAGE / **/ -/*#define PWCHANGE / **/ -/*#define PWCLASS / **/ -/*#define PWEXPIRE / **/ -/*#define PWCOMMENT / **/ -/*#define PWGECOS / **/ -/*#define PWPASSWD / **/ - /* I_SHADOW: * This symbol, if defined, indicates that exists and @@ -2925,10 +3053,4 @@ /*#define I_SYS_STATVFS / **/ -/* I_SYSUIO: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_SYSUIO / **/ - /* I_SYSUTSNAME: * This symbol, if defined, indicates that exists and @@ -2943,25 +3065,4 @@ /*#define I_SYS_VFS / **/ -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -/* HAS_TM_TM_ZONE: - * This symbol, if defined, indicates to the C program that - * the struct tm has a tm_zone field. - */ -#define I_TIME /**/ -/*#define I_SYS_TIME / **/ -/*#define I_SYS_TIME_KERNEL / **/ -/*#define HAS_TM_TM_ZONE / **/ - /* I_USTAT: * This symbol, if defined, indicates that exists and @@ -2969,19 +3070,4 @@ */ /*#define I_USTAT / **/ - -/* PERL_INC_VERSION_LIST: - * This variable specifies the list of subdirectories in over - * which perl.c:incpush() and lib/lib.pm will automatically - * search when adding directories to @INC, in a format suitable - * for a C initialization string. See the inc_version_list entry - * in Porting/Glossary for more details. - */ -#define PERL_INC_VERSION_LIST NULL /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL / **/ /* PERL_PRIfldbl: @@ -3005,69 +3091,4 @@ /*#define PERL_PRIeldbl "lle" / **/ /*#define PERL_SCNfldbl "llf" / **/ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -/* Off_t_size: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t int /* type */ -#define LSEEKSIZE 4 /* size */ -#define Off_t_size 4 /* size */ - -/* Free_t: - * This variable contains the return type of free(). It is usually - * void, but occasionally int. - */ -/* Malloc_t: - * This symbol is the type of pointer returned by malloc and realloc. - */ -#define Malloc_t void * /**/ -#define Free_t int /**/ - -/* MYMALLOC: - * This symbol, if defined, indicates that we're using our own malloc. - */ -/*#define MYMALLOC / **/ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t int /* file mode parameter for system calls */ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#undef EOF_NONBLOCK /* NEED_VA_COPY: @@ -3081,35 +3102,4 @@ */ /*#define NEED_VA_COPY / **/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t const char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t const char * /**/ -#define Netdb_net_t unsigned long /**/ - -/* PERL_OTHERLIBDIRS: - * This variable contains a colon-separated set of paths for the perl - * binary to search for additional library files or modules. - * These directories will be tacked to the end of @INC. - * Perl will automatically search below each path for version- - * and architecture-specific directories. See PERL_INC_VERSION_LIST - * for more details. - */ -/*#define PERL_OTHERLIBDIRS "" / **/ /* IVTYPE: @@ -3257,57 +3247,4 @@ #define NVgf "g" /**/ -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t int /* PID type */ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "/usr/local/lib/perl5/5.7" /**/ -#define PRIVLIB_EXP "/usr/local/lib/perl5/5.7" /**/ - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 4 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in its headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15)) /**/ -#define Rand_seed_t int /**/ -#define seedDrand01(x) srand((Rand_seed_t)x) /**/ -#define RANDBITS 48 /**/ - /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. @@ -3319,119 +3256,4 @@ #define SELECT_MIN_BITS 32 /**/ -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t int /**/ - -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -/* SIG_SIZE: - * This variable contains the number of elements of the sig_name - * and sig_num arrays, excluding the final NULL entry. - */ -#define SIG_NAME 0 /**/ -#define SIG_NUM 0 /**/ -#define SIG_SIZE 1 /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-dependent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "" /**/ -#define SITEARCH_EXP "" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * After perl has been installed, users may install their own local - * architecture-independent modules in this directory with - * MakeMaker Makefile.PL - * or equivalent. See INSTALL for details. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/* SITELIB_STEM: - * This define is SITELIB_EXP with any trailing version-specific component - * removed. The elements in inc_version_list (inc_version_list.U) can - * be tacked onto this variable to generate a list of directories to search. - */ -#define SITELIB "" /**/ -#define SITELIB_EXP "" /**/ -#define SITELIB_STEM "" /**/ - -/* Size_t_size: - * This symbol holds the size of a Size_t in bytes. - */ -#define Size_t_size 4 /* */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. - */ -#define Size_t int /* length paramater for string functions */ - -/* Sock_size_t: - * This symbol holds the type used for the size argument of - * various socket calls (just the base type, not the pointer-to). - */ -#define Sock_size_t int /**/ - -/* SSize_t: - * This symbol holds the type used by functions that return - * a count of bytes or an error condition. It must be a signed type. - * It is usually ssize_t, but may be long or int, etc. - * It may be necessary to include or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t int /* signed count of bytes */ - /* STARTPERL: * This variable contains the string to put in front of a perl @@ -3441,10 +3263,4 @@ #define STARTPERL "" /**/ -/* STDCHAR: - * This symbol is defined to be the type of char used in stdio.h. - * It has the values "unsigned char" or "char". - */ -#define STDCHAR char /**/ - /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array @@ -3457,27 +3273,4 @@ /*#define HAS_STDIO_STREAM_ARRAY / **/ #define STDIO_STREAM_ARRAY - -/* Uid_t_f: - * This symbol defines the format string used for printing a Uid_t. - */ -#define Uid_t_f "lu" /**/ - -/* Uid_t_sign: - * This symbol holds the signedess of a Uid_t. - * 1 for unsigned, -1 for signed. - */ -#define Uid_t_sign 1 /* UID sign */ - -/* Uid_t_size: - * This symbol holds the size of a Uid_t in bytes. - */ -#define Uid_t_size 4 /* UID size */ - -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Uid_t int /* UID type */ /* USE_64_BIT_INT: @@ -3507,4 +3300,13 @@ #endif +/* USE_FAST_STDIO: + * This symbol, if defined, indicates that Perl should + * be built to use 'fast stdio'. + * Defaults to define in Perls 5.8 and earlier, to undef later. + */ +#ifndef USE_FAST_STDIO +/*#define USE_FAST_STDIO / **/ +#endif + /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support @@ -3554,84 +3356,4 @@ #ifndef USE_SOCKS /*#define USE_SOCKS / **/ -#endif - -/* USE_ITHREADS: - * This symbol, if defined, indicates that Perl should be built to - * use the interpreter-based threading implementation. - */ -/* USE_5005THREADS: - * This symbol, if defined, indicates that Perl should be built to - * use the 5.005-based threading implementation. - */ -/* OLD_PTHREADS_API: - * This symbol, if defined, indicates that Perl should - * be built to use the old draft POSIX threads API. - */ -/* USE_REENTRANT_API: - * This symbol, if defined, indicates that Perl should - * try to use the various _r versions of library functions. - * This is extremely experimental. - */ -/*#define USE_5005THREADS / **/ -/*#define USE_ITHREADS / **/ -#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) -#define USE_THREADS /* until src is revised*/ -#endif -/*#define OLD_PTHREADS_API / **/ -/*#define USE_REENTRANT_API / **/ - -/* PERL_VENDORARCH: - * If defined, this symbol contains the name of a private library. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. - * It may have a ~ on the front. - * The standard distribution will put nothing in this directory. - * Vendors who distribute perl may wish to place their own - * architecture-dependent modules and extensions in this directory with - * MakeMaker Makefile.PL INSTALLDIRS=vendor - * or equivalent. See INSTALL for details. - */ -/* PERL_VENDORARCH_EXP: - * This symbol contains the ~name expanded version of PERL_VENDORARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define PERL_VENDORARCH "" / **/ -/*#define PERL_VENDORARCH_EXP "" / **/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/* PERL_VENDORLIB_STEM: - * This define is PERL_VENDORLIB_EXP with any trailing version-specific component - * removed. The elements in inc_version_list (inc_version_list.U) can - * be tacked onto this variable to generate a list of directories to search. - */ -/*#define PERL_VENDORLIB_EXP "" / **/ -/*#define PERL_VENDORLIB_STEM "" / **/ - -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED 1 -#endif -#define VOIDFLAGS 1 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ #endif @@ -3671,246 +3393,120 @@ #define PERL_PM_APIVERSION "5.005" -/* HAS_CRYPT: - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -/*#define HAS_CRYPT / **/ - -/* SETUID_SCRIPTS_ARE_SECURE_NOW: - * This symbol, if defined, indicates that the bug that prevents - * setuid scripts from being secure is not present in this kernel. - */ -/* DOSUID: - * This symbol, if defined, indicates that the C program should - * check the script that it is executing for setuid/setgid bits, and - * attempt to emulate setuid/setgid on systems that have disabled - * setuid #! scripts because the kernel can't do it securely. - * It is up to the package designer to make sure that this emulation - * is done securely. Among other things, it should do an fstat on - * the script it just opened to make sure it really is a setuid/setgid - * script, it should make sure the arguments passed correspond exactly - * to the argument on the #! line, and it should not trust any - * subprocesses to which it must pass the filename rather than the - * file descriptor of the script to be executed. - */ -/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/ -/*#define DOSUID / **/ - -/* Shmat_t: - * This symbol holds the return type of the shmat() system call. - * Usually set to 'void *' or 'char *'. - */ -/* HAS_SHMAT_PROTOTYPE: - * This symbol, if defined, indicates that the sys/shm.h includes - * a prototype for shmat(). Otherwise, it is up to the program to - * guess one. Shmat_t shmat(int, Shmat_t, int) is a good guess, - * but not always right so it should be emitted by the program only - * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. - */ -#define Shmat_t void * /**/ -/*#define HAS_SHMAT_PROTOTYPE / **/ - -/* I_NDBM: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/*#define I_NDBM / **/ - -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/* I_VARARGS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_STDARG /**/ -/*#define I_VARARGS / **/ - -/* CAN_PROTOTYPE: - * If defined, this macro indicates that the C compiler can handle - * function prototypes. - */ -/* _: - * This macro is used to declare function parameters for folks who want - * to make declarations with prototypes using a different style than - * the above macros. Use double parentheses. For example: - * - * int main _((int argc, char *argv[])); - */ -/*#define CAN_PROTOTYPE / **/ -#ifdef CAN_PROTOTYPE -#define _(args) args -#else -#define _(args) () -#endif - -/* SH_PATH: - * This symbol contains the full pathname to the shell used on this - * on this system to execute Bourne shell scripts. Usually, this will be - * /bin/sh, though it's possible that some systems will have /bin/ksh, - * /bin/pdksh, /bin/ash, /bin/bash, or even something such as - * D:/bin/sh.exe. - */ -#define SH_PATH "" /**/ - -/* USE_CROSS_COMPILE: - * This symbol, if defined, indicates that Perl is being cross-compiled. - */ -/* PERL_TARGETARCH: - * This symbol, if defined, indicates the target architecture - * Perl has been cross-compiled to. Undefined if not a cross-compile. - */ -#ifndef USE_CROSS_COMPILE -/*#define USE_CROSS_COMPILE / **/ -#define PERL_TARGETARCH "" /**/ -#endif - -/* HAS_DBMINIT_PROTO: +/* HAS_DRAND48_PROTO: * This symbol, if defined, indicates that the system provides - * a prototype for the dbminit() function. Otherwise, it is up + * a prototype for the drand48() function. Otherwise, it is up * to the program to supply one. A good guess is - * extern int dbminit(char *); - */ -/*#define HAS_DBMINIT_PROTO / **/ - -/* HAS_DIRFD: - * This manifest constant lets the C program know that dirfd - * is available. - */ -/*#define HAS_DIRFD / **/ - -/* HAS_FLOCK_PROTO: + * extern double drand48(void); + */ +/*#define HAS_DRAND48_PROTO / **/ + +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETHOST_PROTOS / **/ + +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETNET_PROTOS / **/ + +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETPROTO_PROTOS / **/ + +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETSERV_PROTOS / **/ + +/* HAS_LSEEK_PROTO: * This symbol, if defined, indicates that the system provides - * a prototype for the flock() function. Otherwise, it is up + * a prototype for the lseek() function. Otherwise, it is up * to the program to supply one. A good guess is - * extern int flock(int, int); - */ -/*#define HAS_FLOCK_PROTO / **/ - -/* HAS_FPCLASSL: - * This symbol, if defined, indicates that the fpclassl routine is - * available to classify long doubles. Available for example in IRIX. - * The returned values are defined in and are: - * - * FP_SNAN signaling NaN - * FP_QNAN quiet NaN - * FP_NINF negative infinity - * FP_PINF positive infinity - * FP_NDENORM negative denormalized non-zero - * FP_PDENORM positive denormalized non-zero - * FP_NZERO negative zero - * FP_PZERO positive zero - * FP_NNORM negative normalized non-zero - * FP_PNORM positive normalized non-zero - */ -/*#define HAS_FPCLASSL / **/ - -/* HAS_NL_LANGINFO: - * This symbol, if defined, indicates that the nl_langinfo routine is - * available to return local data. You will also need - * and therefore I_LANGINFO. - */ -/*#define HAS_NL_LANGINFO / **/ - -/* HAS_PROCSELFEXE: - * This symbol is defined if PROCSELFEXE_PATH is a symlink - * to the absolute pathname of the executing program. - */ -/* PROCSELFEXE_PATH: - * If HAS_PROCSELFEXE is defined this symbol is the filename - * of the symbolic link pointing to the absolute pathname of - * the executing program. - */ -/*#define HAS_PROCSELFEXE / **/ -#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH) -#define PROCSELFEXE_PATH /**/ -#endif - -/* HAS_SIGPROCMASK: - * This symbol, if defined, indicates that the sigprocmask - * system call is available to examine or change the signal mask - * of the calling process. - */ -/*#define HAS_SIGPROCMASK / **/ - -/* HAS_SOCKATMARK: - * This symbol, if defined, indicates that the sockatmark routine is - * available to test whether a socket is at the out-of-band mark. - */ -/*#define HAS_SOCKATMARK / **/ - -/* HAS_SOCKATMARK_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the sockatmark() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern int sockatmark(int); - */ -/*#define HAS_SOCKATMARK_PROTO / **/ - -/* HAS_SETRESGID_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the setresgid() function. Otherwise, it is up - * to the program to supply one. Good guesses are - * extern int setresgid(uid_t ruid, uid_t euid, uid_t suid); - */ -/*#define HAS_SETRESGID_PROTO / **/ - -/* HAS_SETRESUID_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the setresuid() function. Otherwise, it is up - * to the program to supply one. Good guesses are - * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); - */ -/*#define HAS_SETRESUID_PROTO / **/ - -/* HAS_STRFTIME: - * This symbol, if defined, indicates that the strftime routine is - * available to do time formatting. - */ -/*#define HAS_STRFTIME / **/ - -/* HAS_SYSCALL_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the syscall() function. Otherwise, it is up - * to the program to supply one. Good guesses are - * extern int syscall(int, ...); - * extern int syscall(long, ...); - */ -/*#define HAS_SYSCALL_PROTO / **/ - -/* U32_ALIGNMENT_REQUIRED: - * This symbol, if defined, indicates that you must access - * character data through U32-aligned pointers. - */ -#ifndef U32_ALIGNMENT_REQUIRED -#define U32_ALIGNMENT_REQUIRED /**/ -#endif - -/* HAS_USLEEP_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the usleep() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern int usleep(useconds_t); - */ -/*#define HAS_USLEEP_PROTO / **/ - -/* I_CRYPT: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_CRYPT / **/ - -/* I_FP: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_FP / **/ - -/* I_LANGINFO: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_LANGINFO / **/ + * extern off_t lseek(int, off_t, int); + */ +/*#define HAS_LSEEK_PROTO / **/ + +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). + */ +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). + */ +#define Netdb_host_t const char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t const char * /**/ +#define Netdb_net_t unsigned long /**/ + +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t int /**/ + +/* Sock_size_t: + * This symbol holds the type used for the size argument of + * various socket calls (just the base type, not the pointer-to). + */ +#define Sock_size_t int /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "unknown" /**/ + +/* HAS_ASCTIME_R: + * This symbol, if defined, indicates that the asctime_r routine + * is available to asctime re-entrantly. + */ +/* ASCTIME_R_PROTO: + * This symbol encodes the prototype of asctime_r. + * It is zero if d_asctime_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r + * is defined. + */ +/*#define HAS_ASCTIME_R / **/ +#define ASCTIME_R_PROTO 0 /**/ + +/* HAS_CRYPT_R: + * This symbol, if defined, indicates that the crypt_r routine + * is available to crypt re-entrantly. + */ +/* CRYPT_R_PROTO: + * This symbol encodes the prototype of crypt_r. + * It is zero if d_crypt_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r + * is defined. + */ +/*#define HAS_CRYPT_R / **/ +#define CRYPT_R_PROTO 0 /**/ /* HAS_CTERMID_R: @@ -3927,4 +3523,43 @@ #define CTERMID_R_PROTO 0 /**/ +/* HAS_CTIME_R: + * This symbol, if defined, indicates that the ctime_r routine + * is available to ctime re-entrantly. + */ +/* CTIME_R_PROTO: + * This symbol encodes the prototype of ctime_r. + * It is zero if d_ctime_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r + * is defined. + */ +/*#define HAS_CTIME_R / **/ +#define CTIME_R_PROTO 0 /**/ + +/* HAS_DRAND48_R: + * This symbol, if defined, indicates that the drand48_r routine + * is available to drand48 re-entrantly. + */ +/* DRAND48_R_PROTO: + * This symbol encodes the prototype of drand48_r. + * It is zero if d_drand48_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r + * is defined. + */ +/*#define HAS_DRAND48_R / **/ +#define DRAND48_R_PROTO 0 /**/ + +/* HAS_ENDGRENT_R: + * This symbol, if defined, indicates that the endgrent_r routine + * is available to endgrent re-entrantly. + */ +/* ENDGRENT_R_PROTO: + * This symbol encodes the prototype of endgrent_r. + * It is zero if d_endgrent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r + * is defined. + */ +/*#define HAS_ENDGRENT_R / **/ +#define ENDGRENT_R_PROTO 0 /**/ + /* HAS_ENDHOSTENT_R: * This symbol, if defined, indicates that the endhostent_r routine @@ -3966,4 +3601,17 @@ #define ENDPROTOENT_R_PROTO 0 /**/ +/* HAS_ENDPWENT_R: + * This symbol, if defined, indicates that the endpwent_r routine + * is available to endpwent re-entrantly. + */ +/* ENDPWENT_R_PROTO: + * This symbol encodes the prototype of endpwent_r. + * It is zero if d_endpwent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r + * is defined. + */ +/*#define HAS_ENDPWENT_R / **/ +#define ENDPWENT_R_PROTO 0 /**/ + /* HAS_ENDSERVENT_R: * This symbol, if defined, indicates that the endservent_r routine @@ -3979,4 +3627,43 @@ #define ENDSERVENT_R_PROTO 0 /**/ +/* HAS_GETGRENT_R: + * This symbol, if defined, indicates that the getgrent_r routine + * is available to getgrent re-entrantly. + */ +/* GETGRENT_R_PROTO: + * This symbol encodes the prototype of getgrent_r. + * It is zero if d_getgrent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r + * is defined. + */ +/*#define HAS_GETGRENT_R / **/ +#define GETGRENT_R_PROTO 0 /**/ + +/* HAS_GETGRGID_R: + * This symbol, if defined, indicates that the getgrgid_r routine + * is available to getgrgid re-entrantly. + */ +/* GETGRGID_R_PROTO: + * This symbol encodes the prototype of getgrgid_r. + * It is zero if d_getgrgid_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r + * is defined. + */ +/*#define HAS_GETGRGID_R / **/ +#define GETGRGID_R_PROTO 0 /**/ + +/* HAS_GETGRNAM_R: + * This symbol, if defined, indicates that the getgrnam_r routine + * is available to getgrnam re-entrantly. + */ +/* GETGRNAM_R_PROTO: + * This symbol encodes the prototype of getgrnam_r. + * It is zero if d_getgrnam_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r + * is defined. + */ +/*#define HAS_GETGRNAM_R / **/ +#define GETGRNAM_R_PROTO 0 /**/ + /* HAS_GETHOSTBYADDR_R: * This symbol, if defined, indicates that the gethostbyaddr_r routine @@ -4018,4 +3705,17 @@ #define GETHOSTENT_R_PROTO 0 /**/ +/* HAS_GETLOGIN_R: + * This symbol, if defined, indicates that the getlogin_r routine + * is available to getlogin re-entrantly. + */ +/* GETLOGIN_R_PROTO: + * This symbol encodes the prototype of getlogin_r. + * It is zero if d_getlogin_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r + * is defined. + */ +/*#define HAS_GETLOGIN_R / **/ +#define GETLOGIN_R_PROTO 0 /**/ + /* HAS_GETNETBYADDR_R: * This symbol, if defined, indicates that the getnetbyaddr_r routine @@ -4096,4 +3796,43 @@ #define GETPROTOENT_R_PROTO 0 /**/ +/* HAS_GETPWENT_R: + * This symbol, if defined, indicates that the getpwent_r routine + * is available to getpwent re-entrantly. + */ +/* GETPWENT_R_PROTO: + * This symbol encodes the prototype of getpwent_r. + * It is zero if d_getpwent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r + * is defined. + */ +/*#define HAS_GETPWENT_R / **/ +#define GETPWENT_R_PROTO 0 /**/ + +/* HAS_GETPWNAM_R: + * This symbol, if defined, indicates that the getpwnam_r routine + * is available to getpwnam re-entrantly. + */ +/* GETPWNAM_R_PROTO: + * This symbol encodes the prototype of getpwnam_r. + * It is zero if d_getpwnam_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r + * is defined. + */ +/*#define HAS_GETPWNAM_R / **/ +#define GETPWNAM_R_PROTO 0 /**/ + +/* HAS_GETPWUID_R: + * This symbol, if defined, indicates that the getpwuid_r routine + * is available to getpwuid re-entrantly. + */ +/* GETPWUID_R_PROTO: + * This symbol encodes the prototype of getpwuid_r. + * It is zero if d_getpwuid_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r + * is defined. + */ +/*#define HAS_GETPWUID_R / **/ +#define GETPWUID_R_PROTO 0 /**/ + /* HAS_GETSERVBYNAME_R: * This symbol, if defined, indicates that the getservbyname_r routine @@ -4135,9 +3874,90 @@ #define GETSERVENT_R_PROTO 0 /**/ +/* HAS_GETSPNAM_R: + * This symbol, if defined, indicates that the getspnam_r routine + * is available to getspnam re-entrantly. + */ +/* GETSPNAM_R_PROTO: + * This symbol encodes the prototype of getspnam_r. + * It is zero if d_getspnam_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r + * is defined. + */ +/*#define HAS_GETSPNAM_R / **/ +#define GETSPNAM_R_PROTO 0 /**/ + +/* HAS_GMTIME_R: + * This symbol, if defined, indicates that the gmtime_r routine + * is available to gmtime re-entrantly. + */ +/* GMTIME_R_PROTO: + * This symbol encodes the prototype of gmtime_r. + * It is zero if d_gmtime_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r + * is defined. + */ +/*#define HAS_GMTIME_R / **/ +#define GMTIME_R_PROTO 0 /**/ + +/* HAS_LOCALTIME_R: + * This symbol, if defined, indicates that the localtime_r routine + * is available to localtime re-entrantly. + */ +/* LOCALTIME_R_PROTO: + * This symbol encodes the prototype of localtime_r. + * It is zero if d_localtime_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r + * is defined. + */ +/*#define HAS_LOCALTIME_R / **/ +#define LOCALTIME_R_PROTO 0 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ + /* HAS_PTHREAD_ATFORK: * This symbol, if defined, indicates that the pthread_atfork routine - * is available setup fork handlers. + * is available to setup fork handlers. */ /*#define HAS_PTHREAD_ATFORK / **/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/*#define HAS_PTHREAD_YIELD / **/ +#define SCHED_YIELD sched_yield() /**/ +/*#define HAS_SCHED_YIELD / **/ + +/* HAS_RANDOM_R: + * This symbol, if defined, indicates that the random_r routine + * is available to random re-entrantly. + */ +/* RANDOM_R_PROTO: + * This symbol encodes the prototype of random_r. + * It is zero if d_random_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r + * is defined. + */ +/*#define HAS_RANDOM_R / **/ +#define RANDOM_R_PROTO 0 /**/ /* HAS_READDIR64_R: @@ -4154,4 +3974,30 @@ #define READDIR64_R_PROTO 0 /**/ +/* HAS_READDIR_R: + * This symbol, if defined, indicates that the readdir_r routine + * is available to readdir re-entrantly. + */ +/* READDIR_R_PROTO: + * This symbol encodes the prototype of readdir_r. + * It is zero if d_readdir_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r + * is defined. + */ +/*#define HAS_READDIR_R / **/ +#define READDIR_R_PROTO 0 /**/ + +/* HAS_SETGRENT_R: + * This symbol, if defined, indicates that the setgrent_r routine + * is available to setgrent re-entrantly. + */ +/* SETGRENT_R_PROTO: + * This symbol encodes the prototype of setgrent_r. + * It is zero if d_setgrent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r + * is defined. + */ +/*#define HAS_SETGRENT_R / **/ +#define SETGRENT_R_PROTO 0 /**/ + /* HAS_SETHOSTENT_R: * This symbol, if defined, indicates that the sethostent_r routine @@ -4206,4 +4052,17 @@ #define SETPROTOENT_R_PROTO 0 /**/ +/* HAS_SETPWENT_R: + * This symbol, if defined, indicates that the setpwent_r routine + * is available to setpwent re-entrantly. + */ +/* SETPWENT_R_PROTO: + * This symbol encodes the prototype of setpwent_r. + * It is zero if d_setpwent_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r + * is defined. + */ +/*#define HAS_SETPWENT_R / **/ +#define SETPWENT_R_PROTO 0 /**/ + /* HAS_SETSERVENT_R: * This symbol, if defined, indicates that the setservent_r routine @@ -4219,4 +4078,56 @@ #define SETSERVENT_R_PROTO 0 /**/ +/* HAS_SRAND48_R: + * This symbol, if defined, indicates that the srand48_r routine + * is available to srand48 re-entrantly. + */ +/* SRAND48_R_PROTO: + * This symbol encodes the prototype of srand48_r. + * It is zero if d_srand48_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r + * is defined. + */ +/*#define HAS_SRAND48_R / **/ +#define SRAND48_R_PROTO 0 /**/ + +/* HAS_SRANDOM_R: + * This symbol, if defined, indicates that the srandom_r routine + * is available to srandom re-entrantly. + */ +/* SRANDOM_R_PROTO: + * This symbol encodes the prototype of srandom_r. + * It is zero if d_srandom_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r + * is defined. + */ +/*#define HAS_SRANDOM_R / **/ +#define SRANDOM_R_PROTO 0 /**/ + +/* HAS_STRERROR_R: + * This symbol, if defined, indicates that the strerror_r routine + * is available to strerror re-entrantly. + */ +/* STRERROR_R_PROTO: + * This symbol encodes the prototype of strerror_r. + * It is zero if d_strerror_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r + * is defined. + */ +/*#define HAS_STRERROR_R / **/ +#define STRERROR_R_PROTO 0 /**/ + +/* HAS_TMPNAM_R: + * This symbol, if defined, indicates that the tmpnam_r routine + * is available to tmpnam re-entrantly. + */ +/* TMPNAM_R_PROTO: + * This symbol encodes the prototype of tmpnam_r. + * It is zero if d_tmpnam_r is undef, and one of the + * REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r + * is defined. + */ +/*#define HAS_TMPNAM_R / **/ +#define TMPNAM_R_PROTO 0 /**/ + /* HAS_TTYNAME_R: * This symbol, if defined, indicates that the ttyname_r routine @@ -4232,3 +4143,156 @@ #define TTYNAME_R_PROTO 0 /**/ +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_MACH_CTHREADS / **/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_PTHREAD / **/ + +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. + */ +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. + */ +/* OLD_PTHREADS_API: + * This symbol, if defined, indicates that Perl should + * be built to use the old draft POSIX threads API. + */ +/* USE_REENTRANT_API: + * This symbol, if defined, indicates that Perl should + * try to use the various _r versions of library functions. + * This is extremely experimental. + */ +/*#define USE_5005THREADS / **/ +/*#define USE_ITHREADS / **/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ #endif +/*#define OLD_PTHREADS_API / **/ +/*#define USE_REENTRANT_API / **/ + +/* HAS_TIME: + * This symbol, if defined, indicates that the time() routine exists. + */ +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define HAS_TIME /**/ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +/*#define HAS_TIMES / **/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t int /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "lu" /**/ + +/* Gid_t_sign: + * This symbol holds the signedess of a Gid_t. + * 1 for unsigned, -1 for signed. + */ +#define Gid_t_sign 1 /* GID sign */ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * gid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t int /* Type for getgid(), etc... */ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t int /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. + */ +#define Mode_t int /* file mode parameter for system calls */ + +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Pid_t int /* PID type */ + +/* Size_t_size: + * This symbol holds the size of a Size_t in bytes. + */ +#define Size_t_size 4 /* */ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. + */ +#define Size_t int /* length paramater for string functions */ + +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. + */ +#define Uid_t_f "lu" /**/ + +/* Uid_t_sign: + * This symbol holds the signedess of a Uid_t. + * 1 for unsigned, -1 for signed. + */ +#define Uid_t_sign 1 /* UID sign */ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t int /* UID type */ + +#endif Index: /branches/vendor/third/perl/README.dos =================================================================== --- /branches/vendor/third/perl/README.dos (revision 18449) +++ /branches/vendor/third/perl/README.dos (revision 20074) @@ -314,5 +314,5 @@ When you are done, the XS-module install process will have added information to your "perllocal" information telling that the perl binary has been replaced, -and what module was installed. you can view this information at any time +and what module was installed. You can view this information at any time by using the command: Index: /branches/vendor/third/perl/mpeix/mpeix.c =================================================================== --- /branches/vendor/third/perl/mpeix/mpeix.c (revision 18449) +++ /branches/vendor/third/perl/mpeix/mpeix.c (revision 20074) @@ -43,8 +43,8 @@ * Refer to the gcc documentation or http://www.dis.com/gnu/gcc_toc.html */ - asm volatile ( - "comiclr,= 0,%1,%%r28; - ldsid (%%r0,%1),%%r28; - stw %%r28, %0" + __asm__ __volatile__ ( + " comiclr,= 0,%1,%%r28\n" + "\t ldsid (%%r0,%1),%%r28\n" + "\t stw %%r28, %0" : "=m" (val) // Output to val : "r" (source) // Source must be gen reg @@ -60,9 +60,9 @@ */ - asm volatile ( - "comiclr,= 0,%2,%%r28; - ldsid (%%r0,%2),%%r28; - stw %%r28, %0; - stw %2, %1" + __asm__ __volatile__ ( + " comiclr,= 0,%2,%%r28\n" + "\t ldsid (%%r0,%2),%%r28\n" + "\t stw %%r28, %0\n" + "\t stw %2, %1" : "=m" (lptr.spaceid), "=m" (lptr.offset) // Store to lptr @@ -80,7 +80,7 @@ */ - asm volatile ( - "copy %0,%%r28; // copy space to r28 - add %1,%2,%%r29" // Increment the pointer + __asm__ __volatile__ ( + " copy %0,%%r28\n" // copy space to r28 + "\t add %1,%2,%%r29" // Increment the pointer : // No output : "r" (source.spaceid), // Source address @@ -99,12 +99,12 @@ */ - asm volatile ( - ".import $$lr_unk_unk_long,MILLICODE; - mtsp %0,%%sr1; // copy source space to sr1 - copy %1,%%r26; // load source offset to r26 - copy %4,%%r24; // load length to r24 - copy %3,%%r25; // load target offset to r25 - bl $$lr_unk_unk_long,%%r31; // start branch to millicode - mtsp %2,%%sr2" // copy target space to sr2 + __asm__ __volatile__ ( + " .import $$lr_unk_unk_long,MILLICODE\n" + "\t mtsp %0,%%sr1\n" // copy source space to sr1 + "\t copy %1,%%r26\n" // load source offset to r26 + "\t copy %4,%%r24\n" // load length to r24 + "\t copy %3,%%r25\n" // load target offset to r25 + "\t bl $$lr_unk_unk_long,%%r31\n" // start branch to millicode + "\t mtsp %2,%%sr2" // copy target space to sr2 : // No output : "r" (source.spaceid), // Source address @@ -127,9 +127,9 @@ unsigned int val; - asm volatile ( - "mtsp %1, %%sr1; - copy %2, %%r28; - ldw 0(%%sr1, %%r28), %%r28; - stw %%r28, %0" + __asm__ __volatile__ ( + " mtsp %1, %%sr1\n" + "\t copy %2, %%r28\n" + "\t ldw 0(%%sr1, %%r28), %%r28\n" + "\t stw %%r28, %0" : "=m" (val) // Output val : "r" (source.spaceid), // Source space ID @@ -146,8 +146,8 @@ * Store the val into long pointer space. */ - asm volatile ( - "mtsp %0,%%sr1; - copy %1, %%r28; - stw %2, 0(%%sr1, %%r28)" + __asm__ __volatile__ ( + " mtsp %0,%%sr1\n" + "\t copy %1, %%r28\n" + "\t stw %2, 0(%%sr1, %%r28)" : // No output : "r" (target.spaceid), // Target space ID @@ -165,10 +165,10 @@ * Move using short pointers. */ - asm volatile ( - ".import $$lr_unk_unk,MILLICODE; - copy %1, %%r26; // Move source addr into pos - copy %2, %%r25; // Move target addr into pos - bl $$lr_unk_unk,%%r31; // Start branch to millicode - copy %0, %%r24" // Move length into position + __asm__ __volatile__ ( + " .import $$lr_unk_unk,MILLICODE\n" + "\t copy %1, %%r26\n" // Move source addr into pos + "\t copy %2, %%r25\n" // Move target addr into pos + "\t bl $$lr_unk_unk,%%r31\n" // Start branch to millicode + "\t copy %0, %%r24" // Move length into position : // No output : "r" (len), // Byte length @@ -452,2 +452,55 @@ } /* gettimeofday() */ + +/* +** MPE_FCNTL -- shadow function for fcntl() +** +** MPE requires sfcntl() for sockets, and fcntl() for everything +** else. This shadow routine determines the descriptor type and +** makes the appropriate call. +** +** Parameters: +** same as fcntl(). +** +** Returns: +** same as fcntl(). +*/ + +#include +#include + +int +mpe_fcntl(int fildes, int cmd, ...) +{ + int len, result; + struct sockaddr sa; + + void *arg; + va_list ap; + + va_start(ap, cmd); + arg = va_arg(ap, void *); + va_end(ap); + + len = sizeof sa; + if (getsockname(fildes, &sa, &len) == -1) + { + if (errno == EAFNOSUPPORT) + /* AF_UNIX socket */ + return sfcntl(fildes, cmd, arg); + + if (errno == ENOTSOCK) + /* file or pipe */ + return fcntl(fildes, cmd, arg); + + /* unknown getsockname() failure */ + return (-1); + } + else + { + /* AF_INET socket */ + if ((result = sfcntl(fildes, cmd, arg)) != -1 && cmd == F_GETFL) + result |= O_RDWR; /* fill in some missing flags */ + return result; + } +} Index: /branches/vendor/third/perl/mpeix/mpeixish.h =================================================================== --- /branches/vendor/third/perl/mpeix/mpeixish.h (revision 18449) +++ /branches/vendor/third/perl/mpeix/mpeixish.h (revision 20074) @@ -10,5 +10,5 @@ * available to set I/O characteristics */ -#define HAS_IOCTL / **/ +#define HAS_IOCTL /**/ /* HAS_UTIME: @@ -16,5 +16,5 @@ * available to update the access and modification times of files. */ -#define HAS_UTIME / **/ +#define HAS_UTIME /**/ /* HAS_GROUP @@ -22,5 +22,5 @@ * getgrgid() routines are available to get group entries. */ -#define HAS_GROUP / **/ +#define HAS_GROUP /**/ /* HAS_PASSWD @@ -28,5 +28,5 @@ * getpwuid() routines are available to get password entries. */ -#define HAS_PASSWD / **/ +#define HAS_PASSWD /**/ #define HAS_KILL @@ -53,5 +53,5 @@ * st_rdev */ -#define USE_STAT_RDEV / **/ +#define USE_STAT_RDEV /**/ /* ACME_MESS: @@ -88,7 +88,5 @@ /* #define ALTERNATE_SHEBANG "#!" / **/ -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) -# include -#endif +#include #ifndef SIGABRT @@ -114,5 +112,5 @@ #ifndef PERL_SYS_INIT -# define PERL_SYS_INIT(c,v) PERL_FPU_INIT MALLOC_INIT +# define PERL_SYS_INIT(c,v) PERL_FPU_INIT MALLOC_INIT #endif @@ -154,2 +152,4 @@ extern int gettimeofday( struct timeval *tp, struct timezone *tpz ); extern int truncate(const char *pathname, off_t length); + +#define fcntl mpe_fcntl Index: /branches/vendor/third/perl/Makefile.micro =================================================================== --- /branches/vendor/third/perl/Makefile.micro (revision 18449) +++ /branches/vendor/third/perl/Makefile.micro (revision 20074) @@ -1,8 +1,9 @@ LD = $(CC) -DEFINES = -DPERL_CORE -DPERL_MICRO -OPTIMIZE = +DEFINES = -DPERL_CORE -DPERL_MICRO -DSTANDARD_C -DPERL_USE_SAFE_PUTENV +OPTIMIZE = CFLAGS = $(DEFINES) $(OPTIMIZE) LIBS = -lm _O = .o +ENV = env all: microperl @@ -11,10 +12,10 @@ uglobals$(_O) ugv$(_O) uhv$(_O) \ umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \ - uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \ + upad$(_O) uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \ upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \ uregcomp$(_O) uregexec$(_O) urun$(_O) \ uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \ unumeric$(_O) ulocale$(_O) \ - uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) + uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) uxsutils$(_O) microperl: $(O) @@ -22,8 +23,8 @@ H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \ - hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h patchlevel.h \ - perl.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h reentr.h \ - regexp.h scope.h sv.h thrdvar.h thread.h unixish.h utf8.h util.h \ - warnings.h + hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h pad.h \ + patchlevel.h perl.h perlsdio.h perlvars.h perly.h pp.h \ + pp_proto.h proto.h reentr.h regexp.h scope.h sv.h thrdvar.h \ + thread.h unixish.h utf8.h util.h warnings.h HE = $(H) EXTERN.h @@ -38,5 +39,5 @@ uconfig.h: uconfig.sh config_h.SH - CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH + $(ENV) CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH # Do not regenerate perly.c and perly.h. @@ -81,8 +82,11 @@ uop$(_O): $(HE) op.c keywords.h - $(CC) -c -o $@ $(CFLAGS) op.c + $(CC) -c -o $@ $(CFLAGS) -DPERL_EXTERNAL_GLOB op.c ureentr$(_O): $(HE) reentr.c $(CC) -c -o $@ $(CFLAGS) reentr.c + +upad$(_O): $(HE) pad.c + $(CC) -c -o $@ $(CFLAGS) pad.c uperl$(_O): $(HE) perl.c @@ -152,3 +156,6 @@ $(CC) -c -o $@ $(CFLAGS) perlapi.c +uxsutils$(_O): $(HE) xsutils.c + $(CC) -c -o $@ $(CFLAGS) xsutils.c +# That's it, folks! Index: /branches/vendor/third/perl/AUTHORS =================================================================== --- /branches/vendor/third/perl/AUTHORS (revision 18449) +++ /branches/vendor/third/perl/AUTHORS (revision 20074) @@ -14,10 +14,13 @@ A. C. Yardley Aaron B. Dossett +Aaron J. Mackey Abe Timmerman Abhijit Menon-Sen -Abigail +Abigail Achim Bohnet +Adam Kennedy Adam Krolnik Adam Milner +Adam Spiers Akim Demaille Alan Burlison @@ -29,12 +32,16 @@ Alessandro Forghieri Alex Gough -Alexander Gough +Alex Vandiver +Alexander Gough Alexander Klimov Alexander Smishlajev Alexey Mahotkin +Alexey Tourbin Alexey V. Barantsev -Allen Smith +Allen Smith +Alain Barbet Ambrose Kofi Laing Ananth Kesari +Anders Jonhson Andreas Klussmann Andreas K� @@ -57,4 +64,5 @@ Anton Tagunov Archer Sully +Arjen Laarhoven Art Green Artur Bergman @@ -79,5 +87,5 @@ Brad Hughes Brad Lanam -Brendan O'Dea +Brendan O'Dea Brent B. Powers Brent Dax @@ -111,4 +119,5 @@ Charles Randall Charles Wilson +Chaskiel M Grundman Chip Salzenberg Chris Ball @@ -116,4 +125,5 @@ Chris Faylor Chris Nandor +Chris Pepper Chris Wick Christian Kirsch @@ -125,13 +135,13 @@ Chunhui Teng Clark Cooper +Claes Jacobsson Clinton A. Pierce Colin Kuskie Colin McMillen Colin Meyer -Colin Watson +Colin Watson Conrad Augustin Conrad E. Kimball -Coral -Craig A. Berry +Craig A. Berry Craig Milo Rogers Curtis Poe @@ -140,4 +150,5 @@ Damon Atkins Dan Boorstein +Dan Brook Dan Hale Dan Kogai @@ -150,5 +161,5 @@ Daniel Mui� Daniel P. Berrange -Daniel S. Lewart +Daniel S. Lewart Daniel Yacob Danny R. Faught @@ -161,4 +172,5 @@ Dave Liney Dave Nelson +Dave Paris Dave Rolsky Dave Schweisguth @@ -176,6 +188,7 @@ David J. Fiander David Kerry -David Mitchell +David Mitchell David Muir Sharnoff +david nicol David R. Favor David Sparks @@ -187,5 +200,4 @@ Dennis Marsa Diab Jerius -dive dLux Dominic Dunlop @@ -200,13 +212,17 @@ Ed Mooring Ed Peschko -Edward Avis +Edmund Bacon +Edward Avis Edward Moy Edward Peschko Elaine -HFB- Ashton Elizabeth Mattijsen +Adrian M. Enache Eric Arnold +Eric Amick Eric Bartley Eric E. Coe Eric Fifer +Eric Melville Erich Rickheit Eryq @@ -215,4 +231,5 @@ Fabien Tassin Felix Gallo +Fergal Daly Florent Guillaume Frank Crawford @@ -234,5 +251,4 @@ Giles Lean Gisle Aas -Golubev I. N. Gordon J. Miller Grace Lee @@ -272,4 +288,5 @@ Hershel Walters Holger Bechtold +Hrunting Jonhson Horst von Brand Hubert Feyrer @@ -285,7 +302,8 @@ Ilya Martynov Ilya Sandler -Ilya Zakharevich +Ilya Zakharevich Inaba Hiroto Indy Singh +insecure Irving Reid Ivan Kurmanov @@ -298,4 +316,5 @@ James A. Duncan James FitzGibbon +James Jurach Jamshid Afshar Jan D. @@ -305,4 +324,5 @@ Jan-Pieter Cornet Jared Rhine +Jari Aalto Jarkko Hietaniemi Jason A. Smith @@ -311,4 +331,5 @@ Jason Stewart Jason Varsoke +Jay Hannah Jay Rogers JD Laub @@ -333,5 +354,5 @@ Jim Avera Jim Balter -Jim Cromie +Jim Cromie Jim Meyering Jim Miner @@ -340,6 +361,7 @@ Jochen Wiedmann Joe Buehler -Joe McMahon +Joe McMahon Joe Orton +Joe Schaefer Joe Smith Joel Rosi-Schwartz @@ -380,10 +402,14 @@ Jonathan Roy Jonathan Stowe +Jos I. Boumans +Jose Auguste-Etienne Joseph N. Hall Joseph S. Myers Joshua E. Rodd Joshua Pritikin +Joost van Baal JT McDuffie Juan Gallego +Juerd Waalboer Juha Laiho Julian Yip @@ -398,4 +424,5 @@ Kaveh Ghazi Kay R� +KAWAI Takanori Keith Neufeld Keith Thompson @@ -404,4 +431,5 @@ Ken Fox Ken MacLeod +Ken Neighbors Ken Shan Ken Williams @@ -416,5 +444,5 @@ Kingpin Kirrily Robert -Kragen Sitaker +Kragen Sitaker Krishna Sethuraman Kurt D. Starsinic @@ -436,4 +464,5 @@ Luc St-Louis Luca Fini +Lukas Mai Lupe Christoph Luther Huffman @@ -445,5 +474,7 @@ Marc Paquette Marcel Grunauer +Marek Rouchal Mark A Biggar +Marcus Holland-Moritz Mark A. Hershberger Mark Bixby @@ -458,5 +489,5 @@ Mark Knutsen Mark Kvale -Mark Leighton Fisher +Mark Leighton Fisher Mark Murray Mark P. Lutz @@ -472,5 +503,7 @@ Martin Lichtin Martin Plechsmid +Martti Rahkila Marty Lucich +Marty Pauley Martyn Pearce Masahiro KAJIURA @@ -496,4 +529,5 @@ Michael H. Moran Michael Mahan +Michael Schroeder Michael Somos Michael Stevens @@ -505,4 +539,5 @@ Mike Hopkirk Mike Mestnik +Mike Pomraning Mike Rogers Mike Schilli @@ -517,5 +552,5 @@ Neil Bowers Nicholas Clark -Nick Duffek +Nicholas Oxh�ck Duffek Nick Gianniotis Nick Ing-Simmons @@ -524,4 +559,5 @@ Norbert Pueschel Norton T. Allen +OKAIE Yutaka Olaf Flebbe Olaf Titz @@ -539,5 +575,5 @@ Paul Johnson Paul Lindner -Paul Marquess +Paul Marquess Paul Moore Paul Rogers @@ -545,4 +581,5 @@ Paul Schinder Per Einar Ellefsen +Peter BARABAS Pete Peterson Peter Chines @@ -552,5 +589,6 @@ Peter J. Farley III Peter Jaspers-Fayer -Peter Prymmer +Peter O'Gorman +Peter Prymmer Peter Scott Peter van Heusden @@ -563,4 +601,5 @@ Piotr Klaban Pixel +Pradeep Hodigere Prymmer/Kahn Quentin Fennessy @@ -575,7 +614,9 @@ Randolf Werner Randy J. Ray +Randy W. Sims Raphael Manfredi Raul Dias Raymund Will +Redvers Davies Reini Urban Rex Dieter @@ -584,6 +625,8 @@ Richard A. Wells Richard Clamp -Richard Foley +Richard Foley Richard Hatch +Richard Hitt +Richard Kandarian Richard L. England Richard L. Maus, Jr. @@ -599,5 +642,5 @@ Robert Sanders Robert Spier -Robin Barker +Robin Barker Robin Houston Rocco Caputo @@ -614,4 +657,5 @@ SADAHIRO Tomoyuki SAKAI Kiyotaka +Salvador Fandi� Sam Tregar Samuli K�k�en @@ -622,4 +666,5 @@ Scott L. Miller Sean Dague +Sean Davis Sean M. Burke Sean Robinson @@ -630,19 +675,22 @@ Shimpei Yamashita Shishir Gundavaram +Shlomi Fish Simon Cozens Simon Glover Simon Leinen Simon Parsons -Slaven Rezic +Slaven Rezic Spider Boardman Stas Bekman Steffen Mueller -Stephane Payrard +St�ane Payrard Stephanie Beals -Stephen McCamant +Stephen Clouse +Stephen McCamant Stephen O. Lidie Stephen P. Potter Stephen Zander Steve A Fink +Steve Grazzini Steve Hay Steve Kelem @@ -661,4 +709,5 @@ Takis Psarogiannakopoulos Taro KAWAGISHI +Tassilo von Parseval Tatsuhiko Miyagawa Ted Ashton @@ -675,5 +724,5 @@ Tim Adye Tim Ayers -Tim Bunce +Tim Bunce Tim Conrow Tim Freeman @@ -688,4 +737,5 @@ Tom Bates Tom Brown +Tom Dinger Tom Christiansen Tom Horsley @@ -698,4 +748,5 @@ Tony Sanders Tor Lillqvist +Torsten Foertsch Trevor Blackwell Tuomas J. Lukka @@ -703,5 +754,5 @@ Ulrich Kunitz Ulrich Pfeifer -Vadim Konovalov +Vadim Konovalov Valeriy E. Ushakov Ville Skytt� @@ -710,5 +761,5 @@ Vladimir Alexiev W. Phillip Moore -Walt Mankowski +Walt Mankowski Walter Briscoe Warren Hyde @@ -725,4 +776,5 @@ Winfried K� Wolfgang Laun +Xavier Noria Yary Hluchan Yasushi Nakajima Index: /branches/vendor/third/perl/run.c =================================================================== --- /branches/vendor/third/perl/run.c (revision 18449) +++ /branches/vendor/third/perl/run.c (revision 20074) @@ -1,5 +1,6 @@ /* run.c * - * Copyright (c) 1991-2002, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public Index: /branches/vendor/third/perl/av.c =================================================================== --- /branches/vendor/third/perl/av.c (revision 18449) +++ /branches/vendor/third/perl/av.c (revision 20074) @@ -1,5 +1,6 @@ /* av.c * - * Copyright (c) 1991-2002, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -106,5 +107,5 @@ #endif -#if defined(MYMALLOC) && !defined(LEAKTEST) +#ifdef MYMALLOC newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; @@ -135,5 +136,5 @@ AvALLOC(av) = ary; #endif -#if defined(MYMALLOC) && !defined(LEAKTEST) +#ifdef MYMALLOC resized: #endif @@ -185,19 +186,40 @@ return 0; + if (SvRMAGICAL(av)) { + MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied); + if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) { + U32 adjust_index = 1; + + if (tied_magic && key < 0) { + /* Handle negative array indices 20020222 MJD */ + SV **negative_indices_glob = + hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, + tied_magic))), + NEGATIVE_INDICES_VAR, 16, 0); + + if (negative_indices_glob + && SvTRUE(GvSV(*negative_indices_glob))) + adjust_index = 0; + } + + if (key < 0 && adjust_index) { + key += AvFILL(av) + 1; + if (key < 0) + return 0; + } + + sv = sv_newmortal(); + sv_upgrade(sv, SVt_PVLV); + mg_copy((SV*)av, sv, 0, key); + LvTYPE(sv) = 't'; + LvTARG(sv) = sv; /* fake (SV**) */ + return &(LvTARG(sv)); + } + } + if (key < 0) { key += AvFILL(av) + 1; if (key < 0) return 0; - } - - if (SvRMAGICAL(av)) { - if (mg_find((SV*)av, PERL_MAGIC_tied) || - mg_find((SV*)av, PERL_MAGIC_regdata)) - { - sv = sv_newmortal(); - mg_copy((SV*)av, sv, 0, key); - PL_av_fetch_sv = sv; - return &PL_av_fetch_sv; - } } @@ -252,4 +274,31 @@ val = &PL_sv_undef; + if (SvRMAGICAL(av)) { + MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied); + if (tied_magic) { + /* Handle negative array indices 20020222 MJD */ + if (key < 0) { + unsigned adjust_index = 1; + SV **negative_indices_glob = + hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, + tied_magic))), + NEGATIVE_INDICES_VAR, 16, 0); + if (negative_indices_glob + && SvTRUE(GvSV(*negative_indices_glob))) + adjust_index = 0; + if (adjust_index) { + key += AvFILL(av) + 1; + if (key < 0) + return 0; + } + } + if (val != &PL_sv_undef) { + mg_copy((SV*)av, val, 0, key); + } + return 0; + } + } + + if (key < 0) { key += AvFILL(av) + 1; @@ -260,13 +309,4 @@ if (SvREADONLY(av) && key >= AvFILL(av)) Perl_croak(aTHX_ PL_no_modify); - - if (SvRMAGICAL(av)) { - if (mg_find((SV*)av, PERL_MAGIC_tied)) { - if (val != &PL_sv_undef) { - mg_copy((SV*)av, val, 0, key); - } - return 0; - } - } if (!AvREAL(av) && AvREIFY(av)) @@ -417,6 +457,9 @@ key = AvFILLp(av) + 1; while (key) { - SvREFCNT_dec(ary[--key]); + SV * sv = ary[--key]; + /* undef the slot before freeing the value, because a + * destructor might try to modify this arrray */ ary[key] = &PL_sv_undef; + SvREFCNT_dec(sv); } } @@ -751,4 +794,40 @@ if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); + + if (SvRMAGICAL(av)) { + MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied); + SV **svp; + if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) { + /* Handle negative array indices 20020222 MJD */ + if (key < 0) { + unsigned adjust_index = 1; + if (tied_magic) { + SV **negative_indices_glob = + hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, + tied_magic))), + NEGATIVE_INDICES_VAR, 16, 0); + if (negative_indices_glob + && SvTRUE(GvSV(*negative_indices_glob))) + adjust_index = 0; + } + if (adjust_index) { + key += AvFILL(av) + 1; + if (key < 0) + return Nullsv; + } + } + svp = av_fetch(av, key, TRUE); + if (svp) { + sv = *svp; + mg_clear(sv); + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */ + return sv; + } + return Nullsv; + } + } + } + if (key < 0) { key += AvFILL(av) + 1; @@ -756,19 +835,5 @@ return Nullsv; } - if (SvRMAGICAL(av)) { - SV **svp; - if ((mg_find((SV*)av, PERL_MAGIC_tied) || - mg_find((SV*)av, PERL_MAGIC_regdata)) - && (svp = av_fetch(av, key, TRUE))) - { - sv = *svp; - mg_clear(sv); - if (mg_find(sv, PERL_MAGIC_tiedelem)) { - sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */ - return sv; - } - return Nullsv; /* element cannot be deleted */ - } - } + if (key > AvFILLp(av)) return Nullsv; @@ -808,4 +873,40 @@ if (!av) return FALSE; + + + if (SvRMAGICAL(av)) { + MAGIC *tied_magic = mg_find((SV*)av, PERL_MAGIC_tied); + if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) { + SV *sv = sv_newmortal(); + MAGIC *mg; + /* Handle negative array indices 20020222 MJD */ + if (key < 0) { + unsigned adjust_index = 1; + if (tied_magic) { + SV **negative_indices_glob = + hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, + tied_magic))), + NEGATIVE_INDICES_VAR, 16, 0); + if (negative_indices_glob + && SvTRUE(GvSV(*negative_indices_glob))) + adjust_index = 0; + } + if (adjust_index) { + key += AvFILL(av) + 1; + if (key < 0) + return FALSE; + } + } + + mg_copy((SV*)av, sv, 0, key); + mg = mg_find(sv, PERL_MAGIC_tiedelem); + if (mg) { + magic_existspack(sv, mg); + return (bool)SvTRUE(sv); + } + + } + } + if (key < 0) { key += AvFILL(av) + 1; @@ -813,19 +914,5 @@ return FALSE; } - if (SvRMAGICAL(av)) { - if (mg_find((SV*)av, PERL_MAGIC_tied) || - mg_find((SV*)av, PERL_MAGIC_regdata)) - { - SV *sv = sv_newmortal(); - MAGIC *mg; - - mg_copy((SV*)av, sv, 0, key); - mg = mg_find(sv, PERL_MAGIC_tiedelem); - if (mg) { - magic_existspack(sv, mg); - return (bool)SvTRUE(sv); - } - } - } + if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef && AvARRAY(av)[key]) @@ -874,4 +961,7 @@ mg_get(sv); if (SvROK(sv)) { + if (ckWARN(WARN_DEPRECATED) && !sv_isa(sv, "pseudohash")) + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), + "Pseudo-hashes are deprecated"); sv = SvRV(sv); if (SvTYPE(sv) == SVt_PVHV) Index: /branches/vendor/third/perl/emacs/cperl-mode.el =================================================================== --- /branches/vendor/third/perl/emacs/cperl-mode.el (revision 18449) +++ /branches/vendor/third/perl/emacs/cperl-mode.el (revision 20074) @@ -1,11 +1,9 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs -;;;; The following message is relative to GNU version of the module: - -;; Copyright (C) 1985, 86, 87, 1991--2000 +;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003 ;; Free Software Foundation, Inc. ;; Author: Ilya Zakharevich and Bob Olson -;; Maintainer: Ilya Zakharevich +;; Maintainer: Ilya Zakharevich ;; Keywords: languages, Perl @@ -42,10 +40,10 @@ ;; Boston, MA 02111-1307, USA. -;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu +;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de ;;; Commentary: -;; $Id: cperl-mode.el,v 1.1.1.4 2003-01-10 13:39:54 zacheiss Exp $ +;; $Id: cperl-mode.el,v 1.1.1.5 2004-02-09 19:05:15 zacheiss Exp $ ;;; If your Emacs does not default to `cperl-mode' on Perl files: @@ -55,18 +53,18 @@ ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) -;;; You can either fine-tune the bells and whistles of this mode or -;;; bulk enable them by putting +;; You can either fine-tune the bells and whistles of this mode or +;; bulk enable them by putting ;; (setq cperl-hairy t) -;;; in your .emacs file. (Emacs rulers do not consider it politically -;;; correct to make whistles enabled by default.) - -;;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< -;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< -;;; `cperl-non-problems', `cperl-praise', `cperl-speed'. <<<<<< - -;;; Additional useful commands to put into your .emacs file (before -;;; RMS Emacs 20.3): +;; in your .emacs file. (Emacs rulers do not consider it politically +;; correct to make whistles enabled by default.) + +;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< +;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< +;; `cperl-non-problems', `cperl-praise', `cperl-speed'. <<<<<< + +;; Additional useful commands to put into your .emacs file (before +;; RMS Emacs 20.3): ;; (setq auto-mode-alist @@ -75,29 +73,36 @@ ;; '(("miniperl" . perl-mode)))) -;;; The mode information (on C-h m) provides some customization help. -;;; If you use font-lock feature of this mode, it is advisable to use -;;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. - -;;; Faces used now: three faces for first-class and second-class keywords -;;; and control flow words, one for each: comments, string, labels, -;;; functions definitions and packages, arrays, hashes, and variable -;;; definitions. If you do not see all these faces, your font-lock does -;;; not define them, so you need to define them manually. Maybe you have -;;; an obsolete font-lock from 19.28 or earlier. Upgrade. - -;;; If you have a grayscale monitor, and do not have the variable -;;; font-lock-display-type bound to 'grayscale, insert - -;;; (setq font-lock-display-type 'grayscale) - -;;; into your .emacs file (this is relevant before RMS Emacs 20). - -;;;; This mode supports font-lock, imenu and mode-compile. In the -;;;; hairy version font-lock is on, but you should activate imenu -;;;; yourself (note that mode-compile is not standard yet). Well, you -;;;; can use imenu from keyboard anyway (M-x imenu), but it is better -;;;; to bind it like that: +;; The mode information (on C-h m) provides some customization help. +;; If you use font-lock feature of this mode, it is advisable to use +;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. + +;; Faces used now: three faces for first-class and second-class keywords +;; and control flow words, one for each: comments, string, labels, +;; functions definitions and packages, arrays, hashes, and variable +;; definitions. If you do not see all these faces, your font-lock does +;; not define them, so you need to define them manually. +;; Maybe you have an obsolete font-lock from 19.28 or earlier. Upgrade. + +;; If you have a grayscale monitor, and do not have the variable +;; font-lock-display-type bound to 'grayscale, insert + +;; (setq font-lock-display-type 'grayscale) + +;; into your .emacs file (this is relevant before RMS Emacs 20). + +;; This mode supports font-lock, imenu and mode-compile. In the +;; hairy version font-lock is on, but you should activate imenu +;; yourself (note that mode-compile is not standard yet). Well, you +;; can use imenu from keyboard anyway (M-x imenu), but it is better +;; to bind it like that: ;; (define-key global-map [M-S-down-mouse-3] 'imenu) + +;;; Font lock bugs as of v4.32: + +;; The following kinds of Perl code erroneously start strings: +;; \$` \$' \$" +;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ +;; likewise with m, tr, y, q, qX instead of s ;;; In fact the version of font-lock that this version supports can be @@ -108,14 +113,14 @@ ;;; Updates: ======================================== -;;; Made less hairy by default: parentheses not electric, +;;; Made less hairy by default: parentheses not electric, ;;; linefeed not magic. Bug with abbrev-mode corrected. ;;;; After 1.4: ;;; Better indentation: -;;; subs inside braces should work now, +;;; subs inside braces should work now, ;;; Toplevel braces obey customization. ;;; indent-for-comment knows about bad cases, cperl-indent-for-comment ;;; moves cursor to a correct place. -;;; cperl-indent-exp written from the scratch! Slow... (quadratic!) :-( +;;; cperl-indent-exp written from the scratch! Slow... (quadratic!) :-( ;;; (50 secs on DB::DB (sub of 430 lines), 486/66) ;;; Minor documentation fixes. @@ -130,5 +135,5 @@ ;;; Better package support for `imenu'. ;;; Progress indicator for indentation (with `imenu' loaded). -;;; `Cperl-set' was busted, now setting the individual hairy option +;;; `Cperl-set' was busted, now setting the individual hairy option ;;; should be better. @@ -139,5 +144,5 @@ ;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'. ;;; Bugs with `cperl-auto-newline' corrected. -;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation +;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation ;;; like $hash{. @@ -156,5 +161,5 @@ ;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz) ;;; for portable code? -;;; - should `cperl-mode' do a +;;; - should `cperl-mode' do a ;;; (if (featurep 'easymenu) (easy-menu-add cperl-menu)) ;;; or should this be left to the user's `cperl-mode-hook'? @@ -163,8 +168,8 @@ ;;; Some bugs under XEmacs introduced by the correction corrected. -;;; Some more can remain since there are two many different variants. +;;; Some more can remain since there are two many different variants. ;;; Please feedback! -;;; We do not support fontification of arrays and hashes under +;;; We do not support fontification of arrays and hashes under ;;; obsolete font-lock any more. Upgrade. @@ -192,5 +197,5 @@ ;;;; After 1.12: -;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions +;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions ;;; vertically. ;;; `cperl-do-auto-fill' updated for 19.29 style. @@ -232,5 +237,5 @@ ;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info ;;; for indentation so far. -;;; Fontification updated to 19.30 style. +;;; Fontification updated to 19.30 style. ;;; The change 19.29->30 did not add all the required functionality, ;;; but broke "font-lock-extra.el". Get "choose-color.el" from @@ -242,5 +247,5 @@ ;;; Two different font-lock-levels provided. ;;; `cperl-pod-head-face' introduced. Used for highlighting. -;;; `imenu' marks pods, +Packages moved to the head. +;;; `imenu' marks pods, +Packages moved to the head. ;;;; After 1.17: @@ -252,5 +257,5 @@ ;;;; After 1.18: -;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme +;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme ;;; may break under XEmacs. ;;; `cperl-calculate-indent' dis suppose that `parse-start' was defined. @@ -313,8 +318,8 @@ ;;;; After 1.25 (probably not...) -;;; `cperl-info-page' introduced. +;;; `cperl-info-page' introduced. ;;; To make `uncomment-region' working, `comment-region' would ;;; not insert extra space. -;;; Here documents delimiters better recognized +;;; Here documents delimiters better recognized ;;; (empty one, and non-alphanums in quotes handled). May be wrong with 1<<14? ;;; `cperl-db' added, used in menu. @@ -381,10 +386,10 @@ ;;; `cperl-use-syntax-table-text-property'. Currently recognized: ;;; All quote-like operators: m, s, y, tr, qq, qw, qx, q, -;;; // in most frequent context: +;;; // in most frequent context: ;;; after block or ;;; ~ { ( = | & + - * ! , ; -;;; or +;;; or ;;; while if unless until and or not xor split grep map -;;; Here-documents, formats, PODs, +;;; Here-documents, formats, PODs, ;;; ${...} ;;; 'abc$' @@ -473,5 +478,5 @@ ;;; s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm ;;; is much simpler now; -;;; Next round of changes: s\\\ works, s/foo/, +;;; Next round of changes: s\\\ works, s/foo/, ;;; comments between the first and the second part allowed ;;; Another problem discovered: @@ -492,5 +497,5 @@ ;;; added (for -batch mode); ;;; Better handling of errors when scanning for Perl constructs; -;;;;;;; Possible "problem" with class hierarchy in Perl distribution +;;;;;;; Possible "problem" with class hierarchy in Perl distribution ;;;;;;; directory: ./ext duplicates ./lib; ;;; Write relative paths for generated TAGS; @@ -528,5 +533,5 @@ ;;; $a->y() is not y///. ;;; `cperl-after-block-p' was missing a `save-excursion' => wrong results. -;;; `cperl-val' was defined too late. +;;; `cperl-val' was defined too late. ;;; `cperl-init-faces' was failing. ;;; Init faces when loading `ps-print'. @@ -563,5 +568,5 @@ ;;; Upgraded hints to mention 20.2's goods/bads. ;;; Started to use `cperl-extra-newline-before-brace-multiline', -;;; `cperl-break-one-line-blocks-when-indent', +;;; `cperl-break-one-line-blocks-when-indent', ;;; `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'. @@ -572,5 +577,5 @@ ;;; (We expect that starting from 19.33, `font-lock' supports keywords ;;; being a function - what is a correct version?) -;;; Rename `cperl-indent-region-fix-else' to +;;; Rename `cperl-indent-region-fix-else' to ;;; `cperl-indent-region-fix-constructs'. ;;; `cperl-fix-line-spacing' could be triggered inside strings, would not @@ -594,9 +599,9 @@ ;;;; After 2.12: ;;; Remove some commented out chunks. -;;; Styles are slightly updated (a lot of work is needed, especially +;;; Styles are slightly updated (a lot of work is needed, especially ;;; with new `cperl-fix-line-spacing'). ;;;; After 2.13: -;;; Old value of style is memorized when choosing a new style, may be +;;; Old value of style is memorized when choosing a new style, may be ;;; restored from the same menu. ;;; Mode-documentation added to micro-docs. @@ -647,10 +652,10 @@ ;;;; After 3.4: ;;; (`cperl-mode'): Make lazy syntaxification possible. -;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to +;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to ;;; restart syntaxification. ;;; (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now. ;;;; After 3.5: -;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to +;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to ;;; `message' too. @@ -805,5 +810,5 @@ ;;; (`cperl-init-faces-weak'): use `cperl-force-face'. ;;; (`cperl-after-block-p'): After END/BEGIN we are a block. -;;; (`cperl-mode'): `font-lock-unfontify-region-function' +;;; (`cperl-mode'): `font-lock-unfontify-region-function' ;;; was set to a wrong function. ;;; (`cperl-comment-indent'): Commenting __END__ was not working. @@ -814,5 +819,5 @@ ;;; (`cperl-unwind-to-safe'): Signature changed, unwinds end too. ;;; (`cperl-find-pods-heres'): mark qq[]-etc sections as syntax-type=string -;;; (`cperl-fontify-syntaxically'): Unwinds start and end to go out of +;;; (`cperl-fontify-syntaxically'): Unwinds start and end to go out of ;;; long strings (not very successful). @@ -839,9 +844,9 @@ ;;; (`cperl-tags-hier-init'): Another try to work around XEmacs problems ;;; Better progress messages. -;;; (`cperl-find-tags'): Was writing line/pos in a wrong order, +;;; (`cperl-find-tags'): Was writing line/pos in a wrong order, ;;; pos off by 1 and not at beg-of-line. ;;; (`cperl-etags-snarf-tag'): New macro ;;; (`cperl-etags-goto-tag-location'): New macro -;;; (`cperl-write-tags'): When removing old TAGS info was not +;;; (`cperl-write-tags'): When removing old TAGS info was not ;;; relativizing filename @@ -907,5 +912,5 @@ ;;; (`cperl-find-pods-heres'): / and ? after : start a REx. ;;; (`cperl-after-expr-p'): Skip labels when checking -;;; (`cperl-calculate-indent'): Correct for labels when calculating +;;; (`cperl-calculate-indent'): Correct for labels when calculating ;;; indentation of continuations. ;;; Docstring updated. @@ -964,5 +969,5 @@ ;;; of `foo' inserts (t), second one inserts (BUG) ?! ;;; -;;; In CPerl it was triggered by inserting then deleting `/' at start of +;;; In CPerl it was triggered by inserting then deleting `/' at start of ;;; / a (?# asdf {[(}asdf )ef,/; @@ -1046,4 +1051,92 @@ ;;; on an unreadable directory +;;;; After 4.32: +;;; Syncronized with v1.60 from Emacs 21.3. +;;; Mostly docstring and formatting changes, and: + +;;; (`cperl-noscan-files-regexp'): Do not scan CVS subdirs +;;; (`cperl-problems'): Note that newer XEmacsen may syntaxify too +;;; (`imenu-example--create-perl-index'): +;;; Renamed to `cperl-imenu--create-perl-index' +;;; (`cperl-mode'): Replace `make-variable-buffer-local' by `make-local-variable' +;;; (`cperl-setup-tmp-buf'): Likewise +;;; (`cperl-fix-line-spacing'): Fix a misprint of "t" for "\t" +;;; (`cperl-next-bad-style'): Fix misprints in character literals + +;;;; After 4.33: +;;; (`cperl-font-lock-keywords'): +etc: Aliased to perl-font-lock-keywords. + +;;;; After 4.34: +;;; Further updates of whitespace and spelling w.r.t. RMS version. +;;; (`cperl-font-lock-keywords'): +etc: Avoid warnings when aliasing. +;;; (`cperl-mode'): Use `normal-auto-fill-function' if present. +;;; (`cperl-use-major-mode'): New variable +;;; (`cperl-can-font-lock'): New variable; replaces `window-system' +;;; (`cperl-tags-hier-init'): use `display-popup-menus-p' (if present) +;;; to choose `x-popup-menu' vs `tmm-prompt' + +;;;; 4.35 has the following differences from version 1.40+ of RMS Emacs: + +;;; New variables `cperl-use-major-mode', `cperl-can-font-lock'; +;;; `cperl-use-major-mode' is (effectively) 'cperl-mode in RMS. +;;; `cperl-under-as-char' is nil in RMS. +;;; Minor differences in docstrings, and `cperl-non-problems'. +;;; Backward compatibility addressed: (`); (function (lambda ...)); font-lock; +;;; (:italic t bold t) vs (:slant italic :weight bold) in faces; +;;; `normal-auto-fill-function'. +;;; RMS version has wrong logic in `cperl-calculate-indent': $a = { } is +;;; wrongly indented if the closing brace is on a separate line. +;;; Different choice of ordering if's for is-x-REx and (eq (char-after b) ?\#) +;;; in `cperl-find-pods-heres'. [Cosmetic] + +;;;; After 4.35: +;;; (`cperl-find-pods-heres'): If no end of HERE-doc found, mark to the end +;;; of buffer. This enables recognition of end +;;; of HERE-doc "as one types". +;;; Require "\n" after trailing tag of HERE-doc. +;;; \( made non-quoting outside of string/comment +;;; (gdj-contributed). +;;; Likewise for \$. +;;; Remove `here-doc-group' text property at start +;;; (makes this property reliable). +;;; Text property `first-format-line' ==> t. +;;; Do not recognize $opt_s and $opt::s as s///. +;;; (`cperl-perldoc'): Use case-sensitive search (contributed). +;;; (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when +;;; underscore isn't a word char (gdj-contributed). +;;; (`defun-prompt-regexp'): Allow prototypes. +;;; (`cperl-vc-header-alist'): Extract numeric version from the Id. +;;; Toplevel: Put toggle-autohelp into the mode menu. +;;; Better docs for toggle/set/unset autohelp. +;;; (`cperl-electric-backspace-untabify'): New customization variable +;;; (`cperl-after-expr-p'): Works after here-docs, formats, and PODs too +;;; (affects many electric constructs). +;;; (`cperl-calculate-indent'): Takes into account `first-format-line' ==> +;;; works after format. +;;; (`cperl-short-docs'): Make it work with ... too. +;;; "array context" ==> "list context" +;;; (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric +;;; '(' after keyword would insert a doubled paren +;;; (`cperl-electric-paren'): documented affected by `cperl-electric-parens' +;;; (`cperl-electric-rparen'): Likewise +;;; (`cperl-build-manpage'): New function by Nick Roberts +;;; (`cperl-perldoc'): Make it work in XEmacs too + +;;;; After 4.36: +;;; (`cperl-find-pods-heres'): Recognize s => 1 and {s} (as a key or varname), +;;; { s:: } and { s::bar::baz } as varnames. +;;; (`cperl-after-expr-p'): Updates syntaxification before checks +;;; (`cperl-calculate-indent'): Likewise +;;; Fix wrong indent of blocks starting with POD +;;; (`cperl-after-block-p'): Optional argument for checking for a pre-block +;;; Recognize `continue' blocks too. +;;; (`cperl-electric-brace'): use `cperl-after-block-p' for detection; +;;; Now works for else/continue/sub blocks +;;; (`cperl-short-docs'): Minor edits; make messages fit 80-column screen + +;;;; After 4.37: +;;; `cperl-add-tags-recurse-noxs-fullpath' +;;; added (for -batch mode); + ;;; Code: @@ -1054,5 +1147,19 @@ (require 'custom) (error nil)) + (condition-case nil + (require 'man) + (error nil)) (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) + (defvar cperl-can-font-lock + (or cperl-xemacs-p + (and (boundp 'emacs-major-version) + (or window-system + (> emacs-major-version 20))))) + (if cperl-can-font-lock + (require 'font-lock)) + (defvar msb-menu-cond) + (defvar gud-perldb-history) + (defvar font-lock-background-mode) ; not in Emacs + (defvar font-lock-display-type) ; ditto (or (fboundp 'defgroup) (defmacro defgroup (name val doc &rest arr) @@ -1062,8 +1169,8 @@ (` (defvar (, name) (, val) (, doc))))) (or (and (fboundp 'custom-declare-variable) - (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work + (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work (defmacro defface (&rest arr) nil)) - ;; Avoid warning (tmp definitions) + ;; Avoid warning (tmp definitions) (or (fboundp 'x-color-defined-p) (defmacro x-color-defined-p (col) @@ -1075,18 +1182,18 @@ (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg - (cond ((fboundp 'find-face) - (` (find-face (, arg)))) - (;;(and (fboundp 'face-list) - ;; (face-list)) - (fboundp 'face-list) - (` (member (, arg) (and (fboundp 'face-list) - (face-list))))) - (t - (` (boundp (, arg)))))) + (cond ((fboundp 'find-face) + (` (find-face (, arg)))) + (;;(and (fboundp 'face-list) + ;; (face-list)) + (fboundp 'face-list) + (` (member (, arg) (and (fboundp 'face-list) + (face-list))))) + (t + (` (boundp (, arg)))))) (defmacro cperl-make-face (arg descr) ; Takes unquoted arg (cond ((fboundp 'make-face) (` (make-face (quote (, arg))))) (t - (` (defconst (, arg) (quote (, arg)) (, descr)))))) + (` (defvar (, arg) (quote (, arg)) (, descr)))))) (defmacro cperl-force-face (arg descr) ; Takes unquoted arg (` (progn @@ -1094,5 +1201,5 @@ (cperl-make-face (, arg) (, descr))) (or (boundp (quote (, arg))) ; We use unquoted variants too - (defconst (, arg) (quote (, arg)) (, descr)))))) + (defvar (, arg) (quote (, arg)) (, descr)))))) (if cperl-xemacs-p (defmacro cperl-etags-snarf-tag (file line) @@ -1104,14 +1211,22 @@ (if cperl-xemacs-p (defmacro cperl-etags-goto-tag-location (elt) - (` ;;(progn - ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) - ;; (set-buffer (get-file-buffer (elt (, elt) 0))) - ;; Probably will not work due to some save-excursion??? - ;; Or save-file-position? - ;; (message "Did I get to line %s?" (elt (, elt) 1)) - (goto-line (string-to-int (elt (, elt) 1))))) - ;;) + (`;;(progn + ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) + ;; (set-buffer (get-file-buffer (elt (, elt) 0))) + ;; Probably will not work due to some save-excursion??? + ;; Or save-file-position? + ;; (message "Did I get to line %s?" (elt (, elt) 1)) + (goto-line (string-to-int (elt (, elt) 1))))) + ;;) (defmacro cperl-etags-goto-tag-location (elt) (` (etags-goto-tag-location (, elt))))))) + +(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) + +(defvar cperl-can-font-lock + (or cperl-xemacs-p + (and (boundp 'emacs-major-version) + (or window-system + (> emacs-major-version 20))))) (condition-case nil @@ -1177,10 +1292,9 @@ if () { - } -" + }" :type 'boolean :group 'cperl-autoinsert-details) -(defcustom cperl-extra-newline-before-brace-multiline +(defcustom cperl-extra-newline-before-brace-multiline cperl-extra-newline-before-brace "*Non-nil means the same as `cperl-extra-newline-before-brace', but @@ -1196,5 +1310,5 @@ (defcustom cperl-lineup-step nil "*`cperl-lineup' will always lineup at multiple of this number. -If `nil', the value of `cperl-indent-level' will be used." +If nil, the value of `cperl-indent-level' will be used." :type '(choice (const nil) integer) :group 'cperl-indentation-details) @@ -1237,5 +1351,5 @@ and after colons and semicolons, inserted in CPerl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. -Insertion after colons requires both this variable and +Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set." :type 'boolean @@ -1261,5 +1375,5 @@ (defcustom cperl-font-lock nil - "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode. + "*Non-nil (and non-null) means CPerl buffers will use `font-lock-mode'. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) @@ -1267,5 +1381,5 @@ (defcustom cperl-electric-lbrace-space nil - "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '. + "*Non-nil (and non-null) means { after $ should be preceded by ` '. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) @@ -1286,5 +1400,5 @@ (defvar zmacs-regions) ; Avoid warning -(defcustom cperl-electric-parens-mark +(defcustom cperl-electric-parens-mark (and window-system (or (and (boundp 'transient-mark-mode) ; For Emacs @@ -1310,7 +1424,12 @@ :group 'cperl-affected-by-hairy) +(defcustom cperl-electric-backspace-untabify t + "*Not-nil means electric-backspace will untabify in CPerl." + :type 'boolean + :group 'cperl-autoinsert-details) + (defcustom cperl-hairy nil "*Not-nil means most of the bells and whistles are enabled in CPerl. -Affects: `cperl-font-lock', `cperl-electric-lbrace-space', +Affects: `cperl-font-lock', `cperl-electric-lbrace-space', `cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords', `cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings', @@ -1324,11 +1443,11 @@ :group 'cperl-indentation-details) -(defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;") - (RCS "$rcs = ' $Id\$ ' ;")) +(defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") + (RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")) "*What to use as `vc-header-alist' in CPerl." :type '(repeat (list symbol string)) :group 'cperl) -(defcustom cperl-clobber-mode-lists +(defcustom cperl-clobber-mode-lists (not (and @@ -1361,10 +1480,10 @@ (defcustom cperl-pod-face 'font-lock-comment-face - "*The result of evaluation of this expression is used for pod highlighting." + "*The result of evaluation of this expression is used for POD highlighting." :type 'face :group 'cperl-faces) (defcustom cperl-pod-head-face 'font-lock-variable-name-face - "*The result of evaluation of this expression is used for pod highlighting. + "*The result of evaluation of this expression is used for POD highlighting. Font for POD headers." :type 'face @@ -1382,5 +1501,5 @@ (defcustom cperl-pod-here-fontify '(featurep 'font-lock) - "*Not-nil after evaluation means to highlight pod and here-docs sections." + "*Not-nil after evaluation means to highlight POD and here-docs sections." :type 'boolean :group 'cperl-faces) @@ -1392,14 +1511,14 @@ (defcustom cperl-highlight-variables-indiscriminately nil - "*Not-nil means perform additional hightlighting on variables. -Currently only changes how scalar variables are hightlighted. + "*Non-nil means perform additional highlighting on variables. +Currently only changes how scalar variables are highlighted. Note that that variable is only read at initialization time for -the variable perl-font-lock-keywords-2, so changing it after you've -entered cperl-mode the first time will have no effect." +the variable `perl-font-lock-keywords-2', so changing it after you've +entered CPerl mode the first time will have no effect." :type 'boolean :group 'cperl) (defcustom cperl-pod-here-scan t - "*Not-nil means look for pod and here-docs sections during startup. + "*Not-nil means look for POD and here-docs sections during startup. You can always make lookup from menu or using \\[cperl-find-pods-heres]." :type 'boolean @@ -1434,5 +1553,5 @@ :group 'cperl-help-system) -(defcustom cperl-use-syntax-table-text-property +(defcustom cperl-use-syntax-table-text-property (boundp 'parse-sexp-lookup-properties) "*Non-nil means CPerl sets up and uses `syntax-table' text property." @@ -1440,5 +1559,5 @@ :group 'cperl-speed) -(defcustom cperl-use-syntax-table-text-property-for-tags +(defcustom cperl-use-syntax-table-text-property-for-tags cperl-use-syntax-table-text-property "*Non-nil means: set up and use `syntax-table' text property generating TAGS." @@ -1451,5 +1570,6 @@ :group 'cperl) -(defcustom cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$" +(defcustom cperl-noscan-files-regexp + "/\\(\\.\\.?\\|SCCS\\|RCS\\|CVS\\|blib\\)$" "*Regexp to match files/dirs to skip when generating TAGS." :type 'regexp @@ -1458,5 +1578,5 @@ (defcustom cperl-regexp-indent-step nil "*Indentation used when beautifying regexps. -If `nil', the value of `cperl-indent-level' will be used." +If nil, the value of `cperl-indent-level' will be used." :type '(choice integer (const nil)) :group 'cperl-indentation-details) @@ -1492,5 +1612,5 @@ (defcustom cperl-break-one-line-blocks-when-indent t "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs -need to be reformated into multiline ones when indenting a region." +need to be reformatted into multiline ones when indenting a region." :type 'boolean :group 'cperl-indentation-details) @@ -1498,5 +1618,5 @@ (defcustom cperl-fix-hanging-brace-when-indent t "*Non-nil means that BLOCK-end `}' may be put on a separate line -when indenting a region. +when indenting a region. Braces followed by else/elsif/while/until are excepted." :type 'boolean @@ -1504,5 +1624,5 @@ (defcustom cperl-merge-trailing-else t - "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue + "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue may be merged to be on the same line when indenting a region." :type 'boolean @@ -1516,6 +1636,6 @@ :group 'cperl-indentation-details) -(defcustom cperl-syntaxify-by-font-lock - (and window-system +(defcustom cperl-syntaxify-by-font-lock + (and cperl-can-font-lock (boundp 'parse-sexp-lookup-properties)) "*Non-nil means that CPerl uses `font-lock's routines for syntaxification." @@ -1525,5 +1645,5 @@ (defcustom cperl-syntaxify-unwind t - "*Non-nil means that CPerl unwinds to a start of along construction + "*Non-nil means that CPerl unwinds to a start of a long construction when syntaxifying a chunk of buffer." :type 'boolean @@ -1543,5 +1663,5 @@ (underline nil "LightGray" strikeout)) "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." - :type '(repeat (cons symbol + :type '(repeat (cons symbol (cons (choice (const nil) string) (cons (choice (const nil) string) @@ -1549,9 +1669,9 @@ :group 'cperl-faces) -(if window-system +(if cperl-can-font-lock (progn - (defvar cperl-dark-background + (defvar cperl-dark-background (cperl-choose-color "navy" "os2blue" "darkgreen")) - (defvar cperl-dark-foreground + (defvar cperl-dark-foreground (cperl-choose-color "orchid1" "orange")) @@ -1561,7 +1681,7 @@ (((class grayscale) (background dark)) (:foreground "Gray80" :italic t :underline t :bold t)) - (((class color) (background light)) + (((class color) (background light)) (:foreground "chartreuse3")) - (((class color) (background dark)) + (((class color) (background dark)) (:foreground (, cperl-dark-foreground))) (t (:bold t :underline t)))) @@ -1574,7 +1694,7 @@ (((class grayscale) (background dark)) (:foreground "Gray80" :bold t)) - (((class color) (background light)) + (((class color) (background light)) (:foreground "Blue" :background "lightyellow2" :bold t)) - (((class color) (background dark)) + (((class color) (background dark)) (:foreground "yellow" :background (, cperl-dark-background) :bold t)) (t (:bold t)))) @@ -1587,7 +1707,7 @@ (((class grayscale) (background dark)) (:foreground "Gray80" :bold t :italic t)) - (((class color) (background light)) + (((class color) (background light)) (:foreground "Red" :background "lightyellow2" :bold t :italic t)) - (((class color) (background dark)) + (((class color) (background dark)) (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t)) (t (:bold t :italic t)))) @@ -1600,5 +1720,5 @@ (defvar cperl-tips 'please-ignore-this-line - "Get newest version of this package from + "Get maybe newer version of this package from ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs and/or @@ -1611,11 +1731,10 @@ \(this upgrades syntax-parsing abilities of RMS Emaxen v19.34 and v20.2 up to the level of RMS Emacs v20.3 - a must for a good Perl -mode.) You will not get much from XEmacs; its syntax abilities are -too primitive. +mode.) As of beginning of 2003, XEmacs may provide a similar ability. Get support packages choose-color.el (or font-lock-extra.el before 19.30), imenu-go.el from the same place. \(Look for other files there too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and -later you should use choose-color.el *instead* of font-lock-extra.el +later you should use choose-color.el *instead* of font-lock-extra.el \(and you will not get smart highlighting in C :-(). @@ -1626,7 +1745,11 @@ want it to: put the following into your .emacs file: -(autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t) - -Get perl5-info from + (autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t) + +or + + (defalias 'perl-mode 'cperl-mode) + +Get perl5-info from $CPAN/doc/manual/info/perl-info.tar.gz older version was on @@ -1638,5 +1761,5 @@ If some class structure is too complicated, use Tools/Hierarchy-view -from Perl menu, or hierarchic view of imenu. The second one uses the +from Perl menu, or hierarchic view of imenu. The second one uses the current buffer only, the first one requires generation of TAGS from Perl/Tools/Tags menu beforehand. @@ -1651,4 +1774,8 @@ M-x norm RET +or + + \\[normal-mode] + In cases of more severe confusion sometimes it is helpful to do @@ -1656,9 +1783,15 @@ M-x norm RET +or + + \\[load-library] cperl-mode RET + \\[normal-mode] + Before reporting (non-)problems look in the problem section of online micro-docs on what I know about CPerl problems.") (defvar cperl-problems 'please-ignore-this-line -"Some faces will not be shown on some versions of Emacs unless you + "Description of problems in CPerl mode. +Some faces will not be shown on some versions of Emacs unless you install choose-color.el, available from ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/ @@ -1670,7 +1803,7 @@ Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs 20.1. Most problems below are corrected starting from this version of -Emacs, and all of them should go with RMS's version 20.3. (Or apply -patches to Emacs 19.33/34 - see tips.) XEmacs is very backward in -this respect. +Emacs, and all of them should be fixed in RMS's version 20.3. (Or apply +patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in +this respect (until 2003). Note that even with newer Emacsen in some very rare cases the details @@ -1689,5 +1822,5 @@ This may be confusing, since the regexp s#//#/#\; may be highlighted as a comment, but it will be recognized as a regexp by the indentation -code. Or the opposite case, when a pod section is highlighted, but +code. Or the opposite case, when a POD section is highlighted, but may break the indentation of the following code (though indentation should work if the balance of delimiters is not broken by POD). @@ -1695,5 +1828,5 @@ The main trick (to make $ a \"backslash\") makes constructions like ${aaa} look like unbalanced braces. The only trick I can think of is -to insert it as $ {aaa} (legal in perl5, not in perl4). +to insert it as $ {aaa} (legal in perl5, not in perl4). Similar problems arise in regexps, when /(\\s|$)/ should be rewritten @@ -1707,5 +1840,5 @@ If these bugs cannot be fixed on your machine (say, you have an inferior environment and cannot recompile), you may still disable all the fancy stuff -via `cperl-use-syntax-table-text-property'." ) +via `cperl-use-syntax-table-text-property'.") (defvar cperl-non-problems 'please-ignore-this-line @@ -1766,10 +1899,10 @@ (defvar cperl-praise 'please-ignore-this-line - "RMS asked me to list good things about CPerl. Here they go: + "Advantages of CPerl mode. 0) It uses the newest `syntax-table' property ;-); 1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl -mode - but the latter number may have improved too in last years) even +mode - but the latter number may have improved too in last years) even with old Emaxen which do not support `syntax-table' property. @@ -1835,5 +1968,5 @@ progress indicator for indentation (with `imenu' loaded). -6) Indent-region improves inline-comments as well; also corrects +6) Indent-region improves inline-comments as well; also corrects whitespace *inside* the conditional/loop constructs. @@ -1843,10 +1976,9 @@ the settings present before the switch. -9) When doing indentation of control constructs, may correct +9) When doing indentation of control constructs, may correct line-breaks/spacing between elements of the construct. 10) Uses a linear-time algorith for indentation of regions (on Emaxen with -capable syntax engines). -") +capable syntax engines).") (defvar cperl-speed 'please-ignore-this-line @@ -1882,5 +2014,5 @@ to nil. -B) Speed of editing operations. +B) Speed of editing operations. One can add a (minor) speedup to editing operations by setting @@ -1892,31 +2024,30 @@ One can unset `cperl-syntaxify-unwind'. This might speed up editing - of, say, long POD sections. -") + of, say, long POD sections.") (defvar cperl-tips-faces 'please-ignore-this-line "CPerl mode uses following faces for highlighting: - cperl-array-face Array names - cperl-hash-face Hash names - font-lock-comment-face Comments, PODs and whatever is considered + `cperl-array-face' Array names + `cperl-hash-face' Hash names + `font-lock-comment-face' Comments, PODs and whatever is considered syntaxically to be not code - font-lock-constant-face HERE-doc delimiters, labels, delimiters of + `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of 2-arg operators s/y/tr/ or of RExen, - font-lock-function-name-face Special-cased m// and s//foo/, _ as + `font-lock-function-name-face' Special-cased m// and s//foo/, _ as a target of a file tests, file tests, subroutine names at the moment of definition (except those conflicting with Perl operators), package names (when recognized), format names - font-lock-keyword-face Control flow switch constructs, declarators - cperl-nonoverridable-face Non-overridable keywords, modifiers of RExen - font-lock-string-face Strings, qw() constructs, RExen, POD sections, + `font-lock-keyword-face' Control flow switch constructs, declarators + `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen + `font-lock-string-face' Strings, qw() constructs, RExen, POD sections, literal parts and the terminator of formats and whatever is syntaxically considered as string literals - font-lock-type-face Overridable keywords - font-lock-variable-name-face Variable declarations, indirect array and + `font-lock-type-face' Overridable keywords + `font-lock-variable-name-face' Variable declarations, indirect array and hash names, POD headers/item names - cperl-invalid-face Trailing whitespace + `cperl-invalid-face' Trailing whitespace Note that in several situations the highlighting tries to inform about @@ -1925,5 +2056,5 @@ m// and s/// which do not do what one would expect them to do. -Help with best setup of these faces for printout requested (for each of +Help with best setup of these faces for printout requested (for each of the faces: please specify bold, italic, underline, shadow and box.) @@ -1933,6 +2064,4 @@ ;;; Portability stuff: - -(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) @@ -1946,7 +2075,7 @@ (car (append (where-is-internal 'delete-backward-char) (where-is-internal 'backward-delete-char-untabify))) - "Character generated by key bound to delete-backward-char.") - -(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) + "Character generated by key bound to `delete-backward-char'.") + +(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) @@ -1963,7 +2092,7 @@ (defsubst cperl-enable-font-lock () - (or cperl-xemacs-p window-system)) - -(defun cperl-putback-char (c) ; Emacs 19 + cperl-can-font-lock) + +(defun cperl-putback-char (c) ; Emacs 19 (set 'unread-command-events (list c))) ; Avoid undefined warning @@ -1994,5 +2123,5 @@ (defcustom cperl-mode-hook nil - "Hook run by `cperl-mode'." + "Hook run by CPerl mode." :type 'hook :group 'cperl) @@ -2001,5 +2130,5 @@ (defvar cperl-syntax-done-to nil) (defvar cperl-emacs-can-parse (> (length (save-excursion - (parse-partial-sexp 1 1))) 9)) + (parse-partial-sexp (point) (point)))) 9)) ;; Make customization possible "in reverse" @@ -2020,37 +2149,23 @@ (if (fboundp 'eval-when-compile) (eval-when-compile - (condition-case nil - (require 'imenu) - (error nil)) - (condition-case nil - (require 'easymenu) - (error nil)) - (condition-case nil - (require 'etags) - (error nil)) - (condition-case nil - (require 'timer) - (error nil)) - (condition-case nil - (require 'man) - (error nil)) - (condition-case nil - (require 'info) - (error nil)) + (mapcar (lambda (p) + (condition-case nil + (require p) + (error nil))) + '(imenu easymenu etags timer man info)) (if (fboundp 'ps-extend-face-list) (defmacro cperl-ps-extend-face-list (arg) (` (ps-extend-face-list (, arg)))) (defmacro cperl-ps-extend-face-list (arg) - (` (error "This version of Emacs has no `ps-extend-face-list'.")))) + (` (error "This version of Emacs has no `ps-extend-face-list'")))) ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, ;; macros instead of defsubsts don't work on Emacs, so we do the ;; expansion manually. Any other suggestions? - (if (or (string-match "XEmacs\\|Lucid" emacs-version) - window-system) + (if cperl-can-font-lock (require 'font-lock)) (require 'cl))) (defvar cperl-mode-abbrev-table nil - "Abbrev table in use in Cperl-mode buffers.") + "Abbrev table in use in CPerl mode buffers.") (add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))) @@ -2112,5 +2227,5 @@ 'cperl-get-help [(control c) (control h) v])) - (if (and cperl-xemacs-p + (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn @@ -2138,111 +2253,113 @@ (progn (require 'easymenu) - (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode" - '("Perl" - ["Beginning of function" beginning-of-defun t] - ["End of function" end-of-defun t] - ["Mark function" mark-defun t] - ["Indent expression" cperl-indent-exp t] - ["Fill paragraph/comment" cperl-fill-paragraph t] - "----" - ["Line up a construction" cperl-lineup (cperl-use-region-p)] - ["Invert if/unless/while etc" cperl-invert-if-unless t] - ("Regexp" - ["Beautify" cperl-beautify-regexp - cperl-use-syntax-table-text-property] - ["Beautify one level deep" (cperl-beautify-regexp 1) - cperl-use-syntax-table-text-property] - ["Beautify a group" cperl-beautify-level - cperl-use-syntax-table-text-property] - ["Beautify a group one level deep" (cperl-beautify-level 1) - cperl-use-syntax-table-text-property] - ["Contract a group" cperl-contract-level - cperl-use-syntax-table-text-property] - ["Contract groups" cperl-contract-levels - cperl-use-syntax-table-text-property]) - ["Refresh \"hard\" constructions" cperl-find-pods-heres t] - "----" - ["Indent region" cperl-indent-region (cperl-use-region-p)] - ["Comment region" cperl-comment-region (cperl-use-region-p)] - ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] - "----" - ["Run" mode-compile (fboundp 'mode-compile)] - ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) - (get-buffer "*compilation*"))] - ["Next error" next-error (get-buffer "*compilation*")] - ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] - "----" - ["Debugger" cperl-db t] - "----" - ("Tools" - ["Imenu" imenu (fboundp 'imenu)] - ["Insert spaces if needed" cperl-find-bad-style t] - ["Class Hierarchy from TAGS" cperl-tags-hier-init t] - ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] - ["CPerl pretty print (exprmntl)" cperl-ps-print - (fboundp 'ps-extend-face-list)] - ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] - ("Tags" + (easy-menu-define + cperl-menu cperl-mode-map "Menu for CPerl mode" + '("Perl" + ["Beginning of function" beginning-of-defun t] + ["End of function" end-of-defun t] + ["Mark function" mark-defun t] + ["Indent expression" cperl-indent-exp t] + ["Fill paragraph/comment" cperl-fill-paragraph t] + "----" + ["Line up a construction" cperl-lineup (cperl-use-region-p)] + ["Invert if/unless/while etc" cperl-invert-if-unless t] + ("Regexp" + ["Beautify" cperl-beautify-regexp + cperl-use-syntax-table-text-property] + ["Beautify one level deep" (cperl-beautify-regexp 1) + cperl-use-syntax-table-text-property] + ["Beautify a group" cperl-beautify-level + cperl-use-syntax-table-text-property] + ["Beautify a group one level deep" (cperl-beautify-level 1) + cperl-use-syntax-table-text-property] + ["Contract a group" cperl-contract-level + cperl-use-syntax-table-text-property] + ["Contract groups" cperl-contract-levels + cperl-use-syntax-table-text-property]) + ["Refresh \"hard\" constructions" cperl-find-pods-heres t] + "----" + ["Indent region" cperl-indent-region (cperl-use-region-p)] + ["Comment region" cperl-comment-region (cperl-use-region-p)] + ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] + "----" + ["Run" mode-compile (fboundp 'mode-compile)] + ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) + (get-buffer "*compilation*"))] + ["Next error" next-error (get-buffer "*compilation*")] + ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] + "----" + ["Debugger" cperl-db t] + "----" + ("Tools" + ["Imenu" imenu (fboundp 'imenu)] + ["Insert spaces if needed" cperl-find-bad-style t] + ["Class Hierarchy from TAGS" cperl-tags-hier-init t] + ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] + ["CPerl pretty print (exprmntl)" cperl-ps-print + (fboundp 'ps-extend-face-list)] + ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] + ("Tags" ;;; ["Create tags for current file" cperl-etags t] ;;; ["Add tags for current file" (cperl-etags t) t] ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] ;;; ["Add tags for Perl files in directory" (cperl-etags t t) t] -;;; ["Create tags for Perl files in (sub)directories" +;;; ["Create tags for Perl files in (sub)directories" ;;; (cperl-etags nil 'recursive) t] ;;; ["Add tags for Perl files in (sub)directories" -;;; (cperl-etags t 'recursive) t]) +;;; (cperl-etags t 'recursive) t]) ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) - ["Create tags for current file" (cperl-write-tags nil t) t] - ["Add tags for current file" (cperl-write-tags) t] - ["Create tags for Perl files in directory" - (cperl-write-tags nil t nil t) t] - ["Add tags for Perl files in directory" - (cperl-write-tags nil nil nil t) t] - ["Create tags for Perl files in (sub)directories" - (cperl-write-tags nil t t t) t] - ["Add tags for Perl files in (sub)directories" - (cperl-write-tags nil nil t t) t])) - ("Perl docs" - ["Define word at point" imenu-go-find-at-position - (fboundp 'imenu-go-find-at-position)] - ["Help on function" cperl-info-on-command t] - ["Help on function at point" cperl-info-on-current-command t] - ["Help on symbol at point" cperl-get-help t] - ["Perldoc" cperl-perldoc t] - ["Perldoc on word at point" cperl-perldoc-at-point t] - ["View manpage of POD in this file" cperl-pod-to-manpage t] - ["Auto-help on" cperl-lazy-install - (and (fboundp 'run-with-idle-timer) - (not cperl-lazy-installed))] - ["Auto-help off" (eval '(cperl-lazy-unstall)) - (and (fboundp 'run-with-idle-timer) - cperl-lazy-installed)]) - ("Toggle..." - ["Auto newline" cperl-toggle-auto-newline t] - ["Electric parens" cperl-toggle-electric t] - ["Electric keywords" cperl-toggle-abbrev t] - ["Fix whitespace on indent" cperl-toggle-construct-fix t] - ["Auto fill" auto-fill-mode t]) - ("Indent styles..." - ["CPerl" (cperl-set-style "CPerl") t] - ["PerlStyle" (cperl-set-style "PerlStyle") t] - ["GNU" (cperl-set-style "GNU") t] - ["C++" (cperl-set-style "C++") t] - ["FSF" (cperl-set-style "FSF") t] - ["BSD" (cperl-set-style "BSD") t] - ["Whitesmith" (cperl-set-style "Whitesmith") t] - ["Current" (cperl-set-style "Current") t] - ["Memorized" (cperl-set-style-back) cperl-old-style]) - ("Micro-docs" - ["Tips" (describe-variable 'cperl-tips) t] - ["Problems" (describe-variable 'cperl-problems) t] - ["Non-problems" (describe-variable 'cperl-non-problems) t] - ["Speed" (describe-variable 'cperl-speed) t] - ["Praise" (describe-variable 'cperl-praise) t] - ["Faces" (describe-variable 'cperl-tips-faces) t] - ["CPerl mode" (describe-function 'cperl-mode) t] - ["CPerl version" - (message "The version of master-file for this CPerl is %s" - cperl-version) t])))) + ["Create tags for current file" (cperl-write-tags nil t) t] + ["Add tags for current file" (cperl-write-tags) t] + ["Create tags for Perl files in directory" + (cperl-write-tags nil t nil t) t] + ["Add tags for Perl files in directory" + (cperl-write-tags nil nil nil t) t] + ["Create tags for Perl files in (sub)directories" + (cperl-write-tags nil t t t) t] + ["Add tags for Perl files in (sub)directories" + (cperl-write-tags nil nil t t) t])) + ("Perl docs" + ["Define word at point" imenu-go-find-at-position + (fboundp 'imenu-go-find-at-position)] + ["Help on function" cperl-info-on-command t] + ["Help on function at point" cperl-info-on-current-command t] + ["Help on symbol at point" cperl-get-help t] + ["Perldoc" cperl-perldoc t] + ["Perldoc on word at point" cperl-perldoc-at-point t] + ["View manpage of POD in this file" cperl-build-manpage t] + ["Auto-help on" cperl-lazy-install + (and (fboundp 'run-with-idle-timer) + (not cperl-lazy-installed))] + ["Auto-help off" cperl-lazy-unstall + (and (fboundp 'run-with-idle-timer) + cperl-lazy-installed)]) + ("Toggle..." + ["Auto newline" cperl-toggle-auto-newline t] + ["Electric parens" cperl-toggle-electric t] + ["Electric keywords" cperl-toggle-abbrev t] + ["Fix whitespace on indent" cperl-toggle-construct-fix t] + ["Auto-help on Perl constructs" cperl-toggle-autohelp t] + ["Auto fill" auto-fill-mode t]) + ("Indent styles..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PerlStyle" (cperl-set-style "PerlStyle") t] + ["GNU" (cperl-set-style "GNU") t] + ["C++" (cperl-set-style "C++") t] + ["FSF" (cperl-set-style "FSF") t] + ["BSD" (cperl-set-style "BSD") t] + ["Whitesmith" (cperl-set-style "Whitesmith") t] + ["Current" (cperl-set-style "Current") t] + ["Memorized" (cperl-set-style-back) cperl-old-style]) + ("Micro-docs" + ["Tips" (describe-variable 'cperl-tips) t] + ["Problems" (describe-variable 'cperl-problems) t] + ["Non-problems" (describe-variable 'cperl-non-problems) t] + ["Speed" (describe-variable 'cperl-speed) t] + ["Praise" (describe-variable 'cperl-praise) t] + ["Faces" (describe-variable 'cperl-tips-faces) t] + ["CPerl mode" (describe-function 'cperl-mode) t] + ["CPerl version" + (message "The version of master-file for this CPerl is %s" + cperl-version) t])))) (error nil)) @@ -2252,9 +2369,20 @@ t) +(defvar cperl-imenu--function-name-regexp-perl + (concat + "^\\(" + "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?" + "\\|" + "=head\\([12]\\)[ \t]+\\([^\n]+\\)$" + "\\)")) + +(defvar cperl-outline-regexp + (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`")) + (defvar cperl-mode-syntax-table nil - "Syntax table in use in Cperl-mode buffers.") + "Syntax table in use in CPerl mode buffers.") (defvar cperl-string-syntax-table nil - "Syntax table in use in Cperl-mode string-like chunks.") + "Syntax table in use in CPerl mode string-like chunks.") (if cperl-mode-syntax-table @@ -2282,6 +2410,5 @@ (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) (modify-syntax-entry ?$ "." cperl-string-syntax-table) - (modify-syntax-entry ?# "." cperl-string-syntax-table) ; (?# comment ) -) + (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment ) @@ -2299,5 +2426,11 @@ (defvar perl-font-lock-keywords-2) (defvar outline-level) -(defvar cperl-outline-regexp) +(if (fboundp 'defvaralias) + (let ((f 'defvaralias)) ; Some functions deduce stuff from the mode name... + (funcall f 'cperl-font-lock-keywords 'perl-font-lock-keywords) + (funcall f 'cperl-font-lock-keywords-1 'perl-font-lock-keywords-1) + (funcall f 'cperl-font-lock-keywords-2 'perl-font-lock-keywords-2))) + +(defvar cperl-use-major-mode 'perl-mode) ;;;###autoload @@ -2314,5 +2447,5 @@ default.) You can always quote (with \\[quoted-insert]) the left \"paren\" to avoid the expansion. The processing of < is special, -since most the time you mean \"less\". Cperl mode tries to guess +since most the time you mean \"less\". CPerl mode tries to guess whether you want to type pair <>, and inserts is if it appropriate. You can set `cperl-electric-parens-string' to the string that @@ -2324,5 +2457,5 @@ CPerl mode provides expansion of the Perl control constructs: - if, else, elsif, unless, while, until, continue, do, + if, else, elsif, unless, while, until, continue, do, for, foreach, formy and foreachmy. @@ -2337,5 +2470,5 @@ typing \\[cperl-linefeed] places you - appropriately indented - on a new line between the braces (if you typed \\[cperl-linefeed] in a POD -directive line, then appropriate number of new lines is inserted). +directive line, then appropriate number of new lines is inserted). If CPerl decides that you want to insert \"English\" style construct like @@ -2356,6 +2489,6 @@ and you are on a boundary of a statement inside braces, it will transform the construct into a multiline and will place you into an -appropriately indented blank line. If you need a usual -`newline-and-indent' behaviour, it is on \\[newline-and-indent], +appropriately indented blank line. If you need a usual +`newline-and-indent' behaviour, it is on \\[newline-and-indent], see documentation on `cperl-electric-linefeed'. @@ -2388,5 +2521,5 @@ These keys run commands `cperl-info-on-current-command' and `cperl-info-on-command', which one is which is controlled by variable -`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings' +`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings' \(in turn affected by `cperl-hairy'). @@ -2406,5 +2539,5 @@ Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', -`cperl-pod-face', `cperl-pod-head-face' control processing of pod and +`cperl-pod-face', `cperl-pod-head-face' control processing of POD and here-docs sections. With capable Emaxen results of scan are used for indentation too, otherwise they are used for highlighting only. @@ -2420,6 +2553,6 @@ and after colons and semicolons, inserted in Perl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. - Insertion after colons requires both this variable and - `cperl-auto-newline-after-colon' set. + Insertion after colons requires both this variable and + `cperl-auto-newline-after-colon' set. `cperl-auto-newline-after-colon' Non-nil means automatically newline even after colons. @@ -2457,5 +2590,5 @@ If `cperl-indent-level' is 0, the statement after opening brace in -column 0 is indented on +column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'. @@ -2481,5 +2614,5 @@ (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command [(control c) (control h) f]))) - (setq major-mode 'perl-mode) + (setq major-mode cperl-use-major-mode) (setq mode-name "CPerl") (if (not cperl-mode-abbrev-table) @@ -2534,5 +2667,5 @@ (setq comment-start-skip "#+ *") (make-local-variable 'defun-prompt-regexp) - (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)[ \t]*") + (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'cperl-comment-indent) @@ -2544,5 +2677,5 @@ (make-local-variable 'imenu-create-index-function) (setq imenu-create-index-function - (function imenu-example--create-perl-index)) + (function cperl-imenu--create-perl-index)) (make-local-variable 'imenu-sort-function) (setq imenu-sort-function nil) @@ -2565,5 +2698,5 @@ (if cperl-use-syntax-table-text-property (progn - (make-variable-buffer-local 'parse-sexp-lookup-properties) + (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t) @@ -2571,29 +2704,32 @@ (or (boundp 'font-lock-unfontify-region-function) (set 'font-lock-unfontify-region-function - 'font-lock-default-unfontify-region)) - (make-variable-buffer-local 'font-lock-unfontify-region-function) - (set 'font-lock-unfontify-region-function + 'font-lock-default-unfontify-region)) + (make-local-variable 'font-lock-unfontify-region-function) + (set 'font-lock-unfontify-region-function ; not present with old Emacs 'cperl-font-lock-unfontify-region-function) - (make-variable-buffer-local 'cperl-syntax-done-to) + (make-local-variable 'cperl-syntax-done-to) ;; Another bug: unless font-lock-syntactic-keywords, font-lock ;; ignores syntax-table text-property. (t) is a hack ;; to make font-lock think that font-lock-syntactic-keywords ;; are defined - (make-variable-buffer-local 'font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords + (make-local-variable 'font-lock-syntactic-keywords) + (setq font-lock-syntactic-keywords (if cperl-syntaxify-by-font-lock '(t (cperl-fontify-syntaxically)) '(t))))) (make-local-variable 'cperl-old-style) - (or (fboundp 'cperl-old-auto-fill-mode) - (progn - (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) - (defun auto-fill-mode (&optional arg) - (interactive "P") - (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning - (and auto-fill-function (eq major-mode 'perl-mode) - (setq auto-fill-function 'cperl-do-auto-fill))))) + (if (boundp 'normal-auto-fill-function) ; 19.33 and later + (set (make-local-variable 'normal-auto-fill-function) + 'cperl-do-auto-fill) ; RMS has it as #'cperl-do-auto-fill ??? + (or (fboundp 'cperl-old-auto-fill-mode) + (progn + (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) + (defun auto-fill-mode (&optional arg) + (interactive "P") + (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning + (and auto-fill-function (memq major-mode '(perl-mode cperl-mode)) + (setq auto-fill-function 'cperl-do-auto-fill)))))) (if (cperl-enable-font-lock) - (if (cperl-val 'cperl-font-lock) + (if (cperl-val 'cperl-font-lock) (progn (or cperl-faces-init (cperl-init-faces)) (font-lock-mode 1)))) @@ -2605,14 +2741,10 @@ (run-hooks 'cperl-mode-hook) ;; After hooks since fontification will break this - (if cperl-pod-here-scan - (or ;;(and (boundp 'font-lock-mode) - ;; (eval 'font-lock-mode) ; Avoid warning - ;; (boundp 'font-lock-hot-pass) ; Newer font-lock - cperl-syntaxify-by-font-lock ;;) + (if cperl-pod-here-scan + (or cperl-syntaxify-by-font-lock (progn (or cperl-faces-init (cperl-init-faces-weak)) (cperl-find-pods-heres))))) ;; Fix for perldb - make default reasonable -(defvar gud-perldb-history) (defun cperl-db () (interactive) @@ -2622,12 +2754,11 @@ (car gud-perldb-history) (concat "perl " ;;(file-name-nondirectory - ;; I have problems - ;; in OS/2 - ;; otherwise - (buffer-file-name))) + ;; I have problems + ;; in OS/2 + ;; otherwise + (buffer-file-name))) nil nil '(gud-perldb-history . 1)))) -(defvar msb-menu-cond) (defun cperl-msb-fix () ;; Adds perl files to msb menu, supposes that msb is already loaded @@ -2639,5 +2770,5 @@ (setcdr precdr (list (list - '(eq major-mode 'perl-mode) + '(memq major-mode '(cperl-mode perl-mode)) handle "Perl Files (%d)") @@ -2689,5 +2820,5 @@ ;;; (if (= c comment-column) nil ;;; (setq cnt (skip-chars-backward "[ \t]")) -;;; (setq target (max (1+ (setq prevc +;;; (setq target (max (1+ (setq prevc ;;; (current-column))) ; Else indent at comment column ;;; comment-column)) @@ -2731,12 +2862,12 @@ If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the place (even in empty line), but not after. If after \")\" and the inserted -char is \"{\", insert extra newline before only if +char is \"{\", insert extra newline before only if `cperl-extra-newline-before-brace'." (interactive "P") (let (insertpos (other-end (if (and cperl-electric-parens-mark - (cperl-mark-active) + (cperl-mark-active) (< (mark) (point))) - (mark) + (mark) nil))) (if (and other-end @@ -2752,12 +2883,14 @@ (cperl-electric-lbrace arg insertpos)) (forward-char 1)) - ;: Check whether we close something "usual" with `}' + ;; Check whether we close something "usual" with `}' (if (and (eq last-command-char ?\}) - (not + (not (condition-case nil (save-excursion (up-list (- (prefix-numeric-value arg))) ;;(cperl-after-block-p (point-min)) - (cperl-after-expr-p nil "{;)")) + (or (cperl-after-expr-p nil "{;)") + ;; after sub, else, continue + (cperl-after-block-p nil 'pre))) (error nil)))) ;; Just insert the guy @@ -2776,5 +2909,5 @@ (skip-chars-backward " \t") (eq (preceding-char) ?\)))) - (if cperl-auto-newline + (if cperl-auto-newline (progn (cperl-indent-line) (newline) t) nil))) (progn @@ -2789,5 +2922,5 @@ (save-excursion (if insertpos (progn (goto-char insertpos) - (search-forward (make-string + (search-forward (make-string 1 last-command-char)) (setq insertpos (1- (point))))) @@ -2802,15 +2935,15 @@ "Insert character, correct line's indentation, correct quoting by space." (interactive "P") - (let (pos after - (cperl-brace-recursing t) - (cperl-auto-newline cperl-auto-newline) - (other-end (or end - (if (and cperl-electric-parens-mark - (cperl-mark-active) - (> (mark) (point))) - (save-excursion - (goto-char (mark)) - (point-marker)) - nil)))) + (let ((cperl-brace-recursing t) + (cperl-auto-newline cperl-auto-newline) + (other-end (or end + (if (and cperl-electric-parens-mark + (cperl-mark-active) + (> (mark) (point))) + (save-excursion + (goto-char (mark)) + (point-marker)) + nil))) + pos after) (and (cperl-val 'cperl-electric-lbrace-space) (eq (preceding-char) ?$) @@ -2820,5 +2953,5 @@ (insert ?\ )) ;; Check whether we are in comment - (if (and + (if (and (save-excursion (beginning-of-line) @@ -2830,5 +2963,5 @@ (and (cperl-val 'cperl-electric-parens) (eq last-command-char ?{) - (memq last-command-char + (memq last-command-char (append cperl-electric-parens-string nil)) (or (if other-end (goto-char (marker-position other-end))) @@ -2839,13 +2972,14 @@ (defun cperl-electric-paren (arg) - "Insert a matching pair of parentheses." + "Insert an opening parenthesis or a matching pair of parentheses. +See `cperl-electric-parens'." (interactive "P") (let ((beg (save-excursion (beginning-of-line) (point))) (other-end (if (and cperl-electric-parens-mark - (cperl-mark-active) + (cperl-mark-active) (> (mark) (point))) - (save-excursion - (goto-char (mark)) - (point-marker)) + (save-excursion + (goto-char (mark)) + (point-marker)) nil))) (if (and (cperl-val 'cperl-electric-parens) @@ -2863,5 +2997,5 @@ (self-insert-command (prefix-numeric-value arg)) (if other-end (goto-char (marker-position other-end))) - (insert (make-string + (insert (make-string (prefix-numeric-value arg) (cdr (assoc last-command-char '((?{ .?}) @@ -2874,5 +3008,6 @@ (defun cperl-electric-rparen (arg) "Insert a matching pair of parentheses if marking is active. -If not, or if we are not at the end of marking range, would self-insert." +If not, or if we are not at the end of marking range, would self-insert. +Affected by `cperl-electric-parens'." (interactive "P") (let ((beg (save-excursion (beginning-of-line) (point))) @@ -2881,7 +3016,7 @@ (memq last-command-char (append cperl-electric-parens-string nil)) - (cperl-mark-active) + (cperl-mark-active) (< (mark) (point))) - (mark) + (mark) nil)) p) @@ -2899,7 +3034,7 @@ (prefix-numeric-value arg) (cdr (assoc last-command-char '((?\} . ?\{) - (?\] . ?\[) - (?\) . ?\() - (?\> . ?\<)))))) + (?\] . ?\[) + (?\) . ?\() + (?\> . ?\<)))))) (goto-char (1+ p))) (self-insert-command (prefix-numeric-value arg))))) @@ -2909,5 +3044,5 @@ Help message may be switched off by setting `cperl-message-electric-keyword' to nil." - (let ((beg (save-excursion (beginning-of-line) (point))) + (let ((beg (save-excursion (beginning-of-line) (point))) (dollar (and (eq last-command-char ?$) (eq this-command 'self-insert-command))) @@ -2922,6 +3057,6 @@ (error nil)) (cperl-after-expr-p nil "{;:")) - (save-excursion - (not + (save-excursion + (not (re-search-backward "[#\"'`]\\|\\" @@ -2934,4 +3069,6 @@ 'syntax-type) 'pod)))))) + (save-excursion (forward-sexp -1) + (not (memq (following-char) (append "$@%&*" nil)))) (progn (and (eq (preceding-char) ?y) @@ -2940,6 +3077,6 @@ (insert " ") (forward-char 2) - (setq my t dollar t - delete + (setq my t dollar t + delete (memq this-command '(self-insert-command newline))))) (and dollar (insert " $")) @@ -2956,13 +3093,16 @@ (and do (insert " while ();"))) (t - (insert (if do " {\n} while ();" " () {\n}"))) - ) + (insert (if do " {\n} while ();" " () {\n}")))) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (if dollar (progn (search-backward "$") - (if my + (if my (forward-char 1) (delete-char 1))) - (search-backward ")")) + (search-backward ")") + (if (eq last-command-char ?\() + (progn ; Avoid "if (())" + (delete-backward-char 1) + (delete-backward-char -1)))) (if delete (cperl-putback-char cperl-del-back-ch)) @@ -2987,5 +3127,5 @@ (and (save-excursion (forward-word -1) - (and + (and (eq (preceding-char) ?=) (progn @@ -2995,10 +3135,10 @@ (forward-char -1) (bolp)) - (or + (or (get-text-property (point) 'in-pod) (cperl-after-expr-p nil "{;:") (and (re-search-backward - ;; "\\(\\`\n?\\|\n\n\\)=\\sw+" - "\\(\\`\n?\\|^\n\\)=\\sw+" + ;; "\\(\\`\n?\\|\n\n\\)=\\sw+" + "\\(\\`\n?\\|^\n\\)=\\sw+" (point-min) t) (not (or @@ -3015,16 +3155,16 @@ (cperl-ensure-newlines 2) (forward-word -2) - (if (and head1 - (not + (if (and head1 + (not (save-excursion (forward-char -1) (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" - nil t)))) ; Only one - (progn + nil t)))) ; Only one + (progn (forward-word 1) (setq name (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) p (point)) - (insert " NAME\n\n" name + (insert " NAME\n\n" name " - \n\n=head1 SYNOPSIS\n\n\n\n" "=head1 DESCRIPTION") @@ -3056,6 +3196,6 @@ (backward-sexp 1) (cperl-after-expr-p nil "{;:")) - (save-excursion - (not + (save-excursion + (not (re-search-backward "[#\"'`]\\|\\" @@ -3077,6 +3217,5 @@ (insert "\n\n}")) (t - (insert " {\n\n}")) - ) + (insert " {\n\n}"))) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) @@ -3096,7 +3235,7 @@ (pos (point)) start over cut res) (if (and ; Check if we need to split: - ; i.e., on a boundary and inside "{...}" + ; i.e., on a boundary and inside "{...}" (save-excursion (cperl-to-comment-or-eol) - (>= (point) pos)) ; Not in a comment + (>= (point) pos)) ; Not in a comment (or (save-excursion (skip-chars-backward " \t" beg) @@ -3107,5 +3246,5 @@ (save-excursion (and - (eq (car (parse-partial-sexp pos end -1)) -1) + (eq (car (parse-partial-sexp pos end -1)) -1) ; Leave the level of parens (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr @@ -3135,5 +3274,5 @@ (beginning-of-line) (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement - ; after, move it to separate line + ; after, move it to separate line (progn (end-of-line) @@ -3145,5 +3284,5 @@ (cperl-indent-line) (forward-line -1))) - (forward-line -1) ; We are on the line before target + (forward-line -1) ; We are on the line before target (end-of-line) (newline-and-indent)) @@ -3154,5 +3293,5 @@ (skip-chars-backward " \t") (eq (preceding-char) ?\)))) ; Probably if () {} group - ; with an extra newline. + ; with an extra newline. (forward-line 2) (cperl-indent-line)) @@ -3162,5 +3301,5 @@ ;; We are after \n now, so look for the rest (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+") - (progn + (progn (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>")) (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>")) @@ -3206,9 +3345,10 @@ "Insert character and correct line's indentation." (interactive "P") - (let (insertpos (end (point)) - (auto (and cperl-auto-newline - (or (not (eq last-command-char ?:)) - cperl-auto-newline-after-colon)))) - (if (and ;;(not arg) + (let ((end (point)) + (auto (and cperl-auto-newline + (or (not (eq last-command-char ?:)) + cperl-auto-newline-after-colon))) + insertpos) + (if (and ;;(not arg) (eolp) (not (save-excursion @@ -3253,14 +3393,14 @@ (defun cperl-electric-backspace (arg) - "Backspace-untabify, or remove the whitespace around the point inserted -by an electric key." + "Backspace, or remove the whitespace around the point inserted by an electric +key. Will untabivy if `cperl-electric-backspace-untabify' is non-nil." (interactive "p") - (if (and cperl-auto-newline - (memq last-command '(cperl-electric-semi + (if (and cperl-auto-newline + (memq last-command '(cperl-electric-semi cperl-electric-terminator cperl-electric-lbrace)) (memq (preceding-char) '(?\ ?\t ?\n))) (let (p) - (if (eq last-command 'cperl-electric-lbrace) + (if (eq last-command 'cperl-electric-lbrace) (skip-chars-forward " \t\n")) (setq p (point)) @@ -3270,5 +3410,5 @@ ;; We are removing the whitespace *inside* cperl-electric-else (setq this-command 'cperl-electric-else-really)) - (if (and cperl-auto-newline + (if (and cperl-auto-newline (eq last-command 'cperl-electric-else-really) (memq (preceding-char) '(?\ ?\t ?\n))) @@ -3278,5 +3418,7 @@ (skip-chars-backward " \t\n") (delete-region (point) p)) - (backward-delete-char-untabify arg)))) + (if cperl-electric-backspace-untabify + (backward-delete-char-untabify arg) + (delete-backward-char arg))))) (defun cperl-inside-parens-p () @@ -3292,5 +3434,5 @@ (defun cperl-indent-command (&optional whole-exp) "Indent current line as Perl code, or in some cases insert a tab character. -If `cperl-tab-always-indent' is non-nil (the default), always indent current +If `cperl-tab-always-indent' is non-nil (the default), always indent current line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. @@ -3328,7 +3470,7 @@ "Indent current line as Perl code. Return the amount the indentation changed by." - (let (indent i beg shift-amt - (case-fold-search nil) - (pos (- (point-max) (point)))) + (let ((case-fold-search nil) + (pos (- (point-max) (point))) + indent i beg shift-amt) (setq indent (cperl-calculate-indent parse-data) i indent) @@ -3380,5 +3522,5 @@ ;; returns list (START STATE DEPTH PRESTART), ;; START is a good place to start parsing, or equal to - ;; PARSE-START if preset, + ;; PARSE-START if preset, ;; STATE is what is returned by `parse-partial-sexp'. ;; DEPTH is true is we are immediately after end of block @@ -3408,5 +3550,5 @@ (list start state depth prestart)))) -(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! +(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! ;; Positions is before ?\{. Checks whether it starts a block. ;; No save-excursion! @@ -3426,5 +3568,5 @@ (progn (backward-sexp) - (looking-at + (looking-at "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*\\(([^()]*)[ \t\n\f]*\\)?[#{]"))))))))) @@ -3437,5 +3579,6 @@ Will not correct the indentation for labels, but will correct it for braces -and closing parentheses and brackets.." +and closing parentheses and brackets." + (cperl-update-syntaxification (point) (point)) (save-excursion (if (or @@ -3445,123 +3588,124 @@ ;; before start of POD - whitespace found since do not have 'pod! (and (looking-at "[ \t]*\n=") - (error "Spaces before pod section!")) + (error "Spaces before POD section!")) (and (not cperl-indent-left-aligned-comments) (looking-at "^#"))) nil - (beginning-of-line) - (let ((indent-point (point)) - (char-after (save-excursion - (skip-chars-forward " \t") - (following-char))) - (in-pod (get-text-property (point) 'in-pod)) - (pre-indent-point (point)) - p prop look-prop is-block delim) - (cond - (in-pod - ;; In the verbatim part, probably code example. What to do??? - ) - (t - (save-excursion - ;; Not in pod - (cperl-backward-to-noncomment nil) - (setq p (max (point-min) (1- (point))) - prop (get-text-property p 'syntax-type) - look-prop (or (nth 1 (assoc prop cperl-look-for-prop)) - 'syntax-type)) - (if (memq prop '(pod here-doc format here-doc-delim)) + (beginning-of-line) + (let ((indent-point (point)) + (char-after (save-excursion + (skip-chars-forward " \t") + (following-char))) + (in-pod (get-text-property (point) 'in-pod)) + (pre-indent-point (point)) + p prop look-prop is-block delim) + (cond + (in-pod + ;; In the verbatim part, probably code example. What to do??? + ) + (t + (save-excursion + ;; Not in POD + (cperl-backward-to-noncomment nil) + (setq p (max (point-min) (1- (point))) + prop (get-text-property p 'syntax-type) + look-prop (or (nth 1 (assoc prop cperl-look-for-prop)) + 'syntax-type)) + (if (memq prop '(pod here-doc format here-doc-delim)) + (progn + (goto-char (or (previous-single-property-change p look-prop) + (point-min))) + (beginning-of-line) + (setq pre-indent-point (point))))))) + (goto-char pre-indent-point) + (let* ((case-fold-search nil) + (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) + (start (or (nth 2 parse-data) + (nth 0 s-s))) + (state (nth 1 s-s)) + (containing-sexp (car (cdr state))) + old-indent) + (if (and + ;;containing-sexp ;; We are buggy at toplevel :-( + parse-data) (progn - (goto-char (or (previous-single-property-change p look-prop) - (point-min))) - (beginning-of-line) - (setq pre-indent-point (point))))))) - (goto-char pre-indent-point) - (let* ((case-fold-search nil) - (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) - (start (or (nth 2 parse-data) - (nth 0 s-s))) - (state (nth 1 s-s)) - (containing-sexp (car (cdr state))) - old-indent) - (if (and - ;;containing-sexp ;; We are buggy at toplevel :-( - parse-data) - (progn - (setcar parse-data pre-indent-point) - (setcar (cdr parse-data) state) - (or (nth 2 parse-data) - (setcar (cddr parse-data) start)) - ;; Before this point: end of statement - (setq old-indent (nth 3 parse-data)))) - (cond ((get-text-property (point) 'indentable) - ;; indent to just after the surrounding open, - ;; skip blanks if we do not close the expression. - (goto-char (1+ (previous-single-property-change (point) 'indentable))) - (or (memq char-after (append ")]}" nil)) - (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (current-column)) - ((or (nth 3 state) (nth 4 state)) - ;; return nil or t if should not change this line - (nth 4 state)) - ;; XXXX Do we need to special-case this? - ((null containing-sexp) - ;; Line is at top level. May be data or function definition, - ;; or may be function argument declaration. - ;; Indent like the previous top level line - ;; unless that ends in a closeparen without semicolon, - ;; in which case this line is the first argument decl. - (skip-chars-forward " \t") - (+ (save-excursion - (goto-char start) - (- (current-indentation) - (if (nth 2 s-s) cperl-indent-level 0))) - (if (= char-after ?{) cperl-continued-brace-offset 0) - (progn - (cperl-backward-to-noncomment (or old-indent (point-min))) - ;; Look at previous line that's at column 0 - ;; to determine whether we are in top-level decls - ;; or function's arg decls. Set basic-indent accordingly. - ;; Now add a little if this is a continuation line. - (if (or (bobp) - (eq (point) old-indent) ; old-indent was at comment - (eq (preceding-char) ?\;) - ;; Had ?\) too - (and (eq (preceding-char) ?\}) - (cperl-after-block-and-statement-beg - (point-min))) ; Was start - too close - (memq char-after (append ")]}" nil)) - (and (eq (preceding-char) ?\:) ; label - (progn - (forward-sexp -1) - (skip-chars-backward " \t") - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) - (progn - (if (and parse-data - (not (eq char-after ?\C-j))) - (setcdr (cddr parse-data) - (list pre-indent-point))) - 0) - cperl-continued-statement-offset)))) - ((not - (or (setq is-block - (and (setq delim (= (char-after containing-sexp) ?{)) - (save-excursion ; Is it a hash? - (goto-char containing-sexp) - (cperl-block-p)))) - cperl-indent-parens-as-block)) - ;; group is an expression, not a block: - ;; indent to just after the surrounding open parens, - ;; skip blanks if we do not close the expression. - (goto-char (1+ containing-sexp)) - (or (memq char-after - (append (if delim "}" ")]}") nil)) - (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (+ (current-column) - (if (and delim - (eq char-after ?\})) - ;; Correct indentation of trailing ?\} - (+ cperl-indent-level cperl-close-paren-offset) - 0))) + (setcar parse-data pre-indent-point) + (setcar (cdr parse-data) state) + (or (nth 2 parse-data) + (setcar (cddr parse-data) start)) + ;; Before this point: end of statement + (setq old-indent (nth 3 parse-data)))) + (cond ((get-text-property (point) 'indentable) + ;; indent to just after the surrounding open, + ;; skip blanks if we do not close the expression. + (goto-char (1+ (previous-single-property-change (point) 'indentable))) + (or (memq char-after (append ")]}" nil)) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (current-column)) + ((or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state)) + ;; XXXX Do we need to special-case this? + ((null containing-sexp) + ;; Line is at top level. May be data or function definition, + ;; or may be function argument declaration. + ;; Indent like the previous top level line + ;; unless that ends in a closeparen without semicolon, + ;; in which case this line is the first argument decl. + (skip-chars-forward " \t") + (+ (save-excursion + (goto-char start) + (- (current-indentation) + (if (nth 2 s-s) cperl-indent-level 0))) + (if (= char-after ?{) cperl-continued-brace-offset 0) + (progn + (cperl-backward-to-noncomment (or old-indent (point-min))) + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordingly. + ;; Now add a little if this is a continuation line. + (if (or (bobp) + (eq (point) old-indent) ; old-indent was at comment + (eq (preceding-char) ?\;) + ;; Had ?\) too + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg + (point-min))) ; Was start - too close + (memq char-after (append ")]}" nil)) + (and (eq (preceding-char) ?\:) ; label + (progn + (forward-sexp -1) + (skip-chars-backward " \t") + (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) + (get-text-property (point) 'first-format-line)) + (progn + (if (and parse-data + (not (eq char-after ?\C-j))) + (setcdr (cddr parse-data) + (list pre-indent-point))) + 0) + cperl-continued-statement-offset)))) + ((not + (or (setq is-block + (and (setq delim (= (char-after containing-sexp) ?{)) + (save-excursion ; Is it a hash? + (goto-char containing-sexp) + (cperl-block-p)))) + cperl-indent-parens-as-block)) + ;; group is an expression, not a block: + ;; indent to just after the surrounding open parens, + ;; skip blanks if we do not close the expression. + (goto-char (1+ containing-sexp)) + (or (memq char-after + (append (if delim "}" ")]}") nil)) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (+ (current-column) + (if (and delim + (eq char-after ?\})) + ;; Correct indentation of trailing ?\} + (+ cperl-indent-level cperl-close-paren-offset) + 0))) ;;; ((and (/= (char-after containing-sexp) ?{) ;;; (not cperl-indent-parens-as-block)) @@ -3585,151 +3729,157 @@ ;;; (+ (current-column) ; Correct indentation of trailing ?\} ;;; (if (eq char-after ?\}) (+ cperl-indent-level -;;; cperl-close-paren-offset) +;;; cperl-close-paren-offset) ;;; 0))) - (t - ;; Statement level. Is it a continuation or a new statement? - ;; Find previous non-comment character. - (goto-char pre-indent-point) - (cperl-backward-to-noncomment containing-sexp) - ;; Back up over label lines, since they don't - ;; affect whether our line is a continuation. - ;; (Had \, too) - (while ;;(or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (or;;(eq (char-after (- (point) 2)) ?\') ; ???? - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_)))) - ;;) - (if (eq (preceding-char) ?\,) - ;; Will go to beginning of line, essentially. - ;; Will ignore embedded sexpr XXXX. - (cperl-backward-to-start-of-continued-exp containing-sexp)) - (beginning-of-line) - (cperl-backward-to-noncomment containing-sexp)) - ;; Now we get the answer. - (if (not (or (eq (1- (point)) containing-sexp) - (memq (preceding-char) - (append (if is-block " ;{" " ,;{") '(nil))) - (and (eq (preceding-char) ?\}) - (cperl-after-block-and-statement-beg - containing-sexp)))) - ;; This line is continuation of preceding line's statement; - ;; indent `cperl-continued-statement-offset' more than the - ;; previous line of the statement. - ;; - ;; There might be a label on this line, just - ;; consider it bad style and ignore it. - (progn - (cperl-backward-to-start-of-continued-exp containing-sexp) - (+ (if (memq char-after (append "}])" nil)) - 0 ; Closing parenth - cperl-continued-statement-offset) - (if (or is-block - (not delim) - (not (eq char-after ?\}))) - 0 - ;; Now it is a hash reference - (+ cperl-indent-level cperl-close-paren-offset)) - (if (looking-at "\\w+[ \t]*:") - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not move `parse-data', this should - ;; be quick anyway (this comment comes - ;;from different location): - (cperl-calculate-indent)) - (current-column)) - (if (eq char-after ?\{) - cperl-continued-brace-offset 0))) - ;; This line starts a new statement. - ;; Position following last unclosed open. - (goto-char containing-sexp) - ;; Is line first statement after an open-brace? - (or - ;; If no, find that first statement and indent like - ;; it. If the first statement begins with label, do - ;; not believe when the indentation of the label is too - ;; small. - (save-excursion - (forward-char 1) - (setq old-indent (current-indentation)) - (let ((colon-line-end 0)) - (while (progn (skip-chars-forward " \t\n") - (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) - ;; Skip over comments and labels following openbrace. - (cond ((= (following-char) ?\#) - (forward-line 1)) - ;; label: - (t - (save-excursion (end-of-line) - (setq colon-line-end (point))) - (search-forward ":")))) - ;; The first following code counts - ;; if it is before the line we want to indent. - (and (< (point) indent-point) - (if (> colon-line-end (point)) ; After label - (if (> (current-indentation) - cperl-min-label-indent) + (t + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (goto-char pre-indent-point) + (cperl-backward-to-noncomment containing-sexp) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + ;; (Had \, too) + (while ;;(or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (or ;;(eq (char-after (- (point) 2)) ?\') ; ???? + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_)))) + ;;) + (if (eq (preceding-char) ?\,) + ;; Will go to beginning of line, essentially. + ;; Will ignore embedded sexpr XXXX. + (cperl-backward-to-start-of-continued-exp containing-sexp)) + (beginning-of-line) + (cperl-backward-to-noncomment containing-sexp)) + ;; Now we get the answer. + (if (not (or (eq (1- (point)) containing-sexp) + (memq (preceding-char) + (append (if is-block " ;{" " ,;{") '(nil))) + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg + containing-sexp)) + (get-text-property (point) 'first-format-line))) + ;; This line is continuation of preceding line's statement; + ;; indent `cperl-continued-statement-offset' more than the + ;; previous line of the statement. + ;; + ;; There might be a label on this line, just + ;; consider it bad style and ignore it. + (progn + (cperl-backward-to-start-of-continued-exp containing-sexp) + (+ (if (memq char-after (append "}])" nil)) + 0 ; Closing parenth + cperl-continued-statement-offset) + (if (or is-block + (not delim) + (not (eq char-after ?\}))) + 0 + ;; Now it is a hash reference + (+ cperl-indent-level cperl-close-paren-offset)) + (if (looking-at "\\w+[ \t]*:") + (if (> (current-indentation) cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not move `parse-data', this should + ;; be quick anyway (this comment comes + ;; from different location): + (cperl-calculate-indent)) + (current-column)) + (if (eq char-after ?\{) + cperl-continued-brace-offset 0))) + ;; This line starts a new statement. + ;; Position following last unclosed open. + (goto-char containing-sexp) + ;; Is line first statement after an open-brace? + (or + ;; If no, find that first statement and indent like + ;; it. If the first statement begins with label, do + ;; not believe when the indentation of the label is too + ;; small. + (save-excursion + (forward-char 1) + (setq old-indent (current-indentation)) + (let ((colon-line-end 0)) + (while + (progn (skip-chars-forward " \t\n") + (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]")) + ;; Skip over comments and labels following openbrace. + (cond ((= (following-char) ?\#) + (forward-line 1)) + ((= (following-char) ?\=) + (goto-char + (or (next-single-property-change (point) 'in-pod) + (point-max)))) ; do not loop if no syntaxification + ;; label: + (t + (save-excursion (end-of-line) + (setq colon-line-end (point))) + (search-forward ":")))) + ;; The first following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (if (> colon-line-end (point)) ; After label + (if (> (current-indentation) + cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not believe: `max' is involved + (+ old-indent cperl-indent-level)) + (current-column))))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open brace in column zero, don't let statement + ;; start there too. If cperl-indent-level is zero, + ;; use cperl-brace-offset + cperl-continued-statement-offset instead. + ;; For open-braces not the first thing in a line, + ;; add in cperl-brace-imaginary-offset. + + ;; If first thing on a line: ????? + (+ (if (and (bolp) (zerop cperl-indent-level)) + (+ cperl-brace-offset cperl-continued-statement-offset) + cperl-indent-level) + (if (or is-block + (not delim) + (not (eq char-after ?\}))) + 0 + ;; Now it is a hash reference + (+ cperl-indent-level cperl-close-paren-offset)) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the cperl-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 cperl-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + ;; possibly a different line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; In the case it starts a subroutine, indent with + ;; respect to `sub', not with respect to the + ;; first thing on the line, say in the case of + ;; anonymous sub in a hash. + ;; + (skip-chars-backward " \t") + (if (and (eq (preceding-char) ?b) + (progn + (forward-sexp -1) + (looking-at "sub\\>")) + (setq old-indent + (nth 1 + (parse-partial-sexp + (save-excursion (beginning-of-line) (point)) + (point))))) + (progn (goto-char (1+ old-indent)) + (skip-chars-forward " \t") + (current-column)) + ;; Get initial indentation of the line we are on. + ;; If line starts with label, calculate label indentation + (if (save-excursion + (beginning-of-line) + (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) + (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) - ;; Do not believe: `max' is involved - (+ old-indent cperl-indent-level)) - (current-column))))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open brace in column zero, don't let statement - ;; start there too. If cperl-indent-level is zero, - ;; use cperl-brace-offset + cperl-continued-statement-offset instead. - ;; For open-braces not the first thing in a line, - ;; add in cperl-brace-imaginary-offset. - - ;; If first thing on a line: ????? - (+ (if (and (bolp) (zerop cperl-indent-level)) - (+ cperl-brace-offset cperl-continued-statement-offset) - cperl-indent-level) - (if (or is-block - (not delim) - (not (eq char-after ?\}))) - 0 - ;; Now it is a hash reference - (+ cperl-indent-level cperl-close-paren-offset)) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the cperl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 cperl-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; - ;; possibly a different line - (progn - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; In the case it starts a subroutine, indent with - ;; respect to `sub', not with respect to the the - ;; first thing on the line, say in the case of - ;; anonymous sub in a hash. - ;; - (skip-chars-backward " \t") - (if (and (eq (preceding-char) ?b) - (progn - (forward-sexp -1) - (looking-at "sub\\>")) - (setq old-indent - (nth 1 - (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))))) - (progn (goto-char (1+ old-indent)) - (skip-chars-forward " \t") - (current-column)) - ;; Get initial indentation of the line we are on. - ;; If line starts with label, calculate label indentation - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not move `parse-data', this should - ;; be quick anyway: - (cperl-calculate-indent)) - (current-indentation)))))))))))))) + ;; Do not move `parse-data', this should + ;; be quick anyway: + (cperl-calculate-indent)) + (current-indentation)))))))))))))) (defvar cperl-indent-alist @@ -3767,5 +3917,5 @@ (setq res (cons '(comment) res))) ((null containing-sexp) - ;; Line is at top level. + ;; Line is at top level. ;; Indent like the previous top level line ;; unless that ends in a closeparen without semicolon, @@ -3779,5 +3929,5 @@ ((eq (preceding-char) ?\) ) (setq res (cons (list 'toplevel-after-parenth start) res))) - (t + (t (setq res (cons (list 'toplevel-continued start) res))))) ((/= (char-after containing-sexp) ?{) @@ -3793,7 +3943,7 @@ (cons (list 'expression containing-sexp) res)))) ((progn - ;; Containing-expr starts with \{. Check whether it is a hash. - (goto-char containing-sexp) - (not (cperl-block-p))) + ;; Containing-expr starts with \{. Check whether it is a hash. + (goto-char containing-sexp) + (not (cperl-block-p))) (setq res (cons (list 'expression-blanks (progn @@ -3816,5 +3966,5 @@ (if (eq (preceding-char) ?\,) ;; Will go to beginning of line, essentially - ;; Will ignore embedded sexpr XXXX. + ;; Will ignore embedded sexpr XXXX. (cperl-backward-to-start-of-continued-exp containing-sexp)) (beginning-of-line) @@ -3849,10 +3999,10 @@ (setq colon-line-end (point))) (search-forward ":")))) - ;; Now at the point, after label, or at start + ;; Now at the point, after label, or at start ;; of first statement in the block. (and (< (point) start-point) - (if (> colon-line-end (point)) + (if (> colon-line-end (point)) ;; Before statement after label - (if (> (current-indentation) + (if (> (current-indentation) cperl-min-label-indent) (list (list 'label-in-block (point))) @@ -3913,44 +4063,43 @@ (defun cperl-to-comment-or-eol () - "Goes to position before comment on the current line, or to end of line. + "Go to position before comment on the current line, or to end of line. Returns true if comment is found." (let (state stop-in cpoint (lim (progn (end-of-line) (point)))) - (beginning-of-line) - (if (or - (eq (get-text-property (point) 'syntax-type) 'pod) - (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)) - (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) - ;; Else - (while (not stop-in) - (setq state (parse-partial-sexp (point) lim nil nil nil t)) + (beginning-of-line) + (if (or + (eq (get-text-property (point) 'syntax-type) 'pod) + (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)) + (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) + ;; Else + (while (not stop-in) + (setq state (parse-partial-sexp (point) lim nil nil nil t)) ; stop at comment - ;; If fails (beginning-of-line inside sexp), then contains not-comment - (if (nth 4 state) ; After `#'; + ;; If fails (beginning-of-line inside sexp), then contains not-comment + (if (nth 4 state) ; After `#'; ; (nth 2 state) can be ; beginning of m,s,qq and so ; on - (if (nth 2 state) - (progn - (setq cpoint (point)) - (goto-char (nth 2 state)) - (cond - ((looking-at "\\(s\\|tr\\)\\>") - (or (re-search-forward - "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" - lim 'move) - (setq stop-in t))) - ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") - (or (re-search-forward - "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" - lim 'move) - (setq stop-in t))) - (t ; It was fair comment - (setq stop-in t) ; Finish - (goto-char (1- cpoint))))) - (setq stop-in t) ; Finish - (forward-char -1)) - (setq stop-in t)) ; Finish - ) - (nth 4 state)))) + (if (nth 2 state) + (progn + (setq cpoint (point)) + (goto-char (nth 2 state)) + (cond + ((looking-at "\\(s\\|tr\\)\\>") + (or (re-search-forward + "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" + lim 'move) + (setq stop-in t))) + ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") + (or (re-search-forward + "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" + lim 'move) + (setq stop-in t))) + (t ; It was fair comment + (setq stop-in t) ; Finish + (goto-char (1- cpoint))))) + (setq stop-in t) ; Finish + (forward-char -1)) + (setq stop-in t))) ; Finish + (nth 4 state)))) (defsubst cperl-1- (p) @@ -3974,5 +4123,5 @@ (defun cperl-commentify (bb e string &optional noface) - (if cperl-use-syntax-table-text-property + (if cperl-use-syntax-table-text-property (if (eq noface 'n) ; Only immediate nil @@ -3985,5 +4134,5 @@ (cperl-modify-syntax-type (1- e) string)) (if (and (eq string cperl-st-sfence) (> (- e 2) bb)) - (put-text-property (1+ bb) (1- e) + (put-text-property (1+ bb) (1- e) 'syntax-table cperl-string-syntax-table)) (cperl-protect-defun-start bb e)) @@ -4006,5 +4155,5 @@ (skip-chars-forward " \t") ;; ender means matching-char matcher. - (setq b (point) + (setq b (point) starter (if (eobp) 0 (char-after b)) ender (cdr (assoc starter cperl-starters))) @@ -4072,5 +4221,5 @@ (forward-char -1)) (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) - (if ender (modify-syntax-entry ender "." st)) + (if ender (modify-syntax-entry ender "." st)) (setq set-st nil) (setq ender (cperl-forward-re lim end nil t st-l err-l @@ -4102,23 +4251,24 @@ ;;(defvar font-lock-reference-face) (defvar font-lock-constant-face) -(defsubst cperl-postpone-fontification (b e type val &optional now) +(defsubst cperl-postpone-fontification (b e type val &optional now) ;; Do after syntactic fontification? (if cperl-syntaxify-by-font-lock (or now (put-text-property b e 'cperl-postpone (cons type val))) - (put-text-property b e type val))) + (put-text-property b e type val))) ;;; Here is how the global structures (those which cannot be ;;; recognized locally) are marked: -;; a) PODs: +;; a) PODs: ;; Start-to-end is marked `in-pod' ==> t ;; Each non-literal part is marked `syntax-type' ==> `pod' ;; Each literal part is marked `syntax-type' ==> `in-pod' -;; b) HEREs: +;; b) HEREs: ;; Start-to-end is marked `here-doc-group' ==> t ;; The body is marked `syntax-type' ==> `here-doc' ;; The delimiter is marked `syntax-type' ==> `here-doc-delim' -;; c) FORMATs: -;; After-initial-line--to-end is marked `syntax-type' ==> `format' -;; d) 'Q'uoted string: +;; c) FORMATs: +;; First line (to =) marked `first-format-line' ==> t +;; After-this--to-end is marked `syntax-type' ==> `format' +;; d) 'Q'uoted string: ;; part between markers inclusive is marked `syntax-type' ==> `string' ;; part between `q' and the first marker is marked `syntax-type' ==> `prestring' @@ -4158,6 +4308,6 @@ (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) "Scans the buffer for hard-to-parse Perl constructions. -If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify -the sections using `cperl-pod-head-face', `cperl-pod-face', +If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify +the sections using `cperl-pod-head-face', `cperl-pod-face', `cperl-here-face'." (interactive) @@ -4166,88 +4316,87 @@ cperl-syntax-done-to min)) (or max (setq max (point-max))) - (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb - is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 - (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend - (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) - (modified (buffer-modified-p)) - (after-change-functions nil) - (use-syntax-state (and cperl-syntax-state - (>= min (car cperl-syntax-state)))) - (state-point (if use-syntax-state - (car cperl-syntax-state) - (point-min))) - (state (if use-syntax-state - (cdr cperl-syntax-state))) - ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! - (st-l (list nil)) (err-l (list nil)) - ;; Somehow font-lock may be not loaded yet... - (font-lock-string-face (if (boundp 'font-lock-string-face) - font-lock-string-face - 'font-lock-string-face)) - (font-lock-constant-face (if (boundp 'font-lock-constant-face) - font-lock-constant-face - 'font-lock-constant-face)) - (font-lock-function-name-face - (if (boundp 'font-lock-function-name-face) - font-lock-function-name-face - 'font-lock-function-name-face)) - (font-lock-comment-face - (if (boundp 'font-lock-comment-face) - font-lock-comment-face - 'font-lock-comment-face)) - (cperl-nonoverridable-face - (if (boundp 'cperl-nonoverridable-face) - cperl-nonoverridable-face - 'cperl-nonoverridable-face)) - (stop-point (if ignore-max - (point-max) - max)) - (search + (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend + face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb + is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 + (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) + (modified (buffer-modified-p)) + (after-change-functions nil) + (use-syntax-state (and cperl-syntax-state + (>= min (car cperl-syntax-state)))) + (state-point (if use-syntax-state + (car cperl-syntax-state) + (point-min))) + (state (if use-syntax-state + (cdr cperl-syntax-state))) + ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! + (st-l (list nil)) (err-l (list nil)) + ;; Somehow font-lock may be not loaded yet... + (font-lock-string-face (if (boundp 'font-lock-string-face) + font-lock-string-face + 'font-lock-string-face)) + (font-lock-constant-face (if (boundp 'font-lock-constant-face) + font-lock-constant-face + 'font-lock-constant-face)) + (font-lock-function-name-face + (if (boundp 'font-lock-function-name-face) + font-lock-function-name-face + 'font-lock-function-name-face)) + (font-lock-comment-face + (if (boundp 'font-lock-comment-face) + font-lock-comment-face + 'font-lock-comment-face)) + (cperl-nonoverridable-face + (if (boundp 'cperl-nonoverridable-face) + cperl-nonoverridable-face + 'cperl-nonoverridable-face)) + (stop-point (if ignore-max + (point-max) + max)) + (search + (concat + "\\(\\`\n?\\|^\n\\)=" + "\\|" + ;; One extra () before this: + "<<" + "\\(" ; 1 + 1 + ;; First variant "BLAH" or just ``. + "[ \t]*" ; Yes, whitespace is allowed! + "\\([\"'`]\\)" ; 2 + 1 = 3 + "\\([^\"'`\n]*\\)" ; 3 + 1 + "\\3" + "\\|" + ;; Second variant: Identifier or \ID (same as 'ID') or empty + "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 + ;; Do not have <<= or << 30 or <<30 or << $blah. + ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 + "\\(\\)" ; To preserve count of pars :-( 6 + 1 + "\\)" + "\\|" + ;; 1+6 extra () before this: + "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" + (if cperl-use-syntax-table-text-property (concat - "\\(\\`\n?\\|^\n\\)=" "\\|" - ;; One extra () before this: - "<<" - "\\(" ; 1 + 1 - ;; First variant "BLAH" or just ``. - "[ \t]*" ; Yes, whitespace is allowed! - "\\([\"'`]\\)" ; 2 + 1 = 3 - "\\([^\"'`\n]*\\)" ; 3 + 1 - "\\3" - "\\|" - ;; Second variant: Identifier or \ID or empty - "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 - ;; Do not have <<= or << 30 or <<30 or << $blah. - ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 - "\\(\\)" ; To preserve count of pars :-( 6 + 1 - "\\)" + ;; 1+6+2=9 extra () before this: + "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" "\\|" - ;; 1+6 extra () before this: - "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" - (if cperl-use-syntax-table-text-property - (concat - "\\|" - ;; 1+6+2=9 extra () before this: - "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" - "\\|" - ;; 1+6+2+1=10 extra () before this: - "\\([?/<]\\)" ; /blah/ or ?blah? or - "\\|" - ;; 1+6+2+1+1=11 extra () before this: - "\\[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" - "\\|" - ;; 1+6+2+1+1+2=13 extra () before this: - "\\$\\(['{]\\)" - "\\|" - ;; 1+6+2+1+1+2+1=14 extra () before this: - "\\(\\ + "\\|" + ;; 1+6+2+1+1=11 extra () before this: + "\\[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" + "\\|" + ;; 1+6+2+1+1+2=13 extra () before this: + "\\$\\(['{]\\)" + "\\|" + ;; 1+6+2+1+1+2+1=14 extra () before this: + "\\(\\") (if ignore-max @@ -4286,6 +4437,6 @@ (or (car err-l) (setcar err-l (point)))) (beginning-of-line) - - (setq b (point) + + (setq b (point) bb b tb (match-beginning 0) @@ -4305,9 +4456,11 @@ (and (> e max) (progn - (remove-text-properties + (remove-text-properties max e '(syntax-type t in-pod t syntax-table t cperl-postpone t syntax-subtype t + here-doc-group t rear-nonsticky t + first-format-line t indentable t)) (setq tmpend tb))) @@ -4321,5 +4474,5 @@ (cperl-put-do-not-fontify b (point) t) ;; mark the non-literal parts as PODs - (if cperl-pod-here-fontify + (if cperl-pod-here-fontify (cperl-postpone-fontification b (point) 'face face t)) (re-search-forward "\n\n[^ \t\f\n]" e 'toend) @@ -4328,13 +4481,13 @@ (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) (cperl-put-do-not-fontify (point) e t) - (if cperl-pod-here-fontify - (progn + (if cperl-pod-here-fontify + (progn ;; mark the non-literal parts as PODs (cperl-postpone-fontification (point) e 'face face t) (goto-char bb) - (if (looking-at + (if (looking-at "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") ;; mark the headers - (cperl-postpone-fontification + (cperl-postpone-fontification (match-beginning 1) (match-end 1) 'face head-face)) @@ -4344,5 +4497,5 @@ e 'toend) ;; mark the headers - (cperl-postpone-fontification + (cperl-postpone-fontification (match-beginning 1) (match-end 1) 'face head-face)))) @@ -4350,11 +4503,12 @@ (goto-char e) (or (eq e (point-max)) - (forward-char -1)))) ; Prepare for immediate pod start. + (forward-char -1)))) ; Prepare for immediate POD start. ;; Here document ;; We do only one here-per-line ;; ;; One extra () before this: - ;;"<<" + ;;"<<" ;; "\\(" ; 1 + 1 ;; ;; First variant "BLAH" or just ``. + ;; "[ \t]*" ; Yes, whitespace is allowed! ;; "\\([\"'`]\\)" ; 2 + 1 ;; "\\([^\"'`\n]*\\)" ; 3 + 1 @@ -4374,5 +4528,5 @@ tb (match-beginning 0) i (or (nth 3 state) (nth 4 state))) - (if i + (if i (setq c t) (setq c (and @@ -4390,5 +4544,5 @@ (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) - (cond (cperl-pod-here-fontify + (cond (cperl-pod-here-fontify ;; Highlight the starting delimiter (cperl-postpone-fontification b1 e1 'face font-lock-constant-face) @@ -4398,28 +4552,32 @@ ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (cond ((re-search-forward (concat "^" qtag "$") - stop-point 'toend) - (if cperl-pod-here-fontify - (progn - ;; Highlight the ending delimiter - (cperl-postpone-fontification (match-beginning 0) (match-end 0) - 'face font-lock-constant-face) - (cperl-put-do-not-fontify b (match-end 0) t) - ;; Highlight the HERE-DOC - (cperl-postpone-fontification b (match-beginning 0) - 'face here-face))) - (setq e1 (cperl-1+ (match-end 0))) - (put-text-property b (match-beginning 0) - 'syntax-type 'here-doc) - (put-text-property (match-beginning 0) e1 - 'syntax-type 'here-doc-delim) - (put-text-property b e1 - 'here-doc-group t) - (cperl-commentify b e1 nil) - (cperl-put-do-not-fontify b (match-end 0) t) - (if (> e1 max) - (setq tmpend tb))) - (t (message "End of here-document `%s' not found." tag) - (or (car err-l) (setcar err-l b)))))) + (or (and (re-search-forward (concat "^" qtag "$") + stop-point 'toend) + (eq (following-char) ?\n)) + (progn ; Pretend we matched at the end + (goto-char (point-max)) + (re-search-forward "\\'") + (message "End of here-document `%s' not found." tag) + (or (car err-l) (setcar err-l b)))) + (if cperl-pod-here-fontify + (progn + ;; Highlight the ending delimiter + (cperl-postpone-fontification (match-beginning 0) (match-end 0) + 'face font-lock-constant-face) + (cperl-put-do-not-fontify b (match-end 0) t) + ;; Highlight the HERE-DOC + (cperl-postpone-fontification b (match-beginning 0) + 'face here-face))) + (setq e1 (cperl-1+ (match-end 0))) + (put-text-property b (match-beginning 0) + 'syntax-type 'here-doc) + (put-text-property (match-beginning 0) e1 + 'syntax-type 'here-doc-delim) + (put-text-property b e1 + 'here-doc-group t) + (cperl-commentify b e1 nil) + (cperl-put-do-not-fontify b (match-end 0) t) + (if (> e1 max) + (setq tmpend tb)))) ;; format ((match-beginning 8) @@ -4433,5 +4591,9 @@ tb (match-beginning 0)) (setq argument nil) - (if cperl-pod-here-fontify + (put-text-property (save-excursion + (beginning-of-line) + (point)) + b 'first-format-line 't) + (if cperl-pod-here-fontify (while (and (eq (forward-line) 0) (not (looking-at "^[.;]$"))) @@ -4439,5 +4601,5 @@ ((looking-at "^#")) ; Skip comments ((and argument ; Skip argument multi-lines - (looking-at "^[ \t]*{")) + (looking-at "^[ \t]*{")) (forward-sexp 1) (setq argument nil)) @@ -4449,6 +4611,6 @@ (end-of-line) ;; Highlight the format line - (cperl-postpone-fontification b1 (point) - 'face font-lock-string-face) + (cperl-postpone-fontification b1 (point) + 'face font-lock-string-face) (cperl-commentify b1 (point) nil) (cperl-put-do-not-fontify b1 (point) t)))) @@ -4457,9 +4619,9 @@ (re-search-forward "^[.;]$" stop-point 'toend)) (beginning-of-line) - (if (looking-at "^\\.$") ; ";" is not supported yet + (if (looking-at "^\\.$") ; ";" is not supported yet (progn ;; Highlight the ending delimiter (cperl-postpone-fontification (point) (+ (point) 2) - 'face font-lock-string-face) + 'face font-lock-string-face) (cperl-commentify (point) (+ (point) 2) nil) (cperl-put-do-not-fontify (point) (+ (point) 2) t)) @@ -4485,16 +4647,24 @@ ;; bb == "Not a stringy" bb (if (eq b1 10) ; user variables/whatever - (or - (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y - (and (eq bb ?-) (eq c ?s)) ; -s file test - (and (eq bb ?\&) - (not (eq (char-after ; &&m/blah/ - (- (match-beginning b1) 2)) - ?\&)))) + (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y) + (cond ((eq bb ?-) (eq c ?s)) ; -s file test + ((eq bb ?\:) ; $opt::s + (eq (char-after + (- (match-beginning b1) 2)) + ?\:)) + ((eq bb ?\>) ; $foo->s + (eq (char-after + (- (match-beginning b1) 2)) + ?\-)) + ((eq bb ?\&) + (not (eq (char-after ; &&m/blah/ + (- (match-beginning b1) 2)) + ?\&))) + (t t))) ;; or <$file> (and (eq c ?\<) ;; Do not stringify , <$fh> : (save-match-data - (looking-at + (looking-at "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>")))) tb (match-beginning 0)) @@ -4504,7 +4674,8 @@ (if (eq b1 11) ; bare /blah/ or ?blah? or (setq argument "" + b1 nil bb ; Not a regexp? (progn - (not + (not ;; What is below: regexp-p? (and @@ -4527,6 +4698,6 @@ (not (memq (preceding-char) '(?$ ?@ ?& ?%))) - (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) + (looking-at + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) @@ -4535,5 +4706,5 @@ (not (and (eq c ?\?) - cperl-use-syntax-table-text-property + cperl-use-syntax-table-text-property (not (bobp)) (progn @@ -4542,14 +4713,56 @@ b (1- b)) ;; s y tr m - ;; Check for $a->y - (if (and (eq (preceding-char) ?>) - (eq (char-after (- (point) 2)) ?-)) + ;; Check for $a -> y + (setq b1 (preceding-char) + go (point)) + (if (and (eq b1 ?>) + (eq (char-after (- go 2)) ?-)) ;; Not a regexp (setq bb t)))) - (or bb (setq state (parse-partial-sexp + (or bb (setq state (parse-partial-sexp state-point b nil nil state) state-point b)) + (setq bb (or bb (nth 3 state) (nth 4 state))) (goto-char b) - (if (or bb (nth 3 state) (nth 4 state)) + (or bb + (progn + (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") + (goto-char (match-end 0)) + (skip-chars-forward " \t\n\f")) + (cond ((and (eq (following-char) ?\}) + (eq b1 ?\{)) + ;; Check for $a[23]->{ s }, @{s} and *{s::foo} + (goto-char (1- go)) + (skip-chars-backward " \t\n\f") + (if (memq (preceding-char) (append "$@%&*" nil)) + (setq bb t) ; @{y} + (condition-case nil + (forward-sexp -1) + (error nil))) + (if (or bb + (looking-at ; $foo -> {s} + "[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{") + (and ; $foo[12] -> {s} + (memq (following-char) '(?\{ ?\[)) + (progn + (forward-sexp 1) + (looking-at "\\([ \t\n]*->\\)?[ \t\n]*{")))) + (setq bb t) + (goto-char b))) + ((and (eq (following-char) ?=) + (eq (char-after (1+ (point))) ?\>)) + ;; Check for { foo => 1, s => 2 } + ;; Apparently s=> is never a substitution... + (setq bb t)) + ((and (eq (following-char) ?:) + (eq b1 ?\{) ; Check for $ { s::bar } + (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}") + (progn + (goto-char (1- go)) + (skip-chars-backward " \t\n\f") + (memq (preceding-char) + (append "$@%&*" nil)))) + (setq bb t))))) + (if bb (goto-char i) ;; Skip whitespace and comments... @@ -4572,11 +4785,11 @@ ;; Note that if `go', then it is considered as 1-arg b1 (nth 1 i) ; start of the second part - tag (nth 2 i) ; ender-char, true if second part + tag (nth 2 i) ; ender-char, true if second part ; is with matching chars [] go (nth 4 i) ; There is a 1-char part after the end i (car i) ; intermediate point - e1 (point) ; end + e1 (point) ; end ;; Before end of the second part if non-matching: /// - tail (if (and i (not tag)) + tail (if (and i (not tag)) (1- e1)) e (if i i e1) ; end of the first part @@ -4629,13 +4842,13 @@ (forward-word 1) ; skip modifiers s///s (if tail (cperl-commentify tail (point) t)) - (cperl-postpone-fontification + (cperl-postpone-fontification e1 (point) 'face 'cperl-nonoverridable-face))) ;; Check whether it is m// which means "previous match" ;; and highlight differently - (setq is-REx + (setq is-REx (and (string-match "^\\([sm]?\\|qr\\)$" argument) (or (not (= (length argument) 0)) (not (eq c ?\<))))) - (if (and is-REx + (if (and is-REx (eq e (+ 2 b)) ;; split // *is* using zero-pattern @@ -4647,5 +4860,5 @@ (not (looking-at "split\\>"))) (error t)))) - (cperl-postpone-fontification + (cperl-postpone-fontification b e 'face font-lock-function-name-face) (if (or i2 ; Has 2 args @@ -4656,7 +4869,7 @@ (not (eq ?\< (char-after b))))))) (progn - (cperl-postpone-fontification + (cperl-postpone-fontification b (cperl-1+ b) 'face font-lock-constant-face) - (cperl-postpone-fontification + (cperl-postpone-fontification (1- e) e 'face font-lock-constant-face))) (if (and is-REx cperl-regexp-scan) @@ -4670,8 +4883,8 @@ (if (eq (char-after b) ?\#) "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" - "\\((\\?#\\)\\|\\(#\\)") - (if (eq (char-after b) ?\#) - "\\((\\?\\\\#\\)" - "\\((\\?#\\)")) + "\\((\\?#\\)\\|\\(#\\)") + (if (eq (char-after b) ?\#) + "\\((\\?\\\\#\\)" + "\\((\\?#\\)")) (1- e) 'to-end)) (goto-char (match-beginning 0)) @@ -4687,5 +4900,5 @@ (forward-char 1)) (if (match-beginning 2) - (progn + (progn (beginning-of-line 2) (if (> (point) e) @@ -4703,16 +4916,16 @@ (cperl-commentify REx-comment-start REx-comment-end nil) - (cperl-postpone-fontification + (cperl-postpone-fontification REx-comment-start REx-comment-end 'face font-lock-comment-face)))))) (if (and is-REx is-x-REx) - (put-text-property (1+ b) (1- e) + (put-text-property (1+ b) (1- e) 'syntax-subtype 'x-REx))) (if i2 (progn - (cperl-postpone-fontification + (cperl-postpone-fontification (1- e1) e1 'face font-lock-constant-face) (if (assoc (char-after b) cperl-starters) - (cperl-postpone-fontification + (cperl-postpone-fontification b1 (1+ b1) 'face font-lock-constant-face)))) (if (> (point) max) @@ -4723,5 +4936,5 @@ '(?\$ ?\@ ?\% ?\& ?\*)) nil - (setq state (parse-partial-sexp + (setq state (parse-partial-sexp state-point b nil nil state) state-point b) @@ -4736,5 +4949,5 @@ (eq (preceding-char) ?\')) ; $' (setq b (1- (point)) - state (parse-partial-sexp + state (parse-partial-sexp state-point (1- b) nil nil state) state-point (1- b)) @@ -4752,5 +4965,5 @@ (setq bb (match-end 0) b (match-beginning 0) - state (parse-partial-sexp + state (parse-partial-sexp state-point b nil nil state) state-point b) @@ -4764,5 +4977,5 @@ (setq bb (match-end 0) b (match-beginning 0) - state (parse-partial-sexp + state (parse-partial-sexp state-point b nil nil state) state-point b) @@ -4773,5 +4986,6 @@ (setq end t)) (goto-char bb)) - ((match-beginning 17) ; "\\\\\\(['`\"]\\)" + ((match-beginning 17) ; "\\\\\\(['`\"($]\\)" + ;; Trailing backslash ==> non-quoting outside string/comment (setq bb (match-end 0) b (match-beginning 0)) @@ -4779,5 +4993,5 @@ (skip-chars-backward "\\\\") ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) - (setq state (parse-partial-sexp + (setq state (parse-partial-sexp state-point b nil nil state) state-point b) @@ -4789,5 +5003,5 @@ (if (> (point) stop-point) (progn - (if end + (if end (message "Garbage after __END__/__DATA__ ignored") (message "Unbalanced syntax found while scanning") @@ -4815,18 +5029,20 @@ '(pod here-doc here-doc-delim)) (cperl-unwind-to-safe nil) - (if (or (looking-at "^[ \t]*\\(#\\|$\\)") - (progn (cperl-to-comment-or-eol) (bolp))) - nil ; Only comment, skip - ;; Else - (skip-chars-backward " \t") - (if (< p (point)) (goto-char p)) - (setq stop t)))))) - -(defun cperl-after-block-p (lim) + (or (looking-at "^[ \t]*\\(#\\|$\\)") + (progn (cperl-to-comment-or-eol) (bolp)) + (progn + (skip-chars-backward " \t") + (if (< p (point)) (goto-char p)) + (setq stop t))))))) + +(defun cperl-after-block-p (lim &optional pre-block) + "Return true if the preceeding } ends a block or a following { starts one. +Would not look before LIM. If PRE-BLOCK is nil checks preceeding }. +otherwise following {." ;; We suppose that the preceding char is }. (save-excursion (condition-case nil (progn - (forward-sexp -1) + (or pre-block (forward-sexp -1)) (cperl-backward-to-noncomment lim) (or (eq (point) lim) @@ -4835,5 +5051,5 @@ (save-excursion (forward-sexp -1) - (or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>") + (or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>") ;; sub f {} (progn @@ -4847,10 +5063,11 @@ (defun cperl-after-expr-p (&optional lim chars test) - "Returns true if the position is good for start of expression. + "Return true if the position is good for start of expression. TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." - (let (stop p - (lim (or lim (point-min)))) + (let ((lim (or lim (point-min))) + stop p pr) + (cperl-update-syntaxification (point) (point)) (save-excursion (while (and (not stop) (> (point) lim)) @@ -4858,7 +5075,19 @@ (setq p (point)) (beginning-of-line) + ;;(memq (setq pr (get-text-property (point) 'syntax-type)) + ;; '(pod here-doc here-doc-delim)) + (if (get-text-property (point) 'here-doc-group) + (progn + (goto-char + (previous-single-property-change (point) 'here-doc-group)) + (beginning-of-line 0))) + (if (get-text-property (point) 'in-pod) + (progn + (goto-char + (previous-single-property-change (point) 'in-pod)) + (beginning-of-line 0))) (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip ;; Else: last iteration, or a label - (cperl-to-comment-or-eol) + (cperl-to-comment-or-eol) ; Will not move past "." after a format (skip-chars-backward " \t") (if (< p (point)) (goto-char p)) @@ -4879,5 +5108,8 @@ (or (memq (preceding-char) (append (or chars "{;") nil)) (and (eq (preceding-char) ?\}) - (cperl-after-block-p lim))))))))) + (cperl-after-block-p lim)) + (and (eq (following-char) ?.) ; in format: see comment above + (eq (get-text-property (point) 'syntax-type) + 'format))))))))) (defun cperl-backward-to-start-of-continued-exp (lim) @@ -4891,5 +5123,5 @@ (defun cperl-after-block-and-statement-beg (lim) ;; We assume that we are after ?\} - (and + (and (cperl-after-block-p lim) (save-excursion @@ -4901,5 +5133,5 @@ (progn (forward-sexp -1) - (not + (not (looking-at "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>"))))))) @@ -4915,5 +5147,5 @@ continuation of the comment on the previous line. -If `cperl-indent-region-fix-constructs', will improve spacing on +If `cperl-indent-region-fix-constructs', will improve spacing on conditional/loop constructs." (interactive) @@ -4948,176 +5180,176 @@ (or end (setq end (point-max))) - (let (p pp ml have-brace ret - (ee (save-excursion (end-of-line) (point))) - (cperl-indent-region-fix-constructs - (or cperl-indent-region-fix-constructs 1))) + (let ((ee (save-excursion (end-of-line) (point))) + (cperl-indent-region-fix-constructs + (or cperl-indent-region-fix-constructs 1)) + p pp ml have-brace ret) (save-excursion (beginning-of-line) (setq ret (point)) - ;; }? continue + ;; }? continue ;; blah; } - (if (not + (if (not (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") (setq have-brace (save-excursion (search-forward "}" ee t))))) nil ; Do not need to do anything - ;; Looking at: - ;; } - ;; else - (if (and cperl-merge-trailing-else - (looking-at - "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) - (progn - (search-forward "}") - (setq p (point)) - (skip-chars-forward " \t\n") - (delete-region p (point)) - (insert (make-string cperl-indent-region-fix-constructs ?\ )) - (beginning-of-line))) - ;; Looking at: - ;; } else - (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") - (progn - (search-forward "}") - (delete-horizontal-space) - (insert (make-string cperl-indent-region-fix-constructs ?\ )) - (beginning-of-line))) - ;; Looking at: - ;; else { - (if (looking-at - "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") - (progn - (forward-word 1) - (delete-horizontal-space) - (insert (make-string cperl-indent-region-fix-constructs ?\ )) - (beginning-of-line))) - ;; Looking at: - ;; foreach my $var - (if (looking-at - "[ \t]*\\")) + (progn + (search-forward "}") + (setq p (point)) + (skip-chars-forward " \t\n") + (delete-region p (point)) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; } else + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (progn + (search-forward "}") + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; else { + (if (looking-at + "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") + (progn + (forward-word 1) + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; foreach my $var + (if (looking-at + "[ \t]*\\\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") - (progn - (setq ml (match-beginning 8)) - (re-search-forward "[({]") - (forward-char -1) - (setq p (point)) - (if (eq (following-char) ?\( ) - (progn - (forward-sexp 1) - (setq pp (point))) - ;; after `else' or nothing - (if ml ; after `else' - (skip-chars-backward " \t\n") - (beginning-of-line)) - (setq pp nil)) - ;; Now after the sexp before the brace - ;; Multiline expr should be special - (setq ml (and pp (save-excursion (goto-char p) - (search-forward "\n" pp t)))) - (if (and (or (not pp) (< pp end)) - (looking-at "[ \t\n]*{")) - (progn - (cond - ((bolp) ; Were before `{', no if/else/etc - nil) - ((looking-at "\\(\t*\\| [ \t]+\\){") - (delete-horizontal-space) - (if (if ml - cperl-extra-newline-before-brace-multiline - cperl-extra-newline-before-brace) - (progn - (delete-horizontal-space) - (insert "\n") - (setq ret (point)) - (if (cperl-indent-line parse-data) - (progn - (cperl-fix-line-spacing end parse-data) - (setq ret (point))))) + (progn + (forward-sexp 3) + (delete-horizontal-space) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; } foreach my $var () { + (if (looking-at + "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + (progn + (setq ml (match-beginning 8)) + (re-search-forward "[({]") + (forward-char -1) + (setq p (point)) + (if (eq (following-char) ?\( ) + (progn + (forward-sexp 1) + (setq pp (point))) + ;; after `else' or nothing + (if ml ; after `else' + (skip-chars-backward " \t\n") + (beginning-of-line)) + (setq pp nil)) + ;; Now after the sexp before the brace + ;; Multiline expr should be special + (setq ml (and pp (save-excursion (goto-char p) + (search-forward "\n" pp t)))) + (if (and (or (not pp) (< pp end)) + (looking-at "[ \t\n]*{")) + (progn + (cond + ((bolp) ; Were before `{', no if/else/etc + nil) + ((looking-at "\\(\t*\\| [ \t]+\\){") + (delete-horizontal-space) + (if (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace) + (progn + (delete-horizontal-space) + (insert "\n") + (setq ret (point)) + (if (cperl-indent-line parse-data) + (progn + (cperl-fix-line-spacing end parse-data) + (setq ret (point))))) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )))) + ((and (looking-at "[ \t]*\n") + (not (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace))) + (setq pp (point)) + (skip-chars-forward " \t\n") + (delete-region pp (point)) (insert (make-string cperl-indent-region-fix-constructs ?\ )))) - ((and (looking-at "[ \t]*\n") - (not (if ml - cperl-extra-newline-before-brace-multiline - cperl-extra-newline-before-brace))) - (setq pp (point)) - (skip-chars-forward " \t\n") - (delete-region pp (point)) - (insert - (make-string cperl-indent-region-fix-constructs ?\ )))) - ;; Now we are before `{' - (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") - (progn - (skip-chars-forward " \t\n") - (setq pp (point)) - (forward-sexp 1) - (setq p (point)) - (goto-char pp) - (setq ml (search-forward "\n" p t)) - (if (or cperl-break-one-line-blocks-when-indent ml) - ;; not good: multi-line BLOCK - (progn - (goto-char (1+ pp)) - (delete-horizontal-space) - (insert "\n") - (setq ret (point)) - (if (cperl-indent-line parse-data) - (setq ret (cperl-fix-line-spacing end parse-data))))))))))) - (beginning-of-line) - (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. - ;; Now check whether there is a hanging `}' - ;; Looking at: - ;; } blah - (if (and - cperl-fix-hanging-brace-when-indent - have-brace - (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) - (condition-case nil - (progn - (up-list 1) - (if (and (<= (point) pp) - (eq (preceding-char) ?\} ) - (cperl-after-block-and-statement-beg (point-min))) - t - (goto-char p) - nil)) - (error nil))) - (progn - (forward-char -1) - (skip-chars-backward " \t") - (if (bolp) - ;; `}' was the first thing on the line, insert NL *after* it. - (progn - (cperl-indent-line parse-data) - (search-forward "}") - (delete-horizontal-space) - (insert "\n")) - (delete-horizontal-space) - (or (eq (preceding-char) ?\;) - (bolp) - (and (eq (preceding-char) ?\} ) - (cperl-after-block-p (point-min))) - (insert ";")) - (insert "\n") - (setq ret (point))) - (if (cperl-indent-line parse-data) - (setq ret (cperl-fix-line-spacing end parse-data))) - (beginning-of-line))))) + ;; Now we are before `{' + (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") + (progn + (skip-chars-forward " \t\n") + (setq pp (point)) + (forward-sexp 1) + (setq p (point)) + (goto-char pp) + (setq ml (search-forward "\n" p t)) + (if (or cperl-break-one-line-blocks-when-indent ml) + ;; not good: multi-line BLOCK + (progn + (goto-char (1+ pp)) + (delete-horizontal-space) + (insert "\n") + (setq ret (point)) + (if (cperl-indent-line parse-data) + (setq ret (cperl-fix-line-spacing end parse-data))))))))))) + (beginning-of-line) + (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. + ;; Now check whether there is a hanging `}' + ;; Looking at: + ;; } blah + (if (and + cperl-fix-hanging-brace-when-indent + have-brace + (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) + (condition-case nil + (progn + (up-list 1) + (if (and (<= (point) pp) + (eq (preceding-char) ?\} ) + (cperl-after-block-and-statement-beg (point-min))) + t + (goto-char p) + nil)) + (error nil))) + (progn + (forward-char -1) + (skip-chars-backward " \t") + (if (bolp) + ;; `}' was the first thing on the line, insert NL *after* it. + (progn + (cperl-indent-line parse-data) + (search-forward "}") + (delete-horizontal-space) + (insert "\n")) + (delete-horizontal-space) + (or (eq (preceding-char) ?\;) + (bolp) + (and (eq (preceding-char) ?\} ) + (cperl-after-block-p (point-min))) + (insert ";")) + (insert "\n") + (setq ret (point))) + (if (cperl-indent-line parse-data) + (setq ret (cperl-fix-line-spacing end parse-data))) + (beginning-of-line))))) ret)) @@ -5130,10 +5362,10 @@ (defun cperl-indent-region (start end) "Simple variant of indentation of region in CPerl mode. -Should be slow. Will not indent comment if it starts at `comment-indent' +Should be slow. Will not indent comment if it starts at `comment-indent' or looks like continuation of the comment on the previous line. -Indents all the lines whose first character is between START and END -inclusive. - -If `cperl-indent-region-fix-constructs', will improve spacing on +Indents all the lines whose first character is between START and END +inclusive. + +If `cperl-indent-region-fix-constructs', will improve spacing on conditional/loop constructs." (interactive "r") @@ -5141,10 +5373,10 @@ (save-excursion (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) - (let (st comm old-comm-indent new-comm-indent p pp i empty - (indent-info (if cperl-emacs-can-parse - (list nil nil nil) ; Cannot use '(), since will modify - nil)) - after-change-functions ; Speed it up! - (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) + (let ((indent-info (if cperl-emacs-can-parse + (list nil nil nil) ; Cannot use '(), since will modify + nil)) + (pm 0) (imenu-scanning-message "Indenting... (%3d%%)") + after-change-functions ; Speed it up! + st comm old-comm-indent new-comm-indent p pp i empty) (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook)) (goto-char start) @@ -5159,5 +5391,5 @@ (while (and (<= (point) end) (not (eobp))) ; bol to check start (and (fboundp 'imenu-progress-message) - (imenu-progress-message + (imenu-progress-message pm (/ (* 100 (- (point) start)) (- end start -1)))) (setq st (point)) @@ -5165,5 +5397,5 @@ (setq empty (looking-at "[ \t]*\n")) (and (setq comm (looking-at "[ \t]*#")) - (or (eq (current-indentation) (or old-comm-indent + (or (eq (current-indentation) (or old-comm-indent comment-column)) (setq old-comm-indent nil)))) @@ -5176,5 +5408,5 @@ (let ((comment-column new-comm-indent)) (indent-for-comment))) - (progn + (progn (setq i (cperl-indent-line indent-info)) (or comm @@ -5183,10 +5415,10 @@ (if cperl-indent-region-fix-constructs (goto-char (cperl-fix-line-spacing end indent-info))) - (if (setq old-comm-indent + (if (setq old-comm-indent (and (cperl-to-comment-or-eol) - (not (memq (get-text-property (point) + (not (memq (get-text-property (point) 'syntax-type) '(pod here-doc))) - (not (eq (get-text-property (point) + (not (eq (get-text-property (point) 'syntax-table) cperl-st-cfence)) @@ -5201,14 +5433,13 @@ (message nil))) ;; Now run the update hooks - (if after-change-functions - (save-excursion - (if cperl-update-end - (progn - (goto-char cperl-update-end) - (insert " ") - (delete-char -1) - (goto-char cperl-update-start) - (insert " ") - (delete-char -1)))))))) + (and after-change-functions + cperl-update-end + (save-excursion + (goto-char cperl-update-end) + (insert " ") + (delete-char -1) + (goto-char cperl-update-start) + (insert " ") + (delete-char -1)))))) ;; Stolen from lisp-mode with a lot of improvements @@ -5220,6 +5451,5 @@ indentation and initial hashes. Behaves usually outside of comment." (interactive "P") - (let ( - ;; Non-nil if the current line contains a comment. + (let (;; Non-nil if the current line contains a comment. has-comment @@ -5246,16 +5476,16 @@ (setq has-comment t) (looking-at "#+[ \t]*") - (setq start (point) c (current-column) + (setq start (point) c (current-column) comment-fill-prefix (concat (make-string (current-column) ?\ ) (buffer-substring (match-beginning 0) (match-end 0))) - spaces (progn (skip-chars-backward " \t") + spaces (progn (skip-chars-backward " \t") (buffer-substring (point) start)) - dc (- c (current-column)) len (- start (point)) + dc (- c (current-column)) len (- start (point)) start (point-marker)) (delete-char len) (insert (make-string dc ?-))))) (if (not has-comment) - (fill-paragraph justify) ; Do the usual thing outside of comment + (fill-paragraph justify) ; Do the usual thing outside of comment ;; Narrow to include only the comment, and then fill the region. (save-restriction @@ -5279,5 +5509,5 @@ (while (progn (forward-line 1) (< (point) (point-max))) (skip-chars-forward " \t") - (and (looking-at "#+") + (and (looking-at "#+") (delete-char (- (match-end 0) (match-beginning 0))))) @@ -5288,8 +5518,8 @@ (fill-paragraph justify))) (if (and start) - (progn + (progn (goto-char start) (if (> dc 0) - (progn (delete-char dc) (insert spaces))) + (progn (delete-char dc) (insert spaces))) (if (or (= (current-column) c) iteration) nil (setq comment-column c) @@ -5304,28 +5534,20 @@ (current-column)) fill-column) - (let ((c (save-excursion (beginning-of-line) - (cperl-to-comment-or-eol) (point))) - (s (memq (following-char) '(?\ ?\t))) marker) - (if (>= c (point)) nil - (setq marker (point-marker)) - (cperl-fill-paragraph) - (goto-char marker) - ;; Is not enough, sometimes marker is a start of line - (if (bolp) (progn (re-search-forward "#+[ \t]*") - (goto-char (match-end 0)))) - ;; Following space could have gone: - (if (or (not s) (memq (following-char) '(?\ ?\t))) nil - (insert " ") - (backward-char 1)) - ;; Previous space could have gone: - (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) - -(defvar imenu-example--function-name-regexp-perl - (concat - "^\\(" - "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?" - "\\|" - "=head\\([12]\\)[ \t]+\\([^\n]+\\)$" - "\\)")) + (let ((c (save-excursion (beginning-of-line) + (cperl-to-comment-or-eol) (point))) + (s (memq (following-char) '(?\ ?\t))) marker) + (if (>= c (point)) nil + (setq marker (point-marker)) + (cperl-fill-paragraph) + (goto-char marker) + ;; Is not enough, sometimes marker is a start of line + (if (bolp) (progn (re-search-forward "#+[ \t]*") + (goto-char (match-end 0)))) + ;; Following space could have gone: + (if (or (not s) (memq (following-char) '(?\ ?\t))) nil + (insert " ") + (backward-char 1)) + ;; Previous space could have gone: + (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) (defun cperl-imenu-addback (lst &optional isback name) @@ -5335,22 +5557,21 @@ (cond ((not cperl-imenu-addback) lst) (t - (or name + (or name (setq name "+++BACK+++")) - (mapcar (function (lambda (elt) - (if (and (listp elt) (listp (cdr elt))) - (progn - ;; In the other order it goes up - ;; one level only ;-( - (setcdr elt (cons (cons name lst) - (cdr elt))) - (cperl-imenu-addback (cdr elt) t name) - )))) + (mapcar (lambda (elt) + (if (and (listp elt) (listp (cdr elt))) + (progn + ;; In the other order it goes up + ;; one level only ;-( + (setcdr elt (cons (cons name lst) + (cdr elt))) + (cperl-imenu-addback (cdr elt) t name)))) (if isback (cdr lst) lst)) lst))) -(defun imenu-example--create-perl-index (&optional regexp) +(defun cperl-imenu--create-perl-index (&optional regexp) (require 'cl) (require 'imenu) ; May be called from TAGS creator - (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) + (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) (index-meth-alist '()) meth @@ -5365,5 +5586,5 @@ (progn ;;save-match-data (while (re-search-forward - (or regexp imenu-example--function-name-regexp-perl) + (or regexp cperl-imenu--function-name-regexp-perl) nil t) (or noninteractive @@ -5374,5 +5595,5 @@ (eq (char-after (match-beginning 2)) ?p) ; package (not (save-match-data - (looking-at "[ \t\n]*;")))) ; Plain text word 'package' + (looking-at "[ \t\n]*;")))) ; Plain text word 'package' nil) ((and @@ -5384,6 +5605,5 @@ (save-excursion (goto-char (match-beginning 2)) - (setq fchar (following-char)) - ) + (setq fchar (following-char))) ;; (if (looking-at "([^()]*)[ \t\n\f]*") ;; (goto-char (match-end 0))) ; Messes what follows @@ -5401,7 +5621,7 @@ (set-text-properties 0 (length name) nil name) name) - package (concat name "::") + package (concat name "::") name (concat "package " name) - end-range + end-range (save-excursion (parse-partial-sexp (point) (point-max) -1) (point)) @@ -5415,18 +5635,18 @@ (set-text-properties 0 (length name) nil name) (set-marker marker (match-end 3)) - (if (eq fchar ?p) + (if (eq fchar ?p) (setq name (concat "package " name)) (cond ((string-match "[:']" name) (setq meth t)) ((> p end-range) nil) - (t + (t (setq name (concat package name) meth t)))) (setq index (cons name marker)) - (if (eq fchar ?p) + (if (eq fchar ?p) (push index index-pack-alist) (push index index-alist)) (if meth (push index index-meth-alist)) (push index index-unsorted-alist))) - ((match-beginning 5) ; Pod section + ((match-beginning 5) ; POD section ;; (beginning-of-line) (setq index (imenu-example--name-and-position) @@ -5441,8 +5661,8 @@ (or noninteractive (imenu-progress-message prev-pos 100)) - (setq index-alist + (setq index-alist (if (default-value 'imenu-sort-function) (sort index-alist (default-value 'imenu-sort-function)) - (nreverse index-alist))) + (nreverse index-alist))) (and index-pod-alist (push (cons "+POD headers+..." @@ -5461,20 +5681,20 @@ (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt)) (setq pack (substring (car elt) 0 (match-beginning 0))) - (if (setq group (assoc pack hier-list)) + (if (setq group (assoc pack hier-list)) (if (listp (cdr group)) ;; Have some functions already - (setcdr group - (cons (cons (substring + (setcdr group + (cons (cons (substring (car elt) (+ 2 (match-beginning 0))) (cdr elt)) (cdr group))) - (setcdr group (list (cons (substring + (setcdr group (list (cons (substring (car elt) (+ 2 (match-beginning 0))) (cdr elt))))) - (setq hier-list - (cons (cons pack - (list (cons (substring + (setq hier-list + (cons (cons pack + (list (cons (substring (car elt) (+ 2 (match-beginning 0))) @@ -5488,5 +5708,5 @@ (nreverse index-pack-alist)) index-alist)) - (and (or index-pack-alist index-pod-alist + (and (or index-pack-alist index-pod-alist (default-value 'imenu-sort-function)) index-unsorted-alist @@ -5497,7 +5717,4 @@ -(defvar cperl-outline-regexp - (concat imenu-example--function-name-regexp-perl "\\|" "\\`")) - ;; Suggested by Mark A. Hershberger (defun cperl-outline-level () @@ -5515,5 +5732,5 @@ -(defvar cperl-compilation-error-regexp-alist +(defvar cperl-compilation-error-regexp-alist ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" @@ -5523,7 +5740,7 @@ (if (fboundp 'eval-after-load) (eval-after-load - "mode-compile" - '(setq perl-compilation-error-regexp-alist - cperl-compilation-error-regexp-alist))) + "mode-compile" + '(setq perl-compilation-error-regexp-alist + cperl-compilation-error-regexp-alist))) @@ -5536,13 +5753,11 @@ (function (lambda () - (if (or - (eq major-mode 'perl-mode) - (eq major-mode 'cperl-mode)) + (if (memq major-mode '(perl-mode cperl-mode)) (progn (or cperl-faces-init (cperl-init-faces))))))) (if (fboundp 'eval-after-load) (eval-after-load - "ps-print" - '(or cperl-faces-init (cperl-init-faces)))))) + "ps-print" + '(or cperl-faces-init (cperl-init-faces)))))) (defun cperl-load-font-lock-keywords () @@ -5585,5 +5800,5 @@ (if (fboundp 'font-lock-fontify-anchored-keywords) (setq font-lock-anchored t)) - (setq + (setq t-font-lock-keywords (list @@ -5638,5 +5853,5 @@ ;; "umask" "unlink" "unpack" "utime" "values" "vec" ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor" - "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|" + "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|" "b\\(in\\(d\\|mode\\)\\|less\\)\\|" "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|" @@ -5709,5 +5924,5 @@ 1 font-lock-function-name-face) (cond ((featurep 'font-lock-extra) - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} @@ -5722,6 +5937,6 @@ '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) - '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 - font-lock-constant-face) ; labels + '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 + font-lock-constant-face) ; labels '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets 2 font-lock-constant-face) @@ -5736,5 +5951,5 @@ ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" (1 font-lock-variable-name-face) - (2 '(restart 2 nil) nil t))) + (2 '(restart 2 nil) nil t))) nil t))) ; local variables, multiple (font-lock-anchored @@ -5748,8 +5963,8 @@ '("\\= 19.12 -;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) -;; ;; XEmacs 19.11 -;; (t 'x-valid-color-name-p)))) - (cperl-force-face font-lock-constant-face + ;; (or (fboundp 'x-color-defined-p) + ;; (defalias 'x-color-defined-p + ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) + ;; ;; XEmacs >= 19.12 + ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) + ;; ;; XEmacs 19.11 + ;; (t 'x-valid-color-name-p)))) + (cperl-force-face font-lock-constant-face "Face for constant and label names") (cperl-force-face font-lock-variable-name-face @@ -5910,16 +6122,16 @@ ;; "Face to use for function names."))) (if (and - (not (cperl-is-face 'cperl-array-face)) - (cperl-is-face 'font-lock-emphasized-face)) + (not (cperl-is-face 'cperl-array-face)) + (cperl-is-face 'font-lock-emphasized-face)) (copy-face 'font-lock-emphasized-face 'cperl-array-face)) (if (and - (not (cperl-is-face 'cperl-hash-face)) - (cperl-is-face 'font-lock-other-emphasized-face)) - (copy-face 'font-lock-other-emphasized-face + (not (cperl-is-face 'cperl-hash-face)) + (cperl-is-face 'font-lock-other-emphasized-face)) + (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) (if (and - (not (cperl-is-face 'cperl-nonoverridable-face)) - (cperl-is-face 'font-lock-other-type-face)) - (copy-face 'font-lock-other-type-face + (not (cperl-is-face 'cperl-nonoverridable-face)) + (cperl-is-face 'font-lock-other-type-face)) + (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face)) ;;(or (boundp 'cperl-hash-face) @@ -5935,8 +6147,6 @@ (if (boundp 'font-lock-background-mode) font-lock-background-mode - 'light)) - (face-list (and (fboundp 'face-list) (face-list))) - ;; cperl-is-face - ) + 'light)) + (face-list (and (fboundp 'face-list) (face-list)))) ;;;; (fset 'cperl-is-face ;;;; (cond ((fboundp 'find-face) @@ -5952,8 +6162,7 @@ background) "Background as guessed by CPerl mode") - (if (and - (not (cperl-is-face 'font-lock-constant-face)) - (cperl-is-face 'font-lock-reference-face)) - (copy-face 'font-lock-reference-face 'font-lock-constant-face)) + (and (not (cperl-is-face 'font-lock-constant-face)) + (cperl-is-face 'font-lock-reference-face) + (copy-face 'font-lock-reference-face 'font-lock-constant-face)) (if (cperl-is-face 'font-lock-type-face) nil (copy-face 'default 'font-lock-type-face) @@ -6031,8 +6240,8 @@ (eval-after-load "ps-print" '(setq ps-bold-faces - ;; font-lock-variable-name-face + ;; font-lock-variable-name-face ;; font-lock-constant-face (append '(cperl-array-face - cperl-hash-face) + cperl-hash-face) ps-bold-faces) ps-italic-faces @@ -6058,6 +6267,6 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." (interactive) - (or file - (setq file (read-from-minibuffer + (or file + (setq file (read-from-minibuffer "Print to file (if empty - to printer): " (concat (buffer-file-name) ".ps") @@ -6080,15 +6289,15 @@ ;;; (append '(font-lock-emphasized-face ;;; cperl-array-face -;;; font-lock-keyword-face -;;; font-lock-variable-name-face -;;; font-lock-constant-face -;;; font-lock-reference-face +;;; font-lock-keyword-face +;;; font-lock-variable-name-face +;;; font-lock-constant-face +;;; font-lock-reference-face ;;; font-lock-other-emphasized-face -;;; cperl-hash-face) +;;; cperl-hash-face) ;;; ps-bold-faces)) ;;; (setq ps-italic-faces ;;; (append '(cperl-nonoverridable-face -;;; font-lock-constant-face -;;; font-lock-reference-face +;;; font-lock-constant-face +;;; font-lock-reference-face ;;; font-lock-other-emphasized-face ;;; cperl-hash-face) @@ -6107,11 +6316,11 @@ (defconst cperl-styles-entries - '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset - cperl-label-offset cperl-extra-newline-before-brace + '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset + cperl-label-offset cperl-extra-newline-before-brace cperl-merge-trailing-else cperl-continued-statement-offset)) (defconst cperl-style-alist - '(("CPerl" ; =GNU without extra-newline-before-brace + '(("CPerl" ; =GNU without extra-newline-before-brace (cperl-indent-level . 2) (cperl-brace-offset . 0) @@ -6121,5 +6330,5 @@ (cperl-merge-trailing-else . t) (cperl-continued-statement-offset . 2)) - ("PerlStyle" ; CPerl with 4 as indent + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) @@ -6172,7 +6381,7 @@ (defun cperl-set-style (style) - "Set CPerl-mode variables to use one of several different indentation styles. + "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. -The list of styles is in `cperl-style-alist', available styles +The list of styles is in `cperl-style-alist', available styles are GNU, K&R, BSD, C++ and Whitesmith. @@ -6182,5 +6391,5 @@ Chosing \"Current\" style will not change style, so this may be used for side-effect of memorizing only." - (interactive + (interactive (let ((list (mapcar (function (lambda (elt) (list (car elt)))) cperl-style-alist))) @@ -6203,5 +6412,5 @@ (let (setting) (while cperl-old-style - (setq setting (car cperl-old-style) + (setq setting (car cperl-old-style) cperl-old-style (cdr cperl-old-style)) (set (car setting) (cdr setting))))) @@ -6236,10 +6445,10 @@ (rename-buffer "*info*") (set-buffer bname))) - (make-variable-buffer-local 'window-min-height) + (make-local-variable 'window-min-height) (setq window-min-height 2) (current-buffer))))) (defun cperl-word-at-point (&optional p) - ;; Returns the word at point or at P. + "Return the word at point or at P." (save-excursion (if p (goto-char p)) @@ -6255,16 +6464,16 @@ (defun cperl-info-on-command (command) - "Shows documentation for Perl command in other window. + "Show documentation for Perl command COMMAND in other window. If perl-info buffer is shown in some frame, uses this frame. Customized by setting variables `cperl-shrink-wrap-info-frame', `cperl-max-help-size'." - (interactive + (interactive (let* ((default (cperl-word-at-point)) - (read (read-string - (format "Find doc for Perl function (default %s): " - default)))) - (list (if (equal read "") - default - read)))) + (read (read-string + (format "Find doc for Perl function (default %s): " + default)))) + (list (if (equal read "") + default + read)))) (let ((buffer (current-buffer)) @@ -6280,5 +6489,5 @@ (set-buffer buf) (beginning-of-buffer) - (or isvar + (or isvar (progn (re-search-forward "^-X[ \t\n]") (forward-line -1))) @@ -6289,5 +6498,5 @@ (forward-line 1)) (beginning-of-line) - ;; Get some of + ;; Get some of (setq pos (point) buf-list (list buf "*info-perl-var*" "*info-perl*")) @@ -6308,15 +6517,15 @@ frheight (frame-height) not-loner (< iniheight (1- frheight))) ; Are not alone - (cond ((if not-loner cperl-max-help-size + (cond ((if not-loner cperl-max-help-size cperl-shrink-wrap-info-frame) - (setq height - (+ 2 - (count-lines - pos + (setq height + (+ 2 + (count-lines + pos (save-excursion (if (re-search-forward "^[ \t][^\n]*\n+\\([^ \t\n\f]\\|\\'\\)" nil t) (match-beginning 0) (point-max))))) - max-height + max-height (if not-loner (/ (* (- frheight 3) cperl-max-help-size) 100) @@ -6325,6 +6534,5 @@ (if (eq char-height 1) (setq char-height 18)) ;; Title, menubar, + 2 for slack - (- (/ (x-display-pixel-height) char-height) 4) - )) + (- (/ (x-display-pixel-height) char-height) 4))) (if (> height max-height) (setq height max-height)) ;;(message "was %s doing %s" iniheight height) @@ -6338,5 +6546,5 @@ (defun cperl-info-on-current-command () - "Shows documentation for Perl command at point in other window." + "Show documentation for Perl command at point in other window." (interactive) (cperl-info-on-command (cperl-word-at-point))) @@ -6348,5 +6556,5 @@ (forward-line 1))) -(defun cperl-imenu-info-imenu-name () +(defun cperl-imenu-info-imenu-name () (buffer-substring (match-beginning 1) (match-end 1))) @@ -6356,10 +6564,10 @@ (let* ((buffer (current-buffer)) imenu-create-index-function - imenu-prev-index-position-function - imenu-extract-index-name-function + imenu-prev-index-position-function + imenu-extract-index-name-function (index-item (save-restriction (save-window-excursion (set-buffer (cperl-info-buffer nil)) - (setq imenu-create-index-function + (setq imenu-create-index-function 'imenu-default-create-index-function imenu-prev-index-position-function @@ -6388,5 +6596,5 @@ MINSHIFT is the minimal amount of space to insert before the construction. STEP is the tabwidth to position constructions. -If STEP is `nil', `cperl-lineup-step' will be used +If STEP is nil, `cperl-lineup-step' will be used \(or `cperl-indent-level', if `cperl-lineup-step' is `nil'). Will not move the position at the start to the left." @@ -6406,6 +6614,6 @@ (if (looking-at "\\<[a-zA-Z0-9_]+\\>") (setq search - (concat "\\<" - (regexp-quote + (concat "\\<" + (regexp-quote (buffer-substring (match-beginning 0) (match-end 0))) "\\>")) @@ -6418,5 +6626,5 @@ (while (progn (beginning-of-line 2) - (and (< (point) end) + (and (< (point) end) (re-search-forward search end t) (goto-char (match-beginning 0)))) @@ -6428,12 +6636,12 @@ (setq col (+ col minshift)) (if (/= (% col step) 0) (setq step (* step (1+ (/ col step))))) - (while + (while (progn (setq e (point)) (skip-chars-backward " \t") (delete-region (point) e) - (indent-to-column col); (make-string (- col (current-column)) ?\ )) - (beginning-of-line 2) - (and (< (point) end) + (indent-to-column col) ;(make-string (- col (current-column)) ?\ )) + (beginning-of-line 2) + (and (< (point) end) (re-search-forward search end t) (goto-char (match-beginning 0)))))))) ; No body @@ -6452,16 +6660,16 @@ ((eq all 'recursive) ;;(error "Not implemented: recursive") - (setq args (append (list "-e" + (setq args (append (list "-e" "sub wanted {push @ARGV, $File::Find::name if /\\.[pP][Llm]$/} use File::Find; find(\\&wanted, '.'); - exec @ARGV;" + exec @ARGV;" cmd) args) cmd "perl")) - (all + (all ;;(error "Not implemented: all") - (setq args (append (list "-e" + (setq args (append (list "-e" "push @ARGV, <*.PL *.pl *.pm>; - exec @ARGV;" + exec @ARGV;" cmd) args) cmd "perl")) @@ -6476,5 +6684,5 @@ (interactive) (setq cperl-auto-newline (not cperl-auto-newline)) - (message "Newlines will %sbe auto-inserted now." + (message "Newlines will %sbe auto-inserted now." (if cperl-auto-newline "" "not "))) @@ -6483,5 +6691,5 @@ (interactive) (abbrev-mode (if abbrev-mode 0 1)) - (message "Perl control structure will %sbe auto-inserted now." + (message "Perl control structure will %sbe auto-inserted now." (if abbrev-mode "" "not "))) @@ -6491,17 +6699,17 @@ (interactive) (setq cperl-electric-parens (if (cperl-val 'cperl-electric-parens) 'null t)) - (message "Parentheses will %sbe auto-doubled now." + (message "Parentheses will %sbe auto-doubled now." (if (cperl-val 'cperl-electric-parens) "" "not "))) (defun cperl-toggle-autohelp () - "Toggle the state of automatic help message in CPerl mode. -See `cperl-lazy-help-time' too." + "Toggle the state of Auto-Help on Perl constructs (put in the message area). +Delay of auto-help controlled by `cperl-lazy-help-time'." (interactive) (if (fboundp 'run-with-idle-timer) (progn (if cperl-lazy-installed - (eval '(cperl-lazy-unstall)) + (cperl-lazy-unstall) (cperl-lazy-install)) - (message "Perl help messages will %sbe automatically shown now." + (message "Perl help messages will %sbe automatically shown now." (if cperl-lazy-installed "" "not "))) (message "Cannot automatically show Perl help messages - run-with-idle-timer missing."))) @@ -6510,9 +6718,9 @@ "Toggle whether `indent-region'/`indent-sexp' fix whitespace too." (interactive) - (setq cperl-indent-region-fix-constructs + (setq cperl-indent-region-fix-constructs (if cperl-indent-region-fix-constructs nil 1)) - (message "indent-region/indent-sexp will %sbe automatically fix whitespace." + (message "indent-region/indent-sexp will %sbe automatically fix whitespace." (if cperl-indent-region-fix-constructs "" "not "))) @@ -6528,5 +6736,5 @@ (if cperl-use-syntax-table-text-property-for-tags (progn - (make-variable-buffer-local 'parse-sexp-lookup-properties) + (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t)))) @@ -6535,5 +6743,5 @@ (require 'cl) (require 'imenu) - (let ((index-alist '()) + (let ((index-alist '()) (prev-pos 0) index index1 name package prefix) (goto-char (point-min)) @@ -6549,5 +6757,5 @@ (imenu-progress-message prev-pos)) (cond - ((match-beginning 2) ; SECTION + ((match-beginning 2) ; SECTION (setq package (buffer-substring (match-beginning 2) (match-end 2))) (goto-char (match-beginning 0)) @@ -6582,9 +6790,9 @@ (defun cperl-find-tags (ifile xs topdir) - (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel - (cperl-pod-here-fontify nil) f file) + (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel + (cperl-pod-here-fontify nil) f file) (save-excursion (if b (set-buffer b) - (cperl-setup-tmp-buf)) + (cperl-setup-tmp-buf)) (erase-buffer) (condition-case err @@ -6595,80 +6803,88 @@ (setq cperl-unreadable-ok t) (error "Aborting: unreadable file %s" ifile))))) - (if (not file) + (if (not file) (message "Unreadable file %s" ifile) - (message "Scanning file %s ..." file) - (if (and cperl-use-syntax-table-text-property-for-tags - (not xs)) - (condition-case err ; after __END__ may have garbage - (cperl-find-pods-heres nil nil noninteractive) - (error (message "While scanning for syntax: %s" err)))) - (if xs - (setq lst (cperl-xsub-scan)) - (setq ind (imenu-example--create-perl-index)) - (setq lst (cdr (assoc "+Unsorted List+..." ind)))) - (setq lst - (mapcar - (function - (lambda (elt) - (cond ((string-match "^[_a-zA-Z]" (car elt)) - (goto-char (cdr elt)) - (beginning-of-line) ; pos should be of the start of the line - (list (car elt) - (point) - (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l - (buffer-substring (progn - (goto-char (cdr elt)) - ;; After name now... - (or (eolp) (forward-char 1)) - (point)) - (progn - (beginning-of-line) - (point)))))))) - lst)) - (erase-buffer) - (while lst - (setq elt (car lst) lst (cdr lst)) - (if elt - (progn - (insert (elt elt 3) - 127 - (if (string-match "^package " (car elt)) - (substring (car elt) 8) - (car elt) ) - 1 - (number-to-string (elt elt 2)) ; Line - "," - (number-to-string (1- (elt elt 1))) ; Char pos 0-based - "\n") - (if (and (string-match "^[_a-zA-Z]+::" (car elt)) - (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]" - (elt elt 3))) - ;; Need to insert the name without package as well - (setq lst (cons (cons (substring (elt elt 3) - (match-beginning 1) - (match-end 1)) - (cdr elt)) - lst)))))) - (setq pos (point)) - (goto-char 1) - (setq rel file) - ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties - (set-text-properties 0 (length rel) nil rel) - (and (equal topdir (substring rel 0 (length topdir))) - (setq rel (substring file (length topdir)))) - (insert "\f\n" rel "," (number-to-string (1- pos)) "\n") - (setq ret (buffer-substring 1 (point-max))) - (erase-buffer) - (or noninteractive - (message "Scanning file %s finished" file)) - ret)))) + (message "Scanning file %s ..." file) + (if (and cperl-use-syntax-table-text-property-for-tags + (not xs)) + (condition-case err ; after __END__ may have garbage + (cperl-find-pods-heres nil nil noninteractive) + (error (message "While scanning for syntax: %s" err)))) + (if xs + (setq lst (cperl-xsub-scan)) + (setq ind (cperl-imenu--create-perl-index)) + (setq lst (cdr (assoc "+Unsorted List+..." ind)))) + (setq lst + (mapcar + (function + (lambda (elt) + (cond ((string-match "^[_a-zA-Z]" (car elt)) + (goto-char (cdr elt)) + (beginning-of-line) ; pos should be of the start of the line + (list (car elt) + (point) + (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l + (buffer-substring (progn + (goto-char (cdr elt)) + ;; After name now... + (or (eolp) (forward-char 1)) + (point)) + (progn + (beginning-of-line) + (point)))))))) + lst)) + (erase-buffer) + (while lst + (setq elt (car lst) lst (cdr lst)) + (if elt + (progn + (insert (elt elt 3) + 127 + (if (string-match "^package " (car elt)) + (substring (car elt) 8) + (car elt) ) + 1 + (number-to-string (elt elt 2)) ; Line + "," + (number-to-string (1- (elt elt 1))) ; Char pos 0-based + "\n") + (if (and (string-match "^[_a-zA-Z]+::" (car elt)) + (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]" + (elt elt 3))) + ;; Need to insert the name without package as well + (setq lst (cons (cons (substring (elt elt 3) + (match-beginning 1) + (match-end 1)) + (cdr elt)) + lst)))))) + (setq pos (point)) + (goto-char 1) + (setq rel file) + ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties + (set-text-properties 0 (length rel) nil rel) + (and (equal topdir (substring rel 0 (length topdir))) + (setq rel (substring file (length topdir)))) + (insert "\f\n" rel "," (number-to-string (1- pos)) "\n") + (setq ret (buffer-substring 1 (point-max))) + (erase-buffer) + (or noninteractive + (message "Scanning file %s finished" file)) + ret)))) (defun cperl-add-tags-recurse-noxs () - "Add to TAGS data for Perl and XSUB files in the current directory and kids. -Use as + "Add to TAGS data for Perl (skipping XSUBs) in the current directory +and kids. Use as emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ - -f cperl-add-tags-recurse + -f cperl-add-tags-recurse-noxs " (cperl-write-tags nil nil t t nil t)) + +(defun cperl-add-tags-recurse-noxs-fullpath () + "Add to TAGS data for Perl (skipping XSUBs) in the current directory +and kids, using fullpath, so TAGS is relocatable. Use as + emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ + -f cperl-add-tags-recurse-noxs-fullpath +" + (cperl-write-tags nil nil t t nil t "")) (defun cperl-add-tags-recurse () @@ -6676,5 +6892,5 @@ Use as emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ - -f cperl-add-tags-recurse + -f cperl-add-tags-recurse " (cperl-write-tags nil nil t t)) @@ -6697,5 +6913,5 @@ (if cperl-xemacs-p (visit-tags-table-buffer) - (visit-tags-table-buffer tags-file-name))) + (visit-tags-table-buffer tags-file-name))) (t (set-buffer (find-file-noselect tags-file-name)))) (cond @@ -6705,7 +6921,7 @@ (erase-buffer) (setq erase 'ignore))) - (let ((files + (let ((files (condition-case err - (directory-files file t + (directory-files file t (if recurse nil cperl-scan-files-regexp) t) @@ -6714,18 +6930,18 @@ (if (y-or-n-p (format "Directory %s unreadable. Continue? " file)) - (setq cperl-unreadable-ok t - tm nil) ; Return empty list + (setq cperl-unreadable-ok t + tm nil) ; Return empty list (error "Aborting: unreadable directory %s" file))))))) - (mapcar (function (lambda (file) - (cond - ((string-match cperl-noscan-files-regexp file) - nil) - ((not (file-directory-p file)) - (if (string-match cperl-scan-files-regexp file) - (cperl-write-tags file erase recurse nil t noxs topdir))) - ((not recurse) nil) - (t (cperl-write-tags file erase recurse t t noxs topdir))))) - files)) - ) + (mapcar (function + (lambda (file) + (cond + ((string-match cperl-noscan-files-regexp file) + nil) + ((not (file-directory-p file)) + (if (string-match cperl-scan-files-regexp file) + (cperl-write-tags file erase recurse nil t noxs topdir))) + ((not recurse) nil) + (t (cperl-write-tags file erase recurse t t noxs topdir))))) + files))) (t (setq xs (string-match "\\.xs$" file)) @@ -6733,31 +6949,31 @@ (progn (cond ((eq erase 'ignore) (goto-char (point-max))) - (erase (erase-buffer)) - (t - (goto-char 1) - (setq rel file) - ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties - (set-text-properties 0 (length rel) nil rel) - (and (equal topdir (substring rel 0 (length topdir))) - (setq rel (substring file (length topdir)))) - (if (search-forward (concat "\f\n" rel ",") nil t) - (progn - (search-backward "\f\n") - (delete-region (point) - (save-excursion - (forward-char 1) - (if (search-forward "\f\n" - nil 'toend) - (- (point) 2) - (point-max))))) - (goto-char (point-max))))) + (erase (erase-buffer)) + (t + (goto-char 1) + (setq rel file) + ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties + (set-text-properties 0 (length rel) nil rel) + (and (equal topdir (substring rel 0 (length topdir))) + (setq rel (substring file (length topdir)))) + (if (search-forward (concat "\f\n" rel ",") nil t) + (progn + (search-backward "\f\n") + (delete-region (point) + (save-excursion + (forward-char 1) + (if (search-forward "\f\n" + nil 'toend) + (- (point) 2) + (point-max))))) + (goto-char (point-max))))) (insert (cperl-find-tags file xs topdir)))))) - (if inbuffer nil ; Delegate to the caller - (save-buffer 0) ; No backup + (if inbuffer nil ; Delegate to the caller + (save-buffer 0) ; No backup (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? (initialize-new-tags-table)))))) (defvar cperl-tags-hier-regexp-list - (concat + (concat "^\\(" "\\(package\\)\\>" @@ -6771,5 +6987,5 @@ (defvar cperl-hierarchy '(() ()) - "Global hierarchy of classes") + "Global hierarchy of classes.") (defun cperl-tags-hier-fill () @@ -6778,5 +6994,5 @@ (let (type pack name pos line chunk ord cons1 file str info fileind) (while (re-search-forward cperl-tags-hier-regexp-list nil t) - (setq pos (match-beginning 0) + (setq pos (match-beginning 0) pack (match-beginning 2)) (beginning-of-line) @@ -6808,5 +7024,5 @@ ;; First occurrence of the name, start alist (setq cons1 (cons name (list (cons fileind (vector file info))))) - (if pack + (if pack (setcar (cdr cperl-hierarchy) (cons cons1 (nth 1 cperl-hierarchy))) @@ -6824,9 +7040,9 @@ (require 'imenu) (if (or update (null (nth 2 cperl-hierarchy))) - (let (pack name cons1 to l1 l2 l3 l4 b - (remover (function (lambda (elt) ; (name (file1...) (file2..)) - (or (nthcdr 2 elt) - ;; Only in one file - (setcdr elt (cdr (nth 1 elt)))))))) + (let ((remover (function (lambda (elt) ; (name (file1...) (file2..)) + (or (nthcdr 2 elt) + ;; Only in one file + (setcdr elt (cdr (nth 1 elt))))))) + pack name cons1 to l1 l2 l3 l4 b) ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! (setq cperl-hierarchy (list l1 l2 l3)) @@ -6863,5 +7079,8 @@ (setq update ;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) - (if window-system + (if (if (boundp 'display-popup-menus-p) + (let ((f 'display-popup-menus-p)) + (funcall f)) + window-system) (x-popup-menu t (nth 2 cperl-hierarchy)) (require 'tmm) @@ -6870,5 +7089,5 @@ (progn (while (cdr update) (setq update (cdr update))) (setq update (car update)))) ; Get the last from the list - (if (vectorp update) + (if (vectorp update) (progn (find-file (elt update 0)) @@ -6878,5 +7097,5 @@ (defun cperl-tags-treeify (to level) ;; cadr of `to' is read-write. On start it is a cons - (let* ((regexp (concat "^\\(" (mapconcat + (let* ((regexp (concat "^\\(" (mapconcat 'identity (make-list level "[_a-zA-Z0-9]+") @@ -6942,14 +7161,13 @@ (cdr to))))) (if (default-value 'imenu-sort-function) - (nreverse + (nreverse (sort root-packages (default-value 'imenu-sort-function))) - root-packages)) - )) + root-packages)))) ;;;(x-popup-menu t -;;; '(keymap "Name1" +;;; '(keymap "Name1" ;;; ("Ret1" "aa") -;;; ("Head1" "ab" -;;; keymap "Name2" +;;; ("Head1" "ab" +;;; keymap "Name2" ;;; ("Tail1" "x") ("Tail2" "y")))) @@ -6959,5 +7177,5 @@ (setq list1 nil list2 nil) (while list - (setq num (1+ num) + (setq num (1+ num) elt1 (car list) list (cdr list)) @@ -6975,7 +7193,7 @@ (defun cperl-menu-to-keymap (menu &optional name) (let (list) - (cons 'keymap - (mapcar - (function + (cons 'keymap + (mapcar + (function (lambda (elt) (cond ((listp (cdr elt)) @@ -6992,12 +7210,12 @@ (defvar cperl-bad-style-regexp (mapconcat 'identity - '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign - "[-<>=+^&|]+[^- \t\n=+<>~]" ; sign+ char - ) - "\\|") + '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign + "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char + "\\|") "Finds places such that insertion of a whitespace may help a lot.") -(defvar cperl-not-bad-style-regexp - (mapconcat 'identity +(defvar cperl-not-bad-style-regexp + (mapconcat + 'identity '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. @@ -7018,5 +7236,5 @@ "&&" "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C - "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value + "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below ;;"[*/+-|&<.]+=" @@ -7037,7 +7255,7 @@ (beginning-of-buffer) (map-y-or-n-p "Insert space here? " - (function (lambda (arg) (insert " "))) + (lambda (arg) (insert " ")) 'cperl-next-bad-style - '("location" "locations" "insert a space into") + '("location" "locations" "insert a space into") '((?\C-r (lambda (arg) (let ((buffer-quit-function @@ -7046,5 +7264,5 @@ (recursive-edit) t)) ; Consider acted upon - "edit, exit with Esc Esc") + "edit, exit with Esc Esc") (?e (lambda (arg) (let ((buffer-quit-function @@ -7071,5 +7289,5 @@ (save-excursion (skip-chars-backward " \t\n") - (memq (preceding-char) '(?\= ?\> ?\< ?\, ?\(, ?\[, ?\{)))) + (memq (preceding-char) '(?\= ?\> ?\< ?\, ?\( ?\[ ?\{)))) ;; Now check for syntax type (save-match-data @@ -7084,25 +7302,24 @@ (not not-found))) + ;;; Getting help -(defvar cperl-have-help-regexp +(defvar cperl-have-help-regexp ;;(concat "\\(" (mapconcat 'identity - '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable + '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable "[$@]\\^[a-zA-Z]" ; Special variable "[$@][^ \n\t]" ; Special variable "-[a-zA-Z]" ; File test "\\\\[a-zA-Z0]" ; Special chars - "^=[a-z][a-zA-Z0-9_]*" ; Pod sections + "^=[a-z][a-zA-Z0-9_]*" ; POD sections "[-!&*+,-./<=>?\\\\^|~]+" ; Operator "[a-zA-Z_0-9:]+" ; symbol or number "x=" - "#!" - ) + "#!") ;;"\\)\\|\\(" - "\\|" - ) - ;;"\\)" - ;;) + "\\|") + ;;"\\)" + ;;) "Matches places in the buffer we can find help for.") @@ -7114,5 +7331,5 @@ ;; Get to the something meaningful (or (eobp) (eolp) (forward-char 1)) - (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" + (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" (save-excursion (beginning-of-line) (point)) 'to-beg) @@ -7125,5 +7342,5 @@ ((looking-at "[a-zA-Z0-9_:]") ; symbol (skip-chars-backward "a-zA-Z0-9_:") - (cond + (cond ((and (eq (preceding-char) ?^) ; $^I (eq (char-after (- (point) 2)) ?\$)) @@ -7179,5 +7396,5 @@ (cperl-describe-perl-symbol word)) (if cperl-message-on-help-error - (message "Nothing found for %s..." + (message "Nothing found for %s..." (buffer-substring (point) (min (+ 5 (point)) (point-max)))))))))) @@ -7192,23 +7409,23 @@ args-file regexp) (cond - ((string-match "^[&*][a-zA-Z_]" val) - (setq val (concat (substring val 0 1) "NAME"))) - ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val) - (setq val (concat "@" (substring val 1 (match-end 1))))) - ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val) - (setq val (concat "%" (substring val 1 (match-end 1))))) - ((and (string= val "x") (string-match "^x=" val)) - (setq val "x=")) - ((string-match "^\\$[\C-a-\C-z]" val) - (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1)))))) - ((string-match "^CORE::" val) - (setq val "CORE::")) - ((string-match "^SUPER::" val) - (setq val "SUPER::")) - ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val)) - (setq val ""))) - (setq regexp (concat "^" + ((string-match "^[&*][a-zA-Z_]" val) + (setq val (concat (substring val 0 1) "NAME"))) + ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val) + (setq val (concat "@" (substring val 1 (match-end 1))))) + ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val) + (setq val (concat "%" (substring val 1 (match-end 1))))) + ((and (string= val "x") (string-match "^x=" val)) + (setq val "x=")) + ((string-match "^\\$[\C-a-\C-z]" val) + (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1)))))) + ((string-match "^CORE::" val) + (setq val "CORE::")) + ((string-match "^SUPER::" val) + (setq val "SUPER::")) + ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val)) + (setq val ""))) + (setq regexp (concat "^" "\\([^a-zA-Z0-9_:]+[ \t]+\\)?" - (regexp-quote val) + (regexp-quote val) "\\([ \t([/]\\|$\\)")) @@ -7219,5 +7436,5 @@ (goto-char (point-min)) (let ((case-fold-search nil)) - (list + (list (if (re-search-forward regexp (point-max) t) (save-excursion @@ -7229,13 +7446,14 @@ (message "No definition for %s" val))))))) -(defvar cperl-short-docs "Ignore my value" +(defvar cperl-short-docs 'please-ignore-this-line ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl) "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5] -! ... Logical negation. +... Range (list context); flip/flop [no flop when flip] (scalar context). +! ... Logical negation. ... != ... Numeric inequality. ... !~ ... Search pattern, substitution, or translation (negated). $! In numeric context: errno. In a string context: error string. $\" The separator which joins elements of arrays interpolated in strings. -$# The output format for printed numbers. Initial value is %.15g or close. +$# The output format for printed numbers. Default is %.15g or close. $$ Process number of this script. Changes in the fork()ed child process. $% The current page number of the currently selected output channel. @@ -7264,5 +7482,5 @@ $. The current input line number of the last filehandle that was read. $/ The input record separator, newline by default. -$0 Name of the file containing the perl script being executed. May be set. +$0 Name of the file containing the current perl script (read/write). $: String may be broken after these characters to fill ^-lines in a format. $; Subscript separator for multi-dim array emulation. Default \"\\034\". @@ -7291,5 +7509,5 @@ $^X The name under which perl was invoked (argv[0] in C-speech). $_ The default input and pattern-searching space. -$| Auto-flush after write/print on current output channel? Default 0. +$| Auto-flush after write/print on current output channel? Default 0. $~ The name of the current report format. ... % ... Modulo division. @@ -7341,10 +7559,10 @@ -z File has zero size. . Concatenate strings. -.. Alternation, also range operator. +.. Range (list context); flip/flop (scalar context) operator. .= Concatenate assignment strings ... / ... Division. /PATTERN/ioxsmg Pattern match ... /= ... Division assignment. /PATTERN/ioxsmg Pattern match. -... < ... Numeric less than. Glob. See , <> as well. +... < ... Numeric less than. Glob. See , <> as well. Reads line from filehandle NAME (a bareword or dollar-bareword). Glob (Unless pattern is bareword/dollar-bareword - see ). @@ -7364,5 +7582,5 @@ @ARGV Command line arguments (not including the command name - see $0). @INC List of places to look for perl scripts during do/include/use. -@_ Parameter array for subroutines. Also used by split unless in list context. +@_ Parameter array for subroutines; result of split() unless in list context. \\ Creates reference to what follows, like \$var, or quotes non-\w in strings. \\0 Octal char, e.g. \\033. @@ -7615,5 +7833,5 @@ else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. -exists $HASH{KEY} True if the key exists. +exists $HASH{KEY} True if the key exists. format [NAME] = Start of output format. Ended by a single dot (.) on a line. formline PICTURE, LIST Backdoor into \"format\" processing. @@ -7693,5 +7911,5 @@ (beginning-of-line) (if (re-search-forward "[^ \t]" e t) - (progn ; Something before the ending delimiter + (progn ; Something before the ending delimiter (goto-char e) (delete-horizontal-space) @@ -7710,5 +7928,5 @@ (while (and inline - (looking-at + (looking-at (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 word "\\|" ; Embedded variable @@ -7723,6 +7941,5 @@ "\\((\\(\\?\\)?\\)" ; 7 8 "\\|" ; | - "\\(|\\)" ; 9 - ))) + "\\(|\\)"))) ; 9 (goto-char (match-end 0)) (setq spaces t) @@ -7771,5 +7988,5 @@ (if (= level 1) (if (progn ; indent rigidly if multiline - ;; In fact does not make a lot of sense, since + ;; In fact does not make a lot of sense, since ;; the starting position can be already lost due ;; to insertion of "\n" and " " @@ -7834,18 +8051,17 @@ (insert " ")) (skip-chars-forward " \t")) - (or (looking-at "[#\n]") - (error "unknown code \"%s\" in a regexp" - (buffer-substring (point) (1+ (point))))) - (and inline (end-of-line 2))) + (or (looking-at "[#\n]") + (error "Unknown code `%s' in a regexp" + (buffer-substring (point) (1+ (point))))) + (and inline (end-of-line 2))) ;; Special-case the last line of group (if (and (>= (point) (marker-position e)) (/= (current-indentation) c)) (progn - (beginning-of-line) - (setq s (point)) - (skip-chars-forward " \t") - (delete-region s (point)) - (indent-to-column c))) - )) + (beginning-of-line) + (setq s (point)) + (skip-chars-forward " \t") + (delete-region s (point)) + (indent-to-column c))))) (defun cperl-make-regexp-x () @@ -7860,5 +8076,5 @@ (if (looking-at "\\([smy]\\|qr\\)\\s|") (forward-char 1) - (re-search-backward "\\s|"))) ; Assume it is scanned already. + (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) @@ -7870,5 +8086,5 @@ (error "Possible s/blah// - do not know how to deal with")) (if sub-p (forward-sexp 1)) - (if (looking-at "\\sw*x") + (if (looking-at "\\sw*x") (setq have-x t) (insert "x")) @@ -7883,10 +8099,8 @@ (defun cperl-beautify-regexp (&optional deep) - "do it. (Experimental, may change semantics, recheck the result.) + "Do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive "P") - (if deep - (prefix-numeric-value deep) - (setq deep -1)) + (setq deep (if deep (prefix-numeric-value deep) -1)) (save-excursion (goto-char (cperl-make-regexp-x)) @@ -7917,21 +8131,21 @@ (interactive) ;; (save-excursion ; Can't, breaks `cperl-contract-levels' - (cperl-regext-to-level-start) - (let ((b (point)) (e (make-marker)) s c) - (forward-sexp 1) - (set-marker e (1- (point))) - (goto-char b) - (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) - (cond - ((match-beginning 1) ; #-comment - (or c (setq c (current-indentation))) - (beginning-of-line 2) ; Skip - (setq s (point)) - (skip-chars-forward " \t") - (delete-region s (point)) - (indent-to-column c)) - (t - (delete-char -1) - (just-one-space)))))) + (cperl-regext-to-level-start) + (let ((b (point)) (e (make-marker)) s c) + (forward-sexp 1) + (set-marker e (1- (point))) + (goto-char b) + (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) + (cond + ((match-beginning 1) ; #-comment + (or c (setq c (current-indentation))) + (beginning-of-line 2) ; Skip + (setq s (point)) + (skip-chars-forward " \t") + (delete-region s (point)) + (indent-to-column c)) + (t + (delete-char -1) + (just-one-space)))))) (defun cperl-contract-levels () @@ -7950,5 +8164,5 @@ (goto-char (1+ b)) (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) - (cond + (cond ((match-beginning 1) ; Skip nil) @@ -7961,7 +8175,5 @@ We suppose that the regexp is scanned already." (interactive "P") - (if deep - (prefix-numeric-value deep) - (setq deep -1)) + (setq deep (if deep (prefix-numeric-value deep) -1)) (save-excursion (cperl-regext-to-level-start) @@ -7975,5 +8187,5 @@ (interactive) (or (looking-at "\\<") - (forward-sexp -1)) + (forward-sexp -1)) (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") (let ((pos1 (point)) @@ -8015,5 +8227,5 @@ s1 (buffer-substring p (match-end 0)) state (parse-partial-sexp pos4 p)) - (or (nth 3 state) + (or (nth 3 state) (nth 4 state) (nth 5 state) @@ -8055,5 +8267,5 @@ (error "`%s' (EXPR) not with an {BLOCK}" s0))) (error "`%s' not with an (EXPR)" s0))) - (error "Not at `if', `unless', `while', `unless', `for' or `foreach'"))) + (error "Not at `if', `unless', `while', `until', `for' or `foreach'"))) ;;; By Anthony Foiani @@ -8075,5 +8287,7 @@ default-entry) input)))) - (let* ((is-func (and + (require 'man) + (let* ((case-fold-search nil) + (is-func (and (string-match "^[a-z]+$" word) (string-match (concat "^" word "\\>") @@ -8082,6 +8296,11 @@ 'variable-documentation)))) (manual-program (if is-func "perldoc -f" "perldoc"))) - (require 'man) - (Man-getpage-in-background word))) + (cond + (cperl-xemacs-p + (let ((Manual-program "perldoc") + (Manual-switches (if is-func (list "-f")))) + (manual-entry word))) + (t + (Man-getpage-in-background word))))) (defun cperl-perldoc-at-point () @@ -8113,4 +8332,17 @@ 'Man-bgproc-sentinel))))) +;;; Updated version by him too +(defun cperl-build-manpage () + "Create a virtual manpage in Emacs from the POD in the file." + (interactive) + (require 'man) + (cond + (cperl-xemacs-p + (let ((Manual-program "perldoc")) + (manual-entry buffer-file-name))) + (t + (let* ((manual-program "perldoc")) + (Man-getpage-in-background buffer-file-name))))) + (defun cperl-pod2man-build-command () "Builds the entire background manpage and cleaning command." @@ -8131,4 +8363,5 @@ (defun cperl-lazy-install ()) ; Avoid a warning +(defun cperl-lazy-unstall ()) ; Avoid a warning (if (fboundp 'run-with-idle-timer) @@ -8141,4 +8374,6 @@ (defun cperl-lazy-install () + "Switches on Auto-Help on Perl constructs (put in the message area). +Delay of auto-help controlled by `cperl-lazy-help-time'." (interactive) (make-variable-buffer-local 'cperl-help-shown) @@ -8147,11 +8382,13 @@ (progn (add-hook 'post-command-hook 'cperl-lazy-hook) - (run-with-idle-timer - (cperl-val 'cperl-lazy-help-time 1000000 5) - t + (run-with-idle-timer + (cperl-val 'cperl-lazy-help-time 1000000 5) + t 'cperl-get-help-defer) (setq cperl-lazy-installed t)))) (defun cperl-lazy-unstall () + "Switches off Auto-Help on Perl constructs (put in the message area). +Delay of auto-help controlled by `cperl-lazy-help-time'." (interactive) (remove-hook 'post-command-hook 'cperl-lazy-hook) @@ -8163,5 +8400,5 @@ (defun cperl-get-help-defer () - (if (not (eq major-mode 'perl-mode)) nil + (if (not (memq major-mode '(perl-mode cperl-mode))) nil (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) (cperl-get-help) @@ -8185,6 +8422,7 @@ ;; Some vars for debugging only ;; (message "Syntaxifying...") - (let (start (dbg (point)) (iend end) - (istate (car cperl-syntax-state))) + (let ((dbg (point)) (iend end) + (istate (car cperl-syntax-state)) + start) (and cperl-syntaxify-unwind (setq end (cperl-unwind-to-safe t end))) @@ -8203,8 +8441,8 @@ (cperl-find-pods-heres start end t nil t)) (if (eq cperl-syntaxify-by-font-lock 'message) - (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" - dbg iend - start end cperl-syntax-done-to - istate (car cperl-syntax-state))) ; For debugging + (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" + dbg iend + start end cperl-syntax-done-to + istate (car cperl-syntax-state))) ; For debugging nil)) ; Do not iterate @@ -8216,5 +8454,5 @@ (and prop (put-text-property pos posend (car prop) (cdr prop))) (setq pos posend))) - nil) ; Do not iterate + nil) ; Do not iterate (defun cperl-update-syntaxification (from to) @@ -8228,6 +8466,6 @@ (cperl-fontify-syntaxically to))))) -(defvar cperl-version - (let ((v "$Revision: 1.1.1.4 $")) +(defvar cperl-version + (let ((v "$Revision: 1.1.1.5 $")) (string-match ":\\s *\\([0-9.]+\\)" v) (substring v (match-beginning 1) (match-end 1))) Index: /branches/vendor/third/perl/emacs/ptags =================================================================== --- /branches/vendor/third/perl/emacs/ptags (revision 18449) +++ /branches/vendor/third/perl/emacs/ptags (revision 20074) @@ -3,4 +3,11 @@ # to get tags from all files.) # +# +# usage: sh emacs/ptags +# +# options: +# +# fullpath - use full paths in TAGS (default: relative to the root) +# # (IZ: to be a happier jumper: install 'imenu-go.el' from # ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs.) @@ -18,13 +25,28 @@ if test ! -z "$OS2_SHELL"; then alias find=gnufind; fi +case "$1" in + fullpath) + cwd=`pwd` + cperl_add_tags='cperl-add-tags-recurse-noxs-fullpath' + echo "Building TAGS with full paths" + ;; + *) + cperl_add_tags='cperl-add-tags-recurse-noxs' + cwd='.' + echo "Building TAGS with relative paths" +esac + +emacs=`(which emacs || which xemacs) 2>/dev/null` +[ -x "$emacs" ] || { echo "can't find emacs or xemacs in PATH"; exit 1; } + # Insure proper order (.h after .c, .xs before .c in subdirs): # Move autogenerated less-informative files to the end: # Hard to do embed.h and embedvar.h in one sweep: -topfiles="`echo ' ' *.y *.c *.h ' ' | sed 's/ / /g' | sed 's/ embedvar\.h\|embed\.h\|perlapi\.h\|\(globals\|perlapi\)\.c / /g'`" -subdirs="`find ./* -maxdepth 0 -type d`" +topfiles="`echo ' ' *.y *.c *.h ' ' | sed 's/ / /g' | sed 's/ embedvar\.h\|embed\.h\|perlapi\.h\|os2ish\.h\|\(globals\|perlapi\| os2\)\.c / /g'| sed "s#\(^\| \)\([^ ]\)#\1$cwd/\2#g"`" +subdirs="`find $cwd/* -maxdepth 0 -type d`" subdirfiles="`find $subdirs -name '*.[cy]' -print | sort`" subdirfiles1="`find $subdirs -name '*.[hH]' -print | sort`" -xsfiles="`find . -name '*.xs' -print | sort`" +xsfiles="`find $cwd/ -name '*.xs' -print | sort`" # etags -d : process defines too (default now) @@ -53,9 +75,9 @@ etags -o TAGS.tmp \ -l none -r '/#\(\$[a-zA-Z_0-9]+\|define\)[ \t]+\([a-zA-Z_0-9]+\)/\2/' \ - config_h.SH + $cwd/config_h.SH # Process lines like this: Mcc (Loc.U): etags -o TAGS.tmp -a \ -l none -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\$\1/' \ - -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\1/' Porting/Glossary + -r '/^\([a-zA-Z_0-9]+\)[ \t]+(/\1/' $cwd/Porting/Glossary etags -o TAGS.tmp -a "$@" $topfiles @@ -99,6 +121,6 @@ }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp -etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' embed.h -etags -o TAGS.tmp -a globals.c embedvar.h perlapi.c perlapi.h +etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' $cwd/embed.h +etags -o TAGS.tmp -a $cwd/globals.c $cwd/embedvar.h $cwd/perlapi.c $cwd/perlapi.h # The above processes created a lot of descriptions with an @@ -142,5 +164,5 @@ if test ! -f emacs/cperl-mode.elc ; then - ( cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el ) + ( cd emacs; $emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el ) fi @@ -148,5 +170,5 @@ cp TAGS.tmp TAGS -if emacs -batch -q -no-site-file -l emacs/cperl-mode.elc -f cperl-add-tags-recurse-noxs ; then +if $emacs -batch -q -no-site-file -l emacs/cperl-mode.elc -f $cperl_add_tags ; then mv TAGS TAGS.tmp fi Index: /branches/vendor/third/perl/installhtml =================================================================== --- /branches/vendor/third/perl/installhtml (revision 18449) +++ /branches/vendor/third/perl/installhtml (revision 20074) @@ -7,5 +7,5 @@ use Getopt::Long; # for command-line parsing use Cwd; -use Pod::Html; +use Pod::Html 'anchorify'; =head1 NAME @@ -228,4 +228,5 @@ foreach my $dir (@splithead) { + (my $pod = $dir) =~ s,^.*/,,; $dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/; # let pod2html create the file @@ -244,13 +245,13 @@ my @data = (); while () { - last if /NAME=/; - $_ =~ s{HREF="#(.*)">}{ - my $url = "$file/$1.html" ; - $url = Pod::Html::relativize_url( $url, "$file.html" ) - if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' ); - "HREF=\"$url\">" ; - }eg; + last if /name="name"/i; + $_ =~ s{href="#(.*)">}{ + my $url = "$pod/$1.html" ; + $url = Pod::Html::relativize_url( $url, "$file.html" ) + if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' ); + "href=\"$url\">" ; + }egi; push @data, $_; - } + } close(H); @@ -304,4 +305,5 @@ sub create_index { my($html, $dir) = @_; + (my $pod = $dir) =~ s,^.*/,,; my(@files, @filedata, @index, $file); my($lcp1,$lcp2); @@ -329,18 +331,19 @@ # pull out the NAME section - my $name; - ($name) = grep(/NAME=/, @filedata); - ($lcp1,$lcp2) = ($name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm); - if (defined $lcp1 and $lcp1 eq '

') { # Uninteresting. Try again. - ($lcp1,$lcp2) = ($name =~ m,/H1>\s

\s(\S+)\s[\s-]*(.*?)\s*$,sm); - } - my $url= "$dir/$file" ; + my $name; + ($name) = grep(/name="name"/i, @filedata); + ($lcp1,$lcp2) = ($name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,smi); + if (defined $lcp1 and $lcp1 =~ m,^

$,i) { # Uninteresting. Try again. + ($lcp1,$lcp2) = ($name =~ m,/H1>\s

\s*(\S+)\s[\s-]*(.*?)\s*$,smi); + } + my $url= "$pod/$file" ; if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' ) { - $url = Pod::Html::relativize_url( "$dir/$file", $html ) ; - } - - print HTML qq(); - print HTML "

$lcp1
$lcp2\n" if defined $lcp1; -# print HTML qq($lcp1
\n") if defined $lcp1; + $url = Pod::Html::relativize_url( "$pod/$file", $html ) ; + } + + if (defined $lcp1) { + print HTML qq(
); + print HTML "$lcp1
$lcp2
\n"; + } next; @@ -351,5 +354,4 @@ s/(\s*\s*)/$lcp2/s; s,#,$dir/$file#,g; - # print HTML "$_\n"; print HTML "$_\n

\n"; } @@ -370,5 +372,5 @@ # figure out the directory name and filename $pod =~ s,^([^/]*)$,/$1,; - $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $pod =~ m,(.*)/(.*?)(\.pod)?$,; $dirname = $1; $filename = "$2.pod"; @@ -390,9 +392,10 @@ print "splitting files by item.\n" if $verbose && $#splititem >= 0; $pwd = getcwd(); - my $splitter = absolute_path($pwd, "$splitpod/splitpod"); + my $splitter = absolute_path($pwd, "$splitpod/splitpod"); + my $perl = absolute_path($pwd, $^X); foreach my $pod (@splititem) { # figure out the directory to split into $pod =~ s,^([^/]*)$,/$1,; - $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $pod =~ m,(.*)/(.*?)(\.pod)?$,; $dirname = "$1/$2"; $filename = "$2.pod"; @@ -411,5 +414,5 @@ die "$splitter not found. Use '-splitpod dir' option.\n" unless -f $splitter; - system("perl", $splitter, "../$filename") && + system($perl, $splitter, "../$filename") && warn "$0: error running '$splitter ../$filename'" ." from $podroot/$dirname"; @@ -453,5 +456,5 @@ my %heads = (); foreach $i (0..$#poddata) { - $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/; + $heads{anchorify($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/; } @@ -485,5 +488,5 @@ # what pod2html will try and guess) # $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/; - $file = "$dir/" . htmlize($section) . ".pod"; + $file = "$dir/" . anchorify($section) . ".pod"; # create the new .pod file @@ -492,6 +495,6 @@ die "$0: error opening $poddir/$file for output: $!\n"; $poddata[$i] =~ s,L<([^<>]*)>, - defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>" - ,ge; + defined $heads{anchorify($1)} ? "L<$dir/$1>" : "L<$1>" + ,ge; print SPLITOUT $poddata[$i]."\n\n"; print SPLITOUT "=over 4\n\n"; @@ -551,5 +554,5 @@ # check if a .pm files exists too - if (grep($_ eq "$pod.pm", @pmlist)) { + if (grep($_ eq $pod, @pmlist)) { print "$0: Warning both `$podroot/$pod.pod' and " . "`$podroot/$pod.pm' exist, using pod\n"; @@ -593,7 +596,5 @@ # invoke pod2html print "$podroot/$pod => $htmldir/$html\n" if $verbose; -#system("./pod2html", - Pod::Html'pod2html( - #Pod::Html'pod2html($pod2html, + Pod::Html::pod2html( "--htmldir=$htmldir", "--htmlroot=$htmlroot", @@ -607,4 +608,2 @@ die "$0: error running $pod2html: $!\n" if $?; } - -sub htmlize { htmlify(0, @_) } Index: /branches/vendor/third/perl/av.h =================================================================== --- /branches/vendor/third/perl/av.h (revision 18449) +++ /branches/vendor/third/perl/av.h (revision 20074) @@ -1,5 +1,6 @@ /* av.h * - * Copyright (c) 1991-2002, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -84,2 +85,3 @@ ? mg_size((SV *) av) : AvFILLp(av)) +#define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" Index: /branches/vendor/third/perl/xsutils.c =================================================================== --- /branches/vendor/third/perl/xsutils.c (revision 18449) +++ /branches/vendor/third/perl/xsutils.c (revision 20074) @@ -1,5 +1,5 @@ /* xsutils.c * - * Copyright (c) 1999-2002, Larry Wall + * Copyright (C) 1999, 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public Index: /branches/vendor/third/perl/configure.com =================================================================== --- /branches/vendor/third/perl/configure.com (revision 18449) +++ /branches/vendor/third/perl/configure.com (revision 20074) @@ -881,5 +881,5 @@ $ config_symbols2 ="|prefix|privlib|privlibexp|scriptdir|sitearch|sitearchexp|sitebin|sitelib|sitelib_stem|sitelibexp|try_cxx|use64bitall|use64bitint|" $ config_symbols3 ="|usecasesensitive|usedefaulttypes|usedevel|useieee|useithreads|usemultiplicity|usemymalloc|usedebugging_perl|useperlio|usesecurelog|" -$ config_symbols4 ="|usethreads|usevmsdebug|" +$ config_symbols4 ="|usethreads|usevmsdebug|usefaststdio|" $! $ open/read CONFIG 'config_sh' @@ -933,4 +933,5 @@ $! echo " ","VMS_VAX" $! echo " ","VMS_AXP" +$! echo " ","VMS_IA64" $! : Now look for a hint file osname_osvers, unless one has been $! : specified already. @@ -1106,15 +1107,22 @@ $! configure a VAX build on an Alpha). $! -$ IF (F$GETSYI("HW_MODEL") .LT. 1024) +$ IF (F$GETSYI("HW_MODEL") .LT. 1024 .AND. F$GETSYI("HW_MODEL") .GT. 0) $ THEN $ archname = "VMS_VAX" -$ otherarch = "an Alpha" +$ otherarch = "an Alpha or IA64" $ alignbytes="8" $ arch_type = "ARCH-TYPE=__VAX__" $ ELSE -$ archname = "VMS_AXP" -$ otherarch = "a VAX" +$ IF (F$GETSYI("ARCH_TYPE") .EQ. 2) +$ THEN +$ archname = "VMS_AXP" +$ otherarch = "a VAX or IA64" +$ arch_type = "ARCH-TYPE=__AXP__" +$ ELSE +$ archname = "VMS_IA64" +$ otherarch = "a VAX or Alpha" +$ arch_type = "ARCH-TYPE=__IA64__" +$ ENDIF $ alignbytes="8" -$ arch_type = "ARCH-TYPE=__AXP__" $ ENDIF $ dflt = archname @@ -1142,4 +1150,8 @@ $ THEN $ macros = macros + """AXE=1""," +$ ENDIF +$ IF (archname.EQS."VMS_IA64") +$ THEN +$ macros = macros + """IXE=1""," $ ENDIF $ ENDIF @@ -1582,5 +1594,6 @@ $ ENDIF $ ELSE -$ IF (F$LOCATE("DEC",line).NE.F$LENGTH(line)).or.(F$LOCATE("Compaq",line).NE.F$LENGTH(line)) +$ IF (F$LOCATE("DEC",line).NE.F$LENGTH(line)).or.(F$LOCATE("Compaq",line).NE.F$LENGTH(line)) - + .or.(F$LOCATE("hp",line).NE.F$LENGTH(line)) $ THEN $ vms_cc_dflt = "/decc" @@ -1716,5 +1729,6 @@ $ ans = F$EDIT(ans,"TRIM, COMPRESS, LOWERCASE") $ Mcc = ans -$ IF (F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans)) +$ IF (F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans)) - + .or.(F$LOCATE("hp",ans).NE.F$LENGTH(ans)) $ THEN $ Mcc = "cc/decc" @@ -2003,5 +2017,10 @@ $ archsufx = "VAX" $ ELSE -$ archsufx = "AXP" +$ IF archname .EQS. "VMS_AXP" +$ THEN +$ archsufx = "AXP" +$ ELSE +$ archsufx = "IA64" +$ ENDIF $ ENDIF $ CLOSE CONFIG @@ -2250,5 +2269,5 @@ $! $! Ask if they want to build with 64-bit support -$ IF (archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") +$ IF (archname.NES."VMS_VAX").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") $ THEN $ bool_dflt = "n" @@ -2355,6 +2374,6 @@ $ use_5005_threads="Y" $ ENDIF -$ ! Are they on VMS 7.1 on an alpha? -$ if (archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") +$ ! Are they on VMS 7.1 on an alpha or itanium? +$ if (archname.nes."VMS_VAX").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") $ THEN $ echo "" @@ -2377,5 +2396,5 @@ $ ENDIF $ ENDIF -$ IF archname .EQS. "VMS_AXP" +$ IF archname .NES. "VMS_VAX" $ THEN $! Case sensitive? @@ -2574,6 +2593,4 @@ $ dflt = dflt - "Socket" ! optional on VMS $ ENDIF -$ IF .NOT. use_ithreads THEN dflt = dflt - "threads/shared" -$ IF .NOT. use_ithreads THEN dflt = dflt - "threads" $ IF .NOT. use_threads THEN dflt = dflt - "Thread" $ dflt = F$EDIT(dflt,"TRIM,COMPRESS") @@ -2710,5 +2727,10 @@ $!: locate the preferred pager for this system $!pagers = "most|more|less|type/page" -$ dflt = "type/page" +$ IF osvers .GES. "V6.1" +$ THEN +$ dflt = "type/page=save=10" +$ ELSE +$ dflt = "type/page" +$ ENDIF $! assume that the presence of a most symbol indicates the presence $! of the pager. @@ -2938,9 +2960,18 @@ $ lib_ext=".alb" $ ELSE -$ obj_ext=".obj" -$ so="exe" -$ dlext="exe" -$ exe_ext=".exe" -$ lib_ext=".olb" +$ IF (sharedperl .AND. archname .EQS. "VMS_IA64") +$ THEN +$ obj_ext=".ibj" +$ so="ixe" +$ dlext="ixe" +$ exe_ext=".ixe" +$ lib_ext=".ilb" +$ ELSE +$ obj_ext=".obj" +$ so="exe" +$ dlext="exe" +$ exe_ext=".exe" +$ lib_ext=".olb" +$ ENDIF $ ENDIF $ dlobj="dl_vms''obj_ext'" @@ -3004,4 +3035,5 @@ $ d_isnanl = "define" $ d_modfl = "define" +$ d_modflproto = "define" $ ELSE $ d_PRId64 = "undef" @@ -3024,4 +3056,5 @@ $ d_isnanl = "undef" $ d_modfl = "undef" +$ d_modflproto = "undef" $ ENDIF $! @@ -3663,4 +3696,11 @@ $ GOSUB inhdr $ i_sysfile = tmp +$! +$! +$! Check for sys/ioctl.h +$! +$ tmp = "sys/ioctl.h" +$ GOSUB inhdr +$ i_sysioctl = tmp $! $! Check for sys/utsname.h @@ -4045,4 +4085,27 @@ $ GOSUB inlibc $ d_mkdtemp = tmp +$! +$! Check for poll +$! +$ if i_poll .eqs. "define" +$ then +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "struct pollfd pfd;" +$ WS "int count=poll(&pfd,1,0);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "poll" +$ GOSUB inlibc +$ d_poll = tmp +$ else +$ d_poll = "undef" +$ endif $! $! Check for setvbuf @@ -4555,4 +4618,9 @@ $ ENDIF $! +$! Check for pthread_attr_setscope and PTHREAD_SCOPE_SYSTEM. +$! (The actual test is to be written.) +$! +$ d_pthread_attr_setscope="undef" +$! $! Check for generic pointer size $! @@ -4678,12 +4746,11 @@ $ d_index="define" $ pidtype="pid_t" -$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2 SPARE18 SPARE19 CHLD CONT STOP TSTP TTIN TTOU DEBUG SPARE27 SPARE28 SPARE29 SPARE30 SPARE31 SPARE32 RTMIN RTMAX"",0" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2 SPARE18 SPARE19 CHLD CONT STOP TSTP TTIN TTOU DEBUG SPARE27 SPARE28 SPARE29 SPARE30 SPARE31 SPARE32 RTMIN RTMAX" $ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," $ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",""SPARE18"",""SPARE19"",""CHLD"",""CONT"",""STOP"",""TSTP""," $ psnwc3="""TTIN"",""TTOU"",""DEBUG"",""SPARE27"",""SPARE28"",""SPARE29"",""SPARE30"",""SPARE31"",""SPARE32"",""RTMIN"",""RTMAX"",0" $ sig_name_init = psnwc1 + psnwc2 + psnwc3 -$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 64"",0" +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 64" $ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,64,0" -$! perl_sig_num_with_commas=sig_num_init $ sig_size="36" $ uidtype="uid_t" @@ -4710,11 +4777,10 @@ $ d_wait4="undef" $ d_index="undef" -$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2"",0" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2" $ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," $ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",0" $ sig_name_init = psnwc1 + psnwc2 -$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17"",0" +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17" $ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0" -$! perl_sig_num_with_commas=sig_num_init $ sig_size="19" $ uidtype="unsigned int" @@ -4757,4 +4823,5 @@ $ d_stdio_ptr_lval="define" $ d_stdstdio="define" +$ d_faststdio="define" $ d_wcstombs="define" $ d_mblen="define" @@ -4781,4 +4848,5 @@ $ d_stdio_ptr_lval="undef" $ d_stdstdio="undef" +$ d_faststdio="undef" $ d_wcstombs="undef" $ d_mblen="undef" @@ -4795,4 +4863,5 @@ $ d_stdio_ptr_lval_sets_cnt="undef" $ d_stdio_ptr_lval_nochange_cnt="define" +$ usefaststdio="define" $! $! Sockets? @@ -5041,5 +5110,11 @@ $ WS "}" $ CS -$ GOSUB compile +$ IF (F$EXTRACT(0,7,archname) .EQS. "VMS_AXP") +$ THEN +$ GOSUB compile +$ ELSE +$ ! Causes SS$_BADSTACK on OpenVMS I64 v8.1 (but hey, it was undocumented) +$ tmp = "0" +$ ENDIF $ IF tmp .EQS. "1" $ THEN @@ -5052,18 +5127,18 @@ $ if vms_ver .GES. "6.2" $ then -$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2"",0" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2" $ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," $ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",0" $ sig_name_init = psnwc1 + psnwc2 -$ sig_num="0 1 2 3 4 5 6 7 8 9 10 10 12 13 14 15 6 16 17"",0" -$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,10,12,13,14,15,6,16,17,0" +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17" +$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0" $ sig_size="19" $ else -$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT"",0" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT" $ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," $ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",0" $ sig_name_init = psnwc1 + psnwc2 -$ sig_num="0 1 2 3 4 5 6 7 8 9 10 10 12 13 14 15 6"",0" -$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,10,12,13,14,15,6,0" +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6" +$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,0" $ sig_size="17" $ endif @@ -5180,4 +5255,5 @@ $ WC "d_access='" + d_access + "'" $ WC "d_accessx='undef'" +$ WC "d_aintl='undef'" $ WC "d_alarm='define'" $ WC "d_archlib='define'" @@ -5201,4 +5277,5 @@ $ WC "d_cmsghdr_s='undef'" $ WC "d_const='define'" +$ WC "d_copysignl='define'" $ WC "d_crypt='define'" $ WC "d_csh='undef'" @@ -5290,4 +5367,5 @@ $ WC "d_hasmntopt='undef'" $ WC "d_htonl='" + d_htonl + "'" +$ WC "d_ilogbl='undef'" $ WC "d_index='" + d_index + "'" $ WC "d_inetaton='undef'" @@ -5327,4 +5405,5 @@ $ WC "d_mmap='" + d_mmap + "'" $ WC "d_modfl='" + d_modfl + "'" +$ WC "d_modflproto='" + d_modflproto + "'" $ WC "d_modfl_pow32_bug='undef'" $ WC "d_mprotect='" + d_mprotect + "'" @@ -5339,4 +5418,5 @@ $ WC "d_munmap='" + d_munmap + "'" $ WC "d_mymalloc='" + d_mymalloc + "'" +$ WC "d_nanosleep='undef'" $ WC "d_nice='define'" $ WC "d_nl_langinfo='" + d_nl_langinfo + "'" @@ -5353,7 +5433,8 @@ $ WC "d_phostname='" + d_phostname + "'" $ WC "d_pipe='define'" -$ WC "d_poll='undef'" +$ WC "d_poll='" + d_poll + "'" $ WC "d_procselfexe='undef'" $ WC "d_pthread_atfork='undef'" +$ WC "d_pthread_attr_setscope='" + d_pthread_attr_setscope + "'" $ WC "d_pthread_yield='" + d_pthread_yield + "'" $ WC "d_pthreads_created_joinable='" + d_pthreads_created_joinable + "'" @@ -5380,4 +5461,5 @@ $ WC "d_sanemcmp='define'" $ WC "d_sbrkproto='define'" +$ WC "d_scalbnl='undef'" $ WC "d_sched_yield='" + d_sched_yield + "'" $ WC "d_scm_rights='undef'" @@ -5442,4 +5524,5 @@ $ WC "d_stdiobase='" + d_stdiobase + "'" $ WC "d_stdstdio='" + d_stdstdio + "'" +$ WC "d_faststdio='" + d_faststdio + "'" $ WC "d_strchr='define'" $ WC "d_strcoll='" + d_strcoll + "'" @@ -5601,5 +5684,5 @@ $ WC "i_sysdir='undef'" $ WC "i_sysfile='" + i_sysfile + "'" -$ WC "i_sysioctl='undef'" +$ WC "i_sysioctl='" + i_sysioctl + "'" $ WC "i_syslog='" + i_syslog + "'" $ WC "i_sysmman='undef'" @@ -5706,5 +5789,5 @@ $ WC "perladmin='" + perladmin + "'" $ WC "perllibs='" + perllibs + "'" -$ WC "perlpath='" + "''vms_prefix':[000000]Perl''ext'" + "'" +$ WC "perlpath='" + "''vms_prefix':[000000]Perl''exe_ext'" + "'" $ WC "perl_symbol='" + perl_symbol + "'" ! VMS specific $ WC "perl_verb='" + perl_verb + "'" ! VMS specific @@ -5804,4 +5887,5 @@ $ WC "usecrosscompile='undef'" $ WC "usedl='" + usedl + "'" +$ WC "usefaststdio='" + usefaststdio + "'" $ WC "useieee='" + useieee + "'" ! VMS-specific $ WC "useithreads='" + useithreads + "'" @@ -5860,12 +5944,4 @@ $ WC "d_ctime_r='undef'" $ ENDIF -$ IF use_threads .AND. vms_ver .GES. "7.3-1" -$ THEN -$ WC "readdir_r_proto='REENTRANT_PROTO_I_TSR'" -$ WC "d_readdir_r='define'" -$ ELSE -$ WC "readdir_r_proto='0'" -$ WC "d_readdir_r='undef'" -$ ENDIF $ WC "d_crypt_r='undef'" $ WC "d_ctermid_r='undef'" @@ -5900,4 +5976,5 @@ $ WC "d_localtime_r='undef'" ! leave undef'd; we use my_localtime $ WC "d_random_r='undef'" +$ WC "d_readdir_r='define'" ! always defined; we roll our own $ WC "d_readdir64_r='undef'" $ WC "d_setgrent_r='undef'" @@ -5945,4 +6022,5 @@ $ WC "localtime_r_proto='0'" $ WC "random_r_proto='0'" +$ WC "readdir_r_proto='REENTRANT_PROTO_I_TSR'" ! always defined; we roll our own $ WC "readdir64_r_proto='0'" $ WC "setgrent_r_proto='0'" @@ -6224,5 +6302,5 @@ $extra_loop: $ read/error=extra_close/END_OF_FILE=extra_close EXTRA file -$ file_type = f$parse(file,,,"TYPE",) - "." +$ file_type = f$edit(f$parse(file,,,"TYPE",),"LOWERCASE") - "." $ if file_type .nes. "VMS" .and. file_type .nes. "vms" $ then @@ -6240,5 +6318,6 @@ $ if file_rdt .GTS. pod_file_rdt then do_copy := true $ endif -$ if do_copy then copy/log/noconfirm 'file' 'pod_file' +$ ! wacky method to preserve case on ODS-5 even when parse style is traditional +$ if do_copy then mcr sys$disk:[]miniperl.exe -e "exit 0+$^E unless File::Copy::rmscopy(q{''file'}, q{''pod_file'});" $ endif $ endif @@ -6295,4 +6374,5 @@ $ echo "" $ echo4 "Checking for dangerous pre-existing global symbols and logical names." +$ CALL Bad_environment "COMP" $ CALL Bad_environment "EXT" $ CALL Bad_environment "FOO" @@ -6321,5 +6401,6 @@ $ OPEN/WRITE CONFIG 'file_2_find' $ ext = ".exe" -$ IF (sharedperl .AND. archname .EQS. "VMS_AXP") THEN ext := .AXE +$ IF (sharedperl .AND. F$EXTRACT(0,7,archname) .EQS. "VMS_AXP") THEN ext := .AXE +$ IF (sharedperl .AND. F$EXTRACT(0,8,archname) .EQS. "VMS_IA64") THEN ext := .IXE $ IF (use_vmsdebug_perl) $ THEN @@ -6363,29 +6444,30 @@ $ WRITE CONFIG "$!" $ prefix = prefix - "000000." -$ IF F$LOCATE(".]",prefix) .EQ. F$LENGTH(prefix) THEN - - prefix = prefix - "]" + ".]" +$ IF F$LOCATE(".]",prefix) .EQ. F$LENGTH(prefix) THEN prefix = prefix - "]" + ".]" $ WRITE CONFIG "$ define/translation=concealed ''vms_prefix' ''prefix'" $ WRITE CONFIG "$ ext = "".exe""" $ IF sharedperl $ THEN -$ write config "$ if f$getsyi(""HW_MODEL"") .ge. 1024 then ext = "".AXE""" +$ WRITE CONFIG "$ if f$getsyi(""HW_MODEL"") .ge. 1024 then ext = "".AXE""" $ ENDIF $ IF (perl_symbol) $ THEN +$ perl_setup_perl = "'" + "'perl'" ! triple quoted foreign command symbol $ IF (use_vmsdebug_perl) $ THEN -$ WRITE CONFIG "$ dbgperl :== $''vms_prefix':[000000]dbgPerl'ext'" -$ WRITE CONFIG "$ perl :== $''vms_prefix':[000000]ndbgPerl'ext'" -$ WRITE CONFIG "$ define dbgPerlShr ''vms_prefix':[000000]dbgPerlShr'ext'" +$ WRITE CONFIG "$ dbgperl :== $''vms_prefix':[000000]dbgperl'ext'" +$ WRITE CONFIG "$ perl :== $''vms_prefix':[000000]ndbgperl'ext'" +$ WRITE CONFIG "$ define dbgperlshr ''vms_prefix':[000000]dbgperlshr'ext'" $ ELSE $ WRITE CONFIG "$ perl :== $''vms_prefix':[000000]Perl'ext'" -$ WRITE CONFIG "$ define PerlShr ''vms_prefix':[000000]PerlShr'ext'" +$ WRITE CONFIG "$ define perlshr ''vms_prefix':[000000]perlshr'ext'" $ ENDIF $ ELSE ! .NOT.perl_symbol +$ perl_setup_perl = "perl" ! command verb $ IF (use_vmsdebug_perl) $ THEN -$ WRITE CONFIG "$ define dbgPerlShr ''vms_prefix':[000000]dbgPerlShr'ext'" +$ WRITE CONFIG "$ define dbgperlshr ''vms_prefix':[000000]dbgperlshr'ext'" $ ELSE -$ WRITE CONFIG "$ define PerlShr ''vms_prefix':[000000]PerlShr'ext'" +$ WRITE CONFIG "$ define perlshr ''vms_prefix':[000000]perlshr'ext'" $ ENDIF $ IF perl_verb .EQS. "PROCESS" @@ -6407,44 +6489,33 @@ $ WRITE CONFIG "$! Symbols for commonly used programs:" $ WRITE CONFIG "$!" -$ IF (perl_symbol) -$ THEN -$ WRITE CONFIG "$ Perldoc == ""'"+"'Perl' ''vms_prefix':[lib.pod]Perldoc.com -t""" -$ WRITE CONFIG "$ pod2text == ""'"+"'Perl' pod2text""" -$ WRITE CONFIG "$ pod2html == ""'"+"'Perl' pod2html""" -$ WRITE CONFIG "$ pod2latex == ""'"+"'Perl' ''vms_prefix':[lib.pod]pod2latex.com""" -$ WRITE CONFIG "$!pod2man == ""'"+"'Perl' pod2man""" -$ WRITE CONFIG "$!Perlbug == ""'"+"'Perl' ''vms_prefix':[lib]Perlbug.com""" -$ WRITE CONFIG "$ c2ph == ""'"+"'Perl' ''vms_prefix':[utils]c2ph.com""" -$ IF F$LOCATE("Devel::DProf",extensions) .LT. F$LENGTH(extensions) -$ THEN -$ WRITE CONFIG "$ dprofpp == ""'"+"'Perl' ''vms_prefix':[utils]dprofpp.com""" -$ ENDIF -$ WRITE CONFIG "$ h2ph == ""'"+"'Perl' ''vms_prefix':[utils]h2ph.com""" -$ WRITE CONFIG "$ h2xs == ""'"+"'Perl' ''vms_prefix':[utils]h2xs.com""" -$ WRITE CONFIG "$ libnetcfg == ""'"+"'Perl' ''vms_prefix':[utils]libnetcfg.com""" -$ WRITE CONFIG "$!perlcc == ""'"+"'Perl' ''vms_prefix':[utils]perlcc.com""" -$ WRITE CONFIG "$ perlivp == ""'"+"'Perl' ''vms_prefix':[utils]perlivp.com""" -$ WRITE CONFIG "$ splain == ""'"+"'Perl' ''vms_prefix':[utils]splain.com""" -$ WRITE CONFIG "$ xsubpp == ""'"+"'Perl' ''vms_prefix':[utils]xsubpp.com""" -$ ELSE -$ WRITE CONFIG "$ Perldoc == ""Perl ''vms_prefix':[lib.pod]Perldoc.com -t""" -$ WRITE CONFIG "$ pod2text == ""Perl pod2text""" -$ WRITE CONFIG "$ pod2html == ""Perl pod2html""" -$ WRITE CONFIG "$ pod2latex == ""Perl ''vms_prefix':[lib.pod]pod2latex.com""" -$ WRITE CONFIG "$!pod2man == ""Perl pod2man""" -$ WRITE CONFIG "$!Perlbug == ""Perl ''vms_prefix':[lib]Perlbug.com""" -$ WRITE CONFIG "$ c2ph == ""Perl ''vms_prefix':[utils]c2ph.com""" -$ IF F$LOCATE("Devel::DProf",extensions) .LT. F$LENGTH(extensions) -$ THEN -$ WRITE CONFIG "$ dprofpp == ""Perl ''vms_prefix':[utils]dprofpp.com""" -$ ENDIF -$ WRITE CONFIG "$ h2ph == ""Perl ''vms_prefix':[utils]h2ph.com""" -$ WRITE CONFIG "$ h2xs == ""Perl ''vms_prefix':[utils]h2xs.com""" -$ WRITE CONFIG "$ libnetcfg == ""Perl ''vms_prefix':[utils]libnetcfg.com""" -$ WRITE CONFIG "$!perlcc == ""Perl ''vms_prefix':[utils]perlcc.com""" -$ WRITE CONFIG "$ perlivp == ""Perl ''vms_prefix':[utils]perlivp.com""" -$ WRITE CONFIG "$ splain == ""Perl ''vms_prefix':[utils]splain.com""" -$ WRITE CONFIG "$ xsubpp == ""Perl ''vms_prefix':[utils]xsubpp.com""" -$ ENDIF +$ WRITE CONFIG "$ c2ph == """ + perl_setup_perl + " ''vms_prefix':[utils]c2ph.com""" +$ WRITE CONFIG "$ cpan == """ + perl_setup_perl + " ''vms_prefix':[utils]cpan.com""" +$ IF F$LOCATE("Devel::DProf",extensions) .LT. F$LENGTH(extensions) +$ THEN +$ WRITE CONFIG "$ dprofpp == """ + perl_setup_perl + " ''vms_prefix':[utils]dprofpp.com""" +$ ENDIF +$ WRITE CONFIG "$ enc2xs == """ + perl_setup_perl + " ''vms_prefix':[utils]enc2xs.com""" +$ WRITE CONFIG "$!find2perl == """ + perl_setup_perl + " ''vms_prefix':[utils]find2perl.com""" +$ WRITE CONFIG "$ h2ph == """ + perl_setup_perl + " ''vms_prefix':[utils]h2ph.com""" +$ WRITE CONFIG "$ h2xs == """ + perl_setup_perl + " ''vms_prefix':[utils]h2xs.com""" +$ WRITE CONFIG "$ libnetcfg == """ + perl_setup_perl + " ''vms_prefix':[utils]libnetcfg.com""" +$ WRITE CONFIG "$!perlbug == """ + perl_setup_perl + " ''vms_prefix':[lib]perlbug.com""" +$ WRITE CONFIG "$!perlcc == """ + perl_setup_perl + " ''vms_prefix':[utils]perlcc.com""" +$ WRITE CONFIG "$ perldoc == """ + perl_setup_perl + " ''vms_prefix':[lib.pod]perldoc.com -t""" +$ WRITE CONFIG "$ perlivp == """ + perl_setup_perl + " ''vms_prefix':[utils]perlivp.com""" +$ WRITE CONFIG "$ piconv == """ + perl_setup_perl + " ''vms_prefix':[utils]piconv.com""" +$ WRITE CONFIG "$ pl2pm == """ + perl_setup_perl + " ''vms_prefix':[utils]pl2pm.com""" +$ WRITE CONFIG "$ pod2html == """ + perl_setup_perl + " pod2html""" +$ WRITE CONFIG "$ pod2latex == """ + perl_setup_perl + " ''vms_prefix':[lib.pod]pod2latex.com""" +$ WRITE CONFIG "$ pod2text == """ + perl_setup_perl + " pod2text""" +$ WRITE CONFIG "$!pod2man == """ + perl_setup_perl + " pod2man""" +$ WRITE CONFIG "$ pod2usage == """ + perl_setup_perl + " ''vms_prefix':[utils]pod2usage.com""" +$ WRITE CONFIG "$ podchecker == """ + perl_setup_perl + " ''vms_prefix':[utils]podchecker.com""" +$ WRITE CONFIG "$ podselect == """ + perl_setup_perl + " ''vms_prefix':[utils]podselect.com""" +$ WRITE CONFIG "$ psed == """ + perl_setup_perl + " ''vms_prefix':[utils]psed.com""" +$ WRITE CONFIG "$ pstruct == """ + perl_setup_perl + " ''vms_prefix':[utils]pstruct.com""" +$ WRITE CONFIG "$ s2p == """ + perl_setup_perl + " ''vms_prefix':[utils]s2p.com""" +$ WRITE CONFIG "$ splain == """ + perl_setup_perl + " ''vms_prefix':[utils]splain.com""" +$ WRITE CONFIG "$ xsubpp == """ + perl_setup_perl + " ''vms_prefix':[utils]xsubpp.com""" $ CLOSE CONFIG $! Index: /branches/vendor/third/perl/README.os2 =================================================================== --- /branches/vendor/third/perl/README.os2 (revision 18449) +++ /branches/vendor/third/perl/README.os2 (revision 20074) @@ -870,5 +870,8 @@ make sure that no copies or perl are currently running. Later steps of the build may fail since an older version of F loaded into -memory may be found. +memory may be found. Running C becomes meaningless, since +the test are checking a previous build of perl (this situation is detected +and reported by F test). Do not forget to unset +C in environment. Also make sure that you have F directory on the current drive, @@ -908,5 +911,5 @@ time, looking into - http://www.cpan.org/ports/os2/ilyaz/ + http://www.cpan.org/ports/os2/ may indicate the latest release which was publicly released by the @@ -1089,4 +1092,431 @@ first. + +=head1 Building a binary distribution + +[This section provides a short overview only...] + +Building should proceed differently depending on whether the version of perl +you install is already present and used on your system, or is a new version +not yet used. The description below assumes that the version is new, so +installing its DLLs and F<.pm> files will not disrupt the operation of your +system even if some intermediate steps are not yet fully working. + +The other cases require a little bit more convoluted procedures. Below I +suppose that the current version of Perl is C<5.8.2>, so the executables are +named accordingly. + +=over + +=item 1. + +Fully build and test the Perl distribution. Make sure that no tests are +failing with C and C targets; fix the bugs in Perl and +the Perl test suite detected by these tests. Make sure that C +make target runs as clean as possible. Check that C +runs fine. + +=item 2. + +Fully install Perl, including C target. Copy the generated DLLs +to C; copy the numbered Perl executables (as in F) +to C; copy C to C as C. Think whether +you need backward-compatibility DLLs. In most cases you do not need to install +them yet; but sometime this may simplify the following steps. + +=item 3. + +Make sure that C can download files from CPAN. If not, you may need +to manually install C. + +=item 4. + +Install the bundle C + + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_1 + +This may take a couple of hours on 1GHz processor (when run the first time). +And this should not be necessarily a smooth procedure. Some modules may not +specify required dependencies, so one may need to repeat this procedure several +times until the results stabilize. + + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_2 + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_3 + +Even after they stabilize, some tests may fail. + +Fix as many discovered bugs as possible. Document all the bugs which are not +fixed, and all the failures with unknown reasons. Inspect the produced logs +F<00cpan_i_1> to find suspiciously skipped tests, and other fishy events. + +Keep in mind that I of some modules may fail too: for example, +the DLLs to update may be already loaded by F. Inspect the C +logs (in the example above F<00cpan_i_1> etc) for errors, and install things +manually, as in + + cd $CPANHOME/.cpan/build/Digest-MD5-2.31 + make install + +Some distributions may fail some tests, but you may want to install them +anyway (as above, or via C command of C shell-mode). + +Since this procedure may take quite a long time to complete, it makes sense +to "freeze" your CPAN configuration by disabling periodic updates of the +local copy of CPAN index: set C to some big value (I use 365), +then save the settings + + CPAN> o conf index_expire 365 + CPAN> o conf commit + +Reset back to the default value C<1> when you are finished. + +=item 5. + +When satisfied with the results, rerun the C target. Now you +can copy C to C, and install the other OMF-build +executables: C etc. They are ready to be used. + +=item 6. + +Change to the C<./pod> directory of the build tree, download the Perl logo +F, and run + + ( perl2ipf > perl.ipf ) |& tee 00ipf + ipfc /INF perl.ipf |& tee 00inf + +This produces the Perl docs online book C. Install in on +C path. + +=item 7. + +Now is the time to build statically linked executable F which +includes newly-installed via C modules. Doing testing +via C is going to be painfully slow, since it statically links +a new executable per XS extension. + +Here is a possible workaround: create a toplevel F in +F<$CPANHOME/.cpan/build/> with contents being (compare with L) + + use ExtUtils::MakeMaker; + WriteMakefile NAME => 'dummy'; + +execute this as + + perl_5.8.2.exe Makefile.PL 's +in subdirectories may be buggy, and would not run as "child" scripts. The +interdependency of modules can strike you; however, since non-XS modules +are already installed, the prerequisites of most modules have a very good +chance to be present. + +If you discover some glitches, move directories of problematic modules to a +different location; if these modules are non-XS modules, you may just ignore +them - they are already installed; the remaining, XS, modules you need to +install manually one by one. + +After each such removal you need to rerun the C/C process; +usually this procedure converges soon. (But be sure to convert all the +necessary external C libraries from F<.lib> format to F<.a> format: run one of + + emxaout foo.lib + emximp -o foo.a foo.lib + +whichever is appropriate.) Also, make sure that the DLLs for external +libraries are usable with with executables compiled without C<-Zmtd> options. + +When you are sure that only a few subdirectories +lead to failures, you may want to add C<-j4> option to C to speed up +skipping subdirectories with already finished build. + +When you are satisfied with the results of tests, install the build C libraries +for extensions: + + make install |& tee 00aout_i + +Now you can rename the file F<./perl.exe> generated during the last phase +to F; place it on C; if there is an inter-dependency +between some XS modules, you may need to repeat the C/C loop +with this new executable and some excluded modules - until the procedure +converges. + +Now you have all the necessary F<.a> libraries for these Perl modules in the +places where Perl builder can find it. Use the perl builder: change to an +empty directory, create a "dummy" F again, and run + + perl_5.8.2.exe Makefile.PL |& tee 00c + make perl |& tee 00p + +This should create an executable F<./perl.exe> with all the statically loaded +extensions built in. Compare the generated F files to make sure +that during the iterations the number of loaded extensions only increases. +Rename F<./perl.exe> to F on C. + +When it converges, you got a functional variant of F; copy it +to C. You are done with generation of the local Perl installation. + +=item 8. + +Make sure that the installed modules are actually installed in the location +of the new Perl, and are not inherited from entries of @INC given for +inheritance from the older versions of Perl: set C to +redirect the new version of Perl to a new location, and copy the installed +files to this new location. Redo the tests to make sure that the versions of +modules inherited from older versions of Perl are not needed. + +Actually, the log output of L during the step 6 gives a very detailed +info about which modules are loaded from which place; so you may use it as +an additional verification tool. + +Check that some temporary files did not make into the perl install tree. +Run something like this + + pfind . -f "!(/\.(pm|pl|ix|al|h|a|lib|txt|pod|imp|bs|dll|ld|bs|inc|xbm|yml|cgi|uu|e2x|skip|packlist|eg|cfg|html|pub|enc|all|ini|po|pot)$/i or /^\w+$/") | less + +in the install tree (both top one and F one). + +Compress all the DLLs with F. The tiny F<.exe> can be compressed with +C (the bug only appears when there is a fixup in the last 6 bytes of a +page (?); since the tiny executables are much smaller than a page, the bug +will not hit). Do not compress C - it would not work under DOS. + +=item 9. + +Now you can generate the binary distribution. This is done by running the +test of the CPAN distribution C. Tune up the file +F to suit the layout of current version of Perl first. Do not +forget to pack the necessary external DLLs accordingly. Include the +description of the bugs and test suite failures you could not fix. Include +the small-stack versions of Perl executables from Perl build directory. + +Include F so that people can relink the perl DLL preserving +the binary compatibility, or can create compatibility DLLs. Include the diff +files (C) of fixes you did so that people can rebuild your +version. Include F so that one can use remote debugging. + +=item 10. + +Share what you did with the other people. Relax. Enjoy fruits of your work. + +=item 11. + +Brace yourself for thanks, bug reports, hate mail and spam coming as result +of the previous step. No good deed should remain unpunished! + +=back + +=head1 Building custom F<.EXE> files + +The Perl executables can be easily rebuilt at any moment. Moreover, one can +use the I interface (see L) to make very customized +executables. + +=head2 Making executables with a custom collection of statically loaded extensions + +It is a little bit easier to do so while I the list of statically +loaded extensions. We discuss this case only here. + +=over + +=item 1. + +Change to an empty directory, and create a placeholder : + + use ExtUtils::MakeMaker; + WriteMakefile NAME => 'dummy'; + +=item 2. + +Run it with the flavor of Perl (F or F) you want to +rebuild. + + perl_ Makefile.PL + +=item 3. + +Ask it to create new Perl executable: + + make perl + +(you may need to manually add C to this commandline on +some versions of Perl; the symptom is that the command-line globbing does not +work from OS/2 shells with the newly-compiled executable; check with + + .\perl.exe -wle "print for @ARGV" * + +). + +=item 4. + +The previous step created F which contains a list of newXS() calls +near the end. Removing unnecessary calls, and rerunning + + make perl + +will produce a customized executable. + +=back + +=head2 Making executables with a custom search-paths + +The default perl executable is flexible enough to support most usages. +However, one may want something yet more flexible; for example, one may want +to find Perl DLL relatively to the location of the EXE file; or one may want +to ignore the environment when setting the Perl-library search patch, etc. + +If you fill comfortable with I interface (see L), such +things are easy to do repeating the steps outlined in L, and +doing more comprehensive edits to main() of F. The people with +little desire to understand Perl can just rename main(), and do necessary +modification in a custom main() which calls the renamed function in appropriate +time. + +However, there is a third way: perl DLL exports the main() function and several +callbacks to customize the search path. Below is a complete example of a +"Perl loader" which + +=over + +=item 1. + +Looks for Perl DLL in the directory C<$exedir/../dll>; + +=item 2. + +Prepends the above directory to C; + +=item 3. + +Fails if the Perl DLL found via C is different from what was +loaded on step 1; e.g., another process could have loaded it from C +or from a different value of C. In these cases one needs to +modify the setting of the system so that this other process either does not +run, or loads the DLL from C with C (available +with kernels after September 2000). + +=item 4. + +Loads Perl library from C<$exedir/../dll/lib/>. + +=item 5. + +Uses Bourne shell from C<$exedir/../dll/sh/ksh.exe>. + +=back + +For best results compile the C file below with the same options as the Perl +DLL. However, a lot of functionality will work even if the executable is not +an EMX applications, e.g., if compiled with + + gcc -Wall -DDOSISH -DOS2=1 -O2 -s -Zomf -Zsys perl-starter.c -DPERL_DLL_BASENAME=\"perl312F\" -Zstack 8192 -Zlinker /PM:VIO + +Here is the sample C file: + + #define INCL_DOS + #define INCL_NOPM + /* These are needed for compile if os2.h includes os2tk.h, not os2emx.h */ + #define INCL_DOSPROCESS + #include + + #include "EXTERN.h" + #define PERL_IN_MINIPERLMAIN_C + #include "perl.h" + + static char *me; + HMODULE handle; + + static void + die_with(char *msg1, char *msg2, char *msg3, char *msg4) + { + ULONG c; + char *s = " error: "; + + DosWrite(2, me, strlen(me), &c); + DosWrite(2, s, strlen(s), &c); + DosWrite(2, msg1, strlen(msg1), &c); + DosWrite(2, msg2, strlen(msg2), &c); + DosWrite(2, msg3, strlen(msg3), &c); + DosWrite(2, msg4, strlen(msg4), &c); + DosWrite(2, "\r\n", 2, &c); + exit(255); + } + + typedef ULONG (*fill_extLibpath_t)(int type, char *pre, char *post, int replace, char *msg); + typedef int (*main_t)(int type, char *argv[], char *env[]); + typedef int (*handler_t)(void* data, int which); + + #ifndef PERL_DLL_BASENAME + # define PERL_DLL_BASENAME "perl" + #endif + + static HMODULE + load_perl_dll(char *basename) + { + char buf[300], fail[260]; + STRLEN l, dirl; + fill_extLibpath_t f; + ULONG rc_fullname; + HMODULE handle, handle1; + + if (_execname(buf, sizeof(buf) - 13) != 0) + die_with("Can't find full path: ", strerror(errno), "", ""); + /* XXXX Fill `me' with new value */ + l = strlen(buf); + while (l && buf[l-1] != '/' && buf[l-1] != '\\') + l--; + dirl = l - 1; + strcpy(buf + l, basename); + l += strlen(basename); + strcpy(buf + l, ".dll"); + if ( (rc_fullname = DosLoadModule(fail, sizeof fail, buf, &handle)) != 0 + && DosLoadModule(fail, sizeof fail, basename, &handle) != 0 ) + die_with("Can't load DLL ", buf, "", ""); + if (rc_fullname) + return handle; /* was loaded with short name; all is fine */ + if (DosQueryProcAddr(handle, 0, "fill_extLibpath", (PFN*)&f)) + die_with(buf, ": DLL exports no symbol ", "fill_extLibpath", ""); + buf[dirl] = 0; + if (f(0 /*BEGINLIBPATH*/, buf /* prepend */, NULL /* append */, + 0 /* keep old value */, me)) + die_with(me, ": prepending BEGINLIBPATH", "", ""); + if (DosLoadModule(fail, sizeof fail, basename, &handle1) != 0) + die_with(me, ": finding perl DLL again via BEGINLIBPATH", "", ""); + buf[dirl] = '\\'; + if (handle1 != handle) { + if (DosQueryModuleName(handle1, sizeof(fail), fail)) + strcpy(fail, "???"); + die_with(buf, ":\n\tperl DLL via BEGINLIBPATH is different: \n\t", + fail, + "\n\tYou may need to manipulate global BEGINLIBPATH and LIBPATHSTRICT" + "\n\tso that the other copy is loaded via BEGINLIBPATH."); + } + return handle; + } + + int + main(int argc, char **argv, char **env) + { + main_t f; + handler_t h; + + me = argv[0]; + /**/ + handle = load_perl_dll(PERL_DLL_BASENAME); + + if (DosQueryProcAddr(handle, 0, "Perl_OS2_handler_install", (PFN*)&h)) + die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "Perl_OS2_handler_install", ""); + if ( !h((void *)"~installprefix", Perlos2_handler_perllib_from) + || !h((void *)"~dll", Perlos2_handler_perllib_to) + || !h((void *)"~dll/sh/ksh.exe", Perlos2_handler_perl_sh) ) + die_with(PERL_DLL_BASENAME, ": Can't install @INC manglers", "", ""); + + if (DosQueryProcAddr(handle, 0, "dll_perlmain", (PFN*)&f)) + die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "dll_perlmain", ""); + return f(argc, argv, env); + } + =head1 Build FAQ @@ -2271,6 +2701,6 @@ =head1 BUGS -This description was not updated since 5.6.1, see F for -more info. +This description is not updated often (since 5.6.1?), see F<./os2/Changes> +(L) for more info. =cut Index: /branches/vendor/third/perl/opcode.h =================================================================== --- /branches/vendor/third/perl/opcode.h (revision 18449) +++ /branches/vendor/third/perl/opcode.h (revision 20074) @@ -2,5 +2,6 @@ * opcode.h * - * Copyright (c) 1997-2002, Larry Wall + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -21,8 +22,8 @@ -#define OP_NAME(o) (o->op_type == OP_CUSTOM ? custom_op_name(o) : \ - PL_op_name[o->op_type]) -#define OP_DESC(o) (o->op_type == OP_CUSTOM ? custom_op_desc(o) : \ - PL_op_desc[o->op_type]) +#define OP_NAME(o) ((o)->op_type == OP_CUSTOM ? custom_op_name(o) : \ + PL_op_name[(o)->op_type]) +#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \ + PL_op_desc[(o)->op_type]) #ifndef DOINIT @@ -1617,6 +1618,6 @@ 0x05326801, /* splice */ 0x0004691d, /* push */ - 0x00007604, /* pop */ - 0x00007604, /* shift */ + 0x00017604, /* pop */ + 0x00017604, /* shift */ 0x0004691d, /* unshift */ 0x0005a801, /* sort */ @@ -1817,5 +1818,5 @@ 0x0000000c, /* getlogin */ 0x0004281d, /* syscall */ - 0x00003604, /* lock */ + 0x0000f604, /* lock */ 0x00000044, /* threadsv */ 0x00001404, /* setstate */ Index: /branches/vendor/third/perl/Changes5.6 =================================================================== --- /branches/vendor/third/perl/Changes5.6 (revision 18449) +++ /branches/vendor/third/perl/Changes5.6 (revision 20074) @@ -23214,4 +23214,9 @@ Branch: cfgperl ! t/op/pwent.t + +---------------- +Version 5.005_54 +---------------- + ____________________________________________________________________________ [ 2430] By: gsar on 1998/12/01 12:12:50 @@ -23280,9 +23285,4 @@ Branch: cfgperl ! util.c - ----------------- -Version 5.005_54 ----------------- - ____________________________________________________________________________ [ 2414] By: gsar on 1998/11/30 02:23:55 Index: /branches/vendor/third/perl/configpm =================================================================== --- /branches/vendor/third/perl/configpm (revision 18449) +++ /branches/vendor/third/perl/configpm (revision 20074) @@ -1,96 +1,171 @@ #!./miniperl -w -# following options are recognized: -# --no-glossary - no glossary file inclusion, for compactness -# --cross=PALTFORM - crosscompiling for PLATFORM -my %opts = ( - # %known_opts enumerates allowed opts as well as specifies default and initial values - my %known_opts = ( - 'cross' => '', - 'glossary' => 1, - ), - # options itself - my %specified_opts = ( - (map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth - (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt --no-opt --noopt - ), +# commonly used names to put first (and hence lookup fastest) +my %Common = map {($_,$_)} + qw(archname osname osvers prefix libs libpth + dynamic_ext static_ext dlsrc so + cc ccflags cppflags + privlibexp archlibexp installprivlib installarchlib + sharpbang startsh shsharp + ); + +# names of things which may need to have slashes changed to double-colons +my %Extensions = map {($_,$_)} + qw(dynamic_ext static_ext extensions known_extensions); + +# allowed opts as well as specifies default and initial values +my %Allowed_Opts = ( + 'cross' => '', # --cross=PALTFORM - crosscompiling for PLATFORM + 'glossary' => 1, # --no-glossary - no glossary file inclusion, + # for compactness ); -die "option '$_' is not recognized" for grep {!exists $known_opts{$_}} keys %specified_opts; -@ARGV = grep {!/^--/} @ARGV; - -my $config_pm; -my $glossary = $ARGV[1] || 'Porting/Glossary'; - -if ($opts{cross}) { + +sub opts { + # user specified options + my %given_opts = ( + # --opt=smth + (map {/^--([\-_\w]+)=(.*)$/} @ARGV), + # --opt --no-opt --noopt + (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), + ); + + my %opts = (%Allowed_Opts, %given_opts); + + for my $opt (grep {!exists $Allowed_Opts{$_}} keys %given_opts) { + die "option '$opt' is not recognized"; + } + @ARGV = grep {!/^--/} @ARGV; + + return %opts; +} + + +my %Opts = opts(); + +my $Config_PM; +my $Glossary = $ARGV[1] || 'Porting/Glossary'; + +if ($Opts{cross}) { # creating cross-platform config file mkdir "xlib"; - mkdir "xlib/$opts{cross}"; - $config_pm = $ARGV[0] || "xlib/$opts{cross}/Config.pm"; + mkdir "xlib/$Opts{cross}"; + $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm"; } else { - $config_pm = $ARGV[0] || 'lib/Config.pm'; -} - -@ARGV = "./config.sh"; - -# list names to put first (and hence lookup fastest) -@fast = qw(archname osname osvers prefix libs libpth - dynamic_ext static_ext extensions dlsrc so - sig_name sig_num cc ccflags cppflags - privlibexp archlibexp installprivlib installarchlib - sharpbang startsh shsharp -); - -# names of things which may need to have slashes changed to double-colons -@extensions = qw(dynamic_ext static_ext extensions known_extensions); - - -open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n"; -$myver = sprintf "v%vd", $^V; - -print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG"; + $Config_PM = $ARGV[0] || 'lib/Config.pm'; +} + + +open CONFIG, ">$Config_PM" or die "Can't open $Config_PM: $!\n"; + +my $myver = sprintf "v%vd", $^V; + +printf CONFIG <<'ENDOFBEG', ($myver) x 3; +# This file was created by configpm when Perl was built. Any changes +# made to this file will be lost the next time perl is built. + package Config; -use Exporter (); -@EXPORT = qw(%Config); -@EXPORT_OK = qw(myconfig config_sh config_vars); +@EXPORT = qw(%%Config); +@EXPORT_OK = qw(myconfig config_sh config_vars config_re); + +my %%Export_Cache = map {($_ => 1)} (@EXPORT, @EXPORT_OK); # Define our own import method to avoid pulling in the full Exporter: sub import { - my $pkg = shift; - @_ = @EXPORT unless @_; - my @func = grep {$_ ne '%Config'} @_; - local $Exporter::ExportLevel = 1; - Exporter::import('Config', @func) if @func; - return if @func == @_; - my $callpkg = caller(0); - *{"$callpkg\::Config"} = \%Config; -} - -ENDOFBEG_NOQ -die "Perl lib version ($myver) doesn't match executable version (\$])" - unless \$^V; - -\$^V eq $myver - or die "Perl lib version ($myver) doesn't match executable version (" . - (sprintf "v%vd",\$^V) . ")"; - -# This file was created by configpm when Perl was built. Any changes -# made to this file will be lost the next time perl is built. + my $pkg = shift; + @_ = @EXPORT unless @_; + + my @funcs = grep $_ ne '%%Config', @_; + my $export_Config = @funcs < @_ ? 1 : 0; + + my $callpkg = caller(0); + foreach my $func (@funcs) { + die sprintf qq{"%%s" is not exported by the %%s module\n}, + $func, __PACKAGE__ unless $Export_Cache{$func}; + *{$callpkg.'::'.$func} = \&{$func}; + } + + *{"$callpkg\::Config"} = \%%Config if $export_Config; + return; +} + +die "Perl lib version (%s) doesn't match executable version ($])" + unless $^V; + +$^V eq %s + or die "Perl lib version (%s) doesn't match executable version (" . + sprintf("v%%vd",$^V) . ")"; ENDOFBEG -@fast{@fast} = @fast; -@extensions{@extensions} = @extensions; -@non_v=(); -@v_fast=(); -@v_others=(); -$in_v = 0; - -while (<>) { +my @non_v = (); +my @v_fast = (); +my %v_fast = (); +my @v_others = (); +my $in_v = 0; +my %Data = (); + +# This is somewhat grim, but I want the code for parsing config.sh here and +# now so that I can expand $Config{ivsize} and $Config{ivtype} + +my $fetch_string = <<'EOT'; + +# Search for it in the big string +sub fetch_string { + my($self, $key) = @_; + + my $quote_type = "'"; + my $marker = "$key="; + + # Check for the common case, ' delimited + my $start = index($Config_SH, "\n$marker$quote_type"); + # If that failed, check for " delimited + if ($start == -1) { + $quote_type = '"'; + $start = index($Config_SH, "\n$marker$quote_type"); + } + return undef if ( ($start == -1) && # in case it's first + (substr($Config_SH, 0, length($marker)) ne $marker) ); + if ($start == -1) { + # It's the very first thing we found. Skip $start forward + # and figure out the quote mark after the =. + $start = length($marker) + 1; + $quote_type = substr($Config_SH, $start - 1, 1); + } + else { + $start += length($marker) + 2; + } + + my $value = substr($Config_SH, $start, + index($Config_SH, "$quote_type\n", $start) - $start); + + # If we had a double-quote, we'd better eval it so escape + # sequences and such can be interpolated. Since the incoming + # value is supposed to follow shell rules and not perl rules, + # we escape any perl variable markers + if ($quote_type eq '"') { + $value =~ s/\$/\\\$/g; + $value =~ s/\@/\\\@/g; + eval "\$value = \"$value\""; + } + + # So we can say "if $Config{'foo'}". + $value = undef if $value eq 'undef'; + $self->{$key} = $value; # cache it +} +EOT + +eval $fetch_string; +die if $@; + +open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!"; +while () { next if m:^#!/bin/sh:; + # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure. - s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/; - my ($k,$v) = ($1,$2); + s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/ or m/^(\w+)='(.*)'$/; + my($k, $v) = ($1, $2); + # grandfather PATCHLEVEL and SUBVERSION and CONFIG if ($k) { @@ -105,4 +180,5 @@ } } + # We can delimit things in config.sh with either ' or ". unless ($in_v or m/^(\w+)=(['"])(.*\n)/){ @@ -111,24 +187,32 @@ } $quote = $2; - if ($in_v) { $val .= $_; } - else { ($name,$val) = ($1,$3); } + if ($in_v) { + $val .= $_; + } + else { + ($name,$val) = ($1,$3); + } $in_v = $val !~ /$quote\n/; next if $in_v; - if ($extensions{$name}) { s,/,::,g } - if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; } - push(@v_fast,"$name=$quote$val"); -} - -foreach(@non_v){ print CONFIG $_ } - -print CONFIG "\n", - "my \$config_sh = <<'!END!';\n", - join("", @v_fast, sort @v_others), - "!END!\n\n"; + + s,/,::,g if $Extensions{$name}; + + $val =~ s/$quote\n?\z//; + + my $line = "$name=$quote$val$quote\n"; + if (!$Common{$name}){ + push(@v_others, $line); + } + else { + push(@v_fast, $line); + $v_fast{$name} = "'$name' => $quote$val$quote"; + } +} +close CONFIG_SH; + +print CONFIG @non_v, "\n"; # copy config summary format from the myconfig.SH script - -print CONFIG "my \$summary = <<'!END!';\n"; - +print CONFIG "our \$summary : unique = <<'!END!';\n"; open(MYCONFIG,") && !/^Summary of/; @@ -136,62 +220,51 @@ close(MYCONFIG); +# NB. as $summary is unique, we need to copy it in a lexical variable +# before expanding it, because may have been made readonly if a perl +# interpreter has been cloned. + print CONFIG "\n!END!\n", <<'EOT'; -my $summary_expanded = 0; +my $summary_expanded; sub myconfig { - return $summary if $summary_expanded; - $summary =~ s{\$(\w+)} - { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge; - $summary_expanded = 1; - $summary; -} + return $summary_expanded if $summary_expanded; + ($summary_expanded = $summary) =~ s{\$(\w+)} + { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge; + $summary_expanded; +} + +our $Config_SH : unique = <<'!END!'; EOT -# ---- +print CONFIG join("", @v_fast, sort @v_others); + +print CONFIG "!END!\n", $fetch_string; print CONFIG <<'ENDOFEND'; -sub FETCH { - # check for cached value (which may be undef so we use exists not defined) - return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]}); - - # Search for it in the big string - my($value, $start, $marker, $quote_type); - - $quote_type = "'"; - # Virtual entries. - if ($_[1] eq 'byteorder') { - # byteorder does exist on its own but we overlay a virtual - # dynamically recomputed value. - my $t = $Config{ivtype}; - my $s = $Config{ivsize}; - my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I'; - if ($s == 4 || $s == 8) { - my $i = 0; - foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 } - $i |= ord(1); - $value = join('', unpack('a'x$s, pack($f, $i))); - } else { - $value = '?'x$s; - } - } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) { +sub fetch_virtual { + my($self, $key) = @_; + + my $value; + + if ($key =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) { # These are purely virtual, they do not exist, but need to # be computed on demand for largefile-incapable extensions. - my $key = "${1}_uselargefiles"; + my $new_key = "${1}_uselargefiles"; $value = $Config{$1}; - my $withlargefiles = $Config{$key}; - if ($key =~ /^(?:cc|ld)flags_/) { + my $withlargefiles = $Config{$new_key}; + if ($new_key =~ /^(?:cc|ld)flags_/) { $value =~ s/\Q$withlargefiles\E\b//; - } elsif ($key =~ /^libs/) { + } elsif ($new_key =~ /^libs/) { my @lflibswanted = split(' ', $Config{libswanted_uselargefiles}); if (@lflibswanted) { my %lflibswanted; @lflibswanted{@lflibswanted} = (); - if ($key =~ /^libs_/) { + if ($new_key =~ /^libs_/) { my @libs = grep { /^-l(.+)/ && not exists $lflibswanted{$1} } split(' ', $Config{libs}); $Config{libs} = join(' ', @libs); - } elsif ($key =~ /^libswanted_/) { + } elsif ($new_key =~ /^libswanted_/) { my @libswanted = grep { not exists $lflibswanted{$_} } split(' ', $Config{libswanted}); @@ -200,42 +273,21 @@ } } - } else { - $marker = "$_[1]="; - # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m); - # Check for the common case, ' delimeted - $start = index($config_sh, "\n$marker$quote_type"); - # If that failed, check for " delimited - if ($start == -1) { - $quote_type = '"'; - $start = index($config_sh, "\n$marker$quote_type"); - } - return undef if ( ($start == -1) && # in case it's first - (substr($config_sh, 0, length($marker)) ne $marker) ); - if ($start == -1) { - # It's the very first thing we found. Skip $start forward - # and figure out the quote mark after the =. - $start = length($marker) + 1; - $quote_type = substr($config_sh, $start - 1, 1); - } - else { - $start += length($marker) + 2; - } - $value = substr($config_sh, $start, - index($config_sh, "$quote_type\n", $start) - $start); - } - # If we had a double-quote, we'd better eval it so escape - # sequences and such can be interpolated. Since the incoming - # value is supposed to follow shell rules and not perl rules, - # we escape any perl variable markers - if ($quote_type eq '"') { - $value =~ s/\$/\\\$/g; - $value =~ s/\@/\\\@/g; - eval "\$value = \"$value\""; - } - #$value = sprintf($value) if $quote_type eq '"'; - # So we can say "if $Config{'foo'}". - $value = undef if $value eq 'undef'; - $_[0]->{$_[1]} = $value; # cache it - return $value; + } + + $self->{$key} = $value; +} + +sub FETCH { + my($self, $key) = @_; + + # check for cached value (which may be undef so we use exists not defined) + return $self->{$key} if exists $self->{$key}; + + $self->fetch_string($key); + return $self->{$key} if exists $self->{$key}; + $self->fetch_virtual($key); + + # Might not exist, in which undef is correct. + return $self->{$key}; } @@ -244,49 +296,51 @@ sub FIRSTKEY { $prevpos = 0; - # my($key) = $config_sh =~ m/^(.*?)=/; - substr($config_sh, 0, index($config_sh, '=') ); - # $key; + substr($Config_SH, 0, index($Config_SH, '=') ); } sub NEXTKEY { # Find out how the current key's quoted so we can skip to its end. - my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1); - my $pos = index($config_sh, qq($quote\n), $prevpos) + 2; - my $len = index($config_sh, "=", $pos) - $pos; + my $quote = substr($Config_SH, index($Config_SH, "=", $prevpos)+1, 1); + my $pos = index($Config_SH, qq($quote\n), $prevpos) + 2; + my $len = index($Config_SH, "=", $pos) - $pos; $prevpos = $pos; - $len > 0 ? substr($config_sh, $pos, $len) : undef; + $len > 0 ? substr($Config_SH, $pos, $len) : undef; } sub EXISTS { - # exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m; - exists($_[0]->{$_[1]}) or - index($config_sh, "\n$_[1]='") != -1 or - substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or - index($config_sh, "\n$_[1]=\"") != -1 or - substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or - $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/; + return 1 if exists($_[0]->{$_[1]}); + + return(index($Config_SH, "\n$_[1]='") != -1 or + substr($Config_SH, 0, length($_[1])+2) eq "$_[1]='" or + index($Config_SH, "\n$_[1]=\"") != -1 or + substr($Config_SH, 0, length($_[1])+2) eq "$_[1]=\"" or + $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/ + ); } sub STORE { die "\%Config::Config is read-only\n" } -sub DELETE { &STORE } -sub CLEAR { &STORE } +*DELETE = \&STORE; +*CLEAR = \&STORE; sub config_sh { - $config_sh + $Config_SH } sub config_re { my $re = shift; - my @matches = grep /^$re=/, split /^/, $config_sh; - @matches ? (print @matches) : print "$re: not found\n"; + return map { chomp; $_ } grep /^$re=/, split /^/, $Config_SH; } sub config_vars { - foreach(@_){ - config_re($_), next if /\W/; - my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN'; - $v='undef' unless defined $v; - print "$_='$v';\n"; + foreach (@_) { + if (/\W/) { + my @matches = config_re($_); + print map "$_\n", @matches ? @matches : "$_: not found"; + } else { + my $v = (exists $Config{$_}) ? $Config{$_} : 'UNKNOWN'; + $v = 'undef' unless defined $v; + print "$_='$v';\n"; + } } } @@ -295,10 +349,10 @@ if ($^O eq 'os2') { - print CONFIG <<'ENDOFSET'; + print CONFIG <<'ENDOFSET'; my %preconfig; if ($OS2::is_aout) { - my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m; + my ($value, $v) = $Config_SH =~ m/^used_aout='(.*)'\s*$/m; for (split ' ', $value) { - ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m; + ($v) = $Config_SH =~ m/^aout_$_='(.*)'\s*$/m; $preconfig{$_} = $v eq 'undef' ? undef : $v; } @@ -307,31 +361,72 @@ sub TIEHASH { bless {%preconfig} } ENDOFSET - # Extract the name of the DLL from the makefile to avoid duplication - my ($f) = grep -r, qw(GNUMakefile Makefile); - my $dll; - if (open my $fh, '<', $f) { - while (<$fh>) { - $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/; - } - } - print CONFIG <) { + $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/; + } + } + print CONFIG < $value' ; + +print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config; # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD sub DESTROY { } -tie %Config, 'Config'; +%s + +tie %%Config, 'Config', { +%s +}; 1; -__END__ - +ENDOFTIE + + +open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!"; +print CONFIG_POD <<'ENDOFTAIL'; =head1 NAME @@ -345,9 +440,11 @@ } - use Config qw(myconfig config_sh config_vars); + use Config qw(myconfig config_sh config_vars config_re); print myconfig(); print config_sh(); + + print config_re(); config_vars(qw(osname archname)); @@ -377,4 +474,9 @@ Returns the entire perl configuration information in the form of the original config.sh shell variable assignment script. + +=item config_re($regex) + +Like config_sh() but returns, as a list, only the config entries who's +names match the $regex. =item config_vars(@names) @@ -444,6 +546,6 @@ ENDOFTAIL -if ($opts{glossary}) { - open(GLOS, "<$glossary") or die "Can't open $glossary: $!"; +if ($Opts{glossary}) { + open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!"; } %seen = (); @@ -455,9 +557,9 @@ my $c = substr $1, 0, 1; unless ($seen{$c}++) { - print CONFIG <; # Skip the "DO NOT EDIT" ; # Skip the preamble while () { process; - print CONFIG; + print CONFIG_POD; } } -print CONFIG <<'ENDOFTAIL'; +print CONFIG_POD <<'ENDOFTAIL'; =back @@ -525,7 +627,8 @@ close(CONFIG); close(GLOS); +close(CONFIG_POD); # Now create Cross.pm if needed -if ($opts{cross}) { +if ($Opts{cross}) { open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!"; my $cross = <<'EOS'; @@ -548,24 +651,23 @@ 1; EOS - $cross =~ s/\*\*\*replace-marker\*\*\*/$opts{cross}/g; + $cross =~ s/\*\*\*replace-marker\*\*\*/$Opts{cross}/g; print CROSS $cross; close CROSS; } - # Now do some simple tests on the Config.pm file we have created unshift(@INC,'lib'); -require $config_pm; +require $Config_PM; import Config; -die "$0: $config_pm not valid" +die "$0: $Config_PM not valid" unless $Config{'PERL_CONFIG_SH'} eq 'true'; -die "$0: error processing $config_pm" +die "$0: error processing $Config_PM" if defined($Config{'an impossible name'}) or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache ; -die "$0: error processing $config_pm" +die "$0: error processing $Config_PM" if eval '$Config{"cc"} = 1' or eval 'delete $Config{"cc"}' Index: /branches/vendor/third/perl/embed.h =================================================================== --- /branches/vendor/third/perl/embed.h (revision 18449) +++ /branches/vendor/third/perl/embed.h (revision 20074) @@ -2,17 +2,25 @@ * embed.h * - * Copyright (c) 1997-2002, Larry Wall + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - * This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h, - * perlvars.h and thrdvar.h. Any changes made here will be lost! + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by embed.pl from data in embed.fnc, embed.pl, + * pp.sym, intrpvar.h, perlvars.h and thrdvar.h. + * Any changes made here will be lost! + * + * Edit those files and run 'make regen_headers' to effect changes. */ /* (Doing namespace management portably in C is really gross.) */ -/* NO_EMBED is no longer supported. i.e. EMBED is always active. */ +/* By defining PERL_NO_SHORT_NAMES (not done by default) the short forms + * (like warn instead of Perl_warn) for the API are not defined. + * Not defining the short forms is a good thing for cleaner embedding. */ + +#ifndef PERL_NO_SHORT_NAMES /* Hide global symbols */ @@ -22,4 +30,5 @@ #if defined(PERL_IMPLICIT_SYS) #endif +#define doing_taint Perl_doing_taint #if defined(USE_ITHREADS) # if defined(PERL_IMPLICIT_SYS) @@ -27,5 +36,7 @@ #endif #if defined(MYMALLOC) +#ifdef PERL_CORE #define malloced_size Perl_malloced_size +#endif #endif #define get_context Perl_get_context @@ -34,7 +45,13 @@ #define Gv_AMupdate Perl_Gv_AMupdate #define gv_handler Perl_gv_handler +#ifdef PERL_CORE #define append_elem Perl_append_elem +#endif +#ifdef PERL_CORE #define append_list Perl_append_list +#endif +#ifdef PERL_CORE #define apply Perl_apply +#endif #define apply_attrs_string Perl_apply_attrs_string #define avhv_delete_ent Perl_avhv_delete_ent @@ -49,5 +66,7 @@ #define av_exists Perl_av_exists #define av_extend Perl_av_extend +#ifdef PERL_CORE #define av_fake Perl_av_fake +#endif #define av_fetch Perl_av_fetch #define av_fill Perl_av_fill @@ -56,17 +75,31 @@ #define av_pop Perl_av_pop #define av_push Perl_av_push +#ifdef PERL_CORE #define av_reify Perl_av_reify +#endif #define av_shift Perl_av_shift #define av_store Perl_av_store #define av_undef Perl_av_undef #define av_unshift Perl_av_unshift +#ifdef PERL_CORE #define bind_match Perl_bind_match +#endif +#ifdef PERL_CORE #define block_end Perl_block_end +#endif #define block_gimme Perl_block_gimme +#ifdef PERL_CORE #define block_start Perl_block_start +#endif +#ifdef PERL_CORE #define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL +#endif +#ifdef PERL_CORE #define boot_core_PerlIO Perl_boot_core_PerlIO +#endif #define call_list Perl_call_list +#ifdef PERL_CORE #define cando Perl_cando +#endif #define cast_ulong Perl_cast_ulong #define cast_i32 Perl_cast_i32 @@ -79,5 +112,7 @@ #define condpair_magic Perl_condpair_magic #endif +#ifdef PERL_CORE #define convert Perl_convert +#endif #define croak Perl_croak #define vcroak Perl_vcroak @@ -99,8 +134,14 @@ #define printf_nocontext Perl_printf_nocontext #endif +#ifdef PERL_CORE #define cv_ckproto Perl_cv_ckproto +#endif +#ifdef PERL_CORE #define cv_clone Perl_cv_clone +#endif #define cv_const_sv Perl_cv_const_sv +#ifdef PERL_CORE #define op_const_sv Perl_op_const_sv +#endif #define cv_undef Perl_cv_undef #define cx_dump Perl_cx_dump @@ -110,8 +151,14 @@ #define get_op_descs Perl_get_op_descs #define get_op_names Perl_get_op_names +#ifdef PERL_CORE #define get_no_modify Perl_get_no_modify +#endif +#ifdef PERL_CORE #define get_opargs Perl_get_opargs +#endif #define get_ppaddr Perl_get_ppaddr +#if defined(PERL_CORE) || defined(PERL_EXT) #define cxinc Perl_cxinc +#endif #define deb Perl_deb #define vdeb Perl_vdeb @@ -121,17 +168,35 @@ #define debstackptrs Perl_debstackptrs #define delimcpy Perl_delimcpy +#ifdef PERL_CORE #define deprecate Perl_deprecate +#endif +#ifdef PERL_CORE #define deprecate_old Perl_deprecate_old +#endif #define die Perl_die +#ifdef PERL_CORE #define vdie Perl_vdie +#endif +#ifdef PERL_CORE #define die_where Perl_die_where +#endif #define dounwind Perl_dounwind +#ifdef PERL_CORE #define do_aexec Perl_do_aexec +#endif +#ifdef PERL_CORE #define do_aexec5 Perl_do_aexec5 +#endif #define do_binmode Perl_do_binmode +#ifdef PERL_CORE #define do_chop Perl_do_chop +#endif #define do_close Perl_do_close +#ifdef PERL_CORE #define do_eof Perl_do_eof +#endif +#ifdef PERL_CORE #define do_exec Perl_do_exec +#endif #if defined(WIN32) #define do_aspawn Perl_do_aspawn @@ -140,33 +205,75 @@ #endif #if !defined(WIN32) +#ifdef PERL_CORE #define do_exec3 Perl_do_exec3 #endif +#endif +#ifdef PERL_CORE #define do_execfree Perl_do_execfree +#endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +#ifdef PERL_CORE #define do_ipcctl Perl_do_ipcctl +#endif +#ifdef PERL_CORE #define do_ipcget Perl_do_ipcget +#endif +#ifdef PERL_CORE #define do_msgrcv Perl_do_msgrcv +#endif +#ifdef PERL_CORE #define do_msgsnd Perl_do_msgsnd +#endif +#ifdef PERL_CORE #define do_semop Perl_do_semop +#endif +#ifdef PERL_CORE #define do_shmio Perl_do_shmio #endif +#endif #define do_join Perl_do_join +#ifdef PERL_CORE #define do_kv Perl_do_kv +#endif #define do_open Perl_do_open #define do_open9 Perl_do_open9 #define do_openn Perl_do_openn +#ifdef PERL_CORE #define do_pipe Perl_do_pipe +#endif +#ifdef PERL_CORE #define do_print Perl_do_print +#endif +#ifdef PERL_CORE #define do_readline Perl_do_readline +#endif +#ifdef PERL_CORE #define do_chomp Perl_do_chomp +#endif +#ifdef PERL_CORE #define do_seek Perl_do_seek +#endif #define do_sprintf Perl_do_sprintf +#ifdef PERL_CORE #define do_sysseek Perl_do_sysseek +#endif +#ifdef PERL_CORE #define do_tell Perl_do_tell +#endif +#ifdef PERL_CORE #define do_trans Perl_do_trans +#endif +#ifdef PERL_CORE #define do_vecget Perl_do_vecget +#endif +#ifdef PERL_CORE #define do_vecset Perl_do_vecset +#endif +#ifdef PERL_CORE #define do_vop Perl_do_vop +#endif +#ifdef PERL_CORE #define dofile Perl_dofile +#endif #define dowantarray Perl_dowantarray #define dump_all Perl_dump_all @@ -183,16 +290,28 @@ #define fbm_compile Perl_fbm_compile #define fbm_instr Perl_fbm_instr +#ifdef PERL_CORE #define find_script Perl_find_script +#endif #if defined(USE_5005THREADS) +#ifdef PERL_CORE #define find_threadsv Perl_find_threadsv #endif +#endif +#ifdef PERL_CORE #define force_list Perl_force_list +#endif +#ifdef PERL_CORE #define fold_constants Perl_fold_constants +#endif #define form Perl_form #define vform Perl_vform #define free_tmps Perl_free_tmps +#ifdef PERL_CORE #define gen_constant_list Perl_gen_constant_list +#endif #if !defined(HAS_GETENV_LEN) +#ifdef PERL_CORE #define getenv_len Perl_getenv_len +#endif #endif #define gp_free Perl_gp_free @@ -244,14 +363,28 @@ #define ibcmp_locale Perl_ibcmp_locale #define ibcmp_utf8 Perl_ibcmp_utf8 +#ifdef PERL_CORE #define ingroup Perl_ingroup +#endif +#ifdef PERL_CORE #define init_argv_symbols Perl_init_argv_symbols +#endif +#ifdef PERL_CORE #define init_debugger Perl_init_debugger +#endif #define init_stacks Perl_init_stacks #define init_tm Perl_init_tm +#ifdef PERL_CORE #define intro_my Perl_intro_my +#endif #define instr Perl_instr +#ifdef PERL_CORE #define io_close Perl_io_close +#endif +#ifdef PERL_CORE #define invert Perl_invert +#endif +#ifdef PERL_CORE #define is_gv_magical Perl_is_gv_magical +#endif #define is_lvalue_sub Perl_is_lvalue_sub #define to_uni_upper_lc Perl_to_uni_upper_lc @@ -292,4 +425,5 @@ #define is_utf8_char Perl_is_utf8_char #define is_utf8_string Perl_is_utf8_string +#define is_utf8_string_loc Perl_is_utf8_string_loc #define is_utf8_alnum Perl_is_utf8_alnum #define is_utf8_alnumc Perl_is_utf8_alnumc @@ -308,17 +442,35 @@ #define is_utf8_xdigit Perl_is_utf8_xdigit #define is_utf8_mark Perl_is_utf8_mark +#ifdef PERL_CORE #define jmaybe Perl_jmaybe +#endif +#ifdef PERL_CORE #define keyword Perl_keyword +#endif #define leave_scope Perl_leave_scope +#ifdef PERL_CORE #define lex_end Perl_lex_end +#endif +#ifdef PERL_CORE #define lex_start Perl_lex_start +#endif #define op_null Perl_op_null +#ifdef PERL_CORE #define op_clear Perl_op_clear +#endif +#ifdef PERL_CORE #define linklist Perl_linklist +#endif +#ifdef PERL_CORE #define list Perl_list +#endif +#ifdef PERL_CORE #define listkids Perl_listkids +#endif #define load_module Perl_load_module #define vload_module Perl_vload_module +#ifdef PERL_CORE #define localize Perl_localize +#endif #define looks_like_number Perl_looks_like_number #define grok_bin Perl_grok_bin @@ -327,64 +479,172 @@ #define grok_numeric_radix Perl_grok_numeric_radix #define grok_oct Perl_grok_oct +#ifdef PERL_CORE #define magic_clearenv Perl_magic_clearenv +#endif +#ifdef PERL_CORE #define magic_clear_all_env Perl_magic_clear_all_env +#endif +#ifdef PERL_CORE #define magic_clearpack Perl_magic_clearpack +#endif +#ifdef PERL_CORE #define magic_clearsig Perl_magic_clearsig +#endif +#ifdef PERL_CORE #define magic_existspack Perl_magic_existspack +#endif +#ifdef PERL_CORE #define magic_freeregexp Perl_magic_freeregexp +#endif +#ifdef PERL_CORE #define magic_freeovrld Perl_magic_freeovrld +#endif +#ifdef PERL_CORE #define magic_get Perl_magic_get +#endif +#ifdef PERL_CORE #define magic_getarylen Perl_magic_getarylen +#endif +#ifdef PERL_CORE #define magic_getdefelem Perl_magic_getdefelem +#endif +#ifdef PERL_CORE #define magic_getglob Perl_magic_getglob +#endif +#ifdef PERL_CORE #define magic_getnkeys Perl_magic_getnkeys +#endif +#ifdef PERL_CORE #define magic_getpack Perl_magic_getpack +#endif +#ifdef PERL_CORE #define magic_getpos Perl_magic_getpos +#endif +#ifdef PERL_CORE #define magic_getsig Perl_magic_getsig +#endif +#ifdef PERL_CORE #define magic_getsubstr Perl_magic_getsubstr +#endif +#ifdef PERL_CORE #define magic_gettaint Perl_magic_gettaint +#endif +#ifdef PERL_CORE #define magic_getuvar Perl_magic_getuvar +#endif +#ifdef PERL_CORE #define magic_getvec Perl_magic_getvec +#endif +#ifdef PERL_CORE #define magic_len Perl_magic_len +#endif #if defined(USE_5005THREADS) +#ifdef PERL_CORE #define magic_mutexfree Perl_magic_mutexfree #endif +#endif +#ifdef PERL_CORE #define magic_nextpack Perl_magic_nextpack +#endif +#ifdef PERL_CORE #define magic_regdata_cnt Perl_magic_regdata_cnt +#endif +#ifdef PERL_CORE #define magic_regdatum_get Perl_magic_regdatum_get +#endif +#ifdef PERL_CORE #define magic_regdatum_set Perl_magic_regdatum_set +#endif +#ifdef PERL_CORE #define magic_set Perl_magic_set +#endif +#ifdef PERL_CORE #define magic_setamagic Perl_magic_setamagic +#endif +#ifdef PERL_CORE #define magic_setarylen Perl_magic_setarylen +#endif +#ifdef PERL_CORE #define magic_setbm Perl_magic_setbm +#endif +#ifdef PERL_CORE #define magic_setdbline Perl_magic_setdbline +#endif #if defined(USE_LOCALE_COLLATE) +#ifdef PERL_CORE #define magic_setcollxfrm Perl_magic_setcollxfrm #endif +#endif +#ifdef PERL_CORE #define magic_setdefelem Perl_magic_setdefelem +#endif +#ifdef PERL_CORE #define magic_setenv Perl_magic_setenv +#endif +#ifdef PERL_CORE #define magic_setfm Perl_magic_setfm +#endif +#ifdef PERL_CORE #define magic_setisa Perl_magic_setisa +#endif +#ifdef PERL_CORE #define magic_setglob Perl_magic_setglob +#endif +#ifdef PERL_CORE #define magic_setmglob Perl_magic_setmglob +#endif +#ifdef PERL_CORE #define magic_setnkeys Perl_magic_setnkeys +#endif +#ifdef PERL_CORE #define magic_setpack Perl_magic_setpack +#endif +#ifdef PERL_CORE #define magic_setpos Perl_magic_setpos +#endif +#ifdef PERL_CORE +#define magic_setregexp Perl_magic_setregexp +#endif +#ifdef PERL_CORE #define magic_setsig Perl_magic_setsig +#endif +#ifdef PERL_CORE #define magic_setsubstr Perl_magic_setsubstr +#endif +#ifdef PERL_CORE #define magic_settaint Perl_magic_settaint +#endif +#ifdef PERL_CORE #define magic_setuvar Perl_magic_setuvar +#endif +#ifdef PERL_CORE #define magic_setvec Perl_magic_setvec +#endif +#ifdef PERL_CORE +#define magic_setutf8 Perl_magic_setutf8 +#endif +#ifdef PERL_CORE #define magic_set_all_env Perl_magic_set_all_env +#endif +#ifdef PERL_CORE #define magic_sizepack Perl_magic_sizepack +#endif +#ifdef PERL_CORE #define magic_wipepack Perl_magic_wipepack +#endif +#ifdef PERL_CORE #define magicname Perl_magicname +#endif #define markstack_grow Perl_markstack_grow #if defined(USE_LOCALE_COLLATE) +#ifdef PERL_CORE #define mem_collxfrm Perl_mem_collxfrm +#endif #endif #define mess Perl_mess #define vmess Perl_vmess +#ifdef PERL_CORE #define qerror Perl_qerror +#endif #define sortsv Perl_sortsv #define mg_clear Perl_mg_clear @@ -398,8 +658,14 @@ #define mg_size Perl_mg_size #define mini_mktime Perl_mini_mktime +#ifdef PERL_CORE #define mod Perl_mod +#endif +#ifdef PERL_CORE #define mode_from_discipline Perl_mode_from_discipline +#endif #define moreswitches Perl_moreswitches +#ifdef PERL_CORE #define my Perl_my +#endif #define my_atof Perl_my_atof #if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) @@ -433,5 +699,7 @@ #define my_ntohl Perl_my_ntohl #endif +#ifdef PERL_CORE #define my_unexec Perl_my_unexec +#endif #define newANONLIST Perl_newANONLIST #define newANONHASH Perl_newANONHASH @@ -486,21 +754,47 @@ #define newWHILEOP Perl_newWHILEOP #define new_stackinfo Perl_new_stackinfo -#define new_vstring Perl_new_vstring +#define scan_vstring Perl_scan_vstring +#ifdef PERL_CORE #define nextargv Perl_nextargv +#endif #define ninstr Perl_ninstr +#ifdef PERL_CORE #define oopsCV Perl_oopsCV +#endif #define op_free Perl_op_free +#ifdef PERL_CORE #define package Perl_package +#endif +#ifdef PERL_CORE #define pad_alloc Perl_pad_alloc -#define pad_allocmy Perl_pad_allocmy +#endif +#ifdef PERL_CORE +#define allocmy Perl_allocmy +#endif +#ifdef PERL_CORE #define pad_findmy Perl_pad_findmy +#endif +#ifdef PERL_CORE #define oopsAV Perl_oopsAV +#endif +#ifdef PERL_CORE #define oopsHV Perl_oopsHV +#endif +#ifdef PERL_CORE #define pad_leavemy Perl_pad_leavemy +#endif #define pad_sv Perl_pad_sv +#ifdef PERL_CORE #define pad_free Perl_pad_free +#endif +#ifdef PERL_CORE #define pad_reset Perl_pad_reset +#endif +#ifdef PERL_CORE #define pad_swipe Perl_pad_swipe +#endif +#ifdef PERL_CORE #define peep Perl_peep +#endif #if defined(USE_5005THREADS) #define new_struct_thread Perl_new_struct_thread @@ -534,15 +828,32 @@ #define require_pv Perl_require_pv #define pack_cat Perl_pack_cat +#define packlist Perl_packlist +#ifdef PERL_CORE #define pidgone Perl_pidgone +#endif #define pmflag Perl_pmflag +#ifdef PERL_CORE #define pmruntime Perl_pmruntime +#endif +#ifdef PERL_CORE #define pmtrans Perl_pmtrans +#endif +#ifdef PERL_CORE #define pop_return Perl_pop_return +#endif #define pop_scope Perl_pop_scope +#ifdef PERL_CORE #define prepend_elem Perl_prepend_elem +#endif +#ifdef PERL_CORE #define push_return Perl_push_return +#endif #define push_scope Perl_push_scope +#ifdef PERL_CORE #define ref Perl_ref +#endif +#ifdef PERL_CORE #define refkids Perl_refkids +#endif #define regdump Perl_regdump #define regclass_swash Perl_regclass_swash @@ -554,16 +865,30 @@ #define regexec_flags Perl_regexec_flags #define regnext Perl_regnext +#if defined(PERL_CORE) || defined(PERL_EXT) #define regprop Perl_regprop +#endif #define repeatcpy Perl_repeatcpy #define rninstr Perl_rninstr #define rsignal Perl_rsignal +#ifdef PERL_CORE #define rsignal_restore Perl_rsignal_restore +#endif +#ifdef PERL_CORE #define rsignal_save Perl_rsignal_save +#endif #define rsignal_state Perl_rsignal_state +#ifdef PERL_CORE #define rxres_free Perl_rxres_free +#endif +#ifdef PERL_CORE #define rxres_restore Perl_rxres_restore +#endif +#ifdef PERL_CORE #define rxres_save Perl_rxres_save +#endif #if !defined(HAS_RENAME) +#ifdef PERL_CORE #define same_dirent Perl_same_dirent +#endif #endif #define savepv Perl_savepv @@ -571,8 +896,10 @@ #define savepvn Perl_savepvn #define savestack_grow Perl_savestack_grow +#define savestack_grow_cnt Perl_savestack_grow_cnt #define save_aelem Perl_save_aelem #define save_alloc Perl_save_alloc #define save_aptr Perl_save_aptr #define save_ary Perl_save_ary +#define save_bool Perl_save_bool #define save_clearsv Perl_save_clearsv #define save_delete Perl_save_delete @@ -580,5 +907,7 @@ #define save_destructor_x Perl_save_destructor_x #define save_freesv Perl_save_freesv +#ifdef PERL_CORE #define save_freeop Perl_save_freeop +#endif #define save_freepv Perl_save_freepv #define save_generic_svref Perl_save_generic_svref @@ -600,5 +929,7 @@ #define save_mortalizesv Perl_save_mortalizesv #define save_nogv Perl_save_nogv +#ifdef PERL_CORE #define save_op Perl_save_op +#endif #define save_scalar Perl_save_scalar #define save_pptr Perl_save_pptr @@ -609,24 +940,47 @@ #define save_svref Perl_save_svref #define save_threadsv Perl_save_threadsv +#ifdef PERL_CORE #define sawparens Perl_sawparens +#endif +#ifdef PERL_CORE #define scalar Perl_scalar +#endif +#ifdef PERL_CORE #define scalarkids Perl_scalarkids +#endif +#ifdef PERL_CORE #define scalarseq Perl_scalarseq +#endif +#ifdef PERL_CORE #define scalarvoid Perl_scalarvoid +#endif #define scan_bin Perl_scan_bin #define scan_hex Perl_scan_hex #define scan_num Perl_scan_num #define scan_oct Perl_scan_oct +#ifdef PERL_CORE #define scope Perl_scope +#endif #define screaminstr Perl_screaminstr #if !defined(VMS) +#ifdef PERL_CORE #define setenv_getix Perl_setenv_getix #endif +#endif +#ifdef PERL_CORE #define setdefout Perl_setdefout +#endif +#ifdef PERL_CORE #define share_hek Perl_share_hek +#endif +#ifdef PERL_CORE #define sighandler Perl_sighandler +#endif +#define csighandler Perl_csighandler #define stack_grow Perl_stack_grow #define start_subparse Perl_start_subparse +#ifdef PERL_CORE #define sub_crush_depth Perl_sub_crush_depth +#endif #define sv_2bool Perl_sv_2bool #define sv_2cv Perl_sv_2cv @@ -646,5 +1000,7 @@ #define sv_pvbyten Perl_sv_pvbyten #define sv_true Perl_sv_true +#ifdef PERL_CORE #define sv_add_arena Perl_sv_add_arena +#endif #define sv_backoff Perl_sv_backoff #define sv_bless Perl_sv_bless @@ -653,6 +1009,10 @@ #define sv_catpv Perl_sv_catpv #define sv_chop Perl_sv_chop +#ifdef PERL_CORE #define sv_clean_all Perl_sv_clean_all +#endif +#ifdef PERL_CORE #define sv_clean_objs Perl_sv_clean_objs +#endif #define sv_clear Perl_sv_clear #define sv_cmp Perl_sv_cmp @@ -668,5 +1028,7 @@ #define sv_eq Perl_sv_eq #define sv_free Perl_sv_free +#ifdef PERL_CORE #define sv_free_arenas Perl_sv_free_arenas +#endif #define sv_gets Perl_sv_gets #define sv_grow Perl_sv_grow @@ -688,4 +1050,5 @@ #define sv_pvbyten_force Perl_sv_pvbyten_force #define sv_recode_to_utf8 Perl_sv_recode_to_utf8 +#define sv_cat_decode Perl_sv_cat_decode #define sv_reftype Perl_sv_reftype #define sv_replace Perl_sv_replace @@ -695,4 +1058,5 @@ #define sv_vsetpvf Perl_sv_vsetpvf #define sv_setiv Perl_sv_setiv +#define sv_setpviv Perl_sv_setpviv #define sv_setuv Perl_sv_setuv #define sv_setnv Perl_sv_setnv @@ -731,7 +1095,12 @@ #endif #define unpack_str Perl_unpack_str +#define unpackstring Perl_unpackstring #define unsharepvn Perl_unsharepvn +#ifdef PERL_CORE #define unshare_hek Perl_unshare_hek +#endif +#ifdef PERL_CORE #define utilize Perl_utilize +#endif #define utf16_to_utf8 Perl_utf16_to_utf8 #define utf16_to_utf8_reversed Perl_utf16_to_utf8_reversed @@ -752,22 +1121,56 @@ #define pv_uni_display Perl_pv_uni_display #define sv_uni_display Perl_sv_uni_display +#ifdef PERL_CORE #define vivify_defelem Perl_vivify_defelem +#endif +#ifdef PERL_CORE #define vivify_ref Perl_vivify_ref +#endif +#ifdef PERL_CORE #define wait4pid Perl_wait4pid +#endif +#ifdef PERL_CORE +#define parse_unicode_opts Perl_parse_unicode_opts +#endif +#ifdef PERL_CORE +#define seed Perl_seed +#endif +#ifdef PERL_CORE +#define get_hash_seed Perl_get_hash_seed +#endif +#ifdef PERL_CORE #define report_evil_fh Perl_report_evil_fh +#endif +#ifdef PERL_CORE #define report_uninit Perl_report_uninit +#endif #define warn Perl_warn #define vwarn Perl_vwarn #define warner Perl_warner #define vwarner Perl_vwarner +#ifdef PERL_CORE #define watch Perl_watch +#endif #define whichsig Perl_whichsig +#ifdef PERL_CORE +#define write_to_stderr Perl_write_to_stderr +#endif +#ifdef PERL_CORE #define yyerror Perl_yyerror +#endif #ifdef USE_PURE_BISON +#ifdef PERL_CORE #define yylex_r Perl_yylex_r #endif +#endif +#ifdef PERL_CORE #define yylex Perl_yylex +#endif +#ifdef PERL_CORE #define yyparse Perl_yyparse +#endif +#ifdef PERL_CORE #define yywarn Perl_yywarn +#endif #if defined(MYMALLOC) #define dump_mstats Perl_dump_mstats @@ -778,10 +1181,4 @@ #define safesysrealloc Perl_safesysrealloc #define safesysfree Perl_safesysfree -#if defined(LEAKTEST) -#define safexmalloc Perl_safexmalloc -#define safexcalloc Perl_safexcalloc -#define safexrealloc Perl_safexrealloc -#define safexfree Perl_safexfree -#endif #if defined(PERL_GLOBAL_STRUCT) #define GetVars Perl_GetVars @@ -800,4 +1197,5 @@ #define sv_vsetpvf_mg Perl_sv_vsetpvf_mg #define sv_setiv_mg Perl_sv_setiv_mg +#define sv_setpviv_mg Perl_sv_setpviv_mg #define sv_setuv_mg Perl_sv_setuv_mg #define sv_setnv_mg Perl_sv_setnv_mg @@ -833,10 +1231,16 @@ #define tmps_grow Perl_tmps_grow #define sv_rvweaken Perl_sv_rvweaken +#ifdef PERL_CORE #define magic_killbackrefs Perl_magic_killbackrefs +#endif #define newANONATTRSUB Perl_newANONATTRSUB #define newATTRSUB Perl_newATTRSUB #define newMYSUB Perl_newMYSUB +#ifdef PERL_CORE #define my_attrs Perl_my_attrs +#endif +#ifdef PERL_CORE #define boot_core_xsutils Perl_boot_core_xsutils +#endif #if defined(USE_ITHREADS) #define cx_dup Perl_cx_dup @@ -872,319 +1276,797 @@ #define nothreadhook Perl_nothreadhook #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define avhv_index_sv S_avhv_index_sv +#endif +#ifdef PERL_CORE #define avhv_index S_avhv_index #endif +#endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define do_trans_simple S_do_trans_simple +#endif +#ifdef PERL_CORE #define do_trans_count S_do_trans_count +#endif +#ifdef PERL_CORE #define do_trans_complex S_do_trans_complex +#endif +#ifdef PERL_CORE #define do_trans_simple_utf8 S_do_trans_simple_utf8 +#endif +#ifdef PERL_CORE #define do_trans_count_utf8 S_do_trans_count_utf8 +#endif +#ifdef PERL_CORE #define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif +#endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define gv_init_sv S_gv_init_sv +#endif +#ifdef PERL_CORE #define require_errno S_require_errno #endif +#endif #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define hsplit S_hsplit +#endif +#ifdef PERL_CORE #define hfreeentries S_hfreeentries +#endif +#ifdef PERL_CORE #define more_he S_more_he +#endif +#ifdef PERL_CORE #define new_he S_new_he +#endif +#ifdef PERL_CORE #define del_he S_del_he +#endif +#ifdef PERL_CORE #define save_hek_flags S_save_hek_flags +#endif +#ifdef PERL_CORE #define hv_magic_check S_hv_magic_check +#endif +#ifdef PERL_CORE #define unshare_hek_or_pvn S_unshare_hek_or_pvn +#endif +#ifdef PERL_CORE #define share_hek_flags S_share_hek_flags -#define hv_fetch_flags S_hv_fetch_flags +#endif +#ifdef PERL_CORE #define hv_notallowed S_hv_notallowed #endif +#endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define save_magic S_save_magic +#endif +#ifdef PERL_CORE #define magic_methpack S_magic_methpack +#endif +#ifdef PERL_CORE #define magic_methcall S_magic_methcall #endif +#endif #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define list_assignment S_list_assignment +#endif +#ifdef PERL_CORE #define bad_type S_bad_type +#endif +#ifdef PERL_CORE #define cop_free S_cop_free +#endif +#ifdef PERL_CORE #define modkids S_modkids +#endif +#ifdef PERL_CORE #define no_bareword_allowed S_no_bareword_allowed +#endif +#ifdef PERL_CORE #define no_fh_allowed S_no_fh_allowed +#endif +#ifdef PERL_CORE #define scalarboolean S_scalarboolean +#endif +#ifdef PERL_CORE #define too_few_arguments S_too_few_arguments +#endif +#ifdef PERL_CORE #define too_many_arguments S_too_many_arguments -#define pad_addlex S_pad_addlex -#define pad_findlex S_pad_findlex +#endif +#ifdef PERL_CORE #define newDEFSVOP S_newDEFSVOP +#endif +#ifdef PERL_CORE #define new_logop S_new_logop +#endif +#ifdef PERL_CORE #define simplify_sort S_simplify_sort +#endif +#ifdef PERL_CORE #define is_handle_constructor S_is_handle_constructor +#endif +#ifdef PERL_CORE #define gv_ename S_gv_ename -# if defined(DEBUG_CLOSURES) -#define cv_dump S_cv_dump +#endif +#ifdef PERL_CORE +#define scalar_mod_type S_scalar_mod_type +#endif +#ifdef PERL_CORE +#define my_kid S_my_kid +#endif +#ifdef PERL_CORE +#define dup_attrlist S_dup_attrlist +#endif +#ifdef PERL_CORE +#define apply_attrs S_apply_attrs +#endif +#ifdef PERL_CORE +#define apply_attrs_my S_apply_attrs_my +#endif +#endif +#if defined(PL_OP_SLAB_ALLOC) +#define Slab_Alloc Perl_Slab_Alloc +#define Slab_Free Perl_Slab_Free +#endif +#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define find_beginning S_find_beginning +#endif +#ifdef PERL_CORE +#define forbid_setid S_forbid_setid +#endif +#ifdef PERL_CORE +#define incpush S_incpush +#endif +#ifdef PERL_CORE +#define init_interp S_init_interp +#endif +#ifdef PERL_CORE +#define init_ids S_init_ids +#endif +#ifdef PERL_CORE +#define init_lexer S_init_lexer +#endif +#ifdef PERL_CORE +#define init_main_stash S_init_main_stash +#endif +#ifdef PERL_CORE +#define init_perllib S_init_perllib +#endif +#ifdef PERL_CORE +#define init_postdump_symbols S_init_postdump_symbols +#endif +#ifdef PERL_CORE +#define init_predump_symbols S_init_predump_symbols +#endif +#ifdef PERL_CORE +#define my_exit_jump S_my_exit_jump +#endif +#ifdef PERL_CORE +#define nuke_stacks S_nuke_stacks +#endif +#ifdef PERL_CORE +#define open_script S_open_script +#endif +#ifdef PERL_CORE +#define usage S_usage +#endif +#ifdef PERL_CORE +#define validate_suid S_validate_suid +#endif +# if defined(IAMSUID) +#ifdef PERL_CORE +#define fd_on_nosuid_fs S_fd_on_nosuid_fs +#endif # endif -#define cv_clone2 S_cv_clone2 -#define scalar_mod_type S_scalar_mod_type -#define my_kid S_my_kid -#define dup_attrlist S_dup_attrlist -#define apply_attrs S_apply_attrs -#define apply_attrs_my S_apply_attrs_my -# if defined(PL_OP_SLAB_ALLOC) -#define Slab_Alloc S_Slab_Alloc -#define Slab_Free S_Slab_Free +#ifdef PERL_CORE +#define parse_body S_parse_body +#endif +#ifdef PERL_CORE +#define run_body S_run_body +#endif +#ifdef PERL_CORE +#define call_body S_call_body +#endif +#ifdef PERL_CORE +#define call_list_body S_call_list_body +#endif +#if defined(PERL_FLEXIBLE_EXCEPTIONS) +#ifdef PERL_CORE +#define vparse_body S_vparse_body +#endif +#ifdef PERL_CORE +#define vrun_body S_vrun_body +#endif +#ifdef PERL_CORE +#define vcall_body S_vcall_body +#endif +#ifdef PERL_CORE +#define vcall_list_body S_vcall_list_body +#endif +#endif +# if defined(USE_5005THREADS) +#ifdef PERL_CORE +#define init_main_thread S_init_main_thread +#endif # endif #endif -#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -#define find_beginning S_find_beginning -#define forbid_setid S_forbid_setid -#define incpush S_incpush -#define init_interp S_init_interp -#define init_ids S_init_ids -#define init_lexer S_init_lexer -#define init_main_stash S_init_main_stash -#define init_perllib S_init_perllib -#define init_postdump_symbols S_init_postdump_symbols -#define init_predump_symbols S_init_predump_symbols -#define my_exit_jump S_my_exit_jump -#define nuke_stacks S_nuke_stacks -#define open_script S_open_script -#define usage S_usage -#define validate_suid S_validate_suid -# if defined(IAMSUID) -#define fd_on_nosuid_fs S_fd_on_nosuid_fs +#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define refto S_refto +#endif +#endif +#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define unpack_rec S_unpack_rec +#endif +#ifdef PERL_CORE +#define pack_rec S_pack_rec +#endif +#ifdef PERL_CORE +#define mul128 S_mul128 +#endif +#ifdef PERL_CORE +#define measure_struct S_measure_struct +#endif +#ifdef PERL_CORE +#define group_end S_group_end +#endif +#ifdef PERL_CORE +#define get_num S_get_num +#endif +#ifdef PERL_CORE +#define next_symbol S_next_symbol +#endif +#ifdef PERL_CORE +#define doencodes S_doencodes +#endif +#ifdef PERL_CORE +#define is_an_int S_is_an_int +#endif +#ifdef PERL_CORE +#define div128 S_div128 +#endif +#endif +#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define docatch S_docatch +#endif +#ifdef PERL_CORE +#define docatch_body S_docatch_body +#endif +#if defined(PERL_FLEXIBLE_EXCEPTIONS) +#ifdef PERL_CORE +#define vdocatch_body S_vdocatch_body +#endif +#endif +#ifdef PERL_CORE +#define dofindlabel S_dofindlabel +#endif +#ifdef PERL_CORE +#define doparseform S_doparseform +#endif +#ifdef PERL_CORE +#define dopoptoeval S_dopoptoeval +#endif +#ifdef PERL_CORE +#define dopoptolabel S_dopoptolabel +#endif +#ifdef PERL_CORE +#define dopoptoloop S_dopoptoloop +#endif +#ifdef PERL_CORE +#define dopoptosub S_dopoptosub +#endif +#ifdef PERL_CORE +#define dopoptosub_at S_dopoptosub_at +#endif +#ifdef PERL_CORE +#define save_lines S_save_lines +#endif +#ifdef PERL_CORE +#define doeval S_doeval +#endif +#ifdef PERL_CORE +#define doopen_pm S_doopen_pm +#endif +#ifdef PERL_CORE +#define path_is_absolute S_path_is_absolute +#endif +#endif +#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define do_maybe_phash S_do_maybe_phash +#endif +#ifdef PERL_CORE +#define do_oddball S_do_oddball +#endif +#ifdef PERL_CORE +#define get_db_sub S_get_db_sub +#endif +#ifdef PERL_CORE +#define method_common S_method_common +#endif +#endif +#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define doform S_doform +#endif +#ifdef PERL_CORE +#define emulate_eaccess S_emulate_eaccess +#endif +# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +#ifdef PERL_CORE +#define dooneliner S_dooneliner +#endif # endif -#define parse_body S_parse_body -#define run_body S_run_body -#define call_body S_call_body -#define call_list_body S_call_list_body -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#define vparse_body S_vparse_body -#define vrun_body S_vrun_body -#define vcall_body S_vcall_body -#define vcall_list_body S_vcall_list_body -#endif -# if defined(USE_5005THREADS) -#define init_main_thread S_init_main_thread +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reg S_reg +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reganode S_reganode +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regatom S_regatom +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regbranch S_regbranch +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reguni S_reguni +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regclass S_regclass +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regcurly S_regcurly +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reg_node S_reg_node +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regpiece S_regpiece +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reginsert S_reginsert +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regoptail S_regoptail +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regtail S_regtail +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regwhite S_regwhite +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define nextchar S_nextchar +#endif +# ifdef DEBUGGING +#if defined(PERL_CORE) || defined(PERL_EXT) +#define dumpuntil S_dumpuntil +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define put_byte S_put_byte +#endif # endif -#endif -#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) -#define refto S_refto -#define seed S_seed -#endif -#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT) -#define doencodes S_doencodes -#define mul128 S_mul128 -#define is_an_int S_is_an_int -#define div128 S_div128 -#define next_symbol S_next_symbol -#define find_count S_find_count -#define group_end S_group_end -#define measure_struct S_measure_struct -#endif -#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) -#define docatch S_docatch -#define docatch_body S_docatch_body -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#define vdocatch_body S_vdocatch_body -#endif -#define dofindlabel S_dofindlabel -#define doparseform S_doparseform -#define dopoptoeval S_dopoptoeval -#define dopoptolabel S_dopoptolabel -#define dopoptoloop S_dopoptoloop -#define dopoptosub S_dopoptosub -#define dopoptosub_at S_dopoptosub_at -#define save_lines S_save_lines -#define doeval S_doeval -#define doopen_pmc S_doopen_pmc -#define path_is_absolute S_path_is_absolute -#endif -#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -#define do_maybe_phash S_do_maybe_phash -#define do_oddball S_do_oddball -#define get_db_sub S_get_db_sub -#define method_common S_method_common -#endif -#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) -#define doform S_doform -#define emulate_eaccess S_emulate_eaccess -# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) -#define dooneliner S_dooneliner -# endif -#endif -#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) -#define reg S_reg -#define reganode S_reganode -#define regatom S_regatom -#define regbranch S_regbranch -#define reguni S_reguni -#define regclass S_regclass -#define regcurly S_regcurly -#define reg_node S_reg_node -#define regpiece S_regpiece -#define reginsert S_reginsert -#define regoptail S_regoptail -#define regtail S_regtail -#define regwhite S_regwhite -#define nextchar S_nextchar +#if defined(PERL_CORE) || defined(PERL_EXT) +#define scan_commit S_scan_commit +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_anything S_cl_anything +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_is_anything S_cl_is_anything +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_init S_cl_init +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_init_zero S_cl_init_zero +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_and S_cl_and +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cl_or S_cl_or +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define study_chunk S_study_chunk +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define add_data S_add_data +#endif +#ifdef PERL_CORE +#define re_croak2 S_re_croak2 +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regpposixcc S_regpposixcc +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define checkposixcc S_checkposixcc +#endif +#endif +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regmatch S_regmatch +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regrepeat S_regrepeat +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regrepeat_hard S_regrepeat_hard +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regtry S_regtry +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reginclass S_reginclass +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regcppush S_regcppush +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regcppop S_regcppop +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define regcp_set_to S_regcp_set_to +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define cache_re S_cache_re +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reghop S_reghop +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reghop3 S_reghop3 +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reghopmaybe S_reghopmaybe +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define reghopmaybe3 S_reghopmaybe3 +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define find_byclass S_find_byclass +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define to_utf8_substr S_to_utf8_substr +#endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#define to_byte_substr S_to_byte_substr +#endif +#endif +#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define deb_curcv S_deb_curcv +#endif +#ifdef PERL_CORE +#define debprof S_debprof +#endif +#endif +#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define save_scalar_at S_save_scalar_at +#endif +#endif +#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define asIV S_asIV +#endif +#ifdef PERL_CORE +#define asUV S_asUV +#endif +#ifdef PERL_CORE +#define more_sv S_more_sv +#endif +#ifdef PERL_CORE +#define more_xiv S_more_xiv +#endif +#ifdef PERL_CORE +#define more_xnv S_more_xnv +#endif +#ifdef PERL_CORE +#define more_xpv S_more_xpv +#endif +#ifdef PERL_CORE +#define more_xpviv S_more_xpviv +#endif +#ifdef PERL_CORE +#define more_xpvnv S_more_xpvnv +#endif +#ifdef PERL_CORE +#define more_xpvcv S_more_xpvcv +#endif +#ifdef PERL_CORE +#define more_xpvav S_more_xpvav +#endif +#ifdef PERL_CORE +#define more_xpvhv S_more_xpvhv +#endif +#ifdef PERL_CORE +#define more_xpvmg S_more_xpvmg +#endif +#ifdef PERL_CORE +#define more_xpvlv S_more_xpvlv +#endif +#ifdef PERL_CORE +#define more_xpvbm S_more_xpvbm +#endif +#ifdef PERL_CORE +#define more_xrv S_more_xrv +#endif +#ifdef PERL_CORE +#define new_xiv S_new_xiv +#endif +#ifdef PERL_CORE +#define new_xnv S_new_xnv +#endif +#ifdef PERL_CORE +#define new_xpv S_new_xpv +#endif +#ifdef PERL_CORE +#define new_xpviv S_new_xpviv +#endif +#ifdef PERL_CORE +#define new_xpvnv S_new_xpvnv +#endif +#ifdef PERL_CORE +#define new_xpvcv S_new_xpvcv +#endif +#ifdef PERL_CORE +#define new_xpvav S_new_xpvav +#endif +#ifdef PERL_CORE +#define new_xpvhv S_new_xpvhv +#endif +#ifdef PERL_CORE +#define new_xpvmg S_new_xpvmg +#endif +#ifdef PERL_CORE +#define new_xpvlv S_new_xpvlv +#endif +#ifdef PERL_CORE +#define new_xpvbm S_new_xpvbm +#endif +#ifdef PERL_CORE +#define new_xrv S_new_xrv +#endif +#ifdef PERL_CORE +#define del_xiv S_del_xiv +#endif +#ifdef PERL_CORE +#define del_xnv S_del_xnv +#endif +#ifdef PERL_CORE +#define del_xpv S_del_xpv +#endif +#ifdef PERL_CORE +#define del_xpviv S_del_xpviv +#endif +#ifdef PERL_CORE +#define del_xpvnv S_del_xpvnv +#endif +#ifdef PERL_CORE +#define del_xpvcv S_del_xpvcv +#endif +#ifdef PERL_CORE +#define del_xpvav S_del_xpvav +#endif +#ifdef PERL_CORE +#define del_xpvhv S_del_xpvhv +#endif +#ifdef PERL_CORE +#define del_xpvmg S_del_xpvmg +#endif +#ifdef PERL_CORE +#define del_xpvlv S_del_xpvlv +#endif +#ifdef PERL_CORE +#define del_xpvbm S_del_xpvbm +#endif +#ifdef PERL_CORE +#define del_xrv S_del_xrv +#endif +#ifdef PERL_CORE +#define sv_unglob S_sv_unglob +#endif +#ifdef PERL_CORE +#define not_a_number S_not_a_number +#endif +#ifdef PERL_CORE +#define visit S_visit +#endif +#ifdef PERL_CORE +#define sv_add_backref S_sv_add_backref +#endif +#ifdef PERL_CORE +#define sv_del_backref S_sv_del_backref +#endif # ifdef DEBUGGING -#define dumpuntil S_dumpuntil -#define put_byte S_put_byte -# endif -#define scan_commit S_scan_commit -#define cl_anything S_cl_anything -#define cl_is_anything S_cl_is_anything -#define cl_init S_cl_init -#define cl_init_zero S_cl_init_zero -#define cl_and S_cl_and -#define cl_or S_cl_or -#define study_chunk S_study_chunk -#define add_data S_add_data -#define re_croak2 S_re_croak2 -#define regpposixcc S_regpposixcc -#define checkposixcc S_checkposixcc -#endif -#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) -#define regmatch S_regmatch -#define regrepeat S_regrepeat -#define regrepeat_hard S_regrepeat_hard -#define regtry S_regtry -#define reginclass S_reginclass -#define regcppush S_regcppush -#define regcppop S_regcppop -#define regcp_set_to S_regcp_set_to -#define cache_re S_cache_re -#define reghop S_reghop -#define reghop3 S_reghop3 -#define reghopmaybe S_reghopmaybe -#define reghopmaybe3 S_reghopmaybe3 -#define find_byclass S_find_byclass -#define to_utf8_substr S_to_utf8_substr -#define to_byte_substr S_to_byte_substr -#endif -#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) -#define deb_curcv S_deb_curcv -#define debprof S_debprof -#endif -#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -#define save_scalar_at S_save_scalar_at -#endif -#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -#define asIV S_asIV -#define asUV S_asUV -#define more_sv S_more_sv -#define more_xiv S_more_xiv -#define more_xnv S_more_xnv -#define more_xpv S_more_xpv -#define more_xpviv S_more_xpviv -#define more_xpvnv S_more_xpvnv -#define more_xpvcv S_more_xpvcv -#define more_xpvav S_more_xpvav -#define more_xpvhv S_more_xpvhv -#define more_xpvmg S_more_xpvmg -#define more_xpvlv S_more_xpvlv -#define more_xpvbm S_more_xpvbm -#define more_xrv S_more_xrv -#define new_xiv S_new_xiv -#define new_xnv S_new_xnv -#define new_xpv S_new_xpv -#define new_xpviv S_new_xpviv -#define new_xpvnv S_new_xpvnv -#define new_xpvcv S_new_xpvcv -#define new_xpvav S_new_xpvav -#define new_xpvhv S_new_xpvhv -#define new_xpvmg S_new_xpvmg -#define new_xpvlv S_new_xpvlv -#define new_xpvbm S_new_xpvbm -#define new_xrv S_new_xrv -#define del_xiv S_del_xiv -#define del_xnv S_del_xnv -#define del_xpv S_del_xpv -#define del_xpviv S_del_xpviv -#define del_xpvnv S_del_xpvnv -#define del_xpvcv S_del_xpvcv -#define del_xpvav S_del_xpvav -#define del_xpvhv S_del_xpvhv -#define del_xpvmg S_del_xpvmg -#define del_xpvlv S_del_xpvlv -#define del_xpvbm S_del_xpvbm -#define del_xrv S_del_xrv -#define sv_unglob S_sv_unglob -#define not_a_number S_not_a_number -#define visit S_visit -#define sv_add_backref S_sv_add_backref -#define sv_del_backref S_sv_del_backref -# ifdef DEBUGGING +#ifdef PERL_CORE #define del_sv S_del_sv +#endif # endif # if !defined(NV_PRESERVES_UV) +#ifdef PERL_CORE #define sv_2iuv_non_preserve S_sv_2iuv_non_preserve +#endif # endif +#ifdef PERL_CORE #define expect_number S_expect_number +#endif # if defined(USE_ITHREADS) +#ifdef PERL_CORE #define gv_share S_gv_share +#endif # endif +#ifdef PERL_CORE +#define utf8_mg_pos S_utf8_mg_pos +#endif +#ifdef PERL_CORE +#define utf8_mg_pos_init S_utf8_mg_pos_init +#endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define check_uni S_check_uni +#endif +#ifdef PERL_CORE #define force_next S_force_next +#endif +#ifdef PERL_CORE #define force_version S_force_version +#endif +#ifdef PERL_CORE #define force_word S_force_word +#endif +#ifdef PERL_CORE #define tokeq S_tokeq +#endif +#ifdef PERL_CORE #define pending_ident S_pending_ident +#endif +#ifdef PERL_CORE #define scan_const S_scan_const +#endif +#ifdef PERL_CORE #define scan_formline S_scan_formline +#endif +#ifdef PERL_CORE #define scan_heredoc S_scan_heredoc +#endif +#ifdef PERL_CORE #define scan_ident S_scan_ident +#endif +#ifdef PERL_CORE #define scan_inputsymbol S_scan_inputsymbol +#endif +#ifdef PERL_CORE #define scan_pat S_scan_pat +#endif +#ifdef PERL_CORE #define scan_str S_scan_str +#endif +#ifdef PERL_CORE #define scan_subst S_scan_subst +#endif +#ifdef PERL_CORE #define scan_trans S_scan_trans +#endif +#ifdef PERL_CORE #define scan_word S_scan_word +#endif +#ifdef PERL_CORE #define skipspace S_skipspace +#endif +#ifdef PERL_CORE #define swallow_bom S_swallow_bom +#endif +#ifdef PERL_CORE #define checkcomma S_checkcomma +#endif +#ifdef PERL_CORE #define force_ident S_force_ident +#endif +#ifdef PERL_CORE #define incline S_incline +#endif +#ifdef PERL_CORE #define intuit_method S_intuit_method +#endif +#ifdef PERL_CORE #define intuit_more S_intuit_more +#endif +#ifdef PERL_CORE #define lop S_lop +#endif +#ifdef PERL_CORE #define missingterm S_missingterm +#endif +#ifdef PERL_CORE #define no_op S_no_op +#endif +#ifdef PERL_CORE #define set_csh S_set_csh +#endif +#ifdef PERL_CORE #define sublex_done S_sublex_done +#endif +#ifdef PERL_CORE #define sublex_push S_sublex_push +#endif +#ifdef PERL_CORE #define sublex_start S_sublex_start +#endif +#ifdef PERL_CORE #define filter_gets S_filter_gets +#endif +#ifdef PERL_CORE #define find_in_my_stash S_find_in_my_stash +#endif +#ifdef PERL_CORE #define new_constant S_new_constant +#endif # if defined(DEBUGGING) +#ifdef PERL_CORE #define tokereport S_tokereport +#endif # endif +#ifdef PERL_CORE #define ao S_ao +#endif +#ifdef PERL_CORE #define depcom S_depcom +#endif +#ifdef PERL_CORE #define incl_perldb S_incl_perldb +#endif #if 0 +#ifdef PERL_CORE #define utf16_textfilter S_utf16_textfilter +#endif +#ifdef PERL_CORE #define utf16rev_textfilter S_utf16rev_textfilter #endif +#endif # if defined(PERL_CR_FILTER) +#ifdef PERL_CORE #define cr_textfilter S_cr_textfilter +#endif # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define isa_lookup S_isa_lookup #endif +#endif #if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define stdize_locale S_stdize_locale #endif +#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE #define closest_cop S_closest_cop +#endif +#ifdef PERL_CORE #define mess_alloc S_mess_alloc -# if defined(LEAKTEST) -#define xstat S_xstat -# endif +#endif +#endif +#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) +#ifdef PERL_CORE +#define mulexp10 S_mulexp10 +#endif #endif #define sv_setsv_flags Perl_sv_setsv_flags @@ -1221,4 +2103,84 @@ #define PerlIO_stderr Perl_PerlIO_stderr #endif /* PERLIO_LAYERS */ +#ifdef PERL_CORE +#define deb_stack_all Perl_deb_stack_all +#endif +#ifdef PERL_IN_DEB_C +#ifdef PERL_CORE +#define deb_stack_n S_deb_stack_n +#endif +#endif +#ifdef PERL_CORE +#define pad_new Perl_pad_new +#endif +#ifdef PERL_CORE +#define pad_undef Perl_pad_undef +#endif +#ifdef PERL_CORE +#define pad_add_name Perl_pad_add_name +#endif +#ifdef PERL_CORE +#define pad_add_anon Perl_pad_add_anon +#endif +#ifdef PERL_CORE +#define pad_check_dup Perl_pad_check_dup +#endif +#ifdef DEBUGGING +#ifdef PERL_CORE +#define pad_setsv Perl_pad_setsv +#endif +#endif +#ifdef PERL_CORE +#define pad_block_start Perl_pad_block_sta