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

Diff of /gcl/o/readline.d

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

revision 1.1 by camm, Thu Dec 20 00:00:27 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 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    static char **rl_completion(char *text, int start, int end) {
98            return completion_matches(text, rl_completion_words);
99    }
100    #endif
101    
102    int rl_getc_em(FILE *f) {
103            static unsigned char *line = NULL;
104            static int linepos = 0;
105            int r;
106            
107            if (f!=stdin || !isatty(fileno(f)) ) return getc(f);
108            
109            if (rl_ungetc_em_char!=-1) {
110                    r = rl_ungetc_em_char;
111                    rl_ungetc_em_char = -1;
112                    return r;
113            }
114            
115            if (line==NULL) {
116                    if (readline_on==1) {
117                            putc('\r', stdout);
118                            line = readline(rl_putc_em_line);
119                            if (line==NULL) return EOF;
120                            if (line[0] != 0) add_history(line);
121                    } else {
122                            return getc(f);
123                    }
124            }
125    
126            if (line[linepos]==0) {
127                    free(line);
128                    line = NULL;
129                    linepos = 0;
130                    return '\n';
131            }
132    
133            return line[linepos++];
134    }
135    
136    int rl_ungetc_em(int c, FILE *f) {
137            if (f!=stdin || !isatty(fileno(f)) ) return ungetc(c, f);
138            rl_ungetc_em_char = ((unsigned char)c);
139            return c;
140    }
141    
142    int rl_putc_em(int c, FILE *f) {
143            static int allocated_length = 0;
144            static int current_length = 0;
145            unsigned char *old_line;
146    
147            if (f!=stdout || !isatty(fileno(f)) ) goto tail;
148    
149            if (c=='\r' || c=='\n') {
150                    current_length = 0;
151                    if (allocated_length>0) rl_putc_em_line[0] = 0;
152                    goto tail;
153            }
154            
155            if (current_length+2 > allocated_length) {
156                    allocated_length = (current_length+8)*2;
157                    old_line = rl_putc_em_line;
158                    rl_putc_em_line = realloc(old_line, allocated_length);
159                    if (rl_putc_em_line==NULL) {
160                            free(old_line);
161                            allocated_length = 0;
162                            current_length = 0;
163                            goto tail;
164                    }
165            }
166            
167            rl_putc_em_line[current_length++] = (unsigned char)c;
168            rl_putc_em_line[current_length] = 0;
169    
170            tail:
171            return putc(c, f);
172    }
173    
174    static int qsort_compare(const void *a, const void *b) {
175            const char *ac = *((const char **)a);
176            const char *bc = *((const char **)b);
177            return strcmp(ac, bc);
178    }
179    
180    /* Usage:
181     * (si::READLINE-INIT <onoff> <progname> <case> <wordlist>)
182     * Where
183     *      onoff: T or NIL. T enables Readline support, NIL disables.
184     *              When disabled, uses normal getc calls to read input.
185     *      progname: STRING. Program name for Readline. This is used to specify
186     *              program specific key binding in ~/.inputrc. For more
187     *              information about .inputrc, read Readline documentation.
188     *      case: 0, 1 or 2. Defines how different cases in word completion
189     *              are handled.
190     *              0 = case sensitive completion.
191     *              1 = case insensitive completion. Everything completed to lower case.
192     *              2 = case insensitive completion. Everything completed to upper case.
193     *      wordlist: LIST of STRINGs. These are the candidate words for completion.
194     *              NIL disables word completion.
195     * Examples:
196     * (si::READLINE-INIT nil nil nil nil)          ; Disable Readline
197     * (si::READLINE-INIT t "Gcl" 1 '("first" "second" "third" "rest"))
198     */
199    
200    /* Should this return void or what? Should input args be void? */
201    static siLreadline_init() {
202            object on_or_off;
203            object program_name;
204            object case_type;
205            object word_list;
206    
207            object con, word;
208            char **charp;
209            int words, i, j;
210            char c;
211    
212            check_arg(4);
213    
214            on_or_off    = vs_base[0];
215            program_name = vs_base[1];
216            case_type    = vs_base[2];
217            word_list    = vs_base[3];
218    
219            if (on_or_off==Cnil) {
220                    /* Disable Readline support */
221                    readline_on = 0;
222            } else {
223                    /* Enable Readline support */
224                    readline_on = 1;
225    
226                    if (type_of(program_name)==t_string) {
227                            if (rl_readline_name)
228                                    free(rl_readline_name);
229                            rl_readline_name = malloc(program_name->st.st_fillp+1);
230                            if (rl_readline_name==NULL) FEerror("Out of memory.", 0);
231                            for (i=0; i<program_name->st.st_fillp; i++)
232                                    rl_readline_name[i] = program_name->ust.ust_self[i];
233                            rl_readline_name[i] = 0;
234                            rl_initialize();
235                    } else {
236                            FEerror("~S is not a string.", 1, program_name);
237                    }
238    
239                    if (type_of(case_type)==t_fixnum) {
240                            i = fix(case_type);
241                            if (i<0 || i>2) FEerror("Case sensitivity must be between 0 and 2", 0);
242                            case_sensitivity = i;
243                    } else {
244                            FEerror("~S is not a fixnum.", 1, case_type);
245                    }
246    
247                    if (type_of(word_list)==t_cons || word_list==Cnil) {
248    #ifdef RL_COMPLETION
249                            /* First count the number of completion words and check their type */
250                            words = 0;
251                            for (con=word_list; con!=Cnil; con=con->c.c_cdr) {
252                                    word = con->c.c_car;
253                                    if (type_of(word)!=t_string)
254                                            FEerror("Completion list ~S contains non-strings.", 1, word_list);
255                                    words++;
256                            }
257    
258                            /* Free old list */
259                            if (completion_list!=NULL) {
260                                    for (charp=completion_list; *charp!=NULL; charp++)
261                                            free(*charp);
262                                    free(completion_list);
263                            }
264    
265                            /* Set up the new completion list */
266                            completion_list = malloc(sizeof(*completion_list) * (words+1));
267                            if (completion_list==NULL) FEerror("Out of memory.", 0);
268                            for (con=word_list,i=0; con!=Cnil; con=con->c.c_cdr,i++) {
269                                    word = con->c.c_car;
270                                    completion_list[i] = malloc(sizeof(char) * (word->st.st_fillp+1));
271                                    if (completion_list[i]==NULL) FEerror("Out of memory.", 0);
272                                    for (j=0; j<word->st.st_fillp; j++) {  
273                                            c = word->ust.ust_self[j];
274                                            if (case_sensitivity!=0)
275                                                    c = (case_sensitivity==1) ? tolower(c) : toupper(c);
276                                            (completion_list[i])[j] = c;
277                                    }
278                                    (completion_list[i])[j] = 0;
279                            }
280                            completion_list[i] = NULL;
281    
282                            /* Sort the completion list */
283                            qsort(completion_list, words, sizeof(*completion_list), &qsort_compare);
284    #endif
285                    } else {
286                            FEerror("~S is not a list.", 1, word_list);
287                            /* or maybe use FEwrong_type_argument(...); */
288                    }
289            }
290    }
291    
292    init_readline_function()
293    {
294            rl_readline_name = NULL;
295    #ifdef RL_COMPLETION
296            rl_attempted_completion_function = (CPPFunction *)rl_completion;
297    #endif                  
298            make_si_function("READLINE-INIT", siLreadline_init);
299    }
300    
301    #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