Hi Bernd!
Am Donnerstag, den 08.12.2011, 20:44 +0100 schrieb Bernd:
> 2011/5/1 Johann Glaser <johann.gla...@gmx.at>:
>
> > If you find any improvements or comments don't hesitate to send me an
> > EMail.
>
> I just used it. I only needed readline() and add_history(), these two
> functions are already enough to make a ReadLn() substitute that really
> works and It works like a charm! Thank you!
>
> I think this code really deserves to be included in FPC.
Thanks for your feedback and support!
In the meantime I've added an OOP wrapper which greatly simplifies the
usage of the history and readline and helps to implement custom
completion.
Please find attached the OOP wrappers and a small example.
I've also used this OOP wrapper for a command line tool which integrates
the TCL OOP wrapper (mentioned in this list on 2011-05-05). The
completion correctly identifies whether it is asked for commands or
variables, and even works inside of the TCL equivalent of backticks. Due
to shortage of time it's still a bit messy, but will be released under
the terms of the GPL too.
Bye
Hansi
(* Copyright (C) 1989-2011 Free Software Foundation, Inc.
This file contains the FreePascal header translations for the
GNU History Library (History), a set of routines for managing the
text of previously typed lines.
History is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
History is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with History. If not, see <http://www.gnu.org/licenses/>.
*)
Unit HistoryOOP;
{$mode objfpc}{$H+}
Interface
Uses
Classes, SysUtils, History;
Type
{ THistory }
THistory = class
private
FFilename : String;
FAddDuplicates : Boolean;
public
Constructor Create(AFilename:String);
Destructor Destroy; override;
Procedure Read;
Procedure Write;
Procedure Print;
Function List : PPHIST_ENTRY; inline;
Function Length : Integer; inline;
Function GetLast : PHIST_ENTRY; inline;
Procedure Add(St:String);
property AddDuplicates : Boolean read FAddDuplicates write FAddDuplicates;
End;
Implementation
// signelton static variable
Const HistoryInst : THistory = Nil;
{ THistory }
(**
* Constructor
*
* AFilename: path to history file, if its empty, no history file is used, if
* it doesn't contain a '/', it is interpreted relative to the user's home
* directory.
*)
Constructor THistory.Create(AFilename:String);
Begin
{ History is not thread-save }
if assigned(HistoryInst) then
raise Exception.Create('You can only have a single THistory instance!');
HistoryInst := Self; // set singleton static variable
inherited Create;
if AFilename <> '' then
Begin
if Pos('/',AFilename) > 0 then
Begin
// filename contains a '/' -> absolute path
FFilename := AFilename;
End
else
Begin
// filename doesn't contain a '/' -> relative to home directory
FFilename := GetEnvironmentVariable('HOME') + '/' + AFilename;
End;
End;
End;
Destructor THistory.Destroy;
Begin
{ clean up singleton static variable }
if HistoryInst <> Self then
raise Exception.Create('Internal Error: HistoryInst <> Self');
HistoryInst := Nil;
Inherited Destroy;
End;
Procedure THistory.Read;
Begin
if FFilename = '' then Exit;
read_history(PChar(FFilename));
End;
Procedure THistory.Write;
Begin
if FFilename = '' then Exit;
write_history(PChar(FFilename));
End;
(**
* Print the full history
*)
Procedure THistory.Print;
Var H : PPHIST_ENTRY;
I : Integer;
W : Integer;
Begin
// get the required width for the enumeration
W := 0;
I := Length;
While I > 0 do
Begin
Inc(W);
I := I div 10;
End;
// print the whole history list
H := List;
if H = Nil then Exit;
I := 0;
While H^[I] <> Nil do
Begin
WriteLn(' ',(I+1):W,' ',H^[I]^.Line);
Inc(I);
End;
End;
Function THistory.List:PPHIST_ENTRY; inline;
Begin
Result := history_list;
End;
Function THistory.Length:Integer; inline;
Begin
Result := history_length;
End;
Function THistory.GetLast:PHIST_ENTRY;Inline;
Begin
Result := history_get(Length);
End;
Procedure THistory.Add(St:String);
Var H : PHIST_ENTRY;
Begin
if not FAddDuplicates then
Begin
H := GetLast;
if (H <> Nil) and (St = H^.Line) then
Exit;
End;
add_history(PChar(St));
End;
End.
(* Copyright (C) 1987-2011 Free Software Foundation, Inc.
This file is part of the FreePascal header translations for the
GNU Readline Library (Readline), a library for reading lines of
text with interactive input and history editing.
Readline is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Readline is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Readline. If not, see <http://www.gnu.org/licenses/>.
*)
(* http://tiswww.case.edu/php/chet/readline/rltop.html
* http://tiswww.case.edu/php/chet/readline/readline.html
* http://tiswww.case.edu/php/chet/readline/history.html
*)
Unit ReadlineOOP;
{$mode objfpc}{$H+}
Interface
Uses
Classes, SysUtils, Readline, HistoryOOP;
Type
TDynArrString = Array of String;
TGetCompletionsFunc = Function(Text:PChar;Start,TheEnd:Integer) : TDynArrString of object;
{ TReadline }
TReadline = class
private
FName : String; // for conditions in the ~/.inputrc file
FPrompt : String;
FQuitCmd : String;
FHistory : THistory;
FSigIntHandler : Boolean; // if true a ^C signal handler is set before readline() is called
FSigIntConvert : Boolean; // raise EReadlineSigInt exception in signal handler to catch by higher-level
FGetCompletions : TGetCompletionsFunc;
Function GetBasicWordBreakCharacters:String;
Procedure SetBasicWordBreakCharacters(Const AValue: String);
Function GetSpecialPrefixes:String;
Procedure SetSpecialPrefixes(Const AValue: String);
Function GetLineBuffer:PChar;
// TODO: rl_instream, rl_outstream
public
Constructor Create(AName:String);
Destructor Destroy; override;
{ the main function }
Function Read : String;
{ helper functions }
Procedure Show(St:String);
Procedure CRLF; inline;
{ completion helper functions }
Procedure UseFilenames; inline;
{ properties }
property QuitCmd : String read FQuitCmd write FQuitCmd;
property Prompt : String read FPrompt write FPrompt;
property History : THistory read FHistory write FHistory;
property SigIntHandler : Boolean read FSigIntHandler write FSigIntHandler;
property SigIntConvert : Boolean read FSigIntConvert write FSigIntConvert;
property GetCompletions : TGetCompletionsFunc read FGetCompletions write FGetCompletions;
{ Readline variables }
property BasicWordBreakCharacters : String read GetBasicWordBreakCharacters write SetBasicWordBreakCharacters;
property SpecialPrefixes : String read GetSpecialPrefixes write SetSpecialPrefixes;
property LineBuffer : PChar read GetLineBuffer;
End;
EReadline = class(Exception); // errors encountered in TReadline
EReadlineSigInt = class(EReadline); // special class raised in the SIGINT handler
Implementation
Uses BaseUnix;
// signelton static variable
Const ReadlineInst : TReadline = Nil;
(*
* rl_completion_matches() is very simple: It calls the entry_function
* repeatedly until it returns Nil and places its return value into a growing
* array starting at [1] (growing by 10 to avoid too frequency realloc). Then
* it calls the compute_lcd_of_matches() to sort the entries and compute the
* least common deniminator of all possible completions. Unfortunately this
* function is a private, therefore we can't use it to generate our own LCD.
*
* Plan: We set AttemptCompletion as rl_attempted_completion_function. This
* calls a user-defined function of object, which returns an Array of String
* (trust in reference counting!). This is then stored to the global variable
* GlobalCompletions. Then it calls rl_completion_matches() for which we
* provide the callback function GetGlobalCompletions. This simply returns one
* entry from GlobalCompletions after each other.
*
* AttemptCompletion and therefore the user-defined function get a lot more
* information as GetGlobalCompletions, so it is more powerful to choose smart
* completions.
*)
// global variables to store completions
Const GlobalCompletions : TDynArrString = Nil;
GlobalCompletionsIdx : Integer = 0;
// rl_completion_matches() wants the strings to be malloc()ed and will be freed
// later, therefore we link to the libc strdup() (which is basically a wrapper
// for malloc()).
Function StrDup(para1:Pchar):Pchar;cdecl;external 'c' name 'strdup';
Function GetGlobalCompletions(TheText : PChar; Matches : CInt) : PChar; CDecl;
Begin
// first run: reset the index
if Matches = 0 then
GlobalCompletionsIdx := 0;
// no more completions?
if GlobalCompletionsIdx >= Length(GlobalCompletions) then
Exit(Nil);
// return the string (which must be malloc()ed!)
Result := StrDup(PChar(GlobalCompletions[GlobalCompletionsIdx]));
Inc(GlobalCompletionsIdx);
End;
Function AttemptedCompletion(Text:PChar;Start,TheEnd:Integer): PPChar; CDecl;
Begin
Result := Nil;
// by default we don't want to complete filenames if we don't have completions
rl_attempted_completion_over := 1;
// don't return any completions if no callback is defined
if not assigned(ReadlineInst.GetCompletions) then
Exit;
// get all completions
GlobalCompletions := ReadlineInst.GetCompletions(Text,Start,TheEnd);
// make an appropriate array
Result := rl_completion_matches(Text,@GetGlobalCompletions);
End;
{ TReadline }
Constructor TReadline.Create(AName:String);
Begin
{ readline is not thread-save }
if assigned(ReadlineInst) then
raise EReadline.Create('You can only have a single TReadline instance!');
ReadlineInst := Self; // set singleton static variable
inherited Create;
// set defaults
FName := AName;
FPrompt := '> ';
FQuitCmd := 'quit';
FSigIntHandler := true;
// setup readline
rl_readline_name := PChar(FName);
rl_attempted_completion_function := @AttemptedCompletion;
End;
Destructor TReadline.Destroy;
Begin
{ clean up singleton static variable }
if ReadlineInst <> Self then
raise EReadline.Create('Internal Error: ReadlineInst <> Self');
ReadlineInst := Nil;
Inherited Destroy;
End;
Procedure SigCtrlC(Signal:Longint;Info:PSigInfo;Context:PSigContext); CDecl;
Begin
rl_crlf(); // readline only prints '^C' -> print newline
// rl_done() doesn't work as I'd like: immedately return from readline().
// Instead the user has to push at least one key to return.
//
// But how is bash doing this? They install a setjmp() position before the
// readline() and then do a longjmp() from within the signal handler.
//
// We model this with exceptions and create the dedicated EReadlineSigInt for
// it.
//
// There is another problem: Since this signal handler function is not
// finished the sigreturn() call (injected by the kernel) is not executed.
// Somehow the SIGINT stays blocked and no further ^C presses work. To work
// around this problem, we clear the set of blocked signals directly before
// readline() (see below).
// "convert" signal to exception
if ReadlineInst.FSigIntConvert then
raise EReadlineSigInt.Create('SIGINT')
else
Begin
// readline() continues to run, so clean information and redraw the screen
rl_free_line_state(); // free partial history entry, keyboard macro, numeric argument
rl_replace_line('', 1); // clear line buffer
rl_forced_update_display(); // force the line to be updated and redisplayed
End;
End;
Function TReadline.Read:String;
Var InputLine : PChar;
NewAct,OldAct : SigActionRec;
NewSig,OldSig : TSigSet;
Begin
// install signal handler to ignore ^C
// Readline by default catches many signals (including SIGINT), does some
// terminal cleanup, and resend the signal to the calling application. So we
// have to catch it ourselves.
if FSigIntHandler then
Begin
NewAct.sa_handler := @SigCtrlC;
NewAct.sa_flags := SA_RESTART or SA_SIGINFO; // SA_SIGINFO required that sa_sigaction(int, siginfo_t*, void*) instead of sa_handler(int) is called
FpSigEmptySet(NewAct.sa_mask);
if FpSigAction(SIGINT,@NewAct,@OldAct) <> 0 then
raise EReadline.CreateFmt('Error installing SIGINT handler: %d (%s)',[FpGetErrno, '']);
// un-block all signals
FpSigEmptySet(NewSig);
if FpSigProcMask(SIG_SETMASK,NewSig,OldSig) <> 0 then
raise EReadline.CreateFmt('Error unblocking all signals: %d (%s)',[FpGetErrno, '']);
End;
// read a line
InputLine := Readline.readline(PChar(FPrompt));
// remove signal handler
if FSigIntHandler then
Begin
if FpSigAction(SIGINT,@OldAct,Nil) <> 0 then
raise EReadline.CreateFmt('Error installing old SIGINT handler: %d (%s)',[FpGetErrno, '']);
End;
// handle ^D
if InputLine = Nil then
Begin
Show(FQuitCmd);
CRLF; // print a newline because after pressing ^D there is none
InputLine := PChar(FQuitCmd);
End;
Result := Trim(InputLine);
// if the string was non-empty process it
if Result > '' then
Begin
// Add line to history (only if its not a duplicate)
if assigned(FHistory) then
FHistory.Add(Result);
End;
End;
Procedure TReadline.Show(St:String);
Var I : Integer;
Begin
For I := 1 to Length(St) do
rl_show_char(Ord(St[I]));
End;
Procedure TReadline.CRLF;Inline;
Begin
rl_crlf;
End;
Procedure TReadline.UseFilenames; inline;
Begin
// Called from the user-defined function to return a list of completions.
// Re-enable filename completions.
rl_attempted_completion_over := 0;
End;
Function TReadline.GetBasicWordBreakCharacters:String;
Begin
Result := rl_basic_word_break_characters;
End;
Procedure TReadline.SetBasicWordBreakCharacters(Const AValue: String);
Begin
rl_basic_word_break_characters := PChar(AValue);
End;
Function TReadline.GetSpecialPrefixes:String;
Begin
Result := rl_special_prefixes;
End;
Procedure TReadline.SetSpecialPrefixes(Const AValue: String);
Begin
rl_special_prefixes := PChar(AValue);
End;
Function TReadline.GetLineBuffer:PChar;
Begin
Result := rl_line_buffer;
End;
End.
Program OOTest;
{$mode objfpc}{$H+}
Uses
Classes, SysUtils, HistoryOOP, ReadlineOOP;
Type
{ TCompleter }
TCompleter = class
private
FReadline : TReadline;
public
Constructor Create(AReadline:TReadline);
Function GetCompletions(Text:PChar;Start,TheEnd:Integer) : TDynArrString;
Function GetCommands (Text:PChar;Start,TheEnd:Integer) : TDynArrString;
End;
{ TCompleter }
Constructor TCompleter.Create(AReadline:TReadline);
Begin
inherited Create;
FReadline := AReadline;
End;
Function TCompleter.GetCompletions(Text:PChar;Start,TheEnd:Integer):TDynArrString;
Begin
Result := Nil;
{ context dependent completion }
if Start = 0 then
Begin
{ first word -> command }
Result := GetCommands(Text,Start,TheEnd);
End
else
Begin
{ 2nd or later word -> filename }
FReadline.UseFilenames; // re-enable filename completions
End;
End;
Function TCompleter.GetCommands(Text:PChar;Start,TheEnd:Integer):TDynArrString;
Const Commands : Array[0..6] of String = ('list','history','quit','help','linux','open','ootest-1');
Var I : Integer;
N : Integer;
Begin
SetLength(Result,Length(Commands));
N := 0;
// WriteLn;
// WriteLn('Text = ''',Text,''', Start = ',Start,', End = ',TheEnd);
For I := Low(Commands) to High(Commands) do
if Text = Copy(Commands[I],1,TheEnd-Start) then
Begin
// WriteLn('Possible match: ',Commands[I]);
Result[N] := Commands[I];
Inc(N);
End;
// set correct length of array
SetLength(Result,N);
End;
Var H : THistory;
R : TReadline;
St : String;
C : TCompleter;
Begin
H := THistory.Create('histtest.delme');
H.Read; // read history
R := TReadline.Create('OOTest');
R.History := H;
C := TCompleter.Create(R);
R.GetCompletions := @C.GetCompletions;
// command line
repeat
St := R.Read;
Until St = 'quit';
C.Free;
H.Print; // print history to screen
H.Write; // write history to file
H.Free;
R.Free;
End.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
