Updated 2013-01-18 16:09:30 by pooryorick

The GNU Readline library [1] 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 Example

The C-code below will provide Tcl procs readline, history and completion in the readline namespace. A Win32 build can be downloaded from [2]. Remember to put readline.dll somewhere in your path if you use this. You can use the readline5.dll from [3]

The readline procs can be used to create for instance a basic Tcl sh with command completion:
package require tclreadline


# This proc returns the larges common startstring in a list, e.g.:
# for {list link} it will return li
 
namespace eval readline {
    namespace export readline history
    proc largest_common_substring { word matches } {
        # returns a list with the largest common substring
        if {[llength $matches]==1} {
            return [list [lindex $matches 0] $matches]
        }
        set subword $word
        while {[llength [lsearch -inline -all $matches $subword*]]==[llength $matches]} {
            if {$subword eq [lindex $matches 0]} break;
            set word $subword
            set subword [string range [lindex $matches 0] 0 [string length $word]]
        }
        return [list $word $matches]

    }
}

readline::history read ~/.sh_history ; # read saved history

# unknown should behave as in an interactive tclsh
set tcl_interactive 1 ; info script ""

# save history before exit use hide instead if rename so no _exit is show in [info commands]
interp hide {} exit
 
proc exit {args} {
     readline::history write ~/.sh_history
     interp invokehidden {} exit
}

# Define completion proc
# The completion proc is called from readline with the arguments:
# line:  The complete line in the readline buffer
# word:  The word that is being completed
# start: The start index of the word in line
# end:   The end index of the word in line
#
# A completion proc returns a list with two elements 
# 0: The text that will replace the word that is being completed
# 1: A list of all possible matches for the word that is currently being completed

proc complete {line word start end} {
    set matches {}
    if {[string index $word 0] eq {$}} {
        # variable completion
        set var_name [string range $word 1 end]
        foreach var [uplevel #0 [list info vars ${var_name}*]] {
            lappend matches \$[set var]
        }
    } elseif {$word eq $line} {
        # command completion
        set matches [uplevel #0 [list info commands $word*]]
        foreach ns [namespace children ::] {
            if {[string match $word* $ns]!=0} {
                lappend matches $ns
            }
        }
    } else {
        foreach file [glob -nocomplain $word*] {
            string map [list [file normalize ~] ~] $file
            lappend matches [string map  {{ } {\ }} $file]
        }
        foreach file [glob -nocomplain -type hidden $word*] {
            string map [list [file normalize ~] ~] $file
            lappend matches [string map  {{ } {\ }} $file]
        }
    }
    # suppress space
    if {[llength $matches] == 1} {
        return [list [lindex $matches 0] [list {}]]
    }
    return [::readline::largest_common_substring $word $matches]
} 

 
# register compeletion proc, completion can be disabled by readline::completion {}

readline::completion complete
    
# command loop
while {1} {
    set command [readline::readline "([file tail [pwd]]) % "]
    while {![info complete $command]} {
     set command $command\n[readline::readline "> "]
    }
    readline::history add $command
    catch [eval $command] result
    if {($result ne "") && ([string range $command end-1 end] ne ";;")} { 
        puts $result
    }
}

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 removing the __declspec(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.

MJ -- When calling readline::readline, no event processing in the eventloop will take place. This is something to keep in mind when including this in GUI apps. It can be worked around by executing readline in a different thread from everything else. See [4].

Code

tclreadline.tcl
load [file dirname [info script]]/tclreadline01.dll
namespace eval readline {
    namespace export readline history
    proc largest_common_substring { word matches } {
        # returns a list with the largest common substring
        if {[llength $matches]==1} {
            return [list [lindex $matches 0] $matches]
        }
        set subword $word
        while {[llength [lsearch -inline -all $matches $subword*]]==[llength $matches]} {
            set word $subword
            if {$subword eq [lindex $matches 0]} { break; }
            set subword [string range [lindex $matches 0] 0 [string length $word]]
        }
        return [list $word $matches]

    }
} 

pkgIndex.tcl
package ifneeded tclreadline 0.1 \
[list source [file dirname [info script]]/tclreadline.tcl]

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
static char ** tcl_completion_generator(const char *text, int start, int end);

#endif _TCLREADLINE_TCL_H

'tclreadline.c''
#include <tcl.h>
#include <string.h>
#include <readline/readline.h>
#include <readline/history.h>
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>


#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) {
        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;
    }

    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;
}

static 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<list_length; list_idx++) {

            Tcl_ListObjIndex(g_Interp,matches,list_idx,&tmp);
            const_str = Tcl_GetStringFromObj(tmp,&string_length);
            names[list_idx+1] = malloc((string_length+1)*sizeof(char)); 
            strncpy(names[list_idx+1],const_str,string_length);
            names[list_idx+1][string_length] = '\0';
        }
        names[list_length+1]=(char *)NULL;
        names[0] = strdup(Tcl_GetString(word));
    } else {
        /* TODO is there a way to let this result in an tcl error?  */
        fprintf (stderr, "\nexecution of completion proc failed: '%s'\n", Tcl_GetStringResult(g_Interp));
        return NULL;
    }
    return (names);
}

See also:


For those on Linux (and probably most other Unix-like platforms) who don't want to bother building an extension, rlwrap [5] can provide readline editing with:
rlwrap tclsh 

There are other command history filters. These are programs which sit between the user's shell and a program and attempt to provide a history mechanism to commands which have no such capability. One that used to be mentioned is "ile". The master site for the latest version of ile that I knew was is ftp://ftp.inria.fr/system/user/lile-2.0.tar.z , but that URL is no longer active. If someone knows where the latest is, please rewrite this paragraph to mention it.

Another commonly referred command history program is "fep". The master ftp site for the source code for it is ftp://ftp.sra.co.jp/pub/cmd/fep/fep.tar.gz .

See also cle (http://kaolin.unice.fr/Cle/) which has been mentioned as a command history filter that Linux users have available.

A useful place to begin looking for source code for these and other programs is ftp://ftp.freebsd.org/ and its mirrors. A WWW site for this would be http://www.freebsd.org/ .

PT: It is also possible to use [socat] to wrap readline around your tclsh executable.
# Rename your tclsh8.6 binary to tclsh8.6.exe then create the following wrapper script
mv tclsh8.6 tclsh8.6.exe
cat > tclsh8.6 <<EOF
#!/bin/bash
bin=$(readlink -f $0).exe
if [ $# -lt 1 ]; then
    exec socat READLINE,history=$HOME/.tclsh_history EXEC:$bin,pty,ctty
else
    exec $bin $*
fi

The same can be usefully done for wish.