{
Этот исходный код является частью проекта ПВТ-ОО.
Следующие файлы используются этим исходным кодом:
ru.malik.elaborarer.avt.browser.mainwindow.lfm
На них так же распространяются те же права, как и на этот исходный код.
Copyright © 2021 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit ru.malik.elaborarer.avt.browser.mainwindow;
{$MODE DELPHI}
interface
uses
buttons,
classes,
comctrls,
controls,
dialogs,
extctrls,
forms,
graphics,
iphtml,
lcltype,
menus,
stdctrls,
sysutils,
themes,
types,
utf8process,
pascalx.lang,
pascalx.io,
pascalx.io.vfs,
pascalx.osapi,
pascalx.utils,
ru.malik.elaborarer.avt.programme,
ru.malik.elaborarer.avt.operation,
ru.malik.elaborarer.avt.lexer,
ru.malik.elaborarer.avt.table,
ru.malik.elaborarer.avt.browser.aboutwindow;
{$ASMMODE INTEL,CALLING REGISTER,TYPEINFO ON}
{%region public }
type
ParseLinkResult = interface;
AVTLibrarySource = class;
TMainForm = class;
TFPImageBitmap_Array1d = packed array of TFPImageBitmap;
ParseLinkResult = interface(_Interface) ['{0963C50A-83F0-4F82-8E31-BCFA2707BDCD}']
function getItem(): AVTItem;
function getRef(): AnsiString;
end;
AVTLibrarySource = class(AVTSource)
private
fldDirectory: UnicodeString;
public
constructor create(parentProgramme: AVTProgramme; const directory, fileName: UnicodeString);
procedure realize(); overload;
end;
TMainForm = class(TForm, Runnable)
treePackagesImageList: TImageList;
treePackagesMenu: TPopupMenu;
treePackagesMenuFlat: TMenuItem;
treePackagesMenuHierarchy: TMenuItem;
treePackagesMenu001: TMenuItem;
treePackagesMenuOnPages: TMenuItem;
treePackagesMenuHorizontal: TMenuItem;
treePackagesMenuSeparate: TMenuItem;
treeTypesImageList: TImageList;
treeTypesMenu: TPopupMenu;
treeTypesMenuFlat: TMenuItem;
treeTypesMenuHierarchy: TMenuItem;
treeTypesMenu001: TMenuItem;
treeTypesMenuOnPages: TMenuItem;
treeTypesMenuHorizontal: TMenuItem;
treeTypesMenuSeparate: TMenuItem;
listMembersMenu: TPopupMenu;
listMembersMenuViewSynthetic: TMenuItem;
listMembersMenuViewPrivate: TMenuItem;
listMembersMenuViewDefault: TMenuItem;
listMembersMenuViewPackage: TMenuItem;
listMembersMenuViewProtected: TMenuItem;
listMembersMenuViewPublic: TMenuItem;
listMembersMenuViewVisibleFrom: TMenuItem;
listMembersMenu001: TMenuItem;
listMembersMenuInherited: TMenuItem;
listMembersMenuFullNames: TMenuItem;
listMembersMenu002: TMenuItem;
listMembersMenuOnPages: TMenuItem;
listMembersMenuHorizontal: TMenuItem;
viewDocumentationMenu: TPopupMenu;
viewDocumentationMenuBrowser: TMenuItem;
viewDocumentationMenuRefresh: TMenuItem;
viewDocumentationMenu001: TMenuItem;
viewDocumentationMenuOnPages: TMenuItem;
viewDocumentationMenuHorizontal: TMenuItem;
viewDocumentationMenuSeparate: TMenuItem;
viewDocumentationBrowser: TProcessUTF8;
panelMain: TPanel;
panelMembersOfProgramme: TPanel;
panelPackages: TPanel;
headerPackages: TPanel;
labelPackages: TLabel;
sbtnPackagesMenu: TSpeedButton;
treePackages: TTreeView;
splitMembersOfProgramme: TSplitter;
panelTypes: TPanel;
headerTypes: TPanel;
labelTypes: TLabel;
sbtnTypesMenu: TSpeedButton;
listTypes: TListBox;
treeTypes: TTreeView;
splitMain: TSplitter;
panelMembersOfType: TPanel;
panelMembers: TPanel;
headerMembers: TPanel;
labelMembers: TLabel;
listMembersVisibleFrom: TComboBox;
sbtnMembersMenu: TSpeedButton;
listMembers: TListBox;
splitMembersOfType: TSplitter;
panelDocumentation: TPanel;
headerDocumentation: TPanel;
labelDocumentation: TLabel;
sbtnDocumentationMenu: TSpeedButton;
viewDocumentation: TIpHtmlPanel;
panelControl: TPanel;
labelErrorMessage: TLabel;
flagAutoRefresh: TCheckBox;
btnRefresh: TButton;
btnAbout: TButton;
btnClose: TButton;
procedure formActivate(sender: TObject);
procedure formCloseQuery(sender: TObject; var canClose: boolean);
procedure buttonClick(sender: TObject);
procedure autoFocusPackages(sender: TObject);
procedure autoFocusTypes(sender: TObject);
procedure autoFocusMembers(sender: TObject);
procedure autoFocusDocumentation(sender: TObject);
procedure defaultResize(sender: TObject);
procedure defaultKeyDown(sender: TObject; var key: word; shift: TShiftState);
procedure treeSelectionChange(sender: TObject);
procedure listSelectionChange(sender: TObject; user: boolean);
procedure listTypesDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
procedure listMembersDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
procedure listMembersVisibleFromDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
private
fldAutomaticUpdate: boolean;
fldWindowStateLoaded: boolean;
fldSelectedAllPackages: boolean;
fldMinVisibility: int;
fldTypesListWidth: int;
fldMembersListWidth: int;
fldErrorMessage: AnsiString;
fldDocumentation: AnsiString;
fldShowedMemberName: AnsiString;
fldSelectedTypeName: AnsiString;
fldSelectedPackageName: AnsiString;
fldSelectedMemberSimpleName: AnsiString;
fldSelectedMemberArgsName: AnsiString_Array1d;
fldSelectedSourceName: UnicodeString;
fldProjectDirectory: UnicodeString;
fldCssStyleFile: UnicodeString;
fldHtmlDocFile: UnicodeString;
fldSettingsFile: UnicodeString;
fldCurrentProgramme: AVTProgramme;
fldCreatedProgramme: AVTProgramme;
fldObjectsIcons: TFPImageBitmap_Array1d;
fldTypesIcons: TFPImageBitmap_Array1d;
fldMembersIcons: TFPImageBitmap_Array1d;
procedure loadWindowState();
procedure saveWindowState();
procedure updateTabOrders(); overload;
procedure updateSplitters(); overload;
procedure fillTreeOfPackages();
procedure fillTreeOfTypes();
procedure fillListOfTypes();
procedure fillListOfMembers();
procedure fillListOfTypesVisibility();
procedure fillMemberDocumentation(); overload;
procedure fillMemberDocumentation(member: AVTItem; refresh: boolean = false); overload;
procedure fillMemberDocumentation(const memberFullName: AnsiString; refresh: boolean = false); overload;
procedure showDocumentationHTML(const htmlText: AnsiString);
procedure readSourcesFrom(const directory, path: UnicodeString);
procedure realizeSources();
procedure lexicalAnalyzer();
procedure buildProgramme();
procedure programmeBuilded();
procedure setDefaultKeyDownEventFor(control: TWinControl);
function objectTreeNodeCompare(node1, node2: TTreeNode): int;
function flagsToString(flags: int; forceShowPublic: boolean = true; forceShowStatic: boolean = true): AnsiString;
function buildMemberTable(typeRef: AVTTypeStructured): AnsiString;
function parseShortDescription(const documentation: UnicodeString; member: AVTItem): AnsiString;
function parseDocumentation(const documentation: UnicodeString; member: AVTItem): AnsiString;
function parseLinkToType(source: AVTSource; pos: int; member: AVTItem): ParseLinkResult;
function parseLinkToMember(source: AVTSource; pos: int; member: AVTItem): ParseLinkResult;
function resolveName(const simpleName: AnsiString; packRef: AVTPackage): AVTItem; overload;
function resolveName(const simpleName: AnsiString; typeRef: AVTTypeStructured): AVTItem; overload;
function getObjectTreeNode(nodes: TTreeNodes; objectRef: _Object): TTreeNode;
function getTypeTreeNode(nodes: TTreeNodes; typeRef: AVTTypeStructured): TTreeNode;
function getObjectIcon(objectRef: _Object): TFPImageBitmap;
function getTypeIcon(typeRef: AVTTypeStructured): TFPImageBitmap;
function getMemberIcon(memberRef: AVTMember): TFPImageBitmap;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
procedure run();
private
class var instance: TMainForm;
class procedure destroyObjectArray(const objects: TObject_Array1d); static;
class procedure updateTabOrders(panel0, panel1: TWinControl); static; overload;
class procedure updateSplitters(panel0, panel1, splitter: TWinControl); static; overload;
class procedure loadSize(section: Hashtable; const key: AnsiString; selectedControl, selectedSplitter: TWinControl); static;
class procedure loadStrings(dst: TStrings; margin: int; fileSystem: ReadOnlyVirtualFileSystem; const fileName: UnicodeString); static; overload;
class procedure loadStrings(dst: TStrings; margin: int; const source: AnsiString); static; overload;
class procedure saveText(const text: AnsiString; fileSystem: WriteableVirtualFileSystem; const fileName: UnicodeString); static;
class function isMethodArguments(methodRef: AVTMethod; const argumentTypes: AnsiString_Array1d): boolean; static;
class function hasMemberInList(typeRef: AVTTypeStructured; memberRef: AVTMember; list: TStrings; count: int): boolean; static;
class function parseIniBoolean(paramValue: Value; defaultValue: boolean): boolean; static;
class function parseIniInteger(paramValue: Value; defaultValue: int): int; static;
class function getObjectIconIndex(objectRef: _Object): int; static;
class function getTypeIconIndex(typeRef: AVTTypeStructured): int; static;
class function getMemberIconIndex(memberRef: AVTMember): int; static;
class function getObjectIconName(index: int): AnsiString; static;
class function getTypeIconName(index: int): AnsiString; static;
class function getMemberIconName(index: int): AnsiString; static;
class function typeToHTML(typeRef: AVTType): AnsiString; static;
class function argumentsToLink(methodRef: AVTMethod): AnsiString; static;
class function argumentsToHTML(methodRef: AVTMethod): AnsiString; static;
class function readWriteToHTML(propertyRef: AVTProperty): AnsiString; static;
class function parseIniString(paramValue: Value; const defaultValue: AnsiString): AnsiString; static;
class function booleanToIniString(value: boolean): AnsiString; static;
class function windowPositionToIniString(parentControl: TWinControl): AnsiString; static;
class function activePageIndexToIniString(parentControl: TWinControl): AnsiString; static;
class function splitterControlSizeToIniString(splitterAlign: TAlign; splitterControl: TWinControl): AnsiString; static;
class function makeFullName(const path, workingDirectory: UnicodeString): UnicodeString; static;
class function parseFullyQualifiedPackageName(source: AVTSource; pos: int; packageRef: AVTPackage): AVTPackage; static;
class function parseFullyQualifiedTypeName(source: AVTSource; pos: int; packageRef: AVTPackage): AVTTypeStructured; static;
public
class procedure createInstance(const args: UnicodeString_Array1d);
end;
{%endregion}
implementation
{$R *.LFM}
{%region private }
type
ParseLinkInstance = class(RefCountInterfacedObject, ParseLinkResult)
private
fldItem: AVTItem;
fldRef: AnsiString;
public
constructor create(item: AVTItem; const ref: AnsiString);
function getItem(): AVTItem;
function getRef(): AnsiString;
end;
{%endregion}
{%region AVTLibrarySource }
constructor AVTLibrarySource.create(parentProgramme: AVTProgramme; const directory, fileName: UnicodeString);
begin
inherited create(parentProgramme, fileName);
self.fldDirectory := directory;
end;
procedure AVTLibrarySource.realize();
begin
realize(LocalFileSystem.getInstance(), fldDirectory);
end;
{%endregion}
{%region TMainForm }
procedure TMainForm.formActivate(sender: TObject);
begin
labelErrorMessage.caption := '';
if flagAutoRefresh.checked and btnRefresh.enabled then begin
buttonClick(btnRefresh);
end;
end;
procedure TMainForm.formCloseQuery(sender: TObject; var canClose: boolean);
begin
if sender = self then begin
saveWindowState();
canClose := true;
end else begin
canClose := false;
end;
end;
procedure TMainForm.buttonClick(sender: TObject);
const
PANEL_PACKAGES_WIDTH = int(320);
PANEL_PACKAGES_HEIGHT = int(200);
PANEL_DOCUMENTATION_WIDTH = int(480);
PANEL_DOCUMENTATION_HEIGHT = int(200);
var
tempUString: UnicodeString;
p: TPoint;
window: TForm;
pages: TPageControl;
paget: TTabSheet;
pagep: TTabSheet;
split: TSplitter;
panel: TWinControl;
other: TWinControl;
parent: TWinControl;
separated: TWinControl;
menuItemPages0: TMenuItem;
menuItemPages1: TMenuItem;
menuItemHoriz0: TMenuItem;
menuItemHoriz1: TMenuItem;
begin
menuItemPages0 := treeTypesMenuOnPages;
menuItemPages1 := treePackagesMenuOnPages;
menuItemHoriz0 := treeTypesMenuHorizontal;
menuItemHoriz1 := treePackagesMenuHorizontal;
{ ПАКЕТЫ }
if sender = sbtnPackagesMenu then with TControl(sender) do begin
p := clientToScreen(TPoint.create(width div 2, height div 2));
treePackagesMenu.popup(p.x, p.y);
exit;
end;
if (sender = menuItemPages0) or (sender = menuItemPages1) then begin
split := splitMembersOfProgramme;
panel := panelMembersOfProgramme;
other := panelPackages;
parent := other.parent;
if parent is TTabSheet then begin
menuItemPages0.checked := false;
menuItemPages1.checked := false;
menuItemHoriz0.enabled := true;
menuItemHoriz1.enabled := true;
treeTypesMenuSeparate.enabled := true;
treePackagesMenuSeparate.enabled := true;
pages := TTabSheet(parent).pageControl;
if split.align = alLeft then begin
panel.width := 2 * panel.width + split.width;
end;
split.show();
panelTypes.parent := panel;
other.parent := panel;
other.align := split.align;
other.setBounds(0, 0, PANEL_PACKAGES_WIDTH, PANEL_PACKAGES_HEIGHT);
pages.free();
treePackages.setFocus();
exit;
end;
menuItemPages0.checked := true;
menuItemPages1.checked := true;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
treeTypesMenuSeparate.enabled := false;
treePackagesMenuSeparate.enabled := false;
pages := TPageControl.create(panel);
pages.align := alClient;
pages.onKeyDown := defaultKeyDown;
pagep := pages.addTabSheet();
pagep.caption := labelPackages.caption;
pagep.onShow := autoFocusPackages;
paget := pages.addTabSheet();
paget.caption := labelTypes.caption;
paget.onShow := autoFocusTypes;
other.parent := pagep;
other.align := alClient;
panelTypes.parent := paget;
if sender = menuItemPages0 then begin
pages.activePageIndex := 1;
end;
pages.parent := panel;
if split.align = alLeft then begin
panel.width := (panel.width - split.width) div 2;
end;
split.hide();
exit;
end;
if (sender = menuItemHoriz0) or (sender = menuItemHoriz1) then begin
split := splitMembersOfProgramme;
panel := panelMembersOfProgramme;
other := panelPackages;
if split.align = alLeft then begin
menuItemHoriz0.checked := false;
menuItemHoriz1.checked := false;
p := TPoint.create((panel.width - split.width) div 2, 0);
split.align := alTop;
split.cursor := crVSplit;
split.resizeAnchor := akTop;
split.setBounds(0, 0, p.x, splitMain.width);
other.align := alTop;
other.setBounds(0, 0, p.x, PANEL_PACKAGES_HEIGHT);
panel.width := p.x;
updateTabOrders();
updateSplitters();
exit;
end;
menuItemHoriz0.checked := true;
menuItemHoriz1.checked := true;
p := TPoint.create(panel.width, panel.height);
panel.width := 2 * p.x + split.height;
split.align := alLeft;
split.cursor := crHSplit;
split.resizeAnchor := akLeft;
split.setBounds(0, 0, splitMain.width, p.y);
other.align := alLeft;
other.setBounds(0, 0, p.x, p.y);
updateTabOrders();
updateSplitters();
exit;
end;
if (sender = treePackagesMenuFlat) or (sender = treePackagesMenuHierarchy) then begin
fillTreeOfPackages();
exit;
end;
if sender = treePackagesMenuSeparate then begin
split := splitMembersOfProgramme;
panel := panelMembersOfProgramme;
other := panelTypes;
separated := panelPackages;
parent := separated.parent;
if parent is TForm then begin
splitMain.show();
panel.show();
panel.left := 0;
if other.parent is TForm then begin
menuItemPages0.enabled := false;
menuItemPages1.enabled := false;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
end else begin
menuItemPages0.enabled := true;
menuItemPages1.enabled := true;
menuItemHoriz0.enabled := true;
menuItemHoriz1.enabled := true;
split.show();
separated.align := split.align;
end;
separated.parent := panel;
separated.setBounds(0, 0, PANEL_PACKAGES_WIDTH, PANEL_PACKAGES_HEIGHT);
parent.free();
updateTabOrders();
exit;
end;
menuItemPages0.enabled := false;
menuItemPages1.enabled := false;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
window := TForm.create(owner);
with window.constraints do begin
minWidth := 320;
minHeight := 200;
end;
if fldWindowStateLoaded then begin
window.left := left;
window.top := top;
window.clientWidth := separated.width;
window.clientHeight := separated.height;
end;
window.borderIcons := [];
window.borderStyle := bsSizeToolWin;
window.caption := labelPackages.caption;
window.onCloseQuery := formCloseQuery;
window.show();
separated.parent := window;
separated.align := alClient;
if other.parent is TForm then begin
splitMain.hide();
panel.hide();
end;
split.hide();
updateTabOrders();
exit;
end;
{ ТИПЫ }
if sender = sbtnTypesMenu then with TControl(sender) do begin
p := clientToScreen(TPoint.create(width div 2, height div 2));
treeTypesMenu.popup(p.x, p.y);
exit;
end;
if sender = treeTypesMenuFlat then begin
panel := listTypes;
other := treeTypes;
panel.show();
if other.focused() then begin
panel.setFocus();
end;
other.hide();
fillListOfTypes();
exit;
end;
if sender = treeTypesMenuHierarchy then begin
panel := treeTypes;
other := listTypes;
panel.show();
if other.focused() then begin
panel.setFocus();
end;
other.hide();
fillTreeOfTypes();
exit;
end;
if sender = treeTypesMenuSeparate then begin
split := splitMembersOfProgramme;
panel := panelMembersOfProgramme;
other := panelPackages;
separated := panelTypes;
parent := separated.parent;
if parent is TForm then begin
splitMain.show();
panel.show();
panel.left := 0;
if other.parent is TForm then begin
menuItemPages0.enabled := false;
menuItemPages1.enabled := false;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
end else begin
menuItemPages0.enabled := true;
menuItemPages1.enabled := true;
menuItemHoriz0.enabled := true;
menuItemHoriz1.enabled := true;
split.show();
other.align := split.align;
other.setBounds(0, 0, PANEL_PACKAGES_WIDTH, PANEL_PACKAGES_HEIGHT);
end;
separated.parent := panel;
parent.free();
updateTabOrders();
exit;
end;
menuItemPages0.enabled := false;
menuItemPages1.enabled := false;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
window := TForm.create(owner);
with window.constraints do begin
minWidth := 320;
minHeight := 200;
end;
if fldWindowStateLoaded then begin
window.left := left;
window.top := top;
window.clientWidth := separated.width;
window.clientHeight := separated.height;
end;
window.borderIcons := [];
window.borderStyle := bsSizeToolWin;
window.caption := labelTypes.caption;
window.onCloseQuery := formCloseQuery;
window.show();
separated.parent := window;
if other.parent is TForm then begin
splitMain.hide();
panel.hide();
end else begin
other.align := alClient;
end;
split.hide();
updateTabOrders();
exit;
end;
menuItemPages0 := listMembersMenuOnPages;
menuItemPages1 := viewDocumentationMenuOnPages;
menuItemHoriz0 := listMembersMenuHorizontal;
menuItemHoriz1 := viewDocumentationMenuHorizontal;
{ ЭЛЕМЕНТЫ }
if sender = sbtnMembersMenu then with TControl(sender) do begin
p := clientToScreen(TPoint.create(width div 2, height div 2));
listMembersMenu.popup(p.x, p.y);
exit;
end;
if sender = listMembersMenuViewVisibleFrom then begin
if TMenuItem(sender).checked then with listMembersVisibleFrom do begin
visible := true;
if fldWindowStateLoaded then setFocus();
exit;
end;
listMembers.setFocus();
with listMembersVisibleFrom do begin
text := '';
visible := false;
end;
fillListOfMembers();
exit;
end;
if (sender = listMembersVisibleFrom) or (sender = listMembersMenuInherited) or (sender = listMembersMenuFullNames) then begin
fillListOfMembers();
exit;
end;
if (sender = menuItemPages0) or (sender = menuItemPages1) then begin
split := splitMembersOfType;
panel := panelMembersOfType;
other := panelDocumentation;
parent := other.parent;
if parent is TTabSheet then begin
menuItemPages0.checked := false;
menuItemPages1.checked := false;
menuItemHoriz0.enabled := true;
menuItemHoriz1.enabled := true;
viewDocumentationMenuSeparate.enabled := true;
pages := TTabSheet(parent).pageControl;
split.show();
panelMembers.parent := panel;
other.parent := panel;
other.align := split.align;
other.setBounds(panel.width, panel.height, PANEL_DOCUMENTATION_WIDTH, PANEL_DOCUMENTATION_HEIGHT);
pages.free();
listMembers.setFocus();
exit;
end;
menuItemPages0.checked := true;
menuItemPages1.checked := true;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
viewDocumentationMenuSeparate.enabled := false;
pages := TPageControl.create(panel);
pages.align := alClient;
pages.onKeyDown := defaultKeyDown;
pagep := pages.addTabSheet();
pagep.caption := labelMembers.caption;
pagep.onShow := autoFocusMembers;
paget := pages.addTabSheet();
paget.caption := fldDocumentation;
paget.onShow := autoFocusDocumentation;
other.parent := paget;
other.align := alClient;
panelMembers.parent := pagep;
if sender = menuItemPages1 then begin
pages.activePageIndex := 1;
end;
pages.parent := panel;
split.hide();
exit;
end;
if (sender = menuItemHoriz0) or (sender = menuItemHoriz1) then begin
split := splitMembersOfType;
panel := panelMembersOfType;
other := panelDocumentation;
if split.align = alRight then begin
menuItemHoriz0.checked := false;
menuItemHoriz1.checked := false;
p := TPoint.create(panel.width, panel.height);
split.align := alBottom;
split.cursor := crVSplit;
split.resizeAnchor := akBottom;
split.setBounds(0, 0, p.x, splitMain.width);
other.align := alBottom;
other.setBounds(p.x, p.y, PANEL_DOCUMENTATION_WIDTH, PANEL_DOCUMENTATION_HEIGHT);
updateTabOrders();
updateSplitters();
exit;
end;
menuItemHoriz0.checked := true;
menuItemHoriz1.checked := true;
p := TPoint.create(panel.width, panel.height);
split.align := alRight;
split.cursor := crHSplit;
split.resizeAnchor := akRight;
split.setBounds(0, 0, splitMain.width, p.y);
other.align := alRight;
other.setBounds(p.x, p.y, PANEL_DOCUMENTATION_WIDTH, PANEL_DOCUMENTATION_HEIGHT);
updateTabOrders();
updateSplitters();
exit;
end;
if (sender is TMenuItem) and (TMenuItem(sender).getParentMenu() = listMembersMenu) then begin
fldMinVisibility := int(TComponent(sender).tag);
fillTreeOfPackages();
if treeTypes.visible then fillTreeOfTypes();
if listTypes.visible then fillListOfTypes();
fillListOfMembers();
fillMemberDocumentation();
exit;
end;
{ ДОКУМЕНТАЦИЯ }
if sender = sbtnDocumentationMenu then with TControl(sender) do begin
p := clientToScreen(TPoint.create(width div 2, height div 2));
viewDocumentationMenu.popup(p.x, p.y);
exit;
end;
if sender = viewDocumentationMenuBrowser then with viewDocumentationBrowser, parameters do begin
fillMemberDocumentation(fldShowedMemberName, true);
tempUString := getEnvironmentVariable(UnicodeString('SystemRoot'));
if not stringEndsWith(UnicodeString(DIRECTORY_SEPARATOR), tempUString) then begin
tempUString := tempUString + DIRECTORY_SEPARATOR;
end;
executable := stringToUTF8(tempUString) + 'explorer.exe';
clear();
add(stringToUTF8(stringReplace(stringCopy(fldHtmlDocFile, 2), '/', DIRECTORY_SEPARATOR)));
execute();
exit;
end;
if sender = viewDocumentationMenuRefresh then begin
fillMemberDocumentation(fldShowedMemberName, true);
labelErrorMessage.caption := 'Документ обновлён. Теперь обновите вкладку обозревателя.';
exit;
end;
if sender = viewDocumentationMenuSeparate then begin
split := splitMembersOfType;
panel := panelMembersOfType;
other := panelMembers;
separated := panelDocumentation;
parent := separated.parent;
if parent is TForm then begin
menuItemPages0.enabled := true;
menuItemPages1.enabled := true;
menuItemHoriz0.enabled := true;
menuItemHoriz1.enabled := true;
split.show();
separated.align := split.align;
separated.parent := panel;
separated.setBounds(panel.width, panel.height, PANEL_DOCUMENTATION_WIDTH, PANEL_DOCUMENTATION_HEIGHT);
parent.free();
updateTabOrders();
exit;
end;
menuItemPages0.enabled := false;
menuItemPages1.enabled := false;
menuItemHoriz0.enabled := false;
menuItemHoriz1.enabled := false;
window := TForm.create(owner);
with window.constraints do begin
minWidth := 320;
minHeight := 200;
end;
if fldWindowStateLoaded then begin
window.left := left;
window.top := top;
window.clientWidth := separated.width;
window.clientHeight := separated.height;
end;
window.borderIcons := [];
window.borderStyle := bsSizeToolWin;
window.caption := labelDocumentation.caption;
window.onCloseQuery := formCloseQuery;
window.show();
separated.parent := window;
separated.align := alClient;
split.hide();
updateTabOrders();
exit;
end;
if sender = viewDocumentation then begin
fillMemberDocumentation(TIpHtmlPanel(sender).hotURL);
exit;
end;
{ ПОДВАЛ }
if sender = btnRefresh then begin
if TWinControl(sender).focused() then listMembers.setFocus();
TButton(sender).enabled := false;
(Thread.create(self)).start();
exit;
end;
if sender = btnAbout then begin
with TAboutForm.create(self) do begin
try
left := self.left + (self.width - width) div 2;
top := self.top + (self.height - height) div 2;
showModal();
finally
free();
end;
end;
exit;
end;
if sender = btnClose then begin
close();
end;
end;
procedure TMainForm.autoFocusPackages(sender: TObject);
begin
treePackages.setFocus();
end;
procedure TMainForm.autoFocusTypes(sender: TObject);
var
ctrl: TWinControl;
begin
ctrl := treeTypes;
if ctrl.visible then begin
ctrl.setFocus();
exit;
end;
listTypes.setFocus();
end;
procedure TMainForm.autoFocusMembers(sender: TObject);
begin
listMembers.setFocus();
end;
procedure TMainForm.autoFocusDocumentation(sender: TObject);
begin
viewDocumentation.setFocus();
end;
procedure TMainForm.defaultResize(sender: TObject);
begin
updateSplitters();
end;
procedure TMainForm.defaultKeyDown(sender: TObject; var key: word; shift: TShiftState);
var
control: TWinControl;
selectedNode: TTreeNode;
begin
if (sender is TWinControl) and (key = VK_TAB) then begin
control := TWinControl(sender);
while (control <> nil) and not(control is TPageControl) do begin
control := control.parent;
end;
if control is TPageControl then begin
if shift * [ssShift, ssCtrl, ssAlt] = [ssCtrl] then begin
TPageControl(control).selectNextPage(true);
key := 0;
exit;
end;
if shift * [ssShift, ssCtrl, ssAlt] = [ssShift, ssCtrl] then begin
TPageControl(control).selectNextPage(false);
key := 0;
exit;
end;
end;
end;
if (sender is TTreeView) and ((key = VK_8) and (shift * [ssShift, ssCtrl, ssAlt] = [ssShift]) or (key = VK_MULTIPLY) and (shift * [ssShift, ssCtrl, ssAlt] = [])) then begin
selectedNode := TTreeView(sender).selected;
if selectedNode <> nil then selectedNode.expand(true);
key := 0;
exit;
end;
end;
procedure TMainForm.treeSelectionChange(sender: TObject);
var
selectedNode: TTreeNode;
selectedObject: _Object;
begin
if fldAutomaticUpdate then exit;
if sender = treePackages then with TTreeView(sender) do begin
selectedNode := selected;
if selectedNode <> nil then begin
selectedObject := TObject(selectedNode.data) as _Object;
if selectedObject is AVTPackage then begin
fldSelectedAllPackages := false;
fldSelectedPackageName := AVTPackage(selectedObject).fullName;
fldSelectedSourceName := '';
end else
if selectedObject is AVTSource then with AVTSource(selectedObject) do begin
fldSelectedAllPackages := false;
fldSelectedPackageName := package.fullName;
fldSelectedSourceName := fileName;
end else begin
fldSelectedAllPackages := true;
fldSelectedPackageName := '';
fldSelectedSourceName := '';
end;
if listTypes.visible then fillListOfTypes();
if treeTypes.visible then fillTreeOfTypes();
end;
exit;
end;
if sender = treeTypes then with TTreeView(sender) do begin
selectedNode := selected;
if selectedNode <> nil then begin
fldSelectedTypeName := (TObject(selectedNode.data) as AVTTypeStructured).fullName;
fldSelectedMemberSimpleName := '';
fldSelectedMemberArgsName := nil;
fillListOfMembers();
fillMemberDocumentation();
end;
exit;
end;
end;
procedure TMainForm.listSelectionChange(sender: TObject; user: boolean);
var
i: int;
selectedIndex: int;
selectedObject: _Object;
selectedArgs: AnsiString_Array1d;
begin
if fldAutomaticUpdate or not user then exit;
if sender = listTypes then with TListBox(sender) do begin
selectedIndex := itemIndex;
if selectedIndex >= 0 then begin
fldSelectedTypeName := (items.objects[selectedIndex] as AVTTypeStructured).fullName;
fldSelectedMemberSimpleName := '';
fldSelectedMemberArgsName := nil;
fillListOfMembers();
fillMemberDocumentation();
end;
exit;
end;
if sender = listMembers then with TListBox(sender) do begin
selectedIndex := itemIndex;
if selectedIndex >= 0 then begin
selectedObject := items.objects[selectedIndex] as _Object;
if selectedObject is AVTMember then with AVTMember(selectedObject) do begin
fldSelectedMemberSimpleName := simpleName;
selectedArgs := nil;
if selectedObject is AVTMethod then with AVTMethod(selectedObject) do begin
selectedArgs := AnsiString_Array1d_create(getArgumentsCount());
for i := system.length(selectedArgs) - 1 downto 0 do begin
selectedArgs[i] := getArgumentAt(i).valueType.fullName;
end;
end;
fldSelectedMemberArgsName := selectedArgs;
end else begin
fldSelectedMemberSimpleName := '';
fldSelectedMemberArgsName := nil;
end;
fillMemberDocumentation();
end;
exit;
end;
end;
procedure TMainForm.listTypesDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
var
selected: boolean;
left: int;
top: int;
width: int;
height: int;
drawLeft: int;
drawText: AnsiString;
tservices: TThemeServices;
details: TThemedElementDetails;
render: TCanvas;
typeRef: AVTTypeStructured;
icon: TFPImageBitmap;
brush: TBrush;
font: TFont;
list: TListBox;
begin
list := control as TListBox;
typeRef := list.items.objects[index] as AVTTypeStructured;
if typeRef = nil then exit;
render := list.canvas;
tservices := themes.themeServices();
selected := odSelected in state;
if not selected then begin
details := tservices.getElementDetails(ttItemNormal);
end else
if control.focused() then begin
details := tservices.getElementDetails(ttItemSelected);
end else begin
details := tservices.getElementDetails(ttItemSelectedNotFocus);
end;
brush := render.brush;
brush.style := bsSolid;
brush.color := clWindow;
font := render.font;
font.color := clWindowText;
left := rect.left;
top := rect.top;
width := rect.width;
height := rect.height;
render.clipRect := rect;
{ фон }
render.fillRect(rect);
if selected then begin
tservices.drawElement(render.handle, details, rect, @rect);
end;
brush.style := bsClear;
{ элемент }
drawLeft := 1;
{ значок }
icon := getTypeIcon(typeRef);
if icon <> nil then begin
render.draw(left + drawLeft, top + (height - icon.height) div 2, icon);
inc(drawLeft, icon.width + 8);
end;
{ название }
drawText := typeRef.simpleName;
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText) + 2);
if fldTypesListWidth < drawLeft then begin
fldTypesListWidth := drawLeft;
end;
if list.scrollWidth < fldTypesListWidth then begin
list.scrollWidth := fldTypesListWidth;
end;
end;
procedure TMainForm.listMembersDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
var
selected: boolean;
isFullNames: boolean;
i: int;
lim: int;
left: int;
top: int;
width: int;
height: int;
drawLeft: int;
color0: long;
color1: long;
color2: long;
drawText: AnsiString;
tservices: TThemeServices;
details: TThemedElementDetails;
render: TCanvas;
reference: TObject;
typeRef: AVTTypeStructured;
superRef: AVTTypeStructured;
memberRef: AVTMember;
icon: TFPImageBitmap;
brush: TBrush;
font: TFont;
list: TListBox;
begin
list := control as TListBox;
reference := list.items.objects[index];
if reference = nil then exit;
isFullNames := listMembersMenuFullNames.checked;
render := list.canvas;
tservices := themes.themeServices();
selected := odSelected in state;
if not selected then begin
details := tservices.getElementDetails(ttItemNormal);
end else
if control.focused() then begin
details := tservices.getElementDetails(ttItemSelected);
end else begin
details := tservices.getElementDetails(ttItemSelectedNotFocus);
end;
brush := render.brush;
brush.style := bsSolid;
brush.color := clWindow;
font := render.font;
font.color := clWindowText;
left := rect.left;
top := rect.top;
width := rect.width;
height := rect.height;
render.clipRect := rect;
{ фон }
render.fillRect(rect);
if selected then begin
tservices.drawElement(render.handle, details, rect, @rect);
end;
brush.style := bsClear;
{ элемент }
if reference is AVTTypeStructured then begin
drawLeft := 1;
typeRef := reference as AVTTypeStructured;
{ значок }
icon := getTypeIcon(typeRef);
if icon <> nil then begin
render.draw(left + drawLeft, top + (height - icon.height) div 2, icon);
inc(drawLeft, icon.width + 8);
end;
{ название }
drawText := typeRef.simpleName;
font.style := [fsBold];
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
font.style := [];
{ супертипы }
superRef := typeRef.extends();
if superRef <> nil then begin
drawText := '(';
if isFullNames then begin
drawText := drawText + superRef.fullName;
end else begin
drawText := drawText + superRef.simpleName;
end;
with typeRef.implements() do while hasMoreElements() do begin
superRef := nextElement().objectValue() as AVTTypeStructured;
if isFullNames then begin
drawText := drawText + ', ' + superRef.fullName;
end else begin
drawText := drawText + ', ' + superRef.simpleName;
end;
end;
drawText := drawText + ')';
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
end;
end else begin
drawLeft := 16;
memberRef := reference as AVTMember;
{ значок }
icon := getMemberIcon(memberRef);
if icon <> nil then begin
render.draw(left + drawLeft, top + (height - icon.height) div 2, icon);
inc(drawLeft, icon.width + 8);
end;
{ название }
if not(memberRef is AVTSpecial) then begin
if memberRef is AVTOperator then begin
drawText := 'operator ' + AVTOperator.operatorToChar(AVTOperator(memberRef).operatorKind);
end else begin
drawText := memberRef.simpleName;
end;
font.style := [fsBold];
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
font.style := [];
end;
drawText := '';
{ аргументы, возвращаемые значения и прочее }
if memberRef is AVTClassInit then begin
drawText := '{ … }';
end else
if memberRef is AVTMethod then begin
drawText := '(';
lim := AVTMethod(memberRef).getArgumentsCount() - 1;
for i := 0 to lim do with AVTMethod(memberRef).getArgumentAt(i) do begin
if isFullNames then begin
drawText := drawText + valueType.fullName;
end else begin
drawText := drawText + valueType.simpleName;
end;
if i < lim then begin
drawText := drawText + ' ' + simpleName + ', ';
end else begin
drawText := drawText + ' ' + simpleName;
end;
end;
drawText := drawText + ')';
if not(memberRef is AVTSpecial) then begin
if isFullNames then begin
drawText := drawText + ' : ' + AVTMethod(memberRef).returnType.fullName;
end else begin
drawText := drawText + ' : ' + AVTMethod(memberRef).returnType.simpleName;
end;
end;
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
drawText := '';
with AVTMethod(memberRef).throws() do if hasMoreElements() then begin
drawText := ' throws ';
font.style := [fsItalic];
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
font.style := [];
drawText := '';
repeat
with nextElement().objectValue() as AVTTypeStructured do begin
if isFullNames then begin
drawText := drawText + fullName;
end else begin
drawText := drawText + simpleName;
end;
end;
if not hasMoreElements() then break;
drawText := drawText + ', ';
until false;
end;
end else
if memberRef is AVTProperty then begin
if isFullNames then begin
drawText := ' : ' + AVTProperty(memberRef).valueType.fullName;
end else begin
drawText := ' : ' + AVTProperty(memberRef).valueType.simpleName;
end;
drawText := drawText + readWriteToHTML(AVTProperty(memberRef));
end else
if memberRef is AVTField then begin
if isFullNames then begin
drawText := ' : ' + AVTField(memberRef).valueType.fullName;
end else begin
drawText := ' : ' + AVTField(memberRef).valueType.simpleName;
end;
end;
if length(drawText) > 0 then begin
tservices.drawText(render, details, drawText, bounds(left + drawLeft, top, width - drawLeft, height), DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0);
inc(drawLeft, render.textWidth(drawText));
end;
{ родительский тип }
typeRef := memberRef.parentType;
if typeRef <> list.items.objects[0] then begin
color0 := colorToRGB(clWindowText);
color1 := (color0 and $00ff0000 shl 16) + (color0 and $0000ff00 shl 8) + (color0 and $000000ff);
color0 := colorToRGB(clWindow);
color2 := (color0 and $00ff0000 shl 16) + (color0 and $0000ff00 shl 8) + (color0 and $000000ff);
color0 := ($09 * color1 + $07 * color2) shr 4;
if isFullNames then begin
drawText := ' — ' + typeRef.fullName;
end else begin
drawText := ' — ' + typeRef.simpleName;
end;
font.color := (int(color0 shr 16) and $00ff0000) + (int(color0 shr 8) and $0000ff00) + (int(color0) and $000000ff);
render.textOut(left + drawLeft, top + (height - render.textHeight(' ')) div 2, drawText);
inc(drawLeft, render.textWidth(drawText));
end;
end;
inc(drawLeft, 2);
if fldMembersListWidth < drawLeft then begin
fldMembersListWidth := drawLeft;
end;
if list.scrollWidth < fldMembersListWidth then begin
list.scrollWidth := fldMembersListWidth;
end;
end;
procedure TMainForm.listMembersVisibleFromDrawItem(control: TWinControl; index: int; rect: TRect; state: TOwnerDrawState);
var
left: int;
top: int;
height: int;
drawLeft: int;
drawTop: int;
backgroundColor: int;
foregroundColor: int;
color0: long;
color1: long;
color2: long;
drawText: AnsiString;
render: TCanvas;
typeRef: AVTTypeStructured;
brush: TBrush;
font: TFont;
list: TComboBox;
begin
list := control as TComboBox;
typeRef := list.items.objects[index] as AVTTypeStructured;
if typeRef = nil then exit;
render := list.canvas;
if odSelected in state then begin
backgroundColor := clHighlight;
foregroundColor := clHighlightText;
end else begin
backgroundColor := clWindow;
foregroundColor := clWindowText;
end;
brush := render.brush;
brush.style := bsSolid;
brush.color := backgroundColor;
font := render.font;
font.color := foregroundColor;
left := rect.left;
top := rect.top;
height := rect.height;
render.clipRect := rect;
{ фон }
render.fillRect(rect);
brush.style := bsClear;
{ название }
drawLeft := left + 2;
drawTop := top + (height - render.textHeight(' ')) div 2;
drawText := typeRef.simpleName;
render.textOut(drawLeft, drawTop, drawText);
inc(drawLeft, render.textWidth(drawText));
color0 := colorToRGB(foregroundColor);
color1 := (color0 and $00ff0000 shl 16) + (color0 and $0000ff00 shl 8) + (color0 and $000000ff);
color0 := colorToRGB(backgroundColor);
color2 := (color0 and $00ff0000 shl 16) + (color0 and $0000ff00 shl 8) + (color0 and $000000ff);
color0 := ($09 * color1 + $07 * color2) shr 4;
font.color := (int(color0 shr 16) and $00ff0000) + (int(color0 shr 8) and $0000ff00) + (int(color0) and $000000ff);
drawText := ' — ' + typeRef.package.fullName;
render.textOut(drawLeft, drawTop, drawText);
end;
procedure TMainForm.loadWindowState();
var
len: int;
index: int;
equalPos: int;
key: AnsiString;
val: AnsiString;
current: AnsiString;
bytes: byte_Array1d;
strings: AnsiString_Array1d;
sectionName: Value;
sectionValue: Value;
section: Hashtable;
parameters: Hashtable;
selectedMenuItem: TMenuItem;
selectedControl: TWinControl;
selectedSplitter: TSplitter;
begin
try
try
with LocalFileSystem.getInstance().openFileForReading(fldSettingsFile) as Input do begin
try
bytes := byte_Array1d_create(int(longMin(available(), INT_MAX_VALUE)));
read(bytes);
finally
close();
end;
end;
strings := stringSplit(AnsiString_create(bytes, 0, system.length(bytes)));
parameters := Hashtable.create();
try
sectionName := ValueOfAnsiString.create('');
sectionValue := ValueOfObject.create(Hashtable.create());
parameters.put(sectionName, sectionValue);
for index := 0 to system.length(strings) - 1 do begin
current := stringTrim(strings[index]);
len := system.length(current);
if (len <= 0) or stringStartsWith(';', current) or stringStartsWith('#', current) then continue;
if stringStartsWith('[', current) and stringEndsWith(']', current) then begin
current := stringTrim(stringCopy(current, 2, len));
sectionName := ValueOfAnsiString.create(current);
sectionValue := parameters.get(sectionName);
if sectionValue = nil then begin
sectionValue := ValueOfObject.create(Hashtable.create());
parameters.put(sectionName, sectionValue);
end;
continue;
end;
equalPos := stringIndexOf('=', current);
if equalPos > 0 then begin
key := stringTrim(stringCopy(current, 1, equalPos));
val := stringTrim(stringCopy(current, equalPos + 1));
(sectionValue.objectValue() as Hashtable).put(ValueOfAnsiString.create(key), ValueOfAnsiString.create(val));
end;
end;
sectionValue := parameters.get(ValueOfAnsiString.create('browser'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
position := poDesigned;
setBounds(
parseIniInteger(section.get(ValueOfAnsiString.create('left')), left),
parseIniInteger(section.get(ValueOfAnsiString.create('top')), top),
parseIniInteger(section.get(ValueOfAnsiString.create('width')), width),
parseIniInteger(section.get(ValueOfAnsiString.create('height')), height)
);
if parseIniBoolean(section.get(ValueOfAnsiString.create('maximized')), false) then begin
windowState := wsMaximized;
end;
flagAutoRefresh.checked := parseIniBoolean(section.get(ValueOfAnsiString.create('autoupdate')), true);
end;
sectionValue := parameters.get(ValueOfAnsiString.create('packages'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
if parseIniBoolean(section.get(ValueOfAnsiString.create('hierarchy')), false) then begin
selectedMenuItem := treePackagesMenuHierarchy;
end else begin
selectedMenuItem := treePackagesMenuFlat;
end;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
if parseIniBoolean(section.get(ValueOfAnsiString.create('horizontal')), false) then begin
selectedMenuItem := treePackagesMenuHorizontal;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
end;
if parseIniBoolean(section.get(ValueOfAnsiString.create('pages')), false) then begin
selectedMenuItem := treePackagesMenuOnPages;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
index := parseIniInteger(section.get(ValueOfAnsiString.create('page')), 0);
with (panelPackages.parent as TTabSheet).pageControl do if (index >= 0) and (index < pageCount) then begin
activePageIndex := index;
end;
end;
selectedMenuItem := treePackagesMenuSeparate;
if selectedMenuItem.enabled and parseIniBoolean(section.get(ValueOfAnsiString.create('separated')), false) then begin
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
with panelPackages.parent as TForm do begin
position := poDesigned;
setBounds(
parseIniInteger(section.get(ValueOfAnsiString.create('left')), left),
parseIniInteger(section.get(ValueOfAnsiString.create('top')), top),
parseIniInteger(section.get(ValueOfAnsiString.create('width')), width),
parseIniInteger(section.get(ValueOfAnsiString.create('height')), height)
);
end;
end;
end;
sectionValue := parameters.get(ValueOfAnsiString.create('types'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
if parseIniBoolean(section.get(ValueOfAnsiString.create('hierarchy')), false) then begin
selectedMenuItem := treeTypesMenuHierarchy;
end else begin
selectedMenuItem := treeTypesMenuFlat;
end;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
selectedMenuItem := treeTypesMenuSeparate;
if selectedMenuItem.enabled and parseIniBoolean(section.get(ValueOfAnsiString.create('separated')), false) then begin
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
with panelTypes.parent as TForm do begin
position := poDesigned;
setBounds(
parseIniInteger(section.get(ValueOfAnsiString.create('left')), left),
parseIniInteger(section.get(ValueOfAnsiString.create('top')), top),
parseIniInteger(section.get(ValueOfAnsiString.create('width')), width),
parseIniInteger(section.get(ValueOfAnsiString.create('height')), height)
);
end;
end;
end;
sectionValue := parameters.get(ValueOfAnsiString.create('members'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
index := parseIniInteger(section.get(ValueOfAnsiString.create('visibility')), AVT_PRIVATE);
case index of
INT_MIN_VALUE..(-1): selectedMenuItem := listMembersMenuViewSynthetic;
AVT_PRIVATE: selectedMenuItem := listMembersMenuViewPrivate;
AVT_SOURCE: selectedMenuItem := listMembersMenuViewDefault;
AVT_PACKAGE: selectedMenuItem := listMembersMenuViewPackage;
AVT_PROTECTED: selectedMenuItem := listMembersMenuViewProtected;
else selectedMenuItem := listMembersMenuViewPublic;
end;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
if parseIniBoolean(section.get(ValueOfAnsiString.create('inherited')), false) then begin
selectedMenuItem := listMembersMenuInherited;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
end;
if parseIniBoolean(section.get(ValueOfAnsiString.create('canonical')), false) then begin
selectedMenuItem := listMembersMenuFullNames;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
end;
if parseIniBoolean(section.get(ValueOfAnsiString.create('visiblefrom')), false) then begin
selectedMenuItem := listMembersMenuViewVisibleFrom;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
end;
listMembersVisibleFrom.text := parseIniString(section.get(ValueOfAnsiString.create('visiblefromclass')), '');
end;
sectionValue := parameters.get(ValueOfAnsiString.create('documentation'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
if parseIniBoolean(section.get(ValueOfAnsiString.create('horizontal')), false) then begin
selectedMenuItem := viewDocumentationMenuHorizontal;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
end;
if parseIniBoolean(section.get(ValueOfAnsiString.create('pages')), false) then begin
selectedMenuItem := viewDocumentationMenuOnPages;
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
index := parseIniInteger(section.get(ValueOfAnsiString.create('page')), 0);
with (panelDocumentation.parent as TTabSheet).pageControl do if (index >= 0) and (index < pageCount) then begin
activePageIndex := index;
end;
end;
selectedMenuItem := viewDocumentationMenuSeparate;
if selectedMenuItem.enabled and parseIniBoolean(section.get(ValueOfAnsiString.create('separated')), false) then begin
selectedMenuItem.checked := true;
buttonClick(selectedMenuItem);
with panelDocumentation.parent as TForm do begin
position := poDesigned;
setBounds(
parseIniInteger(section.get(ValueOfAnsiString.create('left')), left),
parseIniInteger(section.get(ValueOfAnsiString.create('top')), top),
parseIniInteger(section.get(ValueOfAnsiString.create('width')), width),
parseIniInteger(section.get(ValueOfAnsiString.create('height')), height)
);
end;
end;
end;
sectionValue := parameters.get(ValueOfAnsiString.create('splitters'));
if section <> nil then begin
section := sectionValue.objectValue() as Hashtable;
loadSize(section, 'main', panelMembersOfProgramme, splitMain);
loadSize(section, 'type', panelDocumentation, splitMembersOfType);
loadSize(section, 'programme', panelPackages, splitMembersOfProgramme);
end;
finally
parameters.free();
end;
except
on e: IOException do begin end;
end;
finally
fldWindowStateLoaded := true;
end;
end;
procedure TMainForm.saveWindowState();
var
settings: AnsiString;
treePackagesParent: TWinControl;
treeTypesParent: TWinControl;
viewDocumentationParent: TWinControl;
begin
treePackagesParent := panelPackages.parent;
treeTypesParent := panelTypes.parent;
viewDocumentationParent := panelDocumentation.parent;
settings :=
LINE_ENDING + '[browser]' +
LINE_ENDING + 'left = ' + intToString(restoredLeft) +
LINE_ENDING + 'top = ' + intToString(restoredTop) +
LINE_ENDING + 'width = ' + intToString(restoredWidth) +
LINE_ENDING + 'height = ' + intToString(restoredHeight) +
LINE_ENDING + 'maximized = ' + booleanToIniString(windowState = wsMaximized) +
LINE_ENDING + 'autoupdate = ' + booleanToIniString(flagAutoRefresh.checked) +
LINE_ENDING +
LINE_ENDING + '[packages]' +
LINE_ENDING + 'hierarchy = ' + booleanToIniString(treePackagesMenuHierarchy.checked) +
LINE_ENDING + 'horizontal = ' + booleanToIniString(treePackagesMenuHorizontal.checked) +
LINE_ENDING + 'pages = ' + booleanToIniString(treePackagesMenuOnPages.checked) +
LINE_ENDING + 'page = ' + activePageIndexToIniString(treePackagesParent) +
LINE_ENDING + 'separated = ' + booleanToIniString(treePackagesMenuSeparate.checked) +
LINE_ENDING + windowPositionToIniString(treePackagesParent) +
LINE_ENDING +
LINE_ENDING + '[types]' +
LINE_ENDING + 'hierarchy = ' + booleanToIniString(treeTypesMenuHierarchy.checked) +
LINE_ENDING + 'separated = ' + booleanToIniString(treeTypesMenuSeparate.checked) +
LINE_ENDING + windowPositionToIniString(treeTypesParent) +
LINE_ENDING +
LINE_ENDING + '[members]' +
LINE_ENDING + 'visibility = ' + intToString(fldMinVisibility) +
LINE_ENDING + 'inherited = ' + booleanToIniString(listMembersMenuInherited.checked) +
LINE_ENDING + 'canonical = ' + booleanToIniString(listMembersMenuFullNames.checked) +
LINE_ENDING + 'visiblefrom = ' + booleanToIniString(listMembersMenuViewVisibleFrom.checked) +
LINE_ENDING + 'visiblefromclass = ' + listMembersVisibleFrom.text +
LINE_ENDING +
LINE_ENDING + '[documentation]' +
LINE_ENDING + 'horizontal = ' + booleanToIniString(viewDocumentationMenuHorizontal.checked) +
LINE_ENDING + 'pages = ' + booleanToIniString(viewDocumentationMenuOnPages.checked) +
LINE_ENDING + 'page = ' + activePageIndexToIniString(viewDocumentationParent) +
LINE_ENDING + 'separated = ' + booleanToIniString(viewDocumentationMenuSeparate.checked) +
LINE_ENDING + windowPositionToIniString(viewDocumentationParent) +
LINE_ENDING +
LINE_ENDING + '[splitters]' +
LINE_ENDING + 'main = ' + splitterControlSizeToIniString(splitMain.align, panelMembersOfProgramme) +
LINE_ENDING + 'type = ' + splitterControlSizeToIniString(splitMembersOfType.align, panelDocumentation) +
LINE_ENDING + 'programme = ' + splitterControlSizeToIniString(splitMembersOfProgramme.align, panelPackages) +
LINE_ENDING
;
try
with LocalFileSystem.getInstance().createFile(fldSettingsFile) as Output do begin
try
write(stringToByteArray(settings));
finally
close();
end;
end;
except
on e: IOException do begin end;
end;
end;
procedure TMainForm.updateTabOrders();
begin
updateTabOrders(panelPackages, panelTypes);
updateTabOrders(panelMembers, panelDocumentation);
end;
procedure TMainForm.updateSplitters();
begin
updateSplitters(panelMembersOfProgramme, panelMembersOfType, splitMain);
updateSplitters(panelMembers, panelDocumentation, splitMembersOfType);
updateSplitters(panelPackages, panelTypes, splitMembersOfProgramme);
end;
procedure TMainForm.fillTreeOfPackages();
var
selectedAllPackages: boolean;
minVisibility: int;
selectedSourceName: UnicodeString;
selectedPackageName: AnsiString;
treeRef: TTreeView;
treeItems: TTreeNodes;
programmeRef: AVTProgramme;
foundPackageRef: AVTPackage;
foundSourceRef: AVTSource;
begin
minVisibility := fldMinVisibility;
programmeRef := fldCurrentProgramme;
fldAutomaticUpdate := true;
treeRef := treePackages;
treeRef.beginUpdate();
try
treeItems := treeRef.items;
treeItems.clear();
getObjectTreeNode(treeItems, nil);
with programmeRef.packages() do while hasMoreElements() do begin
foundPackageRef := nextElement().objectValue() as AVTPackage;
if (foundPackageRef.visibility >= minVisibility) and foundPackageRef.types().hasMoreElements() then begin
getObjectTreeNode(treeItems, foundPackageRef);
with foundPackageRef.sources() do while hasMoreElements() do begin
foundSourceRef := nextElement().objectValue() as AVTSource;
getObjectTreeNode(treeItems, foundSourceRef);
end;
end;
end;
treeRef.customSort(objectTreeNodeCompare);
selectedAllPackages := fldSelectedAllPackages;
if selectedAllPackages then begin
treeRef.selected := treeItems.findNodeWithData(nil);
exit;
end;
selectedSourceName := fldSelectedSourceName;
if system.length(selectedSourceName) > 0 then begin
foundSourceRef := programmeRef.getSource(selectedSourceName);
if foundSourceRef <> nil then treeRef.selected := treeItems.findNodeWithData(foundSourceRef);
exit;
end;
selectedPackageName := fldSelectedPackageName;
if system.length(selectedPackageName) > 0 then begin
foundPackageRef := programmeRef.getPackage(selectedPackageName);
if foundPackageRef <> nil then treeRef.selected := treeItems.findNodeWithData(foundPackageRef);
exit;
end;
finally
treeRef.endUpdate();
fldAutomaticUpdate := false;
end;
end;
procedure TMainForm.fillTreeOfTypes();
var
minVisibility: int;
selectedTypeName: AnsiString;
selectedSourceName: UnicodeString;
treeRef: TTreeView;
treeItems: TTreeNodes;
programmeRef: AVTProgramme;
packageRef: AVTPackage;
sourceRef: AVTSource;
foundTypeRef: AVTType;
begin
minVisibility := fldMinVisibility;
programmeRef := fldCurrentProgramme;
if fldSelectedAllPackages then begin
packageRef := nil;
sourceRef := nil;
end else begin
selectedSourceName := fldSelectedSourceName;
if system.length(selectedSourceName) > 0 then begin
packageRef := nil;
sourceRef := programmeRef.getSource(selectedSourceName);
end else begin
packageRef := programmeRef.getPackage(fldSelectedPackageName);
sourceRef := nil;
end;
end;
fldAutomaticUpdate := true;
treeRef := treeTypes;
treeRef.beginUpdate();
try
treeItems := treeRef.items;
treeItems.clear();
if sourceRef <> nil then begin
with sourceRef.declaredTypes() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
getTypeTreeNode(treeItems, AVTTypeStructured(foundTypeRef));
end;
end;
end else
if packageRef <> nil then begin
with packageRef.types() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
getTypeTreeNode(treeItems, AVTTypeStructured(foundTypeRef));
end;
end;
end else begin
with programmeRef.packages() do while hasMoreElements() do with (nextElement().objectValue() as AVTPackage).types() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
getTypeTreeNode(treeItems, AVTTypeStructured(foundTypeRef));
end;
end;
end;
treeRef.customSort(treeRef.defaultTreeViewSort);
treeRef.fullExpand();
selectedTypeName := fldSelectedTypeName;
if system.length(selectedTypeName) > 0 then begin
foundTypeRef := programmeRef.getType(selectedTypeName);
if foundTypeRef <> nil then treeRef.selected := treeItems.findNodeWithData(foundTypeRef);
exit;
end;
finally
treeRef.endUpdate();
fldAutomaticUpdate := false;
end;
end;
procedure TMainForm.fillListOfTypes();
var
index: int;
itemCount: int;
listCount: int;
minVisibility: int;
selectedTypeName: AnsiString;
selectedSourceName: UnicodeString;
listRef: TListBox;
listItems: TStrings;
programmeRef: AVTProgramme;
packageRef: AVTPackage;
sourceRef: AVTSource;
foundTypeRef: AVTType;
begin
minVisibility := fldMinVisibility;
programmeRef := fldCurrentProgramme;
if fldSelectedAllPackages then begin
packageRef := nil;
sourceRef := nil;
end else begin
selectedSourceName := fldSelectedSourceName;
if system.length(selectedSourceName) > 0 then begin
packageRef := nil;
sourceRef := programmeRef.getSource(selectedSourceName);
end else begin
packageRef := programmeRef.getPackage(fldSelectedPackageName);
sourceRef := nil;
end;
end;
fldAutomaticUpdate := true;
listRef := listTypes;
listItems := listRef.items;
listItems.beginUpdate();
try
fldTypesListWidth := 0;
listRef.scrollWidth := 0;
listRef.sorted := false;
itemCount := 0;
listCount := listItems.count;
if sourceRef <> nil then begin
with sourceRef.declaredTypes() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
if itemCount >= listCount then begin
listItems.addObject(foundTypeRef.simpleName, foundTypeRef);
end else begin
listItems.strings[itemCount] := foundTypeRef.simpleName;
listItems.objects[itemCount] := foundTypeRef;
end;
inc(itemCount);
end;
end;
end else
if packageRef <> nil then begin
with packageRef.types() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
if itemCount >= listCount then begin
listItems.addObject(foundTypeRef.simpleName, foundTypeRef);
end else begin
listItems.strings[itemCount] := foundTypeRef.simpleName;
listItems.objects[itemCount] := foundTypeRef;
end;
inc(itemCount);
end;
end;
end else begin
with programmeRef.packages() do while hasMoreElements() do with (nextElement().objectValue() as AVTPackage).types() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if (foundTypeRef.visibility >= minVisibility) and (foundTypeRef is AVTTypeStructured) and (not(foundTypeRef is AVTTypeArray) or not(AVTTypeStructured(foundTypeRef).extends() is AVTTypeArray)) then begin
if itemCount >= listCount then begin
listItems.addObject(foundTypeRef.simpleName, foundTypeRef);
end else begin
listItems.strings[itemCount] := foundTypeRef.simpleName;
listItems.objects[itemCount] := foundTypeRef;
end;
inc(itemCount);
end;
end;
end;
if itemCount < listCount then for index := listCount - 1 downto itemCount do begin
listItems.delete(index);
end;
listRef.sorted := true;
selectedTypeName := fldSelectedTypeName;
if system.length(selectedTypeName) > 0 then begin
foundTypeRef := programmeRef.getType(selectedTypeName);
if foundTypeRef <> nil then listRef.itemIndex := listItems.indexOfObject(foundTypeRef);
exit;
end;
finally
listItems.endUpdate();
fldAutomaticUpdate := false;
end;
end;
procedure TMainForm.fillListOfMembers();
var
index: int;
itemCount: int;
listCount: int;
minVisibility: int;
selectedMemberSimpleName: AnsiString;
selectedMemberArgsName: AnsiString_Array1d;
listRef: TListBox;
listItems: TStrings;
itemRef: AVTType;
visibleFromRef: AVTTypeStructured;
typeRef: AVTTypeStructured;
foundMemberRef: AVTMember;
begin
minVisibility := fldMinVisibility;
itemRef := fldCurrentProgramme.getType(fldSelectedTypeName);
if itemRef is AVTTypeStructured then begin
typeRef := AVTTypeStructured(itemRef);
end else begin
typeRef := nil;
end;
with listMembersVisibleFrom do begin
index := itemIndex;
if index >= 0 then begin
visibleFromRef := items.objects[index] as AVTTypeStructured;
end else begin
visibleFromRef := typeRef;
end;
end;
fldAutomaticUpdate := true;
try
listRef := listMembers;
listItems := listRef.items;
listItems.beginUpdate();
try
fldMembersListWidth := 0;
listRef.scrollWidth := 0;
itemCount := 0;
listCount := listItems.count;
if typeRef <> nil then begin
if itemCount >= listCount then begin
listItems.addObject('', typeRef);
end else begin
listItems.objects[itemCount] := typeRef;
end;
inc(itemCount);
with typeRef.members() do while hasMoreElements() do begin
foundMemberRef := nextElement().objectValue() as AVTMember;
if (system.length(foundMemberRef.simpleName) > 0) and ((minVisibility < 0) or (foundMemberRef.visibility >= minVisibility) and not foundMemberRef.isSynthetic()) and
foundMemberRef.isVisible(typeRef, visibleFromRef)
then begin
if itemCount >= listCount then begin
listItems.addObject('', foundMemberRef);
end else begin
listItems.objects[itemCount] := foundMemberRef;
end;
inc(itemCount);
end;
end;
if listMembersMenuInherited.checked then begin
with typeRef.extendsAll() do while hasMoreElements() do with (nextElement().objectValue() as AVTTypeStructured).members() do while hasMoreElements() do begin
foundMemberRef := nextElement().objectValue() as AVTMember;
if (system.length(foundMemberRef.simpleName) > 0) and ((minVisibility < 0) or (foundMemberRef.visibility >= minVisibility) and not foundMemberRef.isSynthetic()) and
foundMemberRef.isVisible(typeRef, visibleFromRef) and not hasMemberInList(typeRef, foundMemberRef, listItems, itemCount)
then begin
if itemCount >= listCount then begin
listItems.addObject('', foundMemberRef);
end else begin
listItems.objects[itemCount] := foundMemberRef;
end;
inc(itemCount);
end;
end;
with typeRef.implements() do while hasMoreElements() do with (nextElement().objectValue() as AVTTypeStructured).members() do while hasMoreElements() do begin
foundMemberRef := nextElement().objectValue() as AVTMember;
if (system.length(foundMemberRef.simpleName) > 0) and ((minVisibility < 0) or (foundMemberRef.visibility >= minVisibility) and not foundMemberRef.isSynthetic()) and
foundMemberRef.isVisible(typeRef, visibleFromRef) and not hasMemberInList(typeRef, foundMemberRef, listItems, itemCount)
then begin
if itemCount >= listCount then begin
listItems.addObject('', foundMemberRef);
end else begin
listItems.objects[itemCount] := foundMemberRef;
end;
inc(itemCount);
end;
end;
end;
end;
if itemCount < listCount then for index := listCount - 1 downto itemCount do begin
listItems.delete(index);
end;
if typeRef <> nil then begin
selectedMemberSimpleName := fldSelectedMemberSimpleName;
if system.length(selectedMemberSimpleName) <= 0 then begin
listRef.itemIndex := 0;
end else begin
selectedMemberArgsName := fldSelectedMemberArgsName;
with typeRef.members(selectedMemberSimpleName) do while hasMoreElements() do begin
foundMemberRef := nextElement().objectValue() as AVTMember;
if not(foundMemberRef is AVTMethod) or isMethodArguments(AVTMethod(foundMemberRef), selectedMemberArgsName) then begin
listRef.itemIndex := listItems.indexOfObject(foundMemberRef);
break;
end;
end;
end;
end;
finally
listItems.endUpdate();
end;
finally
fldAutomaticUpdate := false;
end;
end;
procedure TMainForm.fillListOfTypesVisibility();
var
listText: AnsiString;
listRef: TComboBox;
listItems: TStrings;
foundTypeRef: AVTType;
begin
listRef := listMembersVisibleFrom;
listItems := listRef.items;
listText := listRef.text;
try
listItems.beginUpdate();
try
listItems.clear();
with fldCurrentProgramme.packages() do while hasMoreElements() do with (nextElement().objectValue() as AVTPackage).types() do while hasMoreElements() do begin
foundTypeRef := nextElement().objectValue() as AVTType;
if foundTypeRef.classType() = AVTTypeStructured then begin
listItems.addObject(foundTypeRef.simpleName + ' — ' + foundTypeRef.package.fullName, foundTypeRef);
end;
end;
finally
listItems.endUpdate();
end;
finally
listRef.itemIndex := listItems.indexOf(listText);
end;
end;
procedure TMainForm.fillMemberDocumentation();
var
selectedMemberSimpleName: AnsiString;
selectedMemberArgsName: AnsiString_Array1d;
programmeRef: AVTProgramme;
itemRef: AVTType;
typeRef: AVTTypeStructured;
memberRef: AVTMember;
begin
programmeRef := fldCurrentProgramme;
itemRef := programmeRef.getType(fldSelectedTypeName);
if not(itemRef is AVTTypeStructured) then begin
fillMemberDocumentation(nil);
exit;
end;
typeRef := AVTTypeStructured(itemRef);
selectedMemberSimpleName := fldSelectedMemberSimpleName;
if system.length(selectedMemberSimpleName) <= 0 then begin
fillMemberDocumentation(typeRef);
exit;
end;
selectedMemberArgsName := fldSelectedMemberArgsName;
with typeRef.members(selectedMemberSimpleName) do while hasMoreElements() do begin
memberRef := nextElement().objectValue() as AVTMember;
if (memberRef is AVTMethod) and not isMethodArguments(AVTMethod(memberRef), selectedMemberArgsName) then continue;
fillMemberDocumentation(memberRef);
exit;
end;
with typeRef.extendsAll() do while hasMoreElements() do with (nextElement().objectValue() as AVTTypeStructured).members(selectedMemberSimpleName) do while hasMoreElements() do begin
memberRef := nextElement().objectValue() as AVTMember;
if (memberRef is AVTMethod) and not isMethodArguments(AVTMethod(memberRef), selectedMemberArgsName) then continue;
fillMemberDocumentation(memberRef);
exit;
end;
with typeRef.implements() do while hasMoreElements() do with (nextElement().objectValue() as AVTTypeStructured).members(selectedMemberSimpleName) do while hasMoreElements() do begin
memberRef := nextElement().objectValue() as AVTMember;
if (memberRef is AVTMethod) and not isMethodArguments(AVTMethod(memberRef), selectedMemberArgsName) then continue;
fillMemberDocumentation(memberRef);
exit;
end;
end;
procedure TMainForm.fillMemberDocumentation(member: AVTItem; refresh: boolean);
var
index: int;
count: int;
mflags: int;
{ поля документа HTML. Начало }
docTitle: AnsiString; { обязательное поле }
docPath: AnsiString;
docHeader: AnsiString;
docDeclaration: AnsiString;
docHierarchy: AnsiString;
docText: AnsiString; { обязательное поле }
{ поля документа HTML. Конец }
text: AnsiString;
immediateName: AnsiString;
immediatePackage: AVTPackage;
enclosingType: AVTTypeStructured;
fileSystem: WriteableVirtualFileSystem;
html: TStrings;
begin
docPath := '';
docHeader := '';
docDeclaration := '';
docHierarchy := '';
{ ПАКЕТЫ }
if member is AVTPackage then with AVTPackage(member) do begin
mflags := flags;
docTitle := fullName;
docPath := simpleName;
immediatePackage := parentPackage;
while immediatePackage <> nil do begin
docPath := '<a href="' + immediatePackage.fullName + '">' + immediatePackage.simpleName + '</a>.' + docPath;
immediatePackage := immediatePackage.parentPackage;
end;
docPath := 'Пакет ' + docPath;
docHeader := 'Пакет ' + docTitle;
docDeclaration := '<strong>' + flagsToString(mflags) + ' package</strong> ' + docTitle;
docText := parseDocumentation(documentation, member);
fldShowedMemberName := docTitle;
viewDocumentationMenuBrowser.enabled := true;
viewDocumentationMenuRefresh.enabled := true;
end else
{ ТИПЫ }
if member is AVTTypeStructured then with AVTTypeStructured(member) do begin
mflags := flags;
docTitle := fullName;
immediatePackage := package;
if immediatePackage <> nil then begin
immediateName := immediatePackage.simpleName;
if system.length(immediateName) > 0 then begin
docPath := '<a href="' + immediatePackage.fullName + '">' + immediateName + '</a>';
repeat
immediatePackage := immediatePackage.parentPackage;
if immediatePackage = nil then break;
docPath := '<a href="' + immediatePackage.fullName + '">' + immediatePackage.simpleName + '</a>.' + docPath;
until false;
docPath := 'Пакет ' + docPath;
end;
end;
text := simpleName;
if isInterface() then begin
docHeader := 'Протокол ' + text;
docDeclaration := '<strong>' + flagsToString(mflags) + ' interface</strong> ' + text;
end else
if isService() then begin
docHeader := 'Сервис ' + text;
docDeclaration := '<strong>' + flagsToString(mflags) + ' service</strong> ' + text;
end else
if isStruct() then begin
docHeader := 'Структура ' + text;
docDeclaration := '<strong>' + flagsToString(mflags) + ' struct</strong> ' + text;
end else begin
docHeader := 'Класс ' + text;
docDeclaration := '<strong>' + flagsToString(mflags) + ' class</strong> ' + text;
end;
docHierarchy := '<strong>Иерархия типов:</strong> <code>' + text + '</code>';
enclosingType := extends();
while enclosingType <> nil do begin
docHierarchy := docHierarchy + ' – <code><a href="' + enclosingType.fullName + '">' + enclosingType.simpleName + '</a></code>';
enclosingType := enclosingType.extends();
end;
with implements() do if hasMoreElements() then begin
enclosingType := nextElement().objectValue() as AVTTypeStructured;
docHierarchy := docHierarchy + '<br /><strong>Все реализуемые сервисы:</strong> <code><a href="' + enclosingType.fullName + '">' + enclosingType.simpleName + '</a></code>';
while hasMoreElements() do begin
enclosingType := nextElement().objectValue() as AVTTypeStructured;
docHierarchy := docHierarchy + ', <code><a href="' + enclosingType.fullName + '">' + enclosingType.simpleName + '</a></code>';
end;
end;
docText := parseDocumentation(documentation, member) + '<hr>' + buildMemberTable(AVTTypeStructured(member));
fldShowedMemberName := docTitle;
viewDocumentationMenuBrowser.enabled := true;
viewDocumentationMenuRefresh.enabled := true;
end else
{ ЭЛЕМЕНТЫ }
if member is AVTMember then with AVTMember(member) do begin
mflags := flags;
enclosingType := parentType;
docTitle := enclosingType.fullName;
immediatePackage := enclosingType.package;
if immediatePackage <> nil then begin
immediateName := immediatePackage.simpleName;
if system.length(immediateName) > 0 then begin
docPath := '<a href="' + immediatePackage.fullName + '">' + immediateName + '</a>';
repeat
immediatePackage := immediatePackage.parentPackage;
if immediatePackage = nil then break;
docPath := '<a href="' + immediatePackage.fullName + '">' + immediatePackage.simpleName + '</a>.' + docPath;
until false;
docPath := 'Пакет ' + docPath + ' ';
end;
end;
docPath := docPath + 'Тип <a href="' + docTitle + '">' + enclosingType.simpleName + '</a>';
if member is AVTField then with AVTField(member) do begin
docHeader := simpleName;
docDeclaration := '<strong>' + flagsToString(mflags) + '</strong> ' + typeToHTML(valueType) + ' ' + docHeader;
fldShowedMemberName := docTitle + '#' + docHeader;
viewDocumentationMenuBrowser.enabled := true;
viewDocumentationMenuRefresh.enabled := true;
end else
if member is AVTProperty then with AVTProperty(member) do begin
docHeader := simpleName;
docDeclaration := '<strong>' + flagsToString(mflags) + '</strong> ' + typeToHTML(valueType) + ' ' + docHeader;
if readSynthetic <> nil then begin
if writeSynthetic <> nil then begin
docDeclaration := docDeclaration + ' { read, write }';
end else begin
docDeclaration := docDeclaration + ' { read }';
end;
end else begin
if writeSynthetic <> nil then begin
docDeclaration := docDeclaration + ' { write }';
end else begin
docDeclaration := docDeclaration + ' { ??? }';
end;
end;
fldShowedMemberName := docTitle + '#' + docHeader;
viewDocumentationMenuBrowser.enabled := true;
viewDocumentationMenuRefresh.enabled := true;
end else
if member is AVTMethod then with AVTMethod(member) do begin
if member is AVTClassInit then begin
docHeader := 'static';
docDeclaration := '<strong>static</strong> { … }';
fldShowedMemberName := '';
viewDocumentationMenuBrowser.enabled := false;
viewDocumentationMenuRefresh.enabled := false;
end else begin
if member is AVTInstInit then begin
docHeader := enclosingType.simpleName;
docDeclaration := '<strong>' + flagsToString(mflags) + '</strong> ';
fldShowedMemberName := docTitle + '#' + argumentsToLink(AVTMethod(member));
end else begin
if member is AVTOperator then with AVTOperator(member) do begin
docHeader := 'operator ' + operatorToChar(operatorKind);
end else begin
docHeader := simpleName;
end;
docDeclaration := '<strong>' + flagsToString(mflags) + '</strong> ' + typeToHTML(returnType) + ' ' + docHeader;
fldShowedMemberName := docTitle + '#' + docHeader + argumentsToLink(AVTMethod(member));
end;
count := getArgumentsCount();
if count <= 0 then begin
docDeclaration := docDeclaration + '()';
end else begin
with getArgumentAt(0) do begin
docDeclaration := docDeclaration + '(<br /> ' + typeToHTML(valueType) + ' ' + simpleName;
end;
for index := 1 to count - 1 do with getArgumentAt(index) do begin
docDeclaration := docDeclaration + ',<br /> ' + typeToHTML(valueType) + ' ' + simpleName;
end;
docDeclaration := docDeclaration + ')';
end;
with throws() do if hasMoreElements() then begin
docDeclaration := docDeclaration + ' <strong>throws</strong><br /> ' + typeToHTML(nextElement().objectValue() as AVTTypeStructured);
while hasMoreElements() do begin
docDeclaration := docDeclaration + ',<br /> ' + typeToHTML(nextElement().objectValue() as AVTTypeStructured);
end;
end;
viewDocumentationMenuBrowser.enabled := true;
viewDocumentationMenuRefresh.enabled := true;
end;
end else begin
fldShowedMemberName := '';
viewDocumentationMenuBrowser.enabled := false;
viewDocumentationMenuRefresh.enabled := false;
end;
docText := parseDocumentation(documentation, enclosingType);
end else
{ ОСТАЛЬНОЕ }
begin
docTitle := fldDocumentation;
docText := '';
end;
{ ГЕНЕРАЦИЯ И ВЫВОД ДОКУМЕНТА HTML }
try
fileSystem := LocalFileSystem.getInstance();
html := TStringList.create();
try
html.add('<!DOCTYPE html>');
html.add('<html>');
html.add(' <head>');
html.add(' <meta http-equiv="content-type" content="text/html; charset=UTF-8"></meta>');
html.add(' <title>' + docTitle + '</title>');
html.add(' <style type="text/css">');
loadStrings(html, 3, fileSystem, fldCssStyleFile);
html.add(' </style>');
html.add(' </head>');
html.add(' <body>');
if system.length(docPath) > 0 then begin
html.add(' <p class="path">' + docPath + '</p>');
end;
if system.length(docHeader) > 0 then begin
html.add(' <h1>' + docHeader + '</h1>');
end;
if system.length(docDeclaration) > 0 then begin
html.add(' <p class="declaration">' + docDeclaration + '</p>');
end;
if system.length(docHierarchy) > 0 then begin
html.add(' <p class="hierarchy">' + docHierarchy + '</p>');
end;
if system.length(docText) > 0 then begin
loadStrings(html, 2, docText);
end;
html.add(' </body>');
html.add('</html>');
text := html.text;
showDocumentationHTML(text);
if refresh then saveText(text, fileSystem, fldHtmlDocFile);
finally
html.free();
end;
except
on e: TObject do begin
labelErrorMessage.caption :=
e.toString()
;
end;
end;
end;
procedure TMainForm.fillMemberDocumentation(const memberFullName: AnsiString; refresh: boolean);
var
member: AVTItem;
nameSource: AVTSource;
begin
nameSource := AVTSource.create();
try
nameSource.realize(UnicodeString_Array1d_create([
stringToUTF16(memberFullName)
]));
with DOCLexer.create() do begin
try
split(nameSource, true);
finally
free();
end;
end;
member := parseLinkToMember(nameSource, 0, nil).getItem();
finally
nameSource.free();
end;
fillMemberDocumentation(member, refresh);
end;
procedure TMainForm.showDocumentationHTML(const htmlText: AnsiString);
var
stream: TStream;
htmlData: TIpHtml;
htmlView: TIpHtmlPanel;
begin
stream := TStringStream.create(htmlText);
try
htmlData := TIpHtml.create();
htmlData.loadFromStream(stream);
finally
stream.free();
end;
htmlView := viewDocumentation;
htmlView.setHtml(htmlData);
labelDocumentation.caption := htmlView.title;
setDefaultKeyDownEventFor(htmlView);
end;
procedure TMainForm.readSourcesFrom(const directory, path: UnicodeString);
var
e: FileEnumeration;
app: AVTProgramme;
nam: UnicodeString;
begin
app := fldCreatedProgramme;
e := LocalFileSystem.getInstance().findFirst(directory + path);
if e <> nil then begin
try
repeat
if e.isDirectory() then begin
readSourcesFrom(directory, path + e.getName() + '/');
continue;
end;
nam := e.getName();
if stringEndsWith(UnicodeString('.avt'), nam) then begin
AVTLibrarySource.create(app, directory, path + nam);
end;
until not e.findNext();
finally
e.close();
end;
end;
end;
procedure TMainForm.realizeSources();
begin
with fldCreatedProgramme.sources() do while hasMoreElements() do begin
(nextElement().objectValue() as AVTLibrarySource).realize();
end;
end;
procedure TMainForm.lexicalAnalyzer();
begin
with AVTLexer.create() do begin
try
with fldCreatedProgramme.sources() do while hasMoreElements() do begin
split(nextElement().objectValue() as AVTSource, true);
end;
finally
free();
end;
end;
end;
procedure TMainForm.buildProgramme();
var
src: AVTSource;
typ: AVTTypeStructured;
app: AVTProgramme;
begin
app := fldCreatedProgramme;
with AVTTableBuilder.create(app) do begin
try
with app.sources() do while hasMoreElements() do begin
src := nextElement().objectValue() as AVTSource;
parsePackage(src);
end;
with app.sources() do while hasMoreElements() do begin
src := nextElement().objectValue() as AVTSource;
parseTypes(src);
end;
with app.sources() do while hasMoreElements() do begin
src := nextElement().objectValue() as AVTSource;
parseImport(src);
parseSuperTypes(src);
end;
app.prefetchTypes();
with app.types() do while hasMoreElements() do begin
typ := nextElement().objectValue() as AVTTypeStructured;
parseMembers(typ);
end;
with app.types() do while hasMoreElements() do begin
typ := nextElement().objectValue() as AVTTypeStructured;
parseFields(typ);
typ.prefetchMembers();
parseProperties(typ);
end;
app.prefetchArrays();
finally
free();
end;
end;
end;
procedure TMainForm.programmeBuilded();
begin
try
labelErrorMessage.caption := fldErrorMessage;
fldCurrentProgramme.free();
fldCurrentProgramme := fldCreatedProgramme;
fillListOfTypesVisibility();
fillTreeOfPackages();
if treeTypes.visible then fillTreeOfTypes();
if listTypes.visible then fillListOfTypes();
fillListOfMembers();
fillMemberDocumentation();
finally
btnRefresh.enabled := true;
end;
end;
procedure TMainForm.setDefaultKeyDownEventFor(control: TWinControl);
var
index: int;
ctrl: TControl;
begin
for index := 0 to control.controlCount - 1 do begin
ctrl := control.controls[index];
if ctrl is TWinControl then with TWinControl(ctrl) do begin
if tabStop then begin
onKeyDown := defaultKeyDown;
end;
setDefaultKeyDownEventFor(TWinControl(ctrl));
end;
end;
end;
function TMainForm.objectTreeNodeCompare(node1, node2: TTreeNode): int;
var
obj1: _Object;
obj2: _Object;
begin
obj1 := TObject(node1.data) as _Object;
obj2 := TObject(node2.data) as _Object;
if obj1 = nil then begin
if obj2 = nil then begin
result := 0;
exit;
end;
result := -1;
exit;
end;
if obj2 = nil then begin
result := 1;
exit;
end;
if (obj1 is AVTPackage) and (obj2 is AVTSource) then begin
result := -1;
exit;
end;
if (obj1 is AVTSource) and (obj2 is AVTPackage) then begin
result := 1;
exit;
end;
result := node1.owner.owner.defaultTreeViewSort(node1, node2);
end;
function TMainForm.flagsToString(flags: int; forceShowPublic, forceShowStatic: boolean): AnsiString;
var
length: int;
text: AnsiString;
begin
case flags and MASK_VISIBILITY of
AVT_PUBLISHED:
text := 'published ';
AVT_PUBLIC:
if not forceShowPublic and (fldMinVisibility >= AVT_PROTECTED) then begin
text := '';
end else begin
text := 'public ';
end;
AVT_PROTECTED:
text := 'protected ';
AVT_PACKAGE:
text := 'package ';
AVT_PRIVATE:
text := 'private ';
else
text := '';
end;
if (flags and FLAG_STATIC) <> 0 then begin
if forceShowStatic then begin
text := text + 'static ';
end;
if (flags and FLAG_INTERRUPT) <> 0 then begin
text := text + 'interrupt ';
end;
end;
case flags and (FLAG_ABSTRACT or FLAG_FINAL) of
FLAG_ABSTRACT: text := text + 'abstract ';
FLAG_FINAL: text := text + 'final ';
end;
length := system.length(text);
if length > 0 then begin
text := stringCopy(text, 1, length);
end;
result := text;
end;
function TMainForm.buildMemberTable(typeRef: AVTTypeStructured): AnsiString;
var
memberLimit: int;
memberIndex: int;
minVisibility: int;
typeSimpleName: AnsiString;
typeFullName: AnsiString;
memberName: AnsiString;
docResult: AnsiString;
foundMemberRef: AVTMember;
foundFieldRef: AVTField;
foundMethodRef: AVTMethod;
foundPropertyRef: AVTProperty;
foundOperatorRef: AVTOperator;
staticFields: Vector;
staticMethods: Vector;
fields: Vector;
constructors: Vector;
methods: Vector;
properties: Vector;
operators: Vector;
begin
minVisibility := fldMinVisibility;
typeSimpleName := typeRef.simpleName;
typeFullName := typeRef.fullName;
docResult := '';
staticFields := nil;
staticMethods := nil;
fields := nil;
constructors := nil;
methods := nil;
properties := nil;
operators := nil;
try
staticFields := Vector.create();
staticMethods := Vector.create();
fields := Vector.create();
constructors := Vector.create();
methods := Vector.create();
properties := Vector.create();
operators := Vector.create();
with typeRef.members() do while hasMoreElements() do begin
foundMemberRef := nextElement().objectValue() as AVTMember;
if (system.length(foundMemberRef.simpleName) > 0) and (foundMemberRef.visibility >= minVisibility) and not foundMemberRef.isSynthetic() then begin
if foundMemberRef.isStatic() then begin
if foundMemberRef is AVTField then begin
staticFields.append(ValueOfObject.create(foundMemberRef, false));
end else
if foundMemberRef.classType() = AVTMethod then begin
staticMethods.append(ValueOfObject.create(foundMemberRef, false));
end;
end else begin
if foundMemberRef is AVTField then begin
fields.append(ValueOfObject.create(foundMemberRef, false));
end else
if foundMemberRef is AVTInstInit then begin
constructors.append(ValueOfObject.create(foundMemberRef, false));
end else
if foundMemberRef.classType() = AVTMethod then begin
methods.append(ValueOfObject.create(foundMemberRef, false));
end else
if foundMemberRef is AVTProperty then begin
properties.append(ValueOfObject.create(foundMemberRef, false));
end else
if foundMemberRef is AVTOperator then begin
operators.append(ValueOfObject.create(foundMemberRef, false));
end;
end;
end;
end;
memberLimit := staticFields.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все статичные поля' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundFieldRef := staticFields.elementAt(memberIndex).objectValue() as AVTField;
memberName := foundFieldRef.simpleName;
docResult := docResult +
flagsToString(foundFieldRef.flags, false, false) + ' ' + typeToHTML(foundFieldRef.valueType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + '">' + memberName + '</a></strong>' + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundFieldRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := staticMethods.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все статичные методы' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundMethodRef := staticMethods.elementAt(memberIndex).objectValue() as AVTMethod;
memberName := foundMethodRef.simpleName;
docResult := docResult +
flagsToString(foundMethodRef.flags, false, false) + ' ' + typeToHTML(foundMethodRef.returnType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + argumentsToLink(foundMethodRef) + '">' + memberName + '</a></strong>' + argumentsToHTML(foundMethodRef) + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundMethodRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := fields.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все инстанционные поля' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundFieldRef := fields.elementAt(memberIndex).objectValue() as AVTField;
memberName := foundFieldRef.simpleName;
docResult := docResult +
flagsToString(foundFieldRef.flags, false) + ' ' + typeToHTML(foundFieldRef.valueType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + '">' + memberName + '</a></strong>' + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundFieldRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := constructors.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все конструкторы' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundMethodRef := constructors.elementAt(memberIndex).objectValue() as AVTMethod;
memberName := typeSimpleName;
docResult := docResult +
flagsToString(foundMethodRef.flags, false) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + argumentsToLink(foundMethodRef) + '">' + memberName + '</a></strong>' + argumentsToHTML(foundMethodRef) + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundMethodRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := methods.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все инстанционные методы' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundMethodRef := methods.elementAt(memberIndex).objectValue() as AVTMethod;
memberName := foundMethodRef.simpleName;
docResult := docResult +
flagsToString(foundMethodRef.flags, false) + ' ' + typeToHTML(foundMethodRef.returnType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + argumentsToLink(foundMethodRef) + '">' + memberName + '</a></strong>' + argumentsToHTML(foundMethodRef) + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundMethodRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := properties.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все свойства' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundPropertyRef := properties.elementAt(memberIndex).objectValue() as AVTProperty;
memberName := foundPropertyRef.simpleName;
docResult := docResult +
flagsToString(foundPropertyRef.flags, false) + ' ' + typeToHTML(foundPropertyRef.valueType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + '">' + memberName + '</a></strong>' + readWriteToHTML(foundPropertyRef) + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundPropertyRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
memberLimit := operators.size() - 1;
for memberIndex := 0 to memberLimit do begin
if memberIndex = 0 then begin
docResult := docResult + ('<table class="memberlist"><thead><tr><th colspan="2">' + LINE_ENDING + 'Все операторы' + LINE_ENDING + '</th></tr></thead><tbody><tr><td>' + LINE_ENDING);
end;
foundOperatorRef := operators.elementAt(memberIndex).objectValue() as AVTOperator;
memberName := 'operator ' + AVTOperator.operatorToChar(foundOperatorRef.operatorKind);
docResult := docResult +
flagsToString(foundOperatorRef.flags, false) + ' ' + typeToHTML(foundOperatorRef.returnType) + LINE_ENDING + '</td><td><p class="member">' + LINE_ENDING +
'<strong><a href="' + typeFullName + '#' + memberName + argumentsToLink(foundOperatorRef) + '">' + memberName + '</a></strong>' + argumentsToHTML(foundOperatorRef) + LINE_ENDING +
'</p><p class="description">' + LINE_ENDING + parseShortDescription(foundOperatorRef.documentation, typeRef) + LINE_ENDING
;
if memberIndex = memberLimit then begin
docResult := docResult + '</p></td></tr></tbody></table>';
end else begin
docResult := docResult + '</p></td></tr><tr><td>';
end;
end;
finally
staticFields.free();
staticMethods.free();
fields.free();
constructors.free();
methods.free();
properties.free();
operators.free();
end;
result := docResult;
end;
function TMainForm.parseShortDescription(const documentation: UnicodeString; member: AVTItem): AnsiString;
var
needExit: boolean;
hasOpenedLink: boolean;
lexemePos: int;
lexemeTypeCurr: int;
lexemeTypePrev: int;
lexemesCount: int;
parOpened: int;
braOpened: int;
curOpened: int;
tagOpened: int;
docResult: AnsiString;
docSource: AVTSource;
begin
docResult := '';
docSource := AVTSource.create();
try
docSource.realize(stringSplit(documentation));
with DOCLexer.create() do begin
try
split(docSource, true);
finally
free();
end;
end;
lexemesCount := docSource.getLexemesCount();
lexemePos := 0;
parOpened := 0;
braOpened := 0;
curOpened := 0;
tagOpened := 0;
needExit := false;
hasOpenedLink := false;
lexemeTypePrev := DOC_END_OF_LINE;
while lexemePos < lexemesCount do begin
lexemeTypeCurr := docSource.getLexemeType(lexemePos);
case lexemeTypeCurr of
DOC_VECT_PACK, DOC_VECT_UNPCKL, DOC_VECT_UNPCKU, DOC_VECT_MUL, DOC_VECT_DIV, DOC_VECT_ADD, DOC_VECT_SUB, DOC_VECT_SAR, DOC_VECT_SAL, DOC_VECT_SHR, DOC_VECT_G,
DOC_VECT_GE, DOC_VECT_L, DOC_VECT_LE, DOC_VECT_E, DOC_VECT_NE, DOC_VECT_MULS, DOC_VECT_ADDS, DOC_VECT_SUBS, DOC_VECT_MULU, DOC_VECT_ADDU, DOC_VECT_SUBU,
DOC_TEXT, DOC_NAME, DOC_ALINK, DOC_SCAL_DIVU, DOC_SCAL_REMU, DOC_SCAL_SAR, DOC_SCAL_SAL, DOC_SCAL_SHR, DOC_SCAL_GE, DOC_SCAL_LE,
DOC_PARENTH_OPENED, DOC_PARENTH_CLOSED, DOC_BRACKET_OPENED, DOC_BRACKET_CLOSED, DOC_CURLY_OPENED, DOC_CURLY_CLOSED, DOC_TAG_OPENED, DOC_TAG_CLOSED,
DOC_EXCLAMATION_MARK, DOC_VERTICAL_LINE, DOC_AMPERSAND, DOC_EQUAL, DOC_TILDE, DOC_POUND_SIGN, DOC_CIRCUMFLEX_ACCENT, DOC_ASTERISK,
DOC_SOLIDUS, DOC_PERCENT, DOC_PLUS, DOC_MINUS, DOC_COMMA, DOC_PERIOD: begin
case lexemeTypeCurr of
DOC_PARENTH_OPENED:
inc(parOpened);
DOC_PARENTH_CLOSED:
dec(parOpened);
DOC_BRACKET_OPENED:
inc(braOpened);
DOC_BRACKET_CLOSED:
dec(braOpened);
DOC_CURLY_OPENED:
inc(curOpened);
DOC_CURLY_CLOSED:
dec(curOpened);
DOC_TAG_OPENED:
inc(tagOpened);
DOC_TAG_CLOSED:
dec(tagOpened);
DOC_PERIOD, DOC_EXCLAMATION_MARK:
if (parOpened <= 0) and (braOpened <= 0) and (curOpened <= 0) and (tagOpened <= 0) then needExit := true;
end;
if (lexemeTypeCurr = DOC_CURLY_OPENED) and (docSource.getLexemeType(lexemePos + 1) = DOC_ALINK) then begin
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + '<a href="' + parseLinkToMember(docSource, lexemePos + 2, member).getRef() + '">';
end else begin
docResult := docResult + ' <a href="' + parseLinkToMember(docSource, lexemePos + 2, member).getRef() + '">';
end;
hasOpenedLink := true;
lexemeTypeCurr := DOC_END_OF_LINE;
lexemePos := docSource.position;
end else begin
if (lexemeTypeCurr = DOC_CURLY_CLOSED) and hasOpenedLink then begin
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + '</a>';
end else begin
docResult := docResult + ' </a>';
end;
hasOpenedLink := false;
lexemeTypeCurr := DOC_TAG_CLOSED;
end else
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + docSource.getLexemeAnsiString(lexemePos);
end else begin
docResult := docResult + ' ' + docSource.getLexemeAnsiString(lexemePos);
end;
inc(lexemePos);
end;
if needExit then break;
end;
DOC_END_OF_LINE: begin
docResult := docResult + LINE_ENDING;
inc(lexemePos);
end;
else
break;
end;
lexemeTypePrev := lexemeTypeCurr;
end;
finally
docSource.free();
end;
result := docResult;
end;
function TMainForm.parseDocumentation(const documentation: UnicodeString; member: AVTItem): AnsiString;
const
KIND_PARAM = int(0);
KIND_RETURN = int(1);
KIND_THROWS = int(2);
KIND_SINCE = int(3);
KIND_SEE = int(4);
var
ppInsertion: boolean;
hasOpenedLink: boolean;
argumentIndex: int;
lexemePos: int;
lexemeTypeCurr: int;
lexemeTypePrev: int;
lexemesCount: int;
returnStarts: int;
sinceStarts: int;
kindOfStarts: int;
indexOfStarts: int;
parsedRef: AnsiString;
docResult: AnsiString;
docSource: AVTSource;
seeStarts: AVTIntStorage;
paramStarts: AVTIntStorage;
throwsStarts: AVTIntStorage;
parsedItem: AVTItem;
parsedLink: ParseLinkResult;
begin
seeStarts := nil;
paramStarts := nil;
throwsStarts := nil;
returnStarts := -1;
sinceStarts := -1;
kindOfStarts := KIND_PARAM;
indexOfStarts := 0;
docResult := '<p>' + LINE_ENDING;
docSource := AVTSource.create();
try
docSource.realize(stringSplit(documentation));
with DOCLexer.create() do begin
try
split(docSource, true);
finally
free();
end;
end;
lexemesCount := docSource.getLexemesCount();
ppInsertion := true;
lexemePos := 0;
repeat
hasOpenedLink := false;
lexemeTypePrev := DOC_END_OF_LINE;
while lexemePos < lexemesCount do begin
lexemeTypeCurr := docSource.getLexemeType(lexemePos);
case lexemeTypeCurr of
DOC_VECT_PACK, DOC_VECT_UNPCKL, DOC_VECT_UNPCKU, DOC_VECT_MUL, DOC_VECT_DIV, DOC_VECT_ADD, DOC_VECT_SUB, DOC_VECT_SAR, DOC_VECT_SAL, DOC_VECT_SHR, DOC_VECT_G,
DOC_VECT_GE, DOC_VECT_L, DOC_VECT_LE, DOC_VECT_E, DOC_VECT_NE, DOC_VECT_MULS, DOC_VECT_ADDS, DOC_VECT_SUBS, DOC_VECT_MULU, DOC_VECT_ADDU, DOC_VECT_SUBU,
DOC_TEXT, DOC_NAME, DOC_ALINK, DOC_SCAL_DIVU, DOC_SCAL_REMU, DOC_SCAL_SAR, DOC_SCAL_SAL, DOC_SCAL_SHR, DOC_SCAL_GE, DOC_SCAL_LE,
DOC_PARENTH_OPENED, DOC_PARENTH_CLOSED, DOC_BRACKET_OPENED, DOC_BRACKET_CLOSED, DOC_CURLY_OPENED, DOC_CURLY_CLOSED, DOC_TAG_OPENED, DOC_TAG_CLOSED,
DOC_EXCLAMATION_MARK, DOC_VERTICAL_LINE, DOC_AMPERSAND, DOC_EQUAL, DOC_TILDE, DOC_POUND_SIGN, DOC_CIRCUMFLEX_ACCENT, DOC_ASTERISK,
DOC_SOLIDUS, DOC_PERCENT, DOC_PLUS, DOC_MINUS, DOC_COMMA, DOC_PERIOD: begin
if (lexemeTypeCurr = DOC_CURLY_OPENED) and (docSource.getLexemeType(lexemePos + 1) = DOC_ALINK) then begin
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + '<a href="' + parseLinkToMember(docSource, lexemePos + 2, member).getRef() + '">';
end else begin
docResult := docResult + ' <a href="' + parseLinkToMember(docSource, lexemePos + 2, member).getRef() + '">';
end;
hasOpenedLink := true;
lexemeTypeCurr := DOC_END_OF_LINE;
lexemePos := docSource.position;
end else begin
if (lexemeTypeCurr = DOC_CURLY_CLOSED) and hasOpenedLink then begin
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + '</a>';
end else begin
docResult := docResult + ' </a>';
end;
hasOpenedLink := false;
lexemeTypeCurr := DOC_TAG_CLOSED;
end else
if (lexemeTypePrev = DOC_END_OF_LINE) or (lexemeTypePrev = DOC_END_OF_PARAGRAPH) or (docSource.line[docSource.getLexemeLineIndex(lexemePos)][docSource.getLexemeCharIndex(lexemePos)] > ' ') then begin
docResult := docResult + docSource.getLexemeAnsiString(lexemePos);
end else begin
docResult := docResult + ' ' + docSource.getLexemeAnsiString(lexemePos);
end;
inc(lexemePos);
end;
end;
DOC_END_OF_LINE, DOC_END_OF_PARAGRAPH: begin
if (lexemeTypeCurr = DOC_END_OF_PARAGRAPH) and ppInsertion then begin
docResult := docResult + LINE_ENDING + '</p><p>' + LINE_ENDING;
end else begin
docResult := docResult + LINE_ENDING;
end;
inc(lexemePos);
end
else
docResult := docResult + '</p>';
break;
end;
lexemeTypePrev := lexemeTypeCurr;
end;
if ppInsertion then begin
ppInsertion := false;
seeStarts := AVTIntStorage.create();
paramStarts := AVTIntStorage.create();
throwsStarts := AVTIntStorage.create();
repeat
case docSource.getLexemeType(lexemePos) of
DOC_APARAM: begin
paramStarts.indexAcquire(lexemePos + 1);
end;
DOC_ARETURN: begin
if returnStarts < 0 then returnStarts := lexemePos + 1;
end;
DOC_ATHROWS: begin
throwsStarts.indexAcquire(lexemePos + 1);
end;
DOC_ASINCE: begin
if sinceStarts < 0 then sinceStarts := lexemePos + 1;
end;
DOC_ASEE: begin
seeStarts.indexAcquire(lexemePos + 1);
end;
DOC_END: begin
break;
end;
end;
inc(lexemePos);
until false;
end;
case kindOfStarts of
KIND_PARAM: begin
if indexOfStarts = 0 then begin
if paramStarts.length <= 0 then begin
lexemePos := lexemesCount;
inc(kindOfStarts);
continue;
end;
docResult := docResult + '<p class="subblock">' + LINE_ENDING + 'Аргументы:' + LINE_ENDING + '</p>';
end;
lexemePos := paramStarts[indexOfStarts];
docResult := docResult + '<p class="argument">' + LINE_ENDING + '<code>' + docSource.getLexemeAnsiString(lexemePos) + '</code> — ';
inc(lexemePos);
if indexOfStarts = paramStarts.length - 1 then begin
inc(kindOfStarts);
indexOfStarts := 0;
end else begin
inc(indexOfStarts);
end;
end;
KIND_RETURN: begin
if returnStarts < 0 then begin
lexemePos := lexemesCount;
inc(kindOfStarts);
continue;
end;
docResult := docResult + '<p class="subblock">' + LINE_ENDING + 'Возвращает:' + LINE_ENDING + '</p><p class="return">' + LINE_ENDING;
lexemePos := returnStarts;
inc(kindOfStarts);
end;
KIND_THROWS: begin
if indexOfStarts = 0 then begin
if throwsStarts.length <= 0 then begin
lexemePos := lexemesCount;
inc(kindOfStarts);
continue;
end;
docResult := docResult + '<p class="subblock">' + LINE_ENDING + 'Возбуждает:' + LINE_ENDING + '</p>';
end;
parsedLink := parseLinkToType(docSource, throwsStarts[indexOfStarts], member);
parsedItem := parsedLink.getItem();
docResult := docResult + '<p class="argument">' + LINE_ENDING;
if parsedItem is AVTTypeStructured then begin
docResult := docResult + '<code><a href="' + parsedLink.getRef() + '">' + parsedItem.simpleName + '</a></code> — ';
end;
lexemePos := docSource.position;
if indexOfStarts = throwsStarts.length - 1 then begin
inc(kindOfStarts);
indexOfStarts := 0;
end else begin
inc(indexOfStarts);
end;
end;
KIND_SINCE: begin
if sinceStarts < 0 then begin
lexemePos := lexemesCount;
inc(kindOfStarts);
continue;
end;
docResult := docResult + '<p class="subblock">' + LINE_ENDING + 'Появился в:' + LINE_ENDING + '</p><p class="return">' + LINE_ENDING;
lexemePos := sinceStarts;
inc(kindOfStarts);
end;
KIND_SEE: begin
if indexOfStarts = 0 then begin
if seeStarts.length <= 0 then begin
lexemePos := lexemesCount;
inc(kindOfStarts);
continue;
end;
docResult := docResult + '<p class="subblock">' + LINE_ENDING + 'См. также:' + LINE_ENDING + '</p>';
end;
parsedLink := parseLinkToMember(docSource, seeStarts[indexOfStarts], member);
parsedItem := parsedLink.getItem();
parsedRef := parsedLink.getRef();
docResult := docResult + '<p class="argument">' + LINE_ENDING + '<code><a href="' + parsedRef + '">';
if parsedItem is AVTPackage then begin
docResult := docResult + parsedItem.fullName;
end else
if parsedItem is AVTTypeStructured then begin
docResult := docResult + parsedItem.simpleName;
end else
if (parsedItem is AVTField) or (parsedItem is AVTProperty) then begin
docResult := docResult + parsedItem.parentItem.simpleName + '.' + parsedItem.simpleName;
end else
if parsedItem is AVTMethod then with AVTMethod(parsedItem) do begin
if parsedItem is AVTInstInit then begin
docResult := docResult + parsedItem.parentItem.simpleName + '(';
end else begin
docResult := docResult + parsedItem.parentItem.simpleName + '.' + stringCopy(parsedRef, stringIndexOf('#', parsedRef) + 1, stringIndexOf('(', parsedRef) + 1);
end;
for argumentIndex := 0 to getArgumentsCount() - 1 do begin
if argumentIndex > 0 then docResult := docResult + ', ';
docResult := docResult + getArgumentAt(argumentIndex).valueType.simpleName;
end;
docResult := docResult + ')';
end else begin
docResult := docResult + 'null';
end;
docResult := docResult + '</a></code>' + LINE_ENDING + '</p>';
lexemePos := lexemesCount;
if indexOfStarts = seeStarts.length - 1 then begin
inc(kindOfStarts);
indexOfStarts := 0;
end else begin
inc(indexOfStarts);
end;
end;
end;
until kindOfStarts > KIND_SEE;
finally
docSource.free();
seeStarts.free();
paramStarts.free();
throwsStarts.free();
end;
result := docResult;
end;
function TMainForm.parseLinkToType(source: AVTSource; pos: int; member: AVTItem): ParseLinkResult;
label
label0;
var
memberIsPack: boolean;
memberIsType: boolean;
dimensions: int;
lexemeType: int;
lexemeName: AnsiString;
docRef: AnsiString;
docItem: AVTItem;
programmeRef: AVTProgramme;
parsedItemRef: AVTItem;
parsedTypeRef: AVTTypeStructured;
begin
programmeRef := fldCurrentProgramme;
begin
memberIsPack := member is AVTPackage;
memberIsType := member is AVTTypeStructured;
lexemeType := source.getLexemeType(pos);
if not memberIsType and (lexemeType <> DOC_NAME) then begin
docItem := nil;
docRef := 'null';
goto label0;
end;
parsedItemRef := nil;
parsedTypeRef := nil;
if lexemeType = DOC_NAME then begin
lexemeName := source.getLexemeAnsiString(pos);
if memberIsType then begin
parsedItemRef := resolveName(lexemeName, AVTTypeStructured(member));
end else
if memberIsPack then begin
parsedItemRef := resolveName(lexemeName, AVTPackage(member));
end else begin
parsedItemRef := programmeRef.getPackage(lexemeName);
end;
inc(pos);
if parsedItemRef is AVTTypeStructured then begin
parsedTypeRef := AVTTypeStructured(parsedItemRef);
end else
if parsedItemRef is AVTPackage then begin
parsedTypeRef := parseFullyQualifiedTypeName(source, pos, AVTPackage(parsedItemRef));
if parsedTypeRef = nil then begin
parsedItemRef := parseFullyQualifiedPackageName(source, pos, AVTPackage(parsedItemRef));
end;
pos := source.position;
end;
end else
if member is AVTTypeStructured then begin
parsedTypeRef := AVTTypeStructured(member);
end;
if parsedTypeRef = nil then begin
if parsedItemRef is AVTPackage then begin
docItem := parsedItemRef;
docRef := parsedItemRef.fullName;
goto label0;
end;
docItem := nil;
docRef := 'null';
goto label0;
end;
dimensions := 0;
while (dimensions < 99) and (source.getLexemeType(pos) = DOC_BRACKET_OPENED) and (source.getLexemeType(pos + 1) = DOC_BRACKET_CLOSED) do begin
parsedTypeRef := programmeRef.getArrayOf(parsedTypeRef);
inc(dimensions);
inc(pos, 2);
end;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
end;
label0:
source.position := pos;
result := ParseLinkInstance.create(docItem, docRef);
end;
function TMainForm.parseLinkToMember(source: AVTSource; pos: int; member: AVTItem): ParseLinkResult;
label
label0,
label1;
var
memberIsType: boolean;
memberIsPack: boolean;
typeEndPos: int;
index: int;
dimensions: int;
lexemeType: int;
parsedArgCount: int;
lexemeName: AnsiString;
memberName: AnsiString;
specialName: AnsiString;
docRef: AnsiString;
docItem: AVTItem;
programmeRef: AVTProgramme;
parsedItemRef: AVTItem;
parsedTypeRef: AVTTypeStructured;
parsedMemberRef: AVTMember;
parsedArgTypeRef: AVTType;
parsedArgTypes: Vector;
begin
programmeRef := fldCurrentProgramme;
begin
memberIsPack := member is AVTPackage;
memberIsType := member is AVTTypeStructured;
lexemeType := source.getLexemeType(pos);
if not memberIsType and (lexemeType <> DOC_NAME) then begin
docItem := nil;
docRef := 'null';
goto label1;
end;
parsedItemRef := nil;
parsedTypeRef := nil;
if lexemeType = DOC_NAME then begin
lexemeName := source.getLexemeAnsiString(pos);
if memberIsType then begin
parsedItemRef := resolveName(lexemeName, AVTTypeStructured(member));
end else
if memberIsPack then begin
parsedItemRef := resolveName(lexemeName, AVTPackage(member));
end else begin
parsedItemRef := programmeRef.getPackage(lexemeName);
end;
inc(pos);
if parsedItemRef is AVTTypeStructured then begin
parsedTypeRef := AVTTypeStructured(parsedItemRef);
end else
if parsedItemRef is AVTPackage then begin
parsedTypeRef := parseFullyQualifiedTypeName(source, pos, AVTPackage(parsedItemRef));
if parsedTypeRef = nil then begin
parsedItemRef := parseFullyQualifiedPackageName(source, pos, AVTPackage(parsedItemRef));
end;
pos := source.position;
end;
end else
if member is AVTTypeStructured then begin
parsedTypeRef := AVTTypeStructured(member);
end;
if parsedTypeRef = nil then begin
if parsedItemRef is AVTPackage then begin
docItem := parsedItemRef;
docRef := parsedItemRef.fullName;
goto label1;
end;
docItem := nil;
docRef := 'null';
goto label1;
end;
dimensions := 0;
while (dimensions < 99) and (source.getLexemeType(pos) = DOC_BRACKET_OPENED) and (source.getLexemeType(pos + 1) = DOC_BRACKET_CLOSED) do begin
parsedTypeRef := programmeRef.getArrayOf(parsedTypeRef);
inc(dimensions);
inc(pos, 2);
end;
if source.getLexemeType(pos) <> DOC_POUND_SIGN then begin
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label1;
end;
typeEndPos := pos;
inc(pos);
if source.getLexemeType(pos) <> DOC_NAME then begin
memberName := '';
specialName := SPECNAME_INST_INIT;
end else begin
memberName := source.getLexemeAnsiString(pos);
if memberName <> 'operator' then begin
specialName := memberName;
end else begin
inc(pos);
memberName := memberName + ' ';
case source.getLexemeType(pos) of
DOC_VECT_PACK: specialName := AVTOperator.operatorToSpecName(OPER_VECT_PACK);
DOC_VECT_UNPCKL: specialName := AVTOperator.operatorToSpecName(OPER_VECT_UNPCKL);
DOC_VECT_UNPCKU: specialName := AVTOperator.operatorToSpecName(OPER_VECT_UNPCKU);
DOC_VECT_MUL: specialName := AVTOperator.operatorToSpecName(OPER_VECT_MUL);
DOC_VECT_DIV: specialName := AVTOperator.operatorToSpecName(OPER_VECT_DIV);
DOC_VECT_ADD: specialName := AVTOperator.operatorToSpecName(OPER_VECT_ADD);
DOC_VECT_SUB: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SUB);
DOC_VECT_SAR: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SAR);
DOC_VECT_SAL: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SAL);
DOC_VECT_SHR: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SHR);
DOC_VECT_G: specialName := AVTOperator.operatorToSpecName(OPER_VECT_G);
DOC_VECT_GE: specialName := AVTOperator.operatorToSpecName(OPER_VECT_GE);
DOC_VECT_L: specialName := AVTOperator.operatorToSpecName(OPER_VECT_L);
DOC_VECT_LE: specialName := AVTOperator.operatorToSpecName(OPER_VECT_LE);
DOC_VECT_E: specialName := AVTOperator.operatorToSpecName(OPER_VECT_E);
DOC_VECT_NE: specialName := AVTOperator.operatorToSpecName(OPER_VECT_NE);
DOC_VECT_MULS: specialName := AVTOperator.operatorToSpecName(OPER_VECT_MULS);
DOC_VECT_ADDS: specialName := AVTOperator.operatorToSpecName(OPER_VECT_ADDS);
DOC_VECT_SUBS: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SUBS);
DOC_VECT_MULU: specialName := AVTOperator.operatorToSpecName(OPER_VECT_MULU);
DOC_VECT_ADDU: specialName := AVTOperator.operatorToSpecName(OPER_VECT_ADDU);
DOC_VECT_SUBU: specialName := AVTOperator.operatorToSpecName(OPER_VECT_SUBU);
DOC_SCAL_DIVU: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_DIVU);
DOC_SCAL_REMU: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_REMU);
DOC_SCAL_SAR: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_SAR);
DOC_SCAL_SAL: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_SAL);
DOC_SCAL_SHR: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_SHR);
DOC_SCAL_GE: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_GE);
DOC_SCAL_LE: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_LE);
DOC_TAG_OPENED: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_L);
DOC_TAG_CLOSED: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_G);
DOC_VERTICAL_LINE: specialName := AVTOperator.operatorToSpecName(OPER_BIT_OR);
DOC_AMPERSAND: specialName := AVTOperator.operatorToSpecName(OPER_BIT_AND);
DOC_TILDE: specialName := AVTOperator.operatorToSpecName(OPER_BIT_NOT);
DOC_CIRCUMFLEX_ACCENT: specialName := AVTOperator.operatorToSpecName(OPER_BIT_XOR);
DOC_ASTERISK: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_MUL);
DOC_SOLIDUS: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_DIV);
DOC_PERCENT: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_REM);
DOC_PLUS: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_ADD);
DOC_MINUS: specialName := AVTOperator.operatorToSpecName(OPER_SCAL_SUB);
DOC_PARENTH_OPENED: begin
if source.getLexemeType(pos + 1) <> DOC_PARENTH_CLOSED then begin
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label1;
end;
memberName := memberName + source.getLexemeAnsiString(pos);
specialName := AVTOperator.operatorToSpecName(INVOKE_VIRTUAL);
inc(pos);
end;
DOC_BRACKET_OPENED: begin
if source.getLexemeType(pos + 1) <> DOC_BRACKET_CLOSED then begin
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label1;
end;
if source.getLexemeType(pos + 2) <> DOC_EQUAL then begin
memberName := memberName + source.getLexemeAnsiString(pos);
specialName := AVTOperator.operatorToSpecName(GET_ARRAY_ELEMENT);
inc(pos);
end else begin
memberName := memberName + source.getLexemeAnsiString(pos) + source.getLexemeAnsiString(pos + 1);
specialName := AVTOperator.operatorToSpecName(SET_ARRAY_ELEMENT);
inc(pos, 2);
end;
end
else
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label1;
end;
memberName := memberName + source.getLexemeAnsiString(pos);
end;
inc(pos);
end;
if source.getLexemeType(pos) <> DOC_PARENTH_OPENED then begin
with parsedTypeRef.members(specialName) do while hasMoreElements() do begin
parsedMemberRef := nextElement().objectValue() as AVTMember;
if (parsedMemberRef is AVTField) or (parsedMemberRef is AVTProperty) then begin
docItem := parsedMemberRef;
docRef := parsedTypeRef.fullName + '#' + memberName;
goto label1;
end;
end;
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label1;
end;
parsedArgTypes := Vector.create();
try
inc(pos);
lexemeType := source.getLexemeType(pos);
if lexemeType <> DOC_PARENTH_CLOSED then repeat
if lexemeType <> DOC_NAME then begin
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label0;
end;
lexemeName := source.getLexemeAnsiString(pos);
parsedArgTypeRef := programmeRef.getType(lexemeName);
if parsedArgTypeRef <> nil then begin
inc(pos);
end else begin
if memberIsType then begin
parsedItemRef := resolveName(lexemeName, AVTTypeStructured(member));
end else
if memberIsPack then begin
parsedItemRef := resolveName(lexemeName, AVTPackage(member));
end else begin
parsedItemRef := programmeRef.getPackage(lexemeName);
end;
inc(pos);
if parsedItemRef is AVTType then begin
parsedArgTypeRef := AVTType(parsedItemRef);
end else
if parsedItemRef is AVTPackage then begin
parsedArgTypeRef := parseFullyQualifiedTypeName(source, pos, AVTPackage(parsedItemRef));
pos := source.position;
end;
if parsedArgTypeRef = nil then begin
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label0;
end;
end;
dimensions := 0;
while (dimensions < 99) and (source.getLexemeType(pos) = DOC_BRACKET_OPENED) and (source.getLexemeType(pos + 1) = DOC_BRACKET_CLOSED) do begin
parsedArgTypeRef := programmeRef.getArrayOf(parsedArgTypeRef);
inc(dimensions);
inc(pos, 2);
end;
parsedArgTypes.append(ValueOfObject.create(parsedArgTypeRef, false));
case source.getLexemeType(pos) of
DOC_COMMA: begin
inc(pos);
lexemeType := source.getLexemeType(pos);
end;
DOC_PARENTH_CLOSED: begin
break;
end
else
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
goto label0;
end;
until false;
inc(pos);
parsedArgCount := parsedArgTypes.size();
if parsedArgCount <= 0 then begin
if specialName = AVTOperator.operatorToSpecName(OPER_VECT_ADD) then begin
specialName := AVTOperator.operatorToSpecName(OPER_VECT_PLUS);
end else
if specialName = AVTOperator.operatorToSpecName(OPER_VECT_SUB) then begin
specialName := AVTOperator.operatorToSpecName(OPER_VECT_MINUS);
end else
if specialName = AVTOperator.operatorToSpecName(OPER_SCAL_ADD) then begin
specialName := AVTOperator.operatorToSpecName(OPER_SCAL_PLUS);
end else
if specialName = AVTOperator.operatorToSpecName(OPER_SCAL_SUB) then begin
specialName := AVTOperator.operatorToSpecName(OPER_SCAL_MINUS);
end;
end;
with parsedTypeRef.members(specialName) do while hasMoreElements() do begin
parsedMemberRef := nextElement().objectValue() as AVTMember;
if (parsedMemberRef is AVTMethod) and (AVTMethod(parsedMemberRef).isIdentityArgumentTypes(parsedArgTypes)) then begin
docItem := parsedMemberRef;
docRef := parsedTypeRef.fullName + '#' + memberName + '(';
for index := 0 to parsedArgCount - 1 do begin
if index > 0 then docRef := docRef + ', ';
docRef := docRef + (parsedArgTypes.elementAt(index).objectValue() as AVTType).fullName;
end;
docRef := docRef + ')';
goto label0;
end;
end;
pos := typeEndPos;
docItem := parsedTypeRef;
docRef := parsedTypeRef.fullName;
label0:
finally
parsedArgTypes.free();
end;
end;
label1:
source.position := pos;
result := ParseLinkInstance.create(docItem, docRef);
end;
function TMainForm.resolveName(const simpleName: AnsiString; packRef: AVTPackage): AVTItem;
var
typeRef: AVTType;
begin
typeRef := packRef.getType(simpleName);
if typeRef <> nil then begin
result := typeRef;
exit;
end;
result := fldCurrentProgramme.getPackage(simpleName);
end;
function TMainForm.resolveName(const simpleName: AnsiString; typeRef: AVTTypeStructured): AVTItem;
label
label0;
var
source: AVTSource;
itemRef: AVTItem;
begin
source := typeRef.source;
begin
itemRef := source.getDeclaredType(simpleName);
if itemRef <> nil then goto label0;
itemRef := source.getImportedType(simpleName);
if itemRef <> nil then goto label0;
itemRef := source.package.getType(simpleName);
if itemRef <> nil then goto label0;
itemRef := source.findImportedType(simpleName);
if itemRef <> nil then goto label0;
itemRef := fldCurrentProgramme.getPackage(simpleName);
end;
label0:
result := itemRef;
end;
function TMainForm.getObjectTreeNode(nodes: TTreeNodes; objectRef: _Object): TTreeNode;
var
objectName: AnsiString;
superRef: AVTPackage;
node: TTreeNode;
begin
node := nodes.findNodeWithData(objectRef);
if node <> nil then begin
result := node;
exit;
end;
if objectRef is AVTSource then begin
objectName := stringToUTF8(AVTSource(objectRef).simpleName);
superRef := AVTSource(objectRef).package;
end else
if objectRef is AVTPackage then begin
if treePackagesMenuFlat.checked then begin
objectName := AVTPackage(objectRef).fullName;
superRef := nil;
end else begin
objectName := AVTPackage(objectRef).simpleName;
superRef := AVTPackage(objectRef).parentPackage;
end;
if system.length(objectName) <= 0 then begin
objectName := '< системный пакет >';
end;
end else begin
objectName := '< все типы >';
superRef := nil;
end;
if superRef = nil then begin
node := nodes.addChildObject(nil, objectName, objectRef);
end else begin
node := nodes.addChildObject(getObjectTreeNode(nodes, superRef), objectName, objectRef);
end;
node.stateIndex := getObjectIconIndex(objectRef);
result := node;
end;
function TMainForm.getTypeTreeNode(nodes: TTreeNodes; typeRef: AVTTypeStructured): TTreeNode;
var
isSource: boolean;
index: int;
source: UnicodeString;
node: TTreeNode;
sourceRef: AVTSource;
packageRef: AVTPackage;
superRef: AVTTypeStructured;
begin
node := nodes.findNodeWithData(typeRef);
if node <> nil then begin
result := node;
exit;
end;
superRef := typeRef.extends();
if superRef = nil then begin
node := nodes.addChildObject(nil, typeRef.simpleName, typeRef);
end else begin
node := nodes.addChildObject(getTypeTreeNode(nodes, superRef), typeRef.simpleName, typeRef);
end;
source := fldSelectedSourceName;
isSource := system.length(source) > 0;
sourceRef := typeRef.source;
packageRef := typeRef.package;
if fldSelectedAllPackages or isSource and (sourceRef <> nil) and (sourceRef.fileName = fldSelectedSourceName) or not isSource and (packageRef <> nil) and (packageRef.fullName = fldSelectedPackageName) then begin
index := getTypeIconIndex(typeRef) + 2;
end else
if typeRef.isAbstract() then begin
index := 1;
end else begin
index := 0;
end;
node.stateIndex := index;
result := node;
end;
function TMainForm.getObjectIcon(objectRef: _Object): TFPImageBitmap;
begin
result := fldObjectsIcons[getObjectIconIndex(objectRef)];
end;
function TMainForm.getTypeIcon(typeRef: AVTTypeStructured): TFPImageBitmap;
begin
result := fldTypesIcons[getTypeIconIndex(typeRef)];
end;
function TMainForm.getMemberIcon(memberRef: AVTMember): TFPImageBitmap;
begin
result := fldMembersIcons[getMemberIconIndex(memberRef)];
end;
constructor TMainForm.create(theOwner: TComponent);
var
i: int;
index: int;
width: int;
height: int;
moduleName: AnsiString;
resourceName: AnsiString;
moduleHandle: TFPResourceHMODULE;
resourceHandle: TFPResourceHandle;
objectsIcons: TFPImageBitmap_Array1d;
typesIcons: TFPImageBitmap_Array1d;
membersIcons: TFPImageBitmap_Array1d;
resourceStream: TStream;
empty: TFPImageBitmap;
image: TFPImageBitmap;
imageList: TImageList;
begin
inherited create(theOwner);
moduleHandle := hInstance();
moduleName := stringToUpperCase(unitName() + '.');
{ значки объектов (пакетов и исходного кода) }
objectsIcons := TFPImageBitmap_Array1d(TObject_Array1d_create(4));
imageList := treePackagesImageList;
empty := TBitmap.create();
try
for index := 0 to system.length(objectsIcons) - 1 do begin
resourceName := moduleName + getObjectIconName(index);
resourceHandle := findResource(moduleHandle, PChar(resourceName), PChar(RT_RCDATA));
if resourceHandle <> 0 then begin
resourceStream := TResourceStream.create(moduleHandle, resourceName, PChar(RT_RCDATA));
try
image := TPortableNetworkGraphic.create();
objectsIcons[index] := image;
image.loadFromStream(resourceStream);
finally
resourceStream.free();
end;
if imageList.count <= 0 then begin
width := image.width;
height := image.height;
imageList.width := width;
imageList.height := height;
empty.setSize(width, height);
for i := 0 to system.length(objectsIcons) - 1 do begin
imageList.add(empty, empty);
end;
end;
imageList.replace(index, image, empty);
end;
end;
finally
empty.free();
end;
{ значки типов }
typesIcons := TFPImageBitmap_Array1d(TObject_Array1d_create(4 * 3 * 3));
imageList := treeTypesImageList;
empty := TBitmap.create();
try
for index := 0 to system.length(typesIcons) - 1 do begin
resourceName := moduleName + getTypeIconName(index);
resourceHandle := findResource(moduleHandle, PChar(resourceName), PChar(RT_RCDATA));
if resourceHandle <> 0 then begin
resourceStream := TResourceStream.create(moduleHandle, resourceName, PChar(RT_RCDATA));
try
image := TPortableNetworkGraphic.create();
typesIcons[index] := image;
image.loadFromStream(resourceStream);
finally
resourceStream.free();
end;
if imageList.count <= 0 then begin
width := image.width;
height := image.height;
imageList.width := width;
imageList.height := height;
empty.setSize(width, height);
for i := 0 to system.length(typesIcons) + 1 do begin
imageList.add(empty, empty);
end;
end;
imageList.replace(index + 2, image, empty);
end;
end;
resourceStream := TResourceStream.create(moduleHandle, moduleName + 'CLASS_INACTIVE', PChar(RT_RCDATA));
try
image := TPortableNetworkGraphic.create();
try
image.loadFromStream(resourceStream);
imageList.replace(0, image, empty);
finally
image.free();
end;
finally
resourceStream.free();
end;
resourceStream := TResourceStream.create(moduleHandle, moduleName + 'CLASS_INACTIVE_ABSTRACT', PChar(RT_RCDATA));
try
image := TPortableNetworkGraphic.create();
try
image.loadFromStream(resourceStream);
imageList.replace(1, image, empty);
finally
image.free();
end;
finally
resourceStream.free();
end;
finally
empty.free();
end;
{ значки членов }
membersIcons := TFPImageBitmap_Array1d(TObject_Array1d_create(2 * 5 * 5 * 6));
for index := 0 to system.length(membersIcons) - 1 do begin
resourceName := moduleName + getMemberIconName(index);
resourceHandle := findResource(moduleHandle, PChar(resourceName), PChar(RT_RCDATA));
if resourceHandle <> 0 then begin
resourceStream := TResourceStream.create(moduleHandle, resourceName, PChar(RT_RCDATA));
try
image := TPortableNetworkGraphic.create();
membersIcons[index] := image;
image.loadFromStream(resourceStream);
finally
resourceStream.free();
end;
end;
end;
{ инициализация полей }
fldSelectedAllPackages := true;
fldSelectedTypeName := 'avt.lang.Object';
fldDocumentation := labelDocumentation.caption;
fldObjectsIcons := objectsIcons;
fldTypesIcons := typesIcons;
fldMembersIcons := membersIcons;
fldCurrentProgramme := AVTProgramme.create();
{ назначение событий }
viewDocumentation.onKeyDown := defaultKeyDown;
forms.application.addOnActivateHandler(formActivate);
end;
destructor TMainForm.destroy;
begin
forms.application.removeOnActivateHandler(formActivate);
destroyObjectArray(TObject_Array1d(fldMembersIcons));
{ destroyObjectArray(TObject_Array1d(fldTypesIcons)); }
{ destroyObjectArray(TObject_Array1d(fldObjectsIcons)); }
fldCurrentProgramme.free();
inherited destroy;
end;
procedure TMainForm.run();
var
programme: AVTProgramme;
begin
programme := AVTProgramme.create();
fldCreatedProgramme := programme;
try
readSourcesFrom(fldProjectDirectory + 'src.avt', '/');
realizeSources();
lexicalAnalyzer();
buildProgramme();
fldErrorMessage := 'Таблица символов программы обновлена.';
except
on e: AVTCompilerException do begin
fldErrorMessage :=
e.message +
' (file: ' + stringToUTF8(e.sourceFileName) +
', line: ' + intToString(e.lineIndex + 1) +
', char: ' + intToString(e.charIndex + 1) + ')'
;
end;
on e: AVTGlobalException do begin
fldErrorMessage :=
e.message
;
end;
on e: TObject do begin
fldErrorMessage :=
e.toString()
;
end;
end;
Thread.synchronize(Thread.currentThread, programmeBuilded);
end;
class procedure TMainForm.destroyObjectArray(const objects: TObject_Array1d);
var
index: int;
begin
for index := system.length(objects) - 1 downto 0 do begin
objects[index].free();
objects[index] := nil;
end;
end;
class procedure TMainForm.updateTabOrders(panel0, panel1: TWinControl);
begin
if not(panel0.parent is TForm) and not(panel1.parent is TForm) then begin
panel0.tabOrder := 0;
panel1.tabOrder := 2;
end;
end;
class procedure TMainForm.updateSplitters(panel0, panel1, splitter: TWinControl);
const
MIN_SIZE_IN_PERCENT = int(20);
var
s: int;
s0: int;
s1: int;
ls0: int;
ls1: int;
par0: TWinControl;
par1: TWinControl;
begin
par0 := panel0.parent;
par1 := panel1.parent;
if not(par0 is TForm) and not(par1 is TForm) then begin
case splitter.align of
alLeft: begin
s := par0.width;
s0 := panel0.width;
s1 := panel1.width;
ls0 := s * MIN_SIZE_IN_PERCENT div 100;
ls1 := s * (100 - MIN_SIZE_IN_PERCENT) div 100;
if (s0 < ls0) or (s1 > ls1) then begin
panel0.width := ls0;
splitter.left := ls0;
end else
if (s1 < ls0) or (s0 > ls1) then begin
panel0.width := ls1;
splitter.left := ls1;
end;
end;
alTop: begin
s := par0.height;
s0 := panel0.height;
s1 := panel1.height;
ls0 := s * MIN_SIZE_IN_PERCENT div 100;
ls1 := s * (100 - MIN_SIZE_IN_PERCENT) div 100;
if (s0 < ls0) or (s1 > ls1) then begin
panel0.height := ls0;
splitter.top := ls0;
end else
if (s1 < ls0) or (s0 > ls1) then begin
panel0.height := ls1;
splitter.top := ls1;
end;
end;
alRight: begin
s := par0.width;
s0 := panel0.width;
s1 := panel1.width;
ls0 := s * MIN_SIZE_IN_PERCENT div 100;
ls1 := s * (100 - MIN_SIZE_IN_PERCENT) div 100;
if (s0 < ls0) or (s1 > ls1) then begin
panel1.width := ls1;
splitter.left := s - ls1 - splitter.width;
end else
if (s1 < ls0) or (s0 > ls1) then begin
panel1.width := ls0;
splitter.left := s - ls0 - splitter.width;
end;
end;
alBottom: begin
s := par0.height;
s0 := panel0.height;
s1 := panel1.height;
ls0 := s * MIN_SIZE_IN_PERCENT div 100;
ls1 := s * (100 - MIN_SIZE_IN_PERCENT) div 100;
if (s0 < ls0) or (s1 > ls1) then begin
panel1.height := ls1;
splitter.top := s - ls1 - splitter.height;
end else
if (s1 < ls0) or (s0 > ls1) then begin
panel1.height := ls0;
splitter.top := s - ls0 - splitter.height;
end;
end;
end;
end;
end;
class procedure TMainForm.loadSize(section: Hashtable; const key: AnsiString; selectedControl, selectedSplitter: TWinControl);
var
index: int;
begin
case selectedSplitter.align of
alLeft: begin
index := parseIniInteger(section.get(ValueOfAnsiString.create(key)), selectedControl.width);
selectedControl.width := index;
selectedSplitter.left := index;
end;
alRight: begin
selectedControl.width := parseIniInteger(section.get(ValueOfAnsiString.create(key)), selectedControl.width);
selectedSplitter.left := selectedControl.left - selectedSplitter.width;
end;
alTop: begin
index := parseIniInteger(section.get(ValueOfAnsiString.create(key)), selectedControl.height);
selectedControl.height := index;
selectedSplitter.top := index;
end;
alBottom: begin
selectedControl.height := parseIniInteger(section.get(ValueOfAnsiString.create(key)), selectedControl.height);
selectedSplitter.top := selectedControl.top - selectedSplitter.height;
end;
end;
end;
class procedure TMainForm.loadStrings(dst: TStrings; margin: int; fileSystem: ReadOnlyVirtualFileSystem; const fileName: UnicodeString);
var
i: int;
length: int;
available: long;
prefix: AnsiString;
current: AnsiString;
data: byte_Array1d;
stream: Input;
strings: AnsiString_Array1d;
begin
stream := fileSystem.openFileForReading(fileName);
try
available := stream.available();
if available > INT_MAX_VALUE then available := INT_MAX_VALUE;
data := byte_Array1d_create(int(available));
stream.read(data);
finally
stream.close();
end;
prefix := AnsiString_create(4 * margin);
for i := system.length(prefix) - 1 downto 0 do prefix[i + 1] := ' ';
strings := stringSplit(AnsiString_create(data, 0, int(available)));
length := system.length(strings);
for i := 0 to length - 1 do begin
current := strings[i];
if system.length(current) > 0 then current := prefix + current;
dst.add(current);
end;
end;
class procedure TMainForm.loadStrings(dst: TStrings; margin: int; const source: AnsiString);
var
i: int;
length: int;
prefix: AnsiString;
current: AnsiString;
strings: AnsiString_Array1d;
begin
prefix := AnsiString_create(4 * margin);
for i := system.length(prefix) - 1 downto 0 do prefix[i + 1] := ' ';
strings := stringSplit(source);
length := system.length(strings);
for i := 0 to length - 1 do begin
current := strings[i];
if system.length(current) > 0 then current := prefix + current;
dst.add(current);
end;
end;
class procedure TMainForm.saveText(const text: AnsiString; fileSystem: WriteableVirtualFileSystem; const fileName: UnicodeString);
var
stream: Output;
begin
stream := fileSystem.createFile(fileName);
try
stream.write(stringToByteArray(text));
finally
stream.close();
end;
end;
class function TMainForm.isMethodArguments(methodRef: AVTMethod; const argumentTypes: AnsiString_Array1d): boolean;
var
i: int;
count: int;
begin
count := methodRef.getArgumentsCount();
if count <> system.length(argumentTypes) then begin
result := false;
exit;
end;
for i := count - 1 downto 0 do begin
if methodRef.getArgumentAt(i).valueType.fullName <> argumentTypes[i] then begin
result := false;
exit;
end;
end;
result := true;
end;
class function TMainForm.hasMemberInList(typeRef: AVTTypeStructured; memberRef: AVTMember; list: TStrings; count: int): boolean;
var
index: int;
simpleName: AnsiString;
foundObjectRef: TObject;
begin
if memberRef is AVTInstInit then begin
result := (not typeRef.isService() or (memberRef.parentType <> typeRef.extends())) and (not typeRef.isStruct() or (memberRef.parentType.fullName <> 'avt.lang.Struct'));
exit;
end;
if memberRef is AVTClassInit then begin
result := false;
exit;
end;
if memberRef is AVTMethod then begin
simpleName := memberRef.simpleName;
for index := 0 to count - 1 do begin
foundObjectRef := list.objects[index];
if (foundObjectRef is AVTMethod) and (AVTMethod(foundObjectRef).simpleName = simpleName) and AVTMethod(foundObjectRef).isIdentityArguments(AVTMethod(memberRef)) then begin
result := true;
exit;
end;
end;
end;
if memberRef is AVTProperty then begin
simpleName := memberRef.simpleName;
for index := 0 to count - 1 do begin
foundObjectRef := list.objects[index];
if (foundObjectRef is AVTProperty) and (AVTMethod(foundObjectRef).simpleName = simpleName) then begin
result := true;
exit;
end;
end;
end;
result := false;
end;
class function TMainForm.parseIniBoolean(paramValue: Value; defaultValue: boolean): boolean;
var
stringValue: AnsiString;
begin
if paramValue = nil then begin
result := defaultValue;
exit;
end;
stringValue := paramValue.ansiStringValue();
if stringValue = '0' then begin
result := false;
exit;
end;
if stringValue = '1' then begin
result := true;
exit;
end;
result := defaultValue;
end;
class function TMainForm.parseIniInteger(paramValue: Value; defaultValue: int): int;
begin
if paramValue = nil then begin
result := defaultValue;
exit;
end;
try
result := intParse(paramValue.ansiStringValue());
except
result := defaultValue;
end;
end;
class function TMainForm.getObjectIconIndex(objectRef: _Object): int;
begin
if objectRef = nil then begin
result := 0;
exit;
end;
if objectRef is AVTSource then begin
result := 3;
exit;
end;
if (objectRef is AVTItem) and (AVTItem(objectRef).visibility = AVT_PUBLIC) then begin
result := 1;
exit;
end;
result := 2;
end;
class function TMainForm.getTypeIconIndex(typeRef: AVTTypeStructured): int;
var
typeKind: int;
visibility: int;
flagsIndex: int;
begin
if typeRef.isInterface() then begin
typeKind := 1;
end else
if typeRef.isService() then begin
typeKind := 2;
end else
if typeRef.isStruct() then begin
typeKind := 3;
end else begin
typeKind := 0;
end;
case typeRef.visibility of
AVT_SOURCE:
visibility := 0;
AVT_PACKAGE:
visibility := 1;
else
visibility := 2;
end;
if typeKind = 1 then begin
flagsIndex := 0;
end else begin
if typeRef.isAbstract() then begin
flagsIndex := 1;
end else
if typeRef.isFinal() then begin
flagsIndex := 2;
end else begin
flagsIndex := 0;
end;
end;
result := typeKind * (3 * 3) + visibility * 3 + flagsIndex;
end;
class function TMainForm.getMemberIconIndex(memberRef: AVTMember): int;
var
flags: int;
overridden: int;
memberType: int;
visibility: int;
flagsIndex: int;
begin
if (memberRef is AVTOverriddable) and AVTOverriddable(memberRef).overriddenMembers().hasMoreElements() then begin
overridden := 1;
end else begin
overridden := 0;
end;
if memberRef is AVTField then begin
memberType := 0;
end else
if memberRef is AVTInstInit then begin
memberType := 1;
end else
if memberRef is AVTProperty then begin
memberType := 3;
end else
if memberRef is AVTOperator then begin
memberType := 4;
end else begin
memberType := 2;
end;
case memberRef.visibility of
AVT_PRIVATE:
visibility := 0;
AVT_SOURCE:
visibility := 1;
AVT_PACKAGE:
visibility := 2;
AVT_PROTECTED:
visibility := 3;
else
visibility := 4;
end;
flags := memberRef.flags;
if (flags and (FLAG_STATIC or FLAG_FINAL)) = FLAG_STATIC then begin
flagsIndex := 0;
end else
if (flags and (FLAG_STATIC or FLAG_FINAL)) = (FLAG_STATIC or FLAG_FINAL) then begin
flagsIndex := 1;
end else
if (flags and (FLAG_STATIC or FLAG_INTERRUPT)) = (FLAG_STATIC or FLAG_INTERRUPT) then begin
flagsIndex := 2;
end else
if (flags and (FLAG_ABSTRACT or FLAG_FINAL)) = FLAG_ABSTRACT then begin
flagsIndex := 4;
end else
if (flags and (FLAG_ABSTRACT or FLAG_FINAL)) = FLAG_FINAL then begin
flagsIndex := 5;
end else begin
flagsIndex := 3;
end;
if (memberType = 2) and (flagsIndex = 1) then begin
flagsIndex := 0;
end;
result := overridden * (5 * 5 * 6) + memberType * (5 * 6) + visibility * 6 + flagsIndex;
end;
class function TMainForm.getObjectIconName(index: int): AnsiString;
var
name: AnsiString;
begin
if index = 3 then begin
result := stringToUpperCase('source');
exit;
end;
name := 'package';
case index of
0: name := name + '_all';
1: name := name + '_public';
2: name := name + '_library';
end;
result := stringToUpperCase(name);
end;
class function TMainForm.getTypeIconName(index: int): AnsiString;
var
typeKind: int;
visibility: int;
flagsIndex: int;
name: AnsiString;
begin
typeKind := index div (3 * 3);
visibility := index mod (3 * 3) div 3;
flagsIndex := index mod 3;
name := '';
case typeKind of
0: name := name + 'class';
1: name := name + 'interface';
2: name := name + 'service';
3: name := name + 'struct';
end;
case visibility of
0: name := name + '_source';
1: name := name + '_package';
2: name := name + '_public';
end;
case flagsIndex of
1: name := name + '_abstract';
2: name := name + '_final';
end;
result := stringToUpperCase(name);
end;
class function TMainForm.getMemberIconName(index: int): AnsiString;
var
overridden: int;
memberType: int;
visibility: int;
flagsIndex: int;
name: AnsiString;
begin
overridden := index div (5 * 5 * 6);
memberType := index mod (5 * 5 * 6) div (5 * 6);
visibility := index mod (5 * 6) div 6;
flagsIndex := index mod 6;
name := '';
if overridden = 1 then name := 'override_';
case memberType of
0: name := name + 'field';
1: name := name + 'constructor';
2: name := name + 'method';
3: name := name + 'property';
4: name := name + 'operator';
end;
case visibility of
0: name := name + '_private';
1: name := name + '_source';
2: name := name + '_package';
3: name := name + '_protected';
4: name := name + '_public';
end;
case flagsIndex of
0: name := name + '_static';
1: name := name + '_static_final';
2: name := name + '_static_interrupt';
4: name := name + '_abstract';
5: name := name + '_final';
end;
result := stringToUpperCase(name);
end;
class function TMainForm.typeToHTML(typeRef: AVTType): AnsiString;
var
i: int;
text: AnsiString;
begin
if typeRef is AVTTypeArray then with AVTTypeArray(typeRef) do begin
text := typeToHTML(cellType);
for i := dimensionsCount - 1 downto 0 do begin
text := text + '[]';
end;
result := text;
exit;
end;
if typeRef is AVTTypeStructured then begin
result := '<a href="' + typeRef.fullName + '">' + typeRef.simpleName + '</a>';
exit;
end;
if typeRef is AVTTypePrimitive then begin
result := '<span class="type">' + typeRef.simpleName + '</span>';
exit;
end;
result := '<span class="type">null</span>';
end;
class function TMainForm.argumentsToLink(methodRef: AVTMethod): AnsiString;
var
i: int;
text: AnsiString;
begin
text := '(';
for i := 0 to methodRef.getArgumentsCount() - 1 do begin
if i > 0 then text := text + ', ';
text := text + methodRef.getArgumentAt(i).valueType.fullName;
end;
result := text + ')';
end;
class function TMainForm.argumentsToHTML(methodRef: AVTMethod): AnsiString;
var
i: int;
text: AnsiString;
begin
text := '(';
for i := 0 to methodRef.getArgumentsCount() - 1 do begin
if i > 0 then text := text + ', ';
with methodRef.getArgumentAt(i) do text := text + typeToHTML(valueType) + ' ' + simpleName;
end;
text := text + ')';
with methodRef.throws() do if hasMoreElements() then begin
text := text + ' throws ' + typeToHTML(nextElement().objectValue() as AVTTypeStructured);
while hasMoreElements() do begin
text := text + ', ' + typeToHTML(nextElement().objectValue() as AVTTypeStructured);
end;
end;
result := text;
end;
class function TMainForm.readWriteToHTML(propertyRef: AVTProperty): AnsiString;
begin
if propertyRef.readSynthetic <> nil then begin
if propertyRef.writeSynthetic <> nil then begin
result := ' { read, write }';
end else begin
result := ' { read }';
end;
end else begin
if propertyRef.writeSynthetic <> nil then begin
result := ' { write }';
end else begin
result := ' { ??? }';
end;
end;
end;
class function TMainForm.parseIniString(paramValue: Value; const defaultValue: AnsiString): AnsiString;
begin
if paramValue = nil then begin
result := defaultValue;
exit;
end;
result := paramValue.ansiStringValue();
end;
class function TMainForm.booleanToIniString(value: boolean): AnsiString;
begin
if value then begin
result := '1';
exit;
end;
result := '0';
end;
class function TMainForm.windowPositionToIniString(parentControl: TWinControl): AnsiString;
begin
if parentControl is TForm then begin
result :=
'left = ' + intToString(parentControl.left) + LINE_ENDING +
'top = ' + intToString(parentControl.top) + LINE_ENDING +
'width = ' + intToString(parentControl.width) + LINE_ENDING +
'height = ' + intToString(parentControl.height);
exit;
end;
result := '; panel is not separated';
end;
class function TMainForm.activePageIndexToIniString(parentControl: TWinControl): AnsiString;
begin
if parentControl is TTabSheet then begin
result := intToString(TTabSheet(parentControl).pageControl.activePageIndex);
exit;
end;
result := '-1';
end;
class function TMainForm.splitterControlSizeToIniString(splitterAlign: TAlign; splitterControl: TWinControl): AnsiString;
begin
case splitterAlign of
alLeft, alRight:
result := intToString(splitterControl.width);
alTop, alBottom:
result := intToString(splitterControl.height)
else
result := '0';
end;
end;
class function TMainForm.makeFullName(const path, workingDirectory: UnicodeString): UnicodeString;
var
c: wchar;
npt: UnicodeString;
begin
npt := stringReplace(path, DIRECTORY_SEPARATOR, '/');
if stringStartsWith(UnicodeString('/'), npt) then npt := stringCopy(npt, 2);
if length(npt) <= 0 then begin
result := workingDirectory;
exit;
end;
if not stringEndsWith(UnicodeString('/'), npt) then npt := npt + '/';
if length(npt) < 3 then begin
result := workingDirectory + npt;
exit;
end;
c := npt[1];
if ((c >= 'A') and (c <= 'Z') or (c >= 'a') and (c <= 'z')) and (npt[2] = ':') and (npt[3] = '/') then begin
result := '/' + npt;
exit;
end;
result := workingDirectory + npt;
end;
class function TMainForm.parseFullyQualifiedPackageName(source: AVTSource; pos: int; packageRef: AVTPackage): AVTPackage;
var
nextPackageRef: AVTPackage;
begin
while (source.getLexemeType(pos) = DOC_PERIOD) and (source.getLexemeType(pos + 1) = DOC_NAME) do begin
nextPackageRef := packageRef.getSubpackage(source.getLexemeAnsiString(pos + 1));
if nextPackageRef = nil then break;
packageRef := nextPackageRef;
inc(pos, 2);
end;
source.position := pos;
result := packageRef;
end;
class function TMainForm.parseFullyQualifiedTypeName(source: AVTSource; pos: int; packageRef: AVTPackage): AVTTypeStructured;
var
simpleName: AnsiString;
nextPackageRef: AVTPackage;
nextTypeRef: AVTTypeStructured;
begin
repeat
if source.getLexemeType(pos) <> DOC_PERIOD then begin
source.position := pos;
result := nil;
exit;
end;
inc(pos);
if source.getLexemeType(pos) <> DOC_NAME then begin
source.position := pos;
result := nil;
exit;
end;
simpleName := source.getLexemeAnsiString(pos);
nextTypeRef := packageRef.getType(simpleName) as AVTTypeStructured;
if nextTypeRef <> nil then break;
nextPackageRef := packageRef.getSubpackage(simpleName);
if nextPackageRef = nil then begin
source.position := pos;
result := nil;
exit;
end;
packageRef := nextPackageRef;
inc(pos);
until false;
source.position := pos + 1;
result := nextTypeRef;
end;
class procedure TMainForm.createInstance(const args: UnicodeString_Array1d);
var
len: int;
moduleDirectory: UnicodeString;
workingDirectory: UnicodeString;
projectDirectory: UnicodeString;
begin
if not AVTProgramme.isSupportedAVX512ByCPU() then begin
messageDlg('Обозреватель кода', 'Запуск этой программы возможен только на процессорах с поддержкой AVX, AVX2 и AVX-512 (F, CD, DQ, BW).', mtError, [mbClose], 0);
system.halt();
end;
if not AVTProgramme.isSupportedAVX512ByOS() then begin
messageDlg('Обозреватель кода', 'Запуск этой программы возможен только в среде операционной системы с поддержкой AVX, AVX2 и AVX-512 (F, CD, DQ, BW).', mtError, [mbClose], 0);
system.halt();
end;
len := length(args);
if len <= 1 then begin
messageDlg('Обозреватель кода', 'Папка проекта не задана в аргументе командной строки.' + LINE_ENDING +
'Пожалуйста, задайте путь к папке проекта в аргументе командной строки.' + LINE_ENDING +
'Папка проекта должна содержать папки src.asm и src.avt.', mtInformation, [mbClose], 0);
system.halt();
end;
moduleDirectory := stringReplace(args[0], DIRECTORY_SEPARATOR, '/');
moduleDirectory := stringCopy(moduleDirectory, 1, stringLastIndexOf(wchar('/'), moduleDirectory) + 1);
if not stringStartsWith(UnicodeString('/'), moduleDirectory) then moduleDirectory := '/' + moduleDirectory;
workingDirectory := stringReplace(systemGetCurrentDirectory(), DIRECTORY_SEPARATOR, '/');
if not stringEndsWith(UnicodeString('/'), workingDirectory) then workingDirectory := workingDirectory + '/';
if not stringStartsWith(UnicodeString('/'), workingDirectory) then workingDirectory := '/' + workingDirectory;
projectDirectory := makeFullName(args[1], workingDirectory);
forms.application.createForm(self, instance);
instance.fldProjectDirectory := projectDirectory;
instance.fldCssStyleFile := moduleDirectory + 'avtb.css';
instance.fldHtmlDocFile := moduleDirectory + 'avtb.html';
instance.fldSettingsFile := moduleDirectory + 'avtb.ini';
instance.loadWindowState();
(Thread.create(instance)).start();
end;
{%endregion}
{%region ParseLinkInstance }
constructor ParseLinkInstance.create(item: AVTItem; const ref: AnsiString);
begin
inherited create();
self.fldItem := item;
self.fldRef := ref;
end;
function ParseLinkInstance.getItem(): AVTItem;
begin
result := fldItem;
end;
function ParseLinkInstance.getRef(): AnsiString;
begin
result := fldRef;
end;
{%endregion}
end.