source: trunk/base/src/pextlib1.0/readline.c @ 15730

Last change on this file since 15730 was 15730, checked in by jberry, 15 years ago

Add readline and rl_history support to pextlib
Part of merge from branch jberry-preview-13

  • Property svn:eol-style set to native
File size: 7.7 KB
Line 
1/*
2 * readline.c
3 *
4 * Some basic readline support callable from Tcl
5 * By James D. Berry <jberry@opendarwin.org> 10/27/05
6 *
7 * $Id: readline.c,v 1.2 2006/01/07 23:08:58 jberry Exp $
8 *
9 */
10
11#if HAVE_CONFIG_H
12#include <config.h>
13#endif
14
15#if HAVE_STDLIB_H
16#include <stdlib.h>
17#endif
18
19#if HAVE_STRING_H
20#include <string.h>
21#endif
22
23#include <stdio.h>
24
25#if HAVE_READLINE_READLINE_H
26#include <readline/readline.h>
27#endif
28
29#if HAVE_READLINE_HISTORY_H
30#include <readline/history.h>
31#endif
32
33#include <tcl.h>
34#include "readline.h"
35
36
37/* Globals */
38#if HAVE_READLINE_READLINE_H
39Tcl_Interp* completion_interp = NULL;
40Tcl_Obj* attempted_completion_word = NULL;
41Tcl_Obj* generator_word = NULL;
42#endif
43
44/* Work-around libedit incompatibilities */
45#if HAVE_DECL_RL_FILENAME_COMPLETION_FUNCTION
46#       define FILENAME_COMPLETION_FUNCTION     rl_filename_completion_function
47#elif HAVE_DECL_FILENAME_COMPLETION_FUNCTION
48#       define FILENAME_COMPLETION_FUNCTION     filename_completion_function
49#endif
50
51#if HAVE_DECL_RL_USERNAME_COMPLETION_FUNCTION
52#       define USERNAME_COMPLETION_FUNCTION     rl_username_completion_function
53#elif HAVE_DECL_USERNAME_COMPLETION_FUNCTION
54#       define USERNAME_COMPLETION_FUNCTION     username_completion_function
55#endif
56
57#if HAVE_DECL_RL_COMPLETION_MATCHES
58#       define COMPLETION_MATCHES rl_completion_matches
59#elif HAVE_DECL_COMPLETION_MATCHES
60#       define COMPLETION_MATCHES completion_matches
61#endif
62
63
64#if HAVE_LIBREADLINE
65char*
66completion_generator(const char* text, int state)
67{
68        const char* match = NULL;
69        if (completion_interp && generator_word) {
70                Tcl_Obj* objv[4];
71                objv[0] = generator_word;
72                objv[1] = Tcl_NewStringObj(text, -1);
73                objv[2] = Tcl_NewIntObj(state);
74                objv[3] = NULL;
75               
76                if (TCL_OK == Tcl_EvalObjv(completion_interp, 3, objv, TCL_EVAL_DIRECT)) {
77                        match = Tcl_GetStringResult(completion_interp);
78                }
79        }
80       
81        return (match && *match) ? strdup(match) : NULL;
82}
83
84       
85char**
86attempted_completion_function(const char* word, int start, int end)
87{
88        /*
89                If we can complete the text at start/end, then
90                call rl_completion_matches with a generator function,
91                else return NULL.
92               
93                We call:
94                        attempted_completion_word line_buffer word start end
95                       
96                If it returns a null string, then we return NULL,
97                otherwise, we use the string returned as a proc name
98                to call into to generate matches
99        */
100       
101        char** matches = NULL;
102       
103        if (completion_interp && attempted_completion_word) {
104       
105                Tcl_Obj* objv[6];
106                objv[0] = attempted_completion_word;
107                objv[1] = Tcl_NewStringObj(rl_line_buffer, -1);
108                objv[2] = Tcl_NewStringObj(word, -1);
109                objv[3] = Tcl_NewIntObj(start);
110                objv[4] = Tcl_NewIntObj(end);
111                objv[5] = NULL;
112               
113                if (TCL_OK == Tcl_EvalObjv(completion_interp, 5, objv, TCL_EVAL_DIRECT)) {
114                        /* If the attempt proc returns a word result, it's the
115                           word to call as a generator function
116                         */
117                        generator_word = Tcl_GetObjResult(completion_interp);
118                        if (generator_word && Tcl_GetCharLength(generator_word)) {
119                                char* (*generator_func)(const char* text, int state) = NULL;
120                                char* s = NULL;
121                               
122                                Tcl_IncrRefCount(generator_word);
123                               
124                                /*
125                                        We support certain built-in completion functions:
126                                                - filename_completion
127                                                - username_completion
128                                 */
129                                s = Tcl_GetString(generator_word);
130                                if (0 == strcmp("filename_completion", s))
131                                        generator_func = FILENAME_COMPLETION_FUNCTION;
132                                else if (0 == strcmp("username_completion", s))
133                                        generator_func = USERNAME_COMPLETION_FUNCTION;
134                                else {
135                                        /* Not a built-in completer, so call the word as a command */
136                                        generator_func = completion_generator;
137                                }
138                               
139                                matches = COMPLETION_MATCHES(word, generator_func);
140
141                                       
142                                Tcl_DecrRefCount(generator_word);
143                        }
144                }
145        }
146       
147        return matches;
148}
149#endif
150
151
152/*
153        readline action
154       
155        actions:
156                init ?name?
157                read line ?prompt?
158                read -attempted_completion proc line ?prompt?
159                completion_matches text function
160*/
161int ReadlineCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
162{
163        char* action;
164        Tcl_Obj *tcl_result;
165        int argbase;
166        int argcnt;
167       
168        /* Get the action */
169        if (objc < 2) {
170                Tcl_WrongNumArgs(interp, 1, objv, "action");
171                return TCL_ERROR;
172        }
173        action = Tcl_GetString(objv[1]);
174
175        /* Case out on action */
176        if        (0 == strcmp("init", action)) {
177       
178                int initOk = 0;
179               
180#if HAVE_LIBREADLINE
181                /* Set the name of our program, so .inputrc can be conditionalized */
182                if (objc == 3) {
183                        rl_readline_name = strdup(Tcl_GetString(objv[2]));
184                } else if (objc != 2) {
185                        Tcl_WrongNumArgs(interp, 1, objv, "init");
186                        return TCL_ERROR;
187                }
188
189                /* Initialize history */
190                using_history();
191
192                /* Setup for completion */
193                rl_attempted_completion_function = attempted_completion_function;
194
195                initOk = 1;             
196#endif
197       
198                tcl_result = Tcl_NewIntObj(initOk);     
199                Tcl_SetObjResult(interp, tcl_result);
200
201#if HAVE_LIBREADLINE
202        } else if (0 == strcmp("read", action)) {
203       
204                char* s;
205                char* line;
206                char* line_name;
207                char* prompt = "default prompt: ";
208                int line_len;
209               
210                /* Initialize completion stuff */
211                completion_interp = interp;
212                attempted_completion_word = NULL;
213                generator_word = NULL;
214               
215                /* Process optional parameters */
216                for (argbase = 2; argbase < objc; ) {
217                        s = Tcl_GetString(objv[argbase]);
218                        if (!s || s[0] != '-')
219                                break;
220                        ++argbase;
221                       
222                        if (0 == strcmp("-attempted_completion", s)) {
223                                if (argbase >= objc) {
224                                        Tcl_WrongNumArgs(interp, 1, objv, "-attempted_completion");
225                                        return TCL_ERROR;
226                                }
227                                attempted_completion_word = objv[argbase++];
228                        } else {
229                                Tcl_AppendResult(interp, "Unsupported argument: ", s, NULL);
230                                return TCL_ERROR;
231                        }
232                }
233                argcnt = objc - argbase;
234               
235                /* Pick a prompt */
236                if (argcnt == 2) {
237                        prompt = Tcl_GetString(objv[argbase + 1]);
238                } else if (argcnt != 1) {
239                        Tcl_WrongNumArgs(interp, 1, objv, "read -arg... line ?prompt?");
240                        return TCL_ERROR;
241                }
242       
243                /* Read the line */
244                line = readline(prompt);
245                line_len = (line == NULL) ? -1 : (int)strlen(line);
246       
247                line_name = Tcl_GetString(objv[argbase + 0]);
248                Tcl_SetVar(interp, line_name, (line == NULL) ? "" : line, 0); 
249                free(line);
250               
251                tcl_result = Tcl_NewIntObj(line_len);   
252                Tcl_SetObjResult(interp, tcl_result);
253       
254#endif
255        } else {
256       
257                Tcl_AppendResult(interp, "Unsupported action: ", action, NULL);
258                return TCL_ERROR;
259               
260        }
261
262        return TCL_OK;
263}
264
265
266/*
267        rl_history action
268       
269        action:
270                add line
271                read filename
272                write filename
273                stifle max
274                unstifle
275*/
276int RLHistoryCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
277{
278        char* action = NULL;
279        char* s = NULL;
280        int i = 0;
281        Tcl_Obj *tcl_result;
282
283        if (objc < 2) {
284                Tcl_WrongNumArgs(interp, 1, objv, "action");
285                return TCL_ERROR;
286        }
287        action = Tcl_GetString(objv[1]);
288
289        /* Case out on action */
290        if (0) {
291#if HAVE_LIBREADLINE
292        } else if (0 == strcmp("add", action)) {
293                if (objc != 3) {
294                        Tcl_WrongNumArgs(interp, 1, objv, "add line");
295                        return TCL_ERROR;
296                }
297                s = Tcl_GetString(objv[2]);
298                add_history(s);
299        } else if (0 == strcmp("read", action)) {
300                if (objc != 3) {
301                        Tcl_WrongNumArgs(interp, 1, objv, "read filename");
302                        return TCL_ERROR;
303                }
304                s = Tcl_GetString(objv[2]);
305                read_history(s);
306        } else if (0 == strcmp("write", action)) {
307                if (objc != 3) {
308                        Tcl_WrongNumArgs(interp, 1, objv, "write filename");
309                        return TCL_ERROR;
310                }
311                s = Tcl_GetString(objv[2]);
312                write_history(s);
313        } else if (0 == strcmp("stifle", action)) {
314                if (objc != 3) {
315                        Tcl_WrongNumArgs(interp, 1, objv, "stifle maxlines");
316                        return TCL_ERROR;
317                }
318                if (TCL_OK == Tcl_GetIntFromObj(interp, objv[2], &i))
319                        stifle_history(i);
320        } else if (0 == strcmp("unstifle", action)) {
321                if (objc != 2) {
322                        Tcl_WrongNumArgs(interp, 1, objv, "unstifle");
323                        return TCL_ERROR;
324                }
325                i = unstifle_history();
326                tcl_result = Tcl_NewIntObj(i);
327                Tcl_SetObjResult(interp, tcl_result);
328#endif
329        } else {
330                Tcl_AppendResult(interp, "Unsupported action: ", action, NULL);
331                return TCL_ERROR;
332        }
333
334        return TCL_OK;
335}
Note: See TracBrowser for help on using the repository browser.