home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume17 / prologtags < prev    next >
Text File  |  1989-02-08  |  29KB  |  1,219 lines
  1. Subject:  v17i093:  Create tags file for Prolog
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4.  
  5. Submitted-by: Chris Tweed <caad.ed.ac.uk!chris>
  6. Posting-number: Volume 17, Issue 93
  7. Archive-name: prologtags
  8.  
  9. [  I haven't tried this.  --r$  ]
  10.  
  11.  
  12. Ptags creates tags for Prolog predicates as defined in the source
  13. files supplied as input.  Its use is analogous to that of ctags(1).
  14.  
  15. ------------------------------ CUT HERE ------------------------------
  16. # This is a shell archive.  Remove anything before this line,
  17. # then unpack it by saving it in a file and typing "sh file".
  18. #
  19. # Contents:  TestFiles/ READ_ME ptags.L Makefile ptags.h config.h main.c
  20. #    process.c symbol.c tags TestFiles/comments.pl TestFiles/crazy.pl
  21. #    TestFiles/difficult.pl TestFiles/morecomments.pl TestFiles/tags
  22. #    TestFiles/tricky.pl
  23.  
  24. echo x - READ_ME
  25. sed 's/^@//' > "READ_ME" <<'@//E*O*F READ_ME//'
  26. Making and installing ptags should be straightforward.  Two things need
  27. to be done before attempting to compile and link the program on your
  28. system.
  29.  
  30. First edit Makefile and set DFLAGS to be either -DBSD4_2 (the default)
  31. or -DSYSV, depending on which system you are using.  If you're not
  32. using either of these you may have to make some changes to the code -
  33. sorry.  You may also want to change the assignments to FINALVN such
  34. that ptags is installed somewhere else.
  35.  
  36. Second make sure you know which characters your Prolog treats as
  37. symbols.  Edit config.h and make any necessary changes to my
  38. definitions.
  39.  
  40. After you have gone through these two stages you should be ready to
  41. type 'make ptags' or 'make install'.
  42.  
  43. Happy tagging!
  44.  
  45. Chris Tweed
  46. chris@caad.ed.ac.uk
  47. @...!mcvax!ukc!edcaad!chris
  48. @//E*O*F READ_ME//
  49. chmod u=rw,g=rw,o=r READ_ME
  50.  
  51. echo x - ptags.L
  52. sed 's/^@//' > "ptags.L" <<'@//E*O*F ptags.L//'
  53. @.TH PTAGS L "February 11, 1988" "" "Local UNIX Programmer's Manual"
  54. @.UC 4
  55. @.SH NAME
  56. ptags \- creates a tags file from Prolog sources
  57. @.SH SYNOPSIS
  58. @.B ptags
  59. [\-w] [\-l] [\-a] [\-p] files
  60. @.br
  61. @.SH DESCRIPTION
  62. @.I Ptags
  63. creates a tags file from one or more Prolog source files.
  64. It will do for Prolog predicates what
  65. @.IR ctags (1)
  66. does for C functions.
  67. Like
  68. @.I ctags,
  69. output is sent to a file called
  70. @.I tags
  71. in the current directory.
  72. Each line in
  73. the tags file contains three tab-separated fields:
  74. the first is the name of each predicate defined in the source files;
  75. the second is the name of the file where the predicate is defined;
  76. and the third is an instruction to be executed by
  77. @.IR vi (1)
  78. or
  79. @.IR ex (1)
  80. to find the definition within the source file.
  81. As with
  82. @.I ctags,
  83. the tags file is sorted alphabetically by predicate name.
  84. @.PP
  85. @.I Ptags
  86. accepts four flags to control its operation and output:
  87. @.TP
  88. @.B \-w
  89. suppresses warnings about multiple definitions of the same predicate
  90. in different files.
  91. Only the first occurrence of a definition is entered in the tags file.
  92. @.TP
  93. @.B \-l
  94. use line numbers,
  95. rather than regular expressions,
  96. to locate predicate definitions in source files.
  97. @.TP
  98. @.B \-a
  99. append the output to an existing tags file in the current directory.
  100. This allows you to combine output from
  101. @.I ptags
  102. with output from
  103. @.I ctags.
  104. A single tags file can be used to access Prolog predicates and C functions
  105. \(em useful if you are mixing Prolog and C in a single program.
  106. @.TP
  107. @.B \-p
  108. sends the output to
  109. @.I stdout
  110. instead of to tags file.
  111. @.PP
  112. @.SH "FILES"
  113. @.PP
  114. \&./tags                      tags file created or appended to
  115. @.SH "SEE ALSO"
  116. ctags(1), ex(1), vi(1)
  117. @.SH "DIAGNOSTICS"
  118. @.I Ptags
  119. complains about a variety of things, mostly related to reaching limits
  120. of static arrays, e.g. predicate name too long, too many symbols (predicates),
  121. too many source files, etc.
  122. @.sp
  123. @.I Ptags
  124. can optionally produce warnings about predicates defined
  125. across different files - see \-w above.
  126. Warnings are only issued once for each different file.
  127. Note that the arity of these predicates may be different -
  128. @.I ptags
  129. doesn't care.
  130. @.SH "BUGS"
  131. @.I Ptags
  132. is NOT a syntax checker for Prolog code, and will quite happily swallow
  133. syntax errors without complaint, probably filling the tags file with
  134. garbage at the same time.
  135. @.sp
  136. The parser is very basic and may not tolerate your style of layout
  137. for Prolog code.
  138. For example,
  139. if regular expressions are used to locate definitions
  140. (rather than line numbers), they will
  141. expect all definitions to begin at the leftmost side of the
  142. screen, because the regular expressions always begin with a
  143. leading `^' character, followed immediately by the predicate
  144. name, and some trailing context characters.
  145. @.sp
  146. Most Prologs will allow "strange" characters in predicate names,
  147. provided the names are enclosed in single quotes.
  148. These names will often not be acceptable as tags, though they seem to
  149. be accepted on the command line with the \-t option in ex or vi.
  150. Nothing we can do about this.
  151. Anybody care to modify ex?
  152. @.SH "AUTHORS"
  153. @.PP
  154. Chris Tweed
  155. @.br
  156. Bob Kemp
  157. @//E*O*F ptags.L//
  158. chmod u=rw,g=r,o=r ptags.L
  159.  
  160. echo x - Makefile
  161. sed 's/^@//' > "Makefile" <<'@//E*O*F Makefile//'
  162. INCDIR=.
  163. INC=-I$(INCDIR)
  164. # change to -DSYSV for System V
  165. DFLAGS=-DBSD4_2
  166. CFLAGS=-g $(INC) $(DFLAGS)
  167. HDRS=ptags.h config.h 
  168. OBJS=main.o process.o symbol.o
  169. BIN=ptags
  170. FINAL=/usr/local/bin/ptags
  171. MAN=/usr/man/manl/ptags.l
  172. SRCS=READ_ME ptags.L Makefile $(HDRS) $(OBJS:.o=.c) tags TestFiles TestFiles/*
  173.  
  174. $(BIN):    $(OBJS)
  175.     cc $(CFLAGS) -o $(BIN) $(OBJS)
  176.  
  177. install: $(BIN) $(MAN)
  178.     install -s $(BIN) $(FINAL)
  179.  
  180. $(MAN): ptags.L
  181.     cp ptags.L $(MAN)
  182.  
  183. shar: $(SRCS)
  184.     shar -c -v $(SRCS) > ptags.shar
  185.  
  186. lint:
  187.     lint -h $(OBJS:.o=.c)
  188.     
  189. tags:    $(OBJS:.o=.c) $(HDRS)
  190.     ctags -t $(HDRS) $(OBJS:.o=.c)
  191.  
  192. clean:
  193.     rm -f core makerr $(OBJS) p.c
  194.  
  195. veryclean: clean
  196.     rm -f $(BIN)
  197.  
  198. # dependencies
  199. $(OBJS): $(HDRS)
  200. @//E*O*F Makefile//
  201. chmod u=rw,g=rw,o=r Makefile
  202.  
  203. echo x - ptags.h
  204. sed 's/^@//' > "ptags.h" <<'@//E*O*F ptags.h//'
  205. /*
  206.  * ptags - creates entries in a tags file for Prolog predicates
  207.  * 
  208.  * Usage: ptags [-w] [-l] [-a] [-p] file1 ... filen
  209.  * 
  210.  * This program code may be freely distributed provided
  211.  * 
  212.  *     a) it, or any part of it, is not sold for profit; and
  213.  * 
  214.  *     b) this entire comment remains intact.
  215.  * 
  216.  * Copyright (c) 1988, Chris Tweed & Bob Kemp, EdCAAD,
  217.  * University of Edinburgh
  218.  * 
  219.  * Please mail us any changes, enhancements, or bug fixes.
  220.  * 
  221.  * Chris Tweed
  222.  * chris@caad.ed.ac.uk
  223.  * ...!mcvax!ukc!edcaad!chris
  224.  * 
  225.  * or
  226.  * 
  227.  * Bob Kemp
  228.  * bob@caad.ed.ac.uk
  229.  * ...!mcvax!ukc!edcaad!bob
  230.  * 
  231.  */
  232.  
  233. #define local            static
  234. #define global
  235. #define VOID            (void)
  236. #define REG            register
  237. #define BOOL            int
  238.  
  239. #define MAXFILE            128
  240. #define MAXSYM            1024
  241. #define MAXSTR            256
  242. #define MAXBUF            MAXSTR
  243.  
  244. #define TRUE            1
  245. #define FALSE            0
  246.  
  247. #define FSEP            '\t'
  248.  
  249. typedef struct symbol {
  250.     char name[MAXSTR];
  251.     char *file;
  252. } SYMBOL;
  253.  
  254. /* NULLS etc. */
  255.  
  256. #define NOSYM        (SYMBOL *)0
  257. #define NOSTR        (char *)0
  258. #define NOOP        0
  259.  
  260. /* MISC */
  261. #define    EOSTR        '\0'
  262.  
  263. /* MACROS */
  264. #define STREQ(s1, s2)    (strcmp((s1), (s2))==0)        /* string compare */
  265.  
  266. @//E*O*F ptags.h//
  267. chmod u=rw,g=rw,o=r ptags.h
  268.  
  269. echo x - config.h
  270. sed 's/^@//' > "config.h" <<'@//E*O*F config.h//'
  271. /* header file to define system dependent things */
  272.  
  273. /*
  274.  * ptags - creates entries in a tags file for Prolog predicates
  275.  * 
  276.  * Usage: ptags [-w] [-l] [-a] [-p] file1 ... filen
  277.  * 
  278.  * This program code may be freely distributed provided
  279.  * 
  280.  *     a) it, or any part of it, is not sold for profit; and
  281.  * 
  282.  *     b) this entire comment remains intact.
  283.  * 
  284.  * Copyright (c) 1988, Chris Tweed & Bob Kemp, EdCAAD,
  285.  * University of Edinburgh
  286.  * 
  287.  * Please mail us any changes, enhancements, or bug fixes.
  288.  * 
  289.  * Chris Tweed
  290.  * chris@caad.ed.ac.uk
  291.  * ...!mcvax!ukc!edcaad!chris
  292.  * 
  293.  * or
  294.  * 
  295.  * Bob Kemp
  296.  * bob@caad.ed.ac.uk
  297.  * ...!mcvax!ukc!edcaad!bob
  298.  * 
  299.  */
  300.  
  301.  
  302. #if SYSV
  303. #    define INDEX    strchr
  304. #else BSD4_2
  305. #    define INDEX    index
  306. #endif
  307.  
  308. /*
  309.  * According to "Programming in Prolog", Clocksin and Mellish,
  310.  * Springer-Verlag, 1981, Prolog has two types of atom: one
  311.  * composed of letters and digits, and one composed of symbols.
  312.  * In ptags we need to recognise both and distinguish between them
  313.  * because they determine the valid characters in predicate names.
  314.  *
  315.  * The definitions used below are those used in C-Prolog 1.5+, but
  316.  * your Prolog may be different.  C-Prolog differs from Clocksin
  317.  * and Mellish in that '$' has the same status as alphanumeric
  318.  * characters and is not, therefore, a symbol.  Check your Prolog
  319.  * and edit these definitions if necessary.
  320.  *
  321.  * Also defined is a line comment character which may be different
  322.  * in your Prolog.
  323.  *
  324.  */
  325.  
  326. /* valid symbol characters - NOTE '$' is not one of these */
  327. #define SYM_CHRS    "+-*/\\^<>=`~:.?@#&"
  328.  
  329. /* test for valid symbol characters */
  330. #define IS_SYM(c)    (INDEX(SYM_CHRS, c) != NULL)
  331.  
  332. /* test for valid character at start of predicate name */
  333. #define BEGIN_NAME(c)    (islower(c) || c == '\'' || c == '$')
  334.  
  335. /* test for valid characters within predicate name */
  336. #define IN_NAME(c)    (isalnum(c) || c == '_' || c == '$')
  337.  
  338. #define L_COMMENT_CHR    '%'
  339. @//E*O*F config.h//
  340. chmod u=rw,g=rw,o=r config.h
  341.  
  342. echo x - main.c
  343. sed 's/^@//' > "main.c" <<'@//E*O*F main.c//'
  344. #include <stdio.h>
  345. #include <sys/param.h>
  346. #include <sys/stat.h>
  347. #include "ptags.h"
  348.  
  349. /*
  350.  * ptags - creates entries in a tags file for Prolog predicates
  351.  * 
  352.  * Usage: ptags [-w] [-l] [-a] [-p] file1 ... filen
  353.  * 
  354.  * This program code may be freely distributed provided
  355.  * 
  356.  *     a) it, or any part of it, is not sold for profit; and
  357.  * 
  358.  *     b) this entire comment remains intact.
  359.  * 
  360.  * Copyright (c) 1988, Chris Tweed & Bob Kemp, EdCAAD,
  361.  * University of Edinburgh
  362.  * 
  363.  * Please mail us any changes, enhancements, or bug fixes.
  364.  * 
  365.  * Chris Tweed
  366.  * chris@caad.ed.ac.uk
  367.  * ...!mcvax!ukc!edcaad!chris
  368.  * 
  369.  * or
  370.  * 
  371.  * Bob Kemp
  372.  * bob@caad.ed.ac.uk
  373.  * ...!mcvax!ukc!edcaad!bob
  374.  * 
  375.  */
  376.  
  377. #define TEMPLATE    "/tmp/ptXXXXXXXX"
  378.  
  379. /* shorthand for usage messages */
  380. #define USE(mesg)    VOID fprintf(stderr, mesg)
  381.  
  382. global    char    *progname;        /* name of this program */
  383. global    BOOL    warnings = TRUE;    /* warns of defs across files if TRUE */
  384. global    BOOL    lines = FALSE;        /* TRUE for line numbers in tags file */
  385. global    BOOL    appending = FALSE;    /* append to existing tags if TRUE */
  386. global    BOOL    piping = FALSE;        /* send output to stdout if TRUE */
  387. global    char    *cfile;            /* current input filename */
  388. global    char    *filename[MAXFILE];    /* list of filenames to be processed */
  389. global    int    nf = 0;            /* number of files to be processed */
  390. global    FILE    *tags;            /* pointer to the tags file */
  391.  
  392. local    void    usage();        /* displays usage and EXITS */
  393.  
  394. main(argc, argv)
  395. int argc;
  396. char *argv[];
  397. {
  398.     extern    char    *strcpy();
  399.     extern    char    *mktemp();
  400.     extern    FILE    *fopen();
  401.     extern    BOOL    process_file();
  402.         int i;
  403.     char *p;
  404.     FILE *ifp;
  405.     char tagfile[MAXPATHLEN];
  406.     char cmd[MAXPATHLEN];
  407.     struct stat stbuf;
  408.  
  409. #if BSD4_2
  410.     setlinebuf(stderr);
  411. #endif
  412.  
  413.         progname = argv[0];
  414.     /* process arguments */
  415.     while (--argc) {
  416.         if (argv[1][0] == '-') {
  417.         p = argv[1] + 1;
  418.         if (p == NOSTR)
  419.             usage(progname);            /* EXITS */
  420.         while(*p) {
  421.             switch(*p) {
  422.             case 'w':
  423.                 warnings = FALSE;
  424.                 break;
  425.             case 'l':
  426.                 lines = TRUE;
  427.                 break;
  428.             case 'a':
  429.                 appending = TRUE;
  430.                 break;
  431.             case 'p':        /* send output to stdout */
  432.                 piping = TRUE;
  433.                 break;
  434.             default:
  435.                 VOID usage(progname);    /* EXITS */
  436.                 break;
  437.             }
  438.             p++;
  439.         }
  440.         } else if (nf < MAXFILE)
  441.         filename[nf++] = argv[1];
  442.         else {
  443.         VOID fprintf(stderr, "%s: too many files\n", progname);
  444.         exit(1);
  445.         }
  446.         argv++;
  447.     }
  448.  
  449.     if (nf == 0)
  450.         usage(progname);    /* EXITS */
  451.  
  452.     /* open temporary tags file */
  453.     VOID strcpy(tagfile, TEMPLATE);
  454.     VOID mktemp(tagfile);
  455.     /* if appending, copy existing tags file */
  456.     if (appending && stat("./tags", &stbuf) == 0) {
  457.         VOID sprintf(cmd, "cp tags %s", tagfile);
  458.         if (system(cmd) != 0) {
  459.         VOID fprintf(stderr, "%s: error copying existing tags file\n",
  460.             tagfile);
  461.         }
  462.         tags = fopen(tagfile, "a");
  463.     } else
  464.         tags = fopen(tagfile, "w");
  465.  
  466.     if (tags == NULL) {
  467.         VOID fprintf(stderr, "%s: can't open tags file\n", progname);
  468.         exit(1);
  469.     }
  470.  
  471.     for(i=0; i<nf; i++) {
  472.         cfile = filename[i];
  473.         /* open input file */
  474.         ifp = fopen(cfile, "r");
  475.         if (ifp == NULL) {
  476.         VOID fprintf(stderr, "%s: can't open %s\n", progname, cfile);
  477.         continue;
  478.         }
  479.         /* process the file */
  480.         VOID process_file(ifp);
  481.         VOID fclose(ifp);
  482.     }
  483.     VOID fclose(tags);
  484.     if (piping == TRUE)
  485.         VOID sprintf(cmd, "sort %s", tagfile);
  486.     else
  487.         VOID sprintf(cmd, "sort %s > tags", tagfile);
  488.     if (system(cmd) == 0)
  489.         VOID unlink(tagfile);
  490.     else {
  491.         VOID fprintf(stderr, "%s: error copying temp file (%s)\n",
  492.                  progname,
  493.                  tagfile);
  494.         exit(1);
  495.     }
  496. }
  497.  
  498. /*
  499.  * local void
  500.  * usage(s)
  501.  *
  502.  * Prints usage and EXITS.
  503.  *
  504.  */
  505.  
  506. local void
  507. usage(s)
  508. char *s;
  509. {
  510.     VOID fprintf(stderr, "usage: %s\n", s);
  511.     USE("\t\t[-w]\t/* suppress warnings about multiple defs */\n");
  512.     USE("\t\t[-l]\t/* use line numbers instead of search strings */\n");
  513.     USE("\t\t[-a]\t/* append to tags file */\n");
  514.     USE("\t\t[-p]\t/* send output to stdout */\n");
  515.     USE("\t\tfile1 ... filen\n");
  516.     exit(1);
  517. }
  518. @//E*O*F main.c//
  519. chmod u=rw,g=rw,o=r main.c
  520.  
  521. echo x - process.c
  522. sed 's/^@//' > "process.c" <<'@//E*O*F process.c//'
  523. #include <stdio.h>
  524. #include <ctype.h>
  525. #include "config.h"
  526. #include "ptags.h"
  527.  
  528. /*
  529.  * ptags - creates entries in a tags file for Prolog predicates
  530.  * 
  531.  * Usage: ptags [-w] [-l] [-a] [-p] file1 ... filen
  532.  * 
  533.  * This program code may be freely distributed provided
  534.  * 
  535.  *     a) it, or any part of it, is not sold for profit; and
  536.  * 
  537.  *     b) this entire comment remains intact.
  538.  * 
  539.  * Copyright (c) 1988, Chris Tweed & Bob Kemp, EdCAAD,
  540.  * University of Edinburgh
  541.  * 
  542.  * Please mail us any changes, enhancements, or bug fixes.
  543.  * 
  544.  * Chris Tweed
  545.  * chris@caad.ed.ac.uk
  546.  * ...!mcvax!ukc!edcaad!chris
  547.  * 
  548.  * or
  549.  * 
  550.  * Bob Kemp
  551.  * bob@caad.ed.ac.uk
  552.  * ...!mcvax!ukc!edcaad!bob
  553.  * 
  554.  */
  555.  
  556. /* lexical states */
  557.  
  558. #define    S_SPACE        1
  559. #define    S_NAME        2
  560. #define    S_SYM        3
  561. #define    S_CLAUSE    4
  562. #define    S_DOT        5
  563. #define    S_STR        6
  564. #define    S_QUOTE        7
  565.  
  566. /* define characters that must be escaped in regular expressions */
  567. #define ESC_CHRS    ".\\$*%&^/[]"
  568.  
  569. /* print character - with escape if necessary */
  570. #define PRINTC(ch, fp)    if (INDEX(ESC_CHRS, ch) != NULL) { \
  571.                 VOID fprintf(fp, "\\%c", ch); \
  572.             } else VOID putc(ch, fp)
  573.  
  574. extern    char    *INDEX();
  575. extern    SYMBOL    *lookup();
  576. local    void    skip_comment();        /* skips comments in source */
  577. local    int    skip_to_chr();        /* move read pointer to chr */
  578. local    BOOL    print_tag();        /* print the tag */
  579. local    void    print_search();        /* print search string */
  580.  
  581. local    int    lineno = 1;        /* line number in input file */
  582.  
  583. /*
  584.  * global BOOL
  585.  * process_file(fp)
  586.  *
  587.  * Main processing routine.
  588.  *
  589.  */
  590.  
  591. global BOOL
  592. process_file(fp)
  593. FILE *fp;                /* pointer to current file */
  594. {
  595.     extern    char    *strcpy();
  596.     extern    char    *progname;    /* name of this program */
  597.     extern    char    *cfile;        /* name of current file */
  598.     char buff[MAXSTR];        /* buffer */
  599.     REG int chno = 0;        /* current position in buff */
  600.     REG int state = S_SPACE;    /* state of the parser */
  601.     int pstate = S_SPACE;        /* previous state */
  602.     REG int ch;            /* current character */
  603.     REG int lastch = EOSTR;        /* previous character */
  604.     int c;                /* temporary character store */
  605.     int startno;
  606.     BOOL inquote = FALSE;
  607.  
  608.     lineno = 1;
  609.  
  610.     for (chno = 0; chno < MAXSTR; chno++)
  611.         buff[chno] = EOSTR;
  612.  
  613.     while ((ch = getc(fp)) != EOF ) {
  614.  
  615.         if (ch == '\n')
  616.         lineno++;
  617.  
  618.         switch (state) {
  619.         case S_SPACE:        /* in whitespace preceding clause */
  620.         if (!isspace(ch)) {    /* usually will be space */
  621.             if (ch == L_COMMENT_CHR)
  622.             skip_comment(ch, fp);
  623.             else if (ch == '\'') {
  624.             state = S_QUOTE;
  625.             } else if (ch == '"' && ! inquote) {
  626.             pstate = state;
  627.             state = S_STR;
  628.             } else if (BEGIN_NAME(ch)) {
  629.             state = S_NAME;
  630.             buff[0] = ch;
  631.             chno = 1;
  632.             /* look for comments */
  633.             } else if (ch == '/') {
  634.             if ((c=getc(fp)) == '*') {
  635.                 skip_comment(c, fp);
  636.             } else {
  637.                 ungetc(c, fp);
  638.                 state = S_SYM;
  639.                 buff[0] = ch;
  640.                 chno = 1;
  641.             }
  642.             } else if (IS_SYM(ch)) {
  643.             state = S_SYM;
  644.             buff[0] = ch;
  645.             chno = 1;
  646.             } else if (ch != '/') /* skip "rubbish" */
  647.             state = S_CLAUSE;
  648.         }
  649.         break;
  650.         case S_NAME:        /* in predicate name */
  651.         /* FALLS THROUGH */
  652.         case S_SYM:
  653.         /* weed out directives and queries */
  654.         if (chno == 1 && ch == '-' &&
  655.                 (lastch == ':' || lastch == '?')) {
  656.             state = S_CLAUSE;
  657.             break;
  658.         }
  659.             
  660.         if (chno == MAXSTR) {
  661.             VOID fprintf(stderr,
  662.                 "%s: predicate name too long at line %d\n",
  663.                 progname, lineno);
  664.             return FALSE;
  665.         }
  666.         buff[chno++] = ch;
  667.         if (ch == '\'') {
  668.             state = S_QUOTE;
  669.         } else if (inquote) {
  670.             break;
  671.         } else if (state == S_NAME && ch == '.') {
  672.             state = S_DOT;
  673.         } else if (ch == '/') {        /* comment in symbol or name */
  674.             /* weed comments out */
  675.             if ((c=getc(fp)) == '*') {
  676.             skip_comment(c, fp);
  677.             chno--;
  678.             break;
  679.             } else {
  680.             ungetc(c, fp);
  681.             if (state == S_NAME)
  682.                 state = S_CLAUSE;
  683.             }
  684.         } else if ((state == S_NAME && ! IN_NAME(ch)) ||
  685.                     (state == S_SYM && !IS_SYM(ch)))
  686.             state = S_CLAUSE;
  687.  
  688.         if (state != S_NAME && state != S_SYM) {
  689.             buff[--chno] = EOSTR;
  690.             if (print_tag(buff, ch, lineno) == FALSE)
  691.             exit(1);
  692.         }
  693.         if (ch == L_COMMENT_CHR)
  694.             skip_comment(ch, fp);
  695.         break;
  696.         case S_CLAUSE:        /* in the clause text */
  697.         if (ch == '\'') {
  698.             inquote = (! inquote);
  699.         } else if (inquote)
  700.             break;
  701.         else if (ch == L_COMMENT_CHR) {
  702.             skip_comment(ch, fp);
  703.         } else if (ch == '"') {
  704.             pstate = state;
  705.             state = S_STR;
  706.         } else if (ch == '.')
  707.             state = S_DOT;
  708.         else if (ch == '*' && lastch == '/')
  709.             skip_comment(ch, fp);
  710.         break;
  711.         case S_DOT:
  712.         if (isspace(ch))
  713.             state = S_SPACE;
  714.         else
  715.             state = S_CLAUSE;
  716.         break;
  717.         case S_STR:
  718.         /* we're not really interested in strings, but we want to
  719.          * get them out of the way as soon as possible because they
  720.          * may contain nasty things like a dot (.) followed by
  721.          * white space which would otherwise throw the states off.
  722.          * Note that we must also allow for "" within a string as
  723.          * this is used to put a single " into the string.
  724.          */
  725.         startno = lineno;
  726.         do {
  727.             if (skip_to_chr(fp, ch, '"') == EOF) {
  728.             fprintf(stderr,
  729.             "%s: can't find end of string on line %d in %s\n",
  730.             progname, startno, cfile);
  731.             exit(1);
  732.             }
  733.         } while((ch = getc(fp)) == '"');
  734.         state = pstate;
  735.         break;
  736.         case S_QUOTE:
  737.         inquote = ( ! inquote);
  738.         if (inquote) {
  739.             state = S_NAME;
  740.             buff[0] = '\'';
  741.             buff[1] = ch;
  742.             chno = 2;
  743.         } else
  744.             state = S_CLAUSE;
  745.         break;
  746.         }
  747.         lastch = ch;
  748.     }
  749.     return TRUE;
  750. }
  751.  
  752. /*
  753.  * local void
  754.  * skip_comment(ch, fp)
  755.  *
  756.  * Move reading position to beyond end of comment.
  757.  *
  758.  */
  759.  
  760. local void
  761. skip_comment(ch, fp)
  762. FILE *fp;                /* pointer to current file */
  763. REG int ch;                /* current input character */
  764. {
  765.     extern    char    *progname;
  766.     extern    char    *cfile;
  767.     int startno = lineno;
  768.  
  769.     if (ch == L_COMMENT_CHR) { /* rest-of-line comment */
  770.         while ((ch = getc(fp)) != '\n')
  771.         if (ch == EOF)
  772.             return;
  773.         lineno++;
  774.     } else {    /* this style of comment (slash-star star-slash) */
  775.         do {
  776.         if (skip_to_chr(fp, ch, '*') == EOF) {
  777.             fprintf(stderr,
  778.             "%s: can't find end of comment, from line %d in %s\n",
  779.             progname, startno, cfile);
  780.             exit(1);
  781.         }
  782.         while ((ch = getc(fp)) == '*')
  783.             ;
  784.         } while (ch != '/');
  785.     }
  786. }
  787.  
  788. /*
  789.  * local BOOL
  790.  * print_tag(fn_name, followch, lno)
  791.  *
  792.  * Process the predicate name, removing initial quotes if necessary.
  793.  * Quotes must be retained in the search string.
  794.  *
  795.  */
  796.  
  797. local BOOL
  798. print_tag(fn_name, followch, lno)
  799. char *fn_name;                    /* predicate name */
  800. char followch;                    /* char immediately after it */
  801. int lno;                    /* current line number */
  802. {
  803.     extern    SYMBOL    *install();
  804.     extern    char    *progname;    /* program name */
  805.     extern    char    *cfile;        /* current source filename */
  806.     extern    FILE    *tags;        /* pointer to tags file */
  807.     extern    BOOL    lines;        /* TRUE if line numbers are requested */
  808.     extern    BOOL    warnings;    /* warn about multiple defs? */
  809.     REG SYMBOL *sym;        /* symbol table entry */
  810.     REG char *p;
  811.  
  812.     /* skip initial quote if necessary */
  813.     p = (*fn_name == '\'') ? fn_name+1 : fn_name;
  814.  
  815.     if ((sym = lookup(p)) == NOSYM) {
  816. #if DEBUG
  817.         VOID printf("process_head: installing %s\n", s);
  818. #endif
  819.         if (install(p, cfile) == NOSYM)
  820.         return FALSE;
  821.     } else if (warnings && sym->file != cfile) {
  822.         VOID fprintf(stderr,
  823.             "%s: warning - '%s' is defined in more than one file\n",
  824.             progname, p);
  825.         sym->file = cfile;    /* no more warnings for this file */
  826.     } else    /* already recorded for this file */
  827.         return TRUE;
  828.  
  829.     if (lines == TRUE)    /* use line numbers */
  830.         VOID fprintf(tags, "%s\t%s\t%d\n", p, cfile, lno);
  831.     else {    /* use search string */
  832.         VOID fprintf(tags, "%s\t%s\t", p, cfile);
  833.         VOID print_search(tags, fn_name, followch);
  834.     }
  835.  
  836.     return TRUE;
  837. }
  838.  
  839. /*
  840.  * local void
  841.  * print_search(fp, s, c)
  842.  *
  843.  * Construct a vi/ex regular expression as a search string, escaping
  844.  * special characters if necessary.
  845.  *
  846.  */
  847.  
  848. local void
  849. print_search(fp, s, c)
  850. FILE *fp;
  851. REG char *s;                /* string to search for */
  852. char c;                    /* trailing context character */
  853. {
  854.     /* The definition is assumed to start on a line of its own
  855.      * flush with the left margin.
  856.      */
  857.     VOID fprintf(fp, "/^");
  858.     for ( ; *s != EOSTR; s++)
  859.         PRINTC(*s, fp);
  860.     /* Can't put these in search string */
  861.     if (c != '\n' && c != '\r' && c != '\f')
  862.         PRINTC(c, fp);    /* print char following name */
  863.     VOID fprintf(fp, "/\n");
  864. }
  865.  
  866. /*
  867.  * local int
  868.  * skip_to_chr(fp, ch, match)
  869.  *
  870.  * Skips input up to match character.  Leaves ch at match.
  871.  * Returns match or EOF on end-of-file.
  872.  *
  873.  */
  874.  
  875. local int
  876. skip_to_chr(fp, ch, match)
  877. FILE *fp;                /* pointer to current input file */
  878. int ch;                    /* current character */
  879. char match;                /* character to match */
  880. {
  881.     extern    int    lineno;
  882.     extern    char    *progname;    /* program name */
  883.     extern    char    *cfile;        /* current input filename */
  884.  
  885.     while (ch != match) {
  886.         if (ch == '\n')
  887.         lineno++;
  888.         else if (ch == EOF) {
  889.         fprintf(stderr, "%s: character (%c) not matched in %s\n",
  890.             progname, match, cfile);
  891.         return EOF;
  892.         }
  893.         ch = getc(fp);
  894.     }
  895.     return ch;
  896. }
  897. @//E*O*F process.c//
  898. chmod u=rw,g=rw,o=r process.c
  899.  
  900. echo x - symbol.c
  901. sed 's/^@//' > "symbol.c" <<'@//E*O*F symbol.c//'
  902. #include <stdio.h>
  903. #include "ptags.h"
  904.  
  905. /*
  906.  * ptags - creates entries in a tags file for Prolog predicates
  907.  * 
  908.  * Usage: ptags [-w] [-l] [-a] [-p] file1 ... filen
  909.  * 
  910.  * This program code may be freely distributed provided
  911.  * 
  912.  *     a) it, or any part of it, is not sold for profit; and
  913.  * 
  914.  *     b) this entire comment remains intact.
  915.  * 
  916.  * Copyright (c) 1988, Chris Tweed & Bob Kemp, EdCAAD,
  917.  * University of Edinburgh
  918.  * 
  919.  * Please mail us any changes, enhancements, or bug fixes.
  920.  * 
  921.  * Chris Tweed
  922.  * chris@caad.ed.ac.uk
  923.  * ...!mcvax!ukc!edcaad!chris
  924.  * 
  925.  * or
  926.  * 
  927.  * Bob Kemp
  928.  * bob@caad.ed.ac.uk
  929.  * ...!mcvax!ukc!edcaad!bob
  930.  * 
  931.  */
  932.  
  933. extern    BOOL    warnings;
  934. local    int    nsym = 0;
  935. local    SYMBOL    symbol[MAXSYM];
  936.  
  937. /*
  938.  * global SYMBOL *
  939.  * install(name, file)
  940.  *
  941.  * Installs a symbol in the symbol table.  NOTE: it doesn't check
  942.  * if the symbol has already been entered.
  943.  *
  944.  */
  945.  
  946. global SYMBOL *
  947. install(name, file)
  948. char *name;                /* predicate name */
  949. char *file;                /* name of file where pred is defined */
  950. {
  951.     extern    SYMBOL    *new_sym();
  952.     extern    char    *strcpy();
  953.     SYMBOL *sym;
  954.  
  955.     if ((sym = new_sym()) == NOSYM)
  956.         return NOSYM;
  957.     VOID strcpy(sym->name, name);
  958.     sym->file = file;
  959.  
  960.     return sym;
  961. }
  962.  
  963. /*
  964.  * local SYMBOL *
  965.  * new_sym()
  966.  *
  967.  * Returns a pointer to a new symbol, or NOSYM (NULL) if no
  968.  * space is available.
  969.  *
  970.  */
  971.  
  972. local SYMBOL *
  973. new_sym()
  974. {
  975.     extern char *progname;
  976.  
  977.     if (nsym < MAXSYM)
  978.         return &symbol[nsym++];
  979.     else {
  980.         fprintf(stderr, "%s: too many symbols\n", progname);
  981.         return NOSYM;
  982.     }
  983. }
  984.  
  985. /*
  986.  * global SYMBOL *
  987.  * lookup(name)
  988.  *
  989.  * Returns pointer to symbol if it is in the symbol table; otherwise
  990.  * it returns NOSYM (NULL).
  991.  *
  992.  */
  993.  
  994. global SYMBOL *
  995. lookup(name)
  996. REG char *name;
  997. {
  998.     extern    int    nsym;
  999.     REG int i;
  1000.  
  1001.     for (i = 0; i < nsym; i++)
  1002.         if (STREQ(name, symbol[i].name))
  1003.         return &symbol[i];
  1004.  
  1005.     return NOSYM;
  1006. }
  1007. @//E*O*F symbol.c//
  1008. chmod u=rw,g=rw,o=r symbol.c
  1009.  
  1010. echo x - tags
  1011. sed 's/^@//' > "tags" <<'@//E*O*F tags//'
  1012. BEGIN_NAME    config.h    /^#define BEGIN_NAME(c)    (islower(c) || c == '\\'' || /
  1013. IN_NAME    config.h    /^#define IN_NAME(c)    (isalnum(c) || c == '_' || c ==/
  1014. IS_SYM    config.h    /^#define IS_SYM(c)    (INDEX(SYM_CHRS, c) != NULL)$/
  1015. Mmain    main.c    /^main(argc, argv)$/
  1016. PRINTC    process.c    /^#define PRINTC(ch, fp)    if (INDEX(ESC_CHRS, ch) != /
  1017. STREQ    ptags.h    /^#define STREQ(s1, s2)    (strcmp((s1), (s2))==0)        \/* /
  1018. USE    main.c    /^#define USE(mesg)    VOID fprintf(stderr, mesg)$/
  1019. install    symbol.c    /^install(name, file)$/
  1020. lookup    symbol.c    /^lookup(name)$/
  1021. new_sym    symbol.c    /^new_sym()$/
  1022. print_search    process.c    /^print_search(fp, s, c)$/
  1023. print_tag    process.c    /^print_tag(fn_name, followch, lno)$/
  1024. process_file    process.c    /^process_file(fp)$/
  1025. skip_comment    process.c    /^skip_comment(ch, fp)$/
  1026. skip_to_chr    process.c    /^skip_to_chr(fp, ch, match)$/
  1027. usage    main.c    /^usage(s)$/
  1028. @//E*O*F tags//
  1029. chmod u=rw,g=rw,o=r tags
  1030.  
  1031. echo mkdir - TestFiles
  1032. mkdir TestFiles
  1033. chmod u=rwx,g=rwx,o=rx TestFiles
  1034.  
  1035. echo x - TestFiles/comments.pl
  1036. sed 's/^@//' > "TestFiles/comments.pl" <<'@//E*O*F TestFiles/comments.pl//'
  1037. :- b, c, d.
  1038.  
  1039. a.
  1040.  
  1041. /* hello .
  1042. x.
  1043. */
  1044.  
  1045. /**
  1046. m.
  1047. **/
  1048.  
  1049. /***
  1050. n.
  1051. **/
  1052.  
  1053. b(x,
  1054.     y) :-
  1055.     c(x),
  1056.     d(y,z).
  1057.  
  1058. c
  1059.     (x, a) :-
  1060.     zxc(a).
  1061.  
  1062. d :- true.    % hi!
  1063.  
  1064. e% .
  1065. zzz.
  1066.  
  1067. f/* . */ x .
  1068.  
  1069. @//E*O*F TestFiles/comments.pl//
  1070. chmod u=rw,g=rw,o=r TestFiles/comments.pl
  1071.  
  1072. echo x - TestFiles/crazy.pl
  1073. sed 's/^@//' > "TestFiles/crazy.pl" <<'@//E*O*F TestFiles/crazy.pl//'
  1074. /* crazy program layout */
  1075.  
  1076. c(A, B)
  1077. :-
  1078.             a(A),
  1079.  
  1080.  
  1081.  
  1082.  
  1083. b(B).
  1084.  
  1085. d(a(_),D) :-
  1086.     b(D).
  1087. @//E*O*F TestFiles/crazy.pl//
  1088. chmod u=rw,g=rw,o=r TestFiles/crazy.pl
  1089.  
  1090. echo x - TestFiles/difficult.pl
  1091. sed 's/^@//' > "TestFiles/difficult.pl" <<'@//E*O*F TestFiles/difficult.pl//'
  1092. :- b, c, d.
  1093.  
  1094. a.
  1095.  
  1096. /* hello .
  1097. x.
  1098. */
  1099.  
  1100. :- op(500, xfx, '.').
  1101.  
  1102. b(n.n,
  1103.     y) :-
  1104.     c(x),
  1105.     d(y,z).
  1106.  
  1107. c(
  1108.     x, a) :-
  1109.     zxc(a).
  1110.  
  1111. 'a b c'(A,1.2) :-
  1112.     a(A),
  1113.     b(B).
  1114.  
  1115. d("a dot. followed by white space", "", "and a quote in a string""") :-
  1116.   it_works(ok).
  1117.  
  1118. e :- true.    % hi!
  1119.  
  1120. :- op(300, fx, f).
  1121. /* below should be interpretable as 'f yyy.' */
  1122. f% .
  1123. yyy.
  1124.  
  1125. 'z & () . zz'.
  1126.  
  1127. :- op(300, fx, g).
  1128. g/* . */ x .
  1129.  
  1130. h(a).
  1131.  
  1132. /* symbolic atoms as predicate names */
  1133.  
  1134. ++(X).
  1135. +.+(X).
  1136. &+`(X).
  1137. @~*\/#?```=(X).
  1138.  
  1139. /* some really tricky ones ;-) */
  1140. x/*******/y(X).
  1141. */**/*(X).
  1142. /*******/y(X).
  1143. /**/*(X).
  1144. x/***//****/y(X).
  1145. @//E*O*F TestFiles/difficult.pl//
  1146. chmod u=rw,g=rw,o=r TestFiles/difficult.pl
  1147.  
  1148. echo x - TestFiles/morecomments.pl
  1149. sed 's/^@//' > "TestFiles/morecomments.pl" <<'@//E*O*F TestFiles/morecomments.pl//'
  1150. a(b) :- true.
  1151. /**/
  1152. c(b) :- true.
  1153. d(b).
  1154. @//E*O*F TestFiles/morecomments.pl//
  1155. chmod u=rw,g=rw,o=r TestFiles/morecomments.pl
  1156.  
  1157. echo x - TestFiles/tags
  1158. sed 's/^@//' > "TestFiles/tags" <<'@//E*O*F TestFiles/tags//'
  1159. &+`    difficult.pl    /^\&+`(/
  1160. *    difficult.pl    /^\*(/
  1161. **    difficult.pl    /^\*\*(/
  1162. ++    difficult.pl    /^++(/
  1163. +.+    difficult.pl    /^+\.+(/
  1164. a    difficult.pl    /^a\./
  1165. a b c    difficult.pl    /^'a b c'/
  1166. b    difficult.pl    /^b(/
  1167. c    difficult.pl    /^c(/
  1168. d    difficult.pl    /^d(/
  1169. e    difficult.pl    /^e /
  1170. f    difficult.pl    /^f\%/
  1171. g    difficult.pl    /^g /
  1172. h    difficult.pl    /^h(/
  1173. xy    difficult.pl    /^xy(/
  1174. y    difficult.pl    /^y(/
  1175. z & () . zz    difficult.pl    /^'z \& () \. zz'/
  1176. @~*\/#?```=    difficult.pl    /^~\*\\\/#?```=(/
  1177. @//E*O*F TestFiles/tags//
  1178. chmod u=rw,g=rw,o=r TestFiles/tags
  1179.  
  1180. echo x - TestFiles/tricky.pl
  1181. sed 's/^@//' > "TestFiles/tricky.pl" <<'@//E*O*F TestFiles/tricky.pl//'
  1182. x/*******/y(X).
  1183. */**/*(X).
  1184. /*******/y(X).
  1185. /**/*(X).
  1186. x/***//****/y(X).
  1187. @//E*O*F TestFiles/tricky.pl//
  1188. chmod u=rw,g=rw,o=r TestFiles/tricky.pl
  1189.  
  1190. echo Inspecting for damage in transit...
  1191. temp=/tmp/shar$$; dtemp=/tmp/.shar$$
  1192. trap "rm -f $temp $dtemp; exit" 0 1 2 3 15
  1193. cat > $temp <<\!!!
  1194.       22     128     788 READ_ME
  1195.      104     533    3067 ptags.L
  1196.       38      83     677 Makefile
  1197.       61     182    1128 ptags.h
  1198.       68     325    1908 config.h
  1199.      174     590    3995 main.c
  1200.      374    1484    8989 process.c
  1201.      105     309    1843 symbol.c
  1202.       16      96     831 tags
  1203.       32      39     155 comments.pl
  1204.       13      13      82 crazy.pl
  1205.       53     104     576 difficult.pl
  1206.        4       8      39 morecomments.pl
  1207.       18      68     452 tags
  1208.        5       5      70 tricky.pl
  1209.     1087    3967   24600 total
  1210. !!!
  1211. wc  READ_ME ptags.L Makefile ptags.h config.h main.c process.c symbol.c tags TestFiles/comments.pl TestFiles/crazy.pl TestFiles/difficult.pl TestFiles/morecomments.pl TestFiles/tags TestFiles/tricky.pl | sed 's=[^ ]*/==' | diff -b $temp - >$dtemp
  1212. if [ -s $dtemp ]
  1213. then echo "Ouch [diff of wc output]:" ; cat $dtemp
  1214. else echo "No problems found."
  1215. fi
  1216. exit 0
  1217.  
  1218.  
  1219.