annotate src/vms-pp.c @ 22293:0544aa57ff27

(cperl-style-alist): New variable, since `c-mode' is no longer loaded. - (Somebody who uses the styles should check that they work OK!) - (a lot of work is needed, especially with new `cperl-fix-line-spacing'). Old value of style is memorized when choosing a new style, may be restored from the same menu. (cperl-perldoc, cperl-pod-to-manpage): New commands; thanks to Anthony Foiani <[e-mail]> and Nick Roberts <[e-mail]>. (`Perl doc', `Regexp'): New submenus (latter to allow short displays). (cperl-clobber-lisp-bindings): New cfg variable. (cperl-find-pods-heres): $a->y() is not y///. (cperl-after-block-p): Add save-excursion. (cperl-init-faces): Was failing. Init faces when loading `ps-print'. (cperl-toggle-autohelp): New command. (cperl-electric-paren): `while SPACE LESS' was buggy. (cperl-init-faces): `-text' in `[-text => 1]' was not highlighted. (cperl-after-block-p): was FALSE after `sub f {}'. (cperl-electric-keyword): `foreachmy', `formy' expanded too, Expands `=pod-directive'. (cperl-linefeed): behaves reasonable in POD-directive lines. (cperl-message-electric-keyword): new cfg variable. (cperl-electric-keyword): print a message, governed by `cperl-message-electric-keyword'. (cperl-electric-paren): Typing `}' was not checking for being block or not. (cperl-beautify-regexp-piece): Did not know about lookbehind; finding *which* level to work with was not intuitive. (cperl-beautify-levels): New command. (cperl-electric-keyword): Allow here-docs contain `=head1' and friends for keyword expansion. Fix for broken `font-lock-unfontify-region-function'. Should preserve `syntax-table' properties even with `lazy-lock'. (cperl-indent-region-fix-else): New command. (cperl-fix-line-spacing): New command. (cperl-invert-if-unless): New command (C-c C-t and in Menu). (cperl-hints): mention 20.2's goods/bads. (cperl-extra-newline-before-brace-multiline): Started to use it. (cperl-break-one-line-blocks-when-indent): New cfg variable. (cperl-fix-hanging-brace-when-indent): New cfg variable. (cperl-merge-trailing-else): New cfg variable. Workaround for another `font-lock's `syntax-table' text-property bug. `zerop' could be applied to nil. At last, may work with `font-lock' without setting `cperl-font-lock'. (cperl-indent-region-fix-constructs): Renamed from `cperl-indent-region-fix-constructs'. (cperl-fix-line-spacing): could be triggered inside strings, would not know what to do with BLOCKs of map/printf/etc. (cperl-merge-trailing-else): Handle `continue' too. (cperl-fix-line-spacing): Likewise. (cperl-calculate-indent): Knows about map/printf/etc before {BLOCK}; treat after-comma lines as continuation lines. (cperl-mode): `continue' made electric. (cperl-electric-keyword): Electric `do' inserts `do/while'. (cperl-fontify-syntaxically): New function. (cperl-syntaxify-by-font-lock): New cfg variable. Make syntaxification to be autoredone via `font-lock', switched on by `cperl-syntaxify-by-font-lock', off by default so far. Remove some commented out chunks. (cperl-set-style-back): Old value of style is memorized when choosing a new style, may be restored from the same menu. Mode-documentation added to micro-docs. (cperl-praise): updated. (cperl-toggle-construct-fix): New command. Added on C-c C-w and menu. (auto-fill-mode): added on C-c C-f and menu. (cperl-style-alist): `PerlStyle' style added. (cperl-find-pods-heres): Message for termination of scan corrected. (cperl-speed): New variable with hints. (cperl-electric-else): Make backspace electric after expansion of `else/continue' too. Fixed customization to honor cperl-hairy. Created customization groups. All the compile-time warnings fixed. (cperl-syntaxify-by-font-lock): Interaction with `font-lock-hot-pass' fixed. (cperl-after-block-and-statement-beg): It is BLOCK if we reach lim when backup sexp. (cperl-after-block-p, cperl-after-expr-p): Likewise. (cperl-indent-region): Make a marker for END - text added/removed. (cperl-style-alist): Include `cperl-merge-trailing-else' where the value is clear. (cperl-styles-entries): Likewise. (cperl-tips, cperl-problems): Improvements to docs.

