<commit_before>(*
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.

Copyright (c) <NAME>
*)
unit formconsole;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StrUtils, Menus, LclType,
  PythonEngine,
  ATStrings,
  ATSynEdit,
  ATSynEdit_Edits,
  ATSynEdit_Commands,
  ATSynEdit_Adapter_Simple,
  ATStringProc,
  ec_SyntAnal,
  ec_syntax_format,
  proc_py,
  proc_str,
  proc_colors,
  proc_globdata,
  proc_customdialog,
  proc_customdialog_dummy,
  proc_msg;

type
  TAppStrEvent = procedure(const Str: string) of object;
  TAppConsoleEvent = function(const Str: string): boolean of object;
  TAppConsoleCommandEvent = procedure(ACommand: integer; const AText: string; var AHandled: boolean) of object;

  TAppConsoleLineKind = (
    acLineUsual,
    acLinePrompt,
    acLineNote,
    acLineError
    );

type
  { TfmConsole }

  //inherit from TFormDummy to support dlg_proc API for this form
  TfmConsole = class(TFormDummy)
  private
    { private declarations }
    FAdapter: TATAdapterSimple;
    FOnNavigate: TAppConsoleEvent;
    FOnNumberChange: TNotifyEvent;
    FCudatextImported: boolean;
    mnuTextClear: TMenuItem;
    mnuTextNav: TMenuItem;
    mnuTextWrap: TMenuItem;
    procedure ComboCommand(Sender: TObject; ACmd: integer; const AText: string; var AHandled: boolean);
    procedure DoGetLineColor(Ed: TATSynEdit; ALineIndex: integer; var AColorFont, AColorBg: TColor);
    procedure MemoClickDbl(Sender: TObject; var AHandled: boolean);
    procedure MemoCommand(Sender: TObject; ACmd: integer; const AText: string; var AHandled: boolean);
    procedure MemoContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
    procedure DoNavigate(Sender: TObject);
    procedure DoToggleWrap(Sender: TObject);
    function ParseLine(const S: string): TAppConsoleLineKind;
    procedure SetIsDoubleBuffered(AValue: boolean);
    function GetWordWrap: boolean;
    procedure SetWordWrap(AValue: boolean);
    procedure DoRunLine(Str: string);
  public
    { public declarations }
    EdInput: TATComboEdit;
    EdMemo: TATSynEdit;
    ErrorCounter: integer;
    property OnConsoleNav: TAppConsoleEvent read FOnNavigate write FOnNavigate;
    property OnNumberChange: TNotifyEvent read FOnNumberChange write FOnNumberChange;
    procedure DoAddLine(const AText: UnicodeString);
    procedure DoClearMemo(Sender: TObject);
    procedure DoClearInput(Sender: TObject);
    procedure DoClearHistory;
    procedure DoUpdateMemo;
    property IsDoubleBuffered: boolean write SetIsDoubleBuffered;
    property MemoWordWrap: boolean read GetWordWrap write SetWordWrap;
    procedure SetFocus; override;
  end;

var
  fmConsole: TfmConsole = nil;

procedure InitConsole;

const
  cConsoleMaxLines = 1000;
  cConsoleMaxComboboxItems: integer = 20;
  cConsolePrompt = '>>> ';
  cConsolePrintPrefix = '=';

implementation

//{$R *.lfm} //not needed for console

function IsConsoleErrorLine(const S: string): boolean;
var
  N, i: integer;
begin
  Result:= false;
  N:= Pos('Error: ', S);
  if N<=1 then exit;
  if S[1]='.' then exit;
  for i:= 1 to N-1 do
    if not (S[i] in ['.', 'a'..'z', 'A'..'Z', '_']) then
      exit;
  Result:= true;
end;

{ TfmConsole }

function TfmConsole.ParseLine(const S: string): TAppConsoleLineKind;
begin
  if StartsStr(cConsolePrompt, S) then
    exit(acLinePrompt);

  if StartsText('NOTE: ', S) then
    exit(acLineNote);

  if StartsText('ERROR: ', S) then
    exit(acLineError);

  //EndsText is better than compare, to find FindInFiles4 log string added to 'traceback'
  if EndsText('Traceback (most recent call last):', S) then
    exit(acLineError);<commit_msg>better coloring of errors on console<commit_after>(*
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.

Copyright (c) <NAME>
*)
unit formconsole;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StrUtils, Menus, LclType,
  PythonEngine,
  ATStrings,
  ATSynEdit,
  ATSynEdit_Edits,
  ATSynEdit_Commands,
  ATSynEdit_Adapter_Simple,
  ATStringProc,
  ec_SyntAnal,
  ec_syntax_format,
  proc_py,
  proc_str,
  proc_colors,
  proc_globdata,
  proc_customdialog,
  proc_customdialog_dummy,
  proc_msg;

