freepascal.compiler/packages/extra/amunits/units/amigaguide.pas

{
    This file is part of the Free Pascal run time library.

    A file in Amiga system run time library.
    Copyright (c) 1998-2003 by Nils Sjoholm
    member of the Amiga RTL development team.

    See the file COPYING.FPC, 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.

 **********************************************************************}

{
    History:

    Added functions and procedures with array of const.
    For use with fpc 1.0.7. They are in systemvartags.
    10 Nov 2002.

    Added the defines use_amiga_smartlink and
    use_auto_openlib. Implemented opening of
    the library.
    13 Jan 2003.

    Update for AmigaOs 3.9.
    Added a const and a member to record tXRef;
    Changed startupcode for library.
    26 Jan 2003.

    Changed cardinal to longword.
    09 Feb 2003.

    [email protected]
}

{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
   {$smartlink on}
{$endif use_amiga_smartlink}

unit amigaguide;

INTERFACE

uses exec,amigados, intuition, utility;

const
 APSH_TOOL_ID           = 11000;
 StartupMsgID           = (APSH_TOOL_ID+1) ;      { Startup message }
 LoginToolID            = (APSH_TOOL_ID+2) ;      { Login a tool SIPC port }
 LogoutToolID           = (APSH_TOOL_ID+3) ;      { Logout a tool SIPC port }
 ShutdownMsgID          = (APSH_TOOL_ID+4) ;      { Shutdown message }
 ActivateToolID         = (APSH_TOOL_ID+5) ;      { Activate tool }
 DeactivateToolID       = (APSH_TOOL_ID+6) ;      { Deactivate tool }
 ActiveToolID           = (APSH_TOOL_ID+7) ;      { Tool Active }
 InactiveToolID         = (APSH_TOOL_ID+8) ;      { Tool Inactive }
 ToolStatusID           = (APSH_TOOL_ID+9) ;      { Status message }
 ToolCmdID              = (APSH_TOOL_ID+10);      { Tool command message }
 ToolCmdReplyID         = (APSH_TOOL_ID+11);      { Reply to tool command }
 ShutdownToolID         = (APSH_TOOL_ID+12);      { Shutdown tool }

{ Attributes accepted by GetAmigaGuideAttr() }
 AGA_Dummy              = (TAG_USER)   ;
 AGA_Path               = (AGA_Dummy+1);
 AGA_XRefList           = (AGA_Dummy+2);
 AGA_Activate           = (AGA_Dummy+3);
 AGA_Context            = (AGA_Dummy+4);

 AGA_HelpGroup          = (AGA_Dummy+5);
    { (ULONG) Unique identifier }

 AGA_Reserved1          = (AGA_Dummy+6);
 AGA_Reserved2          = (AGA_Dummy+7);
 AGA_Reserved3          = (AGA_Dummy+8);

 AGA_ARexxPort          = (AGA_Dummy+9);
    { (struct MsgPort *) Pointer to the ARexx message port (V40) }

 AGA_ARexxPortName      = (AGA_Dummy+10);
   { (STRPTR) Used to specify the ARexx port name (V40) (not copied) }

 AGA_Secure             = (AGA_Dummy+11);
   { (BOOL) Disable "ONOPEN", "ONCLOSE" and "LINK RX", "LINK RXS", "LINK SYSTEM" commands (V41) }

Type
    AMIGAGUIDECONTEXT = Pointer;

 pAmigaGuideMsg = ^tAmigaGuideMsg;
 tAmigaGuideMsg = record
    agm_Msg     : tMessage;                     { Embedded Exec message structure }
    agm_Type    : ULONG;                        { Type of message }
    agm_Data    : Pointer;                      { Pointer to message data }
    agm_DSize,                                  { Size of message data }
    agm_DType,                                  { Type of message data }
    agm_Pri_Ret,                                { Primary return value }
    agm_Sec_Ret : ULONG;                        { Secondary return value }
    agm_System1,
    agm_System2 : Pointer;
 end;

{ Allocation description structure }
  pNewAmigaGuide = ^tNewAmigaGuide;
  tNewAmigaGuide = record
    nag_Lock  : BPTR;                           { Lock on the document directory }
    nag_Name  : STRPTR;                         { Name of document file }
    nag_Screen : pScreen;                       { Screen to place windows within }
    nag_PubScreen,                              { Public screen name to open on }
    nag_HostPort,                               { Application's ARexx port name }
    nag_ClientPort,                             { Name to assign to the clients ARexx port }
    nag_BaseName  : STRPTR;                     { Base name of the application }
    nag_Flags  : ULONG;                         { Flags }
    nag_Context: Pointer;                       { NULL terminated context table }
    nag_Node   : STRPTR;                        { Node to align on first (defaults to Main) }
    nag_Line   : Longint;                       { Line to align on }
    nag_Extens : pTagItem;                      { Tag array extension }
    nag_Client : Pointer;                       { Private! MUST be NULL }
  END;

CONST
{ public Client flags }
    HTF_LOAD_INDEX = 0;                 { Force load the index at init time }
    HTF_LOAD_ALL   = 2;                 { Force load the entire database at init }
    HTF_CACHE_NODE = 3;                 { Cache each node as visited }
    HTF_CACHE_DB   = 8;                 { Keep the buffers around UNTIL expunge }
    HTF_UNIQUE     = 32768;             { Unique ARexx port name }
    HTF_NOACTIVATE = 65536;             { Don't activate window }

    HTFC_SYSGADS   = $80000000;

{ Callback function ID's }
    HTH_OPEN       = 0;
    HTH_CLOSE      = 1;

    HTERR_NOT_ENOUGH_MEMORY       =  100;
    HTERR_CANT_OPEN_DATABASE      =  101;
    HTERR_CANT_FIND_NODE          =  102;
    HTERR_CANT_OPEN_NODE          =  103;
    HTERR_CANT_OPEN_WINDOW        =  104;
    HTERR_INVALID_COMMAND         =  105;
    HTERR_CANT_COMPLETE           =  106;
    HTERR_PORT_CLOSED             =  107;
    HTERR_CANT_CREATE_PORT        =  108;
    HTERR_KEYWORD_NOT_FOUND       =  113;

Type
{ Cross reference node }
  pXRef = ^tXRef;
  tXRef = record
    xr_Node   : tNode;            { Embedded node }
    xr_Pad    : WORD;             { Padding }
    xr_DF     : Pointer;          { Document defined in }
    xr_File,                      { Name of document file }
    xr_Name   : STRPTR;           { Name of item }
    xr_Line   : Longint;          { Line defined at }
    xr_Reserved : array [0..1] of Ulong;
   END;

CONST
{ Types of cross reference nodes }
    XR_GENERIC     = 0;
    XR_FUNCTION    = 1;
    XR_COMMAND     = 2;
    XR_INCLUDE     = 3;
    XR_MACRO       = 4;
    XR_STRUCT      = 5;
    XR_FIELD       = 6;
    XR_TYPEDEF     = 7;
    XR_DEFINE      = 8;

Type
{ Callback handle }
   pAmigaGuideHost = ^tAmigaGuideHost;
   tAmigaGuideHost = record
    agh_Dispatcher  : tHook;         { Dispatcher }
    agh_Reserved,                 { Must be 0 }
    agh_Flags,
    agh_UseCnt      : ULONG;                   { Number of open nodes }
    agh_SystemData,                        { Reserved for system use }
    agh_UserData    : Pointer;                  { Anything you want... }
   END;

CONST
{ Methods }
    HM_FindNode    = 1 ;
    HM_OpenNode    = 2 ;
    HM_CloseNode   = 3 ;
    HM_Expunge     = 10;              { Expunge DataBase }

Type
{ HM_FindNode }
   popFindHost = ^topFindHost;
   topFindHost = record
    MethodID  : ULONG;
    ofh_Attrs : pTagItem;           {  R: Additional attributes }
    ofh_Node,                    {  R: Name of node }
    ofh_TOC,                     {  W: Table of Contents }
    ofh_Title,                   {  W: Title to give to the node }
    ofh_Next,                    {  W: Next node to browse to }
    ofh_Prev  : STRPTR;          {  W: Previous node to browse to }
   END;

{ HM_OpenNode, HM_CloseNode }
   popNodeIO = ^topNodeIO;
   topNodeIO = record
    MethodID  : ULONG;
    onm_Attrs : pTagItem;          {  R: Additional attributes }
    onm_Node,                    {  R: Node name AND arguments }
    onm_FileName,                {  W: File name buffer }
    onm_DocBuffer : STRPTR;               {  W: Node buffer }
    onm_BuffLen : ULONG;                  {  W: Size of buffer }
    onm_Flags : ULONG;                    { RW: Control flags }
   END;

CONST
{ onm_Flags }
    HTNF_KEEP      = 0; { Don't flush this node UNTIL database is
                                 * closed. }
    HTNF_Reserved1 = 2 ; { Reserved for system use }
    HTNF_Reserved2 = 4 ; { Reserved for system use }
    HTNF_ASCII     = 8 ; { Node is straight ASCII }
    HTNF_Reserved3 = 16; { Reserved for system use }
    HTNF_CLEAN     = 32; { Remove the node from the database }
    HTNF_DONE      = 64; { Done with node }

{ onm_Attrs }
    HTNA_Dummy     = TAG_USER;
    HTNA_Screen    = (TAG_USER + 1);  { Screen that window resides in }
    HTNA_Pens      = (TAG_USER + 2);  { Pen array (from DrawInfo) }
    HTNA_Rectangle = (TAG_USER + 3);  { Window box }

    HTNA_HelpGroup = (HTNA_Dummy+5);  { (ULONG) unique identifier }


Type
{ HM_Expunge }
  popExpungeNode = ^topExpungeNode;
  topExpungeNode = record
    MethodID  : ULONG;
    oen_Attrs : pTagItem;          {  R: Additional attributes }
  END;

VAR AmigaGuideBase : pLibrary;

const
    AMIGAGUIDENAME : Pchar = 'amigaguide.library';

FUNCTION AddAmigaGuideHostA(h : pHook; name : pCHAR; attrs : pTagItem) : POINTER;
FUNCTION AmigaGuideSignal(cl : POINTER) : ULONG;
PROCEDURE CloseAmigaGuide(cl : POINTER);
PROCEDURE ExpungeXRef;
FUNCTION GetAmigaGuideAttr(tag : ULONG; cl : POINTER; storage : POINTER) : LONGINT;
FUNCTION GetAmigaGuideMsg(cl : POINTER) : pAmigaGuideMsg;
FUNCTION GetAmigaGuideString(id : LONGINT) : pCHAR;
FUNCTION LoadXRef(lock : LONGINT; name : pCHAR) : LONGINT;
FUNCTION LockAmigaGuideBase(handle : POINTER) : LONGINT;
FUNCTION OpenAmigaGuideA(nag : pNewAmigaGuide; taglist : pTagItem) : POINTER;
FUNCTION OpenAmigaGuideAsyncA(nag : pNewAmigaGuide; attrs : pTagItem) : POINTER;
FUNCTION RemoveAmigaGuideHostA(hh : POINTER; attrs : pTagItem) : LONGINT;
PROCEDURE ReplyAmigaGuideMsg(amsg : pAmigaGuideMsg);
FUNCTION SendAmigaGuideCmdA(cl : POINTER; cmd : pCHAR; attrs : pTagItem) : LONGINT;
FUNCTION SendAmigaGuideContextA(cl : POINTER; attrs : pTagItem) : LONGINT;
FUNCTION SetAmigaGuideAttrsA(cl : POINTER; attrs : pTagItem) : LONGINT;
FUNCTION SetAmigaGuideContextA(cl : POINTER; id : ULONG; attrs : pTagItem) : LONGINT;
PROCEDURE UnlockAmigaGuideBase(key : LONGINT);


{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitAMIGAGUIDELibrary;
{$endif use_init_openlib}

{This is a variable that knows how the unit is compiled}
var
    AMIGAGUIDEIsCompiledHow : longint;

IMPLEMENTATION

{$ifndef dont_use_openlib}
uses msgbox;
{$endif dont_use_openlib}


FUNCTION AddAmigaGuideHostA(h : pHook; name : pCHAR; attrs : pTagItem) : POINTER;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L h,A0
    MOVE.L  name,D0
    MOVEA.L attrs,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -138(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION AmigaGuideSignal(cl : POINTER) : ULONG;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVEA.L AmigaGuideBase,A6
    JSR -072(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE CloseAmigaGuide(cl : POINTER);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVEA.L AmigaGuideBase,A6
    JSR -066(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE ExpungeXRef;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L AmigaGuideBase,A6
    JSR -132(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION GetAmigaGuideAttr(tag : ULONG; cl : POINTER; storage : POINTER) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  tag,D0
    MOVEA.L cl,A0
    MOVEA.L storage,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -114(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION GetAmigaGuideMsg(cl : POINTER) : pAmigaGuideMsg;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVEA.L AmigaGuideBase,A6
    JSR -078(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION GetAmigaGuideString(id : LONGINT) : pCHAR;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  id,D0
    MOVEA.L AmigaGuideBase,A6
    JSR -210(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION LoadXRef(lock : LONGINT; name : pCHAR) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L lock,A0
    MOVEA.L name,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -126(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION LockAmigaGuideBase(handle : POINTER) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L handle,A0
    MOVEA.L AmigaGuideBase,A6
    JSR -036(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION OpenAmigaGuideA(nag : pNewAmigaGuide; taglist : pTagItem) : POINTER;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L nag,A0
    MOVEA.L taglist,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -054(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION OpenAmigaGuideAsyncA(nag : pNewAmigaGuide; attrs : pTagItem) : POINTER;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L nag,A0
    MOVE.L  attrs,D0
    MOVEA.L AmigaGuideBase,A6
    JSR -060(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION RemoveAmigaGuideHostA(hh : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L hh,A0
    MOVEA.L attrs,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -144(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE ReplyAmigaGuideMsg(amsg : pAmigaGuideMsg);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L amsg,A0
    MOVEA.L AmigaGuideBase,A6
    JSR -084(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION SendAmigaGuideCmdA(cl : POINTER; cmd : pCHAR; attrs : pTagItem) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVE.L  cmd,D0
    MOVE.L  attrs,D1
    MOVEA.L AmigaGuideBase,A6
    JSR -102(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION SendAmigaGuideContextA(cl : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVE.L  attrs,D0
    MOVEA.L AmigaGuideBase,A6
    JSR -096(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION SetAmigaGuideAttrsA(cl : POINTER; attrs : pTagItem) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVEA.L attrs,A1
    MOVEA.L AmigaGuideBase,A6
    JSR -108(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION SetAmigaGuideContextA(cl : POINTER; id : ULONG; attrs : pTagItem) : LONGINT;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L cl,A0
    MOVE.L  id,D0
    MOVE.L  attrs,D1
    MOVEA.L AmigaGuideBase,A6
    JSR -090(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE UnlockAmigaGuideBase(key : LONGINT);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  key,D0
    MOVEA.L AmigaGuideBase,A6
    JSR -042(A6)
    MOVEA.L (A7)+,A6
  END;
END;

const
    { Change VERSION and LIBVERSION to proper values }

    VERSION : string[2] = '0';
    LIBVERSION : longword = 0;

{$ifdef use_init_openlib}
  {$Info Compiling initopening of amigaguide.library}
  {$Info don't forget to use InitAMIGAGUIDELibrary in the beginning of your program}

var
    amigaguide_exit : Pointer;

procedure CloseamigaguideLibrary;
begin
    ExitProc := amigaguide_exit;
    if AmigaGuideBase <> nil then begin
        CloseLibrary(AmigaGuideBase);
        AmigaGuideBase := nil;
    end;
end;

procedure InitAMIGAGUIDELibrary;
begin
    AmigaGuideBase := nil;
    AmigaGuideBase := OpenLibrary(AMIGAGUIDENAME,LIBVERSION);
    if AmigaGuideBase <> nil then begin
        amigaguide_exit := ExitProc;
        ExitProc := @CloseamigaguideLibrary;
    end else begin
        MessageBox('FPC Pascal Error',
        'Can''t open amigaguide.library version ' + VERSION + #10 +
        'Deallocating resources and closing down',
        'Oops');
        halt(20);
    end;
end;

begin
    AMIGAGUIDEIsCompiledHow := 2;
{$endif use_init_openlib}

{$ifdef use_auto_openlib}
  {$Info Compiling autoopening of amigaguide.library}

var
    amigaguide_exit : Pointer;

procedure CloseamigaguideLibrary;
begin
    ExitProc := amigaguide_exit;
    if AmigaGuideBase <> nil then begin
        CloseLibrary(AmigaGuideBase);
        AmigaGuideBase := nil;
    end;
end;

begin
    AmigaGuideBase := nil;
    AmigaGuideBase := OpenLibrary(AMIGAGUIDENAME,LIBVERSION);
    if AmigaGuideBase <> nil then begin
        amigaguide_exit := ExitProc;
        ExitProc := @CloseamigaguideLibrary;
        AMIGAGUIDEIsCompiledHow := 1;
    end else begin
        MessageBox('FPC Pascal Error',
        'Can''t open amigaguide.library version ' + VERSION + #10 +
        'Deallocating resources and closing down',
        'Oops');
        halt(20);
    end;

{$endif use_auto_openlib}

{$ifdef dont_use_openlib}
begin
    AMIGAGUIDEIsCompiledHow := 3;
   {$Warning No autoopening of amigaguide.library compiled}
   {$Warning Make sure you open amigaguide.library yourself}
{$endif dont_use_openlib}


END. (* UNIT AMIGAGUIDE *)