/* vms_pp - preprocess emacs files in such a way that they can be
 *          compiled on VMS without warnings.
 * Copyright (C) 1986 Free Software Foundation, Inc.
   
   This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

 *
 * Usage:
 *	vms_pp infile outfile
 * implicit inputs:
 *	The file "vms_pp.trans" has the names and their translations.
 * description:
 *	Vms_pp takes the input file and scans it, replacing the long
 *	names with shorter names according to the table read in from
 *	vms_pp.trans. The line is then written to the output file.
 *
 *	Additionally, the "#undef foo" construct is replaced with:
 *		#ifdef foo
 *		#undef foo
 *		#endif
 *
 *	The construct #if defined(foo) is replaced with
 *		#ifdef foo
 *		#define foo_VAL 1
 *		#else
 *		#define foo_VAL 0
 *		#endif
 *		#define defined(XX) XX_val
 *		#if defined(foo)
 *
 *	This last construction only works on single line #if's and takes
 *	advantage of a questionable C pre-processor trick. If there are
 *	comments within the #if, that contain "defined", then this will
 *	bomb.
 */
#include <stdio.h>

#define Max_table 100
#define Table_name "vms_pp.trans"
#define Word_member \
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$"

static   FILE *in,*out;			/* read from, write to */
struct item {				/* symbol table entries */
  char *name;
  char *value;
};
static struct item name_table[Max_table]; /* symbol table */
static int defined_defined = 0;		/* small optimization */

main(argc,argv) int argc; char **argv; {
  char buffer[1024];

  if(argc != 3) {			/* check argument count */
    fprintf(stderr,"usage: vms_pp infile outfile");
    exit();
  }
  init_table();				/* read in translation table */

/* open input and output files
 */
  if((in = fopen(argv[1],"r")) == NULL) {
    fprintf(stderr,"vms_pp: unable to open file '%s'",argv[1]);
    exit();
  }
  if((out = fopen(argv[2],"w")) == NULL) {
    fprintf(stderr,"vms_pp: unable to create file '%s'",argv[2]);
    exit();
  }

  while(fgets(buffer,1023,in) != NULL) { /* loop through buffer until end */
    process_line(buffer);		/* process the line */
    fputs(buffer,out);			/* write out the line */
  }
}

/* buy - allocate and copy a string
 */
static char *buy(str) char *str; {
  char *temp;

  if(!(temp = malloc(strlen(str)+1))) {
    fprintf(stderr,"vms_pp: can't allocate memory");
    exit();
  }
  strcpy(temp,str);
  return temp;
}

/* gather_word - return a buffer full of the next word
 */
static char *gather_word(ptr,word) char *ptr, *word;{
  for(; strchr(Word_member,*ptr); ptr++,word++)
    *word = *ptr;
  *word = 0;
  return ptr;
}

/* skip_white - skip white space
 */
static char *skip_white(ptr) char *ptr; {
  while(*ptr == ' ' || *ptr == '\t')
    ptr++;
  return ptr;
}

/* init_table - initialize translation table.
 */
