The GNU Readline library [http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html] provides a set of functions for use by applications that allow users to edit command lines as they are typed in. Most of the work in the readline library is done by the readline function. ''' Usage ''' The C-code below will provide a Tcl procs readline, history and completion in the readline namespace which can be used as: readline prompt While editing the line all the standard readline functionality is available. A build of the extension for Win32 can be downloaded from [http://marknet.tk/downloads/tclreadline02.dll]. -- [[[MJ]]] '''Notes ''' [slebetman] notes that for the Win32 platform, readline is not necessary as native tclsh on Win32 already have line editing capability including history and history substitution (which I believe is due to DOSKEY). People usually want readline for Tcl when they are on Unix. [MJ] agrees that on Windows it is not necessary per se, but I like a consistent interface in my application regardless if it is run on Linux or Windows. Readline keyboard shortcuts have a tendency to stick in your fingers, which makes working with a Windows CLI application painful. Also note that the code below should be easy to adapt to Linux (probably only changing the dllexport) giving you a binding to readline on Linux. [MJ] -- In the previous build an access violation occured on the free(line_read) this was caused by the fact that the dll linked to msvcr70.dll and msvcrt.dll at the same time. malloc was used from the one dll and free from the other resulting in a crash. The current dll at the url above only links to msvcrt.dll, solving the problem. [MJ] -- 14/08/2006 -- The newer version includes history modification commands and allows the readline completion to be performed by a Tcl proc. This allows integration into your own Tcl programs where the default readline completions don't make sense. It has been tested on Windows, but should be easy to adapt to Linux. A built for Windows compiled against 8.4.13 with stubs enabled can be downloaded from the URL above. '''Code''' ''tclreadline.h'' #ifndef _TCLREADLINE_TCL_H #define _TCLREADLINE_TCL_H static int ReadlineCmd( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) ; static int HistoryCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) ; static int CompletionCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) ; /* completion */ #define NUMBER_OF_COMPLETION_ARGS 5 char ** tcl_completion_generator(const char *text, int start, int end); #endif _TCLREADLINE_TCL_H ''tclreadline.c'' #include #include #include #include #include #include #include #include "tclreadline.h" static char * tcl_completion_proc = NULL; static Tcl_Interp *g_Interp; __declspec(dllexport) int Tclreadline_Init(Tcl_Interp *interp) { if (Tcl_InitStubs(interp, TCL_VERSION, 0) == 0L) { return TCL_ERROR; } /* initialize history */ using_history (); /* store interp for callback */ g_Interp = interp; /* Use default completion */ rl_attempted_completion_function = tcl_completion_generator; /* Make word boundaries more applicable for tcl */ rl_basic_word_break_characters = "\t\n "; Tcl_CreateObjCommand(interp, "::readline::readline", ReadlineCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::readline::completion", CompletionCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::readline::history", HistoryCmd, NULL, NULL); Tcl_PkgProvide(interp, "tclreadline", PKG_VERSION); return TCL_OK; } static int ReadlineCmd( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { char * line_read; if(objc!=2) { Tcl_WrongNumArgs(interp,1,objv,"prompt"); return TCL_ERROR; } /* Get a line from the user. */ line_read = readline (Tcl_GetString(objv[1])); if (line_read!=NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(line_read,-1)); free(line_read); return TCL_OK; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj("EOF entered", -1)); return TCL_ERROR; } } static int HistoryCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { static CONST char *options[] = { "read", "write", "add", (char *) NULL }; enum options { READ, WRITE, ADD }; Tcl_Obj * normalizedPath; char * str; int index; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "option arg"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case READ: if ((normalizedPath = Tcl_FSGetNormalizedPath(interp,objv[2]))==NULL) { Tcl_AppendResult(interp,"unable to normalize path'", Tcl_GetString(objv[2]),"'",NULL); return TCL_ERROR; } if(read_history(Tcl_GetString(normalizedPath))!=0) { Tcl_AppendResult(interp,"unable to open history file '", Tcl_GetString(objv[2]),"'",NULL); return TCL_ERROR; } break; case WRITE: if ((normalizedPath = Tcl_FSGetNormalizedPath(interp,objv[2]))==NULL) { Tcl_AppendResult(interp,"unable to normalize path'", Tcl_GetString(objv[2]),"'",NULL); return TCL_ERROR; } if(write_history(Tcl_GetString(normalizedPath))!=0) { Tcl_AppendResult(interp,"unable to write history file '", Tcl_GetString(objv[2]),"'",NULL); return TCL_ERROR; } break; case ADD: str = Tcl_GetString(objv[2]); if(strcmp(str,"")!=0) { add_history(str); } break; default: // should never happen Tcl_AppendResult(interp, "never has happened",NULL); return TCL_ERROR; } return TCL_OK; } static int CompletionCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { int command_length; char * command_name; Tcl_CmdInfo cmdInfo; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "completionProc"); return TCL_ERROR; } command_name = Tcl_GetStringFromObj(objv[1],&command_length); if (strcmp(command_name,"")==0) { if (tcl_completion_proc!=NULL) { free(tcl_completion_proc); } tcl_completion_proc=NULL; return TCL_OK; } if(Tcl_GetCommandInfo(interp,command_name,&cmdInfo)==0) { Tcl_AppendResult(interp,"unknown command '", command_name,"' not setting completer",NULL); return TCL_ERROR; } if (tcl_completion_proc!=NULL) { free(tcl_completion_proc); } tcl_completion_proc = malloc((command_length+1)*sizeof(char)); strncpy(tcl_completion_proc,command_name,command_length); tcl_completion_proc[command_length]='\0'; rl_attempted_completion_function = tcl_completion_generator; return TCL_OK; } char ** tcl_completion_generator (const char * text, int start, int end) { Tcl_Obj * result=NULL; Tcl_Obj * matches=NULL; Tcl_Obj * word=NULL; Tcl_Obj * objv[NUMBER_OF_COMPLETION_ARGS]; int objc = NUMBER_OF_COMPLETION_ARGS; Tcl_Obj * tmp = NULL; int string_length; char * const_str; int list_length , list_idx; int code; char ** names = NULL; rl_attempted_completion_over = 1; /* do we have to complete? */ if(tcl_completion_proc==NULL) { return NULL; } /* prepare args for callback */ objv[0] = Tcl_NewStringObj(tcl_completion_proc,-1); objv[1] = Tcl_NewStringObj(rl_line_buffer,-1); objv[2] = Tcl_NewStringObj(text,-1); objv[3] = Tcl_NewIntObj(start); objv[4] = Tcl_NewIntObj(end); code = Tcl_EvalObjv(g_Interp,objc,objv,TCL_EVAL_GLOBAL); if (code == TCL_OK) { result = Tcl_GetObjResult(g_Interp); Tcl_ListObjLength(g_Interp,result,&list_length); if(list_length!=2) { fprintf (stderr, "\nexecution of completion proc failed: 'proc should retrun a list of length 2'\n"); return NULL; } Tcl_ListObjIndex(g_Interp,result,0,&word); Tcl_ListObjIndex(g_Interp,result,1,&matches); Tcl_ListObjLength(g_Interp,matches,&list_length); if(list_length==0) { return NULL; } names = malloc((list_length+2)*sizeof(char *)); for (list_idx=0;list_idx