unit WebOutline;
(*
Copyright (c) 1998-2003 HREF Tools Corp.

NB: This unit was named weboutln.pas in WebHub through v2.017 and defined 
the web action component named TWebOutline.

Permission is hereby granted, on 26-May-2003, free of charge, to any person 
obtaining a copy of this file (the "Software"), to deal in the Software 
without restriction, including without limitation the rights to use, copy, 
modify, merge, publish, distribute, sublicense, and/or sell copies of the 
Software, and to permit persons to whom the Software is furnished to do so, 
subject to the following conditions:

The above copyright notice and this permission notice shall be included in 
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
THE SOFTWARE.
*)

{ This makes a great example for storing and restoring state!
  every node in the outline becomes a letter in a string.
  that string is saved as a 'saved state' and travels through
  the system with the other information the surfer has provided.

  The outline has one quirky little 'cut' command that I'd like
  people to try interactively and give me some feedback on.
  --Michael.

}


{outline.items  .text property must be in this form:
  pageDescription | outlineLevel | outlineIndex | WebHub PageID

required macros in application-level .ini file:

 outlineFolderClosed=<img hspace=2 src=/planet/gif/foldclsd.gif border=0>
 outlineFolderOpen=<img hspace=2 src=/planet/gif/foldopen.gif border=0>
 outlinePage=<img hspace=2 src=/planet/gif/pagedoc.gif border=0>

 }



interface

uses
  SysUtils, Messages, Classes, Forms, Dialogs, Outline
, Windows
, Graphics, Controls
, UpdateOk
, HTMConst, WebTypes, WebLink
, ucInteg
, UcString
  ;

Const
  toCollapsed='C';
   toExpanded='E';
  cStateCode:array[false..true] of char=(toCollapsed,toExpanded);
  cOutlineMagic=3;

Type
  TWebOutlineCommands = (ocGoto,ocCut,ocTop,ocLess,ocMore,ocAll);

Const
  WebOutlineCommands: array[ocGoto..ocAll] of string[4]
                        = ('Lvl','Cut','Top','Less','More','All');
Type
  TOnNode= procedure (aNode:TOutlineNode;NodeNr:integer;var Value:String) of object;
  TOnFolder= procedure (aNode:TOutlineNode;NodeNr:integer;var Value:String;Expanded:Boolean) of object;
  TOnDocument= procedure (aNode:TOutlineNode;NodeNr:integer;var Value:String) of object;

  TNodeNamePrefix= string[10];

