[comp.emacs] mail forwarding

mieko@WHEATIES.AI.MIT.EDU (01/13/89)

------- Forwarded Message

6 January 1989

Shinichirou Sugou
8-26 Hasugawara-shinmachi
Tsuchiura-City, Ibaraki-Pref.
300 Japan

Mr. Richard Stallman and GNU project people:


Dear Mr. Richard stallman.

I have extended Emacs's etags to be able to handle Prolog source.  The file
terminates with '.pl' is recognized as Prolog file.

Though, there are many Prolog languages whose syntax is different each other,
this etags works with DEC10-type Prolog, that is, C-Prolog, Quintus-Prolog,
RealTime-Prolog and so on ('prolog.el', which is included in Emacs, also works
on this kind of Prolog language).

Patch against Emacs-18.52 follows.


- ----------begin of patch--------------
*** /usr/local/src/emacs-18.52/etc/etags.c	Thu Dec 22 13:46:36 1988
- --- etags.c	Fri Jan  6 19:06:36 1989
***************
*** 95,100 ****
- --- 95,105 ----
  #include <stdio.h>
  #include <ctype.h>
  
+ /* patch by S.Sugou
+    Lint, be silent. */
+ char *malloc(), *strcpy(), *getenv(), *strncpy(), *sprintf(), *realloc();
+ /* end of patch */
+ 
  /* Define the symbol ETAGS to make the program "etags",
   which makes emacs-style tag tables by default.
   Define CTAGS to make the program "ctags" compatible with the usual one.
***************
*** 488,493 ****
- --- 493,499 ----
       char *file;
  {
    char *cp;
+   void prolog_funcs();
  
    if ((inf=fopen(file,"r")) == NULL)
      {
***************
*** 497,502 ****
- --- 503,515 ----
      }
    curfile = savestr(file);
    cp = rindex(file, '.');
+   /* patch by S.Sugou */
+   /* .pl implies prolog source code */
+   if (cp && !strcmp (cp + 1, "pl")) {
+      prolog_funcs(inf);
+      fclose(inf);
+      return; }
+   /* end of patch */
    /* .tex, .aux or .bbl implies LaTeX source code */
    if (cp && (!strcmp (cp + 1, "tex") || !strcmp (cp + 1, "aux")
  	     || !strcmp (cp + 1, "bbl")))
***************
*** 552,558 ****
    name is the tag name,
    f is nonzero to use a pattern, zero to use line number instead. */
  
! pfnote (name, f, linestart, linelen, lno, cno)
       char *name;
       logical f;			/* f == TRUE when function */
       char *linestart;
- --- 565,571 ----
    name is the tag name,
    f is nonzero to use a pattern, zero to use line number instead. */
  
! pfnote (name, f, linestart, linelen, lno, cno, permit_overlap)
       char *name;
       logical f;			/* f == TRUE when function */
       char *linestart;
***************
*** 559,564 ****
- --- 572,578 ----
       int linelen;
       int lno;
       long cno;
+      int permit_overlap;
  {
    register char *fp;
    register NODE *np;
***************
*** 606,612 ****
    if (head == NULL)
      head = np;
    else
!     add_node(np, head);
  }
  
  free_tree(node)
- --- 620,626 ----
    if (head == NULL)
      head = np;
    else
!     add_node(np, head, permit_overlap);
  }
  
  free_tree(node)
***************
*** 615,627 ****
    while (node)
      {
        free_tree(node->right);
!       free(node);
        node = node->left;
      }
  }
  
! add_node(node, cur_node)
       NODE *node,*cur_node;
  {
    register int dif;
  
- --- 629,642 ----
    while (node)
      {
        free_tree(node->right);
!       free((char *)node);
        node = node->left;
      }
  }
  
! add_node(node, cur_node, permit_overlap)
       NODE *node,*cur_node;
+      int permit_overlap;
  {
    register int dif;
  
***************
*** 649,665 ****
        return;
      } 
  
    /* Actually add the node */
    if (dif < 0) 
      {
        if (cur_node->left != NULL)
! 	add_node(node,cur_node->left);
        else
  	cur_node->left = node;
        return;
      }
    if (cur_node->right != NULL)
!     add_node(node,cur_node->right);
    else
      cur_node->right = node;
  }
- --- 664,688 ----
        return;
      } 
  
