/[gcl]/gcl/o/gcl_readline.d
ViewVC logotype

Diff of /gcl/o/gcl_readline.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Sun Sep 14 02:30:45 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:07 2003 UTC
# Line 0  Line 1 
1    /*
2     Copyright (C) 2000 Tuukka Toivonen <tuukkat AT ee.oulu.fi>
3    
4    This file is part of GNU Common Lisp, herein referred to as GCL
5    
6    GCL is free software; you can redistribute it and/or modify it under
7    the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
8    the Free Software Foundation; either version 2, or (at your option)
9    any later version.
10    
11    GCL is distributed in the hope that it will be useful, but WITHOUT
12    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
14    License for more details.
15    
16    You should have received a copy of the GNU Library General Public License
17    along with GCL; see the file COPYING.  If not, write to the Free Software
18    Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19    */
20    
21    /*
22            readline.d
23    
24            Here we have GNU Readline 4.0 library interface.
25    */
26    
27    #define IN_READLINE
28    #include "include.h"
29    
30    #ifdef HAVE_READLINE
31    
32    /* Here begins GNU Readline support. It was designed for Maxima,
33     * but it works with GCL fine too. If you want to include word completion
34     * code, define RL_COMPLETION, else undefine it.
35     * Todo: context sensitive completion, optional keywords.
36     * To support Readline, we define wrappers (emulation) for putc/ungetc.
37     * by Tuukka Toivonen <tuukkat AT ee.oulu.fi> 2000-07-25, 2000-10-2.
38     */
39    
40    #define RL_COMPLETION
41    
42    #include <stdio.h>
43    #include <stdlib.h>
44    #include <unistd.h>
45    #include <string.h>
46    #if 1
47    #include <readline/readline.h>
48    #include <readline/history.h>
49    #else
50    #include <readline.h>
51    #include <history.h>
52    #endif
53    
54    static int readline_on = 0;             /* On (1) or off (0) */
55    static int rl_ungetc_em_char = -1;
56    static unsigned char *rl_putc_em_line = NULL;
57    
58    #ifdef RL_COMPLETION
59    
60    static char **completion_list = NULL;
61    static int case_sensitivity = 0;        /* 0 = case sensitive */
62                                            /* 1 = complete to lower case */
63                                            /* 2 = complete to upper case */
64    
65    /* Generator function for command completion.  STATE lets us know whether
66       to start from scratch; without any state (i.e. STATE == 0), then we
67       start at the top of the list. */
68    static char *rl_completion_words(char *text, int state) {
69            static int list_index, len;
70            char *name;
71    
72            /* If this is a new word to complete, initialize now.  This includes
73              saving the length of TEXT for efficiency, and initializing the index
74              variable to 0. */
75            if (state==0) {
76                    list_index = 0;
77                    len = strlen(text);
78            }
79    
80            /* Return the next name which partially matches from the command list. */
81            while (completion_list!=NULL && (name=completion_list[list_index])!=NULL) {
82                    list_index++;
83                    if ( (case_sensitivity==0) ?
84                            (strncmp(name, text, len)==0) :
85                            (strncasecmp(name, text, len)==0) ) return strdup(name);
86            }
87    
88            /* If no names matched, then return NULL. */
89            return NULL;
90    }
91    
92    /* Attempt to complete on the contents of TEXT.  START and END bound the
93       region of rl_line_buffer that contains the word to complete.  TEXT is
94       the word to complete.  We can use the entire contents of rl_line_buffer
95       in case we want to do some simple parsing.  Return the array of matches,
96       or NULL if there aren't any. */
97    extern char **completion_matches(char *,char *(*)(char *,int));
98    static char **rl_completion(char *text, int start, int end) {
99            return completion_matches(text, rl_completion_words);
100    }
101    #endif
102    
103    int rl_getc_em(FILE *f) {
104            static unsigned char *line = NULL;
105            static int linepos = 0;
106            int r;
107            
108            if (f!=stdin || !isatty(fileno(f)) ) return getc(f);
109            
110            if (rl_ungetc_em_char!=-1) {
111                    r = rl_ungetc_em_char;
112                    rl_ungetc_em_char = -1;
113                    return r;
114            }
115            
116            if (line==NULL) {
117                    if (readline_on==1) {
118                            putc('\r', stdout);
119                            line = readline(rl_putc_em_line);
120                            if (line==NULL) return EOF;
121                            if (line[0] != 0) add_history(line);
122                    } else {
123                            return getc(f);
124                    }
125            }
126    
127            if (line[linepos]==0) {
128                    free(line);
129                    line = NULL;
130                    linepos = 0;
131                    return '\n';
132            }
133    
134            return line[linepos++];
135    }
136    
137    int rl_ungetc_em(int c, FILE *f) {
138            if (f!=stdin || !isatty(fileno(f)) ) return ungetc(c, f);
139            rl_ungetc_em_char = ((unsigned char)c);
140            return c;
141    }
142    
143    int rl_putc_em(int c, FILE *f) {
144            static int allocated_length = 0;
145            static int current_length = 0;
146            unsigned char *old_line;
147    
148            if (f!=stdout || !isatty(fileno(f)) ) goto tail;
149    
150            if (c=='\r' || c=='\n') {
151                    current_length = 0;
152                    if (allocated_length>0) rl_putc_em_line[0] = 0;
153                    goto tail;
154            }
155            
156            if (current_length+2 > allocated_length) {
157                    allocated_length = (current_length+8)*2;
158                    old_line = rl_putc_em_line;
159                    rl_putc_em_line = realloc(old_line, allocated_length);
160                    if (rl_putc_em_line==NULL) {
161                            free(old_line);
162                            allocated_length = 0;
163                            current_length = 0;
164                            goto tail;
165                    }
166            }
167            
168            rl_putc_em_line[current_length++] = (unsigned char)c;
169            rl_putc_em_line[current_length] = 0;
170    
171            tail:
172            return putc(c, f);
173    }
174    
175    static int qsort_compare(const void *a, const void *b) {
176            const char *ac = *((const char **)a);
177            const char *bc = *((const char **)b);
178            return strcmp(ac, bc);
179    }
180    
181    /* Usage:
182     * (si::READLINE-INIT <onoff> <progname> <case> <wordlist>)
183     * Where
184     *      onoff: T or NIL. T enables Readline support, NIL disables.
185     *              When disabled, uses normal getc calls to read input.
186     *      progname: STRING. Program name for Readline. This is used to specify
187     *              program specific key binding in ~/.inputrc. For more
188     *              information about .inputrc, read Readline documentation.
189     *      case: 0, 1 or 2. Defines how different cases in word completion
190     *              are handled.
191     *              0 = case sensitive completion.
192     *              1 = case insensitive completion. Everything completed to lower case.
193     *              2 = case insensitive completion. Everything completed to upper case.
194     *      wordlist: LIST of STRINGs. These are the candidate words for completion.
195     *              NIL disables word completion.
196     * Examples:
197     * (si::READLINE-INIT nil nil nil nil)          ; Disable Readline
198     * (si::READLINE-INIT t "Gcl" 1 '("first" "second" "third" "rest"))
199     */
200    
201    /* Should this return void or what? Should input args be void? */
202    static void
203    siLreadline_init() {
204            object on_or_off;
205            object program_name;
206            object case_type;
207            object word_list;
208    
209            object con, word;
210            char **charp;
211            int words, i, j;
212            char c,*cp;
213    
214            if (!isatty(0))
215               return;
216    
217            if ((cp=getenv("TERM")) && !strcmp(cp,"dumb"))
218               return;
219    
220            check_arg(4);
221    
222            on_or_off    = vs_base[0];
223            program_name = vs_base[1];
224            case_type    = vs_base[2];
225            word_list    = vs_base[3];
226    
227            if (on_or_off==Cnil) {
228                    /* Disable Readline support */
229                    readline_on = 0;
230            } else {
231                    /* Enable Readline support */
232                    readline_on = 1;
233    
234                    if (type_of(program_name)==t_string) {
235    
236                            static char *mrln;
237    
238                            if (mrln)
239                                    free(mrln);
240                            mrln = malloc(program_name->st.st_fillp+1);
241                            if (!mrln) FEerror("Out of memory.", 0);
242                            for (i=0; i<program_name->st.st_fillp; i++)
243                                    mrln[i] = program_name->ust.ust_self[i];
244                            mrln[i] = 0;
245                            rl_readline_name=mrln;
246                            rl_initialize();
247                    } else {
248                            FEerror("~S is not a string.", 1, program_name);
249                    }
250    
251                    if (type_of(case_type)==t_fixnum) {
252                            i = fix(case_type);
253                            if (i<0 || i>2) FEerror("Case sensitivity must be between 0 and 2", 0);
254                            case_sensitivity = i;
255                    } else {
256                            FEerror("~S is not a fixnum.", 1, case_type);
257                    }
258    
259                    if (type_of(word_list)==t_cons || word_list==Cnil) {
260    #ifdef RL_COMPLETION
261                            /* First count the number of completion words and check their type */
262                            words = 0;
263                            for (con=word_list; con!=Cnil; con=con->c.c_cdr) {
264                                    word = con->c.c_car;
265                                    if (type_of(word)!=t_string)
266                                            FEerror("Completion list ~S contains non-strings.", 1, word_list);
267                                    words++;
268                            }
269    
270                            /* Free old list */
271                            if (completion_list!=NULL) {
272                                    for (charp=completion_list; *charp!=NULL; charp++)
273                                            free(*charp);
274                                    free(completion_list);
275                            }
276    
277                            /* Set up the new completion list */
278                            completion_list = malloc(sizeof(*completion_list) * (words+1));
279                            if (completion_list==NULL) FEerror("Out of memory.", 0);
280                            for (con=word_list,i=0; con!=Cnil; con=con->c.c_cdr,i++) {
281                                    word = con->c.c_car;
282                                    completion_list[i] = malloc(sizeof(char) * (word->st.st_fillp+1));
283                                    if (completion_list[i]==NULL) FEerror("Out of memory.", 0);
284                                    for (j=0; j<word->st.st_fillp; j++) {  
285                                            c = word->ust.ust_self[j];
286                                            if (case_sensitivity!=0)
287                                                    c = (case_sensitivity==1) ? tolower(c) : toupper(c);
288                                            (completion_list[i])[j] = c;
289                                    }
290                                    (completion_list[i])[j] = 0;
291                            }
292                            completion_list[i] = NULL;
293    
294                            /* Sort the completion list */
295                            qsort(completion_list, words, sizeof(*completion_list), &qsort_compare);
296    #endif
297                    } else {
298                            FEerror("~S is not a list.", 1, word_list);
299                            /* or maybe use FEwrong_type_argument(...); */
300                    }
301            }
302    }
303    
304    void
305    gcl_init_readline_function(void) {
306            rl_readline_name = NULL;
307    #ifdef RL_COMPLETION
308            rl_attempted_completion_function = (CPPFunction *)rl_completion;
309    #endif                  
310            make_si_function("READLINE-INIT", siLreadline_init);
311    }
312    
313    #endif /* HAVE_READLINE */

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26