type
  TAppStrEvent = procedure(const Str: string) of object;
  TAppConsoleEvent = function(const Str: string): boolean of object;
  TAppConsoleCommandEvent = procedure(ACommand: integer; const AText: string; var AHandled: boolean) of object;

  TAppConsoleLineKind = (
    acLineUsual,
    acLinePrompt,
    acLineNote,
    acLineError
    );

type
  { TfmConsole }

  //inherit from TFormDummy to support dlg_proc API for this form
  TfmConsole = class(TFormDummy)
  private
    { private declarations }
    FAdapter: TATAdapterSimple;
    FOnNavigate: TAppConsoleEvent;
    FOnNumberChange: TNotifyEvent;
    FCudatextImported: boolean;
    mnuTextClear: TMenuItem;
    mnuTextNav: TMenuItem;
    mnuTextWrap: TMenuItem;
    procedure ComboCommand(Sender: TObject; ACmd: integer; const AText: string; var AHandled: boolean);
    procedure DoGetLineColor(Ed: TATSynEdit; ALineIndex: integer; var AColorFont, AColorBg: TColor);
    procedure MemoClickDbl(Sender: TObject; var AHandled: boolean);
    procedure MemoCommand(Sender: TObject; ACmd: integer; const AText: string; var AHandled: boolean);
    procedure MemoContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
    procedure DoNavigate(Sender: TObject);
    procedure DoToggleWrap(Sender: TObject);
    function ParseLine(const S: string): TAppConsoleLineKind;
    procedure SetIsDoubleBuffered(AValue: boolean);
    function GetWordWrap: boolean;
    procedure SetWordWrap(AValue: boolean);
    procedure DoRunLine(Str: string);
  public
    { public declarations }
    EdInput: TATComboEdit;
    EdMemo: TATSynEdit;
    ErrorCounter: integer;
    property OnConsoleNav: TAppConsoleEvent read FOnNavigate write FOnNavigate;
    property OnNumberChange: TNotifyEvent read FOnNumberChange write FOnNumberChange;
    procedure DoAddLine(const AText: UnicodeString);
    procedure DoClearMemo(Sender: TObject);
    procedure DoClearInput(Sender: TObject);
    procedure DoClearHistory;
    procedure DoUpdateMemo;
    property IsDoubleBuffered: boolean write SetIsDoubleBuffered;
    property MemoWordWrap: boolean read GetWordWrap write SetWordWrap;
    procedure SetFocus; override;
  end;

var
  fmConsole: TfmConsole = nil;

procedure InitConsole;

const
  cConsoleMaxLines = 1000;
  cConsoleMaxComboboxItems: integer = 20;
  cConsolePrompt = '>>> ';
  cConsolePrintPrefix = '=';

implementation

//{$R *.lfm} //not needed for console

function IsConsoleErrorLine(const S: string): boolean;
var
  N, i: integer;
begin
  Result:= false;
  N:= Pos('Error: ', S);
  if N<=1 then exit;
  if S[1]='.' then exit;
  for i:= 1 to N-1 do
    if not (S[i] in ['.', 'a'..'z', 'A'..'Z', '_']) then
      exit;
  Result:= true;
end;

{ TfmConsole }

function TfmConsole.ParseLine(const S: string): TAppConsoleLineKind;
begin
  if StartsStr(cConsolePrompt, S) then
    exit(acLinePrompt);

  if StartsText('NOTE:', S) then
    exit(acLineNote);

  if StartsText('ERROR:', S) then
    exit(acLineError);

  //EndsText is better than compare, to find FindInFiles4 log string added to 'traceback'
  if EndsText('Traceback (most recent call last):', S) then
    exit(acLineError);
{'fraction_non_alphanumeric': 0.0924358807446947, 'fraction_numerical': 0.0039057414399166776, 'mean_word_length': 4.432814710042432, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4358600', 'n_tokens_mistral': 2558, 'n_tokens_neox': 2477, 'n_words': 720}