view lib-src/make-msgfile.c @ 4678:b5e1d4f6b66f

Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp. lisp/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (ceiling*, floor*, round*, truncate*): Implement these in terms of the C functions; mark them as obsolete. (mod*, rem*): Use #'nth-value with the C functions, not #'nth with the CL emulation functions. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * lispref/numbers.texi (Bigfloat Basics): Correct this documentation (ignoring for the moment that it breaks off in mid-sentence). tests/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test the new Common Lisp-compatible rounding functions available in C. (generate-rounding-output): Provide a function useful for generating the data for the rounding functions tests. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES) (CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM) (MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO) (MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT) (MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER): New macros, used in the implementation of the rounding functions. (ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio) (ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat) (ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg) (floor_two_fixnum, floor_two_bignum, floor_two_ratio) (floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat) (floor_two_float, floor_one_mundane_arg, round_two_fixnum) (round_two_bignum_1, round_two_bignum, round_two_ratio) (round_one_bigfloat_1, round_two_bigfloat, round_one_ratio) (round_one_bigfloat, round_two_float, round_one_float) (round_one_mundane_arg, truncate_two_fixnum) (truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat) (truncate_one_ratio, truncate_one_bigfloat, truncate_two_float) (truncate_one_float, truncate_one_mundane_arg): New functions, used in the implementation of the rounding functions. (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor) (Ffround, Fftruncate): Revise to fully support Common Lisp conventions. This means: -- All functions have optional DIVISOR arguments -- All functions return multiple values; see #'values -- All functions do their arithmetic with the correct number types according to the contamination rules. -- #'round and #'fround always round towards the even number in ambiguous cases. * doprnt.c (emacs_doprnt_1): * number.c (internal_coerce_number): Call Ftruncate with two arguments, not one. * floatfns.c (Ffloat): Correct this, if NUMBER is a bignum. * lisp.h: Declare Ftruncate as taking two arguments. * number.c: Provide scratch_ratio2, init it appropriately. * number.h: Make scratch_ratio2 available. * number.h (BIGFLOAT_ARITH_RETURN): * number.h (BIGFLOAT_ARITH_RETURN1): Correct these functions.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 11 Aug 2009 17:59:23 +0100
parents ecf1ebac70d8
children
line wrap: on
line source

/* #### Old code!  Replaced with make-msgfile.lex. */


/* Scan specified C and Lisp files, extracting the following messages:

     C files:
	GETTEXT (...)
	DEFER_GETTEXT (...)
	DEFUN interactive prompts
     Lisp files:
	(gettext ...)
	(dgettext "domain-name" ...)
	(defer-gettext ...)
	(interactive ...)

  The arguments given to this program are all the C and Lisp source files
  of XEmacs.  .el and .c files are allowed.  There is no support for .elc
  files at this time, but they may be specified; the corresponding .el file
  will be used.  Similarly, .o files can also be specified, and the corresponding
  .c file will be used.  This helps the makefile pass the correct list of files.

  The results, which go to standard output or to a file specified with -a or -o
  (-a to append, -o to start from nothing), are quoted strings wrapped in
  gettext(...).  The results can be passed to xgettext to produce a .po message
  file.
*/

#include <stdio.h>
#include <string.h>

#define LINESIZE 256
#define GET_LINE	fgets (line, LINESIZE, infile)
#define CHECK_EOL(p)	if (*(p) == '\0')  (p) = GET_LINE
#define SKIP_BLANKS(p)	while ((*p) == ' ' || (*p) == '\t')  (p)++

enum filetype { C_FILE, LISP_FILE, INVALID_FILE };
/* some brain-dead headers define this ... */
#undef FALSE
#undef TRUE
enum boolean { FALSE, TRUE };

FILE *infile;
FILE *outfile;
char line[LINESIZE];


void scan_file (char *filename);
void process_C_file (void);
void process_Lisp_file (void);
char *copy_up_to_paren (register char *p);
char *copy_quoted_string (register char *p);
enum boolean no_interactive_prompt (register char *q);
char *skip_blanks (register char *p);


main (int argc, char *argv[])
{
  register int i;

  outfile = stdout;

  /* If first two args are -o FILE, output to FILE. */
  i = 1;
  if (argc > i + 1 && strcmp (argv[i], "-o") == 0) {
    outfile = fopen (argv[++i], "w");
    ++i;
  }
  /* ...Or if args are -a FILE, append to FILE. */
  if (argc > i + 1 && strcmp (argv[i], "-a") == 0) {
    outfile = fopen (argv[++i], "a");
    ++i;
  }
  if (!outfile) {
    fprintf (stderr, "Unable to open output file %s\n", argv[--i]);
    return;
  }

  for (; i < argc; i++)
    scan_file (argv[i]);

  return 0;
}