init_table() {
  char buf[256],*ptr,word[128];
  FILE *in;
  int i;

  if((in = fopen(Table_name,"r")) == NULL) { /* open file */
    fprintf(stderr,"vms_pp: can't open '%s'",Table_name);
    exit();
  }
  for(i = 0; fgets(buf,255,in) != NULL;) { /* loop through lines */
    ptr = skip_white(buf);
    if(*ptr == '!')			/* skip comments */
      continue;
    ptr = gather_word(ptr,word);	/* get long word */
    if(*word == 0) {			/* bad entry */
      fprintf(stderr,"vms_pp: bad input line '%s'\n",buf);
      continue;
    }
    name_table[i].name = buy(word);	/* set up the name */
    ptr = skip_white(ptr);		/* skip white space */
    ptr = gather_word(ptr,word);	/* get equivalent name */
    if(*word == 0) {			/* bad entry */
      fprintf(stderr,"vms_pp: bad input line '%s'\n",buf);
      continue;
    }
    name_table[i].value = buy(word);	/* and the equivalent name */
    i++;				/* increment to next position */
  }
  for(; i < Max_table; i++)		/* mark rest as unused */
    name_table[i].name = 0;
}

/* process_line - do actual line processing
 */
process_line(buf) char *buf; {
  char *in_ptr,*out_ptr;
  char word[128],*ptr;
  int len;

  check_pp(buf);			/* check for preprocessor lines */

  for(in_ptr = out_ptr = buf; *in_ptr;) {
    if(!strchr(Word_member,*in_ptr))	/* non alpha-numeric? just copy */
      *out_ptr++ = *in_ptr++;
    else {
      in_ptr = gather_word(in_ptr,word); /* get the 'word' */
      if(strlen(word) > 31)		/* length is too long */
	replace_word(word);		/* replace the word */
      for(ptr = word; *ptr; ptr++,out_ptr++) /* copy out the word */
	  *out_ptr = *ptr;
    }
  }
  *out_ptr = 0;
}

/* check_pp - check for preprocessor lines
 */
check_pp(buf) char *buf; {
  char *ptr,*p;
  char word[128];

  ptr = skip_white(buf);		/* skip white space */
  if(*ptr != '#')			/* is this a preprocessor line? */
    return;				/* no, just return */

  ptr = skip_white(++ptr);		/* skip white */
  ptr = gather_word(ptr,word);		/* get command word */
  if(!strcmp("undef",word)) {		/* undef? */
    ptr = skip_white(ptr);
    ptr = gather_word(ptr,word);	/* get the symbol to undef */
    fprintf(out,"#ifdef %s\n",word);
    fputs(buf,out);
    strcpy(buf,"#endif");
    return;
  }
  if(!strcmp("if",word)) {		/* check for if */
    for(;;) {
      ptr = strchr(ptr,'d');		/* look for d in defined */
      if(!ptr)				/* are we done? */
	return;
      if(strchr(Word_member,*(ptr-1))){	/* at beginning of word? */
	ptr++; continue;		/* no, continue looking */
      }
      ptr = gather_word(ptr,word);	/* get the word */
      if(strcmp(word,"defined"))	/* skip if not defined */
	continue;
      ptr = skip_white(ptr);		/* skip white */
      if(*ptr != '(')			/* look for open paren */
	continue;			/* error, continue */
      ptr++;				/* skip paren */
      ptr = skip_white(ptr);		/* more white skipping */
      ptr = gather_word(ptr,word);	/* get the thing to test */
      if(!*word)			/* null word is bad */
	continue;
      fprintf(out,"#ifdef %s\n",word);	/* generate the code */
      fprintf(out,"#define %s_VAL 1\n",word);
      fprintf(out,"#else\n");
      fprintf(out,"#define %s_VAL 0\n",word);
      fprintf(out,"#endif\n");
      if(!defined_defined) {
	fprintf(out,"#define defined(XXX) XXX/**/_VAL\n");
	defined_defined = 1;
      }
    }
  }
}

/* replace_word - look the word up in the table, and replace it
 *		  if a match is found.
 */
replace_word(word) char *word; {
  int i;

  for(i = 0; i < Max_table && name_table[i].name; i++)
    if(!strcmp(word,name_table[i].name)) {
      strcpy(word,name_table[i].value);
      return;
    }
  fprintf(stderr,"couldn't find '%s'\n",word);
}