Type
  TWebOutline = class(TWebAction)
  private
    fAnchor: Boolean;
    fCurrent: Integer;
    fCut,
    fLevel,
    fLevels,
    fIndent: byte;
    fNodeNamePrefix: TNodeNamePrefix;
    fOutline : TOutline;
    fOnNode: TOnNode;
    fOnFolder: TOnFolder;
    fOnDocument: TOnDocument;
    procedure SetExpanded(Node:Integer;Value:Boolean);
    function  GetExpanded(Node:Integer):Boolean;
    procedure PerformCommand;
    function  GetLevels:Byte;
    procedure SetToZero(Value:Byte);
    procedure SetLevel(Value:Byte);
    procedure StringToOutline(Const Value:string); {set the outline from the state}
    function  OutlineToString:string;              {convert the outline to the state}
  protected
    function  DoUpdate : boolean; override;   {make sure outline is hooked up}
    procedure DoExecute; override;            {send the html for the outline}
    procedure SetSaveState(const State:String); override;  {restore the outline's state}
    function  GetSaveState:String; override;       {get the outline's state}
  public
    constructor Create(aOwner:TComponent); override;
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetToTop;   {added 6/9/96 aml}
    property Expanded[Node:Integer]:Boolean read GetExpanded write SetExpanded;
    property Current: Integer read fCurrent write fCurrent;
  published
    property Anchor: Boolean read fAnchor write fAnchor default false;
    property Level: Byte read fLevel write SetLevel;
    property Levels: Byte read GetLevels write SetToZero;
    property Indent: Byte read fIndent write fIndent;
    property Outline : TOutline read fOutline write fOutline;
    property NodeNamePrefix: TNodeNamePrefix read fNodeNamePrefix write fNodeNamePrefix;
    property OnNode: TOnNode read fOnNode write fOnNode;
    property OnFolder: TOnFolder read fOnFolder write fOnFolder;
    property OnDocument: TOnDocument read fOnDocument write fOnDocument;
    end;

{----------------------------------------------------------------------------------------}

//procedure Register;

implementation

var
  iStackCounter:integer;
{----------------------------------------------------------------------------------------}

constructor TWebOutline.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  fIndent:= cOutlineMagic;
  fNodeNamePrefix:='';
end;

procedure TWebOutline.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (csUpdating in ComponentState) then
    exit;
  if Operation = opRemove then
    cx.NilIfSet(fOutline,AComponent)
  else
    if (fOutline=nil) and (aComponent is TOutline) then
      fOutline:=TOutline(AComponent);
end;

function TWebOutline.DoUpdate:boolean;
begin
  result:=inherited DoUpdate;
  if result then begin
    fOutline:=TOutline(cx.SetIfFound(fOutline,TOutline));
    result:=fOutline<>nil;
    if not assigned(fOutline) then
      AddError('Outline is nil')
    end;
  if result then begin {reset reread levels}
    fLevels:=0;
    GetLevels;
    end;
end;

{----------------------------------------------------------------------------------------}
{----------------------------------------------------------------------------------------}

procedure TWebOutline.DoExecute;
var
  ShowThis, anchor, youAreHere,
  MoreHTML, pageID: String;
  NodeNr              : Integer;

  function SendNodeString:String;
  begin
    with fOutline.Items[NodeNr] do begin
      fLevels:=max(Level,fLevels);
      if IsVisible and (Level>fCut) then begin
        Result:=text;
        if assigned(fOnNode) then
          fOnNode(fOutline.Items[NodeNr],NodeNr,Result);
        SplitString(Result,'|',ShowThis,Result);  { showthis | pageID [|addtlhtml]}
        SplitString(Result,'|',pageID,MoreHTML);
        if ShowThis='' then
          exit;
        //
        if Expanded or HasItems then begin
          if NodeNr=Current then
            youAreHere:='%=outlinePointer=%'
          else
            youAreHere:='';
          //
          Result:='<A HREF="%=where=%'+self.name+'.'+inttostr(NodeNr)+'#'+fNodeNamePrefix+inttostr(NodeNr);
          if not expanded then {HasItems}
            Result:=Result+'">%=OutlineFolderClosed=%'
          else
            Result:=Result+'">%=OutlineFolderOpen=%';
          //
          if fAnchor then
            anchor:='<A NAME="'+fNodeNamePrefix+inttostr(NodeNr)+'"></A>'
          else
            anchor:='';
          //
          Result:=Result+'</A>'+anchor+'&nbsp;'
            +'%=JUMP|'+pageID+'|'+showThis+'=%'+MoreHTML+youAreHere+'<BR>';
          if assigned(fOnFolder) then
            fOnFolder(fOutline.Items[NodeNr],NodeNr,Result,Expanded);
          with WebOutput do begin
            SendSpacers(fIndent*pred(Level));
            SendLine(Result);
            end;
          end
        else begin{cannot be expanded}
          Result:='%=outlinePage=%%=JUMP|'+pageID+'|'+showThis+'=%';
          if assigned(fOnDocument) then
            fOnDocument(fOutline.Items[NodeNr],NodeNr,Result);
          with WebOutput do begin
            SendSpacers(fIndent*pred(Level));
            Send(Result);
            SendLine(MoreHTML+'<BR>');
            end;
          end;
        end;
      end;
  end;

begin
  if not tpUpdated then
    exit;
  inherited DoExecute;
  //
  iStackCounter:=0;
  //
  PerformCommand;
  fLevels:=0;
  with fOutline do begin
    BeginUpdate;
    for NodeNr:=1 to ItemCount do
      SendNodeString;
    EndUpdate;
    end;
end;

{----------------------------------------------------------------------------------------}
{----------------------------------------------------------------------------------------}

procedure TWebOutline.PerformCommand;
var
  Cmd:TWebOutlineCommands;
  i:integer;
  a1:string;
begin
  a1:=DefaultsTo(Command,HtmlParam);
  i:=StrToIntDef(a1,-1);
  if i>-1 then begin
    Expanded[i]:=not Expanded[i];
    Current:=i;
    end
  else
    Current:=-2;  // nowhere
  for Cmd:= low(cmd) to high(cmd) do
    if pos(uppercase(WebOutlineCommands[Cmd]),uppercase(a1))>0 then
      case cmd of
       ocGoto: Level:=StrToIntDef(LeftOf(',',copy(a1
                ,1+length(WebOutlineCommands[Cmd]),255)),-1);
        ocTop: Level:=1;
       ocLess: Level:=max(1,pred(Level));
       ocMore: Level:=min(Levels,succ(Level));
        ocAll: Level:=Levels;
        ocCut: begin
               fOutline.FullExpand;
               i:=StrToIntDef(LeftOf(',',copy(a1
               ,1+length(WebOutlineCommands[Cmd]),255)),0);
               Expanded[i]:=True;
               fCut:=fOutline.items[i].Level;
               end;
        end;
  //Command:='';
end;

{----------------------------------------------------------------------------------------}

procedure TWebOutline.SetLevel(Value:Byte);
var
  i:integer;
begin
  if not IsUpdated then
    exit;
  fCut:=0;
  fLevel:=max(1,min(Levels,Value));
  with fOutline do begin
    BeginUpdate;
    for i:=1 to ItemCount do
      with items[i] do
        if Level < fLevel then
          if NOT Expanded and HasItems then
            Expand
          else
        else
          if Expanded then
            Collapse;
    EndUpdate;
    end;
end;

procedure TWebOutline.SetToZero(Value:Byte);
begin
  fLevels:=0;
end;

procedure TWebOutline.SetToTop;
begin
  SetLevel(0);
end;

function TWebOutline.GetLevels:Byte;
{Set Level to 0 to re-read levels after changing outline text}
var
  i: Integer;
begin
  Result:=fLevels;
  if (not tpUpdated) or (Result>0) then
    exit;
  fLevels:=0;
  with fOutline do
    for i:=1 to ItemCount do
      if Items[i].Level>fLevels then
        fLevels:=Items[i].Level;
  Result:=fLevels;
end;

{----------------------------------------------------------------------------------------}

procedure TWebOutline.SetSaveState(const State:String);
var
  a1,a2:string;
begin
  inc(iStackCounter);
  //
  SplitString(State,'|',a1,a2);
  try try
    if isUpdated and (a1<>'') then
      StringToOutline(a1);
  finally
    inherited SetSaveState(a2);
    end;
  except
    WebOutput.SendException(Self,Exception(ExceptObject));
    end;
end;

procedure TWebOutline.StringToOutline(Const Value:String);
var
  i:integer;
begin
  with fOutline do
    for i:=1 to ItemCount do
      if Value[i] = toExpanded then
        items[i].expand
      else
        items[i].collapse;
end;

{----------------------------------------------------------------------------------------}

function TWebOutline.GetSaveState:String;
begin
  Result:='|'+inherited GetSaveState;
  if isUpdated then
    Result:=OutlineToString+Result;
end;

function TWebOutline.OutlineToString:string;
var
  i:integer;
begin
  Result:='';
  with fOutline do
    for i:=1 to ItemCount do
      Result:=Result+cStateCode[items[i].expanded];
end;


{----------------------------------------------------------------------------------------}
{helper procs for outside use}

procedure TWebOutline.SetExpanded(Node:Integer;Value:Boolean);
var
  i:integer;

  procedure ExpandNode(Node:TOutlineNode);
  begin
    if Node=nil then
      exit;
    with Node do begin
      if not IsVisible then
        ExpandNode(Parent);
      if IsVisible then
        Expand;
      end;
  end;
begin
  i:=max(0,min(pred(fOutline.ItemCount),Node));
  with fOutline do
    if Value then
      ExpandNode(Items[i])
    else
      Items[i].Collapse;
end;

function TWebOutline.GetExpanded(Node:Integer):Boolean;
begin
  with fOutline.items[max(0,min(pred(fOutline.ItemCount),Node))] do
    Result:=Expanded;
end;

{----------------------------------------------------------------------------------------}

//procedure Register;
//begin
//  RegisterComponents('HT+', [TWebOutline]);
//end;

{----------------------------------------------------------------------------------------}
end.