void scan_file (char *filename)
{
  enum filetype type = INVALID_FILE;
  register char *p = filename + strlen (filename);

  if (strcmp (p - 4, ".elc") == 0) {
    *--p = '\0';				/* Use .el file instead */
    type = LISP_FILE;
  } else if (strcmp (p - 3, ".el") == 0)
    type = LISP_FILE;
  else if (strcmp (p - 2, ".o") == 0) {
    *--p = 'c';					/* Use .c file instead */
    type = C_FILE;
  } else if (strcmp (p - 2, ".c") == 0)
    type = C_FILE;

  if (type == INVALID_FILE) {
    fprintf (stderr, "File %s being ignored\n", filename);
    return;
  }
  infile = fopen (filename, "r");
  if (!infile) {
    fprintf (stderr, "Unable to open input file %s\n", filename);
    return;
  }

  fprintf (outfile, "/* %s */\n", filename);
  if (type == C_FILE)
    process_C_file ();
  else
    process_Lisp_file ();
  fputc ('\n', outfile);

  fclose (infile);
}


void process_C_file (void)
{
  register char *p;
  char *gettext, *defun;

  while (p = GET_LINE) {
    gettext = strstr (p, "GETTEXT");
    defun = strstr (p, "DEFUN");
    if (gettext || defun) {
      if (gettext) {
	p = gettext;
	p += 7;			/* Skip over "GETTEXT" */
      }
      else if (defun) {
	p = defun;
	p += 5;			/* Skip over "DEFUN" */
      }

      p = skip_blanks (p);
      if (*p++ != '(')
	continue;

      if (defun) {
	register int i;

	for (i = 0; i < 5; i++)	/* Skip over commas to doc string */
	  while (*p++ != ',')
	    CHECK_EOL (p);
	if (*p == '\n')
	  p = GET_LINE;
      }

      p = skip_blanks (p);
      if (*p != '\"')		/* Make sure there is a quoted string */
	continue;

      if (defun && no_interactive_prompt (p))
	continue;

      fprintf (outfile, "gettext(");
      if (gettext)
	p = copy_up_to_paren (p);
      else
	p = copy_quoted_string (p);
      fprintf (outfile, ")\n");
    }
  }
}


void process_Lisp_file (void)
{
  register char *p;
  char *gettext, *interactive;
  enum boolean dgettext = FALSE;

  while (p = GET_LINE) {
    gettext = strstr (p, "gettext");
    interactive = strstr (p, "(interactive");
    if (gettext || interactive) {
      if (!interactive)
	p = gettext;
      else if (!gettext)
	p = interactive;
      else if (gettext < interactive) {
	p = gettext;
	interactive = NULL;
      } else {
	p = interactive;
	gettext = NULL;
      }

      if (gettext) {
	if (p > line && *(p-1) == 'd')
	  dgettext = TRUE;
	p += 7;		/* Skip over "gettext" */
      } else
	p += 12;	/* Skip over "(interactive" */

      p = skip_blanks (p);
      if (*p != '\"')		/* Make sure there is a quoted string */
	continue;

      if (dgettext) {		/* Skip first quoted string (domain name) */
	while (*++p != '"')
	  ;  /* null statement */
	++p;
	p = skip_blanks (p);
	if (*p != '\"')		/* Check for second quoted string (message) */
	  continue;
      }

      if (interactive && no_interactive_prompt (p))
	continue;

      fprintf (outfile, "gettext(");
      p = copy_up_to_paren (p);
      fprintf (outfile, ")\n");
    }
  }
}


/* Assuming p points to some character beyond an opening parenthesis, copy
   everything to outfile up to but not including the closing parenthesis.
*/
char *copy_up_to_paren (register char *p)
{
  for (;;) {
    SKIP_BLANKS (p);	/* We don't call skip_blanks() in order to */
    CHECK_EOL (p);	/* preserve blanks at the beginning of the line */
    if (*p == ')')
      break;

    if (*p == '\"')
      p = copy_quoted_string (p);
    else
      fputc (*p++, outfile);
  }
  return p;
}


/* Assuming p points to a quote character, copy the quoted string to outfile.
*/
char *copy_quoted_string (register char *p)
{
  do {
    if (*p == '\\')
      fputc (*p++, outfile);
    fputc (*p++, outfile);
    CHECK_EOL (p);
  } while (*p != '\"');

  fputc (*p++, outfile);
  return p;
}


/* Return TRUE if the interactive specification consists only
   of code letters and no prompt.
*/
enum boolean no_interactive_prompt (register char *q)
{
  while (++q, *q == '*' || *q == '@')
    ; /* null statement */
  if (*q == '\"')
    return TRUE;
 skip_code_letter:
  if (*++q == '\"')
    return TRUE;
  if (*q == '\\' && *++q == 'n') {
    ++q;
    goto skip_code_letter;
  }
  return FALSE;
}


char *skip_blanks (register char *p)
{
  while (*p == ' ' || *p == '\t' || *p == '\n') {
    p++;
    CHECK_EOL (p);
  }
  return p;
}