November 2017 - XEmacs-commits - XEmacs Mailing List Archives

commit/XEmacs: kehoea: Quieten some compiler warnings on 64 bit Linux, clang-3.8. 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/52af36c1d478/ Changeset: 52af36c1d478 User: kehoea Date: 2017-11-07 17:59:18+00:00 Summary: Quieten some compiler warnings on 64 bit Linux, clang-3.8. src/ChangeLog addition: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> Quieten some compiler warnings: * data.c (uint32_t_to_lisp): Add a check for sizeof (ITEM), which quietens the tautological-constant-compare warning on clang. * linuxplay.c (linux_play_data_or_file): Declare a ssize_t variable to take the result of read(). There are a lot of issues with the types used for bytecounts for the sound code, but I'm not going to fix them all today. * tls.c: Wrap a couple of declarations of Lisp variables in #ifdef WITH_TLS. Affected #: 4 files diff -r 6c493b7790729ec2b805a5967c9374258998613d -r 52af36c1d4781c2bce577f240c75f9d67cd5c2f5 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,16 ＠＠ +2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> + + Quieten some compiler warnings: + * data.c (uint32_t_to_lisp): + Add a check for sizeof (ITEM), which quietens the + tautological-constant-compare warning on clang. + * linuxplay.c (linux_play_data_or_file): + Declare a ssize_t variable to take the result of read(). There are + a lot of issues with the types used for bytecounts for the sound + code, but I'm not going to fix them all today. + * tls.c: + Wrap a couple of declarations of Lisp variables in #ifdef WITH_TLS. + 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> valid_ichar_p() needs an EMACS_INT argument, not an Ichar diff -r 6c493b7790729ec2b805a5967c9374258998613d -r 52af36c1d4781c2bce577f240c75f9d67cd5c2f5 src/data.c --- a/src/data.c +++ b/src/data.c ＠＠ -1153,7 +1153,8 ＠＠ Lisp_Object uint32_t_to_lisp (UINT_32_BIT item) { - if (item <= MOST_POSITIVE_FIXNUM_UNSIGNED) /* Fits in a positive fixnum? */ + if (sizeof (item) < sizeof (EMACS_INT) /* Fits in a positive fixnum? */ + || item <= MOST_POSITIVE_FIXNUM_UNSIGNED) { return make_fixnum (item); } diff -r 6c493b7790729ec2b805a5967c9374258998613d -r 52af36c1d4781c2bce577f240c75f9d67cd5c2f5 src/linuxplay.c --- a/src/linuxplay.c +++ b/src/linuxplay.c ＠＠ -338,8 +338,14 ＠＠ sound_warn(buf); goto END_OF_PLAY; } } if (fd >= 0) { - if ((rrtn = read(fd,sndbuf,SNDBUFSZ)) < 0) { - sound_perror("read"); goto END_OF_PLAY; } } + ssize_t gelesen; + if ((gelesen = read(fd,sndbuf,SNDBUFSZ)) < 0) + { + sound_perror("read"); + goto END_OF_PLAY; + } + rrtn = (size_t) gelesen; + } else break; } while (rrtn > 0); diff -r 6c493b7790729ec2b805a5967c9374258998613d -r 52af36c1d4781c2bce577f240c75f9d67cd5c2f5 src/tls.c --- a/src/tls.c +++ b/src/tls.c ＠＠ -28,8 +28,10 ＠＠ #include <netinet/in.h> #include <netinet/tcp.h> +#ifdef WITH_TLS static Lisp_Object prompt; static Lisp_Object Qread_passwd; +#endif Lisp_Object Qtls_error; #ifdef HAVE_NSS Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: valid_ichar_p() needs an EMACS_INT argument, not Ichar. Fix some 64-bit bugs. 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/6c493b779072/ Changeset: 6c493b779072 User: kehoea Date: 2017-11-07 17:44:11+00:00 Summary: valid_ichar_p() needs an EMACS_INT argument, not Ichar. Fix some 64-bit bugs. src/ChangeLog addition: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> valid_ichar_p() needs an EMACS_INT argument, not an Ichar argument, since it is usually used to examine values extracted from a Lisp_Object, and such values will be truncated giving incorrect values on a 64-bit build. Correct this, update associated C code. * doprnt.c (emacs_doprnt): Check whether the EMACS_INT value of OBJ is a valid Ichar, rather than truncating and giving incorrect values. * lisp.h (XCHAR_1): Ditto. * mule-ccl.c: * mule-ccl.c (ccl_driver): * mule-ccl.h: Most integer values in mule-ccl.{c,h} are stored to using XFIXNUM() or XCHAR_OR_FIXNUM(), and so declaring them as int will lead to truncation and errors down the line. Update their declaration to EMACS_INT, which will always have enough bits to handle the result of XFIXNUM(). Use emacs_snprintf() when debug-printing these values, since we have %lx and %ld which fits the width of an EMACS_INT explicitly. Make STATUS in struct ccl_program{} into an enum. Make EOL_TYPE into an enum. Comment out a couple of fields not used in XEmacs. * symbols.c (store_symval_forwarding): #if HAVE_BIGNUM => #ifdef HAVE_BIGNUM. * text.c: * text.c (old_mule_non_ascii_valid_ichar_p): * text.h (valid_unicode_codepoint_p): Make these two functions return Boolints. tests/ChangeLog addition: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> * automated/mule-tests.el: Check that (int-char most-negative-fixnum) gives nil. Affected #: 10 files diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,37 ＠＠ +2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> + + valid_ichar_p() needs an EMACS_INT argument, not an Ichar + argument, since it is usually used to examine values extracted + from a Lisp_Object, and such values will be truncated giving + incorrect values on a 64-bit build. + Correct this, update associated C code. + + * doprnt.c (emacs_doprnt): + Check whether the EMACS_INT value of OBJ is a valid Ichar, rather + than truncating and giving incorrect values. + + * lisp.h (XCHAR_1): + Ditto. + * mule-ccl.c: + * mule-ccl.c (ccl_driver): + * mule-ccl.h: + Most integer values in mule-ccl.{c,h} are stored to using XFIXNUM() + or XCHAR_OR_FIXNUM(), and so declaring them as int will lead to + truncation and errors down the line. + Update their declaration to EMACS_INT, which will always have + enough bits to handle the result of XFIXNUM(). + Use emacs_snprintf() when debug-printing these values, since we + have %lx and %ld which fits the width of an EMACS_INT explicitly. + Make STATUS in struct ccl_program{} into an enum. + Make EOL_TYPE into an enum. + Comment out a couple of fields not used in XEmacs. + * symbols.c (store_symval_forwarding): + #if HAVE_BIGNUM => #ifdef HAVE_BIGNUM. + * text.c: + * text.c (old_mule_non_ascii_valid_ichar_p): + * text.h (valid_unicode_codepoint_p): + Make these two functions return Boolints. + 2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> * editfns.c (make_time): diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/doprnt.c --- a/src/doprnt.c +++ b/src/doprnt.c ＠＠ -1984,12 +1984,13 ＠＠ } else if (FIXNUMP (obj)) { - a = XREALFIXNUM (obj); - if (!valid_ichar_p (a)) + EMACS_INT fa = XREALFIXNUM (obj); + if (!valid_ichar_p (fa)) { UNGCPRO; syntax_error ("Invalid integer value for %c spec", obj); } + a = (Ichar) fa; } else { diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/lisp.h --- a/src/lisp.h +++ b/src/lisp.h ＠＠ -3170,11 +3170,11 ＠＠ XCHAR_1 (Lisp_Object obj, const Ascbyte *file, int line) ) { - Ichar ch; + EMACS_INT ch; assert_at_line (CHARP (obj), file, line); ch = XCHARVAL (obj); assert_at_line (valid_ichar_p (ch), file, line); - return ch; + return (Ichar) ch; } #define XCHAR(x) XCHAR_1 (x, __FILE__, __LINE__) diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/mule-ccl.c --- a/src/mule-ccl.c +++ b/src/mule-ccl.c ＠＠ -953,8 +953,8 ＠＠ #ifdef CCL_DEBUG /* Currently enabled when DEBUG_XEMACS, i.e. configure --with-debug */ #define CCL_DEBUG_BACKTRACE_LEN 256 -int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN]; -int ccl_backtrace_idx; +EMACS_INT ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN]; +EMACS_INT ccl_backtrace_idx; #endif struct ccl_prog_stack ＠＠ -976,18 +976,18 ＠＠ int *consumed, int conversion_mode) { - register int *reg = ccl->reg; - register int ic = ccl->ic; - register int code = -1; - register int field1, field2; + register EMACS_INT *reg = ccl->reg; + register EMACS_INT ic = ccl->ic; + register EMACS_INT code = -1; + register EMACS_INT field1, field2; register Lisp_Object *ccl_prog = ccl->prog; const unsigned char *src = source, *src_end = src + src_bytes; int jump_address; int stack_idx = ccl->stack_idx; /* Instruction counter of the current CCL code. */ - int this_ic = 0; - int eof_ic = ccl->eof_ic; - int eof_hit = 0; + EMACS_INT this_ic = 0; + EMACS_INT eof_ic = ccl->eof_ic; + Boolint eof_hit = 0; if (ic >= eof_ic) ic = CCL_HEADER_MAIN; ＠＠ -1004,7 +1004,7 ＠＠ for (;;) { - int i, j, op; + EMACS_INT i, j, op; ccl_repeat: #ifdef CCL_DEBUG ＠＠ -1057,7 +1057,7 ＠＠ /* #### it's non-obvious to me that we need these casts, but the left one was already there so clearly the intention was an unsigned comparison. --ben */ - if ((unsigned int) i < (unsigned int) j) + if ((EMACS_UINT) i < (EMACS_UINT) j) reg[rrr] = XCHAR_OR_FIXNUM (ccl_prog[ic + i]); ic += j; break; ＠＠ -1110,7 +1110,7 ＠＠ i = reg[rrr]; j = XCHAR_OR_FIXNUM (ccl_prog[ic]); /* #### see comment at CCL_SetArray */ - if ((unsigned int) i < (unsigned int) j) + if ((EMACS_UINT) i < (EMACS_UINT) j) { i = XCHAR_OR_FIXNUM (ccl_prog[ic + 1 + i]); CCL_WRITE_CHAR (i); ＠＠ -1130,7 +1130,7 ＠＠ /* fall through ... */ case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ /* #### see comment at CCL_SetArray */ - if ((unsigned int) reg[rrr] < (unsigned int) field1) + if ((EMACS_UINT) reg[rrr] < (EMACS_UINT) field1) ic += XCHAR_OR_FIXNUM (ccl_prog[ic + reg[rrr]]); else ic += XCHAR_OR_FIXNUM (ccl_prog[ic + field1]); ＠＠ -1178,7 +1178,7 ＠＠ case CCL_Call: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */ { Lisp_Object slot; - int prog_id; + EMACS_INT prog_id; /* If FFF is nonzero, the CCL program ID is in the following code. */ ＠＠ -1229,7 +1229,7 ＠＠ case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ i = reg[rrr]; /* #### see comment at CCL_SetArray */ - if ((unsigned int) i < (unsigned int) field1) + if ((EMACS_UINT) i < (EMACS_UINT) field1) { j = XCHAR_OR_FIXNUM (ccl_prog[ic + i]); CCL_WRITE_CHAR (j); ＠＠ -1492,20 +1492,21 ＠＠ op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0); { Lisp_Object charset; + int ii = -1, jj = -1; /* ＠＠#### Get rid of 7-bit stuff */ buffer_filtered_ichar_to_charset_codepoint (op, buf, charset_7bit_p, - &charset, &i, &j, + &charset, &ii, &jj, CONVERR_FAIL); if (NILP (charset)) CCL_CONVERSION_ERROR; reg[RRR] = XCHARSET_ID (charset); } - if (j != -1) - i = (i << 7) | j; + if (jj != -1) + ii = (ii << 7) | jj; - reg[rrr] = i; + reg[rrr] = ii; #endif break; ＠＠ -1517,7 +1518,8 ＠＠ int ucs; CCL_MAKE_CHAR (reg[rrr], reg[RRR], ich); - /* ＠＠#### Is USE_PRIVATE correct? or should I fail? */ + /* [＠＠#### Is USE_PRIVATE correct? or should I fail?] + I should fail. */ ucs = ichar_to_unicode (ich, CONVERR_USE_PRIVATE); reg[rrr] = ucs; break; ＠＠ -1527,26 +1529,28 ＠＠ { int error = 0; - /* ＠＠#### Is UNICODE_OFFICIAL_ONLY correct? */ + /* [＠＠#### Is UNICODE_OFFICIAL_ONLY correct?] + Yes. */ if (!valid_unicode_codepoint_p (reg[rrr], UNICODE_OFFICIAL_ONLY)) error = 1; else { Lisp_Object charset; + int ii = -1, jj = -1; /* ＠＠#### This 7-bit stuff is awful, change it */ buffer_filtered_unicode_to_charset_codepoint - (reg[rrr], buf, charset_7bit_p, &charset, &i, &j, + (reg[rrr], buf, charset_7bit_p, &charset, &ii, &jj, CONVERR_FAIL); if (NILP (charset)) error = 1; else { reg[RRR] = XCHARSET_ID (charset); - i &= 0x7f; - j &= 0x7f; - reg[rrr] = (i << 7) | j; + ii &= 0x7f; + jj &= 0x7f; + reg[rrr] = (ii << 7) | jj; } } ＠＠ -1568,22 +1572,23 ＠＠ if (!HTENTRY_CLEAR_P (e)) { + int ii = -1, jj = -1; op = XCHARVAL (e->value); if (!valid_ichar_p (op)) CCL_INVALID_CMD; /* ＠＠#### Get rid of 7-bit stuff */ buffer_filtered_ichar_to_charset_codepoint - (op, buf, charset_7bit_p, &charset, &i, &j, + (op, buf, charset_7bit_p, &charset, &ii, &jj, CONVERR_FAIL); if (NILP (charset)) CCL_CONVERSION_ERROR; reg[RRR] = XCHARSET_ID (charset); - if (j != 0) + if (jj != 0) { - i = (i << 7) | j; + ii = (ii << 7) | jj; } - reg[rrr] = i; + reg[rrr] = ii; reg[7] = 1; /* r7 true for success */ } else ＠＠ -1615,7 +1620,7 ＠＠ case CCL_IterateMultipleMap: { Lisp_Object map, content, attrib, value; - int point, size, fin_ic; + EMACS_INT point, size, fin_ic; j = XCHAR_OR_FIXNUM (ccl_prog[ic++]); /* number of maps. */ fin_ic = ic + j; ＠＠ -1713,9 +1718,9 ＠＠ case CCL_MapMultiple: { Lisp_Object map, content, attrib, value; - int point, size, map_vector_size; - int map_set_rest_length, fin_ic; - int current_ic = this_ic; + EMACS_INT point, size, map_vector_size; + EMACS_INT map_set_rest_length, fin_ic; + EMACS_INT current_ic = this_ic; /* inhibit recursive call on MapMultiple. */ if (stack_idx_of_map_multiple > 0) ＠＠ -1987,30 +1992,33 ＠＠ /* We can insert an error message only if DESTINATION is specified and we still have a room to store the message there. */ - char msg[256]; + Ibyte msg[256]; switch (ccl->status) { case CCL_STAT_INVALID_CMD: - sprintf (msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", - code & 0x1F, code, this_ic); + emacs_snprintf (msg, sizeof (msg), + "\nCCL: Invalid command %lx (ccl_code = %lx) at %ld.", + code & 0x1F, code, this_ic); goto ccl_error_continue; case CCL_STAT_INVALID_CHARSET: - sprintf (msg, "\nCCL: Invalid charset (command %x, ccl_code = %x) at %d.", - code & 0x1F, code, this_ic); + emacs_snprintf (msg, sizeof (msg), + "\nCCL: Invalid charset (command %lx, ccl_code = %lx) at %ld.", + (code & 0x1F), code, this_ic); goto ccl_error_continue; case CCL_STAT_CONVERSION_ERROR: - sprintf (msg, "\nCCL: Conversion error (command %x, ccl_code = %x) at %d.", - code & 0x1F, code, this_ic); + emacs_snprintf (msg, sizeof (msg), + "\nCCL: Conversion error (command %lx, ccl_code = %lx) at %ld.", + code & 0x1F, code, this_ic); goto ccl_error_continue; ccl_error_continue: #ifdef CCL_DEBUG { - int i = ccl_backtrace_idx - 1; - int j; + EMACS_INT i = ccl_backtrace_idx - 1; + EMACS_INT j; Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); ＠＠ -2019,8 +2027,9 ＠＠ if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1; if (ccl_backtrace_table[i] == 0) break; - sprintf (msg, " %d", ccl_backtrace_table[i]); - Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); + Dynarr_add_many (destination, msg, + emacs_snprintf (msg, sizeof (msg), + " %ld", ccl_backtrace_table[i])) } goto ccl_finish; } ＠＠ -2028,14 +2037,16 ＠＠ break; case CCL_STAT_QUIT: - sprintf(msg, "\nCCL: Exited."); + emacs_snprintf (msg, sizeof (msg), "\nCCL: Exited."); break; default: - sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); + emacs_snprintf (msg, sizeof (msg), + "\nCCL: Unknown error type (%d).", ccl->status); } - Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); + Dynarr_add_many (destination, (unsigned char *) msg, + qxestrlen (msg)); } ccl_finish: ＠＠ -2340,7 +2351,7 ＠＠ { Lisp_Object val; struct ccl_program ccl; - int i, produced; + EMACS_INT i, produced; unsigned_char_dynarr *outbuf; struct gcpro gcpro1, gcpro2, gcpro3; diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/mule-ccl.h --- a/src/mule-ccl.h +++ b/src/mule-ccl.h ＠＠ -38,45 +38,50 ＠＠ 7-bit charset is wanted, etc.). */ }; +enum ccl_coding_eol + { + CCL_CODING_EOL_LF, /* Line-feed only, same as Emacs' */ + CCL_CODING_EOL_CRLF, /* Sequence of carriage-return and + line-feed. */ + CCL_CODING_EOL_CR, /* Carriage-return only. */ + }; + /* Structure to hold information about running CCL code. Read comments in the file ccl.c for the detail of each field. */ struct ccl_program { Elemcount size; /* Size of the compiled code. */ Lisp_Object *prog; /* Pointer into the compiled code. */ - int ic; /* Instruction Counter (index for PROG). */ - int eof_ic; /* Instruction Counter for end-of-file + EMACS_INT ic; /* Instruction Counter (index for PROG). */ + EMACS_INT eof_ic; /* Instruction Counter for end-of-file processing code. */ - int reg[8]; /* CCL registers, reg[7] is used for + EMACS_INT reg[8]; /* CCL registers, reg[7] is used for condition flag of relational operations. */ - int private_state; /* CCL instruction may use this + /* Not used in XEmacs: */ + /* int private_state; */ /* CCL instruction may use this for private use, mainly for saving internal states on suspending. This variable is set to 0 when ccl is set up. */ - int last_block; /* Set to 1 while processing the last + + Boolint last_block; /* Set to 1 while processing the last block. */ - int status; /* Exit status of the CCL program. */ - int buf_magnification; /* Output buffer magnification. How + enum ccl_status status; /* Exit status of the CCL program. */ + EMACS_INT buf_magnification; /* Output buffer magnification. How many times bigger the output buffer should be than the input buffer. */ int stack_idx; /* How deep the call of CCL_Call is nested. */ - int eol_type; /* When the CCL program is used for + enum ccl_coding_eol eol_type; /* When the CCL program is used for encoding by a coding system, set to the eol_type of the coding system. */ - int multibyte; /* 1 if the source text is multibyte. */ + /* Not used in XEmacs: */ + /* int multibyte; */ /* 1 if the source text is multibyte. */ }; #define CCL_MODE_ENCODING 0 #define CCL_MODE_DECODING 1 -#define CCL_CODING_EOL_LF 0 /* Line-feed only, same as Emacs' - internal format. */ -#define CCL_CODING_EOL_CRLF 1 /* Sequence of carriage-return and - line-feed. */ -#define CCL_CODING_EOL_CR 2 /* Carriage-return only. */ - #ifdef DEBUG_XEMACS #define CCL_DEBUG #endif diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/symbols.c --- a/src/symbols.c +++ b/src/symbols.c ＠＠ -1048,7 +1048,7 ＠＠ CHECK_INTEGER (newval); if (magicfun) magicfun (sym, &newval, Qnil, 0); -#if HAVE_BIGNUM +#ifdef HAVE_BIGNUM if (BIGNUMP (newval)) { if (bignum_fits_emacs_int_p (XBIGNUM_DATA (newval))) diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/text.c --- a/src/text.c +++ b/src/text.c ＠＠ -1498,11 +1498,11 ＠＠ #ifndef UNICODE_INTERNAL -/* Return whether CH is a valid Ichar, assuming it's >= 0x100. - Do not call this directly. Use the macro valid_ichar_p() instead. */ - -int -old_mule_non_ascii_valid_ichar_p (Ichar ch) +/* Return whether CH corresponds to a valid Ichar. Do not call this + directly. Use the macro valid_ichar_p() instead. */ + +Boolint +old_mule_non_ascii_valid_ichar_p (EMACS_INT ch) { int f1, f2, f3; diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d src/text.h --- a/src/text.h +++ b/src/text.h ＠＠ -242,7 +242,7 ＠＠ #define UNICODE_OFFICIAL_MAX 0x10FFFF DECLARE_INLINE_HEADER ( -int +Boolint valid_unicode_codepoint_p (EMACS_INT ch, enum unicode_allow allow) ) { ＠＠ -527,13 +527,13 ＠＠ enum converr); #elif defined (MULE) -MODULE_API INT_32_BIT old_mule_non_ascii_valid_ichar_p (Ichar ch); +MODULE_API Boolint old_mule_non_ascii_valid_ichar_p (EMACS_INT ch); #endif -/* Return whether the given Ichar is valid. */ +/* Return whether the given EMACS_INT can be made into a valid Ichar. */ DECLARE_INLINE_HEADER ( Boolint -valid_ichar_p (Ichar ch) +valid_ichar_p (EMACS_INT ch) ) { #ifdef UNICODE_INTERNAL diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,5 +1,8 ＠＠ 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> + * automated/mule-tests.el: + Check that (int-char most-negative-fixnum) gives nil. + * automated/format-tests.el: Create a ratio at runtime, not load time, on a build without ratio support. diff -r a4a1ae4830fadfd483403399af7d04b496b72138 -r 6c493b7790729ec2b805a5967c9374258998613d tests/automated/mule-tests.el --- a/tests/automated/mule-tests.el +++ b/tests/automated/mule-tests.el ＠＠ -35,6 +35,11 ＠＠ (require 'bytecomp) +;; This would give ?\x00 for a while on 64-bit XEmacs. + +(Assert (eq (int-char most-negative-fixnum) nil) + "checking for a bug with valid_ichar_p() on 64-bit builds") + ;;----------------------------------------------------------------- ;; Test whether all legal chars may be safely inserted to a buffer. ;;----------------------------------------------------------------- Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: Correct some test problems revealed by the buildbot, thank you Raymond Toy. 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/a4a1ae4830fa/ Changeset: a4a1ae4830fa User: kehoea Date: 2017-11-07 16:13:01+00:00 Summary: Correct some test problems revealed by the buildbot, thank you Raymond Toy. tests/ChangeLog addition: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> * automated/format-tests.el: Create a ratio at runtime, not load time, on a build without ratio support. * automated/format-tests.el (slow-integer-to-string): Fix the classical C cannot-make-most-negative-fixnum-positive bug in this function, since we expect it to run on non-bignum builds too. * automated/format-tests.el: (format "%n" pi) can give either wrong-type-argument (if we have bignum support) or syntax-error (if we don't). Check for both. * automated/lisp-tests.el: Operations on not-a-number (the square route of -1, (expt -1 0.5)) can legitimately fail with either range errors or domain errors. We don't really care which, accept both in Check-Error. * automated/lisp-tests.el (with-digits): We can get a useful result for (parse-integer "100000000" :radix 16) without bignum support on 64-bit builds, correct a check for this. * automated/syntax-tests.el (fboundp): Non-DEBUG_XEMACS builds don't have #'syntax-cache-info available, use Skip-Test-Unless to handle this. Affected #: 4 files diff -r 3130df547aa49dfcff4e7592d62613045471d3aa -r a4a1ae4830fadfd483403399af7d04b496b72138 tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,27 ＠＠ +2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/format-tests.el: + Create a ratio at runtime, not load time, on a build without ratio + support. + * automated/format-tests.el (slow-integer-to-string): + Fix the classical C cannot-make-most-negative-fixnum-positive bug + in this function, since we expect it to run on non-bignum builds + too. + * automated/format-tests.el: + (format "%n" pi) can give either wrong-type-argument (if we have + bignum support) or syntax-error (if we don't). Check for both. + * automated/lisp-tests.el: + Operations on not-a-number (the square route of -1, (expt -1 0.5)) + can legitimately fail with either range errors or domain + errors. We don't really care which, accept both in Check-Error. + * automated/lisp-tests.el (with-digits): + We can get a useful result for (parse-integer "100000000" :radix + 16) without bignum support on 64-bit builds, correct a check for + this. + * automated/syntax-tests.el (fboundp): + Non-DEBUG_XEMACS builds don't have #'syntax-cache-info available, + use Skip-Test-Unless to handle this. + 2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> * automated/os-tests.el: diff -r 3130df547aa49dfcff4e7592d62613045471d3aa -r a4a1ae4830fadfd483403399af7d04b496b72138 tests/automated/format-tests.el --- a/tests/automated/format-tests.el +++ b/tests/automated/format-tests.el ＠＠ -218,7 +218,7 ＠＠ (Check-Error 'syntax-error (format "%c" char-code-limit)) (Check-Error 'syntax-error (format "%c" 'a)) (Check-Error 'syntax-error (format "%c" pi)) ;; Newly fails -(Check-Error 'syntax-error (format "%c" '7/5)) +(if (featurep 'ratio) (Check-Error 'syntax-error (format "%c" (read "7/5")))) (Check-Error 'syntax-error (format "%c" (1+ most-positive-fixnum))) (Check-Error 'syntax-error (format "%.20c" ?a)) ;; Newly fails. (Check-Error 'syntax-error (format "%.*c" 20 ?a)) ;; Newly fails. ＠＠ -227,23 +227,27 ＠＠ (check-type integer integer) (check-type radix (integer 2 16)) (loop with minusp = (if (< integer 0) - (prog1 t (setq integer (- integer)))) + "-" + ;; Operate on the negative integer, to avoid the + ;; classical C most-negative-fixnum bug on + ;; non-bignum builds. + (setq integer (- integer)) + nil) with result = nil until (eql integer 0) - do (setf result (cons (cdr (assoc* (mod integer radix) - '((0 . ?0) (1 . ?1) - (2 . ?2) (3 . ?3) - (4 . ?4) (5 . ?5) - (6 . ?6) (7 . ?7) - (8 . ?8) (9 . ?9) - (10 . ?A) (11 . ?B) - (12 . ?C) (13 . ?D) - (14 . ?E) (14 . ?E) - (15 . ?F) (15 . ?F)))) + do (setf result (cons (cdr (assoc* (% integer radix) + '((0 . ?0) (-1 . ?1) + (-2 . ?2) (-3 . ?3) + (-4 . ?4) (-5 . ?5) + (-6 . ?6) (-7 . ?7) + (-8 . ?8) (-9 . ?9) + (-10 . ?A) (-11 . ?B) + (-12 . ?C) (-13 . ?D) + (-14 . ?E) (-14 . ?E) + (-15 . ?F) (-15 . ?F)))) result) integer (/ integer radix)) - finally return (concatenate 'string (if minusp "-") - result))) + finally return (concatenate 'string minusp result))) (defun* slow-ratio-to-string (ratio &optional (radix 10)) (check-type ratio ratio) ＠＠ -690,7 +694,7 ＠＠ (Check-Error syntax-error (format "%I32d" 1)) ;; This used to crash with bignum builds. -(Check-Error wrong-type-argument (format "%n" pi)) +(Check-Error (wrong-type-argument syntax-error) (format "%n" pi)) (Check-Error args-out-of-range (format (concat "%" (number-to-string most-positive-fixnum) diff -r 3130df547aa49dfcff4e7592d62613045471d3aa -r a4a1ae4830fadfd483403399af7d04b496b72138 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el ＠＠ -1564,26 +1564,27 ＠＠ (Check-Error range-error (round negative-infinity)) (Check-Error range-error (round positive-infinity 1)) (Check-Error range-error (round negative-infinity 1)) - (Check-Error range-error (ceiling not-a-number)) - (Check-Error range-error (ceiling not-a-number 1)) - (Check-Error range-error (floor not-a-number)) - (Check-Error range-error (floor not-a-number 1)) - (Check-Error range-error (round not-a-number)) - (Check-Error range-error (round not-a-number 1)) + (Check-Error (range-error domain-error) (ceiling not-a-number)) + (Check-Error (range-error domain-error) (ceiling not-a-number 1)) + (Check-Error (range-error domain-error) (floor not-a-number)) + (Check-Error (range-error domain-error) (floor not-a-number 1)) + (Check-Error (range-error domain-error) (round not-a-number)) + (Check-Error (range-error domain-error) (round not-a-number 1)) (Check-Error range-error (coerce positive-infinity 'fixnum)) (Check-Error range-error (coerce negative-infinity 'fixnum)) - (Check-Error range-error (coerce not-a-number 'fixnum)) + (Check-Error (range-error domain-error) (coerce not-a-number 'fixnum)) (Check-Error range-error (coerce positive-infinity 'integer)) (Check-Error range-error (coerce negative-infinity 'integer)) - (Check-Error range-error (coerce not-a-number 'integer)) + (Check-Error (range-error domain-error) (coerce not-a-number 'integer)) (when (ignore-errors (coerce 1 'ratio)) (Check-Error range-error (coerce positive-infinity 'ratio)) (Check-Error range-error (coerce negative-infinity 'ratio)) - (Check-Error range-error (coerce not-a-number 'ratio))) + (Check-Error (range-error domain-error) (coerce not-a-number 'ratio))) (when (ignore-errors (coerce 1 'bigfloat)) (Check-Error range-error (coerce positive-infinity 'bigfloat)) (Check-Error range-error (coerce negative-infinity 'bigfloat)) - (Check-Error range-error (coerce not-a-number 'bigfloat)))) + (Check-Error (range-error domain-error) + (coerce not-a-number 'bigfloat)))) (labels ((cl-floor (x &optional y) (let ((q (floor x y))) ＠＠ -3732,11 +3733,17 ＠＠ '(nil 0))) (Assert (eql (ignore-errors (parse-integer "100000000" :radix 16)) - (if (featurep 'bignum) (lsh 1 32) nil)) + (if (> (integer-length (1+ most-positive-fixnum)) + 30) + (lsh 1 32) + nil)) "checking an overflow bug has been fixed") (Assert (eql (ignore-errors (parse-integer "-100000000" :radix 16)) - (if (featurep 'bignum) (- (lsh 1 32)) nil)) + (if (> (integer-length (1+ most-positive-fixnum)) + 30) + (- (lsh 1 32)) + nil)) "checking an overflow bug has been fixed, negative int") (Assert (eql (ignore-errors (parse-integer (format "%d4/" most-negative-fixnum) diff -r 3130df547aa49dfcff4e7592d62613045471d3aa -r a4a1ae4830fadfd483403399af7d04b496b72138 tests/automated/syntax-tests.el --- a/tests/automated/syntax-tests.el +++ b/tests/automated/syntax-tests.el ＠＠ -210,85 +210,89 ＠＠ ;; syntax code, and passes with Alan's suggested patch ca. r5545. ;; #### The results of these tests are empirically determined, and will ;; probably change as the syntax cache is documented and repaired. -(with-temp-buffer - ;; buffer->syntax_cache in just-initialized state. - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "just initialized") - (Assert (= 1 (nth 1 sci)) nil "just initialized") - (Assert (= -1 (nth 2 sci)) nil "just initialized") - (Assert (= -1 (nth 3 sci)) nil "just initialized")) - ;; Alan's example uses ?/ not ?, but ?/ has Ssymbol syntax, which would - ;; mean it is treated the same as the letters by forward-sexp. - (insert ",regexp, {") - ;; Insertion updates markers, but not the cache boundaries. - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after main insert") - (Assert (= 11 (nth 1 sci)) nil "after main insert") - (Assert (= -1 (nth 2 sci)) nil "after main insert") - (Assert (= -1 (nth 3 sci)) nil "after main insert")) - ;; #### Interactively inserting in fundamental mode swaps marker positions! - ;; Why? - (insert "}") - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after brace insert") - (Assert (= 12 (nth 1 sci)) nil "after brace insert") - (Assert (= -1 (nth 2 sci)) nil "after brace insert") - (Assert (= -1 (nth 3 sci)) nil "after brace insert")) - ;; Motion that ignores the cache should not update the cache. - (goto-char (point-min)) - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after movement 0") - (Assert (= 12 (nth 1 sci)) nil "after movement 0") - (Assert (= -1 (nth 2 sci)) nil "after movement 0") - (Assert (= -1 (nth 3 sci)) nil "after movement 0")) - ;; Cache should be updated and global since no syntax-table property. - (forward-sexp 1) - (Assert (= (point) 8) nil "after 1st forward-sexp") - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after 1st forward-sexp") - (Assert (= 12 (nth 1 sci)) nil "after 1st forward-sexp") - (Assert (= 1 (nth 2 sci)) nil "after 1st forward-sexp") - (Assert (= 12 (nth 3 sci)) nil "after 1st forward-sexp")) - ;; Adding the text property should invalidate the cache. - (put-text-property 1 2 'syntax-table '(7)) - (let ((sci (syntax-cache-info))) - (Assert (= 1 (nth 0 sci)) nil "after putting property") - (Assert (= 1 (nth 1 sci)) nil "after putting property") - (Assert (= -1 (nth 2 sci)) nil "after putting property") - (Assert (= -1 (nth 3 sci)) nil "after putting property")) - (put-text-property 8 9 'syntax-table '(7)) - (goto-char (point-min)) - ;; Motion that is stopped by a syntax-table property should impose - ;; that property's region on the cache. - (forward-sexp 1) - (Assert (= (point) 9) nil "after 2d forward-sexp") - (let ((sci (syntax-cache-info))) - (Assert (= 8 (nth 0 sci)) nil "after 2d forward-sexp") - (Assert (= 9 (nth 1 sci)) nil "after 2d forward-sexp") - (Assert (= 8 (nth 2 sci)) nil "after 2d forward-sexp") - (Assert (= 9 (nth 3 sci)) nil "after 2d forward-sexp")) - ;; Narrowing warps point but does not affect the cache. - (narrow-to-region 10 12) - (Assert (= 10 (point)) nil "after narrowing") - (let ((sci (syntax-cache-info))) - (Assert (= 8 (nth 0 sci)) nil "after narrowing") - (Assert (= 9 (nth 1 sci)) nil "after narrowing") - (Assert (= 8 (nth 2 sci)) nil "after narrowing") - (Assert (= 9 (nth 3 sci)) nil "after narrowing")) - ;; Motion that is stopped by buffer's syntax table should capture - ;; the largest region known to not contain a change of syntax-table - ;; property. - (forward-sexp 1) - (let ((sci (syntax-cache-info))) - (Assert (= 10 (nth 0 sci)) nil "after 3d forward-sexp") - (Assert (= 12 (nth 1 sci)) nil "after 3d forward-sexp") - (Assert (= 10 (nth 2 sci)) nil "after 3d forward-sexp") - (Assert (= 12 (nth 3 sci)) nil "after 3d forward-sexp")) - (widen) - (goto-char (point-min)) - ;; Check that we still respect the syntax table properties. - (forward-sexp 1) - (Assert (= 9 (point)) nil "after widening")) +(Skip-Test-Unless + (fboundp 'syntax-cache-info) + "#'syntax-cache-info not available in this build" + "Check the syntax cache for consistency." + (with-temp-buffer + ;; buffer->syntax_cache in just-initialized state. + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "just initialized") + (Assert (= 1 (nth 1 sci)) nil "just initialized") + (Assert (= -1 (nth 2 sci)) nil "just initialized") + (Assert (= -1 (nth 3 sci)) nil "just initialized")) + ;; Alan's example uses ?/ not ?, but ?/ has Ssymbol syntax, which would + ;; mean it is treated the same as the letters by forward-sexp. + (insert ",regexp, {") + ;; Insertion updates markers, but not the cache boundaries. + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after main insert") + (Assert (= 11 (nth 1 sci)) nil "after main insert") + (Assert (= -1 (nth 2 sci)) nil "after main insert") + (Assert (= -1 (nth 3 sci)) nil "after main insert")) + ;; #### Interactively inserting in fundamental mode swaps marker positions! + ;; Why? + (insert "}") + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after brace insert") + (Assert (= 12 (nth 1 sci)) nil "after brace insert") + (Assert (= -1 (nth 2 sci)) nil "after brace insert") + (Assert (= -1 (nth 3 sci)) nil "after brace insert")) + ;; Motion that ignores the cache should not update the cache. + (goto-char (point-min)) + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after movement 0") + (Assert (= 12 (nth 1 sci)) nil "after movement 0") + (Assert (= -1 (nth 2 sci)) nil "after movement 0") + (Assert (= -1 (nth 3 sci)) nil "after movement 0")) + ;; Cache should be updated and global since no syntax-table property. + (forward-sexp 1) + (Assert (= (point) 8) nil "after 1st forward-sexp") + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after 1st forward-sexp") + (Assert (= 12 (nth 1 sci)) nil "after 1st forward-sexp") + (Assert (= 1 (nth 2 sci)) nil "after 1st forward-sexp") + (Assert (= 12 (nth 3 sci)) nil "after 1st forward-sexp")) + ;; Adding the text property should invalidate the cache. + (put-text-property 1 2 'syntax-table '(7)) + (let ((sci (syntax-cache-info))) + (Assert (= 1 (nth 0 sci)) nil "after putting property") + (Assert (= 1 (nth 1 sci)) nil "after putting property") + (Assert (= -1 (nth 2 sci)) nil "after putting property") + (Assert (= -1 (nth 3 sci)) nil "after putting property")) + (put-text-property 8 9 'syntax-table '(7)) + (goto-char (point-min)) + ;; Motion that is stopped by a syntax-table property should impose + ;; that property's region on the cache. + (forward-sexp 1) + (Assert (= (point) 9) nil "after 2d forward-sexp") + (let ((sci (syntax-cache-info))) + (Assert (= 8 (nth 0 sci)) nil "after 2d forward-sexp") + (Assert (= 9 (nth 1 sci)) nil "after 2d forward-sexp") + (Assert (= 8 (nth 2 sci)) nil "after 2d forward-sexp") + (Assert (= 9 (nth 3 sci)) nil "after 2d forward-sexp")) + ;; Narrowing warps point but does not affect the cache. + (narrow-to-region 10 12) + (Assert (= 10 (point)) nil "after narrowing") + (let ((sci (syntax-cache-info))) + (Assert (= 8 (nth 0 sci)) nil "after narrowing") + (Assert (= 9 (nth 1 sci)) nil "after narrowing") + (Assert (= 8 (nth 2 sci)) nil "after narrowing") + (Assert (= 9 (nth 3 sci)) nil "after narrowing")) + ;; Motion that is stopped by buffer's syntax table should capture + ;; the largest region known to not contain a change of syntax-table + ;; property. + (forward-sexp 1) + (let ((sci (syntax-cache-info))) + (Assert (= 10 (nth 0 sci)) nil "after 3d forward-sexp") + (Assert (= 12 (nth 1 sci)) nil "after 3d forward-sexp") + (Assert (= 10 (nth 2 sci)) nil "after 3d forward-sexp") + (Assert (= 12 (nth 3 sci)) nil "after 3d forward-sexp")) + (widen) + (goto-char (point-min)) + ;; Check that we still respect the syntax table properties. + (forward-sexp 1) + (Assert (= 9 (point)) nil "after widening"))) ;; #### Add the recipe in <yxzfymklb6p.fsf(a)gimli.holgi.priv> on xemacs-beta. ;; You also need to do a DELETE or type SPC to get the crash in 21.5.24. Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: 2017-11-07 Aidan Kehoe <kehoea@parhasard.net> 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/3130df547aa4/ Changeset: 3130df547aa4 User: kehoea Date: 2017-11-07 06:45:00+00:00 Summary: 2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> * configure.ac (XE_COMPLEX_ARG): Document that we default to the system malloc. * configure.ac: Implement this. Use src/gmalloc.c if --with-system-malloc=no was supplied, otherwise use the system malloc. Document that the right next step is to remove src/gmalloc.c, and to use __after_morecore_hook and malloc_set_state if those are available in the system malloc, not otherwise. * configure: Regenerate. Affected #: 3 files diff -r 92495f148d48c7e2fdfe53d7180fa14766e2afce -r 3130df547aa49dfcff4e7592d62613045471d3aa ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,16 ＠＠ +2017-11-07 Aidan Kehoe <kehoea(a)parhasard.net> + + * configure.ac (XE_COMPLEX_ARG): + Document that we default to the system malloc. + * configure.ac: + Implement this. Use src/gmalloc.c if --with-system-malloc=no was + supplied, otherwise use the system malloc. + Document that the right next step is to remove src/gmalloc.c, and + to use __after_morecore_hook and malloc_set_state if those are + available in the system malloc, not otherwise. + * configure: + Regenerate. + 2017-03-13 Aidan Kehoe <kehoea(a)parhasard.net> * ChangeLog: diff -r 92495f148d48c7e2fdfe53d7180fa14766e2afce -r 3130df547aa49dfcff4e7592d62613045471d3aa configure --- a/configure +++ b/configure ＠＠ -824,6 +824,7 ＠＠ docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir ＠＠ -1110,6 +1111,7 ＠＠ sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' ＠＠ -1362,6 +1364,15 ＠＠ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ ＠＠ -1499,7 +1510,7 ＠＠ for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. ＠＠ -1652,6 +1663,7 ＠＠ --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] ＠＠ -1960,8 +1972,7 ＠＠ --with-rel-alloc Enable the relocating allocator. --with-dlmalloc Use Doug Lea's malloc implementation. - --with-system-malloc Use the system malloc, not the one distributed with - XEmacs. + --with-system-malloc Use the system malloc, (default). --with-debug-malloc Use a debugging malloc. --with-pdump Enable portable LISP preloader. --with-dump-in-exec Enable dumping into executable (enabled by default ＠＠ -10266,33 +10277,20 ＠＠ -case "$opsys" in - darwin ) - if test "$with_system_malloc" = "default"; then - system_malloc=yes - with_system_malloc=yes - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Forcing system malloc on Darwin." >&5 -$as_echo "$as_me: WARNING: Forcing system malloc on Darwin." >&2;} - fi ;; -esac - -GNU_MALLOC=yes -if test "$with_dlmalloc" != "no"; then - doug_lea_malloc=yes -else - doug_lea_malloc=no -fi -after_morecore_hook_exists=yes -ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state" + +if test "$with_dlmalloc" = "yes"; then + ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state" if test "x$ac_cv_func_malloc_set_state" = xyes; then : - + doug_lea_malloc=yes else doug_lea_malloc=no fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5 + if test "$doug_lea_malloc" = "yes"; then + system_malloc=no + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5 $as_echo_n "checking whether __after_morecore_hook exists... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ extern void (* __after_morecore_hook)(); int ＠＠ -10306,38 +10304,45 ＠＠ if ac_fn_c_try_link "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - after_morecore_hook_exists=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -if test "$system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - - The GNU allocators don't work with this system configuration." -elif test "$with_system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - - User chose not to use GNU allocators." + after_morecore_hook_exists=yes +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + after_morecore_hook_exists=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + GNU_MALLOC=yes + $as_echo "#define DOUG_LEA_MALLOC 1" >>confdefs.h + + if test "$after_morecore_hook_exists" = "no" ; then + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the Linux C Library." + $as_echo "#define _NO_MALLOC_WARNING_ 1" >>confdefs.h + + else + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the GNU C Library." + fi + else + system_malloc=yes + fi elif test "$with_debug_malloc" = "yes" ; then + debug_malloc=yes + system_malloc=yes GNU_MALLOC=no GNU_MALLOC_reason=" - User chose to use Debugging Malloc." -fi - -if test "$doug_lea_malloc" = "yes" -a "$GNU_MALLOC" = "yes" ; then +elif test "$with_system_malloc" = "no" ; then + GNU_MALLOC=yes GNU_MALLOC_reason=" - - Using Doug Lea's new malloc from the GNU C Library." - $as_echo "#define DOUG_LEA_MALLOC 1" >>confdefs.h - - if test "$after_morecore_hook_exists" = "no" ; then - GNU_MALLOC_reason=" - - Using Doug Lea's new malloc from the Linux C Library." - $as_echo "#define _NO_MALLOC_WARNING_ 1" >>confdefs.h - - fi + - System malloc explicitly overridden." + system_malloc=no +else + GNU_MALLOC=no + GNU_MALLOC_reason=" + - Defaulting to system malloc." + system_malloc=yes fi ＠＠ -11821,7 +11826,7 ＠＠ We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; ＠＠ -11867,7 +11872,7 ＠＠ We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; ＠＠ -11891,7 +11896,7 ＠＠ We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; ＠＠ -11936,7 +11941,7 ＠＠ We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; ＠＠ -11960,7 +11965,7 ＠＠ We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; ＠＠ -22069,11 +22074,11 ＠＠ -if test "$with_system_malloc" = "yes"; then $as_echo "#define USE_SYSTEM_MALLOC 1" >>confdefs.h - -elif test "$with_debug_malloc" = "yes"; then $as_echo "#define USE_DEBUG_MALLOC 1" >>confdefs.h - - $as_echo "#define USE_SYSTEM_MALLOC 1" >>confdefs.h +if test "$debug_malloc" = "yes"; then $as_echo "#define USE_DEBUG_MALLOC 1" >>confdefs.h + + $as_echo "#define USE_SYSTEM_MALLOC 1" >>confdefs.h + +elif test "$system_malloc" = "yes"; then $as_echo "#define USE_SYSTEM_MALLOC 1" >>confdefs.h fi test "$GCC" = "yes" && $as_echo "#define USE_GCC 1" >>confdefs.h ＠＠ -22182,7 +22187,7 ＠＠ fi echo " libc version: $libc_version" echo " Relocating allocator for buffers: $with_rel_alloc" -echo " GNU version of malloc: ${GNU_MALLOC}${GNU_MALLOC_reason}" +echo " Using gmalloc.c from XEmacs: ${GNU_MALLOC}${GNU_MALLOC_reason}" case "$ld_switch_site" in *nocombreloc*) echo " Linking with \`-z nocombreloc'. - Consider configuring with --with-pdump." ;; diff -r 92495f148d48c7e2fdfe53d7180fa14766e2afce -r 3130df547aa49dfcff4e7592d62613045471d3aa configure.ac --- a/configure.ac +++ b/configure.ac ＠＠ -973,7 +973,7 ＠＠ AS_HELP_STRING([--with-dlmalloc],[Use Doug Lea's malloc implementation.]), [], [with_dlmalloc='default']) XE_MERGED_ARG([system-malloc], - AS_HELP_STRING([--with-system-malloc],[Use the system malloc, not the one distributed with XEmacs.]), + AS_HELP_STRING([--with-system-malloc],[Use the system malloc, (default).]), [], [with_system_malloc='default']) XE_MERGED_ARG([debug-malloc], AS_HELP_STRING([--with-debug-malloc],[Use a debugging malloc.]), ＠＠ -2533,56 +2533,51 ＠＠ dnl Do some misc autoconf-special tests dnl ----------------------------------- -dnl Can we use GNU malloc on this system? -dnl First, configure based-checks. -case "$opsys" in - darwin ) - if test "$with_system_malloc" = "default"; then - system_malloc=yes - with_system_malloc=yes - AC_MSG_WARN([Forcing system malloc on Darwin.]) - fi ;; -esac - -dnl Do the opsystem or machine files prohibit the use of the GNU malloc? -dnl Assume not, until told otherwise. -GNU_MALLOC=yes -if test "$with_dlmalloc" != "no"; then - doug_lea_malloc=yes -else - doug_lea_malloc=no -fi -after_morecore_hook_exists=yes -AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no) -AC_MSG_CHECKING(whether __after_morecore_hook exists) -AC_LINK_IFELSE([AC_LANG_PROGRAM([extern void (* __after_morecore_hook)();], - [__after_morecore_hook = 0])], - [AC_MSG_RESULT(yes)], - [AC_MSG_RESULT(no) - after_morecore_hook_exists=no]) -if test "$system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - - The GNU allocators don't work with this system configuration." -elif test "$with_system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - - User chose not to use GNU allocators." +dnl Default to the system malloc. The right thing here is to remove +dnl src/gmalloc.c entirely, and just autoconfiscate and use malloc_set_state +dnl and __after_morecore_hook and if they are available, otherwise no. But +dnl this is a reasonable first step. + +if test "$with_dlmalloc" = "yes"; then + AC_CHECK_FUNC(malloc_set_state, doug_lea_malloc=yes,doug_lea_malloc=no) + if test "$doug_lea_malloc" = "yes"; then + system_malloc=no + AC_MSG_CHECKING(whether __after_morecore_hook exists) + AC_LINK_IFELSE([AC_LANG_PROGRAM([extern void (* __after_morecore_hook)();], + [__after_morecore_hook = 0])], + [AC_MSG_RESULT(yes) + after_morecore_hook_exists=yes], + [AC_MSG_RESULT(no) + after_morecore_hook_exists=no]) + GNU_MALLOC=yes + AC_DEFINE(DOUG_LEA_MALLOC) + if test "$after_morecore_hook_exists" = "no" ; then + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the Linux C Library." + AC_DEFINE(_NO_MALLOC_WARNING_) + else + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the GNU C Library." + fi + else + system_malloc=yes + fi elif test "$with_debug_malloc" = "yes" ; then + debug_malloc=yes + system_malloc=yes GNU_MALLOC=no GNU_MALLOC_reason=" - User chose to use Debugging Malloc." -fi - -if test "$doug_lea_malloc" = "yes" -a "$GNU_MALLOC" = "yes" ; then +elif test "$with_system_malloc" = "no" ; then + GNU_MALLOC=yes GNU_MALLOC_reason=" - - Using Doug Lea's new malloc from the GNU C Library." - AC_DEFINE(DOUG_LEA_MALLOC) - if test "$after_morecore_hook_exists" = "no" ; then - GNU_MALLOC_reason=" - - Using Doug Lea's new malloc from the Linux C Library." - AC_DEFINE(_NO_MALLOC_WARNING_) - fi + - System malloc explicitly overridden." + system_malloc=no +else + GNU_MALLOC=no + GNU_MALLOC_reason=" + - Defaulting to system malloc." + system_malloc=yes fi dnl #### mcheck is broken in all versions of Linux libc and glibc. ＠＠ -5830,9 +5825,9 ＠＠ dnl so that the user gets immediate feedback on the results of the dnl autodetection. -if test "$with_system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) -elif test "$with_debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) - AC_DEFINE(USE_SYSTEM_MALLOC) +if test "$debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) + AC_DEFINE(USE_SYSTEM_MALLOC) +elif test "$system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) fi test "$GCC" = "yes" && AC_DEFINE(USE_GCC) test "$XEMACS_CC_GPP" = "yes" && AC_DEFINE(USE_GPLUSPLUS) ＠＠ -5931,7 +5926,7 ＠＠ fi echo " libc version: $libc_version" echo " Relocating allocator for buffers: $with_rel_alloc" -echo " GNU version of malloc: ${GNU_MALLOC}${GNU_MALLOC_reason}" +echo " Using gmalloc.c from XEmacs: ${GNU_MALLOC}${GNU_MALLOC_reason}" case "$ld_switch_site" in *nocombreloc*) echo " Linking with \`-z nocombreloc'. - Consider configuring with --with-pdump." ;; Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: Remove the last of the unified Big5 charset from the C code. 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/92495f148d48/ Changeset: 92495f148d48 User: kehoea Date: 2017-11-05 22:47:13+00:00 Summary: Remove the last of the unified Big5 charset from the C code. src/ChangeLog addition: 2017-11-05 Aidan Kehoe <kehoea(a)parhasard.net> * lisp.h: * fontcolor-xlike-inc.c: Remove the last references to the unified Vcharset_chinese_big5 charset, especially relevant with XFT. Thank you Stephen Turnbull and Raymond Toy! Affected #: 3 files diff -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 -r 92495f148d48c7e2fdfe53d7180fa14766e2afce src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -4,6 +4,14 ＠＠ Revert part of 417c790fd731, have this function return a list, never a cons. Thank you Raymond Toy! +2017-11-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * lisp.h: + * fontcolor-xlike-inc.c: + Remove the last references to the unified Vcharset_chinese_big5 + charset, especially relevant with XFT. Thank you Stephen Turnbull + and Raymond Toy! + 2017-10-28 Aidan Kehoe <kehoea(a)parhasard.net> * file-coding.c (handle_possible_error_octet): diff -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 -r 92495f148d48c7e2fdfe53d7180fa14766e2afce src/fontcolor-xlike-inc.c --- a/src/fontcolor-xlike-inc.c +++ b/src/fontcolor-xlike-inc.c ＠＠ -389,13 +389,9 ＠＠ { &Vcharset_hebrew_iso8859_8, "Hebrew", "he" }, /* #### probably close enough for Ukraine? */ { &Vcharset_cyrillic_iso8859_5, "Russian", "ru" }, -#ifdef UNICODE_INTERNAL - { &Vcharset_chinese_big5, "traditional Chinese", "zh-tw" }, -#else /* #### these probably are not quite right */ { &Vcharset_chinese_big5_1, "traditional Chinese", "zh-tw" }, { &Vcharset_chinese_big5_2, "traditional Chinese", "zh-tw" }, -#endif { NULL, NULL, NULL } }; diff -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 -r 92495f148d48c7e2fdfe53d7180fa14766e2afce src/lisp.h --- a/src/lisp.h +++ b/src/lisp.h ＠＠ -5792,12 +5792,10 ＠＠ extern Lisp_Object Vcharset_japanese_jisx0212; extern Lisp_Object Vcharset_chinese_cns11643_1; extern Lisp_Object Vcharset_chinese_cns11643_2; -#ifdef UNICODE_INTERNAL -extern Lisp_Object Vcharset_chinese_big5; -extern Lisp_Object Vcharset_japanese_shift_jis; -#else extern Lisp_Object Vcharset_chinese_big5_1; extern Lisp_Object Vcharset_chinese_big5_2; +#ifdef UNICODE_INTERNAL +extern Lisp_Object Vcharset_japanese_shift_jis; #endif /* UNICODE_INTERNAL */ extern Lisp_Object Vcharset_composite; #endif /* MULE */ Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/edit-utils: kehoea: Make `manual-entry' run asynchronously, increasing responsiveness. 7 years, 6 months

