{
Графическая оболочка обозревателя кода языка программирования
Объектно-ориентированный продвинутый векторный транслятор
Copyright © 2021, 2026 Малик Разработчик
Это свободная программа: вы можете перераспространять ее и/или изменять
ее на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она будет полезной,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЕННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<https://www.gnu.org/licenses/>.
}
unit ru.malik.elaborarer.avtoo.browser;
{$MODE DELPHI}
interface
{%region} uses
{$IFDEF WINDOWS}
windows,
{$ENDIF}
rtlconsts,
classes,
clipbrd,
lclintf,
lcltype,
lmessages,
forms,
themes,
graphics,
fpcanvas,
actnlist,
controls,
comctrls,
extctrls,
stdctrls,
buttons,
dialogs,
menus,
htmlview,
pascalx.lang,
pascalx.lang.locale,
pascalx.lang.math.avo,
pascalx.io,
pascalx.io.extension,
platform.independent.filesystem,
platform.independent.osservices,
platform.independent.streamformat.text.plain,
platform.independent.streamformat.text.plain.ini,
ru.malik.elaborarer.avtoo.lang,
ru.malik.elaborarer.avtoo.compiler;
{%endregion}
{$TYPEINFO ON}
{$CALLING REGISTER}
const UNIT_NAME = 'ru.malik.elaborarer.avtoo.browser';
{%region} type
TMainForm = class;
TPairContainer = class;
TPageContainer = class;
TContainerTabSheet = class;
ConcatenatedObjectArray = class;
TVisibleFromDialog = class;
TAboutDialog = class;
IconSelectOption = (
isInactive,
isSimple
);
IconSelectOptions = set of IconSelectOption;
TGraphic_Array1d = packed array of TGraphic;
TWinControl_Array1d = packed array of TWinControl;
TMainForm = class(TForm, Runnable)
mainMenu: TMainMenu;
projectMenu: TMenuItem;
projectOpen: TMenuItem;
projectRecentMenu: TMenuItem;
projectRecentSeparator: TMenuItem;
projectRecentClear: TMenuItem;
projectRefresh: TMenuItem;
projectAutoRefresh: TMenuItem;
projectExit: TMenuItem;
filtersMenu: TMenuItem;
filtersPublic: TMenuItem;
filtersProtected: TMenuItem;
filtersPackage: TMenuItem;
filtersText: TMenuItem;
filtersPrivate: TMenuItem;
filtersVisibleFrom: TMenuItem;
filtersResetVisibility: TMenuItem;
filtersResetAll: TMenuItem;
helpMenu: TMenuItem;
helpAboutApp: TMenuItem;
pageContainerMenu: TPopupMenu;
pageContainerTabPositionTop: TMenuItem;
pageContainerTabPositionBottom: TMenuItem;
pageContainerTabPositionLeft: TMenuItem;
pageContainerTabPositionRight: TMenuItem;
projectOpenDialog: TSelectDirectoryDialog;
actions: TActionList;
classpathWidget: TPanel;
classpathTitle: TLabel;
classpathActions: TPanel;
classpathFile: TEdit;
classpathSelectButton: TBitBtn;
classpathOpenButton: TSpeedButton;
classpathOthers: TSpeedButton;
classpathList: TListBox;
classpathMenu: TPopupMenu;
classpathSelectItem: TMenuItem;
classpathOpenItem: TMenuItem;
classpathOpenDialog: TOpenDialog;
classpathSelectAction: TAction;
classpathOpenAction: TAction;
librariesWidget: TPanel;
librariesTitle: TLabel;
librariesActions: TPanel;
librariesCollapseAllButton: TSpeedButton;
librariesOthers: TSpeedButton;
librariesTree: TTreeView;
librariesMenu: TPopupMenu;
librariesFlatViewItem: TMenuItem;
librariesTreeViewItem: TMenuItem;
librariesCollapseAllItem: TMenuItem;
librariesCollapseAllAction: TAction;
librariesFlatViewAction: TAction;
librariesTreeViewAction: TAction;
typesWidget: TPanel;
typesTitle: TLabel;
typesActions: TPanel;
typesCollapseAllButton: TSpeedButton;
typesForcePublicButton: TSpeedButton;
typesOthers: TSpeedButton;
typesTree: TTreeView;
typesMenu: TPopupMenu;
typesShowPublicItem: TMenuItem;
typesShowPackageItem: TMenuItem;
typesShowTextItem: TMenuItem;
typesListViewItem: TMenuItem;
typesTreeViewItem: TMenuItem;
typesCollapseAllItem: TMenuItem;
typesCollapseAllAction: TAction;
typesListViewAction: TAction;
typesTreeViewAction: TAction;
typesShowPublicAction: TAction;
typesShowPackageAction: TAction;
typesShowTextAction: TAction;
typesForcePublicAction: TAction;
membersWidget: TPanel;
membersTitle: TLabel;
membersActions: TPanel;
membersSortButton: TSpeedButton;
membersHideFieldsButton: TSpeedButton;
membersHideStaticsButton: TSpeedButton;
membersForcePublicButton: TSpeedButton;
membersShowInheritedButton: TSpeedButton;
membersOthers: TSpeedButton;
membersList: TListBox;
membersMenu: TPopupMenu;
membersShowPublicItem: TMenuItem;
membersShowProtectedItem: TMenuItem;
membersShowPackageItem: TMenuItem;
membersShowTextItem: TMenuItem;
membersShowPrivateItem: TMenuItem;
membersShowSyntheticItem: TMenuItem;
membersHideFieldsItem: TMenuItem;
membersHideStaticsItem: TMenuItem;
membersShowInheritedItem: TMenuItem;
membersShowCanonicalItem: TMenuItem;
membersSimpleIconsItem: TMenuItem;
membersSortItem: TMenuItem;
membersShowPublicAction: TAction;
membersShowProtectedAction: TAction;
membersShowPackageAction: TAction;
membersShowTextAction: TAction;
membersShowPrivateAction: TAction;
membersShowSyntheticAction: TAction;
membersSortAction: TAction;
membersHideFieldsAction: TAction;
membersHideStaticsAction: TAction;
membersForcePublicAction: TAction;
membersShowInheritedAction: TAction;
membersShowCanonicalAction: TAction;
membersSimpleIconsAction: TAction;
documentationWidget: TPanel;
documentationTitle: TLabel;
documentationBorder: TPanel;
documentationView: THtmlViewer;
documentationMenu: TPopupMenu;
documentationCopyItem: TMenuItem;
documentationSelectAllItem: TMenuItem;
documentationCopyAction: TAction;
documentationSelectAllAction: TAction;
messagesWidget: TPanel;
messagesTitlle: TLabel;
messagesView: TMemo;
compilePanel: TPanel;
compileIcon: TImage;
compileStatus: TLabel;
compileTimer: TTimer;
startupTimer: TTimer;
status: TStatusBar;
icons: TImageList;
menuSeparator000: TMenuItem;
menuSeparator001: TMenuItem;
menuSeparator002: TMenuItem;
menuSeparator003: TMenuItem;
menuSeparator004: TMenuItem;
menuSeparator005: TMenuItem;
menuSeparator006: TMenuItem;
menuSeparator007: TMenuItem;
menuSeparator008: TMenuItem;
menuSeparator009: TMenuItem;
menuSeparator010: TMenuItem;
procedure formShow(sender: TObject);
procedure formResize(sender: TObject);
procedure formCloseQuery(sender: TObject; var canClose: Boolean);
procedure titlePointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: int);
procedure siteDockInfo(sender: TObject; widget: TControl; var influenceRect: TRect; pointerPosition: TPoint; var canDock: boolean);
procedure siteDockOver(sender: TObject; source: TDragDockObject; x, y: int; state: TDragState; var canDock: boolean);
procedure siteDockDrop(sender: TObject; source: TDragDockObject; x, y: int);
procedure widgetDockBegin(sender: TObject; var source: TDragDockObject);
procedure widgetDockEnd(sender, target: TObject; x, y: int);
procedure widgetEnter(sender: TObject);
procedure widgetLeave(sender: TObject);
procedure listPaintItem(sender: TWinControl; index: int; const area: TRect; state: TOwnerDrawState);
procedure treeKeyPressed(sender: TObject; var key: system.Word; shift: TShiftState);
procedure classpathSelect(sender: TObject; user: boolean);
procedure librariesSelect(sender: TObject);
procedure typesSelect(sender: TObject);
procedure membersSelect(sender: TObject; user: boolean);
procedure documentationKeyPressed(sender: TObject; var key: system.Word; shift: TShiftState);
procedure documentationPointerDragged(sender: TObject; shift: TShiftState; x, y: int);
procedure documentationSelect(sender: TObject; const ulink: UnicodeString; var handled: boolean);
procedure documentationCreateImageStream(sender: TObject; const ulink: UnicodeString; var stream: TStream);
procedure documentationDestroyImageStream(sender: TObject; const ulink: UnicodeString; var stream: TStream);
procedure openRecentProject(sender: TObject);
procedure commandAction(sender: TObject);
procedure commandHint(sender: TObject);
procedure compileIconUpdate(sender: TObject);
procedure compileStartup(sender: TObject);
strict private { требуется для механизма стыковки }
fldDockingIndex: int;
fldDockingWidget: TWinControl;
fldDockingParent: TWinControl;
fldWidgets: TWinControl_Array1d;
fldContainers: TWinControl_Array1d;
procedure destroyContainer(container: TWinControl);
function parseDockingString(const str: AnsiString): boolean;
function getDockingString(): AnsiString;
function createContainer(first, second: TWinControl): TPageContainer; overload;
function createContainer(first, second: TWinControl; size: double; horizontal: boolean): TPairContainer; overload;
strict private { состояние окна просмотра (* — не хранится в настройках приложения) }
fldInitialMaximized: boolean;
fldAutoRefresh: boolean;
fldPackagesHierarchy: boolean;
fldTypesHierarchy: boolean;
fldTypesForcePublic: boolean;
fldMembersForcePublic: boolean;
fldMembersHideFields: boolean;
fldMembersHideStatics: boolean;
fldMembersShowInherited: boolean;
fldMembersShowCanonical: boolean;
fldMembersSimpleIcons: boolean;
fldMembersSort: boolean;
fldTypesVisibility: int;
fldMembersVisibility: int;
fldSelectedLibraryIndex: int;
fldCompileIconFrameIndex: int; { * }
fldCompileMessage: AnsiString; { * }
fldPrintedMessage: AnsiString; { * }
fldVisibleFromCanonicalName: AnsiString;
fldSelectedPackageCanonicalName: AnsiString;
fldSelectedTypeCanonicalName: AnsiString;
fldSelectedMemberFullName: AnsiString;
fldSelectedTextSourceSimpleFileName: UnicodeString;
fldCurrentClasspathRelativeFileName: UnicodeString;
fldCurrentDocumentationItemAddress: UnicodeString;
fldProjectRootPath: UnicodeString;
fldProjectDirectory: UnicodeString;
fldProjectRecents: UnicodeString_Array1d;
fldProjectFileSystem: FileSystem; { * }
fldProjectInstance: TableBuilder; { * }
fldPageContainerTabPosition: TTabPosition;
fldInitialBounds: TRect;
procedure loadUserState();
procedure saveUserState();
procedure compileProject();
procedure clearClasspath();
procedure clearLibraries();
procedure clearTypes();
procedure clearMembers();
procedure clearDocumentation();
procedure clearMessages();
procedure fillClasspath();
procedure fillLibraries();
procedure fillTypes();
procedure fillMembers();
procedure fillDocumentation();
procedure fillRecentProjects();
procedure updateCommandsStates();
procedure updatePanelActionsStates();
procedure enableActions(isEnabled: boolean);
procedure writeMessage(const msg: AnsiString);
procedure openProject(const internalPath: AnsiString; const classpathName: UnicodeString = ''); overload;
procedure openProject(const internalPath: UnicodeString; const classpathName: UnicodeString = ''); overload;
procedure openProjectInternal(const internalPath, classpathName: UnicodeString);
function readCommandLine(): boolean;
function compareTypesTreeNodes(node1, node2: TTreeNode): int;
function compareLibrariesTreeNodes(node1, node2: TTreeNode): int;
function parsePackageNameProject(const relativePath: AnsiString; sequence: LexemeSequence; position: int; parsed: PackageHolder): int;
function parseTypeNameProject(const relativePath: AnsiString; source: TextSource; sequence: LexemeSequence; position: int; parsed: TypeHolder): int;
function parseMemberNameProject(const relativePath: AnsiString; ctype: ClassType; sequence: LexemeSequence; position: int; parsed: ImmediateBuilderItemHolder): int;
function parseItemNameProject(const relativePath: AnsiString; sequence: LexemeSequence; position: int; parsed: ImmediateBuilderItemHolder): int; overload;
function parseItemNameProject(const relativePath: AnsiString; item: ReflectItem; position: int; parsed: ImmediateBuilderItemHolder): int; overload;
function getItemDocumentationProject(item: ProgrammeItem): UnicodeString;
function getItemDocumentationLibrary(item: ProgrammeItem): UnicodeString; unimplemented;
function itemToLinkString(item: ProgrammeItem): UnicodeString;
function linkStringToItem(const ulink: UnicodeString): ProgrammeItem;
strict private { загруженные ресурсы }
fldTitle: AnsiString;
fldLine: AnsiString;
fldChar: AnsiString;
fldSource: AnsiString;
fldDefault: AnsiString;
fldStatusReady: AnsiString;
fldStatusLoading: AnsiString;
fldStatusNotLoaded: AnsiString;
fldSystemPackage: AnsiString;
fldNameAndVersion: AnsiString;
fldDocumentationStyle: UnicodeString;
fldDocumentationEmpty: UnicodeString;
fldDocumentationTemplate: UnicodeString;
fldDocumentationHeadClass: UnicodeString;
fldDocumentationHeadHelper: UnicodeString;
fldDocumentationHeadStruct: UnicodeString;
fldDocumentationHeadService: UnicodeString;
fldDocumentationHeadPackage: UnicodeString;
fldDocumentationHeadInterface: UnicodeString;
fldDocumentationHeadField: UnicodeString;
fldDocumentationHeadMethod: UnicodeString;
fldDocumentationHeadProperty: UnicodeString;
fldDocumentationHeadOperator: UnicodeString;
fldDocumentationHeadInstInit: UnicodeString;
fldDocumentationHeadClassInit: UnicodeString;
fldDocumentationHierarchyClasses: UnicodeString;
fldDocumentationHierarchyServices: UnicodeString;
fldDocumentationHierarchyHelperFor: UnicodeString;
fldDocumentationPathClass: UnicodeString;
fldDocumentationPathHelper: UnicodeString;
fldDocumentationPathStruct: UnicodeString;
fldDocumentationPathService: UnicodeString;
fldDocumentationPathPackage: UnicodeString;
fldDocumentationPathInterface: UnicodeString;
fldDocumentationAtTagSee: UnicodeString;
fldDocumentationAtTagParam: UnicodeString;
fldDocumentationAtTagSince: UnicodeString;
fldDocumentationAtTagReturn: UnicodeString;
fldDocumentationAtTagThrows: UnicodeString;
fldDocumentationAtTagAuthor: UnicodeString;
fldDocumentationErrorInItem: UnicodeString;
fldDocumentationErrorInType: UnicodeString;
fldItemsIcons: TGraphic_Array1d;
fldCompileIcons: TGraphic_Array1d;
fldVisibleFromDialog: TVisibleFromDialog;
fldAboutDialog: TAboutDialog;
strict private { вспомогательные члены }
fldMembersListScrollWidth: int;
fldClasspathListScrollWidth: int;
fldStringsBuffer: TStringList;
fldObjectsBuffer: ConcatenatedObjectArray;
procedure compileEnd(dummy: long);
procedure modifyListScrollWidth(index: long);
protected
procedure doAddDockClient(client: TControl; const rect: TRect); override;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
procedure afterConstruction(); override;
procedure beforeDestruction(); override;
procedure run();
private const
ICON_GROUP_LIBRARIES = int(0);
ICON_GROUP_TYPES = int(6); { 5 разновидностей, 4 видимости, 3 связывания }
ICON_GROUP_MEMBERS = int(66); { 5 разновидностей, 5 видимостей, 4 отношения, 3 связывания }
ICON_GROUP_ALL = int(366);
private
class function isVisibleArray(aarray: ArrayType): boolean; static;
class function isImageResourceExists(const name: AnsiString): boolean; static;
class function isHTMLTagBlockElement(const tagName: UnicodeString): boolean; static;
class function compareMembersListItems(list: TStringList; index1, index2: int): int; static;
class function getIconIndex(item: TObject; options: IconSelectOptions = []): int; static;
class function getIconName(index: int): AnsiString; static;
class function getImageResourcePath(const name: AnsiString): AnsiString; static;
class function itemToDisplayString(item: ReflectItem; from: ProgrammeItem): UnicodeString; static;
class function loadImageFromResource(const name: AnsiString): TGraphic; static;
public const
CLASSPATH_EXTENSION = '.classpath';
SYSTEM_PACKAGE_NAME = 'system.package';
public
class procedure createInstance();
class function isClasspathSourceFileName(const fileName: UnicodeString): boolean; static;
end;
TPairContainer = class(TPanel)
public const
SPLITTER_SIZE = int(10);
strict private
fldHorizontal: boolean;
fldSize: double;
procedure updateLayout();
procedure setHorizontal(newHorizontal: boolean);
procedure setSize(newSize: double);
procedure containerResized(sender: TObject);
procedure splitterMoved(sender: TObject);
function getAlign(): TAlign;
private
procedure recalculateConstraints();
protected
procedure doAddDockClient(client: TControl; const rect: TRect); override;
public
constructor create(theOwner: TComponent); override;
procedure invalidate(); override;
procedure insertControl(control: TControl; index: int); override; overload;
procedure removeControl(control: TControl); override;
procedure insertSplitter(); virtual;
published
property horizontal: boolean read fldHorizontal write setHorizontal;
property size: double read fldSize write setSize;
end;
TPageContainer = class(TPageControl)
public const
RESERVED_WIDTH = int(80);
RESERVED_HEIGHT = int(40);
strict private
fldIsDragAfterPage: boolean;
fldIsPointerWaitForDrag: boolean;
fldPointerPageIndex: int;
fldDraggingPageIndex: int;
fldDragOverPageIndex: int;
fldTriggerDragAt: int2;
fldPointerPressedAt: int2;
fldDragOverPageRect: TRect;
fldDragAfterPageRect: TRect;
procedure initDragPage();
procedure invalidateRect(const rect: TRect);
function getPageIndexForDrag(x, y: int): int;
function getPageRectEx(pageIndex, x, y: int; out isAfter: boolean): TRect;
private
procedure recalculateConstraints();
protected
procedure cnNotify(var message: TLMNotify); message {controls.}CN_NOTIFY;
procedure mouseDown(button: TMouseButton; shift: TShiftState; x, y: int); override;
procedure mouseMove(shift: TShiftState; x, y: int); override;
procedure mouseUp(button: TMouseButton; shift: TShiftState; x, y: int); override;
procedure dragOver(source: TObject; x, y: int; state: TDragState; var canDrag: boolean); override;
procedure dragCanceled(); override;
procedure captureChanged(); override;
procedure paintWindow(dc: HDC); override;
procedure insertPage(page: TCustomPage; index: int); override;
procedure removePage(index: int); override;
procedure doAddDockClient(client: TControl; const rect: TRect); override;
function getPageClass(): TCustomPageClass; override;
public
constructor create(theOwner: TComponent); override;
procedure insertControl(control: TControl; index: int); override; overload;
procedure removeControl(control: TControl); override;
procedure dragDrop(source: TObject; x, y: int); override;
procedure beginDragPage(pageIndex: int; immediate: boolean; threshold: int = -1);
end;
TContainerTabSheet = class(TTabSheet)
public
procedure insertControl(control: TControl; index: int); override; overload;
procedure removeControl(control: TControl); override;
end;
ConcatenatedObjectArray = class(&Object, Measureable, ObjectArray)
strict private
fldLength: int;
fldArray: TObject_Array1d;
public
procedure clear();
procedure concat(anot: ObjectArray);
function getLength(): int;
function readComponent(index: int): TObject;
end;
TVisibleFromDialog = class(TForm)
typesList: TComboBox;
selectButton: TButton;
cancelButton: TButton;
procedure dialogShow(sender: TObject);
procedure listPaintItem(sender: TWinControl; index: int; const area: TRect; state: TOwnerDrawState);
strict private
procedure setSelectedTypeCanonicalName(const newSelectedTypeCanonicalName: AnsiString);
function getSelectedTypeCanonicalName(): AnsiString;
public
procedure fillTypesList(programmeInstance: Programme);
property selectedTypeCanonicalName: AnsiString read getSelectedTypeCanonicalName write setSelectedTypeCanonicalName;
end;
TAboutDialog = class(TForm)
mainPages: TPageControl;
versionTab: TTabSheet;
logoView: TImage;
descriptionView: TLabel;
versionOfCompilerLabel: TLabel;
versionOfCompilerView: TLabel;
versionOfBrowserLabel: TLabel;
versionOfBrowserView: TLabel;
buildDateLabel: TLabel;
buildDateView: TLabel;
copyrightView: TLabel;
internetTab: TTabSheet;
internetPanel: TPanel;
linkMainOuterPanel: TPanel;
linkMainBackground: TShape;
linkMainTitle: TLabel;
linkMainInnerPanel: TPanel;
linkMainDescription: TLabel;
linkMainQRCode: TImage;
linkMainButton: TButton;
linkDonateOuterPanel: TPanel;
linkDonateBackground: TShape;
linkDonateTitle: TLabel;
linkDonateInnerPanel: TPanel;
linkDonateDescription: TLabel;
linkDonateQRCode: TImage;
linkDonateButton: TButton;
autorsTab: TTabSheet;
autorsView: TMemo;
licenseTab: TTabSheet;
licenseView: TMemo;
closeButton: TButton;
procedure openURL(sender: TObject);
public
procedure afterConstruction(); override;
end;
{%endregion}
implementation
{$R *.res}
{$R *.mainform.lfm}
{$R *.visiblefromdialog.lfm}
{$R *.aboutdialog.lfm}
{$TYPEINFO OFF}
{$CALLING REGISTER}
{%region} type
TByteReaderStream = class;
TByteReaderStream = class(TStream)
private
fldReader: ByteReader;
fldSeeker: SeekExtension;
protected
function getPosition(): long; override;
function getSize(): long; override;
public
constructor create(reader: ByteReader);
destructor destroy; override;
function read(var dst; length: int): int; override;
function seek(const offset: long; from: TSeekOrigin): long; override;
end;
OverriddableHelper = class helper for OverriddableMember
public
function isOverride(): boolean;
end;
PropertyHelper = class helper for &Property
public
function specifiersToString(): AnsiString;
end;
TProgrammeStrings = class helper for TStrings
public
function contains(member: Member; enclosing: ClassType): boolean;
end;
TProgrammeTreeNodes = class helper for TTreeNodes
public
function addChildsClassObject(parent: TTreeNode; const name: AnsiString; data: ClassType): TTreeNode;
function addChildsPackageObject(parent: TTreeNode; const dotName: AnsiString; data: Pointer): TTreeNode;
end;
TProgrammeTreeNode = class helper for TTreeNode
public
function getPackageNodeForFlatView(const dotName: AnsiString): TTreeNode;
function getPackageNodeForTreeView(const dotName: AnsiString): TTreeNode;
end;
{%endregion}
{%region TMainForm }
procedure TMainForm.formShow(sender: TObject);
var
top: int;
left: int;
width: int;
height: int;
{$IFDEF WINDOWS}
cmdshow: int;
{$ENDIF}
bounds: TRect;
begin
bounds := fldInitialBounds;
top := bounds.top;
left := bounds.left;
width := bounds.width;
height := bounds.height;
{$IFDEF WINDOWS}
cmdshow := system.cmdshow;
if cmdshow > lcltype.SW_SHOWNORMAL then begin
if (width or height) <> 0 then begin
if cmdshow = lcltype.SW_SHOWMINNOACTIVE then begin
position := TPosition.poDesigned;
setBounds(left, top, width, height);
end;
setRestoredBounds(left, top, width, height);
end;
end else
{$ENDIF}
begin
if fldInitialMaximized then begin
if (width or height) <> 0 then begin
position := TPosition.poDesigned;
setBounds(left, top, width, height);
setRestoredBounds(left, top, width, height);
end;
windowState := TWindowState.wsMaximized;
end else begin
if (width or height) <> 0 then begin
position := TPosition.poDesigned;
setBounds(left, top, width, height);
end;
end;
end;
if not readCommandLine() and ((fldProjectRootPath.length or fldProjectDirectory.length) > 0) then begin
startupTimer.enabled := true;
end;
end;
procedure TMainForm.formResize(sender: TObject);
var
pos: int2;
begin
with compilePanel do if visible then begin
pos := Scalar.sar(Vector.newInt2(self.width, self.height) - Vector.newInt2(width, height), 1);
left := pos[0];
top := pos[1];
end;
end;
procedure TMainForm.formCloseQuery(sender: TObject; var canClose: Boolean);
begin
canClose := not compilePanel.visible;
end;
procedure TMainForm.titlePointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: int);
begin
if (button = TMouseButton.mbLeft) and (shift * [TShiftStateEnum.ssShift, TShiftStateEnum.ssCtrl, TShiftStateEnum.ssAlt] = []) then begin
(sender as TControl).parent.beginDrag(true);
end;
end;
procedure TMainForm.siteDockInfo(sender: TObject; widget: TControl; var influenceRect: TRect; pointerPosition: TPoint; var canDock: boolean);
var
site: TControl;
parent: TWinControl;
begin
site := sender as TControl;
parent := site.parent;
if parent = nil then begin
influenceRect := site.clientToScreen(site.clientRect);
end else begin
influenceRect := parent.clientToScreen(site.boundsRect);
end;
canDock := site <> widget;
end;
procedure TMainForm.siteDockOver(sender: TObject; source: TDragDockObject; x, y: int; state: TDragState; var canDock: boolean);
label
break_label0;
const
I : int2 = ( 0, 1 );
P1M1: int2 = ( 1, -1 );
var
size: int;
half: int;
index: int;
start: int2;
sizes: int2;
sprod: int2;
ltcrn: int2;
controls: TWinControl_Array1d;
rect: TRect;
align: TAlign;
point: TPoint;
widget: TControl;
site: TWinControl;
splitter: TControl;
control: TWinControl;
begin
widget := source.control;
point := (sender as TControl).clientToScreen(TPoint.create(x, y));
begin
controls := fldWidgets;
for index := 0 to system.length(controls) - 1 do begin
control := controls[index];
if control.dockSite then begin
if control.parent.clientToScreen(control.boundsRect).contains(point) then begin
point := control.screenToClient(point);
site := control;
x := point.x;
y := point.y;
goto break_label0;
end;
end;
end;
controls := fldContainers;
for index := 0 to system.length(controls) - 1 do begin
control := controls[index];
if control is TPairContainer then begin
splitter := control.controls[1];
if control.clientToScreen(splitter.boundsRect).contains(point) then begin
point := control.screenToClient(point);
site := control;
x := point.x;
y := point.y;
goto break_label0;
end;
end;
if control is TPageContainer then begin
if control.parent.clientToScreen(control.boundsRect).contains(point) then begin
point := control.screenToClient(point);
site := control;
x := point.x;
y := point.y;
goto break_label0;
end;
end;
end;
site := widget as TWinControl;
end;
break_label0:
if site is TPairContainer then begin
if TPairContainer(site).horizontal then begin
size := site.height;
half := CoInt.sar(size, 1);
if y < half then begin
align := TAlign.alTop;
rect := TRect.create(0, 0, site.width, half);
end else begin
align := TAlign.alBottom;
rect := TRect.create(0, half, site.width, size);
end;
end else begin
size := site.width;
half := CoInt.sar(size, 1);
if x < half then begin
align := TAlign.alLeft;
rect := TRect.create(0, 0, half, site.height);
end else begin
align := TAlign.alRight;
rect := TRect.create(half, 0, size, site.height);
end;
end;
canDock := true;
end else
if site <> widget then begin
sizes := Vector.newInt2(site.width, site.height);
ltcrn := Cast.toInt2(Vector.&div(Cast.toFloat2(sizes), Vector.newFloat2(3.0, 3.0)));
if (TRect.create(TPoint(ltcrn), TPoint(sizes - ltcrn), true)).contains(TPoint.create(x, y)) then begin
align := TAlign.alClient;
rect := TRect.create(TPoint.create(0, 0), TPoint(sizes));
end else begin
sprod := Vector.mul(sizes * I, Vector.newInt2(x, y));
if sprod[0] + sprod[1] >= 0 then begin
start := Vector.newInt2(0, sizes[1]);
sprod := Vector.mul(Vector.mul(sizes, P1M1) * I, Vector.newInt2(x, y) - start);
if sprod[0] + sprod[1] >= 0 then begin
align := TAlign.alBottom;
half := CoInt.sar(sizes[1], 1);
rect := TRect.create(0, half, sizes[0], sizes[1]);
end else begin
align := TAlign.alLeft;
half := CoInt.sar(sizes[0], 1);
rect := TRect.create(0, 0, half, sizes[1]);
end;
end else begin
start := Vector.newInt2(0, sizes[1]);
sprod := Vector.mul(Vector.mul(sizes, P1M1) * I, Vector.newInt2(x, y) - start);
if sprod[0] + sprod[1] >= 0 then begin
align := TAlign.alRight;
half := CoInt.sar(sizes[0], 1);
rect := TRect.create(half, 0, sizes[0], sizes[1]);
end else begin
align := TAlign.alTop;
half := CoInt.sar(sizes[1], 1);
rect := TRect.create(0, 0, sizes[0], half);
end;
end;
end;
canDock := true;
end else begin
align := TAlign.alClient;
rect := TRect.create(0, 0, site.width, site.height);
canDock := false;
end;
rect.offset(site.left, site.top);
rect := site.parent.clientToScreen(rect);
source.dropOnControl := site;
source.dropAlign := align;
source.dockRect := rect;
end;
procedure TMainForm.siteDockDrop(sender: TObject; source: TDragDockObject; x, y: int);
label
break_label0;
var
reversed: boolean;
horizontal: boolean;
index: int;
cindex: int;
pindex: int;
controls: TWinControl_Array1d;
align: TAlign;
another: TControl;
site: TWinControl;
prev: TWinControl;
widget: TWinControl;
parent: TWinControl;
control: TWinControl;
container: TWinControl;
begin
source.dragTarget := nil;
align := source.dropAlign;
widget := source.control as TWinControl;
site := source.dropOnControl as TWinControl;
reversed := (align = TAlign.alRight) or (align = TAlign.alBottom);
horizontal := (align = TAlign.alLeft) or (align = TAlign.alRight);
parent := site.parent;
prev := widget.parent;
begin
controls := fldContainers;
for cindex := 0 to system.length(controls) - 1 do begin
control := controls[cindex];
if (control is TPairContainer) and (control.controlCount = 2) then begin
prev := control;
goto break_label0;
end;
if control is TPageContainer then with TPageContainer(control) do for pindex := 0 to pageCount - 1 do if pages[pindex].controlCount <= 0 then begin
prev := control;
goto break_label0;
end;
end;
if prev is TCustomPage then begin
prev := prev.parent;
end;
end;
break_label0:
widget.parent := nil;
widget.align := TAlign.alNone;
if site is TPairContainer then begin
another := site.controls[0];
if another is TSplitter then begin
another := site.controls[1];
end;
if site = prev then begin
another.parent := nil;
another.align := TAlign.alNone;
if reversed then begin
site.insertControl(another, 0);
TPairContainer(site).horizontal := horizontal;
TPairContainer(site).size := 0.5;
site.insertControl(widget, 2);
end else begin
site.insertControl(widget, 0);
TPairContainer(site).horizontal := horizontal;
TPairContainer(site).size := 0.5;
site.insertControl(another, 2);
end;
site.invalidate();
end else begin
destroyContainer(prev);
index := parent.getControlIndex(site);
if reversed then begin
container := createContainer(site, widget, 0.5, horizontal);
end else begin
container := createContainer(widget, site, 0.5, horizontal);
end;
parent.insertControl(container, index);
parent.invalidate();
end;
end else begin
if align <> TAlign.alClient then begin
index := parent.getControlIndex(site);
if reversed then begin
container := createContainer(site, widget, 0.5, horizontal);
end else begin
container := createContainer(widget, site, 0.5, horizontal);
end;
parent.insertControl(container, index);
parent.invalidate();
end else
if site is TPageContainer then begin
widget.hostDockSite := nil;
site.insertControl(widget);
with TPageContainer(site) do begin
pageIndex := pageCount - 1;
end;
site.invalidate();
end else begin
index := parent.getControlIndex(site);
container := createContainer(site, widget);
parent.insertControl(container, index);
parent.invalidate();
end;
destroyContainer(prev);
end;
end;
procedure TMainForm.widgetDockBegin(sender: TObject; var source: TDragDockObject);
var
widget: TWinControl;
begin
widget := sender as TWinControl;
if widget.align <> TAlign.alClient then begin
fldDockingIndex := 0;
end else begin
fldDockingIndex := 2;
end;
fldDockingWidget := widget;
fldDockingParent := widget.parent;
end;
procedure TMainForm.widgetDockEnd(sender, target: TObject; x, y: int);
var
index: int;
controls: TWinControl_Array1d;
control: TWinControl;
widget: TWinControl;
parent: TWinControl;
begin
if target is TCustomForm then begin
index := fldDockingIndex;
widget := fldDockingWidget;
parent := fldDockingParent;
widget.parent := nil;
parent.insertControl(widget, index);
parent.invalidate();
TCustomForm(target).hide();
exit;
end;
controls := fldWidgets;
for index := 0 to system.length(controls) - 1 do begin
control := controls[index];
if control.parentWindow = 0 then begin
parent := control.parent;
if parent <> nil then control.parentWindow := parent.handle;
end;
end;
end;
procedure TMainForm.widgetEnter(sender: TObject);
label
break_label0;
var
selectedIndex: int;
selectedNode: TTreeNode;
selectedObject: ProgrammeItem;
begin
if (sender = classpathFile) or (sender = classpathSelectButton) or (sender = classpathList) then begin
classpathSelectButton.default := true;
exit;
end;
begin
if (sender is TTreeView) then begin
selectedNode := TTreeView(sender).selected;
if selectedNode = nil then exit;
selectedObject := TObject(selectedNode.data) as ProgrammeItem;
if selectedObject <> nil then goto break_label0;
exit;
end;
if (sender is TListBox) then begin
selectedIndex := TListBox(sender).itemIndex;
if selectedIndex < 0 then exit;
selectedObject := TListBox(sender).items.objects[selectedIndex] as ProgrammeItem;
if selectedObject <> nil then goto break_label0;
end;
exit;
end;
break_label0:
fldCurrentDocumentationItemAddress := itemToLinkString(selectedObject);
fillDocumentation();
end;
procedure TMainForm.widgetLeave(sender: TObject);
begin
if (sender = classpathFile) or (sender = classpathSelectButton) or (sender = classpathList) then begin
classpathSelectButton.default := false;
exit;
end;
end;
procedure TMainForm.listPaintItem(sender: TWinControl; index: int; const area: TRect; state: TOwnerDrawState);
var
selected: boolean;
canonical: boolean;
li: int;
sw: ^int;
sch: int;
ax0: int;
ay0: int;
ax1: int;
ay1: int;
dx0: int;
dx1: int;
idx: int;
color0: long;
color1: long;
color2: long;
text: AnsiString;
icons: TGraphic_Array1d;
typ: &Type;
font: TFont;
brush: TBrush;
item: TObject;
icon: TGraphic;
fval: Constant;
items: TStrings;
render: TCanvas;
list: TCustomListBox;
tservices: TThemeServices;
tdetails: TThemedElementDetails;
enclosing: ru.malik.elaborarer.avtoo.lang.ClassType;
procedure drawIcon(icon: TGraphic);
begin
render.draw(dx0, ay0 + 1, icon);
inc(dx0, icon.width);
end;
procedure drawText(const text: AnsiString);
begin
render.textOut(dx0, ay0 + CoInt.sar(ay1 - ay0 - render.textHeight(text), 1), text);
inc(dx0, render.textWidth(text));
end;
procedure drawThemedText(const text: AnsiString);
begin
tservices.drawText(render, tdetails, text, TRect.create(dx0, ay0, ax1, ay1), lcltype.DT_LEFT or lcltype.DT_VCENTER or lcltype.DT_SINGLELINE or lcltype.DT_NOPREFIX, 0);
inc(dx0, render.textWidth(text));
end;
function typeToString(&type: &Type): AnsiString;
begin
if canonical then begin
result := &type.specialCanonicalName;
exit;
end;
result := &type.specialSimpleName;
end;
begin
{ инициализация }
list := sender as TCustomListBox;
items := list.items;
render := list.canvas;
selected := TOwnerDrawStateType.odSelected in state;
canonical := fldMembersShowCanonical;
icons := fldItemsIcons;
ax0 := area.left;
ay0 := area.top;
ax1 := area.right;
ay1 := area.bottom;
item := items.objects[index];
tservices := themes.themeServices();
if not selected then begin
tdetails := tservices.getElementDetails(TThemedTreeView.ttItemNormal);
end else
if list.focused() then begin
tdetails := tservices.getElementDetails(TThemedTreeView.ttItemSelected);
end else begin
tdetails := tservices.getElementDetails(TThemedTreeView.ttItemSelectedNotFocus);
end;
{ подготовка }
render.clipRect := area;
brush := render.brush;
brush.style := TFPBrushStyle.bsSolid;
brush.color := graphics.clWindow;
font := render.font;
font.color := graphics.clWindowText;
{ фон }
render.fillRect(area);
if selected then begin
tservices.drawElement(render.handle, tdetails, area);
end;
brush.style := TFPBrushStyle.bsClear;
{ элемент }
dx0 := ax0 + 1;
if item is ru.malik.elaborarer.avtoo.lang.ClassType then with ru.malik.elaborarer.avtoo.lang.ClassType(item) do begin
inc(dx0, 16);
{ значок }
icon := icons[getIconIndex(item)];
if icon <> nil then begin
drawIcon(icon);
inc(dx0, 6);
end;
{ название }
font.style := [TFontStyle.fsBold];
drawThemedText(specialSimpleName);
font.style := [];
{ супертипы }
if isHelper() then begin
drawThemedText(' : ' + typeToString(getHelperForType()));
end else begin
typ := getSuperclassType();
if typ <> nil then begin
text := typeToString(typ);
for idx := 0 to getSuperservicesLength() - 1 do begin
text := text + ', ' + typeToString(getSuperserviceTypeAt(idx));
end;
drawThemedText('(' + text + ')');
end;
end;
end else
if item is Member then with Member(item) do begin
inc(dx0, 32);
{ значок }
if fldMembersSimpleIcons then begin
icon := icons[getIconIndex(item, [IconSelectOption.isSimple])];
end else begin
icon := icons[getIconIndex(item)];
end;
if icon <> nil then begin
drawIcon(icon);
inc(dx0, 6);
end;
{ название }
if not(item is SpecialMethod) then begin
if item is &Operator then begin
text := 'operator ' + &Operator.kindToSymbol(&Operator(item).kind);
end else begin
text := specialSimpleName;
end;
font.style := [TFontStyle.fsBold];
drawThemedText(text);
font.style := [];
end;
{ аргументы, возвращаемые значения и прочее }
if item is ClassInit then begin
text := '{ … }';
end else
if item is Callable then with Callable(item) do begin
text := '';
with arguments do for idx := 0 to getLength() - 1 do with readComponent(idx) do begin
if idx > 0 then text := text + ', ';
text := text + typeToString(&type) + ' ' + specialSimpleName;
end;
if item is SpecialMethod then begin
text := '(' + text + ')';
end else begin
text := '(' + text + ') : ' + typeToString(&type);
end;
if item is Method then with Method(item) do for idx := 0 to getThrowablesLength() - 1 do begin
if idx > 0 then begin
text := text + ', ';
end else begin
drawThemedText(text);
font.style := [TFontStyle.fsItalic];
drawThemedText(' throws ');
font.style := [];
text := '';
end;
text := text + typeToString(getThrowableTypeAt(idx));
end;
end else
if item is &Property then with &Property(item) do begin
text := ' : ' + typeToString(&type) + ' ' + specifiersToString();
end else
if item is Field then with Field(item) do begin
text := ' : ' + typeToString(&type);
fval := value;
if fval <> nil then text := text + ' = ' + fval.toString();
end else begin
text := '';
end;
drawThemedText(text);
{ покрывающий тип }
enclosing := parentType;
if enclosing <> items.objects[0] then begin
color0 := graphics.colorToRGB(graphics.clWindowText);
color1 := (color0 and $ff0000 shl 16) + (color0 and $00ff00 shl 8) + (color0 and $0000ff);
color0 := graphics.colorToRGB(graphics.clWindow);
color2 := (color0 and $ff0000 shl 16) + (color0 and $00ff00 shl 8) + (color0 and $0000ff);
color0 := (9 * color1 + 7 * color2) shr 4;
font.color := (int(color0 shr 16) and $ff0000) + (int(color0 shr 8) and $00ff00) + (int(color0) and $0000ff);
drawText(' — ' + typeToString(enclosing));
end;
end else begin
inc(dx0, 1);
drawThemedText(items[index]);
end;
inc(dx0, 1);
{ ширина списка }
if list = classpathList then begin
sw := @fldClasspathListScrollWidth;
li := 0;
end else begin
sw := @fldMembersListScrollWidth;
li := 1;
end;
dx1 := sw^;
sch := dx1 and CoInt.MIN_VALUE;
dx1 := dx1 and CoInt.MAX_VALUE;
if dx1 >= dx0 then exit;
sw^ := dx0 or CoInt.MIN_VALUE;
if sch <> 0 then exit;
forms.application.queueAsyncCall(modifyListScrollWidth, li);
end;
procedure TMainForm.treeKeyPressed(sender: TObject; var key: system.Word; shift: TShiftState);
var
selected: TTreeNode;
begin
selected := (sender as TTreeView).selected;
if (selected <> nil) and (shift * [TShiftStateEnum.ssCtrl, TShiftStateEnum.ssAlt, TShiftStateEnum.ssAltGr] = []) then case key of
lcltype.VK_MULTIPLY: begin
selected.expand(true);
key := 0;
end;
lcltype.VK_SUBTRACT: begin
selected.collapse(false);
key := 0;
end;
lcltype.VK_ADD: begin
selected.expand(false);
key := 0;
end;
end;
end;
procedure TMainForm.classpathSelect(sender: TObject; user: boolean);
var
selectedIndex: int;
selectedFileName: AnsiString;
begin
if user then with classpathList, items do begin
selectedIndex := itemIndex;
if selectedIndex < 0 then exit;
selectedFileName := strings[selectedIndex];
if selectedFileName = fldDefault then selectedFileName := '';
classpathFile.text := selectedFileName;
end;
end;
procedure TMainForm.librariesSelect(sender: TObject);
var
isNeedFill: boolean;
name: AnsiString;
item: ProgrammeItem;
selectedObject: TObject;
selectedNode: TTreeNode;
selectedLibrary: &Library;
begin
selectedNode := librariesTree.selected;
if selectedNode = nil then exit;
selectedObject := TObject(selectedNode.data);
if selectedObject = nil then exit;
fldSelectedTextSourceSimpleFileName := '';
fldSelectedPackageCanonicalName := '';
isNeedFill := false;
item := nil;
if selectedObject is TextSource then begin
fldSelectedTextSourceSimpleFileName := TextSource(selectedObject).fileName;
selectedNode := selectedNode.parent;
selectedObject := TObject(selectedNode.data);
end;
if selectedObject is Package then with RequiredReflectItem(selectedObject) do begin
item := ProgrammeItem(selectedObject);
name := specialCanonicalName;
if name.length <= 0 then name := SYSTEM_PACKAGE_NAME;
fldSelectedPackageCanonicalName := name;
selectedObject := parentLibrary;
isNeedFill := true;
end;
begin
selectedLibrary := selectedObject as &Library;
if item = nil then item := selectedLibrary;
fldSelectedLibraryIndex := fldProjectInstance.libraries.indexOf(selectedLibrary);
end;
fldCurrentDocumentationItemAddress := itemToLinkString(item);
if isNeedFill then begin
fillTypes();
fillMembers();
end;
fillDocumentation();
end;
procedure TMainForm.typesSelect(sender: TObject);
var
selectedObject: TObject;
selectedNode: TTreeNode;
begin
selectedNode := typesTree.selected;
if selectedNode = nil then exit;
selectedObject := TObject(selectedNode.data);
fldSelectedTypeCanonicalName := '';
if selectedObject is &Type then begin
fldSelectedTypeCanonicalName := RequiredReflectItem(selectedObject).specialCanonicalName;
fldCurrentDocumentationItemAddress := itemToLinkString(ProgrammeItem(selectedObject));
fillMembers();
fillDocumentation();
end;
end;
procedure TMainForm.membersSelect(sender: TObject; user: boolean);
var
selectedIndex: int;
selectedObject: TObject;
begin
if user then with membersList, items do begin
selectedIndex := itemIndex;
if selectedIndex < 0 then exit;
fldSelectedMemberFullName := '';
selectedObject := objects[selectedIndex];
if selectedObject is &Type then begin
fldCurrentDocumentationItemAddress := itemToLinkString(ProgrammeItem(selectedObject));
fillDocumentation();
exit;
end;
if selectedObject is Member then begin
fldSelectedMemberFullName := strings[selectedIndex];
fldCurrentDocumentationItemAddress := itemToLinkString(ProgrammeItem(selectedObject));
fillDocumentation();
end;
end;
end;
procedure TMainForm.documentationKeyPressed(sender: TObject; var key: system.Word; shift: TShiftState);
begin
if shift * [TShiftStateEnum.ssShift, TShiftStateEnum.ssCtrl, TShiftStateEnum.ssAlt, TShiftStateEnum.ssAltGr] = [TShiftStateEnum.ssCtrl] then case key of
lcltype.VK_A: begin
commandAction(documentationSelectAllAction);
key := 0;
end;
lcltype.VK_C: begin
commandAction(documentationCopyAction);
key := 0;
end;
end;
end;
procedure TMainForm.documentationPointerDragged(sender: TObject; shift: TShiftState; x, y: int);
begin
if shift * [TShiftStateEnum.ssLeft, TShiftStateEnum.ssMiddle, TShiftStateEnum.ssRight] <> [] then begin
documentationCopyAction.enabled := (sender as THtmlViewer).sectionList.getSelLength() > 0;
end;
end;
procedure TMainForm.documentationSelect(sender: TObject; const ulink: UnicodeString; var handled: boolean);
begin
fldCurrentDocumentationItemAddress := ulink;
fillDocumentation();
handled := true;
end;
procedure TMainForm.documentationCreateImageStream(sender: TObject; const ulink: UnicodeString; var stream: TStream);
var
relativePath: UnicodeString;
reader: ByteReader;
item: ProgrammeItem;
libraryInstance: &Library;
begin
item := linkStringToItem(fldCurrentDocumentationItemAddress);
if item is &Library then begin
libraryInstance := &Library(item);
relativePath := '';
end else
if item is TableItem then begin
libraryInstance := TableItem(item).parentLibrary;
if item is Package then begin
relativePath := (Package(item).specialCanonicalName + '/').toUTF16();
end else
if item is &Type then begin
relativePath := (&Type(item).parentPackage.specialCanonicalName + '/').toUTF16();
end else
if item is Member then begin
relativePath := (Member(item).parentPackage.specialCanonicalName + '/').toUTF16();
end else begin
relativePath := '';
end;
end else begin
libraryInstance := nil;
relativePath := '';
end;
if libraryInstance = fldProjectInstance.project then begin
relativePath := 'src.doc/' + relativePath;
end else begin
relativePath := 'doc/' + relativePath;
end;
if libraryInstance <> nil then with libraryInstance do try
reader := fileSystem.openFileForRead(directoryPath + relativePath + ulink);
stream := TByteReaderStream.create(reader);
except
on exc: IOException do begin
writeMessage(exc.message);
end;
else begin
raise;
end;
end;
end;
procedure TMainForm.documentationDestroyImageStream(sender: TObject; const ulink: UnicodeString; var stream: TStream);
begin
stream.free();
stream := nil;
end;
procedure TMainForm.openRecentProject(sender: TObject);
begin
openProject(fldProjectRecents[(sender as TComponent).tag]);
end;
procedure TMainForm.commandAction(sender: TObject);
var
flg: boolean;
vis: int;
index: int;
pos: int2;
astr: AnsiString;
ustr: UnicodeString;
root: UnicodeString;
controls: TWinControl_Array1d;
recents: UnicodeString_Array1d;
fsys: FileSystem;
tpos: TTabPosition;
control: TWinControl;
begin
{ главное меню }
if (sender = projectOpen) then begin
with projectOpenDialog do begin
if not execute() then exit;
astr := fileName;
end;
openProject(astr);
exit;
end;
if (sender = projectRecentClear) then begin
recents := fldProjectRecents;
&Array.fillStrings(recents, 0, system.length(recents), '');
fillRecentProjects();
exit;
end;
if (sender = projectAutoRefresh) then begin
fldAutoRefresh := TMenuItem(sender).checked;
exit;
end;
if (sender = projectExit) then begin
close();
exit;
end;
if (sender = filtersPublic) then begin
commandAction(typesShowPublicAction);
commandAction(membersShowPublicAction);
exit;
end;
if (sender = filtersProtected) then begin
commandAction(typesShowPublicAction);
commandAction(membersShowProtectedAction);
exit;
end;
if (sender = filtersPackage) then begin
commandAction(typesShowPackageAction);
commandAction(membersShowPackageAction);
exit;
end;
if (sender = filtersText) then begin
commandAction(typesShowTextAction);
commandAction(membersShowTextAction);
exit;
end;
if (sender = filtersPrivate) then begin
commandAction(typesShowTextAction);
commandAction(membersShowPrivateAction);
exit;
end;
if (sender = filtersVisibleFrom) then begin
with fldVisibleFromDialog do begin
pos := Vector.newInt2(self.left, self.top) + Scalar.sar(Vector.newInt2(self.width, self.height) - Vector.newInt2(width, height), 1);
left := pos[0];
top := pos[1];
fillTypesList(fldProjectInstance);
selectedTypeCanonicalName := fldVisibleFromCanonicalName;
if showModal() <> {controls.}mrOK then exit;
astr := selectedTypeCanonicalName;
end;
flg := astr.length > 0;
TMenuItem(sender).checked := flg;
filtersResetVisibility.enabled := flg;
fldVisibleFromCanonicalName := astr;
fillTypes();
fillMembers();
exit;
end;
if (sender = filtersResetVisibility) then begin
filtersVisibleFrom.checked := false;
TMenuItem(sender).enabled := false;
fldVisibleFromCanonicalName := '';
fillTypes();
fillMembers();
exit;
end;
if (sender = filtersResetAll) then begin
filtersVisibleFrom.checked := false;
membersHideFieldsAction.checked := false;
membersHideStaticsAction.checked := false;
membersShowInheritedAction.checked := false;
fldMembersHideFields := false;
fldMembersHideStatics := false;
fldMembersShowInherited := false;
fldVisibleFromCanonicalName := '';
commandAction(typesShowTextAction);
commandAction(membersShowPrivateAction);
exit;
end;
if (sender = helpAboutApp) then begin
with fldAboutDialog do begin
pos := Vector.newInt2(self.left, self.top) + Scalar.sar(Vector.newInt2(self.width, self.height) - Vector.newInt2(width, height), 1);
left := pos[0];
top := pos[1];
showModal();
end;
exit;
end;
{ меню расположения вкладок }
if (sender is TMenuItem) and (TMenuItem(sender).getParentMenu() = pageContainerMenu) then begin
tpos := TTabPosition(TComponent(sender).tag);
fldPageContainerTabPosition := tpos;
controls := fldContainers;
for index := 0 to system.length(controls) - 1 do begin
control := controls[index];
if control is TPageControl then TPageControl(control).tabPosition := tpos;
end;
exit;
end;
{ параметры и зависимости }
if (sender = classpathOthers) then begin
with TControl(sender), clientToScreen(TPoint.create(width, height)) do begin
classpathMenu.popup(x, y);
end;
exit;
end;
{ библиотеки }
if (sender = librariesFlatViewAction) or (sender = librariesTreeViewAction) then begin
TAction(sender).checked := true;
fldPackagesHierarchy := TComponent(sender).tag <> 0;
fillLibraries();
exit;
end;
if (sender = librariesCollapseAllAction) then begin
librariesTree.fullCollapse();
exit;
end;
if (sender = librariesOthers) then begin
with TControl(sender), clientToScreen(TPoint.create(width, height)) do begin
librariesMenu.popup(x, y);
end;
exit;
end;
{ типы }
if (sender = typesForcePublicAction) then begin
if TAction(sender).checked then begin
fldTypesForcePublic := true;
typesShowPublicAction.checked := true;
end else begin
fldTypesForcePublic := false;
case fldTypesVisibility of
AVTOOConstants.VIS_PRIVATE,
AVTOOConstants.RESERVED_SOURCE,
AVTOOConstants.VIS_SOURCE: begin
typesShowTextAction.checked := true;
end;
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE: begin
typesShowPackageAction.checked := true;
end;
else
fldTypesVisibility := AVTOOConstants.VIS_SOURCE;
typesShowTextAction.checked := true;
end;
end;
fillTypes();
exit;
end;
if (sender = typesShowPublicAction) or (sender = typesShowPackageAction) or (sender = typesShowTextAction) then begin
TAction(sender).checked := true;
vis := TComponent(sender).tag;
fldTypesForcePublic := false;
fldTypesVisibility := vis;
typesForcePublicAction.checked := vis >= AVTOOConstants.VIS_PUBLIC;
fillTypes();
exit;
end;
if (sender = typesListViewAction) or (sender = typesTreeViewAction) then begin
TAction(sender).checked := true;
fldTypesHierarchy := TComponent(sender).tag <> 0;
fillTypes();
exit;
end;
if (sender = typesCollapseAllAction) then begin
typesTree.fullCollapse();
exit;
end;
if (sender = typesOthers) then begin
with TControl(sender), clientToScreen(TPoint.create(width, height)) do begin
typesMenu.popup(x, y);
end;
exit;
end;
{ члены }
if (sender = membersForcePublicAction) then begin
if TAction(sender).checked then begin
fldMembersForcePublic := true;
membersShowPublicAction.checked := true;
end else begin
fldMembersForcePublic := false;
case fldMembersVisibility of
-1: begin
membersShowSyntheticAction.checked := true;
end;
AVTOOConstants.VIS_PRIVATE: begin
membersShowPrivateAction.checked := true;
end;
AVTOOConstants.RESERVED_SOURCE,
AVTOOConstants.VIS_SOURCE: begin
membersShowTextAction.checked := true;
end;
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE: begin
membersShowPackageAction.checked := true;
end;
AVTOOConstants.VIS_PROTECTED: begin
membersShowProtectedAction.checked := true;
end;
else
fldMembersVisibility := AVTOOConstants.VIS_PRIVATE;
membersShowPrivateAction.checked := true;
end;
end;
fillMembers();
exit;
end;
if
(sender = membersShowPublicAction) or (sender = membersShowProtectedAction) or (sender = membersShowPackageAction) or
(sender = membersShowTextAction) or (sender = membersShowPrivateAction) or (sender = membersShowSyntheticAction)
then begin
TAction(sender).checked := true;
vis := TComponent(sender).tag;
fldMembersForcePublic := false;
fldMembersVisibility := vis;
membersForcePublicAction.checked := vis >= AVTOOConstants.VIS_PUBLIC;
fillMembers();
exit;
end;
if (sender = membersHideFieldsAction) then begin
fldMembersHideFields := TAction(sender).checked;
fillMembers();
exit;
end;
if (sender = membersHideStaticsAction) then begin
fldMembersHideStatics := TAction(sender).checked;
fillMembers();
exit;
end;
if (sender = membersShowInheritedAction) then begin
fldMembersShowInherited := TAction(sender).checked;
fillMembers();
exit;
end;
if (sender = membersShowCanonicalAction) then begin
fldMembersShowCanonical := TAction(sender).checked;
fldMembersListScrollWidth := 0;
membersList.invalidate();
exit;
end;
if (sender = membersSimpleIconsAction) then begin
fldMembersSimpleIcons := TAction(sender).checked;
fldMembersListScrollWidth := 0;
membersList.invalidate();
exit;
end;
if (sender = membersSortAction) then begin
fldMembersSort := TAction(sender).checked;
fillMembers();
exit;
end;
if (sender = membersOthers) then begin
with TControl(sender), clientToScreen(TPoint.create(width, height)) do begin
membersMenu.popup(x, y);
end;
exit;
end;
{ документация }
if sender = documentationCopyAction then begin
{ метод THtmlViewer.copyToClipboard() нельзя использовать, так как он копирует фрагмент текста от начала текста, а не от начала фрагмента }
astr := documentationView.selText.toUTF8();
if astr.length > 0 then with clipbrd.clipboard() do begin
open();
try
clear();
asText := astr;
finally
close();
end;
end;
exit;
end;
if sender = documentationSelectAllAction then begin
documentationView.selectAll();
exit;
end;
{ --- разделитель команд, которым требуется загруженный проект --- }
begin
fsys := fldProjectFileSystem;
if fsys = nil then exit;
end;
{ параметры и зависимости }
if (sender = classpathOpenAction) then begin
root := fldProjectRootPath + fldProjectDirectory;
with classpathOpenDialog do begin
initialDir := FileSystemRoot.toInternalPath(root).toUTF8();
if not execute() then exit;
ustr := fileName.toUTF16();
end;
clearMessages();
ustr := FileSystemRoot.toObjectPath(ustr);
if not ustr.endsWith(CLASSPATH_EXTENSION) then begin
writeMessage(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'classpath.must-have-extension'));
exit;
end;
if not ustr.startsWith(root) then begin
writeMessage(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'classpath.must-be-in-project-dir'));
exit;
end;
classpathFile.text := fsys.toInternalName(ustr.substring(root.length + 1, ustr.length - UnicodeString(CLASSPATH_EXTENSION).length + 1)).toUTF8();
sender := classpathSelectAction;
{ падение через }
end;
if (sender = classpathSelectAction) or (sender = classpathSelectButton) then begin
fldCurrentClasspathRelativeFileName := fsys.toObjectName(AnsiString(classpathFile.text).toUTF16());
sender := projectRefresh;
{ падение через }
end;
{ приложение }
if (sender = forms.application) then begin
if fldAutoRefresh and not compilePanel.visible and not fldVisibleFromDialog.visible then sender := projectRefresh;
{ падение через }
end;
{ главное меню }
if (sender = projectRefresh) then begin
compileProject();
{ конец последнего действия }
end;
end;
procedure TMainForm.commandHint(sender: TObject);
var
hint: AnsiString;
begin
hint := forms.application.hint;
if hint.length > 0 then begin
status.simpleText := hint;
exit;
end;
if compilePanel.visible then begin
status.simpleText := fldStatusLoading;
exit;
end;
if fldProjectInstance.libraries.getLength() <= 0 then begin
status.simpleText := fldStatusNotLoaded;
exit;
end;
status.simpleText := fldStatusReady;
end;
procedure TMainForm.compileIconUpdate(sender: TObject);
var
index: int;
icons: TGraphic_Array1d;
begin
icons := fldCompileIcons;
index := fldCompileIconFrameIndex;
compileIcon.picture.assign(icons[index]);
fldCompileIconFrameIndex := (index + 1) mod system.length(icons);
end;
procedure TMainForm.compileStartup(sender: TObject);
begin
startupTimer.enabled := false;
compileProject();
end;
procedure TMainForm.destroyContainer(container: TWinControl);
var
index: int;
count: int;
controls: TWinControl_Array1d;
widget: TControl;
cpage: TCustomPage;
parent: TWinControl;
begin
if container = nil then exit;
widget := nil;
if container is TPairContainer then begin
widget := container.controls[0];
if widget is TSplitter then begin
widget := container.controls[1];
end;
end else
if container is TPageContainer then with TPageContainer(container) do begin
count := pageCount;
for index := count - 1 downto 0 do begin
cpage := pages[index];
if cpage.controlCount <= 0 then begin
cpage.free();
dec(count);
continue;
end;
widget := cpage.controls[0];
end;
if count >= 2 then exit;
end;
if widget <> nil then begin
controls := fldContainers;
index := &Array.indexOf(container, controls, 0, 0);
if index >= 0 then controls[index] := nil;
widget.parent := nil;
widget.align := TAlign.alClient;
parent := container.parent;
index := parent.getControlIndex(container);
container.free();
parent.insertControl(widget, index);
parent.invalidate();
end;
end;
function TMainForm.parseDockingString(const str: AnsiString): boolean;
label
break_label0;
var
pos: int;
len: int;
token: AnsiString;
usage: byte_Array1d;
widgets: TWinControl_Array1d;
function fetch(): AnsiString;
var
chr: char;
fetched: AnsiString;
begin
if pos >= len then begin
result := '';
exit;
end;
chr := str[pos + 1];
case chr of
',', '(', ')': begin
inc(pos);
result := chr;
end;
'0'..'9': begin
fetched := chr;
repeat
inc(pos);
if pos >= len then break;
chr := str[pos + 1];
if (chr < '0') or (chr > '9') then break;
fetched := fetched + chr;
until false;
result := fetched;
end;
'A'..'Z', 'a'..'z': begin
fetched := chr;
repeat
inc(pos);
if pos >= len then break;
chr := str[pos + 1];
if ((chr < 'A') or (chr > 'Z')) and ((chr < 'a') or (chr > 'z')) then break;
fetched := fetched + chr;
until false;
result := fetched;
end;
else
result := '';
end;
end;
function checkWidget(const name: AnsiString): boolean;
label
break_label0;
var
index: int;
fullName: AnsiString;
control: TControl;
begin
fullName := name + 'Widget';
begin
for index := 0 to controlCount - 1 do begin
control := controls[index];
if control.name = fullName then goto break_label0;
end;
result := false;
exit;
end;
break_label0:
if not(control is TWinControl) then begin
result := false;
exit;
end;
index := &Array.indexOf(control, widgets, 0, 0);
if (index < 0) or (usage[index] <> 0) then begin
result := false;
exit;
end;
usage[index] := -1;
result := true;
end;
function checkPageContainer(): boolean;
var
index: int;
token: AnsiString;
begin
if fetch() <> '(' then begin
result := false;
exit;
end;
index := 0;
repeat
if not checkWidget(fetch()) then begin
result := false;
exit;
end;
inc(index);
token := fetch();
until token <> ',';
result := (index > 1) and (token = ')');
end;
function checkPairContainer(): boolean;
label
break_label0;
var
index: int;
token: AnsiString;
begin
if fetch() <> '(' then begin
result := false;
exit;
end;
for index := 0 to 1 do begin
token := fetch();
begin
if token = 'pair' then begin
if checkPairContainer() then goto break_label0;
end else
if token = 'page' then begin
if checkPageContainer() then goto break_label0;
end else begin
if checkWidget(token) then goto break_label0;
end;
result := false;
exit;
end;
break_label0:
if fetch() <> ',' then begin
result := false;
exit;
end;
end;
token := fetch();
if (token.length <= 0) or not CoChar.isDigit(token[1]) then begin
result := false;
exit;
end;
token := fetch();
result := ((token = 'h') or (token = 'v')) and (fetch() = ')');
end;
function parseWidget(const name: AnsiString): TWinControl;
var
index: int;
fullName: AnsiString;
control: TControl;
begin
fullName := name + 'Widget';
control := nil;
for index := 0 to controlCount - 1 do begin
control := controls[index];
if control.name = fullName then break;
end;
if not(control is TWinControl) then begin
result := nil;
exit;
end;
result := TWinControl(control);
end;
function parsePageContainer(): TPageContainer;
var
first: TWinControl;
second: TWinControl;
control: TWinControl;
container: TPageContainer;
begin
fetch();
first := nil;
second := nil;
container := nil;
repeat
control := parseWidget(fetch());
if first = nil then begin
first := control;
continue;
end;
if second = nil then begin
second := control;
container := createContainer(first, second);
continue;
end;
container.insertControl(control);
until fetch() <> ',';
container.activePageIndex := 0;
result := container;
end;
function parsePairContainer(): TPairContainer;
var
horizontal: boolean;
index: int;
size: double;
token: AnsiString;
first: TWinControl;
second: TWinControl;
control: TWinControl;
begin
fetch();
first := nil;
second := nil;
for index := 0 to 1 do begin
token := fetch();
if token = 'pair' then begin
control := parsePairContainer();
end else
if token = 'page' then begin
control := parsePageContainer();
end else begin
control := parseWidget(token);
end;
if index = 0 then begin
first := control;
end else begin
second := control;
end;
fetch();
end;
size := CoInt.toDouble(CoInt.parse(fetch())) / 1e6;
horizontal := fetch() = 'h';
fetch();
result := createContainer(first, second, size, horizontal);
end;
begin
len := str.length;
widgets := fldWidgets;
usage := &Array.newByte1d(system.length(widgets));
pos := 0;
token := fetch();
begin
if token = 'pair' then begin
if checkPairContainer() then goto break_label0;
end else
if token = 'page' then begin
if checkPageContainer() then goto break_label0;
end;
result := false;
exit;
end;
break_label0:
if &Array.indexOf(0, usage, 0, 0) >= 0 then begin
result := false;
exit;
end;
pos := token.length;
if token = 'pair' then begin
insertControl(parsePairContainer(), 0);
end else begin
insertControl(parsePageContainer(), 0);
end;
result := true;
end;
function TMainForm.getDockingString(): AnsiString;
function pairContainerToString(container: TPairContainer): AnsiString; forward;
function pageContainerToString(container: TPageContainer): AnsiString; forward;
function controlToString(control: TControl): AnsiString;
var
name: AnsiString;
suffix: AnsiString;
begin
name := control.name;
suffix := 'Widget';
if name.endsWith(suffix) then begin
result := name.substring(1, name.length - suffix.length + 1);
exit;
end;
if control is TPairContainer then begin
result := pairContainerToString(TPairContainer(control));
exit;
end;
if control is TPageContainer then begin
result := pageContainerToString(TPageContainer(control));
exit;
end;
result := '';
end;
function widgetToString(control: TControl): AnsiString;
var
name: AnsiString;
suffix: AnsiString;
begin
name := control.name;
suffix := 'Widget';
if name.endsWith(suffix) then begin
result := name.substring(1, name.length - suffix.length + 1);
exit;
end;
result := '';
end;
function pairContainerToString(container: TPairContainer): AnsiString;
var
layout: AnsiString;
begin
if container.horizontal then begin
layout := 'h';
end else begin
layout := 'v';
end;
result := AnsiString.format('pair(%0%,%1%,%2#06%%3%)', [
CoAnsiString.create(controlToString(container.controls[0])),
CoAnsiString.create(controlToString(container.controls[2])),
CoInt.create(CoDouble.toInt(container.size * 1e6)),
CoAnsiString.create(layout)
]);
end;
function pageContainerToString(container: TPageContainer): AnsiString;
var
index: int;
str: AnsiString;
begin
str := 'page(';
for index := 0 to container.pageCount - 1 do begin
if index > 0 then str := str + ',';
str := str + widgetToString(container.page[index].controls[0]);
end;
result := str + ')';
end;
var
index: int;
control: TControl;
begin
for index := 0 to controlCount - 1 do begin
control := controls[index];
if control is TPairContainer then begin
result := pairContainerToString(TPairContainer(control));
exit;
end;
if control is TPageContainer then begin
result := pageContainerToString(TPageContainer(control));
exit;
end;
end;
result := '';
end;
function TMainForm.createContainer(first, second: TWinControl): TPageContainer;
var
index: int;
containers: TWinControl_Array1d;
parent: TWinControl;
container: TPageContainer;
begin
parent := first.parent;
if parent <> nil then parent.removeControl(first);
parent := second.parent;
if parent <> nil then parent.removeControl(second);
first.hostDockSite := nil;
second.hostDockSite := nil;
container := TPageContainer.create(self);
container.align := TAlign.alClient;
container.multiLine := false;
container.popupMenu := pageContainerMenu;
container.tabPosition := fldPageContainerTabPosition;
container.dockSite := true;
container.useDockManager := false;
container.onGetSiteInfo := siteDockInfo;
container.onDockOver := siteDockOver;
container.onDockDrop := siteDockDrop;
container.insertControl(first);
container.insertControl(second);
container.pageIndex := 1;
containers := fldContainers;
index := &Array.indexOf(nil, containers, 0, 0);
if index >= 0 then containers[index] := container;
result := container;
end;
function TMainForm.createContainer(first, second: TWinControl; size: double; horizontal: boolean): TPairContainer;
var
index: int;
containers: TWinControl_Array1d;
parent: TWinControl;
container: TPairContainer;
begin
parent := first.parent;
if parent <> nil then parent.removeControl(first);
parent := second.parent;
if parent <> nil then parent.removeControl(second);
first.hostDockSite := nil;
second.hostDockSite := nil;
container := TPairContainer.create(self);
container.align := TAlign.alClient;
container.horizontal := horizontal;
container.size := size;
container.dockSite := true;
container.useDockManager := false;
container.onGetSiteInfo := siteDockInfo;
container.onDockOver := siteDockOver;
container.onDockDrop := siteDockDrop;
container.insertControl(first);
container.insertSplitter();
container.insertControl(second);
containers := fldContainers;
index := &Array.indexOf(nil, containers, 0, 0);
if index >= 0 then containers[index] := container;
result := container;
end;
procedure TMainForm.loadUserState();
var
isDefaultLayout: boolean;
index: int;
length: int;
intValue: int;
ustrValue: UnicodeString;
directoryPath: UnicodeString;
pos: int_Array1d;
size: int_Array1d;
recents: UnicodeString_Array1d;
stream: ByteReader;
section: IniSection;
begin
isDefaultLayout := true;
try
directoryPath := FileSystemRoot.getUserConfigDir();
with FileSystemRoot.get(directoryPath), fileSystem do begin
directoryPath := directoryPath.substring(path.length + 1) + 'Malik Elaborarer/avtoo/';
try
with PlainCodec.create() do try
stream := openFileForRead(directoryPath + 'avtb.style.css');
try
loadFromInputStream(stream);
finally
stream.close();
end;
fldDocumentationStyle := getText();
finally
free();
end;
except
{ игнорировать все исключения }
end;
with IniConfig.create() do try
stream := openFileForRead(directoryPath + 'avtb.config.ini');
try
loadFromInputStream(stream);
finally
stream.close();
end;
section := getSection('Window');
if section <> nil then with section do begin
pos := readIntArray('position', [ left, top ]);
size := readIntArray('size', [ width, height ]);
if (system.length(pos) >= 2) and (system.length(size) >= 2) then begin
fldInitialBounds := classes.bounds(pos[0], pos[1], size[0], size[1]);
end;
fldInitialMaximized := readBooleanValue('maximized', false);
if isParameterExists('pagesTabs') then begin
ustrValue := readStringValue('pagesTabs', '').toUTF16();
if ustrValue.equalsIgnoreCase('bottom') then begin
fldPageContainerTabPosition := TTabPosition.tpBottom;
end else
if ustrValue.equalsIgnoreCase('left') then begin
fldPageContainerTabPosition := TTabPosition.tpLeft;
end else
if ustrValue.equalsIgnoreCase('right') then begin
fldPageContainerTabPosition := TTabPosition.tpRight;
end;
end;
if parseDockingString(readStringValue('layout', '')) then begin
isDefaultLayout := false;
end;
end;
section := getSection('Global');
if section <> nil then with section do begin
fldAutoRefresh := readBooleanValue('autoRefresh', false);
fldVisibleFromCanonicalName := readStringValue('visibleFrom', '');
end;
section := getSection('Libraries');
if section <> nil then with section do begin
fldPackagesHierarchy := readBooleanValue('packHierarchy', false);
end;
section := getSection('Types');
if section <> nil then with section do begin
fldTypesForcePublic := readBooleanValue('forcePublic', false);
intValue := readIntValue('visibility', AVTOOConstants.VIS_SOURCE);
if intValue <= AVTOOConstants.VIS_SOURCE then begin
fldTypesVisibility := AVTOOConstants.VIS_SOURCE;
end else
if intValue <= AVTOOConstants.VIS_PACKAGE then begin
fldTypesVisibility := AVTOOConstants.VIS_PACKAGE;
end else begin
fldTypesVisibility := AVTOOConstants.VIS_PUBLIC;
end;
fldTypesHierarchy := readBooleanValue('typeHierarchy', false);
end;
section := getSection('Members');
if section <> nil then with section do begin
fldMembersForcePublic := readBooleanValue('forcePublic', false);
intValue := readIntValue('visibility', AVTOOConstants.VIS_PRIVATE);
if intValue <= -1 then begin
fldMembersVisibility := -1;
end else
if intValue <= AVTOOConstants.VIS_PRIVATE then begin
fldMembersVisibility := AVTOOConstants.VIS_PRIVATE;
end else
if intValue <= AVTOOConstants.VIS_SOURCE then begin
fldMembersVisibility := AVTOOConstants.VIS_SOURCE;
end else
if intValue <= AVTOOConstants.VIS_PACKAGE then begin
fldMembersVisibility := AVTOOConstants.VIS_PACKAGE;
end else
if intValue <= AVTOOConstants.VIS_PROTECTED then begin
fldMembersVisibility := AVTOOConstants.VIS_PROTECTED;
end else begin
fldMembersVisibility := AVTOOConstants.VIS_PUBLIC;
end;
fldMembersHideFields := readBooleanValue('hideFields', false);
fldMembersHideStatics := readBooleanValue('hideStatics', false);
fldMembersShowInherited := readBooleanValue('showInherited', false);
fldMembersShowCanonical := readBooleanValue('showCanonicalNames', false);
fldMembersSimpleIcons := readBooleanValue('simpleIcons', false);
fldMembersSort := readBooleanValue('sorted', false);
end;
section := getSection('Selected');
if section <> nil then with section do begin
fldCurrentClasspathRelativeFileName := readStringValue('classpath', '').toUTF16();
fldSelectedLibraryIndex := readIntValue('library', -1);
fldSelectedPackageCanonicalName := readStringValue('package', '');
fldSelectedTextSourceSimpleFileName := readStringValue('text', '').toUTF16();
fldSelectedTypeCanonicalName := readStringValue('type', '');
fldSelectedMemberFullName := readStringValue('member', '');
fldCurrentDocumentationItemAddress := readStringValue('documentation', '').toUTF16();
end;
finally
free();
end;
end;
except
{ игнорировать все исключения }
end;
if isDefaultLayout then begin
insertControl(
createContainer(
createContainer(
createContainer(
classpathWidget,
createContainer(
librariesWidget,
typesWidget,
0.25, false
),
0.125, false
),
membersWidget,
0.25, true
),
createContainer(
documentationWidget,
messagesWidget,
0.75, false
),
0.75, false
), 0
);
end;
try
directoryPath := FileSystemRoot.getUserLocalDir();
with FileSystemRoot.get(directoryPath), fileSystem do begin
directoryPath := directoryPath.substring(path.length + 1) + 'Malik Elaborarer/avtoo/';
try
with PlainCodec.create() do try
stream := openFileForRead(directoryPath + 'avtb.opened-project.txt');
try
loadFromInputStream(stream);
finally
stream.close();
end;
ustrValue := getText();
finally
free();
end;
ustrValue := FileSystemRoot.toObjectPath(ustrValue);
if ustrValue.length > 0 then begin
if not ustrValue.endsWith('/') then begin
ustrValue := ustrValue + '/';
end;
with FileSystemRoot.get(ustrValue) do begin
fldProjectFileSystem := fileSystem;
index := path.length + 1;
end;
fldProjectRootPath := ustrValue.substring(1, index);
fldProjectDirectory := ustrValue.substring(index);
end;
except
{ игнорировать все исключения }
end;
stream := openFileForRead(directoryPath + 'avtb.recent-projects.txt');
try
with DataInputStream.create(stream), bigEndianDataInput do try
recents := fldProjectRecents;
for index := 0 to system.length(recents) - 1 do begin
ustrValue := readln();
length := ustrValue.length;
if (length <= 0) or (length >= 4096) then break;
recents[index] := ustrValue;
end;
finally
free();
end;
finally
stream.close();
end;
end;
except
{ игнорировать все исключения }
end;
updateCommandsStates();
end;
procedure TMainForm.saveUserState();
var
index: int;
astrValue: AnsiString;
ustrValue: UnicodeString;
directoryPath: UnicodeString;
recents: UnicodeString_Array1d;
stream: ByteWriter;
wstate: TWindowState;
begin
try
directoryPath := FileSystemRoot.getUserConfigDir();
with FileSystemRoot.get(directoryPath), fileSystem do begin
directoryPath := directoryPath.substring(path.length + 1) + 'Malik Elaborarer';
if not isObjectExists(directoryPath) then createDirectory(directoryPath);
directoryPath := directoryPath + '/avtoo';
if not isObjectExists(directoryPath) then createDirectory(directoryPath);
directoryPath := directoryPath + '/';
try
with PlainCodec.create() do try
setText(fldDocumentationStyle);
stream := rewriteFile(directoryPath + 'avtb.style.css');
try
saveToOutputStream(stream);
finally
stream.close();
end;
finally
free();
end;
except
{ игнорировать все исключения }
end;
with IniConfig.create() do try
with addSection('Window') do begin
wstate := windowState;
if wstate = TWindowState.wsNormal then begin
writeIntArray('position', [ left, top ]);
writeIntArray('size', [ width, height ]);
end else begin
writeIntArray('position', [ restoredLeft, restoredTop ]);
writeIntArray('size', [ restoredWidth, restoredHeight ]);
end;
writeBooleanValue('maximized', wstate = TWindowState.wsMaximized);
case fldPageContainerTabPosition of
TTabPosition.tpBottom:
astrValue := 'bottom';
TTabPosition.tpLeft:
astrValue := 'left';
TTabPosition.tpRight:
astrValue := 'right';
else
astrValue := '';
end;
if astrValue.length > 0 then begin
writeStringValue('pagesTabs', astrValue);
end;
writeStringValue('layout', getDockingString());
end;
with addSection('Global') do begin
writeBooleanValue('autoRefresh', fldAutoRefresh);
writeStringValue('visibleFrom', fldVisibleFromCanonicalName);
end;
with addSection('Libraries') do begin
writeBooleanValue('packHierarchy', fldPackagesHierarchy);
end;
with addSection('Types') do begin
writeBooleanValue('forcePublic', fldTypesForcePublic);
writeIntValue('visibility', fldTypesVisibility);
writeBooleanValue('typeHierarchy', fldTypesHierarchy);
end;
with addSection('Members') do begin
writeBooleanValue('forcePublic', fldMembersForcePublic);
writeIntValue('visibility', fldMembersVisibility);
writeBooleanValue('hideFields', fldMembersHideFields);
writeBooleanValue('hideStatics', fldMembersHideStatics);
writeBooleanValue('showInherited', fldMembersShowInherited);
writeBooleanValue('showCanonicalNames', fldMembersShowCanonical);
writeBooleanValue('simpleIcons', fldMembersSimpleIcons);
writeBooleanValue('sorted', fldMembersSort);
end;
with addSection('Selected') do begin
writeStringValue('classpath', fldCurrentClasspathRelativeFileName.toUTF8());
writeIntValue('library', fldSelectedLibraryIndex);
writeStringValue('package', fldSelectedPackageCanonicalName);
writeStringValue('text', fldSelectedTextSourceSimpleFileName.toUTF8());
writeStringValue('type', fldSelectedTypeCanonicalName);
writeStringValue('member', fldSelectedMemberFullName);
writeStringValue('documentation', fldCurrentDocumentationItemAddress.toUTF8());
end;
stream := rewriteFile(directoryPath + 'avtb.config.ini');
try
saveToOutputStream(stream);
finally
stream.close();
end;
finally
free();
end;
end;
except
{ игнорировать все исключения }
end;
try
directoryPath := FileSystemRoot.getUserLocalDir();
with FileSystemRoot.get(directoryPath), fileSystem do begin
directoryPath := directoryPath.substring(path.length + 1) + 'Malik Elaborarer';
if not isObjectExists(directoryPath) then createDirectory(directoryPath);
directoryPath := directoryPath + '/avtoo';
if not isObjectExists(directoryPath) then createDirectory(directoryPath);
directoryPath := directoryPath + '/';
try
with PlainCodec.create() do try
setText(FileSystemRoot.toInternalPath(fldProjectRootPath + fldProjectDirectory));
stream := rewriteFile(directoryPath + 'avtb.opened-project.txt');
try
saveToOutputStream(stream);
finally
stream.close();
end;
finally
free();
end;
except
{ игнорировать все исключения }
end;
stream := rewriteFile(directoryPath + 'avtb.recent-projects.txt');
try
with DataOutputStream.create(stream), bigEndianDataOutput do try
recents := fldProjectRecents;
for index := 0 to system.length(recents) - 1 do begin
ustrValue := recents[index];
if ustrValue.length <= 0 then break;
writeln(ustrValue);
end;
finally
free();
end;
finally
stream.close();
end;
end;
except
{ игнорировать все исключения }
end;
end;
procedure TMainForm.compileProject();
var
index: int;
pos: int2;
control: TControl;
begin
{ очистка виджетов }
clearClasspath();
clearLibraries();
clearTypes();
clearMembers();
clearDocumentation();
clearMessages();
{ запуск быстрой компиляции }
with compilePanel do begin
pos := Scalar.sar(Vector.newInt2(self.width, self.height) - Vector.newInt2(width, height), 1);
left := pos[0];
top := pos[1];
show();
bringToFront();
setFocus();
end;
for index := 0 to controlCount - 1 do begin
control := controls[index];
if (control is TPairContainer) or (control is TPageContainer) then begin
control.enabled := false;
break;
end;
end;
begin
enableActions(false);
fldCompileIconFrameIndex := 0;
compileTimer.enabled := true;
compileIconUpdate(self);
commandHint(self);
end;
(Thread.create(self)).start();
end;
procedure TMainForm.clearClasspath();
begin
classpathFile.text := fldCurrentClasspathRelativeFileName.toUTF8();
classpathList.clear();
end;
procedure TMainForm.clearLibraries();
begin
librariesTree.items.clear();
end;
procedure TMainForm.clearTypes();
begin
typesTree.items.clear();
end;
procedure TMainForm.clearMembers();
begin
membersList.items.clear();
end;
procedure TMainForm.clearDocumentation();
begin
documentationView.loadFromString(fldDocumentationEmpty);
end;
procedure TMainForm.clearMessages();
begin
messagesView.lines.text := fldNameAndVersion;
end;
procedure TMainForm.fillClasspath();
var
found: UnicodeString;
selectedFileName: AnsiString;
defaultDisplayName: AnsiString;
begin
defaultDisplayName := fldDefault;
selectedFileName := fldCurrentClasspathRelativeFileName.toUTF8();
with classpathList, items do begin
fldClasspathListScrollWidth := 0;
scrollWidth := 0;
beginUpdate();
try
clear();
classpathFile.text := selectedFileName;
if selectedFileName.length <= 0 then begin
selectedFileName := defaultDisplayName;
end;
with fldProjectFileSystem.findFirst(fldProjectDirectory) do try
repeat
found := name;
if not directory and isClasspathSourceFileName(found) then begin
found := found.substring(1, found.length - UnicodeString(CLASSPATH_EXTENSION).length + 1);
if found.length <= 0 then begin
insert(0, defaultDisplayName);
continue;
end;
add(found.toUTF8());
end;
until not findNext();
finally
close();
end;
finally
endUpdate();
end;
itemIndex := indexOf(selectedFileName);
end;
end;
procedure TMainForm.fillLibraries();
var
lindex: int;
pindex: int;
sindex: int;
llength: int;
packagesVisibility: int;
displayPackageName: AnsiString;
currentSourceFileNameA: AnsiString;
currentPackageFullName: AnsiString;
selectedPackageFullName: AnsiString;
currentLibraryDirPath: UnicodeString;
currentSourceFileNameU: UnicodeString;
selectedSourceFileName: UnicodeString;
sourceNode: TTreeNode;
packageNode: TTreeNode;
libraryNode: TTreeNode;
selectedNode: TTreeNode;
packageInstance: Package;
libraryInstance: &Library;
projectInstance: &Library;
selectedLibrary: &Library;
sourceInstance: TextSource;
begin
if compilePanel.visible then exit;
lindex := fldSelectedLibraryIndex;
selectedPackageFullName := fldSelectedPackageCanonicalName;
if selectedPackageFullName.length <= 0 then begin
selectedPackageFullName := SYSTEM_PACKAGE_NAME;
end else
if selectedPackageFullName = SYSTEM_PACKAGE_NAME then begin
selectedPackageFullName := '';
end;
selectedSourceFileName := fldSelectedTextSourceSimpleFileName;
with librariesTree, items do begin
selectedNode := nil;
beginUpdate();
try
clear();
with fldProjectInstance, libraries do begin
llength := getLength();
if (lindex >= 0) and (lindex < llength) then begin
selectedLibrary := readComponent(lindex);
end else begin
selectedLibrary := project;
end;
projectInstance := project;
if fldPackagesHierarchy then begin
for lindex := 0 to llength - 1 do begin
libraryInstance := readComponent(lindex);
llength := libraryInstance.getLength();
if llength <= 0 then continue;
if projectInstance = libraryInstance then begin
packagesVisibility := AVTOOConstants.VIS_PRIVATE;
end else
if projectInstance.application then begin
packagesVisibility := AVTOOConstants.VIS_PUBLIC;
end else begin
packagesVisibility := AVTOOConstants.VIS_PROTECTED;
end;
currentLibraryDirPath := libraryInstance.directoryPath;
if currentLibraryDirPath.endsWith('/') then currentLibraryDirPath := currentLibraryDirPath.substring(1, currentLibraryDirPath.length);
libraryNode := nil;
for pindex := 0 to llength - 1 do begin
packageInstance := libraryInstance.readComponent(pindex);
if packageInstance.visibility < packagesVisibility then continue;
currentPackageFullName := packageInstance.specialCanonicalName;
if libraryNode = nil then begin
libraryNode := addChildObject(nil, currentLibraryDirPath.substring(currentLibraryDirPath.lastIndexOf('/') + 1).toUTF8(), libraryInstance);
libraryNode.stateIndex := getIconIndex(libraryInstance);
if selectedLibrary = libraryInstance then selectedNode := libraryNode;
end;
if currentPackageFullName.length <= 0 then begin
packageNode := addChildObject(libraryNode, fldSystemPackage, packageInstance);
end else begin
packageNode := addChildsPackageObject(libraryNode, currentPackageFullName, packageInstance);
end;
packageNode.stateIndex := getIconIndex(packageInstance);
if selectedPackageFullName = currentPackageFullName then selectedNode := packageNode;
end;
if packagesVisibility = AVTOOConstants.VIS_PRIVATE then with projectInstance.sources do for sindex := 0 to getLength() - 1 do begin
sourceInstance := TextSource(Lang.cast(readComponent(sindex), TextSource));
currentSourceFileNameU := sourceInstance.fileName;
currentSourceFileNameA := currentSourceFileNameU.toUTF8();
packageInstance := sourceInstance.owner;
if packageInstance = nil then continue;
if libraryNode = nil then begin
libraryNode := addChildObject(nil, currentLibraryDirPath.substring(currentLibraryDirPath.lastIndexOf('/') + 1).toUTF8(), libraryInstance);
libraryNode.stateIndex := getIconIndex(libraryInstance);
if selectedLibrary = libraryInstance then selectedNode := libraryNode;
end;
packageNode := libraryNode.getPackageNodeForTreeView(packageInstance.specialCanonicalName);
if packageNode.indexOfText(currentSourceFileNameA) >= 0 then continue;
sourceNode := addChildObject(packageNode, currentSourceFileNameA, sourceInstance);
sourceNode.stateIndex := getIconIndex(sourceInstance);
if selectedSourceFileName = currentSourceFileNameU then selectedNode := sourceNode;
end;
end;
end else begin
for lindex := 0 to llength - 1 do begin
libraryInstance := readComponent(lindex);
llength := libraryInstance.getLength();
if llength <= 0 then continue;
if projectInstance = libraryInstance then begin
packagesVisibility := AVTOOConstants.VIS_PRIVATE;
end else
if projectInstance.application then begin
packagesVisibility := AVTOOConstants.VIS_PUBLIC;
end else begin
packagesVisibility := AVTOOConstants.VIS_PROTECTED;
end;
currentLibraryDirPath := libraryInstance.directoryPath;
if currentLibraryDirPath.endsWith('/') then currentLibraryDirPath := currentLibraryDirPath.substring(1, currentLibraryDirPath.length);
libraryNode := nil;
for pindex := 0 to llength - 1 do begin
packageInstance := libraryInstance.readComponent(pindex);
if packageInstance.visibility < packagesVisibility then continue;
currentPackageFullName := packageInstance.specialCanonicalName;
displayPackageName := currentPackageFullName;
if displayPackageName.length <= 0 then displayPackageName := fldSystemPackage;
if libraryNode = nil then begin
libraryNode := addChildObject(nil, currentLibraryDirPath.substring(currentLibraryDirPath.lastIndexOf('/') + 1).toUTF8(), libraryInstance);
libraryNode.stateIndex := getIconIndex(libraryInstance);
if selectedLibrary = libraryInstance then selectedNode := libraryNode;
end;
packageNode := addChildObject(libraryNode, displayPackageName, packageInstance);
packageNode.stateIndex := getIconIndex(packageInstance);
if selectedPackageFullName = currentPackageFullName then selectedNode := packageNode;
end;
if packagesVisibility = AVTOOConstants.VIS_PRIVATE then with projectInstance.sources do for sindex := 0 to getLength() - 1 do begin
sourceInstance := TextSource(Lang.cast(readComponent(sindex), TextSource));
currentSourceFileNameU := sourceInstance.fileName;
currentSourceFileNameA := currentSourceFileNameU.toUTF8();
packageInstance := sourceInstance.owner;
if packageInstance = nil then continue;
if libraryNode = nil then begin
libraryNode := addChildObject(nil, currentLibraryDirPath.substring(currentLibraryDirPath.lastIndexOf('/') + 1).toUTF8(), libraryInstance);
libraryNode.stateIndex := getIconIndex(libraryInstance);
if selectedLibrary = libraryInstance then selectedNode := libraryNode;
end;
packageNode := libraryNode.getPackageNodeForFlatView(packageInstance.specialCanonicalName);
if packageNode.indexOfText(currentSourceFileNameA) >= 0 then continue;
sourceNode := addChildObject(packageNode, currentSourceFileNameA, sourceInstance);
sourceNode.stateIndex := getIconIndex(sourceInstance);
if selectedSourceFileName = currentSourceFileNameU then selectedNode := sourceNode;
end;
end;
end;
customSort(compareLibrariesTreeNodes);
end;
finally
endUpdate();
end;
onSelectionChanged := nil;
selected := selectedNode;
onSelectionChanged := librariesSelect;
end;
end;
procedure TMainForm.fillTypes();
var
typesHierarchy: boolean;
index: int;
typesVisibility: int;
selectedTypeFullName: AnsiString;
selectedPackageFullName: AnsiString;
selectedSourceFileName: UnicodeString;
typeInstance: &Type;
typeNode: TTreeNode;
container: ObjectArray;
selectedNode: TTreeNode;
packageInstance: Package;
projectInstance: &Library;
sourceInstance: TextSource;
buffer: ConcatenatedObjectArray;
visibleFromInstance: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if compilePanel.visible then exit;
typesHierarchy := fldTypesHierarchy;
if fldTypesForcePublic then begin
typesVisibility := AVTOOConstants.VIS_PUBLIC;
end else begin
typesVisibility := fldTypesVisibility;
end;
selectedPackageFullName := fldSelectedPackageCanonicalName;
if selectedPackageFullName.length <= 0 then begin
selectedPackageFullName := SYSTEM_PACKAGE_NAME;
end else
if selectedPackageFullName = SYSTEM_PACKAGE_NAME then begin
selectedPackageFullName := '';
end;
selectedTypeFullName := fldSelectedTypeCanonicalName;
with typesTree, items do begin
selectedNode := nil;
beginUpdate();
try
clear();
with fldProjectInstance do begin
projectInstance := project;
packageInstance := getPackage(selectedPackageFullName);
visibleFromInstance := getClassType(fldVisibleFromCanonicalName);
end;
if packageInstance <> nil then begin
begin
selectedSourceFileName := fldSelectedTextSourceSimpleFileName;
if (selectedSourceFileName.length <= 0) or (packageInstance.parentLibrary <> projectInstance) then begin
container := packageInstance;
end else begin
buffer := fldObjectsBuffer;
buffer.clear();
with projectInstance.sources do for index := 0 to getLength() - 1 do begin
sourceInstance := TextSource(Lang.cast(readComponent(index), TextSource));
if (sourceInstance.owner = packageInstance) and (sourceInstance.fileName = selectedSourceFileName) then begin
buffer.concat(sourceInstance.declared);
end;
end;
container := buffer;
end;
end;
for index := 0 to container.getLength() - 1 do begin
typeInstance := container.readComponent(index) as &Type;
if
not(typeInstance is ru.malik.elaborarer.avtoo.lang.ClassType) or (typeInstance.visibility < typesVisibility) or
(typeInstance is ArrayType) and not isVisibleArray(ArrayType(typeInstance)) or
(visibleFromInstance <> nil) and not typeInstance.isVisibleFrom(visibleFromInstance)
then continue;
if typesHierarchy then begin
typeNode := addChildsClassObject(nil, typeInstance.specialSimpleName, ru.malik.elaborarer.avtoo.lang.ClassType(typeInstance));
end else begin
typeNode := addChildObject(nil, typeInstance.specialSimpleName, typeInstance);
end;
typeNode.stateIndex := getIconIndex(typeInstance);
if selectedTypeFullName = typeInstance.specialCanonicalName then begin
selectedNode := typeNode;
end else repeat
typeNode := typeNode.parent;
if typeNode = nil then break;
typeInstance := TObject(typeNode.data) as &Type;
if selectedTypeFullName = typeInstance.specialCanonicalName then begin
selectedNode := typeNode;
break;
end;
until false;
end;
if typesHierarchy then fullExpand();
customSort(compareTypesTreeNodes);
end;
finally
endUpdate();
end;
onSelectionChanged := nil;
selected := selectedNode;
onSelectionChanged := typesSelect;
end;
end;
procedure TMainForm.fillMembers();
function memberToString(member: Member): AnsiString;
begin
if member is Callable then begin
result := member.specialSimpleName + Callable(member).arguments.toString();
exit;
end;
result := member.specialSimpleName;
end;
var
membersHideFields: boolean;
membersHideStatics: boolean;
mindex: int;
sindex: int;
slength: int;
selectedIndex: int;
membersVisibility: int;
currentMemberFullName: AnsiString;
selectedMemberFullName: AnsiString;
memberInstance: Member;
stringsList: TStringList;
realTypeInstance: ru.malik.elaborarer.avtoo.lang.ClassType;
enclosingInstance: ru.malik.elaborarer.avtoo.lang.ClassType;
superclassInstance: ru.malik.elaborarer.avtoo.lang.ClassType;
visibleFromInstance: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if compilePanel.visible then exit;
membersHideFields := fldMembersHideFields;
membersHideStatics := fldMembersHideStatics;
if fldMembersForcePublic then begin
membersVisibility := AVTOOConstants.VIS_PUBLIC;
end else begin
membersVisibility := fldMembersVisibility;
end;
selectedMemberFullName := fldSelectedMemberFullName;
stringsList := fldStringsBuffer;
with membersList, stringsList do begin
fldMembersListScrollWidth := 0;
scrollWidth := 0;
selectedIndex := -1;
beginUpdate();
try
clear();
with fldProjectInstance do begin
enclosingInstance := getClassType(fldSelectedTypeCanonicalName);
visibleFromInstance := getClassType(fldVisibleFromCanonicalName);
end;
if visibleFromInstance = nil then begin
visibleFromInstance := enclosingInstance;
end;
if enclosingInstance <> nil then begin
selectedIndex := 0;
addObject(enclosingInstance.specialSimpleName, enclosingInstance);
for mindex := 0 to enclosingInstance.getLength() - 1 do begin
memberInstance := enclosingInstance.readComponent(mindex);
if
(memberInstance.specialSimpleName.length > 0) and
((membersVisibility < 0) or (memberInstance.visibility >= membersVisibility) and not memberInstance.isSynthetic()) and
(not membersHideFields or not(memberInstance is Field)) and (not membersHideStatics or not memberInstance.isStatic()) and
memberInstance.isVisibleFrom(visibleFromInstance, enclosingInstance)
then begin
currentMemberFullName := memberToString(memberInstance);
if selectedMemberFullName = currentMemberFullName then selectedIndex := count;
addObject(currentMemberFullName, memberInstance);
end;
end;
if fldMembersShowInherited then begin
if enclosingInstance.isHelper() then begin
superclassInstance := enclosingInstance.getHelperForType();
realTypeInstance := superclassInstance;
end else begin
superclassInstance := enclosingInstance.getSuperclassType();
realTypeInstance := enclosingInstance;
end;
sindex := -1;
slength := realTypeInstance.getSuperservicesLength();
if superclassInstance <> nil then repeat
for mindex := 0 to superclassInstance.getLength() - 1 do begin
memberInstance := superclassInstance.readComponent(mindex);
if
(memberInstance.specialSimpleName.length > 0) and
((membersVisibility < 0) or (memberInstance.visibility >= membersVisibility) and not memberInstance.isSynthetic()) and
(not membersHideFields or not(memberInstance is Field)) and (not membersHideStatics or not memberInstance.isStatic()) and
memberInstance.isVisibleFrom(visibleFromInstance, enclosingInstance) and not contains(memberInstance, enclosingInstance)
then begin
currentMemberFullName := memberToString(memberInstance);
if selectedMemberFullName = currentMemberFullName then selectedIndex := count;
addObject(currentMemberFullName, memberInstance);
end;
end;
if sindex < 0 then begin
superclassInstance := superclassInstance.getSuperclassType();
if superclassInstance = nil then sindex := 0;
end;
if sindex >= 0 then begin
if sindex >= slength then break;
superclassInstance := realTypeInstance.getSuperserviceTypeAt(sindex);
inc(sindex);
end;
until false;
end;
if fldMembersSort then begin
customSort(compareMembersListItems);
if selectedIndex > 0 then selectedIndex := indexOf(selectedMemberFullName);
end;
end;
finally
endUpdate();
end;
items.assign(stringsList);
itemIndex := selectedIndex;
end;
end;
procedure TMainForm.fillDocumentation();
const
LINE_ENDING = #$0a;
var
isClass: boolean;
isMember: boolean;
isLibrary: boolean;
isCallable: boolean;
index: int;
bindex: int;
eindex: int;
length: int;
dimIndex: int;
dimCount: int;
path: AnsiString;
body: UnicodeString;
pack: Package;
retType: &Type;
project: &Library;
item: ProgrammeItem;
programme: TableBuilder;
parent: RequiredReflectItem;
localClass: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if compilePanel.visible then exit;
item := linkStringToItem(fldCurrentDocumentationItemAddress);
messagesView.text := fldPrintedMessage;
programme := fldProjectInstance;
project := programme.project;
if item = nil then begin
item := project;
end;
if item = nil then begin
documentationView.loadFromString(fldDocumentationEmpty);
exit;
end;
body := '';
isClass := item is ru.malik.elaborarer.avtoo.lang.ClassType;
isMember := item is Member;
isLibrary := item is &Library;
if not isLibrary and (isClass or isMember or (item is Package)) then begin
if isClass or isMember then begin
body := body + ('<p class="path">' + LINE_ENDING) + fldDocumentationPathPackage + #$0020;
if isClass then begin
parent := &Type(item).parentPackage;
end else begin
parent := Member(item).parentPackage;
end;
path := parent.specialCanonicalName;
if path.length <= 0 then begin
path := fldSystemPackage;
end;
length := path.length;
bindex := 0;
repeat
inc(bindex);
eindex := path.indexOf('.', bindex);
if eindex < 1 then eindex := length + 1;
pack := programme.getPackage(path.substring(1, eindex));
if bindex > 1 then body := body + '.';
if pack = nil then begin
body := body + path.substring(bindex, eindex).toUTF16();
end else begin
body := body + '<a href="' + itemToLinkString(pack) + '">' + path.substring(bindex, eindex).toUTF16() + '</a>';
end;
bindex := eindex;
until (bindex >= length) or (bindex < 0);
if isMember then begin
parent := Member(item).parentType;
body := body + ', ';
with &Type(parent) do begin
if isHelper() then begin
body := body + fldDocumentationPathHelper;
end else
if isInterface() then begin
body := body + fldDocumentationPathInterface;
end else
if isService() then begin
body := body + fldDocumentationPathService;
end else
if isStruct() then begin
body := body + fldDocumentationPathStruct;
end else begin
body := body + fldDocumentationPathClass;
end;
end;
body := body + #$0020'<a href="' + itemToLinkString(parent) + '">' + parent.specialSimpleName.toUTF16() + '</a>';
end;
body := body + (LINE_ENDING + '</p>');
end;
body := body + ('<h1>' + LINE_ENDING);
if isMember then begin
if item is Field then begin
body := body + fldDocumentationHeadField + #$0020 + item.specialSimpleName.toUTF16();
end else
if item is &Property then begin
body := body + fldDocumentationHeadProperty + #$0020 + item.specialSimpleName.toUTF16();
end else
if item is ClassInit then begin
body := body + fldDocumentationHeadClassInit + #$0020 + Member(item).parentType.specialSimpleName.toUTF16();
end else
if item is InstInit then begin
body := body + fldDocumentationHeadInstInit + #$0020 + Member(item).parentType.specialSimpleName.toUTF16();
end else
if item is &Operator then begin
body := body + fldDocumentationHeadOperator + #$0020 + &Operator(item).symbol.toUTF16();
end else begin
body := body + fldDocumentationHeadMethod + #$0020 + item.specialSimpleName.toUTF16();
end;
end else
if isClass then with &Type(item) do begin
if isHelper() then begin
body := body + fldDocumentationHeadHelper;
end else
if isInterface() then begin
body := body + fldDocumentationHeadInterface;
end else
if isService() then begin
body := body + fldDocumentationHeadService;
end else
if isStruct() then begin
body := body + fldDocumentationHeadStruct;
end else begin
body := body + fldDocumentationHeadClass;
end;
body := body + #$0020 + item.specialSimpleName.toUTF16();
end else begin
path := RequiredReflectItem(item).specialCanonicalName;
if path.length <= 0 then path := fldSystemPackage;
body := body + fldDocumentationHeadPackage + #$0020 + path.toUTF16();
end;
body := body + (LINE_ENDING + '</h1><pre class="declaration">');
case ReflectItem(item).visibility of
AVTOOConstants.VIS_PRIVATE:
body := body + '<span class="keyword">private</span> ';
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE:
body := body + '<span class="keyword">package</span> ';
AVTOOConstants.VIS_PROTECTED:
body := body + '<span class="keyword">protected</span> ';
AVTOOConstants.VIS_PUBLIC:
body := body + '<span class="keyword">public</span> ';
AVTOOConstants.VIS_PUBLISHED:
body := body + '<span class="keyword">published</span> ';
end;
if isMember then begin
with Member(item) do begin
if isStatic() then begin
body := body + '<span class="keyword">static</span> ';
end;
if isFinal() then begin
body := body + '<span class="keyword">final</span> ';
end else
if isAbstract() and not parentType.isInterface() then begin
body := body + '<span class="keyword">abstract</span> ';
end;
end;
if item is ClassInit then begin
body := body + '{ '#$2026' }';
end else begin
isCallable := item is Callable;
if isCallable and Callable(item).isInterrupt() then begin
body := body + '<span class="keyword">interrupt</span> ';
end;
if (item is TypedItem) and not(item is SpecialMethod) then begin
dimCount := 0;
retType := (item as TypedItem).&type;
if retType is ArrayType then with ArrayType(retType) do begin
dimCount := dimensionsCount;
retType := cellType;
end;
if retType is PrimitiveType then begin
body := body + '<span class="primitive">' + retType.specialSimpleName.toUTF16() + '</span>';
end else begin
body := body + '<a href="' + itemToLinkString(retType) + '">' + retType.specialSimpleName.toUTF16() + '</a>';
end;
for dimIndex := 0 to dimCount - 1 do begin
body := body + '[]';
end;
if item is &Operator then with &Operator(item) do begin
body := body + #$0020'operator'#$0020 + symbol.toUTF16();
end else begin
body := body + #$0020 + item.specialSimpleName.toUTF16();
end;
end;
if item is &Property then begin
body := body + #$0020 + &Property(item).specifiersToString().toUTF16();
end else
if isCallable then begin
with Callable(item).arguments do begin
length := getLength();
if length <= 0 then begin
body := body + '()';
end else begin
body := body + ('(' + LINE_ENDING + ' ');
for index := 0 to length - 1 do with Local(readComponent(index)) do begin
if index > 0 then body := body + (',' + LINE_ENDING + ' ');
dimCount := 0;
retType := &type;
if retType is ArrayType then with ArrayType(retType) do begin
dimCount := dimensionsCount;
retType := cellType;
end;
if retType is PrimitiveType then begin
body := body + '<span class="primitive">' + retType.specialSimpleName.toUTF16() + '</span>';
end else begin
body := body + '<a href="' + itemToLinkString(retType) + '">' + retType.specialSimpleName.toUTF16() + '</a>';
end;
for dimIndex := 0 to dimCount - 1 do begin
body := body + '[]';
end;
body := body + #$0020 + specialSimpleName.toUTF16();
end;
body := body + (LINE_ENDING + ')');
end;
end;
if item is Method then with Method(item) do begin
length := getThrowablesLength();
if length > 0 then begin
body := body + (#$0020'<span class="keyword">throws</span>' + LINE_ENDING + ' ');
for index := 0 to length - 1 do begin
if index > 0 then body := body + (',' + LINE_ENDING + ' ');
localClass := getThrowableTypeAt(index);
body := body + '<a href="' + itemToLinkString(localClass) + '">' + localClass.specialSimpleName.toUTF16() + '</a>';
end;
end;
end;
end;
end;
end else
if isClass then with &Type(item) do begin
body := body + '<span class="keyword">';
if isHelper() then begin
body := body + 'helper';
end else
if isInterface() then begin
body := body + 'interface';
end else begin
if isAbstract() then begin
body := body + 'abstract</span> <span class="keyword">';
end else
if isFinal() then begin
body := body + 'final</span> <span class="keyword">';
end;
if isService() then begin
body := body + 'service';
end else
if isStruct() then begin
body := body + 'struct';
end else begin
body := body + 'class';
end;
end;
body := body + '</span> ' + specialSimpleName.toUTF16();
end else begin
path := RequiredReflectItem(item).specialCanonicalName;
if path.length <= 0 then path := SYSTEM_PACKAGE_NAME;
body := body + '<span class="keyword">package</span> ' + path.toUTF16();
end;
body := body + '</pre>';
if isClass then with ru.malik.elaborarer.avtoo.lang.ClassType(item) do begin
if isHelper() then begin
localClass := getHelperForType();
body := body +
('<p class="hierarchy">' + LINE_ENDING) + fldDocumentationHierarchyHelperFor + (#$0020 +
'<code><a href="') + itemToLinkString(localClass) + '">' + localClass.specialSimpleName.toUTF16() + ('</a></code>' + LINE_ENDING + '</p>')
;
end else begin
localClass := getSuperclassType();
if localClass <> nil then begin
body := body + ('<p class="hierarchy">' + LINE_ENDING) + fldDocumentationHierarchyClasses + #$0020;
repeat
body := body + '<code><a href="' + itemToLinkString(localClass) + '">' + localClass.specialSimpleName.toUTF16() + '</a></code>';
localClass := localClass.getSuperclassType();
if localClass = nil then break;
body := body + ', ';
until false;
length := getSuperservicesLength();
if length > 0 then begin
body := body + '<br />' + fldDocumentationHierarchyServices + #$0020;
for index := 0 to length - 1 do begin
if index > 0 then body := body + ', ';
localClass := getSuperserviceTypeAt(index);
body := body + '<code><a href="' + itemToLinkString(localClass) + '">' + localClass.specialSimpleName.toUTF16() + '</a></code>';
end;
end;
body := body + (LINE_ENDING + '</p>');
end;
end;
end;
end;
if (item = project) or (item is ReflectItem) and (TableItem(item).parentLibrary = project) then begin
body := body + getItemDocumentationProject(item);
end else begin
body := body + getItemDocumentationLibrary(item);
end;
documentationView.loadFromString(UnicodeString.format(fldDocumentationTemplate, [ CoUnicodeString.create(fldDocumentationStyle), CoUnicodeString.create(body) ]));
end;
procedure TMainForm.fillRecentProjects();
var
index: int;
text: AnsiString;
found: UnicodeString;
recents: UnicodeString_Array1d;
menu: TMenuItem;
item: TMenuItem;
begin
menu := projectRecentMenu;
for index := menu.count - 3 downto 0 do begin
menu[index].free();
end;
recents := fldProjectRecents;
for index := 0 to system.length(recents) - 1 do begin
found := recents[index];
if found.length <= 0 then begin
projectRecentSeparator.visible := true;
menu.enabled := index > 0;
exit;
end;
if index < 9 then begin
text := '&' + char(index + int('1'));
end else begin
text := '1&0';
end;
item := TMenuItem.create(self);
item.caption := text + '. ' + found.toUTF8();
item.tag := index;
item.onClick := openRecentProject;
menu.insert(index, item);
end;
projectRecentSeparator.visible := true;
menu.enabled := true;
end;
procedure TMainForm.updateCommandsStates();
var
flg: boolean;
ustr: UnicodeString;
begin
ustr := fldProjectRootPath + fldProjectDirectory;
if ustr.length > 0 then begin
ustr := FileSystemRoot.toInternalPath(ustr.substring(1, ustr.length));
caption := fldTitle + ' (' + ustr.toUTF8() + ')';
end;
fillRecentProjects();
flg := fldVisibleFromCanonicalName.length > 0;
projectAutoRefresh.checked := fldAutoRefresh;
filtersVisibleFrom.checked := flg;
filtersResetVisibility.enabled := flg;
case fldPageContainerTabPosition of
TTabPosition.tpRight:
pageContainerTabPositionRight.checked := true;
TTabPosition.tpLeft:
pageContainerTabPositionLeft.checked := true;
TTabPosition.tpBottom:
pageContainerTabPositionBottom.checked := true;
else
pageContainerTabPositionTop.checked := true;
end;
if fldPackagesHierarchy then begin
librariesTreeViewAction.checked := true;
end else begin
librariesFlatViewAction.checked := true;
end;
if fldTypesForcePublic then begin
typesShowPublicAction.checked := true;
end else
case fldTypesVisibility of
AVTOOConstants.VIS_SOURCE:
typesShowTextAction.checked := true;
AVTOOConstants.VIS_PACKAGE:
typesShowPackageAction.checked := true;
else
typesShowPublicAction.checked := true;
end;
if fldTypesHierarchy then begin
typesTreeViewAction.checked := true;
end else begin
typesListViewAction.checked := true;
end;
if fldMembersForcePublic then begin
membersShowPublicAction.checked := true;
end else
case fldMembersVisibility of
-1: membersShowSyntheticAction.checked := true;
AVTOOConstants.VIS_PRIVATE:
membersShowPrivateAction.checked := true;
AVTOOConstants.VIS_SOURCE:
membersShowTextAction.checked := true;
AVTOOConstants.VIS_PACKAGE:
membersShowPackageAction.checked := true;
AVTOOConstants.VIS_PROTECTED:
membersShowProtectedAction.checked := true;
else
membersShowPublicAction.checked := true
end;
membersShowCanonicalAction.checked := fldMembersShowCanonical;
membersSimpleIconsAction.checked := fldMembersSimpleIcons;
updatePanelActionsStates();
end;
procedure TMainForm.updatePanelActionsStates();
begin
typesForcePublicAction.checked := fldTypesForcePublic or (fldTypesVisibility >= AVTOOConstants.VIS_PUBLIC);
membersHideFieldsAction.checked := fldMembersHideFields;
membersHideStaticsAction.checked := fldMembersHideStatics;
membersShowInheritedAction.checked := fldMembersShowInherited;
membersSortAction.checked := fldMembersSort;
membersForcePublicAction.checked := fldMembersForcePublic or (fldMembersVisibility >= AVTOOConstants.VIS_PUBLIC);
end;
procedure TMainForm.enableActions(isEnabled: boolean);
begin
projectOpen.enabled := isEnabled;
with projectRecentMenu do enabled := isEnabled and (count > 2);
projectRefresh.enabled := isEnabled;
filtersVisibleFrom.enabled := isEnabled;
classpathSelectAction.enabled := isEnabled;
classpathOpenAction.enabled := isEnabled;
end;
procedure TMainForm.writeMessage(const msg: AnsiString);
begin
if msg.length > 0 then messagesView.lines.add(msg);
end;
procedure TMainForm.openProject(const internalPath: AnsiString; const classpathName: UnicodeString);
begin
caption := fldTitle + ' (' + internalPath + ')';
openProjectInternal(internalPath.toUTF16(), classpathName);
end;
procedure TMainForm.openProject(const internalPath: UnicodeString; const classpathName: UnicodeString);
begin
caption := fldTitle + ' (' + internalPath.toUTF8() + ')';
openProjectInternal(internalPath, classpathName);
end;
procedure TMainForm.openProjectInternal(const internalPath, classpathName: UnicodeString);
var
index: int;
limit: int;
path: UnicodeString;
root: UnicodeString;
found: UnicodeString;
recents: UnicodeString_Array1d;
fsys: FileSystem;
fsroot: FileSystemRoot;
begin
path := FileSystemRoot.toObjectPath(internalPath);
fsroot := FileSystemRoot.get(path);
root := fsroot.path;
fsys := fsroot.fileSystem;
path := path.substring(root.length + 1);
if not path.endsWith('/') then path := path + '/';
fldSelectedLibraryIndex := -1;
fldProjectRootPath := root;
fldProjectDirectory := path;
fldProjectFileSystem := fsys;
fldCurrentClasspathRelativeFileName := classpathName;
recents := fldProjectRecents;
limit := system.length(recents) - 1;
for index := 0 to limit do begin
found := recents[index];
if (index = limit) or (found.length <= 0) or (found = internalPath) then begin
if index > 0 then &Array.copyStrings(recents, 0, recents, 1, index);
recents[0] := internalPath;
break;
end;
end;
fillRecentProjects();
compileProject();
end;
function TMainForm.readCommandLine(): boolean;
var
length: int;
classpathName: UnicodeString;
projectDirectory: UnicodeString;
workingDirectory: UnicodeString;
commandLine: UnicodeString_Array1d;
currentProcess: Process;
begin
currentProcess := Process.current();
workingDirectory := currentProcess.workingDirectory;
commandLine := currentProcess.commandLine;
length := system.length(commandLine);
if length < 2 then begin
result := false;
exit;
end;
{ чтение аргументов командной строки }
projectDirectory := commandLine[1];
if length < 3 then begin
classpathName := '';
end else begin
classpathName := commandLine[2];
end;
{ папка проекта }
if FileSystemRoot.isInternalPathFull(projectDirectory) then begin
projectDirectory := FileSystemRoot.toObjectPath(projectDirectory);
end else begin
projectDirectory := workingDirectory + FileSystemRoot.get(workingDirectory).fileSystem.toObjectName(projectDirectory);
end;
if projectDirectory.endsWith('/') then begin
projectDirectory := projectDirectory.substring(1, projectDirectory.length);
end;
{ файл параметров проекта }
if classpathName.length > 0 then begin
classpathName := FileSystemRoot.get(projectDirectory).fileSystem.toObjectName(classpathName);
end;
{ открытие проекта }
openProject(FileSystemRoot.toInternalPath(projectDirectory), classpathName);
result := true;
end;
function TMainForm.compareTypesTreeNodes(node1, node2: TTreeNode): int;
begin
result := Locale.getInstance().compare(node1.text.toUTF16(), node2.text.toUTF16());
end;
function TMainForm.compareLibrariesTreeNodes(node1, node2: TTreeNode): int;
const
TYPE_ID_LIBRARY = int(1);
TYPE_ID_PACKAGE = int(2);
TYPE_ID_SOURCE = int(3);
function getTypeId(data: TObject): int;
begin
if data is &Library then begin
result := TYPE_ID_LIBRARY;
exit;
end;
if data is TextSource then begin
result := TYPE_ID_SOURCE;
exit;
end;
result := TYPE_ID_PACKAGE;
end;
var
typeId1: int;
typeId2: int;
str1: UnicodeString;
str2: UnicodeString;
data1: TObject;
data2: TObject;
begin
data1 := TObject(node1.data);
data2 := TObject(node2.data);
typeId1 := getTypeId(data1);
typeId2 := getTypeId(data2);
if typeId1 <> typeId2 then begin
result := typeId1 - typeId2;
exit;
end;
case typeId1 of
TYPE_ID_LIBRARY: begin
result := 0;
exit;
end;
TYPE_ID_SOURCE: begin
str1 := TextSource(data1).fileName;
str2 := TextSource(data2).fileName;
end;
else
if (data1 <> nil) and (data2 <> nil) then begin
str1 := RequiredReflectItem(data1).specialCanonicalName.toUTF16();
str2 := RequiredReflectItem(data2).specialCanonicalName.toUTF16();
end else begin
str1 := node1.text.toUTF16();
str2 := node2.text.toUTF16();
end;
end;
result := Locale.getInstance().compare(str1, str2);
end;
function TMainForm.parsePackageNameProject(const relativePath: AnsiString; sequence: LexemeSequence; position: int; parsed: PackageHolder): int;
var
lastPosition: int;
cname: AnsiString;
project: Programme;
lastPackage: Package;
foundPackage: Package;
begin
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.package') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
parsed.resultPack := nil;
result := position;
exit;
end;
lastPackage := nil;
lastPosition := position;
project := fldProjectInstance;
cname := sequence.getLexemeString(position).toUTF8();
repeat
inc(position);
foundPackage := project.getPackage(cname);
if foundPackage <> nil then begin
lastPackage := foundPackage;
lastPosition := position;
end;
if sequence.getLexemeKind(position) <> AVTOOConstants.D_PERIOD then break;
inc(position);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then break;
cname := cname + '.' + sequence.getLexemeString(position).toUTF8();
until false;
parsed.resultPack := lastPackage;
result := lastPosition;
end;
function TMainForm.parseTypeNameProject(const relativePath: AnsiString; source: TextSource; sequence: LexemeSequence; position: int; parsed: TypeHolder): int;
label
break_label0;
var
length: int;
sname: AnsiString;
cname: AnsiString;
project: Programme;
declared: ClassTypeArray;
foundTypes: ClassType_Array1d;
resultType: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.type') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
parsed.resultType := nil;
result := position;
exit;
end;
project := fldProjectInstance;
begin
sname := sequence.getLexemeString(position).toUTF8();
inc(position);
if source <> nil then begin
{ поиск среди типов в исходном коде }
resultType := source.getDeclaredType(sname);
if resultType <> nil then goto break_label0;
resultType := source.getImportedType(sname);
if resultType <> nil then goto break_label0;
{ поиск в родительском пакете }
resultType := source.owner.getChildType(sname) as ru.malik.elaborarer.avtoo.lang.ClassType;
if resultType <> nil then goto break_label0;
{ поиск среди неявно импортированных типов }
declared := source.declared;
if (declared <> nil) and (declared.getLength() > 0) then begin
foundTypes := source.findImplicitlyImportedTypes(sname, declared.readComponent(0));
length := system.length(foundTypes);
if length > 1 then begin
writeMessage(
AnsiString.format(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.ambiguous.type'), [ CoAnsiString.create(sname) ]) +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultType := nil;
goto break_label0;
end;
if length > 0 then begin
resultType := foundTypes[0];
goto break_label0;
end;
end;
{ поиск в языковом пакете }
resultType := project.getLanguagePackage().getChildType(sname) as ru.malik.elaborarer.avtoo.lang.ClassType;
if resultType <> nil then goto break_label0;
end;
{ распознавание канонического имени типа }
cname := sname.copy();
while sequence.getLexemeKind(position) = AVTOOConstants.D_PERIOD do begin
inc(position);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.type') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultType := nil;
goto break_label0;
end;
cname := cname + '.' + sequence.getLexemeString(position).toUTF8();
inc(position);
resultType := project.getClassType(cname);
if resultType <> nil then goto break_label0;
end;
writeMessage(
AnsiString.format(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.not-found.type'), [ CoAnsiString.create(cname) ]) +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultType := nil;
end;
break_label0:
if not parsed.helpersAllowed and (resultType <> nil) and resultType.isHelper() then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.not-allowed.helpers') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultType := nil;
end;
parsed.resultType := resultType;
result := position;
end;
function TMainForm.parseMemberNameProject(const relativePath: AnsiString; ctype: ClassType; sequence: LexemeSequence; position: int; parsed: ImmediateBuilderItemHolder): int;
label
break_label0,
break_label1,
break_label2;
var
kind: int;
length: int;
dimensions: int;
startPosition: int;
sname: AnsiString;
tname: AnsiString;
buffer: Type_Array1d;
arguments: Type_Array1d;
ptype: &Type;
project: Programme;
source: TextSource;
resultMember: Member;
begin
startPosition := position;
begin
{ распознавание специального простого имени члена }
kind := 0;
case sequence.getLexemeKind(position) of
AVTOOConstants.D_PARENTH_OPENED: begin
sname := AVTOOConstants.SPECNAME_INST_INIT;
end;
AVTOOConstants.D_NAME: begin
sname := sequence.getLexemeString(position).toUTF8();
inc(position);
if sname = 'operator' then begin
begin
kind := sequence.getLexemeKind(position);
case kind of
AVTOOConstants.D_PARENTH_OPENED: begin
inc(position);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_PARENTH_CLOSED then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.closed-parenth') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
inc(position);
kind := AVTOOConstants.INVOKE_VIRTUAL;
goto break_label1;
end;
AVTOOConstants.D_BRACKET_OPENED: begin
inc(position);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_BRACKET_CLOSED then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.closed-bracket') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
inc(position);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_EQUAL then begin
kind := AVTOOConstants.READ_COMPONENT;
goto break_label1;
end;
inc(position);
kind := AVTOOConstants.WRITE_COMPONENT;
goto break_label1;
end;
AVTOOConstants.D_TILDE: begin
inc(position);
kind := AVTOOConstants.O_BIT_NOT;
goto break_label1;
end;
AVTOOConstants.D_SCAL_EQ,
AVTOOConstants.D_SCAL_NE,
AVTOOConstants.D_VECT_LUP,
AVTOOConstants.D_VECT_UUP,
AVTOOConstants.D_VECT_PCK: begin
inc(position);
goto break_label1;
end;
AVTOOConstants.D_AMPERSAND: begin
kind := AVTOOConstants.O_BIT_AND;
end;
AVTOOConstants.D_VERTICAL_LINE: begin
kind := AVTOOConstants.O_BIT_OR;
end;
AVTOOConstants.D_CIRCUMFLEX_ACC: begin
kind := AVTOOConstants.O_BIT_XOR;
end;
AVTOOConstants.D_ASTERISK: begin
kind := AVTOOConstants.O_SCAL_MUL;
end;
AVTOOConstants.D_SOLIDUS: begin
kind := AVTOOConstants.O_SCAL_DIV;
end;
AVTOOConstants.D_PERCENT: begin
kind := AVTOOConstants.O_SCAL_REM;
end;
AVTOOConstants.D_PLUS: begin
kind := AVTOOConstants.O_SCAL_ADD;
end;
AVTOOConstants.D_MINUS: begin
kind := AVTOOConstants.O_SCAL_SUB;
end;
AVTOOConstants.D_TAG_OPENED: begin
kind := AVTOOConstants.O_SCAL_LT;
end;
AVTOOConstants.D_TAG_CLOSED: begin
kind := AVTOOConstants.O_SCAL_GT;
end;
AVTOOConstants.D_SCAL_DIVU,
AVTOOConstants.D_SCAL_REMU,
AVTOOConstants.D_SCAL_SHR,
AVTOOConstants.D_SCAL_SHRU,
AVTOOConstants.D_SCAL_SHL,
AVTOOConstants.D_SCAL_GE,
AVTOOConstants.D_SCAL_LE,
AVTOOConstants.D_VECT_MUL,
AVTOOConstants.D_VECT_DIV,
AVTOOConstants.D_VECT_ADD,
AVTOOConstants.D_VECT_SUB,
AVTOOConstants.D_VECT_SHR,
AVTOOConstants.D_VECT_SHRU,
AVTOOConstants.D_VECT_SHL,
AVTOOConstants.D_VECT_EQ,
AVTOOConstants.D_VECT_NE,
AVTOOConstants.D_VECT_GT,
AVTOOConstants.D_VECT_GE,
AVTOOConstants.D_VECT_LT,
AVTOOConstants.D_VECT_LE,
AVTOOConstants.D_VECT_HMUL,
AVTOOConstants.D_VECT_HMULU,
AVTOOConstants.D_VECT_SADD,
AVTOOConstants.D_VECT_SADDU,
AVTOOConstants.D_VECT_SSUB,
AVTOOConstants.D_VECT_SSUBU: ;
else
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.valid-operator') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
inc(position);
if sequence.getLexemeKind(position) = AVTOOConstants.D_GRAVE_ACCENT then begin
inc(kind, AVTOOConstants.R_DELTA);
inc(position);
end;
end;
break_label1:
sname := &Operator.kindToSpecialSimpleName(kind);
end;
end;
else
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.member') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
parsed.resultItem := nil;
result := position;
exit;
end;
parsed.helpersAllowed := false;
resultMember := ctype.getChildMember(sname);
{ распознавание типов аргументов вызываемого члена }
if (kind <> 0) or (resultMember is Callable) then begin
if sequence.getLexemeKind(position) <> AVTOOConstants.D_PARENTH_OPENED then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.opened-parenth') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
inc(position);
if sequence.getLexemeKind(position) = AVTOOConstants.D_PARENTH_CLOSED then begin
arguments := Type_Array1d(&Array.newTObject1d(0));
inc(position);
case kind of
AVTOOConstants.O_SCAL_ADD:
sname := &Operator.kindToSpecialSimpleName(AVTOOConstants.O_SCAL_POS);
AVTOOConstants.O_SCAL_SUB:
sname := &Operator.kindToSpecialSimpleName(AVTOOConstants.O_SCAL_NEG);
AVTOOConstants.O_VECT_ADD:
sname := &Operator.kindToSpecialSimpleName(AVTOOConstants.O_VECT_POS);
AVTOOConstants.O_VECT_SUB:
sname := &Operator.kindToSpecialSimpleName(AVTOOConstants.O_VECT_NEG);
end;
end else begin
arguments := Type_Array1d(&Array.newTObject1d(AVTOOConstants.LIMIT_ARGUMENTS_LENGTH));
source := TextSource(Lang.cast(ctype.source, TextSource));
project := fldProjectInstance;
length := 0;
repeat
tname := sequence.getLexemeString(position).toUTF8();
begin
ptype := project.getType(tname);
if ptype is PrimitiveType then begin
inc(position);
goto break_label2;
end;
position := parseTypeNameProject(relativePath, source, sequence, position, parsed);
ptype := parsed.resultType;
if ptype = nil then begin
resultMember := nil;
goto break_label0;
end;
end;
break_label2:
dimensions := 0;
while
(dimensions < AVTOOConstants.LIMIT_DIMENSIONS_COUNT) and
(sequence.getLexemeKind(position) = AVTOOConstants.D_BRACKET_OPENED) and
(sequence.getLexemeKind(position + 1) = AVTOOConstants.D_BRACKET_CLOSED)
do begin
ptype := project.acquireArrayType(ptype);
inc(position, 2);
inc(dimensions);
end;
arguments[length] := ptype;
inc(length);
case sequence.getLexemeKind(position) of
AVTOOConstants.D_PARENTH_CLOSED: begin
inc(position);
break;
end;
AVTOOConstants.D_COMMA: begin
if length >= AVTOOConstants.LIMIT_ARGUMENTS_LENGTH then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.too-many.arguments') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
inc(position);
end;
else
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.closed-parenth') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
resultMember := nil;
goto break_label0;
end;
until false;
if length < AVTOOConstants.LIMIT_ARGUMENTS_LENGTH then begin
buffer := Type_Array1d(&Array.newTObject1d(length));
&Array.copyObjects(arguments, 0, buffer, 0, length);
arguments := buffer;
end;
end;
resultMember := ctype.getChildCallable(sname, arguments);
end;
if resultMember = nil then begin
position := startPosition;
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.member') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
end;
end;
break_label0:
parsed.resultItem := resultMember;
result := position;
end;
function TMainForm.parseItemNameProject(const relativePath: AnsiString; sequence: LexemeSequence; position: int; parsed: ImmediateBuilderItemHolder): int;
var
newPosition: int;
sname: AnsiString;
cname: AnsiString;
ptype: &Type;
ppack: Package;
begin
newPosition := parsePackageNameProject(relativePath, sequence, position, parsed);
ppack := parsed.resultPack;
if ppack = nil then begin
position := parseTypeNameProject(relativePath, nil, sequence, position, parsed);
ptype := parsed.resultType;
end else begin
position := newPosition;
if (sequence.getLexemeKind(position) <> AVTOOConstants.D_PERIOD) or (sequence.getLexemeKind(position + 1) <> AVTOOConstants.D_NAME) then begin
result := position;
exit;
end;
inc(position, 2);
sname := sequence.getLexemeString(position - 1).toUTF8();
ptype := ppack.getChildType(sname);
if ptype = nil then begin
cname := ppack.specialCanonicalName + '.' + sname;
writeMessage(
AnsiString.format(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.not-found.type'), [ CoAnsiString.create(cname) ]) +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
parsed.resultType := nil;
result := position;
exit;
end;
parsed.resultType := ptype;
end;
if (ptype is ru.malik.elaborarer.avtoo.lang.ClassType) and (sequence.getLexemeKind(position) = AVTOOConstants.D_POUND_SIGN) then begin
position := parseMemberNameProject(relativePath, ru.malik.elaborarer.avtoo.lang.ClassType(ptype), sequence, position + 1, parsed);
end;
result := position;
end;
function TMainForm.parseItemNameProject(const relativePath: AnsiString; item: ReflectItem; position: int; parsed: ImmediateBuilderItemHolder): int;
label
break_label0;
var
sname: AnsiString;
ptype: &Type;
sequence: LexemeSequence;
begin
sequence := item.documentationContent;
begin
if item is Package then begin
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then begin
writeMessage(
AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'doc.expected.name.type') +
CoAnsiString.LINE_ENDING + fldSource + relativePath +
CoAnsiString.LINE_ENDING + fldLine + CoInt.toString(sequence.getLineIndex(position) + 1) +
CoAnsiString.LINE_ENDING + fldChar + CoInt.toString(sequence.getCharIndex(position) + 1)
);
parsed.resultType := nil;
result := position;
exit;
end;
sname := sequence.getLexemeString(position).toUTF8();
ptype := Package(item).getChildType(sname);
end else
if item is ru.malik.elaborarer.avtoo.lang.ClassType then begin
ptype := ru.malik.elaborarer.avtoo.lang.ClassType(item);
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then goto break_label0;
sname := sequence.getLexemeString(position).toUTF8();
ptype := ptype.parentPackage.getChildType(sname);
end else
if item is Member then begin
ptype := Member(item).parentType;
if sequence.getLexemeKind(position) <> AVTOOConstants.D_NAME then goto break_label0;
sname := sequence.getLexemeString(position).toUTF8();
ptype := ptype.parentPackage.getChildType(sname);
end else begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('item') ]));
end;
if not(ptype is ru.malik.elaborarer.avtoo.lang.ClassType) then begin
result := parseItemNameProject(relativePath, sequence, position, parsed);
exit;
end;
inc(position);
end;
break_label0:
parsed.resultType := ptype;
if sequence.getLexemeKind(position) = AVTOOConstants.D_POUND_SIGN then begin
position := parseMemberNameProject(relativePath, ru.malik.elaborarer.avtoo.lang.ClassType(ptype), sequence, position + 1, parsed);
end;
result := position;
end;
function TMainForm.getItemDocumentationProject(item: ProgrammeItem): UnicodeString;
const
TAG_STATUS_NONE = int(0);
TAG_STATUS_SOLIDUS = int(1);
TAG_STATUS_CORNER_OPENED = int(2);
TAG_STATUS_CORNER_CLOSED = int(3);
TAG_STATUS_NAME_OPENED = int(4);
TAG_STATUS_NAME_CLOSED = int(5);
TAG_STATUS_ATTRIBUTES = int(6);
const
LINE_ENDING = #$0a;
const
LIBRARY_INFO_PATH = 'library-info.avtinfo';
var
isLink: boolean;
isError: boolean;
isQuotes: boolean;
isLibrary: boolean;
isParagraph: boolean;
tagAllowCornerClosed: boolean;
prev: int;
curr: int;
lnlen: int;
index: int;
length: int;
lindex: int;
bindex: int;
eindex: int;
tagLine: int;
tagChar: int;
tagStatus: int;
atTagCurr: int;
atTagNext: int;
openedPres: int;
openedBlocks: int;
relativePath: AnsiString;
text: UnicodeString;
line: UnicodeString;
tagName: UnicodeString;
sectionSee: UnicodeString;
sectionMain: UnicodeString;
sectionParam: UnicodeString;
sectionSince: UnicodeString;
sectionReturn: UnicodeString;
sectionThrows: UnicodeString;
sectionAuthor: UnicodeString;
chars: uchar_Array2d;
lines: UnicodeString_Array1d;
stream: ByteReader;
source: TextSource;
parsed: ReflectItem;
sequence: LexemeSequence;
holder: ImmediateBuilderItemHolder;
begin
isLibrary := false;
sequence := nil;
holder := nil;
try
lines := nil;
source := nil;
relativePath := '';
if item is &Library then begin
{ загрузка документации библиотеки }
relativePath := LIBRARY_INFO_PATH;
try
with &Library(item) do begin
stream := fileSystem.openFileForRead(directoryPath + LIBRARY_INFO_PATH);
end;
try
with PlainCodec.create() do try
loadFromInputStream(stream);
text := getText();
finally
free();
end;
finally
stream.close();
end;
except
on exc: IOException do begin
writeMessage(exc.message);
result := '';
exit;
end;
else begin
raise;
end;
end;
lines := text.split();
length := system.length(lines);
chars := &Array.newUChar2d(length);
for index := 0 to length - 1 do begin
chars[index] := lines[index].toUCharArray();
end;
isLibrary := true;
sequence := LexemeSequence.create();
with DocumentLexer.create() do try
lineEndingEnabled := true;
split(chars, 0, Vector.newInt2(CoInt.MAX_VALUE, CoInt.MAX_VALUE), sequence);
finally
free();
end;
end else
if item is ReflectItem then begin
{ получение документации элемента программы }
source := TextSource(Lang.cast(TableItem(item).source, TextSource));
if source <> nil then relativePath := source.relativePath.toUTF8();
sequence := ReflectItem(item).documentationContent;
end else begin
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('item') ]));
end;
if sequence = nil then begin
result := '';
exit;
end;
{ чтение тела документации }
sectionSee := '';
sectionMain := '';
sectionParam := '';
sectionSince := '';
sectionReturn := '';
sectionThrows := '';
sectionAuthor := '';
holder := ImmediateBuilderItemHolder.create();
length := sequence.getLength();
index := 0;
text := '';
isParagraph := false;
openedBlocks := 0;
prev := AVTOOConstants.D_EOP;
atTagCurr := AVTOOConstants.D_TEXT;
atTagNext := AVTOOConstants.D_TEXT;
repeat
isLink := false;
isQuotes := false;
openedPres := 0;
tagLine := 0;
tagChar := 0;
tagName := '';
tagAllowCornerClosed := true;
tagStatus := TAG_STATUS_NONE;
while index < length do begin
curr := sequence.getLexemeKind(index);
{ вставка пробелов }
if openedPres > 0 then begin
line := '';
lindex := sequence.getLineIndex(index);
if (lines <> nil) and (lindex >= 0) and (lindex < system.length(lines)) then begin
line := lines[lindex];
end else
if (source <> nil) and (lindex >= 0) then with source.lines do if (lindex < getLength()) then begin
line := readComponent(lindex).asUnicodeString();
end;
if prev < 0 then begin
if source <> nil then begin
line := line.trim();
if line.startsWith('*') then begin
line := line.substring(2);
if (line.length > 0) and (line[1] <= #$0020) then line := line.substring(2);
end;
end;
bindex := 0;
eindex := 0;
lnlen := line.length;
while (eindex < lnlen) and (line[eindex + 1] <= #$0020) do inc(eindex);
end else
if prev = AVTOOConstants.D_ALINK then begin
bindex := 0;
eindex := 0;
end else begin
bindex := sequence.getCharIndex(index - 1) + sequence.getLexemeString(index - 1).length;
eindex := sequence.getCharIndex(index);
lnlen := line.length;
if ((bindex or eindex) < 0) or (bindex > lnlen) or (eindex > lnlen) then begin
bindex := 0;
eindex := 0;
end;
end;
if bindex < eindex then begin
text := text + line.substring(bindex + 1, eindex + 1);
end;
end else begin
if
(prev >= 0) and (prev <> AVTOOConstants.D_ALINK) and
(sequence.getCharIndex(index - 1) + sequence.getLexemeString(index - 1).length < sequence.getCharIndex(index))
then begin
text := text + #$0020;
end;
end;
{ определение состояния тага }
case tagStatus of
TAG_STATUS_NONE: begin
if curr = AVTOOConstants.D_TAG_OPENED then begin
tagLine := sequence.getLineIndex(index);
tagChar := sequence.getCharIndex(index);
tagStatus := TAG_STATUS_CORNER_OPENED;
inc(index);
continue;
end;
end;
TAG_STATUS_CORNER_OPENED: begin
if (curr = AVTOOConstants.D_SOLIDUS) and (sequence.getLineIndex(index) = tagLine) and (sequence.getCharIndex(index) = tagChar + 1) then begin
inc(tagChar);
tagStatus := TAG_STATUS_SOLIDUS;
inc(index);
continue;
end;
if (curr = AVTOOConstants.D_NAME) and (sequence.getLineIndex(index) = tagLine) and (sequence.getCharIndex(index) = tagChar + 1) then begin
inc(tagChar);
tagStatus := TAG_STATUS_NAME_OPENED;
tagName := sequence.getLexemeString(index);
end;
end;
TAG_STATUS_SOLIDUS: begin
if (curr = AVTOOConstants.D_NAME) and (sequence.getLineIndex(index) = tagLine) and (sequence.getCharIndex(index) = tagChar + 1) then begin
inc(tagChar);
tagStatus := TAG_STATUS_NAME_CLOSED;
tagName := sequence.getLexemeString(index);
end;
end;
end;
{ обработка тагов }
case tagStatus of
TAG_STATUS_NAME_OPENED: begin
if isHTMLTagBlockElement(tagName) then begin
if isParagraph and (openedBlocks <= 0) then begin
text := text + '</p>';
isParagraph := false;
end;
inc(openedBlocks);
end else
if openedBlocks <= 0 then begin
if not isParagraph then begin
text := text + ('<p>' + LINE_ENDING);
isParagraph := true;
end else
if prev = AVTOOConstants.D_EOP then begin
text := text + ('</p><p>' + LINE_ENDING);
end;
end;
if tagName.equalsIgnoreCase('pre') then inc(openedPres);
if tagName.equalsIgnoreCase('figure') then begin
text := text + '<p class="figure"';
end else
if tagName.equalsIgnoreCase('figcaption') then begin
text := text + '<br';
end else begin
text := text + '<' + tagName;
end;
tagStatus := TAG_STATUS_ATTRIBUTES;
prev := curr;
inc(index);
continue;
end;
TAG_STATUS_NAME_CLOSED: begin
if (openedBlocks > 0) and isHTMLTagBlockElement(tagName) then dec(openedBlocks);
if (openedPres > 0) and tagName.equalsIgnoreCase('pre') then dec(openedPres);
if tagName.equalsIgnoreCase('figure') then begin
text := text + '</p';
end else
if tagName.equalsIgnoreCase('figcaption') then begin
tagAllowCornerClosed := false;
end else begin
text := text + '</' + tagName;
end;
tagStatus := TAG_STATUS_CORNER_CLOSED;
prev := curr;
inc(index);
continue;
end;
TAG_STATUS_ATTRIBUTES: begin
if curr = AVTOOConstants.D_QUOTE then begin
isQuotes := not isQuotes;
end;
if not isQuotes then begin
if curr = AVTOOConstants.D_SOLIDUS then begin
if (openedBlocks > 0) and isHTMLTagBlockElement(tagName) then dec(openedBlocks);
if (openedPres > 0) and tagName.equalsIgnoreCase('pre') then dec(openedPres);
text := text + '/';
tagAllowCornerClosed := true;
tagStatus := TAG_STATUS_CORNER_CLOSED;
prev := curr;
inc(index);
continue;
end;
if curr = AVTOOConstants.D_TAG_CLOSED then begin
if tagName.equalsIgnoreCase('figcaption') then begin
text := text + ' /';
end;
text := text + '>';
tagStatus := TAG_STATUS_NONE;
tagName := '';
prev := curr;
inc(index);
continue;
end;
end;
end;
TAG_STATUS_CORNER_CLOSED: begin
if tagAllowCornerClosed then begin
text := text + '>';
end else begin
tagAllowCornerClosed := true;
end;
tagStatus := TAG_STATUS_NONE;
tagName := '';
if curr = AVTOOConstants.D_TAG_CLOSED then begin
prev := curr;
inc(index);
continue;
end;
end;
end;
{ обработка текста }
if AVTOOConstants.isAtTagDocumentLexeme(curr) and (tagStatus = TAG_STATUS_NONE) then begin
atTagNext := curr;
inc(index);
break;
end;
if not isLink and (curr = AVTOOConstants.D_CURLY_OPENED) and (sequence.getLexemeKind(index + 1) = AVTOOConstants.D_ALINK) then begin
prev := AVTOOConstants.D_ALINK;
inc(index, 2);
isLink := true;
if isLibrary then begin
index := parseItemNameProject(relativePath, sequence, index, holder);
end else begin
index := parseItemNameProject(relativePath, ReflectItem(item), index, holder)
end;
parsed := holder.resultItem as ReflectItem;
if parsed = nil then begin
isError := true;
text := text + '<span class="error">';
continue;
end;
isError := false;
text := text + '<a href="' + itemToLinkString(parsed) + '">';
continue;
end;
if isLink and (curr = AVTOOConstants.D_CURLY_CLOSED) then begin
if isError then begin
text := text + '</span>';
end else begin
text := text + '</a>';
end;
isLink := false;
isError := false;
end else
if curr >= 0 then begin
if (tagStatus = TAG_STATUS_NONE) and (openedBlocks <= 0) then begin
if not isParagraph then begin
text := text + ('<p>' + LINE_ENDING);
isParagraph := true;
end else
if prev = AVTOOConstants.D_EOP then begin
text := text + ('</p><p>' + LINE_ENDING);
end;
end;
text := text + sequence.getLexemeString(index);
end else
if (curr = AVTOOConstants.D_EOL) and ((tagStatus <> TAG_STATUS_NONE) or (openedBlocks > 0) or isParagraph) then begin
text := text + LINE_ENDING;
end;
prev := curr;
inc(index);
end;
if isParagraph and (openedBlocks <= 0) then begin
text := text + '</p>';
isParagraph := false;
end;
{ обновление разделов }
case atTagCurr of
AVTOOConstants.D_TEXT: begin
sectionMain := text;
end;
AVTOOConstants.D_APARAM: begin
sectionParam := sectionParam + text;
end;
AVTOOConstants.D_ARETURN: begin
if sectionReturn.length <= 0 then sectionReturn := text;
end;
AVTOOConstants.D_ATHROWS: begin
sectionThrows := sectionThrows + text;
end;
AVTOOConstants.D_ASINCE: begin
if sectionSince.length <= 0 then sectionSince := text;
end;
AVTOOConstants.D_ASEE: begin
if text.endsWith(LINE_ENDING) then text := text.substring(1, text.length - UnicodeString(LINE_ENDING).length + 1);
sectionSee := sectionSee + text + ('</li>' + LINE_ENDING);
end;
AVTOOConstants.D_AAUTHOR: begin
sectionAuthor := sectionAuthor + text;
end;
end;
{ следующий раздел }
case atTagNext of
AVTOOConstants.D_APARAM: begin
text := ('<p>' + LINE_ENDING + '<code>') + sequence.getLexemeString(index) + '</code> '#$2014' ';
isParagraph := true;
openedBlocks := 0;
prev := AVTOOConstants.D_EOL;
inc(index);
end;
AVTOOConstants.D_ARETURN,
AVTOOConstants.D_ASINCE,
AVTOOConstants.D_AAUTHOR: begin
text := '<p>' + LINE_ENDING;
isParagraph := true;
openedBlocks := 0;
prev := AVTOOConstants.D_EOL;
end;
AVTOOConstants.D_ATHROWS: begin
text := '<p>' + LINE_ENDING + '<code>';
index := parseTypeNameProject(relativePath, source, sequence, index, holder);
parsed := holder.resultType;
if parsed = nil then begin
text := text + '<span class="error">' + fldDocumentationErrorInType + '</span>';
end else begin
text := text + '<a href="' + itemToLinkString(parsed) + '">' + itemToDisplayString(parsed, item) + '</a>';
end;
text := text + '</code> '#$2014' ';
isParagraph := true;
openedBlocks := 0;
prev := AVTOOConstants.D_EOL;
end;
AVTOOConstants.D_ASEE: begin
text := '<li><code>';
if isLibrary then begin
index := parseItemNameProject(relativePath, sequence, index, holder);
end else begin
index := parseItemNameProject(relativePath, ReflectItem(item), index, holder)
end;
parsed := holder.resultItem as ReflectItem;
if parsed = nil then begin
text := text + '<span class="error">' + fldDocumentationErrorInItem + '</span>';
end else begin
text := text + '<a href="' + itemToLinkString(parsed) + '">' + itemToDisplayString(parsed, item) + '</a>';
end;
text := text + '</code>';
isParagraph := false;
openedBlocks := 1;
prev := AVTOOConstants.D_TEXT;
end;
else
break;
end;
atTagCurr := atTagNext;
atTagNext := AVTOOConstants.D_TEXT;
until false;
{ формирование результата }
text := sectionMain;
if sectionParam.length > 0 then begin
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagParam + (LINE_ENDING + '</p>') + sectionParam;
end;
if sectionReturn.length > 0 then begin
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagReturn + (LINE_ENDING + '</p>') + sectionReturn;
end;
if sectionThrows.length > 0 then begin
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagThrows + (LINE_ENDING + '</p>') + sectionThrows;
end;
if sectionSee.length > 0 then begin
sectionSee := ('<ul class="see">' + LINE_ENDING) + sectionSee + '</ul>';
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagSee + (LINE_ENDING + '</p>') + sectionSee;
end;
if sectionSince.length > 0 then begin
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagSince + (LINE_ENDING + '</p>') + sectionSince;
end;
if sectionAuthor.length > 0 then begin
text := text + ('<p class="label">' + LINE_ENDING) + fldDocumentationAtTagAuthor + (LINE_ENDING + '</p>') + sectionAuthor;
end;
result := text;
finally
if isLibrary then sequence.free();
holder.free();
end;
end;
function TMainForm.getItemDocumentationLibrary(item: ProgrammeItem): UnicodeString;
const
LINE_ENDING = #$0a;
begin
result := AnsiString(
'<p>' +
LINE_ENDING + 'Получение документации для зависимостей проекта не может быть реализовано до выпуска генератора документации ПВТ-ОО.' +
LINE_ENDING + '</p>'
).toUTF16();
end;
function TMainForm.itemToLinkString(item: ProgrammeItem): UnicodeString;
var
index: int;
alink: AnsiString;
begin
if item is &Library then with fldProjectInstance, libraries do begin
index := indexOf(&Library(item));
if (index < 0) or (item = project) then begin
result := 'lib:this';
exit;
end;
result := 'lib:' + CoInt.toString(index).toUTF16();
exit;
end;
if item is RequiredReflectItem then begin
result := RequiredReflectItem(item).specialCanonicalName.toUTF16();
exit;
end;
if item is Member then begin
alink := Member(item).parentType.specialCanonicalName + '#';
if not(item is Callable) then begin
result := (alink + item.specialSimpleName).toUTF16();
exit;
end;
if item is ClassInit then begin
result := (alink + 'static').toUTF16();
exit;
end;
if item is &Operator then begin
alink := alink + 'operator' + &Operator(item).symbol;
end else
if not(item is InstInit) then begin
alink := alink + item.specialSimpleName;
end;
alink := alink + '(';
with Callable(item).arguments do for index := 0 to getLength() - 1 do begin
if index > 0 then alink := alink + ',';
alink := alink + readComponent(index).&type.specialCanonicalName;
end;
result := (alink + ')').toUTF16();
exit;
end;
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('item') ]));
end;
function TMainForm.linkStringToItem(const ulink: UnicodeString): ProgrammeItem;
label
break_label0;
const
PREFIX_LIBRARY = AnsiString('lib:');
PREFIX_OPERATOR = AnsiString('operator');
var
kind: int;
lindex: int;
bindex: int;
eindex: int;
alength: int;
llength: int;
name: AnsiString;
alink: AnsiString;
buffer: Type_Array1d;
arguments: Type_Array1d;
foundType: &Type;
foundItem: ProgrammeItem;
foundClass: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
foundItem := nil;
alink := ulink.toUTF8();
with fldProjectInstance do begin
if alink.startsWith(PREFIX_LIBRARY) then begin
try
lindex := CoInt.parse(alink.substring(PREFIX_LIBRARY.length + 1));
with libraries do begin
if (lindex >= 0) and (lindex < getLength()) then begin
foundItem := readComponent(lindex);
end else begin
foundItem := project;
end;
end;
except
foundItem := project;
end;
goto break_label0;
end;
lindex := alink.indexOf('#');
llength := alink.length;
if lindex < 1 then begin
foundItem := getPackage(alink);
if foundItem = nil then foundItem := getClassType(alink);
goto break_label0;
end;
foundClass := getClassType(alink.substring(1, lindex));
if foundClass <> nil then begin
bindex := lindex + 1;
eindex := alink.indexOf('(', bindex);
if eindex < 1 then eindex := llength + 1;
lindex := eindex;
kind := 0;
name := alink.substring(bindex, eindex);
if name.length <= 0 then begin
name := SPECNAME_INST_INIT;
end else
if name = 'static' then begin
name := SPECNAME_CLASS_INIT;
end else
if name.startsWith(PREFIX_OPERATOR) then begin
kind := &Operator.symbolToKind(name.substring(PREFIX_OPERATOR.length + 1));
name := &Operator.kindToSpecialSimpleName(kind);
end;
if lindex - 1 >= llength then begin
foundItem := foundClass.getChildMember(name);
end else begin
arguments := Type_Array1d(&Array.newTObject1d(LIMIT_ARGUMENTS_LENGTH));
alength := 0;
repeat
bindex := lindex + 1;
if bindex >= llength then break;
eindex := alink.indexOf(',', bindex);
if eindex < 1 then eindex := llength;
foundType := getType(alink.substring(bindex, eindex));
if foundType = nil then goto break_label0;
arguments[alength] := foundType;
inc(alength);
lindex := eindex;
until lindex >= llength;
if alength < LIMIT_ARGUMENTS_LENGTH then begin
buffer := Type_Array1d(&Array.newTObject1d(alength));
&Array.copyObjects(arguments, 0, buffer, 0, alength);
arguments := buffer;
end;
if (kind <> 0) and (alength <= 0) then case kind of
O_SCAL_ADD:
name := &Operator.kindToSpecialSimpleName(O_SCAL_POS);
O_SCAL_SUB:
name := &Operator.kindToSpecialSimpleName(O_SCAL_NEG);
O_VECT_ADD:
name := &Operator.kindToSpecialSimpleName(O_VECT_POS);
O_VECT_SUB:
name := &Operator.kindToSpecialSimpleName(O_VECT_NEG);
end;
foundItem := foundClass.getChildCallable(name, arguments);
end;
end;
end;
break_label0:
result := foundItem;
end;
procedure TMainForm.compileEnd(dummy: long);
var
index: int;
control: TControl;
begin
{ остановка быстрой компиляции }
for index := 0 to controlCount - 1 do begin
control := controls[index];
if (control is TPairContainer) or (control is TPageContainer) then begin
control.enabled := true;
TWinControl(control).setFocus();
break;
end;
end;
begin
enableActions(true);
updatePanelActionsStates();
compilePanel.hide();
compileTimer.enabled := false;
commandHint(self);
end;
{ показ выбранного содержимого }
writeMessage(fldCompileMessage);
fldPrintedMessage := messagesView.text;
fillClasspath();
fillLibraries();
fillTypes();
fillMembers();
fillDocumentation();
end;
procedure TMainForm.modifyListScrollWidth(index: long);
var
sw: int;
begin
if index = 0 then begin
sw := fldClasspathListScrollWidth and CoInt.MAX_VALUE;
fldClasspathListScrollWidth := sw;
classpathList.scrollWidth := sw;
exit;
end;
sw := fldMembersListScrollWidth and CoInt.MAX_VALUE;
fldMembersListScrollWidth := sw;
membersList.scrollWidth := sw;
end;
procedure TMainForm.doAddDockClient(client: TControl; const rect: TRect);
begin
end;
constructor TMainForm.create(theOwner: TComponent);
var
index: int;
prev: AnsiString;
name: AnsiString;
itemsIcons: TGraphic_Array1d;
compileIcons: TGraphic_Array1d;
programme: TableBuilder;
begin
inherited create(theOwner);
itemsIcons := TGraphic_Array1d(&Array.newTObject1d(ICON_GROUP_ALL));
prev := '';
for index := 0 to system.length(itemsIcons) - 1 do begin
name := getIconName(index);
if (prev <> name) and isImageResourceExists(name) then begin
itemsIcons[index] := loadImageFromResource(name);
prev := name;
end;
end;
compileIcons := TGraphic_Array1d(&Array.newTObject1d(25));
for index := 0 to system.length(compileIcons) - 1 do begin
compileIcons[index] := loadImageFromResource(AnsiString.format('fast-compile/%0#02%', [ CoInt.create(index) ]));
end;
programme := ImmediateBuilder.create(true, true);
programme.documentationEnabled := true;
programme.documentationLexer.lineEndingEnabled := true;
name := AnsiString.format(AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'title'), [ CoAnsiString.create(AVTOOConstants.getVersion()) ]);
fldSelectedLibraryIndex := -1;
fldPrintedMessage := name;
fldProjectRecents := &Array.newUnicodeString1d(10);
fldProjectInstance := programme;
fldTitle := AResource.readUnitResourceAsAnsiString('', 'title');
fldLine := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.lang.UNIT_NAME, 'property.line');
fldChar := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.lang.UNIT_NAME, 'property.char');
fldSource := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.lang.UNIT_NAME, 'property.source');
fldDefault := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'default');
fldStatusReady := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'status.ready');
fldStatusLoading := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'status.loading');
fldStatusNotLoaded := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'status.not-loaded');
fldSystemPackage := AResource.readUnitResourceAsAnsiString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'system-package');
fldNameAndVersion := name;
fldDocumentationStyle := UResource.readResourceAsUnicodeString(AResource.unitToResourceName(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'style.css'));
fldDocumentationEmpty := UResource.readResourceAsUnicodeString(AResource.unitToResourceName(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'empty.html'));
fldDocumentationTemplate := UResource.readResourceAsUnicodeString(AResource.unitToResourceName(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'template.html'));
fldDocumentationHeadClass := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.class');
fldDocumentationHeadHelper := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.helper');
fldDocumentationHeadStruct := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.struct');
fldDocumentationHeadService := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.service');
fldDocumentationHeadPackage := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.package');
fldDocumentationHeadInterface := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.interface');
fldDocumentationHeadField := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.field');
fldDocumentationHeadMethod := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.method');
fldDocumentationHeadProperty := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.property');
fldDocumentationHeadOperator := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.operator');
fldDocumentationHeadInstInit := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.inst-init');
fldDocumentationHeadClassInit := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.head.class-init');
fldDocumentationHierarchyClasses := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.hierarchy.classes');
fldDocumentationHierarchyServices := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.hierarchy.services');
fldDocumentationHierarchyHelperFor := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.hierarchy.helper');
fldDocumentationPathClass := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.class');
fldDocumentationPathHelper := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.helper');
fldDocumentationPathStruct := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.struct');
fldDocumentationPathService := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.service');
fldDocumentationPathPackage := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.package');
fldDocumentationPathInterface := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.path.interface');
fldDocumentationAtTagSee := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.see');
fldDocumentationAtTagParam := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.param');
fldDocumentationAtTagSince := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.since');
fldDocumentationAtTagReturn := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.return');
fldDocumentationAtTagThrows := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.throws');
fldDocumentationAtTagAuthor := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.label.author');
fldDocumentationErrorInItem := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.error.item');
fldDocumentationErrorInType := UResource.readUnitResourceAsUnicodeString(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, 'html.error.type');
fldItemsIcons := itemsIcons;
fldCompileIcons := compileIcons;
fldVisibleFromDialog := TVisibleFromDialog.create(self);
fldAboutDialog := TAboutDialog.create(self);
fldStringsBuffer := TStringList.create();
fldObjectsBuffer := ConcatenatedObjectArray.create();
end;
destructor TMainForm.destroy;
var
index: int;
icons: TGraphic_Array1d;
begin
icons := fldItemsIcons;
for index := 0 to system.length(icons) - 1 do begin
icons[index].free();
icons[index] := nil;
end;
icons := fldCompileIcons;
for index := 0 to system.length(icons) - 1 do begin
icons[index].free();
icons[index] := nil;
end;
fldProjectInstance.free();
fldVisibleFromDialog.free();
fldAboutDialog.free();
fldStringsBuffer.free();
fldObjectsBuffer.free();
inherited destroy;
end;
procedure TMainForm.afterConstruction();
var
width: int;
height: int;
aindex: int;
lindex: int;
length: int;
widgets: TWinControl_Array1d;
aicons: TGraphic_Array1d;
licons: TImageList;
empty: TCustomBitmap;
icon: TGraphic;
open: TGraphic;
sort: TGraphic;
select: TGraphic;
ellipsis: TGraphic;
showPublic: TGraphic;
hideFields: TGraphic;
hideStatics: TGraphic;
collapseAll: TGraphic;
showInherited: TGraphic;
begin
inherited afterConstruction();
{ значки действий }
open := nil;
sort := nil;
select := nil;
ellipsis := nil;
showPublic := nil;
hideFields := nil;
hideStatics := nil;
collapseAll := nil;
showInherited := nil;
try
open := loadImageFromResource('action.open');
sort := loadImageFromResource('action.sort');
select := loadImageFromResource('action.select');
ellipsis := loadImageFromResource('action.ellipsis');
showPublic := loadImageFromResource('action.show-public');
hideFields := loadImageFromResource('action.hide-fields');
hideStatics := loadImageFromResource('action.hide-statics');
collapseAll := loadImageFromResource('action.collapse-all');
showInherited := loadImageFromResource('action.show-inherited');
classpathSelectButton.glyph.assign(select);
classpathOpenButton.glyph.assign(open);
classpathOthers.glyph.assign(ellipsis);
librariesCollapseAllButton.glyph.assign(collapseAll);
librariesOthers.glyph.assign(ellipsis);
typesCollapseAllButton.glyph.assign(collapseAll);
typesForcePublicButton.glyph.assign(showPublic);
typesOthers.glyph.assign(ellipsis);
membersSortButton.glyph.assign(sort);
membersHideFieldsButton.glyph.assign(hideFields);
membersHideStaticsButton.glyph.assign(hideStatics);
membersForcePublicButton.glyph.assign(showPublic);
membersShowInheritedButton.glyph.assign(showInherited);
membersOthers.glyph.assign(ellipsis);
finally
open.free();
sort.free();
select.free();
ellipsis.free();
showPublic.free();
hideFields.free();
hideStatics.free();
collapseAll.free();
showInherited.free();
end;
{ значки элементов программы }
licons := icons;
aicons := fldItemsIcons;
empty := TBitmap.create();
try
length := system.length(aicons);
for aindex := 0 to length - 1 do begin
icon := aicons[aindex];
if icon <> nil then begin
if licons.count <= 0 then begin
width := icon.width;
height := icon.height;
licons.width := width;
licons.height := height;
empty.setSize(width, height);
inc(height, 2);
classpathList.itemHeight := height;
membersList.itemHeight := height;
for lindex := 0 to length - 1 do licons.add(empty, empty);
end;
licons.replace(aindex, icon as TCustomBitmap, empty);
end;
end;
finally
empty.free();
end;
with documentationView do begin
hScrollBar.height := lclintf.getSystemMetrics(lcltype.SM_CYHSCROLL);
vScrollBar.width := lclintf.getSystemMetrics(lcltype.SM_CXVSCROLL);
end;
{ инициализация данных стыковки }
widgets := [ classpathWidget, librariesWidget, typesWidget, membersWidget, documentationWidget, messagesWidget ];
fldWidgets := widgets;
fldContainers := TWinControl_Array1d(&Array.newTObject1d(system.length(widgets)));
fldPageContainerTabPosition := TTabPosition.tpTop;
{ загрузка состояния окна просмотра }
loadUserState();
{ очистка виджетов }
clearClasspath();
clearLibraries();
clearTypes();
clearMembers();
clearDocumentation();
clearMessages();
{ обновление строки состояния }
commandHint(self);
{ установка событий приложения }
with forms.application do begin
addOnActivateHandler(commandAction);
onHint := commandHint;
end;
end;
procedure TMainForm.beforeDestruction();
begin
{ удаление событий приложения }
with forms.application do begin
onHint := nil;
removeOnActivateHandler(commandAction);
end;
{ сохранение состояния окна просмотра }
saveUserState();
inherited beforeDestruction();
end;
procedure TMainForm.run();
function loadParametersFrom(stream: ByteReader): UnicodeString_Array1d; overload;
var
text: UnicodeString;
decoder: PlainCodec;
begin
decoder := PlainCodec.create();
try
decoder.loadFromInputStream(stream);
text := decoder.getText();
finally
decoder.free();
end;
if text.startsWith(#$feff) then text := text.substring(2);
result := text.split();
end;
function loadParametersFrom(fileSystem: FileSystem; const fileName: UnicodeString): UnicodeString_Array1d; overload;
var
stream: ByteReader;
begin
stream := fileSystem.openFileForRead(fileName);
try
result := loadParametersFrom(stream);
finally
stream.close();
end;
end;
var
isLibrary: boolean;
index: int;
chpos: int;
value: UnicodeString;
prefix: UnicodeString;
parameter: UnicodeString;
projectDirectory: UnicodeString;
libraryDirectory: UnicodeString;
processDirectory: UnicodeString;
parameters: UnicodeString_Array1d;
programme: Project;
projectFileSystem: FileSystem;
libraryFileSystem: FileSystem;
excludes: ru.malik.elaborarer.avtoo.compiler.UnicodeStringArray;
libraries: ru.malik.elaborarer.avtoo.compiler.UnicodeStringArray;
begin
try
fldCompileMessage := '';
try
{ получение экземпляра компилятора }
programme := fldProjectInstance;
programme.clear();
{ папки процесса }
projectDirectory := fldProjectDirectory;
projectFileSystem := fldProjectFileSystem;
processDirectory := FileSystemRoot.toObjectPath(Process.current().commandLine[0]);
processDirectory := processDirectory.substring(1, processDirectory.lastIndexOf('/') + 1);
{ параметры компиляции }
parameters := loadParametersFrom(projectFileSystem, projectDirectory + fldCurrentClasspathRelativeFileName + CLASSPATH_EXTENSION);
{ переменные для хранения параметров компиляции }
isLibrary := false;
excludes := nil;
libraries := nil;
try
excludes := ru.malik.elaborarer.avtoo.compiler.UnicodeStringArray.create();
libraries := ru.malik.elaborarer.avtoo.compiler.UnicodeStringArray.create();
{ чтение параметров компиляции }
for index := 0 to system.length(parameters) - 1 do begin
parameter := parameters[index];
{ комментарии }
chpos := parameter.indexOf(';');
if chpos > 0 then begin
parameter := parameter.substring(1, chpos);
end;
{ параметры компиляции }
chpos := parameter.indexOf('=');
if chpos > 0 then begin
prefix := parameter.substring(1, chpos).trim();
value := parameter.substring(1 + chpos).trim();
if prefix = 'pointer-size' then begin
{ устаревший параметр }
continue;
end;
if prefix = 'library' then begin
isLibrary := (value <> '0') and (value.length > 0);
continue;
end;
if prefix = 'reflect' then begin
{ игнорируемый обозревателем кода параметр }
continue;
end;
end;
{ исключаемые из обработки файлы исходного кода }
prefix := '-';
parameter := parameter.trim();
if parameter.startsWith(prefix) then begin
excludes.append(parameter.substring(prefix.length + 1).trim());
continue;
end;
{ используемые проектом библиотеки }
if parameter.length > 0 then begin
libraries.append(parameter);
end;
end;
{ исключаемые из обработки файлы исходного кода }
with programme.excludes do begin
clear();
for index := 0 to excludes.getLength() - 1 do begin
append(excludes.readComponent(index).asUnicodeString());
end;
end;
{ используемые проектом библиотеки }
for index := 0 to libraries.getLength() - 1 do begin
libraryDirectory := libraries.readComponent(index).asUnicodeString();
if not libraryDirectory.startsWith('/') then libraryDirectory := processDirectory + libraryDirectory;
if not libraryDirectory.endsWith('/') then libraryDirectory := libraryDirectory + '/';
with FileSystemRoot.get(libraryDirectory) do begin
libraryDirectory := libraryDirectory.substring(path.length + 1);
libraryFileSystem := fileSystem;
end;
programme.createLibrary(libraryFileSystem, libraryDirectory, false);
end;
finally
excludes.free();
libraries.free();
end;
{ создание библиотеки проекта }
programme.createLibrary(projectFileSystem, projectDirectory, not isLibrary);
{ компиляция проекта }
programme.compile();
except
on exc: Exception do begin
fldCompileMessage := exc.toString();
end;
end;
finally
forms.application.queueAsyncCall(compileEnd, 0);
end;
end;
class function TMainForm.isVisibleArray(aarray: ArrayType): boolean;
var
ctype: &Type;
begin
ctype := aarray.componentType;
result := (ctype is PrimitiveType) or (ctype is ru.malik.elaborarer.avtoo.lang.ClassType) and (ru.malik.elaborarer.avtoo.lang.ClassType(ctype).getSuperclassType() = nil);
end;
class function TMainForm.isImageResourceExists(const name: AnsiString): boolean;
begin
result := SResource.isResourceExists(getImageResourcePath(name));
end;
class function TMainForm.isHTMLTagBlockElement(const tagName: UnicodeString): boolean;
begin
result :=
(tagName.equalsIgnoreCase('p')) or
(tagName.equalsIgnoreCase('h1')) or
(tagName.equalsIgnoreCase('h2')) or
(tagName.equalsIgnoreCase('h3')) or
(tagName.equalsIgnoreCase('h4')) or
(tagName.equalsIgnoreCase('h5')) or
(tagName.equalsIgnoreCase('h6')) or
(tagName.equalsIgnoreCase('hr')) or
(tagName.equalsIgnoreCase('dl')) or
(tagName.equalsIgnoreCase('dt')) or
(tagName.equalsIgnoreCase('dd')) or
(tagName.equalsIgnoreCase('ol')) or
(tagName.equalsIgnoreCase('ul')) or
(tagName.equalsIgnoreCase('li')) or
(tagName.equalsIgnoreCase('div')) or
(tagName.equalsIgnoreCase('pre')) or
(tagName.equalsIgnoreCase('table')) or
(tagName.equalsIgnoreCase('iframe')) or
(tagName.equalsIgnoreCase('figure')) or
(tagName.equalsIgnoreCase('figcaption')) or
(tagName.equalsIgnoreCase('blockquote'))
;
end;
class function TMainForm.compareMembersListItems(list: TStringList; index1, index2: int): int;
const
TYPE_ID_CLASS = int(-1);
TYPE_ID_STATIC = int(0);
TYPE_ID_INSTANCE = int(6);
TYPE_SID_FIELD = int(0);
TYPE_SID_SPECIAL = int(1);
TYPE_SID_METHOD = int(2);
TYPE_SID_PROPERTY = int(3);
TYPE_SID_DOPERATOR = int(4);
TYPE_SID_ROPERATOR = int(5);
function getTypeId(data: TObject): int;
var
typeId: int;
begin
if data is &Type then begin
result := TYPE_ID_CLASS;
exit;
end;
if data is Member then begin
if Member(data).isStatic() then begin
typeId := TYPE_ID_STATIC;
end else begin
typeId := TYPE_ID_INSTANCE;
end;
if data is Field then begin
result := typeId + TYPE_SID_FIELD;
exit;
end;
if data is SpecialMethod then begin
result := typeId + TYPE_SID_SPECIAL;
exit;
end;
if data is &Property then begin
result := typeId + TYPE_SID_PROPERTY;
exit;
end;
if data is &Operator then begin
if &Operator(data).kind >= AVTOOConstants.R_DELTA then begin
result := typeId + TYPE_SID_ROPERATOR;
exit;
end;
result := typeId + TYPE_SID_DOPERATOR;
exit;
end;
result := typeId + TYPE_SID_METHOD;
exit;
end;
result := CoInt.MIN_VALUE;
end;
label
break_label0;
var
index: int;
length1: int;
length2: int;
typeId1: int;
typeId2: int;
str1: AnsiString;
str2: AnsiString;
type1: &Type;
type2: &Type;
data1: TObject;
data2: TObject;
args1: ArgumentArray;
args2: ArgumentArray;
begin
data1 := list.objects[index1];
data2 := list.objects[index2];
typeId1 := getTypeId(data1);
typeId2 := getTypeId(data2);
if typeId1 <> typeId2 then begin
result := typeId1 - typeId2;
exit;
end;
if typeId1 >= TYPE_ID_CLASS then begin
str1 := ProgrammeItem(data1).specialSimpleName;
str2 := ProgrammeItem(data2).specialSimpleName;
if (data1 is Callable) and (data2 is Callable) and (str1 = str2) then begin
args1 := Callable(data1).arguments;
args2 := Callable(data2).arguments;
length1 := args1.getLength();
length2 := args2.getLength();
for index := 0 to CoInt.min(length1, length2) - 1 do begin
type1 := args1.readComponent(index).&type;
type2 := args2.readComponent(index).&type;
if type1 <> type2 then begin
str1 := type1.specialCanonicalName;
str2 := type2.specialCanonicalName;
goto break_label0;
end;
end;
result := length1 - length2;
exit;
end;
break_label0:
result := Locale.getInstance().compare(str1.toUTF16(), str2.toUTF16());
exit;
end;
result := 0;
end;
class function TMainForm.getIconIndex(item: TObject; options: IconSelectOptions): int;
var
avis: int;
arel: int;
akind: int;
index: int;
begin
if item = nil then begin
result := ICON_GROUP_LIBRARIES + 1;
exit;
end;
if item is &Library then begin
result := ICON_GROUP_LIBRARIES + 0;
exit;
end;
if item is Package then begin
if IconSelectOption.isInactive in options then begin
result := ICON_GROUP_LIBRARIES + 1;
exit;
end;
case ReflectItem(item).visibility of
AVTOOConstants.VIS_PRIVATE,
AVTOOConstants.RESERVED_SOURCE,
AVTOOConstants.VIS_SOURCE,
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE: begin
result := ICON_GROUP_LIBRARIES + 2;
exit;
end;
AVTOOConstants.VIS_PROTECTED: begin
result := ICON_GROUP_LIBRARIES + 3;
exit;
end;
else
result := ICON_GROUP_LIBRARIES + 4;
exit;
end;
end;
if item is TextSource then begin
result := ICON_GROUP_LIBRARIES + 5;
exit;
end;
if item is ru.malik.elaborarer.avtoo.lang.ClassType then with ru.malik.elaborarer.avtoo.lang.ClassType(item) do begin
index := ICON_GROUP_TYPES;
if isHelper() then begin
inc(index, 48);
akind := 4;
end else
if isInterface() then begin
inc(index, 36);
akind := 3;
end else
if isStruct() then begin
inc(index, 24);
akind := 2;
end else
if isService() then begin
inc(index, 12);
akind := 1;
end else begin
akind := 0;
end;
if not(IconSelectOption.isInactive in options) then case visibility of
AVTOOConstants.VIS_PRIVATE,
AVTOOConstants.RESERVED_SOURCE,
AVTOOConstants.VIS_SOURCE: begin
inc(index, 3);
end;
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE: begin
inc(index, 6);
end;
else
inc(index, 9);
end;
if (IconSelectOption.isSimple in options) or (akind >= 3) then begin
result := index;
exit;
end;
if isFinal() then begin
inc(index, 2);
end else
if isAbstract() then begin
inc(index);
end;
result := index;
exit;
end;
if item is Member then with Member(item) do begin
index := ICON_GROUP_MEMBERS;
if item is &Property then begin
inc(index, 180);
akind := 3;
end else
if item is &Operator then begin
inc(index, 240);
akind := 4;
end else
if item is InstInit then begin
inc(index, 60);
akind := 1;
end else
if item is Method then begin
inc(index, 120);
akind := 2;
end else begin
akind := 0;
end;
case visibility of
AVTOOConstants.VIS_PRIVATE: begin
avis := 0;
end;
AVTOOConstants.RESERVED_SOURCE,
AVTOOConstants.VIS_SOURCE: begin
inc(index, 12);
avis := 1;
end;
AVTOOConstants.RESERVED_PACKAGE,
AVTOOConstants.VIS_PACKAGE: begin
inc(index, 24);
avis := 2;
end;
AVTOOConstants.VIS_PROTECTED: begin
inc(index, 36);
avis := 3;
end;
else
inc(index, 48);
avis := 4;
end;
if (akind = 1) or (akind >= 3) and (avis = 0) then begin
result := index;
exit;
end;
if isStatic() then begin
if (item is Callable) and Callable(item).isInterrupt() then begin
inc(index, 9);
arel := 3;
end else begin
inc(index, 6);
arel := 2;
end;
end else begin
if not(IconSelectOption.isSimple in options) and (item is OverriddableMember) and OverriddableMember(item).isOverride() then begin
inc(index, 3);
arel := 1;
end else begin
arel := 0;
end;
end;
if (IconSelectOption.isSimple in options) or (akind = 2) and ((arel >= 2) or (avis = 0)) then begin
result := index;
exit;
end;
if isFinal() then begin
inc(index, 2);
end else
if isAbstract() then begin
inc(index);
end;
result := index;
exit;
end;
result := 0;
end;
class function TMainForm.getIconName(index: int): AnsiString;
var
vis: int;
rel: int;
bind: int;
kind: int;
name: AnsiString;
begin
name := '';
result := '';
if (index >= ICON_GROUP_LIBRARIES) and (index < ICON_GROUP_TYPES) then begin
dec(index, ICON_GROUP_LIBRARIES);
case index of
0: result := 'library';
1: result := 'package.inactive';
2: result := 'package.private';
3: result := 'package.protected';
4: result := 'package.public';
5: result := 'source';
end;
end else
if (index >= ICON_GROUP_TYPES) and (index < ICON_GROUP_MEMBERS) then begin
dec(index, ICON_GROUP_TYPES);
kind := index div 12;
vis := (index mod 12) div 3;
bind := index mod 3;
case kind of
0: name := 'class';
1: name := 'service';
2: name := 'struct';
3: name := 'interface';
4: name := 'helper';
end;
case vis of
0: name := name + '.inactive';
1: name := name + '.source';
2: name := name + '.package';
3: name := name + '.public';
end;
if kind >= 3 then begin
result := name;
exit;
end;
case bind of
0: result := name + '.normal';
1: result := name + '.abstract';
2: result := name + '.final';
end;
end else
if (index >= ICON_GROUP_MEMBERS) and (index < ICON_GROUP_ALL) then begin
dec(index, ICON_GROUP_MEMBERS);
kind := index div 60;
vis := (index mod 60) div 12;
rel := (index mod 12) div 3;
bind := index mod 3;
case kind of
0: name := 'field';
1: name := 'constructor';
2: name := 'method';
3: name := 'property';
4: name := 'operator';
end;
case vis of
0: name := name + '.private';
1: name := name + '.source';
2: name := name + '.package';
3: name := name + '.protected';
4: name := name + '.public';
end;
if (kind = 1) or (kind >= 3) and (vis = 0) then begin
result := name;
exit;
end;
case rel of
0: name := name + '.instance';
1: name := name + '.override';
2: name := name + '.static';
3: name := name + '.interrupt';
end;
if (kind = 2) and ((rel >= 2) or (vis = 0)) then begin
result := name;
exit;
end;
case bind of
0: result := name + '.normal';
1: result := name + '.abstract';
2: result := name + '.final';
end;
end;
end;
class function TMainForm.getImageResourcePath(const name: AnsiString): AnsiString;
begin
result := AResource.unitToResourceName(ru.malik.elaborarer.avtoo.browser.UNIT_NAME, name + '.png');
end;
class function TMainForm.itemToDisplayString(item: ReflectItem; from: ProgrammeItem): UnicodeString;
var
index: int;
mstr: UnicodeString;
parent: RequiredReflectItem;
begin
if item is Package then begin
result := RequiredReflectItem(item).specialCanonicalName.toUTF16();
exit;
end;
if item is &Type then begin
parent := &Type(item).parentPackage;
if
(from = parent) or
(from is &Type) and (&Type(from).parentPackage = parent) or
(from is Member) and (Member(from).parentPackage = parent) or
(parent.specialCanonicalName = AVTOOConstants.PACKNAME_LANG)
then begin
result := item.specialSimpleName.toUTF16();
exit;
end;
result := RequiredReflectItem(item).specialCanonicalName.toUTF16();
exit;
end;
if item is Member then begin
mstr := '';
if not(item is Callable) then begin
mstr := item.specialSimpleName.toUTF16();
end else begin
if item is &Operator then begin
mstr := 'operator ' + &Operator(item).symbol.toUTF16();
end else
if not(item is InstInit) then begin
mstr := item.specialSimpleName.toUTF16();
end;
mstr := mstr + '(';
with Callable(item).arguments do for index := 0 to getLength() - 1 do begin
if index > 0 then mstr := mstr + ', ';
mstr := mstr + itemToDisplayString(readComponent(index).&type, from);
end;
mstr := mstr + ')';
end;
parent := Member(item).parentType;
if
(from = parent) or
(from is Member) and (Member(from).parentType = parent)
then begin
result := mstr;
exit;
end;
result := itemToDisplayString(parent, from) + '.' + mstr;
exit;
end;
raise IllegalArgumentException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'illegal-argument'), [ CoAnsiString.create('item') ]));
end;
class function TMainForm.loadImageFromResource(const name: AnsiString): TGraphic;
var
image: TGraphic;
begin
image := TPortableNetworkGraphic.create();
image.loadFromResourceName(system.hInstance(), getImageResourcePath(name));
result := image;
end;
class procedure TMainForm.createInstance();
var
instance: TMainForm;
begin
forms.application.createForm(self, instance);
end;
class function TMainForm.isClasspathSourceFileName(const fileName: UnicodeString): boolean;
begin
result := fileName.endsWith(CLASSPATH_EXTENSION);
end;
{%endregion}
{%region TPairContainer }
procedure TPairContainer.updateLayout();
var
count: int;
delta: int;
controlSize: int;
containerSize: int;
first: TControl;
second: TControl;
begin
count := controlCount;
if count < 2 then exit;
first := controls[0];
if count > 2 then begin
second := controls[2];
end else begin
second := nil;
end;
if fldHorizontal then begin
containerSize := width;
controlSize := CoDouble.toInt(CoInt.toDouble(containerSize - SPLITTER_SIZE) * fldSize);
if second <> nil then with second.constraints do begin
second.align := TAlign.alNone;
delta := containerSize - controlSize - minWidth - SPLITTER_SIZE;
if delta < 0 then inc(controlSize, delta);
end;
first.width := controlSize;
with controls[1] do begin
left := controlSize;
width := SPLITTER_SIZE;
end;
end else begin
containerSize := height;
controlSize := CoDouble.toInt(CoInt.toDouble(containerSize - SPLITTER_SIZE) * fldSize);
if second <> nil then with second.constraints do begin
second.align := TAlign.alNone;
delta := containerSize - controlSize - minHeight - SPLITTER_SIZE;
if delta < 0 then inc(controlSize, delta);
end;
first.height := controlSize;
with controls[1] do begin
top := controlSize;
height := SPLITTER_SIZE;
end;
end;
if second <> nil then begin
second.align := TAlign.alClient;
end;
if (first is TWinControl) and (second is TWinControl) then begin
TWinControl(first).tabOrder := 0;
TWinControl(second).tabOrder := 1;
end;
end;
procedure TPairContainer.setHorizontal(newHorizontal: boolean);
var
index: int;
length: int;
align: TAlign;
begin
if fldHorizontal <> newHorizontal then begin
fldHorizontal := newHorizontal;
length := controlCount;
if length > 2 then length := 2;
align := getAlign();
for index := 0 to length - 1 do begin
controls[index].align := align;
end;
recalculateConstraints();
end;
end;
procedure TPairContainer.setSize(newSize: double);
begin
if CoDouble.isNaN(newSize) then newSize := 0.5;
if newSize < 0 then newSize := 0;
if newSize > 1 then newSize := 1;
fldSize := newSize;
updateLayout();
splitterMoved(self);
end;
procedure TPairContainer.containerResized(sender: TObject);
begin
updateLayout();
end;
procedure TPairContainer.splitterMoved(sender: TObject);
begin
if controlCount < 2 then exit;
if fldHorizontal then begin
fldSize := CoInt.toDouble(controls[0].width) / CoInt.toDouble(width - SPLITTER_SIZE);
exit;
end;
fldSize := CoInt.toDouble(controls[0].height) / CoInt.toDouble(height - SPLITTER_SIZE);
end;
function TPairContainer.getAlign(): TAlign;
begin
if fldHorizontal then begin
result := TAlign.alLeft;
exit;
end;
result := TAlign.alTop;
end;
procedure TPairContainer.recalculateConstraints();
var
index: int;
computedMinWidth: int;
computedMinHeight: int;
parentControl: TWinControl;
begin
computedMinWidth := 0;
computedMinHeight := 0;
if fldHorizontal then begin
for index := 0 to controlCount - 1 do with controls[index].constraints do begin
inc(computedMinWidth, minWidth);
computedMinHeight := CoInt.max(computedMinHeight, minHeight);
end;
end else begin
for index := 0 to controlCount - 1 do with controls[index].constraints do begin
inc(computedMinHeight, minHeight);
computedMinWidth := CoInt.max(computedMinWidth, minWidth);
end;
end;
with constraints do begin
minWidth := computedMinWidth;
minHeight := computedMinHeight;
end;
parentControl := parent;
if parentControl is TPairContainer then TPairContainer(parentControl).recalculateConstraints();
end;
procedure TPairContainer.doAddDockClient(client: TControl; const rect: TRect);
begin
end;
constructor TPairContainer.create(theOwner: TComponent);
begin
inherited create(theOwner);
fldHorizontal := false;
fldSize := 0.5;
bevelOuter := TPanelBevel.bvNone;
onResize := containerResized;
end;
procedure TPairContainer.invalidate();
begin
updateLayout();
inherited invalidate();
end;
procedure TPairContainer.insertControl(control: TControl; index: int);
begin
if index < 2 then begin
control.align := getAlign();
end else begin
control.align := TAlign.alClient;
end;
inherited insertControl(control, index);
recalculateConstraints();
end;
procedure TPairContainer.removeControl(control: TControl);
begin
inherited removeControl(control);
recalculateConstraints();
end;
procedure TPairContainer.insertSplitter();
var
splitter: TSplitter;
begin
splitter := TSplitter.create(self);
with splitter.constraints do begin
minWidth := SPLITTER_SIZE;
minHeight := SPLITTER_SIZE;
end;
splitter.autoSnap := false;
splitter.setBounds(CoInt.MAX_VALUE, CoInt.MAX_VALUE, SPLITTER_SIZE, SPLITTER_SIZE);
splitter.onMoved := splitterMoved;
insertControl(splitter, 1);
end;
{%endregion}
{%region TPageContainer }
procedure TPageContainer.initDragPage();
begin
fldIsPointerWaitForDrag := false;
fldDraggingPageIndex := -1;
fldDragOverPageIndex := -1;
fldDragOverPageRect := TRect.create(0, 0, 0, 0);
fldDragAfterPageRect := TRect.create(0, 0, 0, 0);
end;
procedure TPageContainer.invalidateRect(const rect: TRect);
begin
lclintf.invalidateRect(handle, @rect, false);
end;
function TPageContainer.getPageIndexForDrag(x, y: int): int;
var
count: int;
index: int;
rect: TRect;
begin
index := indexOfTabAt(x, y);
if index < 0 then begin
count := pageCount - 1;
if count >= 0 then begin
rect := tabRect(count);
case tabPosition of
TTabPosition.tpTop,
TTabPosition.tpBottom:
if (x >= rect.right) and (y >= rect.top) and (y < rect.bottom) then index := count;
else
if (y >= rect.bottom) and (x >= rect.left) and (x < rect.right) then index := count;
end;
end;
end;
result := index;
end;
function TPageContainer.getPageRectEx(pageIndex, x, y: int; out isAfter: boolean): TRect;
var
rect: TRect;
begin
rect := tabRect(pageIndex);
case tabPosition of
TTabPosition.tpTop,
TTabPosition.tpBottom:
isAfter := x >= CoInt.sar(rect.left + rect.right, 1);
else
isAfter := y >= CoInt.sar(rect.top + rect.bottom, 1);
end;
result := rect;
end;
procedure TPageContainer.recalculateConstraints();
var
cindex: int;
pindex: int;
computedMinWidth: int;
computedMinHeight: int;
parentControl: TWinControl;
begin
computedMinWidth := 0;
computedMinHeight := 0;
for pindex := 0 to pageCount - 1 do with pages[pindex] do for cindex := 0 to controlCount - 1 do with controls[cindex].constraints do begin
computedMinWidth := CoInt.max(computedMinWidth, minWidth);
computedMinHeight := CoInt.max(computedMinHeight, minHeight);
end;
with constraints do begin
minWidth := computedMinWidth + RESERVED_WIDTH;
minHeight := computedMinHeight + RESERVED_HEIGHT;
end;
parentControl := parent;
if parentControl is TPairContainer then TPairContainer(parentControl).recalculateConstraints();
end;
procedure TPageContainer.cnNotify(var message: TLMNotify);
var
code: int;
begin
code := int(message.nmHdr^.code);
if ((code = comctrls.TCN_SELCHANGING) or (code = comctrls.TCN_SELCHANGE)) and (dragging() or (fldDraggingPageIndex >= 0)) then begin
cancelDrag();
end else
if (code = comctrls.TCN_SELCHANGING) and not fldIsPointerWaitForDrag then begin
fldPointerPageIndex := indexOfTabAt(screenToClient({controls.}mouse.cursorPos));
end;
inherited cnNotify(message);
end;
procedure TPageContainer.mouseDown(button: TMouseButton; shift: TShiftState; x, y: int);
begin
inherited mouseDown(button, shift, x, y);
if button = TMouseButton.mbLeft then begin
initDragPage();
fldIsPointerWaitForDrag := true;
if fldPointerPageIndex < 0 then begin
fldPointerPageIndex := indexOfTabAt(x, y);
end;
fldTriggerDragAt := Vector.newInt2(
lclintf.getSystemMetrics(lcltype.SM_CXDRAG),
lclintf.getSystemMetrics(lcltype.SM_CYDRAG)
);
fldPointerPressedAt := Vector.newInt2(x, y);
mouseCapture := true;
end;
end;
procedure TPageContainer.mouseMove(shift: TShiftState; x, y: int);
var
pageIndex: int;
difference: int2;
begin
inherited mouseMove(shift, x, y);
pageIndex := fldPointerPageIndex;
if fldIsPointerWaitForDrag and (pageIndex >= 0) then begin
difference := fldPointerPressedAt - Vector.newInt2(x, y);
difference := Vector.mul(difference, Vector.mul(Vector.lt(difference, int2(0)), Vector.newInt2(2, 2)) + Vector.newInt2(1, 1));
if Vector.ge(difference, fldTriggerDragAt) <> 0 then begin
fldIsPointerWaitForDrag := false;
beginDragPage(pageIndex, true);
end;
end;
end;
procedure TPageContainer.mouseUp(button: TMouseButton; shift: TShiftState; x, y: int);
begin
if button = TMouseButton.mbLeft then begin
mouseCapture := false;
initDragPage();
fldPointerPageIndex := -1;
end;
inherited mouseUp(button, shift, x, y);
end;
procedure TPageContainer.dragOver(source: TObject; x, y: int; state: TDragState; var canDrag: boolean);
var
pageAfter: boolean;
lastIsAfter: boolean;
needInvalidate: boolean;
pageIndex: int;
dragIndex: int;
lastOverIndex: int;
lastOverRect: TRect;
lastAfterRect: TRect;
begin
if source <> self then begin
inherited dragOver(source, x, y, state, canDrag);
exit;
end;
dragIndex := fldDraggingPageIndex;
pageIndex := getPageIndexForDrag(x, y);
canDrag := (pageIndex >= 0) and (pageIndex <> dragIndex);
if ((state = TDragState.dsDragLeave) or (pageIndex < 0)) and (fldDragOverPageIndex >= 0) then begin
invalidateRect(fldDragOverPageRect);
invalidateRect(fldDragAfterPageRect);
fldDragOverPageIndex := -1;
end;
if pageIndex < 0 then exit;
lastIsAfter := fldIsDragAfterPage;
lastOverIndex := fldDragOverPageIndex;
lastOverRect := fldDragOverPageRect;
lastAfterRect := fldDragAfterPageRect;
fldDragOverPageIndex := pageIndex;
fldDragOverPageRect := getPageRectEx(pageIndex, x, y, pageAfter);
if pageIndex = dragIndex - 1 then pageAfter := false;
if pageIndex = dragIndex + 1 then pageAfter := true;
fldIsDragAfterPage := pageAfter;
needInvalidate := (pageIndex <> lastOverIndex) or (pageAfter <> lastIsAfter);
if pageAfter then begin
inc(pageIndex);
if pageIndex < pageCount then fldDragAfterPageRect := tabRect(pageIndex);
end else begin
dec(pageIndex);
if pageIndex >= 0 then fldDragAfterPageRect := tabRect(pageIndex);
end;
if needInvalidate then begin
invalidateRect(lastOverRect);
invalidateRect(lastAfterRect);
invalidateRect(fldDragOverPageRect);
invalidateRect(fldDragAfterPageRect);
end;
if not canDrag or (state = TDragState.dsDragLeave) then begin
invalidateRect(fldDragOverPageRect);
invalidateRect(fldDragAfterPageRect);
fldDragOverPageIndex := -1;
end;
end;
procedure TPageContainer.dragCanceled();
begin
inherited dragCanceled();
if fldDragOverPageIndex >= 0 then begin
invalidateRect(fldDragOverPageRect);
invalidateRect(fldDragAfterPageRect);
end;
fldDragOverPageIndex := -1;
end;
procedure TPageContainer.captureChanged();
begin
fldPointerPageIndex := -1;
fldIsPointerWaitForDrag := false;
inherited captureChanged();
end;
procedure TPageContainer.paintWindow(dc: HDC);
procedure drawLeftArrow(const rect: TRect);
var
s: int;
y: int;
verts: int2_Array1d;
begin
s := CoInt.min(
CoInt.sar(Math.abs(rect.bottom - rect.top) - 4, 1),
CoInt.sar(Math.abs(rect.left - rect.right) - 4, 1)
);
y := CoInt.sar(rect.bottom + rect.top, 1);
verts := [
Vector.newInt2(rect.left + s + 2, y - s),
Vector.newInt2(rect.left + s + 2, y + s),
Vector.newInt2(rect.left + 2, y),
0
];
verts[3] := verts[0];
lclintf.polygon(dc, Pointer(verts), system.length(verts), false);
end;
procedure drawRightArrow(const rect: TRect);
var
s: int;
y: int;
verts: int2_Array1d;
begin
s := CoInt.min(
CoInt.sar(Math.abs(rect.bottom - rect.top) - 4, 1),
CoInt.sar(Math.abs(rect.left - rect.right) - 4, 1)
);
y := CoInt.sar(rect.bottom + rect.top, 1);
verts := [
Vector.newInt2(rect.right - s - 2, y - s),
Vector.newInt2(rect.right - s - 2, y + s),
Vector.newInt2(rect.right - 2, y),
0
];
verts[3] := verts[0];
lclintf.polygon(dc, Pointer(verts), system.length(verts), false);
end;
procedure drawTopArrow(const rect: TRect);
var
s: int;
x: int;
verts: int2_Array1d;
begin
s := CoInt.min(
CoInt.sar(Math.abs(rect.bottom - rect.top) - 4, 1),
CoInt.sar(Math.abs(rect.left - rect.right) - 4, 1)
);
x := CoInt.sar(rect.left + rect.right, 1);
verts := [
Vector.newInt2(x - s, rect.top + s + 2),
Vector.newInt2(x + s, rect.top + s + 2),
Vector.newInt2(x, rect.top + 2),
0
];
verts[3] := verts[0];
lclintf.polygon(dc, Pointer(verts), system.length(verts), false);
end;
procedure drawBottomArrow(const rect: TRect);
var
s: int;
x: int;
verts: int2_Array1d;
begin
s := CoInt.min(
CoInt.sar(Math.abs(rect.bottom - rect.top) - 4, 1),
CoInt.sar(Math.abs(rect.left - rect.right) - 4, 1)
);
x := CoInt.sar(rect.left + rect.right, 1);
verts := [
Vector.newInt2(x - s, rect.bottom - s - 2),
Vector.newInt2(x + s, rect.bottom - s - 2),
Vector.newInt2(x, rect.bottom - 2),
0
];
verts[3] := verts[0];
lclintf.polygon(dc, Pointer(verts), system.length(verts), false);
end;
{ Строки, обозначенные двумя звёздочками (**), исправляют ошибку LCL в методе TPageControl.paintWindow(dc: HDC), но не полностью. }
var
lastOverIndex: int;
lastOverRect: TRect;
lastAfterRect: TRect;
(**) clientBoundsRect: TRect;
begin
inherited paintWindow(dc);
lastOverIndex := fldDragOverPageIndex;
if lastOverIndex < 0 then exit;
lastOverRect := fldDragOverPageRect;
lastAfterRect := fldDragAfterPageRect;
(**) clientBoundsRect := TRect.create(0, 0, 0, 0);
(**) if not lclintf.getClientBounds(handle, clientBoundsRect) then exit;
(**) lclintf.moveWindowOrgEx(dc, -clientBoundsRect.left, -clientBoundsRect.top);
case tabPosition of
TTabPosition.tpTop,
TTabPosition.tpBottom: begin
if fldIsDragAfterPage then begin
drawRightArrow(lastOverRect);
if lastOverIndex < pageCount - 1 then drawLeftArrow(lastAfterRect);
exit;
end;
drawLeftArrow(lastOverRect);
if lastOverIndex > 0 then drawRightArrow(lastAfterRect);
end;
else
if fldIsDragAfterPage then begin
drawBottomArrow(lastOverRect);
if lastOverIndex < pageCount - 1 then drawTopArrow(lastAfterRect);
exit;
end;
drawTopArrow(lastOverRect);
if lastOverIndex > 0 then drawBottomArrow(lastAfterRect);
end;
end;
procedure TPageContainer.insertPage(page: TCustomPage; index: int);
begin
cancelDrag();
fldPointerPageIndex := -1;
fldIsPointerWaitForDrag := false;
inherited insertPage(page, index);
end;
procedure TPageContainer.removePage(index: int);
begin
cancelDrag();
fldPointerPageIndex := -1;
fldIsPointerWaitForDrag := false;
inherited removePage(index);
end;
procedure TPageContainer.doAddDockClient(client: TControl; const rect: TRect);
begin
end;
function TPageContainer.getPageClass(): TCustomPageClass;
begin
result := TContainerTabSheet;
end;
constructor TPageContainer.create(theOwner: TComponent);
begin
inherited create(theOwner);
initDragPage();
fldPointerPageIndex := -1;
end;
procedure TPageContainer.insertControl(control: TControl; index: int);
begin
if control is TCustomPage then begin
inherited insertControl(control, index);
exit;
end;
with addTabSheet() do begin
pageIndex := index;
insertControl(control);
end;
recalculateConstraints();
end;
procedure TPageContainer.removeControl(control: TControl);
var
index: int;
begin
if control is TCustomPage then begin
inherited removeControl(control);
exit;
end;
for index := 0 to pageCount - 1 do with pages[index] do if controls[0] = control then begin
removeControl(control);
removePage(index);
break;
end;
recalculateConstraints();
end;
procedure TPageContainer.dragDrop(source: TObject; x, y: int);
var
pageAfter: boolean;
pageIndex: int;
dragIndex: int;
begin
if source <> self then begin
inherited dragDrop(source, x, y);
exit;
end;
if fldDragOverPageIndex >= 0 then begin
invalidateRect(fldDragOverPageRect);
invalidateRect(fldDragAfterPageRect);
end;
fldDragOverPageIndex := -1;
dragIndex := fldDraggingPageIndex;
pageIndex := getPageIndexForDrag(x, y);
getPageRectEx(pageIndex, x, y, pageAfter);
if pageIndex = dragIndex - 1 then pageAfter := false;
if pageIndex = dragIndex + 1 then pageAfter := true;
if pageAfter then inc(pageIndex);
if pageIndex > dragIndex then dec(pageIndex);
if (pageIndex >= 0) and (pageIndex < pageCount) and (pageIndex <> dragIndex) then begin
TCustomTabControl(self).pages.move(dragIndex, pageIndex);
end;
end;
procedure TPageContainer.beginDragPage(pageIndex: int; immediate: boolean; threshold: int);
begin
if (pageIndex >= 0) and (pageIndex < pageCount) then begin
fldDraggingPageIndex := pageIndex;
beginDrag(immediate, threshold);
end;
end;
{%endregion}
{%region TContainerTabSheet }
procedure TContainerTabSheet.insertControl(control: TControl; index: int);
begin
control.align := TAlign.alClient;
if control is TWinControl then begin
TWinControl(control).dockSite := false;
caption := TWinControl(control).controls[0].caption;
end;
inherited insertControl(control, index);
end;
procedure TContainerTabSheet.removeControl(control: TControl);
begin
if control is TWinControl then begin
TWinControl(control).dockSite := true;
end;
inherited removeControl(control);
end;
{%endregion}
{%region ConcatenatedObjectArray }
procedure ConcatenatedObjectArray.clear();
begin
fldLength := 0;
end;
procedure ConcatenatedObjectArray.concat(anot: ObjectArray);
var
sindex: int;
aindex: int;
capacity: int;
oldLength: int;
newLength: int;
sarray: TObject_Array1d;
buffer: TObject_Array1d;
begin
if anot = nil then exit;
oldLength := fldLength;
newLength := oldLength + anot.getLength();
if newLength < 0 then begin
raise BufferTooLargeError.create(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, '!error.buffer-too-large'));
end;
sarray := fldArray;
capacity := AVTOOService.getBestArrayCapacity(newLength);
if sarray = nil then begin
sarray := &Array.newTObject1d(capacity);
fldArray := sarray;
end else
if system.length(sarray) <> capacity then begin
buffer := &Array.newTObject1d(capacity);
&Array.copyObjects(sarray, 0, buffer, 0, oldLength);
fldArray := buffer;
sarray := buffer;
end;
aindex := 0;
for sindex := oldLength to newLength - 1 do begin
sarray[sindex] := anot.readComponent(aindex);
inc(aindex);
end;
fldLength := newLength;
end;
function ConcatenatedObjectArray.getLength(): int;
begin
result := fldLength;
end;
function ConcatenatedObjectArray.readComponent(index: int): TObject;
begin
if (index < 0) or (index >= fldLength) then begin
raise ArrayIndexOutOfBoundsException.create(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'out-of-bounds.array-index'));
end;
result := fldArray[index];
end;
{%endregion}
{%region TVisibleFromDialog }
procedure TVisibleFromDialog.dialogShow(sender: TObject);
begin
typesList.setFocus();
end;
procedure TVisibleFromDialog.listPaintItem(sender: TWinControl; index: int; const area: TRect; state: TOwnerDrawState);
var
ax0: int;
ay0: int;
ay1: int;
dx0: int;
bgColor: int;
fgColor: int;
color0: long;
color1: long;
color2: long;
text: AnsiString;
font: TFont;
brush: TBrush;
items: TStrings;
render: TCanvas;
list: TCustomComboBox;
item: ru.malik.elaborarer.avtoo.lang.ClassType;
procedure drawText(const text: AnsiString);
begin
render.textOut(dx0, ay0 + CoInt.sar(ay1 - ay0 - render.textHeight(text), 1), text);
inc(dx0, render.textWidth(text));
end;
begin
{ инициализация }
list := sender as TCustomComboBox;
items := list.items;
render := list.canvas;
ax0 := area.left;
ay0 := area.top;
ay1 := area.bottom;
item := items.objects[index] as ru.malik.elaborarer.avtoo.lang.ClassType;
if TOwnerDrawStateType.odSelected in state then begin
bgColor := graphics.clHighlight;
fgColor := graphics.clHighlightText;
end else begin
bgColor := graphics.clWindow;
fgColor := graphics.clWindowText;
end;
{ подготовка }
render.clipRect := area;
brush := render.brush;
brush.style := TFPBrushStyle.bsSolid;
brush.color := bgColor;
font := render.font;
font.color := fgColor;
{ фон }
render.fillRect(area);
brush.style := TFPBrushStyle.bsClear;
{ элемент }
dx0 := ax0 + 2;
drawText(item.specialSimpleName);
text := item.parentPackage.specialCanonicalName;
if text.length > 0 then begin
color0 := graphics.colorToRGB(fgColor);
color1 := (color0 and $ff0000 shl 16) + (color0 and $00ff00 shl 8) + (color0 and $0000ff);
color0 := graphics.colorToRGB(bgColor);
color2 := (color0 and $ff0000 shl 16) + (color0 and $00ff00 shl 8) + (color0 and $0000ff);
color0 := (9 * color1 + 7 * color2) shr 4;
font.color := (int(color0 shr 16) and $ff0000) + (int(color0 shr 8) and $00ff00) + (int(color0) and $0000ff);
drawText(' — ' + text);
end;
end;
procedure TVisibleFromDialog.setSelectedTypeCanonicalName(const newSelectedTypeCanonicalName: AnsiString);
var
index: int;
begin
index := newSelectedTypeCanonicalName.lastIndexOf('.');
if index < 1 then begin
typesList.text := newSelectedTypeCanonicalName;
exit;
end;
typesList.text := newSelectedTypeCanonicalName.substring(index + 1) + ' — ' + newSelectedTypeCanonicalName.substring(1, index);
end;
function TVisibleFromDialog.getSelectedTypeCanonicalName(): AnsiString;
var
index: int;
prefix: AnsiString;
curSelectedTypeCanonicalName: AnsiString;
begin
prefix := ' — ';
curSelectedTypeCanonicalName := typesList.text;
index := curSelectedTypeCanonicalName.indexOf(prefix);
if index < 1 then begin
result := curSelectedTypeCanonicalName;
exit;
end;
result := curSelectedTypeCanonicalName.substring(index + prefix.length) + '.' + curSelectedTypeCanonicalName.substring(1, index);
end;
procedure TVisibleFromDialog.fillTypesList(programmeInstance: Programme);
var
index: int;
sname: AnsiString;
cname: AnsiString;
typeInstance: &Type;
begin
with typesList, items do begin
beginUpdate();
try
clear();
with programmeInstance.types do for index := 0 to getLength() - 1 do begin
typeInstance := readComponent(index);
if not(typeInstance is ru.malik.elaborarer.avtoo.lang.ClassType) or (typeInstance is ArrayType) and not TMainForm.isVisibleArray(ArrayType(typeInstance)) then continue;
sname := typeInstance.specialSimpleName;
cname := typeInstance.parentPackage.specialCanonicalName;
if cname.length > 0 then sname := sname + ' — ' + cname;
addObject(sname, typeInstance);
end;
finally
endUpdate();
end;
end;
end;
{%endregion}
{%region TByteReaderStream }
function TByteReaderStream.getPosition(): long;
var
seeker: SeekExtension;
begin
seeker := fldSeeker;
if seeker = nil then begin
raise EStreamError.createFmt(rtlconsts.SSeekNotImplemented, [ className() ]);
end;
result := seeker.position();
end;
function TByteReaderStream.getSize(): long;
var
seeker: SeekExtension;
begin
seeker := fldSeeker;
if seeker = nil then begin
raise EStreamError.createFmt(rtlconsts.SSeekNotImplemented, [ className() ]);
end;
result := seeker.size();
end;
constructor TByteReaderStream.create(reader: ByteReader);
begin
inherited create();
fldReader := reader;
if reader <> nil then begin
fldSeeker := SeekExtension(reader.getExtension(SeekExtension));
end;
end;
destructor TByteReaderStream.destroy;
var
reader: ByteReader;
begin
reader := fldReader;
if reader <> nil then begin
reader.close();
end;
inherited destroy;
end;
function TByteReaderStream.read(var dst; length: int): int;
const
BUFFER_SIZE = int($00010000);
label
break_label0;
var
index: int;
remainder: int;
readedAll: int;
readedBuf: int;
position: long;
buffer: byte_Array1d;
reader: ByteReader;
begin
reader := fldReader;
if reader = nil then begin
result := inherited read(dst, length);
exit;
end;
if length <= 0 then begin
result := 0;
exit;
end;
position := 0;
readedAll := 0;
readedBuf := 0;
buffer := &Array.newByte1d(BUFFER_SIZE);
begin
for index := 0 to (length div BUFFER_SIZE) - 1 do begin
readedBuf := reader.read(buffer);
if readedBuf <= 0 then goto break_label0;
&Array.copyRaw(buffer[0], (@dst + position)^, readedBuf);
inc(readedAll, readedBuf);
if readedBuf < BUFFER_SIZE then goto break_label0;
inc(position, readedBuf);
end;
remainder := length mod BUFFER_SIZE;
if remainder > 0 then begin
readedBuf := reader.read(buffer, 0, remainder);
if readedBuf <= 0 then goto break_label0;
&Array.copyRaw(buffer[0], (@dst + position)^, readedBuf);
inc(readedAll, readedBuf);
end;
end;
break_label0:
result := readedAll;
end;
function TByteReaderStream.seek(const offset: long; from: TSeekOrigin): long;
var
seeker: SeekExtension;
begin
seeker := fldSeeker;
if seeker = nil then begin
raise EStreamError.createFmt(rtlconsts.SSeekNotImplemented, [ className() ]);
end;
result := seeker.seek(offset, SeekFrom(from));
end;
{%endregion}
{%region OverriddableHelper }
function OverriddableHelper.isOverride(): boolean;
var
index: int;
overridden: OverriddableMember;
enclosing: ru.malik.elaborarer.avtoo.lang.ClassType;
superclass: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
enclosing := parentType;
superclass := enclosing.getSuperclassType();
if superclass <> nil then begin
overridden := overridesIn(superclass, Method.CURRENT_TYPE or Method.SUPERCLASSES);
if (overridden <> nil) and overridden.isVisibleFrom(enclosing, enclosing) then begin
result := true;
exit;
end;
end;
for index := 0 to enclosing.getSuperservicesLength() - 1 do begin
overridden := overridesIn(enclosing.getSuperserviceTypeAt(index), Method.CURRENT_TYPE);
if (overridden <> nil) and overridden.isVisibleFrom(enclosing, enclosing) then begin
result := true;
exit;
end;
end;
result := false;
end;
{%endregion}
{%region PropertyHelper }
function PropertyHelper.specifiersToString(): AnsiString;
begin
if readSynthetic <> nil then begin
if writeSynthetic <> nil then begin
result := '{ read, write }';
exit;
end;
result := '{ read }';
exit;
end;
if writeSynthetic <> nil then begin
result := '{ write }';
exit;
end;
result := '{ ??? }';
end;
{%endregion}
{%region TProgrammeStrings }
function TProgrammeStrings.contains(member: Member; enclosing: ClassType): boolean;
var
index: int;
cname: AnsiString;
found: TObject;
realType: ru.malik.elaborarer.avtoo.lang.ClassType;
parentType: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if member is ClassInit then begin
result := false;
exit;
end;
if member is InstInit then begin
parentType := member.parentType;
if enclosing.isHelper() then begin
realType := enclosing.getHelperForType();
if parentType = realType then begin
result := false;
exit;
end;
enclosing := realType;
end;
result :=
(not enclosing.isService() or (parentType <> enclosing.getSuperclassType())) and
(not enclosing.isStruct() or (parentType.specialCanonicalName <> AVTOOConstants.PACKNAME_LANG + '.' + AVTOOConstants.TYPENAME_STRUCT))
;
exit;
end;
if member is Callable then begin
cname := member.specialSimpleName;
for index := 0 to count - 1 do begin
found := objects[index];
if (found is Callable) and (ProgrammeItem(found).specialSimpleName = cname) and Callable(found).isIdentityArguments(Callable(member)) then begin
result := true;
exit;
end;
end;
end else
if member is Fieldoid then begin
cname := member.specialSimpleName;
for index := 0 to count - 1 do begin
found := objects[index];
if (found is Fieldoid) and ((found as Fieldoid).specialSimpleName = cname) then begin
result := true;
exit;
end;
end;
end;
result := false;
end;
{%endregion}
{%region TProgrammeTreeNodes }
function TProgrammeTreeNodes.addChildsClassObject(parent: TTreeNode; const name: AnsiString; data: ClassType): TTreeNode;
label
break_label0,
continue_label0;
var
pos: int;
index: int;
length: int;
superclasses: ClassType_Array1d;
child: TTreeNode;
initial: ru.malik.elaborarer.avtoo.lang.ClassType;
superclass: ru.malik.elaborarer.avtoo.lang.ClassType;
begin
if data = nil then begin
raise NullPointerException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'null-pointer.argument'), [ CoAnsiString.create('data') ]));
end;
if data.isHelper() then begin
initial := data.getHelperForType();
end else begin
initial := data.getSuperclassType();
end;
length := 0;
superclass := initial;
while superclass <> nil do begin
inc(length);
superclass := superclass.getSuperclassType();
end;
superclasses := ClassType_Array1d(&Array.newTObject1d(length));
superclass := initial;
for index := length - 1 downto 0 do begin
superclasses[index] := superclass;
superclass := superclass.getSuperclassType();
end;
if parent = nil then begin
if length <= 0 then begin
for index := 0 to topLvlCount - 1 do begin
child := topLvlItems[index];
if child.data = data then begin
child.text := name;
result := child;
exit;
end;
end;
result := addChildObject(nil, name, data);
exit;
end;
superclass := superclasses[0];
for index := 0 to topLvlCount - 1 do begin
parent := topLvlItems[index];
if parent.data = superclass then goto break_label0;
end;
parent := addChildObject(nil, superclass.specialSimpleName, superclass);
parent.stateIndex := TMainForm.getIconIndex(superclass, [IconSelectOption.isInactive]);
end;
break_label0:
for pos := 1 to length - 1 do begin
superclass := superclasses[pos];
for index := 0 to parent.count - 1 do begin
child := parent[index];
if child.data = superclass then goto continue_label0;
end;
child := addChildObject(parent, superclass.specialSimpleName, superclass);
child.stateIndex := TMainForm.getIconIndex(superclass, [IconSelectOption.isInactive]);
continue_label0:
parent := child;
end;
for index := 0 to parent.count - 1 do begin
child := parent[index];
if child.data = data then begin
child.text := name;
result := child;
exit;
end;
end;
result := addChildObject(parent, name, data);
end;
function TProgrammeTreeNodes.addChildsPackageObject(parent: TTreeNode; const dotName: AnsiString; data: Pointer): TTreeNode;
label
break_label0;
var
posa: int;
posb: int;
index: int;
limit: int;
length: int;
sname: AnsiString;
child: TTreeNode;
begin
if parent = nil then begin
raise NullPointerException.create(AnsiString.format(AResource.readUnitResourceAsAnsiString(pascalx.lang.UNIT_NAME, 'null-pointer.argument'), [ CoAnsiString.create('parent') ]));
end;
limit := dotName.length;
length := limit + 1;
posa := 1;
repeat
posb := dotName.indexOf('.', posa);
if posb < 1 then posb := length;
sname := dotName.substring(posa, posb);
begin
for index := 0 to parent.count - 1 do begin
child := parent[index];
if sname = child.text then goto break_label0;
end;
child := addChildObject(parent, sname, nil);
child.stateIndex := TMainForm.getIconIndex(nil);
end;
break_label0:
parent := child;
posa := posb + 1;
until (posa < 0) or (posa > limit);
child.data := data;
result := child;
end;
{%endregion}
{%region TProgrammeTreeNode }
function TProgrammeTreeNode.getPackageNodeForFlatView(const dotName: AnsiString): TTreeNode;
var
index: int;
child: TTreeNode;
begin
for index := 0 to count - 1 do begin
child := self[index];
if dotName = child.text then begin
result := child;
exit;
end;
end;
result := nil;
end;
function TProgrammeTreeNode.getPackageNodeForTreeView(const dotName: AnsiString): TTreeNode;
label
continue_label0;
var
index: int;
clength: int;
slength: int;
cname: AnsiString;
sname: AnsiString;
child: TTreeNode;
parent: TTreeNode;
begin
sname := dotName;
slength := sname.length;
parent := self;
while slength > 0 do begin
for index := 0 to parent.count - 1 do begin
child := parent[index];
cname := child.text;
if sname.startsWith(cname) then begin
clength := cname.length;
if slength <= clength then begin
result := child;
exit;
end;
if sname[clength + 1] = '.' then begin
sname := sname.substring(clength + 2);
slength := sname.length;
parent := child;
goto continue_label0;
end;
end;
end;
result := nil;
exit;
continue_label0:
end;
result := nil;
end;
{%endregion}
{%region TAboutDialog }
procedure TAboutDialog.openURL(sender: TObject);
var
url: UnicodeString;
begin
url := AnsiString(TControl(sender).caption).toUTF16();
{$IFDEF WINDOWS}
windows.shellExecuteW(0, 'open', system.PWideChar(url), nil, nil, windows.SW_NORMAL);
{$ELSE}
with Process.create() do try
commandLine := [ '/bin/xdg-open', url ];
start();
finally
free();
end;
{$ENDIF}
end;
procedure TAboutDialog.afterConstruction();
var
logo: TGraphic;
linkMain: TGraphic;
linkDonate: TGraphic;
begin
inherited afterConstruction();
logo := nil;
linkMain := nil;
linkDonate := nil;
try
logo := TMainForm.loadImageFromResource('about.logo');
linkMain := TMainForm.loadImageFromResource('about.qrcode.avtoo');
linkDonate := TMainForm.loadImageFromResource('about.qrcode.donate');
logoView.picture.assign(logo);
linkMainQRCode.picture.assign(linkMain);
linkDonateQRCode.picture.assign(linkDonate);
finally
logo.free();
linkMain.free();
linkDonate.free();
end;
versionOfCompilerView.caption := AVTOOConstants.getVersion();
buildDateView.caption := AnsiString({$I %DATE%}).replaceAll('/', '-');
end;
{%endregion}
end.