+   /* patch by S.Sugou */
+   /* In each prolog file, it is a good way not to allow recording the same predicate
+      more than once. */
+   dif = strcmp(node->name, cur_node->name) || strcmp(node->file, cur_node->file);
+   if (!permit_overlap && !dif)
+      return;
+   /* end of patch. */
+ 
    /* Actually add the node */
    if (dif < 0) 
      {
        if (cur_node->left != NULL)
! 	add_node(node,cur_node->left, permit_overlap);
        else
  	cur_node->left = node;
        return;
      }
    if (cur_node->right != NULL)
!     add_node(node,cur_node->right, permit_overlap);
    else
      cur_node->right = node;
  }
***************
*** 908,920 ****
  			  strncpy (tok, token + (lb1.buffer - buf),
  				   tp-token+1);
  			  tok[tp-token+1] = 0;
! 			  pfnote(tok, f, lb1.buffer, endpos, line, linestart);
  			}
  		      else
  			{
  			  strncpy (tok, token, tp-token+1);
  			  tok[tp-token+1] = 0;
! 			  pfnote(tok, f, lb.buffer, endpos, line, linestart);
  			}
  		      gotone = f;	/* function */
  		    }
- --- 931,943 ----
  			  strncpy (tok, token + (lb1.buffer - buf),
  				   tp-token+1);
  			  tok[tp-token+1] = 0;
! 			  pfnote(tok, f, lb1.buffer, endpos, line, linestart, TRUE);
  			}
  		      else
  			{
  			  strncpy (tok, token, tp-token+1);
  			  tok[tp-token+1] = 0;
! 			  pfnote(tok, f, lb.buffer, endpos, line, linestart, TRUE);
  			}
  		      gotone = f;	/* function */
  		    }
***************
*** 1203,1209 ****
    cp[0] = 0;
    strcpy(nambuf, dbp);
    cp[0] = c;
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
    pfcnt++;
  }
  
- --- 1226,1232 ----
    cp[0] = 0;
    strcpy(nambuf, dbp);
    cp[0] = c;
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno, TRUE);
    pfcnt++;
  }
  
***************
*** 1250,1256 ****
    cp[0] = 0;
    strcpy(nambuf, dbp);
    cp[0] = c;
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
    pfcnt++;
  }
  
- --- 1273,1279 ----
    cp[0] = 0;
    strcpy(nambuf, dbp);
    cp[0] = c;
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno, TRUE);
    pfcnt++;
  }
  
***************
*** 1320,1326 ****
    /* Unterminate the string */
    cp[0] = c;
    /* Announce the change */
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
    pfcnt++;
  }
  
- --- 1343,1349 ----
    /* Unterminate the string */
    cp[0] = c;
    /* Announce the change */
!   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno, TRUE);
    pfcnt++;
  }
  
***************
*** 1504,1510 ****
    strncpy (nambuf, name, p - name);
    nambuf[p - name] = 0;
  
!   pfnote (nambuf, TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno);
    pfcnt++;
  }
  
- --- 1527,1533 ----
    strncpy (nambuf, name, p - name);
    nambuf[p - name] = 0;
  
!   pfnote (nambuf, TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno, TRUE);
    pfcnt++;
  }
  