Bitbucket

1 new commit in edit-utils: https://bitbucket.org/xemacs/edit-utils/commits/759a527caec3/ Changeset: 759a527caec3 User: kehoea Date: 2017-11-05 14:58:10+00:00 Summary: Make `manual-entry' run asynchronously, increasing responsiveness. ChangeLog addition: 2017-11-05 Aidan Kehoe <kehoea(a)parhasard.net> * man.el: * man.el (Manual-switches): * man.el (Manual-mode-hook): * man.el (man-italic): * man.el (man-bold): * man.el (man-heading): * man.el (man-xref): * man.el (Manual-mode-map): * man.el (Manual-use-rosetta-man): Removed. * man.el (Manual-mode-xref-map): New. * man.el (Manual-unicode-to-char): New. * man.el (Manual-process-filter): New. * man.el (This function does four broad things): New. * man.el (manual-entry): * man.el (Manual-boldface-section-titles): New. * man.el (Manual-mode): * man.el (Manual-mode-and-display-buffer): New. * man.el (Manual-last-page): * man.el (Manual-delete-char): Removed. * man.el (Manual-nuke-nroff-bs): * man.el (Manual-nuke-nroff-bs-footers): * man.el (Manual-mouseify-xrefs): * man.el (Manual-follow-xref): * man.el (Manual-popup-menu): Extensive changes to this file. 1. Call `man' asynchronously, and display the output immediately as it starts to arrive. This gives a far more pleasant interactive experience with big man pages, in that XEmacs never becomes unresponsive dealing with a synchronous process output. 2. For those accented, punctuation and other non-ASCII characters that groff attempts to display using overstriking with ASCII characters, use mule characters instead, rather than just deleting them as the old code did. 3. Don't treat text like KSH(1) at the beginning and end of the file as a mouseable cross-reference, that is never the intention with it. 4. Fix problems with the interaction of Manual-mode-map and view-mode-minor-map, and make the implementation of Manual-last-page actually work, so l switches to another man page as is documented. 5. Make clickable hyperlinks respond to button1, return. 6. If there are no entries to show in the mode popup menu, give a menu showing that instead of erroring. Use #'menu-split-long-menu so the menu for big man pages isn't totally unwieldy. 7. Make `man-bold', `man-italic' inherit from the corresponding XEmacs faces, so they are distinctive by default. 8. Remove all mention of RosettaMan, now called PolyglotMan. This file doesn't actually work with it, and with an asynchronous implementation the speed benefit is not as important. Affected #: 2 files diff -r d71ad4063ecb9ad9015342592e7ad367759c7e3d -r 759a527caec38f15f925a523bfdd8d5918532fac ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,55 ＠＠ +2017-11-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * man.el: + * man.el (Manual-switches): + * man.el (Manual-mode-hook): + * man.el (man-italic): + * man.el (man-bold): + * man.el (man-heading): + * man.el (man-xref): + * man.el (Manual-mode-map): + * man.el (Manual-use-rosetta-man): Removed. + * man.el (Manual-mode-xref-map): New. + * man.el (Manual-unicode-to-char): New. + * man.el (Manual-process-filter): New. + * man.el (This function does four broad things): New. + * man.el (manual-entry): + * man.el (Manual-boldface-section-titles): New. + * man.el (Manual-mode): + * man.el (Manual-mode-and-display-buffer): New. + * man.el (Manual-last-page): + * man.el (Manual-delete-char): Removed. + * man.el (Manual-nuke-nroff-bs): + * man.el (Manual-nuke-nroff-bs-footers): + * man.el (Manual-mouseify-xrefs): + * man.el (Manual-follow-xref): + * man.el (Manual-popup-menu): + Extensive changes to this file. + 1. Call `man' asynchronously, and display the output immediately + as it starts to arrive. This gives a far more pleasant interactive + experience with big man pages, in that XEmacs never becomes + unresponsive dealing with a synchronous process output. + 2. For those accented, punctuation and other non-ASCII characters + that groff attempts to display using overstriking with ASCII + characters, use mule characters instead, rather than just deleting + them as the old code did. + 3. Don't treat text like KSH(1) at the beginning and end of the + file as a mouseable cross-reference, that is never the intention + with it. + 4. Fix problems with the interaction of Manual-mode-map and + view-mode-minor-map, and make the implementation of + Manual-last-page actually work, so l switches to another man page + as is documented. + 5. Make clickable hyperlinks respond to button1, return. + 6. If there are no entries to show in the mode popup menu, give a + menu showing that instead of erroring. Use #'menu-split-long-menu + so the menu for big man pages isn't totally unwieldy. + 7. Make `man-bold', `man-italic' inherit from the corresponding + XEmacs faces, so they are distinctive by default. + 8. Remove all mention of RosettaMan, now called PolyglotMan. This + file doesn't actually work with it, and with an asynchronous + implementation the speed benefit is not as important. + 2015-10-12 Norbert Koch <viteno(a)xemacs.org> * Makefile (VERSION): XEmacs package 2.57 released. diff -r d71ad4063ecb9ad9015342592e7ad367759c7e3d -r 759a527caec38f15f925a523bfdd8d5918532fac man.el --- a/man.el +++ b/man.el ＠＠ -50,13 +50,13 ＠＠ :group 'man) (defcustom Manual-switches nil - "List of switches to the man program." + "*List of switches to the man program." :type '(choice (const :tag "none" nil) (repeat (string :tag "switch"))) :group 'man) (defcustom Manual-mode-hook nil - "Function or functions run on entry to Manual-mode." + "*Function or functions run on entry to Manual-mode." :type 'hook :group 'man) ＠＠ -76,242 +76,686 ＠＠ :type 'boolean :group 'man) -;;Here is information on RosettaMan, from Neal.Becker(a)comsat.com (Neal Becker): - -;;RosettaMan is a filter for UNIX manual pages. It takes as input man -;;pages formatted for a variety of UNIX flavors (not [tn]roff source) -;;and produces as output a variety of file formats. Currently -;;RosettaMan accepts man pages as formatted by the following flavors of -;;UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, -;;DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following -;;formats: printable ASCII only (stripping page headers and footers), -;;section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF, -;;SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod. - -;;RosettaMan improves on other man page filters in several ways: (1) its -;;analysis recognizes the structural pieces of man pages, enabling high -;;quality output, (2) its modular structure permits easy augmentation of -;;output formats, (3) it accepts man pages formatted with the varient -;;macros of many different flavors of UNIX, and (4) it doesn't require -;;modification or cooperation with any other program. - -;;RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If -;;you haven't heard about TkMan, a hypertext man page browser, you -;;should grab it via anonymous ftp from ftp.cs.berkeley.edu: -;;/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for -;;TkMan, RosettaMan generalizes the process so that the analysis can be -;;leveraged to new output formats. A single analysis engine recognizes -;;section heads, subsection heads, body text, lists, references to other -;;man pages, boldface, italics, bold italics, special characters (like -;;bullets), tables (to a degree) and strips out page headers and -;;footers. The engine sends signals to the selected output functions so -;;that an enhancement in the engine improves the quality of output of -;;all of them. Output format functions are easy to add, and thus far -;;average about about 75 lines of C code each. - - - -;;*** NOTES ON CURRENT VERSION *** - -;;Help! I'm looking for people to help with the following projects. -;;\(1) Better RTF output format. The current one works, but could be -;;made better. (2) Roff macros that produce text that is easily -;;parsable. RosettaMan handles a great variety, but some things, like -;;H-P's tables, are intractable. If you write an output format or -;;otherwise improve RosettaMan, please send in your code so that I may -;;share the wealth in future releases. - -;;This version can try to identify tables (turn this on with the -T -;;switch) by looking for lines with a large amount of interword spacing, -;;reasoning that this is space between columns of a table. This -;;heuristic doesn't always work and sometimes misidentifies ordinary -;;text as tables. In general I think it is impossible to perfectly -;;identify tables from nroff formatted text. However, I do think the -;;heuristics can be tuned, so if you have a collection of manual pages -;;with unrecognized tables, send me the lot, in formatted form (i.e., -;;after formatting with nroff -man), and uuencode them to preserve the -;;control characters. Better, if you can think of heuristics that -;;distinguish tables from ordinary text, I'd like to hear them. - -;;Notes for HTML consumers: This filter does real (heuristic) -;;parsing--no <PRE>! Man page references are turned into hypertext links. - -(defcustom Manual-use-rosetta-man (locate-file "rman" exec-path) - "If non-nil, use RosettaMan (rman) to filter man pages. -This makes man-page cleanup virtually instantaneous, instead of -potentially taking a long time." - :type '(choice (symbol :tag "Do not use Rosettaman" nil) - (file :tag "RosettaMan Programm")) - :group 'man) - (defface man-italic '((t (:italic t))) "Manual italics face" :group 'man) +(set-face-parent 'man-italic 'italic nil '(default)) (defface man-bold '((t (:bold t))) "Manual bold face" :group 'man) +(set-face-parent 'man-bold 'bold nil '(default)) (defface man-heading '((t (:bold t))) "Manual headings face" :group 'man) +(set-face-parent 'man-heading 'bold nil '(default)) (defface man-xref '((t (:underline t))) - "Manual xrefs face" + "Manual cross-reference face" :group 'man) - +(set-face-parent 'man-xref 'underline nil '(default)) (defvar Manual-mode-map (let ((m (make-sparse-keymap))) (set-keymap-name m 'Manual-mode-map) + ;; See the entertainment in #'Manual-mode-and-display-buffer about this + ;; key binding: (define-key m "l" 'Manual-last-page) (define-key m 'button2 'Manual-follow-xref) (define-key m 'button3 'Manual-popup-menu) m)) +(defvar Manual-mode-xref-map + (let ((m (make-sparse-keymap))) + (set-keymap-parents m Manual-mode-map) + (define-key m "\C-m" 'Manual-follow-xref) + (define-key m 'button1 'Manual-follow-xref) + m)) + (defvar Manual-mode-syntax-table nil "Syntax table used in Manual-mode buffers") -(if Manual-mode-syntax-table - () +(unless Manual-mode-syntax-table (setq Manual-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?: "_" Manual-mode-syntax-table) (modify-syntax-entry ?+ "." Manual-mode-syntax-table) (modify-syntax-entry ?- "." Manual-mode-syntax-table) (modify-syntax-entry ?/ "." Manual-mode-syntax-table) - (modify-syntax-entry ?* "." Manual-mode-syntax-table) - ) + (modify-syntax-entry ?* "." Manual-mode-syntax-table)) + +(defun Manual-unicode-to-char (fixnum) + "Limited compatibility version of `unicode-to-char'. + +Falls back to `decode-char' with a `ucs' first argument if that is available; +otherwise uses those Greek and CJK characters available within every Mule +emacs to represent typographical and other non-ASCII characters +emulated by troff using backspace composition. + +Note that several of the characters needed have no equivalent in those XEmacs +versions where any Unicode support is provided by the mule-ucs package." + (let (acons) + (cond + ((< fixnum #x100) (int-char fixnum)) + ((and (fboundp 'decode-char) (decode-char 'ucs fixnum))) + ((and + (setq acons (assq fixnum '((#x0398 greek-iso8859-7 72) + (#x03a6 greek-iso8859-7 86) + (#x03a7 greek-iso8859-7 87) + (#x03b6 greek-iso8859-7 102) + (#x03b8 greek-iso8859-7 104) + (#x03bb greek-iso8859-7 107) + (#x03be greek-iso8859-7 110) + (#x03c0 greek-iso8859-7 112) + (#x03c3 greek-iso8859-7 115) + (#x03c4 greek-iso8859-7 116) + (#x03c8 greek-iso8859-7 120) + (#x2020 japanese-jisx0208 34 119) + (#x2021 japanese-jisx0208 34 120) + (#x2022 chinese-big5-1 33 38) + (#x2200 japanese-jisx0208 34 79) + (#x2191 japanese-jisx0208 34 44) + (#x2193 japanese-jisx0208 34 45) + (#x222b japanese-jisx0208 34 105) + (#x222b japanese-jisx0208 34 105) + (#x2286 japanese-jisx0208 34 60) + (#x2286 japanese-jisx0208 34 60) + (#x2287 japanese-jisx0208 34 61) + (#x2287 japanese-jisx0208 34 61) + (#x2295 chinese-cns11643-1 34 83) + (#x0444 cyrillic-iso8859-5 100)))) + (featurep 'mule) + (apply #'make-char (cdr acons)))) + ;; For the last no-mule user in the world, at least transform bullets to + ;; something readable: + ((cdr (assq fixnum + (load-time-value + (acons #x2022 (let ((extent (make-extent 0 1 "o"))) + (set-extent-face extent 'man-bold) + (set-extent-property extent 'duplicable t) + (set-extent-property extent 'unique t) + (extent-object extent)) nil)))))))) + +(defun Manual-process-filter (process string &optional flush) + "Handle process output from PROCESS, started from `manual-entry'. + +STRING reflects the most recent output from PROCESS. FLUSH, if supplied, +indicates thaat `Manual-process-filter' should not save any data from STRING +for processing on its next call. + +This function does four broad things: + +1. It interprets the tty sequences for underline, removes them, and applies + the `man-italic' face to the associated text. +2. It interprets the tty sequences for overstriking with the same character, + removes them, and applies the `man-bold' face to the associated text. +3. It interprets other groff sequences with backspace to construct accented + characters and other non-ASCII characters, and transforms them to the + appropriate XEmacs character. +4. It sets up cross-references to other man pages, which can be followed by + right clicking or by hitting `return'. + +In addition, the first time it is called for a given PROCESS, it tells XEmacs +to display the buffer; see `Manual-buffer-view-mode'." + (let* ((buffer (process-buffer process)) + (process-mark (process-mark process)) + (length (length string)) + (last 0) + position character-before character-after stashed extent lookup + extent-start-position) + (defvar #123456=#:Manual-stashed-strings nil) + (with-current-buffer buffer + (save-excursion + (macrolet + ;; The first four of these are macros rather than inline labels + ;; because the macro approach will actually lead to inline code on + ;; 21.4, whereas code with #'labels won't. + ((character-after (position) + `((lambda (position) + (incf position) + (if (< position length) (aref string position))) ,position)) + (character-before (position) + `((lambda (position) + (decf position) + (if (>= position 0) + (if (< position length) + (aref string position)) + (char-after (+ (point) position)))) ,position)) + (stash-string (string) + ;; This was implemented initially as a property of + ;; PROCESS. Unfortunately this doesn't work on 21.4. Then I + ;; implemented it as a buffer-local variable; unfortunately + ;; this doesn't work for the first stashed string, we have a + ;; longstanding bug in the first use of buffer local + ;; variables. An alist is cheap and portable. + `(setq #123456# (cons (cons process ,string) + (delete* process #123456# :key #'car)))) + (get-stashed-string () + `(prog1 + (cdr (assq process #123456#)) + (setq #123456# (delete* process #123456# :key #'car)))) + (adjust-or-make-extent (face-name extent-end-position + fail-early-unless) + `(if (and ,fail-early-unless + (setf extent (extent-at extent-start-position + buffer 'face nil + 'before)) + (eq ,face-name (extent-face extent))) + (prog1 extent (setf (extent-end-position extent) + ,extent-end-position)) + (prog1 (setf extent (make-extent extent-start-position + ,extent-end-position + buffer)) + (setf (extent-face extent) ,face-name)))) + (cond-with-handlers (&rest clauses &environment env) + (cons 'cond + (loop for clause in clauses + collect (if (assq (car-safe clause) env) + (macroexpand clause env) + clause)))) + (try-two-character-sequence (first second output) + `((and (eql character-before ,first) (eql character-after + ,second) + (load-time-value (Manual-unicode-to-char ,output))) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + (insert (load-time-value (Manual-unicode-to-char ,output))) + (incf position 2) + (setf last position))) + (try-two-characters-with-table (first alist) + `((and (eql character-before ,first) character-after + (setf lookup + (assq character-after + (load-time-value + (mapcan #'(lambda (cons) + (let ((character + (Manual-unicode-to-char + (cdr cons)))) + (if character + `((,(car cons) . + ,character))))) + ,alist))))) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + (insert (cdr lookup)) + (incf position 2) + (setf last position))) + (try-compose-map (first map) + `((and (eql character-before ,first) character-after + (fboundp ',map) + (setf lookup (lookup-key ',map character-after))) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + (insert + (if (consp (aref lookup 0)) + (car (aref lookup 0)) + (event-to-character + (make-event 'key-press `(key ,(aref lookup 0))) + nil nil t))) + (incf position 2) + (setf last position)))) + (if (marker-buffer process-mark) + (goto-char process-mark) + (set-marker process-mark (point) buffer)) + (when (eql (point) (point-min)) + (add-one-shot-hook + 'pre-idle-hook ;; This is more responsive for me than + ;; #'enqueue-eval-event. + `(lambda () (Manual-mode-and-display-buffer ,buffer)))) + (when (setf stashed (get-stashed-string)) + (let ((position 2)) + (symbol-macrolet ((do-not-end-with + ;; These make it more likely we would have + ;; to stash the end of the concatted + ;; string. + '(?\b ?_ ?| ?+))) + (while (and (< position length) + (or (member* (aref string position) + do-not-end-with) + (member* (aref string (1- position)) + do-not-end-with))) + (incf position))) + (setf position (min (1+ position) length)) + (Manual-process-filter process + (concat stashed + (substring string 0 position)) + flush) + (setf last (- position (length + (setf stashed (get-stashed-string))))) + (goto-char process-mark))) + (setf buffer-read-only nil) + (while (setf position (position ?\b string :start last :end length)) + (cond-with-handlers + ((eql (setf character-before (character-before position)) + (setf character-after (character-after position))) + ;; Bold, implemented in the TTY as overstriking with the same + ;; character. + (insert (substring string last position)) + (setf extent-start-position (1- (point))) + (incf position 2) + (while (and (< position length) + (eql (setf character-before (aref string position)) + (setf character-after + (character-after (1+ position)))) + (eql (aref string (1+ position)) ?\b)) + (insert character-before) + (incf position 3)) + ;; We don't have extra code to handle overstriking multiple + ;; times; that's fine, the loop with #'position above does + ;; that implicitly. + (setf extent (adjust-or-make-extent + 'man-bold (point) + (eql (character-before + (- position + (* 3 (- (point) extent-start-position)) + 1)) + ?\b)) + last position)) + ((and (eql character-before ?_) character-after) + ;; Underline; treat as italic + (insert (substring string last position)) + ;; We do insert-and-delete rather than substring the inserted + ;; string because that interacts better with stashed strings. + (delete-region (1- (point)) (point)) + (setf extent-start-position (point)) + (insert character-after) + (incf position 2) + (while (and (< position length) + (eql (aref string position) ?_) + (eql (character-after position) ?\b) + (setf character-after + (character-after (1+ position)))) + (insert character-after) + (incf position 3)) + ;; Manual-nuke-nroff-bs, below, worries about the ambiguity + ;; of _\b_. This code treats it as bold--it usually is + ;; bold--unless it is preceded immediately by italic + ;; characters. This gives reasonable results. + (setf extent (adjust-or-make-extent + 'man-italic (point) + (eql (character-before + (- position + (* 3 (- (point) extent-start-position)) + 1)) + ?\b)) + last position)) + ((and (eql character-after ?\b) character-before + (eql character-before (character-after (1+ position)))) + ;; Bolded CJK double-width characters. + (insert (substring string last position)) + (setf extent-start-position (1- (point))) + (setf extent (adjust-or-make-extent + 'man-italic (point) + (eql (character-before + (- position + (* 3 (- (point) extent-start-position)) + 1)) + ?\b)) + position (+ position 3) + last position)) + ;; From here onwards we're dealing with attempts of groff + ;; -mtty-char to create non-ASCII characters using ASCII + ;; primitives and overstriking. If troff has been invoked + ;; using -Tutf8 and if we understand UTF-8 none of the below + ;; will apply, and the code will never execute, absent corrupt + ;; data, because the first three clauses will have matched, so + ;; its performance impact is minimal. + (try-two-character-sequence ?+ ?o #x2022) ;; Bullet + (try-two-characters-with-table + ?| '((?^ . #x2191) ;; Uparrow + (?v . #x2193) ;; Downarrow + (?- . #x2020) ;; Dagger + (?= . #x2021) ;; Double dagger + (?u . #x03C8) ;; Psi + (?o . #x0444))) ;; Phi; use lowercase CYRILLIC SMALL + ;; LETTER EF, to force a glyph without a + ;; loop. + (try-compose-map ?\" compose-diaeresis-map) + (try-two-character-sequence ?\" ?_ #x030b) + (try-compose-map ?' compose-acute-map) + (try-two-character-sequence ?' ?\` #x0306) + ((and (eql character-before ?') + (eql character-after ?,) + (eql (character-after (1+ position)) ?\b) + (eql (character-after (+ position 2)) ?I) + (load-time-value (Manual-unicode-to-char #x222b))) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + (insert (load-time-value (Manual-unicode-to-char #x222b))) + (incf position 4) + (setf last position)) + (try-compose-map ?^ compose-circumflex-map) + (try-compose-map ?` compose-grave-map) + ((and (eql character-before ?`) + (eql character-after ?') + (eql (character-after (+ position 1)) ?\b) + (eql (character-after (+ position 2)) ?o)) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + (insert ?\xf0) ;; eth + (incf position 4) + (setf last position)) + (try-compose-map ?~ compose-tilde-map) + (try-two-characters-with-table + ?~ '((?_ . #xAC) ;; Logical not + (?t . #x03c4))) ;; Tau + (try-compose-map ?v compose-caron-map) + (try-compose-map ?/ compose-stroke-map) + (try-two-characters-with-table + ?/ '((?E . #x2209) ;; NOT AN ELEMENT OF + (?c . #xa2))) ;; CENT SIGN + (try-two-characters-with-table + ?, '((?C . #x03b6) ;; Zeta + (?E . #x03be) ;; GREEK SMALL LETTER XI + (?c . #xe7) ;; LATIN SMALL LETTER C WITH CEDILLA + (?f . #x0192) ;; LATIN SMALL LETTER F WITH HOOK + (?i . #xa1) ;; INVERTED EXCLAMATION MARK + (?u . #xb5))) ;; MICRO SIGN + (try-two-characters-with-table + ?- '((?0 . #x03B8) ;; GREEK SMALL LETTER THETA + (?D . #xd0) ;; LATIN CAPITAL LETTER ETH + (?L . #xa3) ;; POUND SIGN (sterling, that is) + (?O . #x0398) ;; GREEK CAPITAL LETTER THETA + (?V . #x2200) ;; FOR ALL + (?n . #x03C0) ;; GREEK SMALL LETTER PI + (?o . #x03C3) ;; GREEK SMALL LETTER SIGMA + (?w . #x03D6))) ;; GREEK PI SYMBOL + (try-two-characters-with-table + ?o '((?A . #xc5) ;; LATIN CAPITAL LETTER A WITH RING ABOVE + (?a . #xea) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX + (?x . #xa4))) ;; CURRENCY SIGN + (try-two-characters-with-table + ?= '((?Y . #xa5) ;; YEN SIGN + (?v . #x21d3) ;; DOWNWARDS DOUBLE ARROW + (?^ . #x21d1))) ;; UPWARDS DOUBLE ARROW + ((and (eql character-before ?=) + (eql character-after ?_) + (eql (character-before (1- position)) ?$) + (load-time-value (Manual-unicode-to-char #x2286))) + (insert (substring string last position)) + (delete-region (- (point) 2) (point)) + ;; Reflex subset + (insert (load-time-value (Manual-unicode-to-char #x2286))) + (incf position 2) + (setf last position)) + ((and (eql character-before ?=) + (eql character-after ?_) + (eql (character-after (1+ position)) ?$) + (load-time-value (Manual-unicode-to-char #x2287))) + (insert (substring string last position)) + (delete-region (1- (point)) (point)) + ;; Reflex superset + (insert (load-time-value (Manual-unicode-to-char #x2287))) + (incf position 3) + (setf last position)) + (try-two-character-sequence ?p ?b #xfe) + (try-two-characters-with-table + ?I '((?b . #xde) + (?O . #x03a6) + (?Y . #x03a7))) + (try-two-character-sequence ?> ?\\ #x03bb) ;; lambda + (try-two-characters-with-table + ?O '((?x . #x2297) ;; CIRCLED TIMES + (?+ . #x2295))) ;; CIRCLED PLUS + ((and (>= (+ position 3) length) (not flush)) + (stash-string (substring string position)) + (setf length position)) + ;; Let the clean-up below insert the trailing piece of the + ;; string. + (t + (incf position) + (insert (substring string last position)) + (setf last position)))) + (if (< last length) (insert (substring string last length))) + (goto-char process-mark) + (if (member "-k" + ;; #'process-command doesn't cons, to my surprise, no + ;; point saving whether this is an apropos or real + ;; man(1) call. + (process-command process)) + (progn + (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t) + (forward-char -2) + (delete-region (point) (1- (point)))) + (goto-char process-mark)) + (if (eql (point) (point-min)) + (progn + ;; Treat the first line as a heading. + (set-extent-face (make-extent (point) (point-at-eol)) + 'man-heading) + ;; Some of the Perl module man pages have ridiculously long + ;; titles, which groff chokes on for the title line, + ;; emitting backspaces with the intention of rubbing out an + ;; already-printed character. Handle that. + (while (re-search-forward "[^\b]\b" (point-at-eol) t) + (delete-region (match-beginning 0) (match-end 0))) + ;; Skip the top line of manual pages, but not apropos + ;; listings. + (forward-line 1)) + ;; Zap ESC7, ESC8, and ESC9 + ;; This is for Sun man pages like "man 1 csh" + (backward-char) + (while (re-search-forward "\e[789]" nil t) + (delete-region (match-beginning 0) (point))) + (goto-char process-mark))) + (if (position ?\) string :end length) ;; Can a cross-reference have + ;; ended in the text we just + ;; inserted? + (Manual-mouseify-xrefs (point) (point-max))) + (setf (marker-position process-mark) (point-max) + buffer-read-only t + (buffer-modified-p buffer) nil)))))) + +(defun Manual-boldface-section-titles () + "Mark subsection header lines bold in the current buffer. + +These are recognized heuristically as text in the first column following two +newlines, and followed by indented text on the next line. + +This function also handles the title lines of meta-manpages created with +troff's .so command, and extra backspaces that may have been inserted into the +final title line." + (labels ((delete-extent-mapper (extent ignore) (delete-extent extent))) + ;; + ;; Turn subsection header lines into bold. The first line is bolded + ;; separately in `Manual-process-filter'. + (goto-char (point-min)) + ;; Regexp to match section headers changed to match a non-indented + ;; line preceded by a blank line and followed by an indented line. + ;; This seems to work ok for manual pages but gives better results + ;; with other nroff'd files + ;; + ;; Most systems have indented text the next line after a section + ;; header, but some (Tru64) have an extra newline in between. + (while (re-search-forward "\n\n\$[^ \t\n].*\$\n\n?[ \t]+[^ \t\n]" nil + t) + (goto-char (match-end 1)) + ;; section headings are often highlighted by the man page + ;; author, but other parts of the man page are highlighted the + ;; same way, so make our lisp-deduced section header + ;; highlighting higher priority. This also avoids having + ;; section headers being _random_ly highlighted alternately by + ;; either man-heading or man-bold, which sure looks like a bug. + ;; And for user interface issues, if it looks like a bug, it + ;; _is_ a bug. + (set-extent-properties (make-extent (match-beginning 1) + (match-end 1)) + '(face man-heading priority 1)) + (forward-line 1)) + (goto-char (point-min)) + ;; If this man page is a meta-manpage created with .so (cf. zshall(1)), + ;; the individual sub-manpages have first-lines included that + ;; Manual-mouseify-xref has made into cross-references. These should + ;; really be treated as first lines and given the heading face. + (while (re-search-forward "\n\n\n\n[A-Z0-9_.:]+([0-9][^)]*)[^\n]*\n\n\n\n" + nil t) + (map-extents #'delete-extent-mapper nil (match-beginning 0) (match-end 0) + nil nil 'man) + (set-extent-face (make-extent (+ (match-beginning 0) (length "\n\n\n\n")) + (- (match-end 0) (length "\n\n\n\n"))) + 'man-heading)) + ;; Do the same thing for the very last line, which tends to get an xref + ;; extent when it shouldn't. + (goto-char (point-max)) + (backward-char) + (map-extents #'delete-extent-mapper nil (point-at-bol) (point-max) nil nil + 'man) + (set-extent-face (make-extent (point-at-bol) (point)) 'man-heading) + ;; Some of the Perl module man pages have ridiculously long titles, which + ;; groff chokes on for the title line, emitting backspaces with the + ;; intention of rubbing out an already-printed character. Handle that. + (beginning-of-line) + (while (re-search-forward "[^\b]\b" (point-max) t) + (delete-region (match-beginning 0) (match-end 0))))) ;;;###autoload -(defun manual-entry (topic &optional arg silent) - "Display the Unix manual entry (or entries) for TOPIC. +(defun manual-entry (topic) + "Display the Unix manual entry for TOPIC. + If TOPIC starts with -k, then a system apropos search is performed using man -k for TOPIC." (interactive - (list (let* ((default (save-excursion - (buffer-substring - (progn - (if (not (eobp)) - (forward-char)) - (if (re-search-backward "\\sw\\|\\s_" nil t) - (forward-char)) - (re-search-backward - "\$\\sw\\|\\s_\$([0-9]+[A-Za-z]*\\=" - (point-at-bol) t) - (skip-syntax-backward "w_") - (point)) - (progn - (skip-syntax-forward "w_") - (re-search-forward "\\=([0-9]+[A-Za-z]*)" nil t) - (point) )))) - (thing (read-string - (if (equal default "") "Manual entry: " - (concat "Manual entry: (default " default ") ")) - nil 'Manual-page-minibuffer-history))) - (if (equal thing "") default thing)) - (prefix-numeric-value current-prefix-arg))) - (let (buffer) - (or arg (setq arg 1)) + (list (let ((default (save-excursion + (buffer-substring + (progn + (if (not (eobp)) + (forward-char)) + (if (re-search-backward "\\sw\\|\\s_" nil t) + (forward-char)) + (re-search-backward + "\$\\sw\\|\\s_\$([0-9]+[A-Za-z]*\\=" + (point-at-bol) t) + (skip-syntax-backward "w_") + (point)) + (progn + (skip-syntax-forward "w_") + (re-search-forward "\\=([0-9]+[A-Za-z]*)" nil t) + (point)))))) + (read-string (if (equal default "") + "Manual entry: " + (concat "Manual entry (default " default "): ")) + nil 'Manual-page-minibuffer-history default)))) + (let (buffer section apropos-mode bufname) ;; Allow leading chapter numbers (if (string-match "\$[1-9n][a-zA-Z0-9]*\$ \$.*\$" topic) - (setq topic (replace-match "\\2(\\1)" t nil topic)) - ) - (let (section apropos-mode) - (let ((case-fold-search nil)) - (if (and (null section) - (string-match - "\\`[ \t]*\$[^( \t]+\$[ \t]*(\$.+\$)[ \t]*\\'" - topic)) - (setq section (match-string 2 topic) - topic (match-string 1 topic)) + (setq topic (replace-match "\\2(\\1)" t nil topic))) + (let ((case-fold-search nil)) + (if (and (null section) + (string-match + "\\`[ \t]*\$[^( \t]+\$[ \t]*(\$.+\$)[ \t]*\\'" + topic)) + (setq section (match-string 2 topic) + topic (match-string 1 topic)) (if (string-match "\\`[ \t]*-k[ \t]+\$[^ \t]+\$\\'" topic) (setq section "-k" topic (substring topic (match-beginning 1)))))) - - (when Manual-snip-subchapter - ;; jwz: turn section "3x11" and "3n" into "3". - (if (and section (string-match "\\`\$[0-9]+\$[^0-9]" section)) - (setq section (match-string 1 section)))) - - (if (or (equal section "-k") (member "-k" Manual-switches)) - (setq apropos-mode t)) - - (let ((bufname (concat "Man" - (when apropos-mode " apropos") - ": " topic - (when section (concat "(" section ")")))) - (temp-buffer-show-function - (cond ((eq 't Manual-buffer-view-mode) - 'view-buffer) - ((eq 'nil Manual-buffer-view-mode) - temp-buffer-show-function) - (t - 'view-buffer-other-window)))) - - (cond ((get-buffer bufname) - ;; reselect an old man page buffer if it exists already. - (save-excursion - (set-buffer (get-buffer bufname)) - (Manual-mode) - (setq buffer (current-buffer))) - (if temp-buffer-show-function - (funcall temp-buffer-show-function (get-buffer bufname)) - (display-buffer bufname))) - (t - (with-output-to-temp-buffer bufname - (buffer-disable-undo standard-output) - (save-excursion - (set-buffer standard-output) - (setq buffer-read-only nil) - (erase-buffer) + (when Manual-snip-subchapter + ;; jwz: turn section "3x11" and "3n" into "3". + (if (and section (string-match "\\`\$[0-9]+\$[^0-9]" section)) + (setq section (match-string 1 section)))) - (let ((args (append Manual-switches (list topic))) - args-string) - (if section - (setq args - (if (and (eq system-type 'usg-unix-v) - (null apropos-mode)) - (cons "-s" (cons section args)) - (cons section args)))) - (setq args-string - (mapconcat 'identity - (cons Manual-program args) " ")) - (if (string-match "\\`\$[^ \t/]*/\$+" args-string) - (setq args-string - (substring args-string (match-end 0)))) - - (message "%s (running...)" args-string) - (apply 'call-process Manual-program nil '(t nil) nil args) - - (if (< (buffer-size) (if apropos-mode 20 200)) - (progn - (kill-buffer (current-buffer)) - (error "%s not found" args-string))) - - (message "%s (cleaning...)" args-string) - (Manual-nuke-nroff-bs apropos-mode) - (message "%s (done.)" args-string)) - (set-buffer-modified-p nil) - (Manual-mode) - (setq buffer (current-buffer)))))) - (let ((page (if section - (concat topic "(" section ")") - topic))) - (setq Manual-page-history - (cons (buffer-name) - (delete (buffer-name) Manual-page-history)) - Manual-page-minibuffer-history - (cons page (delete page Manual-page-minibuffer-history)))))) - - (message nil) - buffer)) + (if (or (equal section "-k") (member "-k" Manual-switches)) + (setq apropos-mode t)) + (setq bufname (concat "Man" (when apropos-mode " apropos") ": " topic + (when section (concat "(" section ")")))) + (if (setq buffer (get-buffer bufname)) + ;; Reselect an old man page buffer if it exists already. + (Manual-mode-and-display-buffer buffer) + (let ((args (append (if section (list section)) Manual-switches + (list topic))) + (process-environment + (list* "EMACS=t" "MAN_KEEP_FORMATTING=1" + "PAGER=cat" ;; apropos doesn't obery MANPAGER + process-environment)) + (page (if section (concat topic "(" section ")") topic)) + process) + (with-current-buffer (setq buffer (get-buffer-create bufname)) + (buffer-disable-undo buffer) + (defvar #424242=#:saved-window-configuration) + (set (make-local-variable '#424242#) (current-window-configuration))) + (message (concat + (mapconcat 'identity + (cons (file-name-nondirectory Manual-program) + args) " ") + " (running...)")) + (setf Manual-page-minibuffer-history + (cons page (delete page Manual-page-minibuffer-history)) + process (apply #'start-process (concat "Manual (" topic ")") + (if (fboundp 'process-stderr-buffer) + (list buffer (generate-new-buffer + " *Manual-standard-error*")) + buffer) + Manual-program args) + (process-filter process) 'Manual-process-filter + (process-sentinel process) + (lambda (process message) + (let* ((buffer (process-buffer process)) saved-point + process-stderr-buffer process-command) + (labels + ((chomp-buffer-string (buffer) + (buffer-substring + (point-min buffer) + (if (eql (char-before (point-max buffer)) ?\n) + (1- (point-max buffer)) + (point-max buffer)) + buffer))) + (when (member (process-status process) '(signal exit)) + (if (not (fboundp 'process-stderr-buffer)) + ;; XEmacs 21.4, no way to tell stderr from stdout + (when (not (eql (process-exit-status process) 0)) + (error (prog1 + (chomp-buffer-string buffer) + (kill-buffer buffer)))) + (setq process-stderr-buffer + (process-stderr-buffer process)) + (if (eql (process-exit-status process) 0) + (if (> (buffer-size process-stderr-buffer) 0) + (display-warning 'alert + (buffer-string process-stderr-buffer))) + (set-window-configuration + (symbol-value-in-buffer '#424242# buffer)) + (error (prog1 + (chomp-buffer-string + process-stderr-buffer) + (kill-buffer buffer) + (kill-buffer process-stderr-buffer)))) + (kill-buffer process-stderr-buffer)) + (setq saved-point (point buffer)) + ;; Flush any stashed data. + (Manual-process-filter process "" t) + (save-excursion + (setf process-command (process-command process) + (current-buffer) buffer + buffer-read-only nil + #424242# nil) + ;; This can't be done in the process filter because it + ;; depends on the number of lines of the complete + ;; output: + (Manual-nuke-nroff-bs-footers) + (or (member "-k" process-command) + ;; And this is tough to do in the filter because + ;; of the extra need to stash text that might + ;; overlap, when determining where the section + ;; titles are. + (Manual-boldface-section-titles)) + ; (message "%s (done.)" args-string) + (setf buffer-read-only t) + (set-buffer-modified-p nil buffer) + (goto-char saved-point) + (setf Manual-page-history + (cons (buffer-name) + (delete (buffer-name) + Manual-page-history))))))))))) + buffer)) ;;;###autoload (define-key help-map "\C-m" 'manual-entry) (defun Manual-mode () + "Major mode for viewing Unix manual entries. See `manual-entry'." (kill-all-local-variables) (setq buffer-read-only t) (use-local-map Manual-mode-map) + (set (make-local-variable 'Manual-mode) t) (set-syntax-table Manual-mode-syntax-table) (setq major-mode 'Manual-mode mode-name "Manual") ＠＠ -330,31 +774,69 ＠＠ nil t) (run-hooks 'Manual-mode-hook)) +(defun Manual-mode-and-display-buffer (buffer) + "Call `Manual-mode' in BUFFER, and then display it. + +BUFFER is displayed as described in `Manual-buffer-view-mode'." + (when (buffer-name buffer) ;; If we don't have a separate stderr, and + ;; man(3) has errored, BUFFER may have been + ;; killed. Don't choke on this. + (save-excursion (set-buffer buffer) (Manual-mode)) + (funcall (case Manual-buffer-view-mode + ((t) 'view-buffer) + ((nil) (or temp-buffer-show-function 'display-buffer)) + (otherwise 'view-buffer-other-window)) + buffer) + ;; view-minor-mode-map is a suppressed keymap; that is, usually + ;; self-inserting characters are explicitly undefined, and this + ;; un-definition overrides further keymaps that are searched when + ;; processing a keystroke. This means that the Manual mode local map is + ;; ignored for key-presses. Work around this by adding it to the + ;; minor-mode-map-alist ahead of view-minor-mode-map. + ;; view-minor-mode-map probably shouldn't be a suppressed keymap. + (if (or (and (assq 'Manual-mode minor-mode-map-alist) + (assq 'view-minor-mode minor-mode-map-alist) + (< (position 'view-minor-mode minor-mode-map-alist :key #'car) + (position 'Manual-mode minor-mode-map-alist :key #'car))) + (not (assq 'Manual-mode minor-mode-map-alist))) + (setq minor-mode-map-alist + (acons 'Manual-mode Manual-mode-map + (delete* 'Manual-mode minor-mode-map-alist :key #'car)))))) + (defun Manual-last-page () + "Switch to the last manual entry buffer viewed." (interactive) - (if Manual-page-history - (let ((page (pop Manual-page-history))) - (if page - (progn - (get-buffer page) - (cons Manual-page-history page) - (switch-to-buffer page)))) - (error "No manual page buffers found. Use `M-x manual-entry'"))) - - -(defmacro Manual-delete-char (n) - ;; in v19, delete-char is compiled as a function call, but delete-region - ;; is byte-coded, so it's much faster. (We were spending 40% of our time - ;; in delete-char alone.) - `(delete-region (point) (+ (point) ,n))) + (let ((list Manual-page-history)) + (while (or (not + (get-buffer + (car + (or + list + (error + 'invalid-argument + (substitute-command-keys + (format + "No %smanual page buffers found. Use \\[manual-entry]." + (if (eq 'Manual-mode major-mode) "other " "")))))))) + (eq (get-buffer (car list)) (current-buffer))) + (setq list (cdr list))) + (setq Manual-page-history + (cons (car list) (delete (car list) Manual-page-history))) + (switch-to-buffer (car Manual-page-history)))) ;; Hint: BS stands for more things than "back space" ;;;###autoload (defun Manual-nuke-nroff-bs (&optional apropos-mode) + ;; This function doesn't work as a process filter, and is mostly deprecated; + ;; it is still in use by #'pager-cleanup-hook, below, but + ;; #'pager-cleanup-hook is mostly not in use. (interactive "*") - (if (and Manual-use-rosetta-man (not apropos-mode)) - (call-process-region (point-min) (point-max) - Manual-use-rosetta-man t t nil) + (macrolet + ((Manual-delete-char (n) + ;; in v19, delete-char is compiled as a function call, but + ;; delete-region is byte-coded, so it's much faster. (We were + ;; spending 40% of our time in delete-char alone.) + `(delete-region (point) (+ (point) ,n)))) ;; ;; turn underlining into italics ;; ＠＠ -418,8 +900,8 ＠＠ (while (search-forward "\b" nil t) (Manual-delete-char -2)) - (Manual-nuke-nroff-bs-footers) - ) ;; not Manual-use-rosetta-man + (Manual-nuke-nroff-bs-footers)) + ;; ;; turn subsection header lines into bold ;; ＠＠ -462,25 +944,38 ＠＠ (forward-line 1)) ) - (if Manual-use-rosetta-man - nil - ;; Zap ESC7, ESC8, and ESC9 - ;; This is for Sun man pages like "man 1 csh" - (goto-char (point-min)) - (while (re-search-forward "\e[789]" nil t) - (replace-match ""))) - - (Manual-mouseify-xrefs apropos-mode) - ) + ;; Zap ESC7, ESC8, and ESC9 + ;; This is for Sun man pages like "man 1 csh" + (goto-char (point-min)) + (while (re-search-forward "\e[789]" nil t) + (replace-match "")) + (Manual-mouseify-xrefs (point-min) (point-max))) ;;;###autoload (defalias 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name +(defun Manual-nuke-nroff-bs-footers () + "Remove page footers from nroff output, for on-screen display. -(defun Manual-nuke-nroff-bs-footers () - "For info see comments in packages/man.el" +Some implementations of man use nroff to produce `paginated' output with a +page size of 66 lines, of which several are devoted to the header and footer. +Each header and footer consists of 3 newlines, one informational line, and +either 3 additional newlines in the case of Solaris nroff, or 2 additional +newlines in the case of groff. + +Of course, pagination is an incredibly stupid idea for online information +presentation instead of printing to real paper, and so some system vendors +have chosen to improve on traditional behavior by providing non-paginated +output. We conservatively autodetect whether the output is in fact paginated. +Misdetection is still possible, but highly unlikely. For starters, the output +from man must accidentally be a multiple of 66 lines. + +Note that if nroff spits out error messages, pages will be more than 66 lines +high, and we'll misdetect page starts. That's ok because standard nroff +doesn't do any diagnostics, and the `gnroff' wrapper for groff turns off error +messages for compatibility. (At least, it's supposed to.)" + ;; Autodetect and nuke headers and footers in nroff output. - (goto-char (point-min)) ;; first lose the status output ＠＠ -497,26 +992,6 ＠＠ (if (looking-at " *done\n") (delete-region (point) (match-end 0))))) - ;; Some implementations of man use nroff to produce "paginated" - ;; output with a page size of 66 lines, of which several are devoted - ;; to the header and footer. Each header and footer consists of 3 - ;; newlines, one informational line, and either 3 additional - ;; newlines in the case of Solaris nroff, or 2 additional newlines - ;; in the case of groff. - ;; - ;; Of course, pagination is an incredibly stupid idea for online - ;; information presentation instead of printing to real paper, and - ;; so some system vendors have chosen to improve on traditional - ;; behavior by providing non-paginated output. We conservatively - ;; autodetect whether the output is in fact paginated. Misdetection - ;; is still possible, but highly unlikely. For starters, the output - ;; from man must accidentally be a multiple of 66 lines. - ;; - ;; Note that if nroff spits out error messages, pages will be more - ;; than 66 lines high, and we'll misdetect page starts. That's ok - ;; because standard nroff doesn't do any diagnostics, and the - ;; "gnroff" wrapper for groff turns off error messages for - ;; compatibility. (At least, it's supposed to.) (block nuke-headers-and-footers (let* ((page-starts '()) (solaris-pagination ; 66 - 2 * (3 + 1 + 3) = 52 ＠＠ -545,7 +1020,7 ＠＠ (looking-at pagination) ; guaranteed to match, by first pass. ;; Delete footers, except merely trim whitespace from the last one. - (if (= (match-end 0) (point-max)) + (if (eql (match-end 0) (point-max)) (progn ;; last footer ;; Leave exactly two newlines before last footer. ＠＠ -579,7 +1054,7 ＠＠ (insert ?\n)))))) ;; Delete headers, except merely trim whitespace from the first one. - (if (= page-start (point-min)) + (if (eql page-start (point-min)) ;; Leave exactly two newlines between first header and body. (delete-region (match-end 1) (save-excursion (goto-char (match-end 1)) ＠＠ -604,72 +1079,94 ＠＠ (delete-region (point-min) (save-excursion (goto-char (point-min)) (skip-chars-forward "\n") - (point))) - ) + (point)))) + +(defun Manual-mouseify-xrefs (begin end) + "Make the manual cross-references between BEGIN and END clickable. -(defun Manual-mouseify-xrefs (&optional apropos-mode) - (goto-char (point-min)) - ;; skip the top line of manual pages, but not apropos listings. - (unless apropos-mode (forward-line 1)) - (let ((case-fold-search nil) - s e name splitp extent) - ;; possibly it would be faster to rewrite this expression to search for - ;; a less common sequence first (like "([0-9]") and then back up to see - ;; if it's really a match. This function is 15% of the total time, 13% - ;; of which is this call to re-search-forward. - (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.:]*([0-9][a-zA-Z0-9]*)" - nil t) +Clicking on a cross-reference of the form `ls(1)' calls `manual-entry' with an +appropriate TOPIC argument." + (let ((case-fold-search nil) s e name extent re-search-forward + found section-length) + (goto-char begin) + (while (progn + (while (and (not found) + (setq re-search-forward + (re-search-forward "([0-9]" end t))) + (goto-char (- (point) (length "(1"))) + (if (eql (skip-chars-backward "-a-zA-Z0-9_.:") 0) + ;; Don't limit the above #'skip-chars-forward by BEGIN, + ;; there may be parts of the command name before that. + (goto-char re-search-forward) + (if (looking-at + ;; This function used to just #'re-search-forward for + ;; the following regexp. It takes about a third of the + ;; time to #'re-search-forward for the shorter + ;; expression, above, and then to back up. + ;; + ;; This is reduced further by only calling + ;; #'Manual-mouseify-xrefs if there is a close + ;; parenthesis in the string supplied to + ;; #'Manual-process-filter; see that latter function. + "[a-zA-Z_][-a-zA-Z0-9_.:]*\$([0-9][a-zA-Z0-9]*)\$") + (setq found t) + (goto-char re-search-forward)))) + re-search-forward) (setq s (match-beginning 0) e (match-end 0) name (buffer-substring s e) - splitp nil) + section-length (- (match-end 1) (match-beginning 1)) + found nil) ;; Let the loop above continue next time around. - (goto-char s) - ;; if this is a hyphenated xref, we're on the second line, 1st char now. + ;; If there could be upper case letters in the section, downcase them. + (if (> section-length (length "(1)")) + (setq name (concat (substring name 0 (- section-length)) + (downcase (substring name (- section-length)))))) + + ;; If this is a hyphenated xref, we're on the second line, first char + ;; now. Deal with the part of the xref on the previous line. (when (progn (beginning-of-line) - (and (looking-at (concat "^[ \t]+" (regexp-quote name))) - (progn - (backward-char 1) - (or (equal (char-before) ?-) - (equal (char-before) ?\255))) - (setq s (progn - (skip-chars-backward "-\255_a-zA-Z0-9") - (point)) - name (buffer-substring s e)))) - (setq splitp t) - ;; delete the spaces and dash from `name' - (let (i) - (while (setq i (string-match "[-\255 \n\t]+" name i)) - (setq name (concat (substring name 0 i) - (substring name (match-end 0))) - i (1+ i))))) - - ;; if there are upper case letters in the section, downcase them. - (if (string-match "(.*[A-Z]+.*)$" name) - (setq name (concat (substring name 0 (match-beginning 0)) - (downcase (substring name (match-beginning 0)))))) - - ;; if the xref was hyphenated, don't highlight the indention spaces. - (if splitp - (progn - (setq extent (make-extent s (progn (goto-char s) (end-of-line) (point)))) - (set-extent-property extent 'man (list 'Manual-follow-xref name)) - (set-extent-property extent 'highlight t) - (set-extent-face extent 'man-xref) - (goto-char e) - (skip-chars-backward "-_a-zA-Z0-9()") - (setq extent (make-extent (point) e))) - (setq extent (make-extent s e))) - (set-extent-property extent 'man (list 'Manual-follow-xref name)) - (set-extent-property extent 'highlight t) - (set-extent-face extent 'man-xref) - (goto-char e)))) + (and (member* (char-before (1- (point))) '(?- ?\255)) + (looking-at (concat "^[ \t]+" (regexp-quote name))))) + (setf extent + ;; Make an extent just for the bit on the previous line. Either + ;; order for FROM, TO for the args is fine. + (make-extent + (progn (backward-char) (point)) + (progn (skip-chars-backward "-\255a-zA-Z0-9_.:") (point))) + ;; Construct the concatenated name, including the bits on both + ;; lines. Don't include the trailing ?- or ?\255 from this line. + name (concat (buffer-substring (point) (1- (point-at-eol))) + name) + ;; Now set the properties of this constructed extent. + (extent-property extent 'man) `(Manual-follow-xref ,name) + (extent-property extent 'highlight) t + (extent-property extent 'keymap) Manual-mode-xref-map + (extent-face extent) 'man-xref)) + ;; Create an extent reflecting the original matched regexp, using the + ;; NAME (possibly de-hyphenated). Create the appropriate interactive + ;; properties. + (setf extent (make-extent s e) + (extent-property extent 'man) `(Manual-follow-xref ,name) + (extent-property extent 'highlight) t + (extent-property extent 'keymap) Manual-mode-xref-map + (extent-face extent) 'man-xref) + (goto-char (min e (or re-search-forward 1)))))) (defun Manual-follow-xref (&optional name-or-event) "Invoke `manual-entry' on the cross-reference under the mouse. -When invoked noninteractively, the arg may be an xref string to parse instead." - (interactive "e") + +When invoked noninteractively, NAME-OR-EVENT may be a cross-reference string +to parse instead." + (interactive + (list (or current-mouse-event ;; also reflects current misc-user events + (and (eql last-command-char ?\C-m) + (let* ((extent (extent-at (point) nil 'man)) + (data (and extent (extent-property extent + 'man)))) + (and (eq 'Manual-follow-xref (car-safe data)) + (cadr data))))))) (if (eventp name-or-event) (let* ((p (event-point name-or-event)) (extent (and p (extent-at p ＠＠ -677,56 +1174,45 ＠＠ 'highlight))) (data (and extent (extent-property extent 'man)))) (if (eq (car-safe data) 'Manual-follow-xref) - (eval data) + (apply 'Manual-follow-xref (cdr data)) (error "no manual cross-reference there."))) - (or (manual-entry name-or-event) - ;; If that didn't work, maybe it's in a different section than the - ;; man page writer expected. For example, man pages tend assume - ;; that all user programs are in section 1, but X tends to generate - ;; makefiles that put things in section "n" instead... - (and (string-match "[ \t]*([^)]+)\\'" name-or-event) - (progn - (message "No entries found for %s; checking other sections..." - name-or-event) - (manual-entry - (substring name-or-event 0 (match-beginning 0)) - nil t)))))) + (manual-entry name-or-event))) -(defun Manual-popup-menu (&optional event) - "Pops up a menu of cross-references in this manual page. +(defun Manual-popup-menu (event) + "Pop up a menu of cross-references in this manual page. + If there is a cross-reference under the mouse button which invoked this command, it will be the first item on the menu. Otherwise, they are -on the menu in the order in which they appear in the buffer." +qon the menu in the order in which they appear in the buffer." (interactive "e") - (let ((buffer (current-buffer)) - (sep "---") - xref items) - (cond (event - (setq buffer (event-buffer event)) - (let* ((p (event-point event)) - (extent (and p (extent-at p buffer 'highlight))) - (data (and extent (extent-property extent 'man)))) - (if (eq (car-safe data) 'Manual-follow-xref) - (setq xref (nth 1 data)))))) - (if xref (setq items (list sep xref))) + (let* ((buffer (event-buffer event)) + (p (event-point event)) + (extent (and p (extent-at p buffer 'highlight))) + (data (and extent (extent-property extent 'man))) + (xref (and (eq (car-safe data) 'Manual-follow-xref) data)) + (sep "---") + (items (if xref (list xref)))) (map-extents #'(lambda (extent ignore) (let ((data (extent-property extent 'man))) (if (and (eq (car-safe data) 'Manual-follow-xref) - (not (member (nth 1 data) items))) - (setq items (cons (nth 1 data) items))) - nil)) - buffer) - (if (eq sep (car items)) (setq items (cdr items))) - (let ((popup-menu-titles t)) - (and (null items) (setq popup-menu-titles nil)) - (popup-menu - (cons "Manual Entry" - (mapcar #'(lambda (item) - (if (eq item sep) - item - (vector item - (list 'Manual-follow-xref item) t))) - (nreverse items))))))) + (not (member data items))) + (setq items (cons data items))) + nil)) + buffer nil nil nil nil 'man) + (popup-menu + (if items + `("Manual Entry" + ,＠(if xref `([,(cadr xref) ,xref t] ,sep)) + ,＠(menu-split-long-menu + (loop for item in (delete* xref items) + with result = nil + do (setq result + (cons (if (eq item sep) + item + (vector (cadr item) item t)) + result)) + finally return result))) + '("Manual Entry" ["No cross-references in this buffer" nil nil]))))) (defun pager-cleanup-hook () "cleanup man page if called via $PAGER" ＠＠ -759,3 +1245,5 ＠＠ (add-hook 'server-visit-hook 'pager-cleanup-hook) (provide 'man) + +;;; man.el ends here Repository URL: https://bitbucket.org/xemacs/edit-utils/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/cc-mode: acm: Introduce a function to CC Mode which displays the current function name 7 years, 6 months

