gcl-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Gcl-devel] readline support


From: Camm Maguire
Subject: Re: [Gcl-devel] readline support
Date: 05 Jan 2004 15:25:16 -0500
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2

Greetings!  Could people please take a look at this patch against the
current stable cvs branch (2.6.1) and report back?

Take care,

=============================================================================
Index: configure.in
===================================================================
RCS file: /cvsroot/gcl/gcl/configure.in,v
retrieving revision 1.112.4.1.2.2.2.19
diff -u -b -r1.112.4.1.2.2.2.19 configure.in
--- configure.in        30 Dec 2003 16:23:29 -0000      1.112.4.1.2.2.2.19
+++ configure.in        5 Jan 2004 20:23:19 -0000
@@ -1033,13 +1033,18 @@
 fi
 AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [TLIBS="$TLIBS -lnsl"]))
 
+RL_OBJS=""
+RL_LIB=""
 if test "$enable_readline" = "yes" ; then
        AC_CHECK_HEADERS(readline/readline.h,
                AC_CHECK_LIB(readline,main,
                        AC_DEFINE(HAVE_READLINE) 
                        TLIBS="$TLIBS -lreadline -lncurses"
                        RL_OBJS=gcl_readline.o
-                       RL_LIB=lsp/gcl_readline.o,,-lncurses))
+# Readline support now initialized automatically when compiled in, this lisp
+# object no longer needed -- 20040102 CM
+#                      RL_LIB=lsp/gcl_readline.o
+                       ,,-lncurses))
 fi
 
 AC_SUBST(RL_OBJS)
Index: o/gcl_readline.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/gcl_readline.d,v
retrieving revision 1.1.2.2
diff -u -b -r1.1.2.2 gcl_readline.d
--- o/gcl_readline.d    6 Nov 2003 16:16:50 -0000       1.1.2.2
+++ o/gcl_readline.d    5 Jan 2004 20:23:19 -0000
@@ -57,6 +57,11 @@
 
 #ifdef RL_COMPLETION
 
+
+/* New completion generator avoids malloc excet where required, and
+   dynamically searches current package lists -- 20040102 CM */
+#if 0
+
 static char **completion_list = NULL;
 static int case_sensitivity = 0;       /* 0 = case sensitive */
                                        /* 1 = complete to lower case */
@@ -89,6 +94,79 @@
        return NULL;
 }
 
+#endif
+
+/* New completion generator avoids malloc excet where required, and
+   dynamically searches current package lists -- 20040102 CM */
+
+static char *rl_completion_words_new(char *text, int state) {
+  static int i,len,internal,size;
+  static object package,use,tp,*base,l;
+  static const char *ftext,*wtext;
+  
+  if (state==0) {
+    static char *mch;
+
+    mch=strchr(text,':');
+    if (!mch) 
+      package=sLApackageA->s.s_dbind;
+    else {
+      if (mch==text) 
+       package=(mch[1]==':') ? sLApackageA->s.s_dbind : keyword_package;
+      else {
+       struct string s={t_string,0,0,0,OBJNULL,1,0,text,mch-text};
+       package=find_package((object)&s);
+      }
+    }
+    
+    package=package ? package : user_package;
+    use=package->p.p_uselist;
+    internal=mch && mch[1]==':' ? 1 : 0;
+    ftext=text;
+    wtext=mch ? mch+internal+1 : ftext;
+    len=strlen(wtext);
+    tp=package;
+    i=0;
+    base=internal ? tp->p.p_internal : tp->p.p_external;
+    size=internal ? tp->p.p_internal_size : tp->p.p_external_size;
+    l=base[i];
+
+  }
+
+  while (tp && tp != Cnil) {
+
+    while (1) {
+      while (type_of(l)==t_cons) {
+       object st=l->c.c_car;
+       l=l->c.c_cdr;
+       if (st->st.st_fillp>=len && 
+           !strncasecmp(wtext,st->st.st_self,len)) {
+         static char *c;
+         c=malloc((wtext-ftext)+st->st.st_fillp+1);
+         memcpy(c,ftext,wtext-ftext);
+         memcpy(c+(wtext-ftext),st->st.st_self,st->st.st_fillp);
+         c[(wtext-ftext)+st->st.st_fillp]=0;
+         return c;
+       }
+      }
+      if (++i==size)
+       break;
+      l=base[i];
+    }      
+
+    tp=use->c.c_car;
+    use=use->c.c_cdr;
+    base=internal ? tp->p.p_internal : tp->p.p_external;
+    size=internal ? tp->p.p_internal_size : tp->p.p_external_size;
+    i=0;
+    l=base[i];
+
+  }
+
+  return NULL;
+  
+}
+
 /* Attempt to complete on the contents of TEXT.  START and END bound the
    region of rl_line_buffer that contains the word to complete.  TEXT is
    the word to complete.  We can use the entire contents of rl_line_buffer
@@ -96,7 +174,7 @@
    or NULL if there aren't any. */
 extern char **completion_matches(char *,char *(*)(char *,int));
 static char **rl_completion(char *text, int start, int end) {
-       return completion_matches(text, rl_completion_words);
+       return completion_matches(text, rl_completion_words_new);
 }
 #endif
 
