Mercurial > hg > xemacs-beta
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; }