Bitbucket

1 new commit in cc-mode: https://bitbucket.org/xemacs/cc-mode/commits/c4233994df9a/ Changeset: c4233994df9a User: acm Date: 2017-11-03 19:23:39+00:00 Summary: Introduce a function to CC Mode which displays the current function name Remove an erroneous interactive specification from two functions. * cc-cmds.el (c-display-defun-name): New command. (c-defun-name, c-cpp-define-name): Remove interactive specification. * cc-mode.el (c-mode-base-map): Add binding C-c C-z for the new command. * cc-mode.texi (Other Commands): Add documentation for the new command. Affected #: 3 files diff -r a63d84d98dedcefec044dfec5e286b57ad4f79ce -r c4233994df9a33d8455917fb88c16c1492402ab0 cc-cmds.el --- a/cc-cmds.el +++ b/cc-cmds.el ＠＠ -1776,7 +1776,6 ＠＠ "Return the name of the current defun, or NIL if there isn't one. \"Defun\" here means a function, or other top level construct with a brace block." - (interactive) (c-save-buffer-state (beginning-of-defun-function end-of-defun-function where pos name-end case-fold-search) ＠＠ -1985,6 +1984,23 ＠＠ (eq (char-after) ?\{) (cons (point-min) (point-max)))))))) +(defun c-display-defun-name (&optional arg) + "Display the name of the current CC mode defun and the position in it. +With a prefix arg, push the name onto the kill ring too." + (interactive "P") + (save-restriction + (widen) + (c-save-buffer-state ((name (c-defun-name)) + (limits (c-declaration-limits t)) + (point-bol (c-point 'bol))) + (when name + (message "%s. Line %s/%s." name + (1+ (count-lines (car limits) point-bol)) + (count-lines (car limits) (cdr limits))) + (if arg (kill-new name)) + (sit-for 3 t))))) +(put 'c-display-defun-name 'isearch-scroll t) + (defun c-mark-function () "Put mark at end of the current top-level declaration or macro, point at beginning. If point is not inside any then the closest following one is ＠＠ -2033,7 +2049,6 ＠＠ (defun c-cpp-define-name () "Return the name of the current CPP macro, or NIL if we're not in one." - (interactive) (let (case-fold-search) (save-excursion (and c-opt-cpp-macro-define-start diff -r a63d84d98dedcefec044dfec5e286b57ad4f79ce -r c4233994df9a33d8455917fb88c16c1492402ab0 cc-mode.el --- a/cc-mode.el +++ b/cc-mode.el ＠＠ -371,7 +371,8 ＠＠ ;;(define-key c-mode-base-map "\C-c\C-v" 'c-version) ;; (define-key c-mode-base-map "\C-c\C-y" 'c-toggle-hungry-state) Commented out by ACM, 2005-11-22. (define-key c-mode-base-map "\C-c\C-w" 'c-subword-mode) - (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style)) + (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style) + (define-key c-mode-base-map "\C-c\C-z" 'c-display-defun-name)) ;; We don't require the outline package, but we configure it a bit anyway. (cc-bytecomp-defvar outline-level) diff -r a63d84d98dedcefec044dfec5e286b57ad4f79ce -r c4233994df9a33d8455917fb88c16c1492402ab0 cc-mode.texi --- a/cc-mode.texi +++ b/cc-mode.texi ＠＠ -1761,6 +1761,7 ＠＠ see ＠ref{Indentation Commands} and ＠ref{Filling and Breaking}. For details of the ＠ccmode{} style system, see ＠ref{Styles}. + ＠item ＠kbd{C-c :} (＠code{c-scope-operator}) ＠kindex C-c : ＠findex c-scope-operator ＠＠ -1769,6 +1770,18 ＠＠ operator without performing the electric behavior of colon insertion. ＠kbd{C-c :} does just this. +＠item ＠kbd{C-c C-z} (＠code{c-display-defun-name}) +＠kindex C-c C-z +＠findex c-display-defun-name +＠findex display-defun-name (c-) +Display the current function name, if any, in the minibuffer. +Additionally, if a prefix argument is given, push the function name to +the kill ring. If there is no current function, +＠code{c-display-defun-name} does nothing. In Emacs, you can use this +command in the middle of an interactive search if you set the +customizable option ＠code{isearch-allow-scoll} to non-＠code{nil}. +＠xref{Not Exiting Isearch,,,emacs, GNU Emacs Manual}. + ＠item ＠kbd{C-c C-\} (＠code{c-backslash-region}) ＠kindex C-c C-\ ＠findex c-backslash-region Repository URL: https://bitbucket.org/xemacs/cc-mode/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