@@ -172,6 +250,9 @@
        return putc(c, f);
 }
 
+/* readline support now initialized automatically -- 20040102 CM */
+#if 0
+
 static int qsort_compare(const void *a, const void *b) {
        const char *ac = *((const char **)a);
        const char *bc = *((const char **)b);
@@ -300,14 +381,52 @@
                }
        }
 }
+#endif
+
+
+static void
+FFN(siLreadline_on)() {
+
+  const char *cp;
+
+  if (!isatty(0)) {
+    FEerror("GCL is not being run from a terminal", 0);
+    return;
+  }
+  
+  if ((cp=getenv("TERM")) && !strcmp(cp,"dumb")) {
+    FEerror("Controlling terminal is not readline capable", 0);
+    return;
+  }
+
+  readline_on=1;
+  return;
+
+}
+
+static void
+FFN(siLreadline_off)() {
+
+  readline_on=0;
+  return;
+
+}
 
 void
 gcl_init_readline_function(void) {
-       rl_readline_name = NULL;
+  static int n;
+  char *pn="GCL",*cp=getenv("TERM");
+  rl_readline_name=pn;
 #ifdef RL_COMPLETION
        rl_attempted_completion_function = (CPPFunction *)rl_completion;
 #endif                 
-       make_si_function("READLINE-INIT", siLreadline_init); 
+  if (isatty(0) && (!cp || strcmp(cp,"dumb")))
+    readline_on=1;
+  if (!n) {
+    make_si_function("READLINE-ON", siLreadline_on);
+    make_si_function("READLINE-OFF", siLreadline_off);
+    n=1;
+  }
 }
 
 #endif /* HAVE_READLINE */
Index: lsp/makefile
===================================================================
RCS file: /cvsroot/gcl/gcl/lsp/makefile,v
retrieving revision 1.18.6.4
diff -u -b -r1.18.6.4 makefile
--- lsp/makefile        24 Sep 2003 15:48:45 -0000      1.18.6.4
+++ lsp/makefile        5 Jan 2004 20:23:19 -0000
@@ -36,7 +36,7 @@
        "${APPEND} ${NULLFILE} $*.data $*.o "
 
 
-all:   $(OBJS) $(RL_OBJS)
+all:   $(OBJS) #$(RL_OBJS)
 
 
 
=============================================================================

address@hidden writes:

>       However, I'm not sure whether this should be the
>       external symbols of the current package, external
>       and internal, or these and the inherited symbols.
>       I'm leaning toward external symbols of the current
>       package and its package use list be default,
>       with a possible alternate behavior when one or
>       more colons appear.  Thoughts?
> 
> Yes.  The external symbols of the current package and its
> used packages, yes that would be nice.
> 
> What if by prefixing two colons, only internal symbols
> would be expanded?
> 
> If I write a package name and one colon, it should behave
> as if that package is the current package.  If I use two
> colons it should only try and complete internal symbols
> (including inherited internal symbols, perhaps).  If I
> use two colons without any package name in front of them
> it should complete internal symbols in the current package
> (and again perhaps also all inherited internal symbols of
> the current package).
> 
> On the other hand, maybe two colons should just complete
> all symbols whether they are internal, shadowed or
> external.  I have on a few occassions missed the ability
> to find an internal symbol by simple completion.  It can
> be very handy.  I do not know if this is general enough
> to warrant its implementation.
> 
> Thanks for all your work!
> 
> --
> Dennis Decker Jensen
> 
> 
> 
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
> 
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah




reply via email to

[Prev in Thread] Current Thread [Next in Thread]