***************
*** 1552,1558 ****
        int c = getc (stream);
        if (p == pend)
  	{
! 	  buffer = (char *) xrealloc (buffer, linebuffer->size *= 2);
  	  p += buffer - linebuffer->buffer;
  	  pend = buffer + linebuffer->size;
  	  linebuffer->buffer = buffer;
- --- 1575,1581 ----
        int c = getc (stream);
        if (p == pend)
  	{
! 	  buffer = (char *) xrealloc (buffer, (int)linebuffer->size *= 2);
  	  p += buffer - linebuffer->buffer;
  	  pend = buffer + linebuffer->size;
  	  linebuffer->buffer = buffer;
***************
*** 1671,1679 ****
  xmalloc (size)
       int size;
  {
!   int result = malloc (size);
    if (!result)
!     fatal ("virtual memory exhausted", 0);
    return result;
  }
  
- --- 1694,1702 ----
  xmalloc (size)
       int size;
  {
!   int result = (int)malloc ((unsigned)size);
    if (!result)
!     fatal ("virtual memory exhausted", (char *)0);
    return result;
  }
  
***************
*** 1682,1689 ****
       char *ptr;
       int size;
  {
!   int result = realloc (ptr, size);
    if (!result)
!     fatal ("virtual memory exhausted");
    return result;
  }
- --- 1705,1843 ----
       char *ptr;
       int size;
  {
!   int result = (int)realloc (ptr, (unsigned)size);
    if (!result)
!     fatal ("virtual memory exhausted", (char *)0);
    return result;
  }
+ 
+ /* patch by S.Sugou */
+ 
+ void
+ prolog_getit(s, lineno, linecharno)
+ char *s;
+ int lineno;
+ long linecharno;
+ /* whole head (not only functor, but also arguments) is gotten in compound term. */
+ {
+    char nambuf[BUFSIZ], *save_s, tmpc;
+    int insquote, npar;
+ 
+    save_s = s;
+    insquote = FALSE; npar = 0;
+    while (1) {
+       if (*s == '\0') /* syntax error. */
+          return;
+       else if (insquote && *s == '\'' && *(s+1) == '\'')
+          s += 2;
+       else if (*s == '\'') {
+          insquote = !insquote;
+          s++; }
+       else if (!insquote && *s == '(') {
+          npar++;
+          s++; }
+       else if(!insquote && *s == ')') {
+          npar--;
+          s++;
+          if (npar == 0)
+             break;
+          else if (npar < 0) /* syntax error. */
+             return; }
+       else if (!insquote && *s == '.' && (isspace(*(s+1)) || *(s+1)=='\0')) { /* fullstop. */
+          if (npar != 0) /* syntax error. */
+             return;
+          s++;
+          break; }
+       else
+          s++; }
+    tmpc = *s;
+    *s = '\0'; strcpy(nambuf, save_s); *s = tmpc;
+    pfnote(nambuf, TRUE, save_s, strlen(nambuf), lineno, linecharno, FALSE);
+ }
+ 
+ void
+ prolog_funcs(fi)
+ FILE *fi;
+ /* It is assumed that prolog predicate starts from colomn 0. */
+ {
+    void skip_comment(), prolog_getit();
+    
+    lineno = linecharno = charno = 0;
+    while (!feof(fi)) {
+       lineno++;
+       linecharno += charno;
+       charno = readline(&lb, fi) + 1; /* 1 for newline. */
+       dbp = lb.buffer;
+       if (isspace(dbp[0])) /* not predicate header. */
+          continue;
+       else if (dbp[0] == '%') /* comment. */
+          continue;
+       else if (dbp[0] == '/' && dbp[1] == '*') /* comment. */
+          skip_comment(&lb, fi, &lineno, &linecharno);
+       else /* found. */
+          prolog_getit(dbp, lineno, linecharno); }
+ }
+ 
+ void
+ skip_comment(plb, fi, plineno, plinecharno)
+ struct linebuffer *plb;
+ FILE *fi;
+ int *plineno; /* result */
+ long *plinecharno; /* result */
+ {
+    while (!substr("*/", plb->buffer)) {
+       (*plineno)++;
+       *plinecharno += readline(plb, fi) + 1; } /* 1 for newline. */
+ }
+ 
+ int
+ substr(sub, s)
+ char *sub;
+ char *s;
+ /* Return TRUE if 'sub' exists somewhere in 's'. */
+ {
+    while (*s && (s = index(s, *sub)))
+       if (prestr(sub, s))
+          return(TRUE);
+       else
+          s++;
+    return(FALSE);
+ }
+ 
+ int
+ prestr(pre, s)
+ char *pre;
+ char *s;
+ /* Return TRUE if 'pre' is prefix of string 's'. */
+ {
+    if (*pre == '\0')
+       return(TRUE);
+    else if (*pre == *s)
+       return(prestr(pre+1, s+1));
+    else
+       return(FALSE);
+ }
+ 
+ main1()
+ /* prestr() */
+ {
+    char s[1000], pre[1000];
+    
+    while (1) {
+       printf("s: "); gets(s);
+       printf("pre: "); gets(pre);
+       printf("%s\n\n", prestr(pre, s) ? "YES" : "NO"); }
+ }
+ 
+ main2()
+ /* substr() */
+ {
+    char s[1000], sub[1000];
+    
+    while (1) {
+       printf("s: "); gets(s);
+       printf("sub: "); gets(sub);
+       printf("%s\n\n", substr(sub, s) ? "YES" : "NO"); }
+ }
+ 
+ /* end of patch */
- ---------------------end of patch-------------------------

Gratefully,

Shinichirou Sugou

------- End of Forwarded Message