commit/XEmacs: kehoea: Have make_time() return a true list, not a cons, thank you Raymond Toy! 7 years, 6 months

Bitbucket

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/51ad3b1a1b92/ Changeset: 51ad3b1a1b92 User: kehoea Date: 2017-11-02 21:38:04+00:00 Summary: Have make_time() return a true list, not a cons, thank you Raymond Toy! src/ChangeLog addition: 2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> * editfns.c (make_time): Revert part of 417c790fd731, have this function return a list, never a cons. Thank you Raymond Toy! tests/ChangeLog addition: 2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> * automated/os-tests.el: We've reverted to returning a list, not a cons, in #'encode-time. Update tests to reflect this, thank you Raymond Toy. Affected #: 4 files diff -r efa8f1377817cf7f529bbd39b58857c7675c59ad -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,9 ＠＠ +2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> + + * editfns.c (make_time): + Revert part of 417c790fd731, have this function return a list, + never a cons. Thank you Raymond Toy! + 2017-10-28 Aidan Kehoe <kehoea(a)parhasard.net> * file-coding.c (handle_possible_error_octet): diff -r efa8f1377817cf7f529bbd39b58857c7675c59ad -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 src/editfns.c --- a/src/editfns.c +++ b/src/editfns.c ＠＠ -1182,7 +1182,7 ＠＠ Lisp_Object make_time (time_t tiempo) { - return Fcons (make_fixnum (tiempo < 0 ? tiempo / 0x10000 : tiempo >> 16), + return list2 (make_fixnum (tiempo < 0 ? tiempo / 0x10000 : tiempo >> 16), make_fixnum (tiempo & 0xFFFF)); } diff -r efa8f1377817cf7f529bbd39b58857c7675c59ad -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,10 ＠＠ +2017-11-02 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/os-tests.el: + We've reverted to returning a list, not a cons, in + #'encode-time. Update tests to reflect this, thank you Raymond + Toy. + 2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net> * automated/lisp-tests.el: diff -r efa8f1377817cf7f529bbd39b58857c7675c59ad -r 51ad3b1a1b9288836a9efba679cc7141495c9e35 tests/automated/os-tests.el --- a/tests/automated/os-tests.el +++ b/tests/automated/os-tests.el ＠＠ -127,9 +127,9 ＠＠ (Check-Error args-out-of-range (encode-time 24 4 20 11 5 2017 -86401)) (Assert (equal (encode-time 24 4 20 11 5 2017 -86400) - '(22806 . 5448))) ;; "05/12/17 09:04:25 PM" + '(22806 5448))) ;; "05/12/17 09:04:25 PM" (Assert (equal (encode-time 24 4 20 11 5 2017 86400) - '(22803 . 29256))) ;; "05/10/17 09:04:24 PM" + '(22803 29256))) ;; "05/10/17 09:04:24 PM" (Check-Error args-out-of-range (encode-time 24 4 20 11 5 2017 86401)) ;;; end of os-tests.el Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email.

1 participants
0 comments

2025

2024

2023

2022

2021

2020

2019

2018

2017

XEmacs-commits November 2017