diff --git a/components/richmemo/samples/mlparse/mlparsers.lpi b/components/richmemo/samples/mlparse/mlparsers.lpi
new file mode 100644
index 000000000..75fc79afa
--- /dev/null
+++ b/components/richmemo/samples/mlparse/mlparsers.lpi
@@ -0,0 +1,89 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="mlparsers"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="richmemopackage"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="mlparsers.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="richmemoml.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="RichMemoML"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="mlparsers"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/components/richmemo/samples/mlparse/mlparsers.lpr b/components/richmemo/samples/mlparse/mlparsers.lpr
new file mode 100644
index 000000000..53989dc2a
--- /dev/null
+++ b/components/richmemo/samples/mlparse/mlparsers.lpr
@@ -0,0 +1,21 @@
+program mlparsers;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Unit1, richmemoml
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
diff --git a/components/richmemo/samples/mlparse/richmemoml.pas b/components/richmemo/samples/mlparse/richmemoml.pas
new file mode 100644
index 000000000..e0f9962ec
--- /dev/null
+++ b/components/richmemo/samples/mlparse/richmemoml.pas
@@ -0,0 +1,254 @@
+{
+ richmemoutils.pas
+
+ Author: Dmitry 'skalogryz' Boyarintsev
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program 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.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+unit RichMemoML;
+
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, RichMemo, RichMemoUtils;
+
+type
+  TMarkupFormatHandler = procedure (Sender: TObject;
+    var tag: string; tagattr: TStrings;
+    var font: TFontParams; var txt: string; var tagCloses: Boolean ) of object;
+
+  TMarkupEntityReplace = procedure (Sender: TObject; var txt: string; tagsStack: TStrings) of object;
+
+  { TFormatStack }
+
+  TFormatStack = class(Tobject)
+  public
+    tagName : string;
+    fmt     : TFontParams;
+    constructor Create(const atag: string; afmt: TFontParams);
+  end;
+
+  { TMarkupHandler }
+
+  TMarkupHandler = class(TObject)
+  private
+    fOnMarkup   : TMarkupFormatHandler;
+    fOnReplace  : TMarkupEntityReplace;
+    fStack      : TList;
+    fStackNames : TStrings;
+    fRichMemo   : TRichMemo;
+    procedure Append(const s: string; const fmt: TFontParams);
+    procedure EntityReplace(var s: string);
+    procedure GetTagFmt(var atag: string; st: TStrings; var fmt: TFontParams; var AText: string; var toBeClosed: Boolean);
+    procedure AddStack(const atag: string; const fmt: TFontParams);
+    procedure PopStack(const atag: string; var fmt: TFontParams);
+    procedure Clear;
+  public
+    DefParams: TFontParams;
+    constructor Create;
+    destructor Destroy; override;
+    procedure Parse(ARichMemo: TRichMemo; const atext: string);
+    property OnFormatSelect:  TMarkupFormatHandler read fOnMarkup write fOnMarkup;
+    property OnEntityReplace: TMarkupEntityReplace read fOnReplace write fOnReplace;
+  end;
+
+procedure Parse(const atext: string; ADstMemo: TRichMemo; AFormat: TMarkupFormatHandler; AReplace: TMarkupEntityReplace = nil);
+
+implementation
+
+procedure Parse(const atext: string; ADstMemo: TRichMemo; AFormat: TMarkupFormatHandler; AReplace: TMarkupEntityReplace);
+var
+  h : TMarkupHandler;
+begin
+  if not Assigned(ADstMemo) or (atext='') then Exit;
+  h := TMarkupHandler.Create;
+  try
+    h.OnFormatSelect:=AFormat;
+    h.OnEntityReplace:=AReplace;
+    h.DefParams:=GetFontParams(ADstMemo.Font);
+    h.Parse(ADstMemo, atext);
+  finally
+    h.Free;
+  end;
+end;
+
+{ TFormatStack }
+
+constructor TFormatStack.Create(const atag: string; afmt: TFontParams);
+begin
+  inherited Create;
+  tagName:=atag;
+  fmt:=afmt;
+end;
+
+{ TMarkupHandler }
+
+procedure TMarkupHandler.Append(const s: string; const fmt: TFontParams);
+begin
+  InsertFontText(fRichMemo, s, fmt);
+end;
+
+procedure TMarkupHandler.EntityReplace(var s: string);
+var
+  i : integer;
+begin
+  //todo: more effecient?
+  fStackNames.Clear;
+  for i:=0 to fStack.Count-1 do
+    fStackNames.Add( TFormatStack(fStack[i]).tagName );
+
+  if Assigned(OnEntityReplace) then OnEntityReplace(Self, s, fStackNames);
+end;
+
+procedure TMarkupHandler.GetTagFmt(var atag: string; st: TStrings;
+  var fmt: TFontParams; var AText: string; var toBeClosed: Boolean);
+begin
+  if Assigned(OnFormatSelect) then
+    OnFormatSelect(Self, atag, st, fmt, atext, toBeClosed);
+end;
+
+procedure TMarkupHandler.AddStack(const atag: string; const fmt: TFontParams);
+begin
+  fStack.Add(TFormatStack.Create(atag, fmt));
+end;
+
+procedure TMarkupHandler.PopStack(const atag: string; var fmt: TFontParams);
+var
+  i   : integer;
+  j   : integer;
+  fs  : TFormatStack;
+begin
+  i:=fStack.Count-1;
+  while i>=0 do begin
+    fs:=TFormatStack(fStack[i]);
+    if fs.tagName=atag then begin
+      for j:=fStack.Count-1 downto i do begin
+        TFormatStack(fStack[j]).Free;
+        fStack[j]:=nil;
+      end;
+      fStack.Pack;
+
+      dec(i);
+      if i>=0 then fmt:=TFormatStack(fStack[i]).fmt
+      else fmt:=DefParams;
+      Exit;
+    end else
+      dec(i);
+  end;
+  // do nothing. unknown closing tag
+end;
+
+procedure TMarkupHandler.Clear;
+var
+  i : Integer;
+begin
+  for i:=0 to fStack.Count-1 do
+    TFormatStack(fStack[i]).free;
+  fStack.Clear;
+end;
+
+constructor TMarkupHandler.Create;
+begin
+  inherited;
+  fStack:=TList.Create;
+  fStackNames:=TStringList.Create;
+end;
+
+destructor TMarkupHandler.Destroy;
+begin
+  Clear;
+  fStackNames.Free;
+  fStack.Free;
+  inherited Destroy;
+end;
+
+procedure TMarkupHandler.Parse(ARichMemo: TRichMemo; const atext: string);
+var
+  i : integer;
+  j : integer;
+  sb : string;
+  fmt : TFontParams;
+  newfmt : TFontParams;
+  tag : string;
+  openTag : Boolean;
+  tagAttr:  TStringList;
+  tobeClosed : Boolean;
+begin
+  if not Assigned(ARichMemo) then Exit;
+  Clear;
+  fmt:=DefParams;
+  i:=1;
+  j:=1;
+  fRichMemo:=ARichMemo;
+  fRichMemo.Lines.BeginUpdate;
+  tagAttr:=TStringList.Create;
+  try
+    while i<=length(atext) do begin
+      if atext[i]='<' then begin
+
+        tagattr.Clear;
+        if j<i then begin
+          sb:=Copy(atext, j, i-j);
+          EntityReplace(sb);
+          Append(sb, fmt);
+        end;
+
+        inc(i);
+        j:=i;
+        while (i<=length(atext)) and (atext[i]<>'>') do inc(i);
+
+        if (i>j+1) and (i<=length(atext)) and (atext[j]='/') then begin
+          openTag:=false;
+          inc(j);
+        end else begin
+          openTag:=true;
+        end;
+        tag:=Copy(atext, j, i-j);
+        tag:=AnsiLowerCase(tag);
+
+        if openTag then begin
+          tobeClosed:=true;
+          sb:='';
+          newfmt:=fmt;
+          GetTagFmt(tag, tagattr, newfmt, sb, tobeClosed);
+
+          if sb<>'' then Append(sb, newfmt);
+
+          if tobeClosed then fmt:=newfmt;
+          AddStack(tag, fmt);
+        end else begin
+          PopStack(tag, fmt);
+        end;
+
+        inc(i);
+        j:=i;
+        // parsing tag!
+      end else
+        inc(i);
+    end;
+    i:=length(atext)+1;
+    if j<i then begin
+      sb:=Copy(atext, j, i-j);
+      Append( sb, fmt );
+    end;
+  finally
+    fRichMemo.Lines.EndUpdate;
+    tagAttr.Free;
+  end;
+end;
+
+end.
+
diff --git a/components/richmemo/samples/mlparse/unit1.lfm b/components/richmemo/samples/mlparse/unit1.lfm
new file mode 100644
index 000000000..652350174
--- /dev/null
+++ b/components/richmemo/samples/mlparse/unit1.lfm
@@ -0,0 +1,78 @@
+object Form1: TForm1
+  Left = 556
+  Height = 393
+  Top = 212
+  Width = 580
+  Caption = 'ML Parsing Example'
+  ClientHeight = 393
+  ClientWidth = 580
+  LCLVersion = '1.7'
+  object Button1: TButton
+    Left = 16
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Convert'
+    OnClick = Button1Click
+    TabOrder = 0
+  end
+  object Panel1: TPanel
+    Left = 0
+    Height = 353
+    Top = 40
+    Width = 580
+    Align = alBottom
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BevelOuter = bvNone
+    ClientHeight = 353
+    ClientWidth = 580
+    TabOrder = 1
+    object RichMemo1: TRichMemo
+      Left = 304
+      Height = 353
+      Top = 0
+      Width = 276
+      Align = alClient
+      HideSelection = False
+      Lines.Strings = (
+        'RichMemo1'
+      )
+      TabOrder = 0
+      ZoomFactor = 1
+    end
+    object Memo1: TMemo
+      Left = 0
+      Height = 353
+      Top = 0
+      Width = 299
+      Align = alLeft
+      Lines.Strings = (
+        '<h1>Big Header</h1>'
+        ''
+        '<h2>Small Header</h2>'
+        ''
+        'Hello world, let me <b>stress</b> how '
+        '<i>happy</i> this component is.'
+        'Infact, <b><u>any</u> user</b> could use it.'
+        ''
+        'Just refer to the code and see how TagFormat handler '
+        'is working'
+        '<pre>'
+        'begin'
+        '  if a &lt; b then '
+        '    writeln(''hello world'');'
+        'end;'
+        '</pre>'
+        ''
+        'Really easy! Right?'
+      )
+      TabOrder = 1
+    end
+    object Splitter1: TSplitter
+      Left = 299
+      Height = 353
+      Top = 0
+      Width = 5
+    end
+  end
+end
diff --git a/components/richmemo/samples/mlparse/unit1.pas b/components/richmemo/samples/mlparse/unit1.pas
new file mode 100644
index 000000000..5f3f8d2ae
--- /dev/null
+++ b/components/richmemo/samples/mlparse/unit1.pas
@@ -0,0 +1,77 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ExtCtrls, RichMemo, richmemoml;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Memo1: TMemo;
+    Panel1: TPanel;
+    RichMemo1: TRichMemo;
+    Splitter1: TSplitter;
+    procedure Button1Click(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    procedure TagFormat(Sender: TObject;  var atagName: string; tagattr: TStrings;
+      var afont: TFontParams; var txt: string; var tagCloses: Boolean );
+    procedure EntReplace(Sender: TObject; var txt: string; tagsStack: TStrings);
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  RichMemo1.Clear;
+  Parse(Memo1.Text, RichMemo1, @TagFormat, @EntReplace);
+end;
+
+procedure TForm1.TagFormat(Sender: TObject; var atagName: string; tagattr: TStrings;
+  var afont: TFontParams; var txt: string; var tagCloses: Boolean);
+begin
+  if atagName='b' then
+    Include(afont.Style, fsBold)
+  else if atagName='i' then
+    Include(afont.Style, fsItalic)
+  else if atagName='s' then
+    Include(afont.Style, fsStrikeOut)
+  else if atagName='u' then
+    Include(afont.Style, fsUnderline)
+  else if atagName='h1' then begin
+    Include(afont.Style, fsBold);
+    afont.Size:=afont.Size*2;
+  end else if atagName='h2' then begin
+    Include(afont.Style, fsBold);
+    afont.Size:=round(afont.Size*1.5)
+  end else if atagName='pre' then begin
+    afont.Name:='Courier New'
+  end;
+end;
+
+procedure TForm1.EntReplace(Sender: TObject; var txt: string;
+  tagsStack: TStrings);
+begin
+  txt:=StringReplace(txt, '&lt;', '<', [rfReplaceAll, rfIgnoreCase]);
+  txt:=StringReplace(txt, '&gt;', '>', [rfReplaceAll, rfIgnoreCase]);
+  txt:=StringReplace(txt, '&quot;', '"', [rfReplaceAll, rfIgnoreCase]);
+end;
+
+end.
+