diff options
Diffstat (limited to 'docview/src')
31 files changed, 10830 insertions, 0 deletions
diff --git a/docview/src/CompareWordUnit.pas b/docview/src/CompareWordUnit.pas new file mode 100644 index 00000000..49c2ea26 --- /dev/null +++ b/docview/src/CompareWordUnit.pas @@ -0,0 +1,107 @@ +Unit CompareWordUnit; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2001 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Compares words and produces a match level (relevance) based +// on the relative sizes etc. Used in searching help files +// to sort by relevance. + +const + // word weightings + mwExactWord = 20; + mwWordStart = 10; + mwWordWithin = 5; + +// Compares the given search word against the given +// reference word. Returns a value indicating how well the +// search word matches, 0 = not at all. +function CompareWord( const SearchWord: string; + const ReferenceWord: string ): longint; + +Implementation + +uses + SysUtils; + +// LOoks for string a within string b, case insensitively +function CaseInsensitivePos( const a, b: string ): longint; +begin + // Budget implementation to begin with. + Result := Pos( UpperCase( a ), UpperCase( b ) ); +end; + +function CompareWord( const SearchWord: string; + const ReferenceWord: string ): longint; +var + OccurrencePos: longint; +begin + Result := 0; + // First up, if the word we're searching for is longer than + // this word, then it can't match at all. + if Length( SearchWord ) > Length( ReferenceWord ) then + exit; + + OccurrencePos := CaseInsensitivePos( SearchWord, ReferenceWord ); + if OccurrencePos = 0 then + // no match. + exit; + + if Length( SearchWord ) = Length( ReferenceWord ) then + begin + // exact word match (except case) + Result := mwExactWord; + exit; + end; + + // partial word match + if OccurrencePos = 1 then + begin + // word starts with searchword + Result := mwWordStart + * Length( SearchWord ) + div Length( ReferenceWord ); + if Result = 0 then + Result := 1; + exit; + end; + + // Matched searchword somewhere within word + Result := mwWordWithin + * Length( SearchWord ) + div Length( ReferenceWord ); + if Result = 0 then + Result := 1; + +end; + +{// Note: searchstring must be uppercase, +function IsMatching( const SearchString: string; + const SearchType: TSearchType; + const Item: string ): boolean; +var + temp: string; +begin + case SearchType of + stStarts: + Result:= StrStarts( SearchString, Item ); + + stContains: + begin + temp:= UpperCase( Item ); + Result:= Pos( SearchString, temp ) <> 0; + end; + + stMatches: + Result:= CompareText( SearchString, + Item )= 0; + end; +end; +} +Initialization +End. diff --git a/docview/src/HelpFile.pas b/docview/src/HelpFile.pas new file mode 100644 index 00000000..b3ee7317 --- /dev/null +++ b/docview/src/HelpFile.pas @@ -0,0 +1,1252 @@ +Unit HelpFile; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Encapsulates the basic reading of a help file's structure. + +uses + Classes + ,SysUtils + ,IPFFileFormatUnit + ,HelpTopic +// ,HelpBitmap + ,SearchTable + ,nvNullObjects // Fake various classes like TImageList + ; + +type + + TIndexEntry = class(TObject) + private + name: String; + topic: TTopic; + flags: uint8; + public + constructor Create(aName: String; aTopic: TTopic; aFlags: uint8); + destructor Destroy; override; + property getTopic: TTopic read topic; + function getLabel: String; + function isGlobal: boolean; + function getLevel: integer; + end; + + + TIndex = class(TObject) + private + entries: TStringList; + public + constructor Create; + destructor Destroy; override; + function Count: longint; + function GetLabels: TStringList; + function GetTopic(aPos: longint): TTopic; + procedure Add(anIndexEntry: TIndexEntry); + end; + + + THelpFile = class(TObject) + private + function GetStringResourceIDCount: integer; + function GetNumericResourceIDCount: integer; + protected + _Filename : string; + _FileSize : longint; + _Handle: TFileStream; + + _pSlotData: pUInt16; + _SlotDataSize: longint; + + _Title: string; + + _Topics: TList; // of TTopics + + _Dictionary: TStringList; // pointers to strings. + + _Index: TIndex; + + _SearchTable: TSearchTable; + + _ReferencedFiles: TStringList; + + _FontTable: TList; + + _pHeader: TPHelpFileHeader; + _pExtendedHeader: TPExtendedHelpFileHeader; + _pContentsData: pointer; + _pResourceData: pointer; + _pSearchData: pointer; + _pHighlightWords: UInt32ArrayPointer; + _pSlotOffsets: Uint32ArrayPointer; + _pDictionaryData: pointer; + _pFontTableData: pointer; + _pTopicNameData: pointer; + _pTopicGlobalNamesData: pointer; + + procedure InitMembers; + procedure Open; + procedure Close; + procedure ReadFileBlock( Var Dest: pointer; + const StartPosition: LongWord; + const Length: LongWord); + + procedure ReadHeader; + procedure ReadContents; + procedure ReadDictionary; + procedure ReadSearchTable; + + procedure ReadIndex; + + procedure ReadReferencedFilesTable; + procedure ReadFontTableData; + procedure ParseFontTable; + + function GetTopic( Index: longint ): TTopic; + function GetTopicCount: longint; + + function GetDictionaryCount: longint; + function GetDictionaryWord( Index: longint ): string; + + function GetHighlightWords: UInt32ArrayPointer; + + function GetSearchTable: TSearchTable; + + // Lookup global or local panel name list + function FindTopicByName( const Name: string; + Var pData: pointer; + Count: longint; + Offset: longint ): TTopic; + + public + constructor Create( const aFileName: string ); + + destructor Destroy; override; + + function GetIndex: TIndex; + + property Title: string read _Title; + property Topics[ Index: longint ]: TTopic read GetTopic; + property TopicList: TList read _Topics; + property TopicCount: longint read GetTopicCount; + property StringResourceIDCount: integer read GetStringResourceIDCount; + property NumericResourceIDCount: integer read GetNumericResourceIDCount; + property Index: TIndex read GetIndex; + property Filename: string read _FileName; + + property ReferencedFiles: TStringList read _ReferencedFiles; + + procedure GetImages( ImageOffsets: TList; + Images: TImageList ); + + function GetImage( ImageOffset: longint ): THelpBitmap; + + property DictionaryCount: longint read GetDictionaryCount; + property DictionaryWords[ Index: longint ]: string read GetDictionaryWord; + + function IndexOfTopic( Topic: TTopic ): longint; + + property SearchTable: TSearchTable read GetSearchTable; + + function FindTopicByResourceID( ID: uint16 ): TTopic; + + function FindTopicByLocalName( const Name: string ): TTopic; + function FindTopicByGlobalName( const Name: string ): TTopic; + + function FindTopicByTitleStartsWith( const SearchText: string ): TTopic; + function FindTopicByTitleContains( const SearchText: string ): TTopic; + + function FindTopicByIndexStartsWith( const SearchText: string ): TTopic; + function FindTopicByIndexContains( const SearchText: string ): TTopic; + + procedure FindResourceIDsForTopic( Topic: TTopic; + ResourceIDs: TList ); + + property HighlightWords: UInt32ArrayPointer read GetHighlightWords; + + property FileSize: longint read _FileSize; + + procedure SetupFontSubstitutes( Substitutions: string ); + public + NotesLoaded: boolean; // used externally + + end; + +// Returns helpfile that the given topic is within +Function TopicFile( Topic: TTopic ): THelpFile; + +function GetHelpFileTitle( const Filename: string ): string; + +Implementation + +uses +// BseErr, +// StringUtilsUnit, +// CharUtilsUnit, +// DebugUnit, +// ACLFileIOUtility, +// ACLLanguageUnit; + nvUtilities + ,ACLStringUtility + ; + +// Load "missing" bitmap +{ TODO -oGraeme -cbitmap : Create and load a "missing image" image } +{.$R Images} + +const + FileErrorNotFound = 'File not found '; + FileErrorAccessDenied = 'File access denied'; + FileErrorInUse = 'File in use'; + FileErrorInvalidHeader = 'Invalid file header'; + + + // ----------- + // TIndexEntry + // ----------- + + CONSTRUCTOR TIndexEntry.Create(aName: String; aTopic: TTopic; aFlags: uint8); + begin + LogEvent(LogObjConstDest, 'TIndexEntry.Create'); + name := aName; + topic := aTopic; + flags := aFlags; + end; + + + DESTRUCTOR TIndexEntry.Destroy; + begin + LogEvent(LogObjConstDest, 'TIndexEntry.Destroy'); + topic := nil; + inherited Destroy; + end; + + + FUNCTION TIndexEntry.getLabel: String; + begin + result := name; + + // index level check (level 1 or 2) + if (getLevel) > 1 then + begin + result := '- ' + result; + end; + + if isGlobal then + begin + result := result + ' (g)'; + end; + end; + + + FUNCTION TIndexEntry.isGlobal: boolean; + begin + result := (flags and 64) > 0 + end; + + + FUNCTION TIndexEntry.getLevel: integer; + begin + result := 1; + + // index level check (level 1 or 2) + if (flags and 2 ) > 0 then + begin + result := 2; + end; + end; + + + + + // ----------- + // TIndex + // ----------- + CONSTRUCTOR TIndex.Create; + begin + inherited Create; + + entries := TStringList.Create; + // labels := nil; // lazy + end; + + + DESTRUCTOR TIndex.Destroy; + var + i : longint; + tmpEntry : TIndexEntry; + begin + LogEvent(LogObjConstDest, 'TIndex.Destroy (size:' + IntToStr(entries.Count) + ')'); + + for i := 0 to entries.Count - 1 do + begin + tmpEntry := TIndexEntry(entries.Objects[i]); + if tmpEntry <> nil then + begin + tmpEntry.Free; + entries.Objects[i] := nil; + end; + end; + entries.Free; + + inherited Destroy; + end; + + + FUNCTION TIndex.Count: longint; + begin + result := entries.Count; + end; + + + FUNCTION TIndex.GetLabels: TStringList; + begin + result := entries; + end; + + + FUNCTION TIndex.GetTopic(aPos: longint): TTopic; + begin + result := TIndexEntry(entries.Objects[aPos]).getTopic; + end; + + + PROCEDURE TIndex.add(anIndexEntry: TIndexEntry); + begin +// LogEvent(LogDebug, 'TIndex.add(' + anIndexEntry.getLabel + ', ' + anIndexEntry.ClassName + ')'); + entries.AddObject(anIndexEntry.getLabel, anIndexEntry); + end; + + + + +//Procedure OnLanguageEvent( Language: TLanguageFile; +// const Apply: boolean ); +//var +// tmpPrefix : String; +//begin +// tmpPrefix := 'HelpFile' + LANGUAGE_LABEL_DELIMITER; +// +// Language.LL( Apply, FileErrorNotFound, tmpPrefix + 'FileErrorNotFound', 'File not found' ); +// Language.LL( Apply, FileErrorAccessDenied, tmpPrefix + 'FileErrorAccessDenied', 'Access denied' ); +// Language.LL( Apply, FileErrorInUse, tmpPrefix + 'FileErrorInUse', 'File in use by another program' ); +// Language.LL( Apply, +// FileErrorInvalidHeader, +// tmpPrefix + 'FileErrorInvalidHeader', +// 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' ); +// Language.LL( Apply, +// ErrorCorruptHelpFile, +// tmpPrefix + 'ErrorCorruptHelpFile', +// 'File is corrupt' ); +//end; + +Function TopicFile( Topic: TTopic ): THelpFile; +Begin + Result := Topic.HelpFile as THelpFile; +end; + +function THelpFile.GetStringResourceIDCount: integer; +begin + Result := _pHeader^.nname; +end; + +function THelpFile.GetNumericResourceIDCount: integer; +begin + Result := _pHeader^.nres; +end; + +procedure THelpFile.InitMembers; +begin + _SlotDataSize := 0; + + _pHeader := nil; + _pExtendedHeader := nil; + _pContentsData := nil; + _pSlotOffsets := nil; + _pResourceData := nil; + _pSearchData := nil; + _pDictionaryData := nil; +// _pIndexData := nil; + _pFontTableData := nil; + + _pHighlightWords := nil; + + _Dictionary:= TStringList.Create; + _Topics := TList.Create; +// _Index := TStringList.Create; + _ReferencedFiles := TStringList.Create; + _FontTable := TList.Create; + + NotesLoaded := false; +end; + + +constructor THelpFile.Create(const aFileName: string); +begin + LogEvent(LogObjConstDest, 'THelpFile.Create (file:' + aFileName + ')'); + LogEvent(LogParse, 'Helpfile Load: ' + aFileName); + + _FileName := aFileName; + + InitMembers; + + Open; + + // we always need these basics: + try + ReadHeader; + ReadContents; + ReadDictionary; + ReadFontTableData; + ParseFontTable; + ReadReferencedFilesTable; + except + Close; + raise; + end; + + // the rest is loaded on demand +end; + + +destructor THelpFile.Destroy; +begin + LogEvent(LogObjConstDest, 'THelpFile.Destroy'); + Dispose( _pHeader ); + Dispose( _pExtendedHeader ); + FreeMem( _pContentsData ); + FreeMem( _pSlotOffsets ); + FreeMem( _pResourceData ); + FreeMem( _pSearchData ); + FreeMem( _pDictionaryData ); +// DeallocateMemory( _pIndexData ); + FreeMem( _pFontTableData ); + + FreeMem( _pHighlightWords ); + + // index entries are pointing to topics + // so let us clean them first + if Assigned( _Index ) then + _Index.Free; + + if Assigned( _Topics ) then + DestroyListAndObjects( _Topics ); + + _Dictionary.Free; + _SearchTable.Free; + _ReferencedFiles.Free; + _FontTable.Free; + + _Handle.Free; +end; + +procedure THelpFile.Open; +begin + if not FileExists( _Filename ) then + raise EHelpFileException.Create( FileErrorNotFound ); + + try + _Handle := TFileStream.Create(_FileName, fmOpenRead); + + except + on E: Exception do + raise EHelpFileException.Create(E.Message); + end; + //case rc of + // ERROR_FILE_NOT_FOUND: // crap, this doesn't actually occur! + // raise EHelpFileException.Create( FileErrorNotFound ); + // + // ERROR_ACCESS_DENIED: + // raise EHelpFileException.Create( FileErrorAccessDenied ); + // + // ERROR_SHARING_VIOLATION: + // raise EHelpFileException.Create( FileErrorInUse ); + // + // else + // raise EHelpFileException.Create( SysErrorMessage( rc ) ); + //end; + + _FileSize := GetFileSize(_Filename); +end; + +procedure THelpFile.Close; +begin + _Handle.Free; + _Handle := nil; +end; + +procedure THelpFile.ReadFileBlock(var Dest: pointer; + const StartPosition: LongWord; const Length: LongWord); +var + bytes: LongWord; +begin + if Length = 0 then + exit; // nothing to read - go home! + + _Handle.Seek(StartPosition, soBeginning); + + // we allocate early so this should never happen + if Dest = nil then + Dest := GetMem(Length); + + bytes := _Handle.Read(Dest^, Length); + if bytes <> Length then + raise EHelpFileException.Create(ErrorCorruptHelpFile); +end; + +procedure THelpFile.ReadHeader; +begin + LogEvent(LogParse, 'Read header'); + New(_pHeader); + ReadFileBlock( _pHeader, + 0, + sizeof( THelpFileHeader ) ); + if _pHeader^.ID <> INF_HEADER_ID then + begin + // not an OS/2 help file. + if (Byte(_pHeader^.ID[0]) = $5f) and (Byte(_pHeader^.ID[1]) = $3f) then + raise EWindowsHelpFormatException.Create( 'It seems we have a Win16 help file!' ); + + raise EHelpFileException.Create( FileErrorInvalidHeader ); + end; + + _Title := _pHeader^.Title; + + if _pHeader^.extstart > 0 then + begin + New(_pExtendedHeader); + // read extended header + ReadFileBlock( _pExtendedHeader, + _pHeader^.extstart, + sizeof( _pExtendedHeader^ ) ); + end; +end; + +procedure THelpFile.ReadContents; +var + Topic: TTopic; + EntryIndex: longint; + pEntry: pTTOCEntryStart; + pEnd: pbyte; + tocarray: UInt32ArrayPointer; + pData: Pointer; + p: PByte; +begin + LogEvent(LogParse, 'Read contents'); + + if _pHeader^.ntoc = 0 then + exit; // explicit check required since ntoc is unsigned + + // Presize the topics list to save reallocation time + _Topics.Capacity := _pHeader^.ntoc; + + // read toc offsets array + //ReadFileBlock( tocarray, + // _pHeader^.tocoffsetsstart, + // _pHeader^.ntoc * SizeOf(uint32) ); + + // read slots first so that Topics can refer to it. + ReadFileBlock( _pSlotOffsets, + _pHeader^.slotsstart, + _pHeader^.nslots * sizeof( uint32 ) ); + + ReadFileBlock( _pContentsData, + _pHeader^.tocstart, + _pHeader^.toclen ); + + pEntry := _pContentsData; + pEnd := _pContentsData + _pHeader^.toclen; + p := PByte(pEntry); + + for EntryIndex := 0 to _pHeader^.ntoc - 1 do + begin +// pEntry := _Handle.Seek(tocarray[EntryIndex], soBeginning); +// pEntry := tocarray[EntryIndex]; + if p >= pEnd then + // runs off end of data! + raise EHelpFileException.Create( ErrorCorruptHelpFile ); + + Topic := TTopic.Create( _Handle, + _pSlotOffsets, + _Dictionary, + pEntry, + _FontTable, + _ReferencedFiles ); + + Topic.HelpFile := Self; + Topic.Index := EntryIndex; + + _Topics.Add( Topic ); + p := PByte(pEntry); + inc(p, pEntry^.Length); + pEntry := pTTOCentryStart(p); + end; +end; + +procedure THelpFile.ReadDictionary; +var + i: longint; + Len: uint8; + p: pbyte; + pEnd: pbyte; + s: string; + c: array[0..255] of char; +begin + LogEvent(LogParse, 'Read dictionary'); + + if _pHeader^.ndict = 0 then + exit; // explicit check required since ndict is unsigned + + ReadFileBlock( _pDictionaryData, + _pHeader^.dictstart, + _pHeader^.dictlen ); + + P := _pDictionaryData; + pEnd := _pDictionaryData + _pHeader^.dictlen; + + // Presize the dictionary to save reallocation + _Dictionary.Capacity := _pHeader^.ndict; + for i := 0 to _pHeader^.ndict - 1 do + begin + // adjust length so we can use as a Pascal string + // (file uses length including length byte, + // Pascal string have length excluding length byte) + if p >= pEnd then + // ran off end of data + raise EHelpFileException.Create( 'Error reading help file dictionary' ); + + + FillChar(c, sizeof(c), 0); // fill string with NUL chars + Len := p^ - 1; // read string length value (corrected length) + Inc(p, sizeof(byte)); // move pointer + Move(p^, c, Len); // read string of dictionary + s := c; // convert PChar to String type + + _Dictionary.Add( s ); + Inc(p, Len); // move pointer to next item + end; +end; + + +function THelpFile.GetIndex: TIndex; +begin + if _Index = nil then + begin + ReadIndex; + end; + Result := _Index; +end; + +type + TIndexEntryHeader = packed record + TextLength: uint8; + Flags: uint8; + NumberOfRoots: uint8; + TOCIndex: uint16; + end; + pTIndexEntryHeader = ^TIndexEntryHeader; + +procedure THelpFile.ReadIndex; +var + IndexIndex: longint; // I can't resist :-) + pEntryHeader: pTIndexEntryHeader; + EntryText: string; + IndexTitleLen: longint; + p: pByte; + pEnd: pByte; + pIndexData: pointer; + tmpIndexEntry: TIndexEntry; +begin + LogEvent(LogParse, 'Read index'); + _Index := TIndex.Create; + if _pHeader^.nindex = 0 then + exit; // explicit check required since ndict is unsigned + + pIndexData := nil; + ReadFileBlock( pIndexData, + _pHeader^.indexstart, + _pHeader^.indexlen ); + + P := pIndexData; + pEnd := pIndexData + _pHeader^.indexlen; + + for IndexIndex := 0 to _pHeader^.nindex - 1 do + begin + if p >= pEnd then + // ran off end of data + raise EHelpFileException.Create( 'Error reading help file index' ); + + pEntryHeader := pTIndexEntryHeader(p); + IndexTitleLen := pEntryHeader^.TextLength; + inc( p, sizeof( TIndexEntryHeader ) ); + + EntryText := ''; + SetString(EntryText, PChar(p), IndexTitleLen); + + if pEntryHeader^.TOCIndex < _Topics.Count then + begin + tmpIndexEntry := TIndexEntry.Create(EntryText, TTopic(_Topics[pEntryHeader^.TOCIndex]), pEntryHeader^.flags); + _Index.Add(tmpIndexEntry); + end + else +// raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' ); + ; // pass! something special + + inc( p, IndexTitleLen + + pEntryHeader^.NumberOfRoots + * sizeof( uint32 ) ); // skip 'roots' for index search + end; + + FreeMem( pIndexData ); +end; + +function THelpFile.GetSearchTable: TSearchTable; +begin + if _SearchTable = nil then + ReadSearchTable; + Result := _SearchTable; +end; + +procedure THelpFile.ReadSearchTable; +var + SearchTableOffset: longint; + SearchTableRecordLengthIs16Bit: boolean; +begin + LogEvent(LogParse, 'Read search table'); + + if _pHeader^.SearchLen = 0 then + begin + LogEvent(LogParse, 'Read search table (len = 0'); + exit; + end; + + SearchTableOffset := _pHeader^.SearchStart and $7fffffff; + SearchTableRecordLengthIs16Bit := _pHeader^.SearchStart and $80000000 > 0; + ReadFileBlock( _pSearchData, + SearchTableOffset, + _pHeader^.SearchLen ); + + _SearchTable := TSearchTable.Create( _pSearchData, + SearchTableRecordLengthIs16Bit, + _Dictionary.Count, + _Topics.Count ); +end; + +function THelpFile.GetHighlightWords: UInt32ArrayPointer; +begin + if _pHighlightWords = nil then + _pHighlightWords := GetMem( _Dictionary.Count * sizeof( UInt32 ) ); + Result := _pHighlightWords; +end; + +function THelpFile.FindTopicByResourceID( ID: uint16 ): TTopic; +var + i: longint; + pResourceIDs: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; + FileResourceID: uint16; + TopicIndex: uint16; +begin + Result := nil; + + if _pHeader^.nres = 0 then + // since nres is unsigned + exit; + + if _pResourceData = nil then + begin + ReadFileBlock( _pResourceData, + _pHeader^.resstart, + (_pHeader^.nres * sizeof( uint16 )) * 2 ); // list of IDs, list of topics + end; + + pResourceIDs := _pResourceData; + pTopicIndices := _pResourceData + + _pHeader^.nres * sizeof( uint16 ); + + for i := 0 to _pHeader^.nres - 1 do + begin + FileResourceID := pResourceIDs^[ i ]; + if FileResourceID = ID then + begin + // found + TopicIndex := pTopicIndices^[ i ]; + Result := TTopic(_Topics[ TopicIndex ]); + exit; + end; + end; +end; + +// Look up a local "panel name" and return associated topic, if any. +function THelpFile.FindTopicByLocalName( const Name: string ): TTopic; +begin + Result := FindTopicByName( Name, + _pTopicNameData, + _pHeader^.nname, + _pHeader^.namestart ); +end; + +function THelpFile.FindTopicByGlobalName( const Name: string ): TTopic; +begin + Result := nil; + + if _pExtendedHeader = nil then + // no extended header - no global list to lookup + exit; + + Result := FindTopicByName( Name, + _pTopicGlobalNamesData, + _pExtendedHeader ^. EntryInGNameTable, + _pExtendedHeader ^. HelpPanelGNameTblOffset ); + +end; + +// The text of the names are stored in the (global) dictionary +// with a table referencing them. +// We could use a binary search here... but whatever... +function THelpFile.FindTopicByName( const Name: string; + Var pData: pointer; + Count: longint; + Offset: longint ): TTopic; +var + i: longint; + pNameTable: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; + TopicIndex: uint16; + + TopicNameWordIndex: uint16; + TopicName: string; +begin + Result := nil; + + if Count = 0 then + // since it's unsigned + exit; + + if pData = nil then + ReadFileBlock( pData, + Offset, + Count * sizeof( uint16 ) * 2 ); // list of name words, list of topics + + // get pointers to the two parts of the table + pNameTable := pData; + pTopicIndices := pData + + Count * sizeof( uint16 ); + + for i := 0 to Count - 1 do + begin + TopicNameWordIndex := pNameTable^[ i ]; + TopicName := DictionaryWords[ TopicNameWordIndex ]; + + if CompareText( TopicName, Name ) = 0 then + begin + // found + TopicIndex := pTopicIndices^[ i ]; + Result := TTopic(_Topics[ TopicIndex ]); + exit; + end; + end; +end; + + +// TODO move to index class +function THelpFile.FindTopicByIndexStartsWith( const SearchText: string ): TTopic; +var + i: longint; + tmpLabel: String; +begin + result := nil; + GetIndex; // make sure it's read + + for i := 0 to _Index.Count - 1 do + begin + tmpLabel := _Index.GetLabels[i]; + if SameText(tmpLabel, SearchText) then + begin + // found + result := Index.getTopic(i); + exit; + end; + end; +end; + + +function THelpFile.FindTopicByIndexContains(const SearchText: string): TTopic; +var + i: longint; + tmpLabel: String; +begin + result := nil; + GetIndex; // make sure it's read + + for i := 0 to _Index.Count - 1 do + begin + tmpLabel := _Index.GetLabels[i]; + if Pos(UpperCase(SearchText), UpperCase(tmpLabel)) > 0 then + begin + // found + result := Index.getTopic(i); + exit; + end; + end; +end; + + +function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic; +var + i: longint; + tmpTopic: TTopic; + tmpLevel : integer; + tmpMore : boolean; +begin + result := nil; + + tmpLevel := 0; + repeat + tmpMore := false; + inc(tmpLevel); + for i := 0 to _Topics.Count - 1 do + begin + tmpTopic := TTopic(_Topics[i]); + if tmpLevel = tmpTopic.ContentsLevel then + begin + if StrStartsWithIgnoringCase(tmpTopic.Title, SearchText) then + begin + result := tmpTopic; + exit; + end; + end; + if tmpLevel < tmpTopic.ContentsLevel then + begin + tmpMore := True; + end; + end; + until NOT tmpMore; +end; + +function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic; +var + i: longint; + tmpTopic: TTopic; + tmpLevel : integer; + tmpMore : boolean; +begin + result := nil; + + tmpLevel := 0; + repeat + tmpMore := false; + inc(tmpLevel); + for i := 0 to _Topics.Count - 1 do + begin + tmpTopic := TTopic(_Topics[i]); + if tmpLevel = tmpTopic.ContentsLevel then + begin + if CaseInsensitivePos( SearchText, tmpTopic.Title) > 0 then + begin + result := tmpTopic; + exit; + end; + end; + if tmpLevel < tmpTopic.ContentsLevel then + begin + tmpMore := True; + end; + end; + until NOT tmpMore; +end; + +procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic; + ResourceIDs: TList ); +var + i: longint; + pResourceIDs: UInt16ArrayPointer; + pTopicIndices: UInt16ArrayPointer; +begin + ResourceIDs.Clear; + + if _pHeader^.nres = 0 then + // since nres is unsigned + exit; + + if _pResourceData = nil then + ReadFileBlock( _pResourceData, + _pHeader^.resstart, + _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics + + pResourceIDs := _pResourceData; + pTopicIndices := _pResourceData + + _pHeader^.nres * sizeof( uint16 ); + + for i := 0 to _pHeader^.nres - 1 do + begin + if pTopicIndices^[ i ] = Topic.Index then + begin + // found + ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) ); + end; + end; +end; + +procedure THelpFile.ReadReferencedFilesTable; +var + i: longint; + p: pointer; + pData: pointer; + DatabaseName: string; + pLength: pByte; +begin + if _pExtendedHeader = nil then + // no extended header -> no referenced files table + exit; + + if _pExtendedHeader^.Numdatabase = 0 then + exit; + + pData := nil; // please allocate... + ReadFileBlock( pData, + _pExtendedHeader^.DatabaseOffset, + _pExtendedHeader^.DatabaseSize ); + + p := pData; + for i := 0 to _pExtendedHeader^.Numdatabase - 1 do + begin + pLength := p; // length byte, including itself + SetString(DatabaseName, p+1, pLength^-1); // use length value minus the length byte to get the string length + _ReferencedFiles.Add( DatabaseName ); + inc( p, pLength^ ); // skip to next entry using full length (including length byte) + end; + FreeMem( pData ); +end; + +procedure THelpFile.ReadFontTableData; +begin + if _pExtendedHeader = nil then + // no extended header -> no font table + exit; + + if _pExtendedHeader^.NumFontEntry = 0 then + exit; + + ReadFileBlock( _pFontTableData, + _pExtendedHeader^.FontTableOffset, + _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) ); +end; + +procedure THelpFile.ParseFontTable; +var + i: longint; + p: pointer; + pFontSpec: pTHelpFontSpec; +begin + _FontTable.Clear; + + p := _pFontTableData; + if p = nil then + exit; // no data + + for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do + begin + pFontSpec := p + i * sizeof( THelpFontSpec ); + _FontTable.Add( pFontSpec ); + end; +end; + +procedure THelpFile.GetImages( ImageOffsets: TList; + Images: TImageList ); +var + ListIndex: longint; + ImageOffset: longint; + Bitmap: THelpBitmap; +begin + Images.Clear; + + for ListIndex := 0 to ImageOffsets.Count - 1 do + begin + ImageOffset := longint( ImageOffsets[ ListIndex ] ); + try + Bitmap := THelpBitmap.CreateFromHelpFile( _Handle, + _pHeader^.imgstart + + ImageOffset ); + except + on e: EHelpBitmapException do +{ raise EHelpFileException.Create( 'Error loading help bitmap at' + + IntToStr( ImageOffset ) + + ': ' + + e.Message );} + begin + Bitmap := THelpBitmap.Create; + Bitmap.LoadFromResourceName( 'MissingBitmap' ); + end; + end; + + Images.Add( Bitmap, nil ); + Bitmap.Destroy; + + end; +end; + +function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap; +begin + try + Result := THelpBitmap.CreateFromHelpFile( _Handle, + _pHeader^.imgstart + + ImageOffset ); + except + on e: EHelpBitmapException do +{ raise EHelpFileException.Create( 'Error loading help bitmap at' + + IntToStr( ImageOffset ) + + ': ' + + e.Message );} + begin + result := nil; + end; + end; +end; + +function THelpFile.GetTopic( Index: longint ): TTopic; +begin + if ( Index < 0 ) + or ( Index > _Topics.Count - 1 ) then + Result := nil + else + Result := TTopic(_Topics[ Index ]); +end; + +function THelpFile.GetTopicCount: longint; +begin + Result := _Topics.Count; +end; + +function THelpFile.IndexOfTopic( Topic: TTopic ): longint; +begin + Result := _Topics.IndexOf( Topic ); +end; + +function THelpFile.GetDictionaryCount: longint; +begin + Result := _Dictionary.Count; +end; + +function THelpFile.GetDictionaryWord( Index: longint ): string; +begin + Result := _Dictionary[ Index ]; +end; + + +// Looks for fonts that should be substitued to the +// users selected fixed font +// doesn't make a lot of sense for this to be here... +procedure THelpFile.SetupFontSubstitutes( Substitutions: string ); +var + Item: string; + FontName: string; + SpacePos: longint; + W: longint; + H: longint; + i: longint; + pFontSpec: pTHelpFontSpec; + tmpSubstitutionItems : TStringList; + tmpCounter : integer; + tmpDimensionParts : TStringList; + s: string; + PointSize: word; + cp: integer; +begin + ParseFontTable; // (re)load table from raw data + + tmpSubstitutionItems := TStringList.Create; + StrExtractStrings(tmpSubstitutionItems, Substitutions, [';'], #0); + + for tmpCounter := 0 to tmpSubstitutionItems.Count - 1 do + begin + Item := tmpSubstitutionItems[tmpCounter]; + try + if Item <> '' then + begin + // Look for space in xxxx WxH + SpacePos := LastDelimiter(' ', Item); + if SpacePos > 0 then + begin + // fontname comes before + FontName := StrLeft( Item, SpacePos - 1 ); + Delete( Item, 1, SpacePos ); + + // width and height after, with an X between + tmpDimensionParts := TStringList.Create; + StrExtractStrings(tmpDimensionParts, Item, ['x'], #0); + W := StrToInt(tmpDimensionParts[0]); + H := StrToInt(tmpDimensionParts[1]); + tmpDimensionParts.Destroy; + if ( W > 0 ) and ( H > 0 ) then + begin + // Now look through the font table for matches + for i := 0 to _FontTable.Count - 1 do + begin + pFontSpec := _FontTable[ i ]; + cp := pFontSpec^.Codepage; + s := StrNPas( pFontSpec^.FaceName, sizeof( pFontSpec^.FaceName ) ); + if s = FontName then + begin + // same face name... + // this formula seems to give a simulated pointsize compared to + // what the original VIEW program intended. + PointSize := (pFontSpec^.Height * 2) div 3; + if ( H = PointSize ) then + begin + // match + pFontSpec^.Codepage := High(word); // font substitute marker added +// _FontTable[ i ] := SubstituteFixedFont; + end; + end; + end; + end; + end; + end; + except + end; + end; + + tmpSubstitutionItems.Free; +end; + + +// ------------------------------------------------------------- +// Get the title only from specific help file (if possible) + +function GetHelpFileTitle( const Filename: string ): string; +var + Header: THelpFileHeader; + fstream: TFileStream; + Ext: string; +begin + Ext := ExtractFileExt( Filename ); + Result := ''; + + if SameText( Ext, '.inf' ) + or SameText( Ext, '.hlp' ) then + begin + try + try + fstream := TFileStream.Create(Filename, fmOpenRead); + fstream.Position := 0; + FillChar( Header, sizeof( Header ), 0 ); + fstream.Read(Header, SizeOf(Header)); + if Header.ID = INF_HEADER_ID then + Result := StrPas(Header.title); + except + // silently ignore errors - it's not to critical at this point. + end; + finally + fstream.Free; + end; + end; +end; + + +end. + diff --git a/docview/src/HelpTopic.pas b/docview/src/HelpTopic.pas new file mode 100644 index 00000000..ea32080b --- /dev/null +++ b/docview/src/HelpTopic.pas @@ -0,0 +1,2698 @@ +Unit HelpTopic; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// This is it - the monster which decodes IPF data. +// It's created with a reference to the contents data defining it. +// It gets relevant pointers out of that. When GetText is called +// it decodes the data and spits out formatted text to suit +// RichTextView. + +uses + Classes, + HelpWindowDimensions, + IPFFileFormatUnit; + +const + DefaultGroupIndex = 0; + + RTF_NewLine = #10; + +var + { TODO -oGraeme -cPointers : I don't like this - double check alternatives later } + // placeholder for font table entry, indiciating user fixed font should be substituted + SubstituteFixedFont: pointer = Pointer(1); + +type + THelpLink = class(TObject) + public + HelpFile: TObject; // file this link is within + // Even though it doesn't do anything, + // we have to have a constructor to allow + // virtual constructors to work + constructor Create; virtual; + end; + + + THelpTopicSlot = class(TObject) + public + pData: pUInt8; // Pointer to actual Slot structure in INF file. + Size: longint; // Number of bytes in the text for this Slot (slotheader.ntext) + pLocalDictionary: UInt16ArrayPointer; // Pointer to Slot's local dictionary + LocalDictSize: uint8; // Number of entries in the local dictionary + destructor Destroy; override; + end; + + + THelpLinkClass = class of THelpLink; + + + TFootnoteHelpLink = class(THelpLink) + public + TopicIndex: longint; + Title: string; // from text within link + end; + + + TWindowedHelpLink = class(THelpLink) + public + GroupIndex: longint; // DefaultGroupIndex if not specified. + // Note: Overrides contents group index of topic + Automatic: boolean; // link should be automatically followed on topic display + Split: boolean; // link should open the window within the parent + ViewPort: boolean; // link should always open a new window + Dependent: boolean; // window opened by link should be closed + // when current topic is closed + Rect: THelpWindowRect; // Display window with this rectangle. + // Note: overrides contents rect + constructor Create; override; + destructor Destroy; override; + end; + + + TInternalHelpLink = class(TWindowedHelpLink) + public + TopicIndex: longint; + end; + + + THelpLinkByResourceID = class(TWindowedHelpLink) + public + ResourceID: longint; + end; + + + SlotArray = array[0..0] of THelpTopicSlot; + pSlotArray = ^SlotArray; + + + TFontState = (fsNormal, fsFixed, fsCustom); + TIPFTextAlignment = (itaLeft, itaRight, itaCenter, itaCenterOnePara); + + + TParseState = record + Alignment: TIPFTextAlignment; + ForegroundColorTag: string; + BackgroundColorTag: string; + Spacing: boolean; + FontState: TFontState; + InCharGraphics: boolean; + LinkIndex: longint; + StartOfTextBlock: longint; + TextBlock: string; + FootnoteLink: TFootnoteHelpLink; + StyleCode: longint; + end; + + + TTopic = class(TObject) + protected + _FileHandle: TFileStream; + _pTOCEntry: pTTOCEntryStart; + _pSlotOffsets: UInt32ArrayPointer; + _Slots: TList; + _pSlotNumbers: puint16; + _NumSlots: longint; + _Title: string; + _GlobalDictionary: TStringList; + _ShowInContents: boolean; + _ContentsLevel: integer; + _ContentsGroupIndex: longint; + _FontTable: TList; + _ReferencedFiles: TStrings; + procedure SetTitle( const NewValue: string ); + function GetTitle: string; + + // Returns the tag texts for the given bitmap ref + function GetImageText( CurrentAlignment: TIPFTextAlignment; + BitmapOffset: longint; + BitmapFlags: longint; + ImageOffsets: TList ): string; + + Procedure ProcessLinkedImage( Var State: TParseState; + Var pData: pByte; + Var OutputString: string; + ImageOffsets: TList ); + procedure TranslateIPFEscapeCode( Var State: TParseState; + Var pData: pUInt8; + var AText: String; + Var WordsOnLine: longint; + ImageOffsets: TList ); + + function CreateLink( Var LinkIndex: longint; + Var Link: THelpLink; + LinkClass: THelpLinkClass ): boolean; + + procedure EnsureSlotsLoaded; + + // returns true if the escape code at pData results in whitespace. + function IPFEscapeCodeSpace( Var State: TParseState; Var pData: pUInt8 ): boolean; + + function GetNextIPFTextItem( Var SlotIndex: longint; + Var pData: pUInt8; + Var State: TParseState ): longint; + + function CheckForSequence( WordSequences: TList; + SlotIndex: longint; + pData: pUint8; + State: TParseState; + GlobalDictIndex: longint + ): longint; + + public + HelpFile: TObject; + Index: longint; + SearchRelevance: longint; + Links: TList; // only valid after GetText + constructor Create( var FileHandle: TFileStream; + pSlotOffsets: UInt32ArrayPointer; + Dictionary: TStringList; + var pTOCEntry: pTTOCEntryStart; + FontTable: TList; + ReferencedFiles: TStrings ); + destructor Destroy; override; + property Title: string read GetTitle write SetTitle; + procedure SetTitleFromMem( const p: pointer; const Len: byte ); + // Main function for retrieving text for topic. + // HighlightSequences: list of sequences to highlight + // if nil then ignored. + // ShowCodes: indicates debugging: hex output of escape + // codes will be included + // ShowWordSeparators: | will be included after each dictionary + // word inserted + // Text: The output is written to here. IS NOT CLEARED FIRST. + // ImageOffsets: For each image that occurs in the text, + // the help file offset will be written to this list. + // HighlightMatches: if not nil, and HighlightSequences is not nil, + // will return offsets to each highlight match + procedure GetText( HighlightSequences: TList; + ShowCodes: boolean; + ShowWordSeparators: boolean; + var Text: String; + ImageOffsets: TList; + HighlightMatches: TList ); + // if StopAtFirstOccurrence true, returns 0 or 1 + // if false, returns count of occurrences of word + function SearchForWord( DictIndex: integer; + StopAtFirstOccurrence: boolean ): longint; + // searches for sequences out of those listed in WordSequence + // Each element of WordSequence contains a pointer to an array + // of flags for each dictionary word, indicating whether that word + // is to be a possible match. + function SearchForWordSequences( WordSequence: TList; StopAtFirstOccurrence: boolean ): longint; + procedure GetContentsWindowRect( ContentsRect: THelpWindowRect ); + // search for binary data including codes + function SearchForData( Data: pbyte; DataLen: integer ): boolean; + procedure SaveIPFEscapeCode( Var State: TParseState; + Var pData: pUInt8; + Var F: TextFile; + ImageOffsets: TList ); + procedure SaveToIPF( Var f: TextFile; ImageOffsets: TList ); + property ShowInContents: boolean read _ShowInContents; + property ContentsLevel: integer read _ContentsLevel; + property ContentsGroupIndex: longint read _ContentsGroupIndex; + function CountWord( DictIndex: integer ): longint; + function ContainsWord( DictIndex: integer ): boolean; + end; + + +// Compares two topics for purposes of sorting by +// search match relevance +function TopicRelevanceCompare( Item1, Item2: pointer ): longint; + +// Compares two topics for purposes of sorting by title +function TopicTitleCompare( Item1, Item2: pointer ): longint; + + +implementation + + +uses + SysUtils + ,NewViewConstantsUnit + ,nvUtilities + ,ACLStringUtility + ,SettingsUnit + ; + +const + IPFColors: array[ 0..15 ] of string = + ( + //rrggbb + '', // default + '#0000ff', // blue + '#ff0000', // red + '#ff00ff', // pink (purple) + '#00ff00', // green + '#00ffff', // cyan + '#ffff00', // yellow + '#808000', // neutral = brown + '#404040', // dark gray + '#000080', // dark blue + '#800000', // dark red + '#800080', // dark pink (purple) + '#008000', // dark green + '#008080', // dark cyan + '#000000', // black + '#c0c0c0' // pale gray + ); + + // for ecHighlight1 + IPFHighlight1Tags : array [ 0..6 ] of string = + ( + '</i></b></u></color>', // normal + '<i>', // hp1 italitc + '<b>', // hp2 bold + '<b><i>', // hp3 bold italic + '<u>', // hp5 underline + '<u><i>', // hp6 underline italic + '<u><b>' // hp7 underline bold + ); + + // for ecHighlight2 + IPFHighlight2Tags : array [ 0..3 ] of string = + ( + '</i></b></u></color>', // normal + '<color blue>', // hp4 blue + '<color red>', // hp8 red + '<color purple>' // hp9 purple + ); + + BlankString: string = ''; + +var + DefaultTitle: string; + + +function GetBeginLink( LinkIndex: longint ): string; +begin + Result := '<link ' + IntToStr( LinkIndex ) + '>' +end; + +function GetEndLinkTags( const State: TParseState ): string; +begin + Result := '</link>' + State.ForegroundColorTag; +end; + +// Even though it doesn't do anything, +// we have to have a constructor to allow +// virtual constructors to work +constructor THelpLink.Create; +begin + // do nothing +end; + +constructor TWindowedHelpLink.Create; +begin + GroupIndex := DefaultGroupIndex; + Automatic := false; + ViewPort := false; + Dependent := false; + Rect := THelpWindowRect.Create; +end; + +destructor TWindowedHelpLink.Destroy; +begin + Rect.Destroy; +end; + +destructor THelpTopicSlot.Destroy; +begin + { TODO -ograeme -ccleanup memory : Double check this } + FreeMem(pData);// DeallocateMemory( pData ); + FreeMem(pLocalDictionary); // DeallocateMemory( pLocalDictionary ); +end; + +constructor TTopic.Create( var FileHandle: TFileStream; + pSlotOffsets: UInt32ArrayPointer; + Dictionary: TStringList; + var pTOCEntry: pTTOCEntryStart; + FontTable: TList; + ReferencedFiles: TStrings ); +var + pExtendedInfo: pExtendedTOCEntry; + titleLen: integer; + XY: THelpXYPair; + p: pbyte; + Flags: byte; +begin + _FileHandle := FileHandle; + _pSlotOffsets := pSlotOffsets; + + _Title := ''; + _GlobalDictionary := Dictionary; + _ContentsGroupIndex := 0; + + _pTOCEntry := pTOCEntry; + _NumSlots := pTOCEntry^.numslots; + + Flags := _pTOCEntry^.flags; + p := pByte( _pTOCEntry ) + sizeof( TTOCEntryStart ); + + if ( Flags and TOCEntryExtended ) = TOCEntryExtended then + begin + pExtendedInfo := pExtendedTOCEntry( p ); + inc( p, sizeof( TExtendedTOCEntry ) ); + + if ( pExtendedInfo^.w1 and 1 ) > 0 then + // skip position + inc( p, sizeof( XY ) ); + + if ( pExtendedInfo^.w1 and 2 ) > 0 then + // skip size + inc( p, sizeof( XY ) ); + + if ( pExtendedInfo^.w1 and 8 ) > 0 then + // skip window controls + inc( p, sizeof(word) ); // increment by 2 + + if ( pExtendedInfo^.w1 and $40 ) > 0 then + // skip something else, unknown... style? 2 bytes + inc( p, sizeof(word) ); // increment by 2 + + if ( pExtendedInfo^.w2 and 4 ) > 0 then + begin + _ContentsGroupIndex := pUInt16(p)^; + // read group + inc( p, sizeof( uint16 ) ); + end; + end; + + // skip slot numbers for now. + _pSlotNumbers := pUInt16(p); + inc( p, _NumSlots * sizeof( uint16 ) ); + + // Calculate the remainder of the tocentry length - that is the bytes used for TOC topic (title) text + titleLen := _pTOCEntry^.length - ( longword( p ) - longword( _pTOCEntry ) ); + + // Read title + if TitleLen > 0 then + SetTitleFromMem( p, TitleLen ) + else + Title := DefaultTitle; + + _ContentsLevel := ( Flags and TOCEntryLevelMask ); + _ShowInContents := Flags and TOCEntryHidden = 0; + if _ContentsLevel = 0 then + _ShowInContents := false; // hmmm.... + + _FontTable := FontTable; + _ReferencedFiles := ReferencedFiles; +end; + +destructor TTopic.Destroy; +begin + LogEvent(LogObjConstDest, 'TTopic.Destroy'); + DestroyListAndObjects( Links ); + DestroyListAndObjects( _Slots ); + inherited Destroy; +end; + +procedure TTopic.SetTitle( const NewValue: string ); +begin + _Title := NewValue; +end; + +procedure TTopic.SetTitleFromMem( const p: pointer; const Len: byte ); +begin + //FreePString( _Title ); + //GetMem( _Title, Len + 1 ); + //_Title^[ 0 ] := char( Len ); + //MemCopy( p, _Title + 1, Len ); + SetString(_Title, p, Len); +end; + +function TTopic.GetTitle: string; +begin + Result := _Title; +end; + +// Replace < and > characters with doubles << and >> +// for compatibility with richtextview. +// This works in place, assuming that instances of > or < are +// actually rare. In practice, IPF normally would insert these +// two characters as distinct words, but I don't want to assume that. +procedure SubstituteAngleBrackets( Var s: string ); +var + i: integer; +begin + i := 1; + while i <= Length( S ) do + begin + case S[ i ] of + '<': + begin + Insert( '<', s, i ); + inc( i ); + end; + + '>': + begin + Insert( '>', s, i ); + inc( i ); + end; + end; + inc( i ); + end; +end; + +function TTopic.GetImageText( CurrentAlignment: TIPFTextAlignment; + BitmapOffset: longint; + BitmapFlags: longint; + ImageOffsets: TList ): string; +var + BitmapIndex: longint; + OriginalAlignTag: string; + ImageTag: string; + AlignTag: string; +begin + BitmapIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) ); + if BitmapIndex = -1 then + BitmapIndex := ImageOffsets.Add( pointer( BitmapOffset ) ); + + ImageTag := '<image ' + + IntToStr( BitmapIndex ) + + '>'; + + if ( BitmapFlags and $08 ) > 0 then + begin + // stretch to fit - not implemented + end; + + // aligned + case CurrentAlignment of + itaLeft: + OriginalAlignTag := '<align left>'; + itaRight: + OriginalAlignTag := '<align right>'; + itaCenter, + itaCenterOnePara: + OriginalAlignTag := '<align center>'; + end; + + case BitmapFlags and 7 of + 0, // curious - should not occur? does in dbexpert.hlp + 1: // left + AlignTag := '<align left>'; + 2: // right + AlignTag := '<align right>'; + 4,5: // centre (4 is official, 5 seems to occur too) + AlignTag := '<align center>'; + end; + + Result := AlignTag + + ImageTag + + OriginalAlignTag; + + if ( BitmapFlags and $10 ) = 0 then + begin + // NOT runin, new lines before and after + Result := RTF_NewLine + Result + RTF_NewLine; + end; + +end; + +Procedure SaveImageText( BitmapOffset: longint; + BitmapFlags: longint; + Var F: TextFile; + ImageOffsets: TList ); +var + ImageIndex: longint; +begin + ImageIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) ); + if ImageIndex = -1 then + ImageIndex := ImageOffsets.Add( pointer( BitmapOffset ) ); + + Write( F, ':artwork name=' ); + Write( F, StrInSingleQuotes('img' + IntToStr(ImageIndex) + '.bmp') ); + + case BitmapFlags and 7 of + 2: // right + Write( F, ' align=right' ); + 4,5: // centre (4 is official, 5 seems to occur too) + Write( F, ' align=center' ); + end; + + if ( BitmapFlags and $10 ) > 0 then + begin + // runin + Write( F, ' runin' ); + end; + + // fit ... + Write( F, '.' ); +end; + +Procedure TTopic.ProcessLinkedImage( Var State: TParseState; + Var pData: pByte; + Var OutputString: string; + ImageOffsets: TList ); +var + EscapeLen: uint8; + EscapeCode: uint8; + SubEscapeCode: uint8; + BitmapOffset: longword; + BitmapFlags: uint8; + Link: TInternalHelpLink; + LinkTopicIndex: uint16; +begin + LinkTopicIndex := -1; + while true do + begin + EscapeLen := pData^; + SubEscapeCode := ( pData + 2 )^; + case SubEscapeCode of + HPART_DEFINE: + begin + BitmapFlags := ( pData + 3 )^; + BitmapOffset := pUInt32( pData + 4 )^; + end; + + HPART_HDREF: // define whole bitmap topic link? + begin + LinkTopicIndex := pUInt16( pData + 3 )^; + end; + end; + inc( pData, EscapeLen ); + + // Now pData points at next code or item + if pData^ <> IPF_ESC then + // not an escape code, done + break; + EscapeCode := (pData + 2) ^; + if EscapeCode <> ecLinkedImage then + // not a hyperlink code, done + break; + // another linked image code is coming up. + SubEscapeCode := ( pData + 3 )^; + if SubEscapeCode = HPART_DEFINE then + // started another linked image. + break; + inc( pData ); // move pointer to escape code len. + end; + + OutputString := GetImageText( State.Alignment, + BitmapOffset, + BitmapFlags, + ImageOffsets ); + + // Don't make it a link if we didn't find a + // overall link code, i.e. degrade gracefully. + if LinkTopicIndex > -1 then + begin + if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then + begin + Link.TopicIndex := LinkTopicIndex; + end; + + OutputString := GetBeginLink( State.LinkIndex ) + + OutputString + + GetEndLinkTags( State ); + + inc( State.LinkIndex ); + end; + +end; + +Procedure SaveLinkedImage( Var pData: pByte; + Var F: TextFile; + ImageOffsets: TList ); +var + EscapeLen: uint8; + EscapeCode: uint8; + SubEscapeCode: uint8; + BitmapOffset: longword; + BitmapFlags: uint8; + LinkTopicIndex: uint16; +begin + LinkTopicIndex := -1; + while true do + begin + EscapeLen := pData^; + SubEscapeCode := ( pData + 2 )^; + case SubEscapeCode of + HPART_DEFINE: + begin + BitmapFlags := ( pData + 3 )^; + BitmapOffset := pUInt32( pData + 4 )^; + end; + + HPART_HDREF: // define whole bitmap topic link? + begin + LinkTopicIndex := pUInt16( pData + 3 )^; + end; + end; + inc( pData, EscapeLen ); + + // Now pData points at next code or item + if pData^ <> IPF_ESC then + // not an escape code, done + break; + EscapeCode := (pData + 2) ^; + if EscapeCode <> ecLinkedImage then + // not a hyperlink code, done + break; + // another linked image code is coming up. + SubEscapeCode := ( pData + 3 )^; + if SubEscapeCode = HPART_DEFINE then + // started another linked image. + break; + inc( pData ); // move pointer to escape code len. + end; + + SaveImageText( BitmapOffset, + BitmapFlags, + F, + ImageOffsets ); + + // Don't make it a link if we didn't find a + // overall link code, i.e. degrade gracefully. + if LinkTopicIndex > -1 then + begin + WriteLn( F, '' ); + WriteLn( F, ':artlink.' ); + Write( F, ':link reftype=hd' ); + Write( F, ' refid=' + IntToStr( LinkTopicIndex ) ); + WriteLn( F, '.' ); + WriteLn( F, ':eartlink.' ); + end; + +end; + +Procedure GetExtraLinkData( Link: TWindowedHelpLink; + pData: pUInt8 ); +var + LinkFlags1: uint8; + LinkFlags2: uint8; + LinkDataIndex: longint; + pLinkXY: pHelpXYPair; + pLinkData: pUInt8; +begin + LinkFlags1 := ( pData + 0 ) ^; + LinkFlags2 := ( pData + 1 ) ^; + + pLinkData := pData + 2; + + if ( LinkFlags1 and 1 ) > 0 then + begin + // position specified + pLinkXY := pHelpXYPair( pLinkData ); + ReadHelpPosition( pLinkXY^, Link.Rect ); + inc( pLinkData, sizeof( THelpXYPair ) ); + end; + + if ( LinkFlags1 and 2 ) > 0 then + begin + // size specified + pLinkXY := pHelpXYPair( pLinkData ); + ReadHelpSize( pLinkXY^, Link.Rect ); + inc( pLinkData, sizeof( THelpXYPair ) ); + end; + + if ( LinkFlags1 and 8 ) > 0 then + begin + // window controls specified - skip + inc( pLinkData, 2 ); + end; + + if ( LinkFlags2 and 4 ) > 0 then + begin + // group specified + Link.GroupIndex := pUInt16( pLinkData )^; + inc( LinkDataIndex, sizeof( uint16 ) ); + end; + + if ( LinkFlags1 and 64 ) > 0 then + begin + Link.Automatic := true; + end; + + if ( LinkFlags1 and 4 ) > 0 then + Link.ViewPort := true; + + if ( LinkFlags2 and 2 ) > 0 then + Link.Dependent := true; + + if ( LinkFlags1 and 128 ) > 0 then + Link.Split := true; + + // cant be bothered with the others. +end; + +// If the given link has already been decoded +// ie. the topic has been displayed before, +// then return the already decoded link & return false +// Otherwise, create a new link object & return true +function TTopic.CreateLink( Var LinkIndex: longint; + Var Link: THelpLink; + LinkClass: THelpLinkClass ): boolean; +begin + if LinkIndex >= Links.Count then + begin + Link := LinkClass.Create; + Link.HelpFile := HelpFile; + Links.Add( Link ); + Result := true; + end + else + begin + Link := THelpLink(Links[ LinkIndex ]); + Result := false; + end; +end; + +const + // size of the original View's default font + AverageViewCharWidth = 8; + +procedure GetMarginTag( const Margin: longint; + FontState: TFontState; + Var MarginString: string; + BreakIfPast: boolean ); +begin + MarginString := '<leftmargin '; + if FontState <> fsCustom then + // for standard fonts, scale margins to match font + MarginString := MarginString + IntToStr( Margin ) + else + // for custom fonts, since the IPF margins were always in + // terms of the standard font size, set the margin to a width based on that. + MarginString := MarginString + IntToStr( Margin * AverageViewCharWidth ) + ' pixels'; + + if BreakIfPast then + MarginString := MarginString + ' breakifpast'; + + MarginString := MarginString + '>'; +end; + +// TODO +function FullDoubleQuote( const s: string ): string; +begin + Result := StrDoubleQuote + + StrEscapeAllCharsBy(s, [], CharDoubleQuote) + + StrDoubleQuote; +end; + +// End URL, if it has been started. Go back and insert the start tag, +// and add the end tag. +procedure CheckForAutoURL( var Text: string; var State: TParseState ); +var + T: string; +begin + if State.StartOfTextBlock = -1 then + // haven't got any text yet + exit; + + TrimPunctuation( State.TextBlock ); + + if not CheckAndEncodeURL( State.TextBlock ) then + begin + // not a URL we know + State.TextBlock := ''; + exit; + end; + + // It's a URL. Insert link at start of URL + T := '<blue><link ' + PARAM_LINK_URL + ' "'; + T := T + State.TextBlock; + T := T + '">'; + Insert(T, Text, State.StartOfTextBlock); + Text := Text + GetEndLinkTags(State); + + State.TextBlock := ''; + State.StartOfTextBlock := -1; +end; + +procedure TTopic.TranslateIPFEscapeCode( Var State: TParseState; + Var pData: pUInt8; + var AText: String; + Var WordsOnLine: longint; + ImageOffsets: TList ); +var + EscapeLen: uint8; + EscapeCode: uint8; + + Link: TInternalHelpLink; + FootnoteLink: TFootnoteHelpLink; + LinkByResourceID: THelpLinkByResourceID; + + Margin: integer; + + BitmapOffset: longword; + BitmapFlags: uint8; + + ColorCode: uint8; + StyleCode: uint8; + + FontIndex: uint8; + pFontSpec: pTHelpFontSpec; + + FaceName: string; + PointSize: longint; + QuotedFaceName: string; + + ExternalLinkFileIndex: uint8; + ExternalLinkTopicID: string; + + ProgramLink: string; + ProgramPath: string; + ProgramFilename: string; + ProgramInfo : TSerializableStringList; + tmpProgramLinkParts : TStringList; + + OutputString: string; +begin + EscapeLen := pData^; + EscapeCode := (pData + 1)^; + OutputString := ''; + + case EscapeCode of + + ecSetLeftMargin: + begin + CheckForAutoURL( AText, State ); + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, false ); + end; + + ecSetLeftMarginNewLine: + begin + CheckForAutoURL( AText, State ); + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, false ); + OutputString := OutputString + + RTF_NewLine; + end; + + ecSetLeftMarginFit: + begin + CheckForAutoURL( AText, State ); + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, true ); + // note that this will cause following tex to be "tabbed" across to the + // new margin position, if not yet there. + // if we are already past this margin then a new line should be started. + + end; + + ecSetLeftMarginHere: + begin + OutputString := '<leftmargin here>'; + end; + + ecHighlight1: + begin + StyleCode := ( pData + 2 )^; + if StyleCode <= High( IPFHighlight1Tags ) then + OutputString := IPFHighlight1Tags[ StyleCode ]; + if StyleCode = 0 then + State.ForegroundColorTag := '</color>'; + end; + + ecHighlight2: + begin + StyleCode := ( pData + 2 )^; + if StyleCode <= High( IPFHighlight2Tags ) then + OutputString := IPFHighlight2Tags[ StyleCode ]; + + if StyleCode = 0 then + State.ForegroundColorTag := '</color>' + else + State.ForegroundColorTag := OutputString; // only colours + end; + + ecLinkStart: + begin + CheckForAutoURL( AText, State ); + if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then + begin + Link.TopicIndex := pUInt16( pData + 2 )^; + + if EscapeLen >= 6 then + begin + GetExtraLinkData( Link, pData + 4 ); + end; + end; + + // If it's not an automatic link + // then put code in to show it. + if not Link.Automatic then + begin + OutputString := '<blue>' + + GetBeginLink( State.LinkIndex ); + end; + + inc( State.LinkIndex ); + end; + + ecFootnoteLinkStart: + begin + CheckForAutoURL( AText, State ); + if CreateLink( State.LinkIndex, FootnoteLink, TFootnoteHelpLink ) then + begin + FootnoteLink.TopicIndex := pUInt16( pData + 2 )^; + State.FootnoteLink := FootnoteLink; + end; + + OutputString := '<blue>' + GetBeginLink( State.LinkIndex ); + + inc( State.LinkIndex ); + end; + + ecStartLinkByResourceID: + begin + CheckForAutoURL( AText, State ); + if CreateLink( State.LinkIndex, LinkByResourceID, THelpLinkByResourceID ) then + begin + LinkByResourceID.ResourceID := pUInt16( pData + 2 )^; + + if EscapeLen >= 6 then + begin + GetExtraLinkData( LinkByResourceID, pData + 4 ); + end; + end; + + OutputString := '<blue>' + GetBeginLink( State.LinkIndex ); + + inc( State.LinkIndex ); + end; + + ecExternalLink: + begin + CheckForAutoURL( AText, State ); + // :link reftype=hd refid=... database=<filename> + ExternalLinkFileIndex := ( pData + 2 )^; + ExternalLinkTopicID := StrNPas( pchar(pData + 4), (pData + 3)^ ); + OutputString := '<blue><link ' + PARAM_LINK_EXTERNAL + ' ' + + IntToStr( ExternalLinkFileIndex ) + + ' ' + + ExternalLinkTopicID + + '>' + + end; + + ecProgramLink: + begin + CheckForAutoURL( AText, State ); + ProgramLink := StrNPas( pchar(pData + 3), EscapeLen-3 ); + + tmpProgramLinkParts := TStringList.Create; + StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0); + ProgramPath := tmpProgramLinkParts[0]; + tmpProgramLinkParts.Destroy; + + ProgramFilename := ExtractFilename( ProgramPath ); + + if StrStartsWithIgnoringCase(ProgramFilename, PRGM_EXPLORER) + or StrStartsWithIgnoringCase(ProgramFilename, PRGM_NETSCAPE) + or StrStartsWithIgnoringCase(ProgramFilename, PRGM_MOZILLA) + or StrStartsWithIgnoringCase(ProgramFilename, PRGM_FIREFOX) + then + begin + OutputString := '<blue><link ' + PARAM_LINK_URL + ' ' + + FullDoubleQuote( ProgramLink ) + + '>'; + end + else + begin + ProgramInfo := TSerializableStringList.create; + ProgramInfo.add(ProgramPath); + ProgramInfo.add(ProgramLink); + OutputString := '<blue><link ' + PARAM_LINK_PROGRAM + ' ' + + ProgramInfo.getSerializedString + + '>'; + ProgramInfo.destroy; + end; + end; + + ecLinkEnd: + begin + OutputString := GetEndLinkTags( State ); + if State.FootnoteLink <> nil then + State.FootnoteLink := nil; + end; + + ecStartCharGraphics: + begin + State.FontState := fsFixed; + State.InCharGraphics := true; + OutputString := RTF_NewLine + RTF_NewLine + '<tt><wrap no>'; + State.Spacing := false; + WordsOnLine := 0; + end; + + ecEndCharGraphics: + begin + State.FontState := fsNormal; + State.InCharGraphics := false; + OutputString := '</tt><wrap yes>' + RTF_NewLine; + State.Spacing := true; + end; + + ecImage: + begin + CheckForAutoURL( AText, State ); + BitmapFlags := ( pData + 2 )^; + BitmapOffset := pUInt32( pData + 3 )^; + + OutputString := GetImageText( State.Alignment, + BitmapOffset, + BitmapFlags, + ImageOffsets ); + if State.Spacing + AND (OutputString[Length(OutputString)] <> RTF_NewLine) // no space after a line break + then + OutputString := OutputString + ' '; + end; + + ecLinkedImage: + begin + CheckForAutoURL( AText, State ); + ProcessLinkedImage( State, + pData, + OutputString, + ImageOffsets ); + if State.Spacing then + OutputString := OutputString + ' '; + + // Note! Early exit, since the procedure + // will update pData. + AText := AText + OutputString; + exit; + end; + + ecStartLines: + begin + CheckForAutoURL( AText, State ); + // aligned text + case ( pData + 2 )^ of + 0, // just in case - to match image alignment oddities + 1: + begin + OutputString := RTF_NewLine + '<align left>'; + State.Alignment := itaLeft; + end; + + 2: + begin + OutputString := RTF_NewLine + '<align right>'; + State.Alignment := itaRight; + end; + + 4: + begin + OutputString := RTF_NewLine + '<align center>'; + State.Alignment := itaCenter; + end; + end; + OutputString := OutputString + '<wrap no>'; + WordsOnLine := 0; + end; + + ecEndLines: + begin + CheckForAutoURL( AText, State ); + // supposed to turn word wrap on, default font + OutputString := '<align left><wrap yes>'; // I guess... + State.Alignment := itaLeft; + end; + + ecForegroundColor: + begin + ColorCode := ( pData + 2 )^; + if ColorCode = 0 then + State.ForegroundColorTag := '</color>' + else if ColorCode <= High( IPFColors ) then + State.ForegroundColorTag := '<color ' + IPFColors[ ColorCode ] + '>'; + OutputString := State.ForegroundColorTag; + end; + + ecBackgroundColor: + begin + ColorCode := ( pData + 2 )^; + if ColorCode = 0 then + State.BackgroundColorTag := '</backcolor>' + else if ColorCode <= High( IPFColors ) then + State.BackgroundColorTag := '<backcolor ' + IPFColors[ ColorCode ] + '>'; + OutputString := State.BackgroundColorTag; + end; + + ecFontChange: + begin + FontIndex := ( pData + 2 )^; + if FontIndex = 0 then + begin + // back to default font + OutputString := '</font>'; + State.FontState := fsNormal; + end + else if FontIndex < _FontTable.Count then + begin + // valid font index + pFontSpec := _FontTable[ FontIndex ]; + +// if pFontSpec = SubstituteFixedFont then + if pFontSpec^.Codepage = High(word) then // Substitute Fixed Font detected + begin + OutputString := '<tt>'; + State.FontState := fsFixed; + end + else + begin +// pFontSpec := _FontTable[ FontIndex ]; + FaceName := StrNPas( pFontSpec^.FaceName, sizeof(pFontSpec^.FaceName) ); + // arbitrarily and capriciously use specified height * 2/3 + // as the point size - seems to correspond to what original + // view wanted... note this doesn't necessarily scale + // correctly, since default font could be different. whatever. + PointSize := (pFontSpec^.Height * 2) div 3; + + if PointSize < 8 then + PointSize := 8; + // quote font name, escape double quotes with duplicates + // e.g. Bob's "Big" Font would become + // "Bob's ""Big"" Font" + QuotedFaceName := FullDoubleQuote( FaceName ); + OutputString := '<font ' + + QuotedFaceName + + ' ' + + IntToStr( PointSize ) + + '>'; + { + // for when (if ever) RTV allows setting font + // by precise dimensions + + '[' + + IntToStr( pFontSpec ^. Width ) + + 'x' + + IntToStr( pFontSpec ^. Height ) + + ']'; + } + State.FontState := fsCustom; + end; + end; + end + end; // case escape code of... + + AText := AText + OutputString; + inc( pData, EscapeLen ); +end; + +// returns true if the escape code results in whitespace +// also updates the bits of State that relate to spacing +// ie. .Spacing, and .InCharGraphics (which affects whether +// spacing is reset at paragraph ends etc) +function TTopic.IPFEscapeCodeSpace( Var State: TParseState; + Var pData: pUInt8 ): boolean; +var + EscapeLen: uint8; + EscapeCode: uint8; + +begin + EscapeLen := pData^; + EscapeCode := (pData + 1) ^; + + result := false; // for most + case EscapeCode of + ecSetLeftMargin, + ecSetLeftMarginNewLine, + ecSetLeftMarginFit: + result := true; + + ecStartCharGraphics: + begin + result := true; + State.InCharGraphics := true; + State.Spacing := false; + end; + + ecEndCharGraphics: + begin + result := true; + State.InCharGraphics := false; + State.Spacing := true; + end; + + ecImage: + result := State.Spacing; + + ecLinkedImage: + result := State.Spacing; + + ecStartLines: + begin + result := true; + State.Spacing := false; + end; + + ecEndLines: + begin + result := true; + // supposed to turn word wrap on, default font + State.Spacing := true; + end; + end; // case escape code of... + + inc( pData, EscapeLen ); +end; + +procedure TTopic.EnsureSlotsLoaded; +var + i: longint; + pSlotNumber: puint16; + SlotNumber: uint16; + SlotHeader: TSlotHeader; + Slot: THelpTopicSlot; + bytes: integer; + expected: integer; +begin + if _Slots = nil then + begin + try + _Slots := TList.Create; + + // Read slot data + pSlotNumber := _pSlotNumbers; + + for i := 1 to _NumSlots do + begin + SlotNumber := pSlotNumber^; + + // Seek to start of slot + try + _FileHandle.Seek(_pSlotOffsets^[SlotNumber], soBeginning); + except + // not a valid offset + raise EHelpFileException.Create( ErrorCorruptHelpFile ); + end; + + // Read header + bytes := _FileHandle.Read(SlotHeader, SizeOf(TSlotHeader)); + if bytes <> SizeOf(TSlotHeader) then + // couldn't read slot header + raise EHelpFileException.Create( 'Failed to load Topic Slots.' ); + + // Create slot object + Slot := THelpTopicSlot.Create; + + Slot.LocalDictSize := SlotHeader.nLocalDict; + Slot.Size := SlotHeader.ntext; + + // Allocate and read slot dictionary + _FileHandle.Seek(SlotHeader.localDictPos, soBeginning); + expected := uint32(Slot.LocalDictSize) * sizeof(uint16); // size we need + if Slot.pLocalDictionary = nil then + // allocate memory + Slot.pLocalDictionary := GetMem(expected); + bytes := _FileHandle.Read(Slot.pLocalDictionary^, expected); + if bytes <> expected then + raise EHelpFileException.Create('Failed to read complete slot dictionary'); + + // Allocate and read slot data (text) + _FileHandle.Seek(_pSlotOffsets^[SlotNumber] + sizeof(TSlotHeader), soBeginning); + expected := Slot.Size; // size we need + if Slot.pData = nil then + // allocate memory + Slot.pData := GetMem(expected); + bytes := _FileHandle.Read(Slot.pData^, expected); + if bytes <> expected then + raise EHelpFileException.Create('Failed to read complete slot data (text)'); + + _Slots.Add( Slot ); + inc( pByte(pSlotNumber), sizeof( UInt16 ) ); + end; + except + on E: EHelpFileException do + begin + DestroyListAndObjects( _Slots ); + raise; + end; + end; + end; +end; + +// returns a global dict index. +// or, -1 for a whitespace item. +// or, -2 for end of text. +function TTopic.GetNextIPFTextItem( Var SlotIndex: longint; + Var pData: pUInt8; + Var State: TParseState ): longint; +var + Slot: THelpTopicSlot; + pSlotEnd: pUInt8; + + LocalDictIndex: uint8; +begin + while SlotIndex < _NumSlots do + begin + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + pSlotEnd := Slot.pData + Slot.Size; + + while pData < pSlotEnd do + begin + LocalDictIndex := pData^; + inc( pData ); + + if LocalDictIndex < Slot.LocalDictSize then + begin + // Normal word lookup + result := Slot.pLocalDictionary^[ LocalDictIndex ]; + exit; + end; + + // special code + case LocalDictIndex of + IPF_END_PARA: + begin + result := -1; + if not State.InCharGraphics then + State.Spacing := true; + exit; + end; + + IPF_CENTER: + begin + result := -1; + exit; + end; + + IPF_INVERT_SPACING: + begin + State.Spacing := not State.Spacing; + end; + + IPF_LINEBREAK: + begin + result := -1; + if not State.InCharGraphics then + State.Spacing := true; + exit; + end; + + IPF_SPACE: + begin + result := -1; + exit; + end; + + IPF_ESC: + begin + // escape sequence + if IPFEscapeCodeSpace( State, pData ) then + result := -1; + end; + end; + end; // while in slot... + inc( SlotIndex ); + end; + Result := -2; +end; + +// Checks to see if the given word (at pData) +// starts one of the given sequences, by looking forward +// If found, returns the length of the sequence. +function TTopic.CheckForSequence( WordSequences: TList; + SlotIndex: longint; + pData: pUint8; + State: TParseState; + GlobalDictIndex: longint + ): longint; +var + WordSequence: TList; + SequenceStepIndex: longint; + pSequenceStepWords: Uint32ArrayPointer; + + SequenceIndex: longint; + + SlotIndexTemp: longint; + pDataTemp: pUint8; + StateTemp: TParseState; +// s : string; + DictIndex: longint; +begin + result := 0; // if we don't find a match. + + for SequenceIndex := 0 to WordSequences.Count - 1 do + begin + WordSequence := TList(WordSequences[ SequenceIndex ]); + pSequenceStepWords := WordSequence[ 0 ]; + + if pSequenceStepWords^[ GlobalDictIndex ] > 0 then + begin + // matched first step in this sequence. Look ahead... + + SequenceStepIndex := 0; + + pDataTemp := pData; + SlotIndexTemp := SlotIndex; + StateTemp := State; + while true do + begin + inc( SequenceStepIndex ); + if SequenceStepIndex = WordSequence.Count then + begin + // have a match for the sequence, insert start highlight + Result := WordSequence.Count; + break; + end; + + // get words for next step in sequence + pSequenceStepWords := WordSequence[ SequenceStepIndex ]; + + DictIndex := GetNextIPFTextItem( SlotIndexTemp, + pDataTemp, + StateTemp ); + if DictIndex = -2 then + begin + // end of text - abort + break; + end; + + if DictIndex = -1 then + begin + // whitespace - abort + // for multi-word phrase searching - count this and subsequent whitespace... + break; + end; + +// s := _GlobalDictionary[ DictIndex ]; // for debug only + if not StrIsEmptyOrSpaces(_GlobalDictionary[ DictIndex ]) then + begin + if pSequenceStepWords^[ DictIndex ] = 0 then + begin + // word doesn't match - abort + break; + end; + end; + + end; // while + + end; + // else - doesn't match first step, do nothing + end; // for sequenceindex ... +end; + +// Main translation function. Turns the IPF data into +// a text string. Translates formatting codes into tags +// as for Rich Text Viewer. +procedure TTopic.GetText( HighlightSequences: TList; + // each element is a TList + // containing a sequence of possible words + // each element of each sequence + // is an array of flags for the dictionary + // indicating if the word is a allowed match at that step + // a match is any sequence that matches one or more words at each step. + ShowCodes: boolean; + ShowWordSeparators: boolean; + var Text: String; + ImageOffsets: TList; + HighlightMatches: TList ); +var + SlotIndex: integer; + Slot: THelpTopicSlot; + pData: pUInt8; + pSlotEnd: pUInt8; + + GlobalDictIndex: uint32; + + WordsOnLine: longint; + + StringToAdd: string; + LocalDictIndex: uint8; + + State: TParseState; + + EscapeLen: uint8; + i: longint; + + SequenceStepIndex: longint; +begin + if Links = nil then + Links := TList.Create; + + if HighlightMatches <> nil then + HighlightMatches.Clear; + + // Text.Clear; + ImageOffsets.Clear; + + try + EnsureSlotsLoaded; + except + on E: EHelpFileException do + begin + Text := Text + E.Message; + exit; + end; + end; + + WordsOnLine := 0; + + State.LinkIndex := 0; + State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot + State.InCharGraphics := false; + State.Spacing := true; + State.ForegroundColorTag := '</color>'; + State.BackgroundColorTag := '</backcolor>'; + State.StartOfTextBlock := -1; + State.TextBlock := ''; + State.FootnoteLink := nil; + Text := Text + '<leftmargin 1>'; + + SequenceStepIndex := 0; + + for SlotIndex := 0 to _NumSlots - 1 do + begin + if not State.InCharGraphics then + State.Spacing := true; // this is just a guess as to the exact view behaviour. + // inf.txt indicates that spacing is reset to true at + // slot (cell) start, but that doesn't seem to be the + // case when in character graphics... hey ho. + + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + pData := Slot.pData; + pSlotEnd := pData + Slot.Size; + State.Alignment := itaLeft; + + while pData < pSlotEnd do + begin + LocalDictIndex := pData^; + inc( pData ); + + if LocalDictIndex < Slot.LocalDictSize then + begin + // Normal word lookup + GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ]; + + if ShowWordSeparators then + Text := Text + '{' + IntToStr( GlobalDictIndex )+ '}'; + + // normal lookup + if GlobalDictIndex < _GlobalDictionary.Count then + StringToAdd := _GlobalDictionary[ GlobalDictIndex ] + else + StringToAdd := ''; + + if StrIsEmptyOrSpaces( StringToAdd ) then + begin + // spaces only... + CheckForAutoURL( Text, State ); + end + else + begin + // really is a word, not a space. + + // store string into "word" + if Length(State.TextBlock) = 0 then + // store start of block + State.StartOfTextBlock := Length(Text); + + State.TextBlock := State.TextBlock + StringToAdd; + + SubstituteAngleBrackets( StringToAdd ); + + if HighlightSequences <> nil then + begin + if SequenceStepIndex > 0 then + begin + // currently highlighting a sequence. + dec( SequenceStepIndex ); + if SequenceStepIndex = 0 then + begin + // now finished, insert end highlight + StringToAdd := StringToAdd + + State.BackgroundColorTag; + + end; + end + else + begin + // not yet in a sequence, searching. + SequenceStepIndex := + CheckForSequence( HighlightSequences, + SlotIndex, + pData, + State, + GlobalDictIndex ); + + if SequenceStepIndex > 0 then + begin + // this word starts a sequence! + if HighlightMatches <> nil then + HighlightMatches.Add( pointer( Length(Text) ) ); + StringToAdd := '<backcolor #' + + IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 ) + + '>' + + StringToAdd; + dec( SequenceStepIndex ); + if SequenceStepIndex = 0 then + // and ends it. + StringToAdd := StringToAdd + + State.BackgroundColorTag; + end; + + end; + end; // if processing sequence + inc( WordsOnLine ); + end; + + Text := Text + StringToAdd; + + if State.FootnoteLink <> nil then + begin + State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd; + if State.Spacing then + begin + State.FootnoteLink.Title := State.FootnoteLink.Title + ' '; + end; + end; + + if State.Spacing then + begin + CheckForAutoURL( Text, State ); + Text := Text + ' '; + end; + end + else + begin + // special code + + if ShowCodes then + begin + Text := Text + '[' + IntToHex( LocalDictIndex, 2 ); + if LocalDictIndex = IPF_ESC then + begin + EscapeLen := pData^; + for i := 1 to EscapeLen - 1 do + Text := Text + ' ' + IntToHex( ( pData + i )^, 2 ); + end; + Text := Text + ']'; + end; + + case LocalDictIndex of + IPF_END_PARA: + begin + if SlotIndex = 0 then + if pData - 1 = Slot.pData then + // ignore first FA, not needed with RichTextView + continue; + + CheckForAutoURL( Text, State ); + if State.Alignment = itaCenterOnePara then + begin + State.Alignment := itaLeft; + Text := Text + '<align left>'; + end; + Text := Text + RTF_NewLine; + + if WordsOnLine > 0 then + Text := Text + RTF_NewLine; + + if not State.InCharGraphics then + State.Spacing := true; + + WordsOnLine := 0; + end; + + IPF_CENTER: + begin + CheckForAutoURL( Text, State ); + Text := Text + RTF_NewLine + '<align center>'; + State.Alignment := itaCenterOnePara; + end; + + IPF_INVERT_SPACING: + begin + if not State.InCharGraphics then + State.Spacing := not State.Spacing; + end; + + IPF_LINEBREAK: + begin + CheckForAutoURL( Text, State ); + + if State.Alignment = itaCenterOnePara then + begin + State.Alignment := itaLeft; + Text := Text + '<align left>'; + end; + Text := Text + RTF_NewLine; + if not State.InCharGraphics then + State.Spacing := true; + WordsOnLine := 0; + end; + + IPF_SPACE: + begin + CheckForAutoURL( Text, State ); + if State.Spacing then + Text := Text + ' '; + end; + + IPF_ESC: + begin + // escape sequence + TranslateIPFEscapeCode( State, + pData, + Text, + WordsOnLine, + ImageOffsets ); + + end; + + end; // case code of... + end; + end; // for slotindex = ... + end; + State.TextBlock := ''; +end; + +function TTopic.SearchForWord( DictIndex: integer; + StopAtFirstOccurrence: boolean ) + : longint; +var + SlotIndex: integer; + Slot: THelpTopicSlot; + pData: pUInt8; + pSlotEnd: pUInt8; + + EscapeLen: longint; + + GlobalDictIndex: uint32; + + LocalDictIndex: uint8; +begin + EnsureSlotsLoaded; + + Result := 0; + for SlotIndex := 0 to _NumSlots - 1 do + begin + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + + pData := Slot.pData; + + pSlotEnd := pData + Slot.Size; + + while pData < pSlotEnd do + begin + LocalDictIndex := pData^; + + if LocalDictIndex < Slot.LocalDictSize then + begin + // Normal word lookup + GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ]; + + if GlobalDictIndex = DictIndex then + begin + inc( result ); + if StopAtFirstOccurrence then + exit; + end; + end + else + begin + // special code + if LocalDictIndex = $ff then + begin + // escape string, skip it + EscapeLen := ( pData + 1 ) ^; + inc( pData, EscapeLen ); + end; + end; + + inc( pData ); + end; // for slotindex = ... + end; +end; + +// Search for a sequence of bytes, including in escape codes +// this is for debugging to allow finding specific sequences +function TTopic.SearchForData( Data: pbyte; + DataLen: integer ): boolean; +var + SlotIndex: integer; + Slot: THelpTopicSlot; + pData: pUInt8; + pSlotEnd: pUInt8; + + pHold: pUint8; + pSearch: pUint8; +begin + EnsureSlotsLoaded; + + for SlotIndex := 0 to _NumSlots - 1 do + begin + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + + pSearch := Data; + pHold := Slot.pData; + pData := Slot.pData; + pSlotEnd := Slot.pData + Slot.Size; + + while pHold < pSlotEnd do + begin + if pData^ = pSearch^ then + begin + // byte matches + inc( pData ); + inc( pSearch ); + if ( pSearch >= Data + DataLen ) then + begin + // matches + result := true; + exit; + end + end + else + begin + // no match + pSearch := Data; + inc( pHold ); + pData := pHold; + end; + end; // for slotindex = ... + end; + + result := false; // not found +end; + +function TTopic.SearchForWordSequences( WordSequence: TList; + StopAtFirstOccurrence: boolean ): longint; +var + SlotIndex: integer; + Slot: THelpTopicSlot; + pData: pUInt8; + pSlotEnd: pUInt8; + + EscapeLen: longint; + + GlobalDictIndex: uint32; + IsWord: boolean; + WordRelevance: uint32; + + CurrentMatchRelevance: uint32; // total relevances for words matched so far + // in the current sequence + +// CurrentMatch: string; // useful for debugging only + LocalDictIndex: uint8; + + SequenceIndex: longint; + SequenceStartSlotIndex: longint; + pSequenceStartData: pUInt8; + + pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence + + // get the current slot start and end pointers + procedure GetSlot; + begin + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + pData := Slot.pData; + pSlotEnd := pData + Slot.Size; + end; + + // get pointer to the current set of word relevances + procedure GetStepFlags; + begin + pStepWordRelevances := WordSequence[ SequenceIndex ]; + end; + + // store the current point as start of a sequence + procedure StoreStartOfSequence; + begin + SequenceIndex := 0; + SequenceStartSlotIndex := SlotIndex; + pSequenceStartData := pData; + CurrentMatchRelevance := 0; +// CurrentMatch := ''; + GetStepFlags; + end; + +begin + Result := 0; + + EnsureSlotsLoaded; + + if _NumSlots = 0 then + // thar's nowt in yon topic, cannae be a match laid + exit; + + SlotIndex := 0; + + GetSlot; + + StoreStartOfSequence; + + while true do + begin + LocalDictIndex := pData^; + IsWord := false; + if LocalDictIndex < Slot.LocalDictSize then + begin + IsWord := true; + // Normal word lookup, so get the global dict idnex before we + // (potentially) move to next slot + GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ]; + end; + + inc( pData ); + if pData >= pSlotEnd then + begin + // reached end of slot, next please + inc( SlotIndex ); + if SlotIndex < _NumSlots then + GetSlot; + // else - there is nothing more to search + // but we need to check this last item + end; + + if IsWord then + begin + // Normal word lookup + WordRelevance := 0; + + if GlobalDictIndex < _GlobalDictionary.Count then + if not StrIsEmptyOrSpaces( _GlobalDictionary[ GlobalDictIndex ] ) then; + WordRelevance := pStepWordRelevances^[ GlobalDictIndex ]; + + if WordRelevance > 0 then + begin + // Found a matching word + inc( CurrentMatchRelevance, WordRelevance ); +// debug: +// CurrentMatch := CurrentMatch + +// pstring( _GlobalDictionary[ GlobalDictIndex ] )^; + + if SequenceIndex = 0 then + begin + // remember next start point + SequenceStartSlotIndex := SlotIndex; + pSequenceStartData := pData; + end; + + inc( SequenceIndex ); + + if SequenceIndex < WordSequence.Count then + begin + // get next set of flags. + GetStepFlags; + end + else + begin + // found a complete sequence. Cool! + + inc( result, CurrentMatchRelevance ); + + if StopAtFirstOccurrence then + exit; + + // start looking from the beginning of the sequence again. + StoreStartOfSequence; + end; + end + else + begin + // not a match at this point, restart search + if SequenceIndex > 0 then + begin + // we had matched one or more steps already, + // back to start of sequence AND back to + // point we started matching from (+1) + SequenceIndex := 0; + CurrentMatchRelevance := 0; +// CurrentMatch := ''; + SlotIndex := SequenceStartSlotIndex; + GetSlot; + pData := pSequenceStartData; + GetStepFlags; + end + else + begin + // haven't matched anything yet. + // update start of sequence + SequenceStartSlotIndex := SlotIndex; + pSequenceStartData := pData; + end; + end; + end + else + begin + // special code + if LocalDictIndex = $ff then + begin + // escape string, skip it + EscapeLen := pData ^; + inc( pData, EscapeLen ); + end; + end; + + if SlotIndex >= _NumSlots then + begin + // finished searching topic + break; + end; + + // next item + end; +end; + + +function TTopic.CountWord( DictIndex: integer ): longint; +begin + Result := SearchForWord( DictIndex, false ); +end; + +function TTopic.ContainsWord( DictIndex: integer ): boolean; +begin + Result := SearchForWord( DictIndex, true ) > 0; +end; + +// Gets the window dimensions specified by this topic's +// contents header +procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect ); +var + extendedinfo: TExtendedTOCEntry; + XY: THelpXYPair; + p: pbyte; + + Flags: byte; +begin + Flags := _pTOCEntry ^.flags; + p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) ); + + ContentsRect.Left := 0; + ContentsRect.Bottom := 0; + ContentsRect.Width := 100; + ContentsRect.Height := 100; + + if ( Flags and TOCEntryExtended ) > 0 then + begin + // have more details available... + ExtendedInfo.w1 := p^; + ExtendedInfo.w2 := ( p+1) ^; + inc( p, sizeof( ExtendedInfo ) ); + + if ( ExtendedInfo.w1 and 1 ) > 0 then + begin + // read origin + XY := pHelpXYPair( p )^; + inc( p, sizeof( XY ) ); + ReadHelpPosition( XY, ContentsRect ); + end; + if ( ExtendedInfo.w1 and 2 ) > 0 then + begin + // read size + XY := pHelpXYPair( p )^; + inc( p, sizeof( XY ) ); + ReadHelpSize( XY, ContentsRect ); + end; + end; +end; + +const + IPFColorNames: array[ 0..15 ] of string = + ( + 'default', + 'blue', + 'red', + 'pink', + 'green', + 'cyan', + 'yellow', + 'neutral', +// 'brown', ?? + 'darkgray', + 'darkblue', + 'darkred', + 'darkpink', + 'darkgreen', + 'darkcyan', + 'black', + 'palegray' + ); + +Procedure SaveExtraLinkData( Link: TWindowedHelpLink; + pData: pUInt8 ); +var + LinkFlags1: uint8; + LinkFlags2: uint8; + LinkDataIndex: longint; + pLinkXY: pHelpXYPair; + pLinkData: pUInt8; +begin + LinkFlags1 := ( pData + 0 ) ^; + LinkFlags2 := ( pData + 1 ) ^; + + pLinkData := pData + 2; + + if ( LinkFlags1 and 1 ) > 0 then + begin + // position specified + pLinkXY := pHelpXYPair( pLinkData ); + inc( pLinkData, sizeof( THelpXYPair ) ); + end; + + if ( LinkFlags1 and 2 ) > 0 then + begin + // size specified + pLinkXY := pHelpXYPair( pLinkData ); + inc( pLinkData, sizeof( THelpXYPair ) ); + end; + + if ( LinkFlags1 and 8 ) > 0 then + begin + // window controls specified - skip + inc( pLinkData, 2 ); + end; + + if ( LinkFlags2 and 4 ) > 0 then + begin + // group specified + Link.GroupIndex := pUInt16( pLinkData )^; + inc( LinkDataIndex, sizeof( uint16 ) ); + end; + + if ( LinkFlags1 and 64 ) > 0 then + begin + Link.Automatic := true; + end; + + if ( LinkFlags1 and 4 ) > 0 then + Link.ViewPort := true; + + if ( LinkFlags2 and 2 ) > 0 then + Link.Dependent := true; + + if ( LinkFlags1 and 128 ) > 0 then + Link.Split := true; + + // cant be bothered with the others. +end; + +procedure TTopic.SaveIPFEscapeCode( Var State: TParseState; + Var pData: pUInt8; + Var F: TextFile; + ImageOffsets: TList ); +var + EscapeLen: uint8; + EscapeCode: uint8; + + Margin: integer; + + BitmapOffset: longword; + BitmapFlags: uint8; + + ColorCode: uint8; + StyleCode: uint8; + + FontIndex: uint8; + pFontSpec: pTHelpFontSpec; + + FaceName: string; + + ExternalLinkFileIndex: uint8; + ExternalLinkTopicID: string; + + ProgramLink: string; + ProgramPath: string; + tmpProgramLinkParts : TStringList; + + OutputString: string; +begin + EscapeLen := pData^; + EscapeCode := (pData + 1) ^; + OutputString := ''; + + case EscapeCode of + + ecSetLeftMargin: + begin + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, false ); + end; + + ecSetLeftMarginNewLine: + begin + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, false ); + OutputString := OutputString + + RTF_NewLine; + end; + + ecSetLeftMarginFit: + begin + Margin := integer( ( pData + 2 )^ ); + GetMarginTag( Margin, State.FontState, OutputString, true ); + // note that this will cause following tex to be "tabbed" across to the + // new margin position, if not yet there. + // if we are already past this margin then a new line should be started. + + end; + + ecSetLeftMarginHere: + begin + OutputString := '<leftmargin here>'; + end; + + ecHighlight1: // hp1,2,3, 5,6,7 + begin + StyleCode := ( pData + 2 ) ^; + if StyleCode > 3 then + StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code + + if StyleCode > 0 then + Write( F, ':hp' + IntToStr( StyleCode ) + '.' ) + else + Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' ); + State.StyleCode := StyleCode; + end; + + ecHighlight2: // hp4, 8, 9 + begin + StyleCode := ( pData + 2 ) ^; + case StyleCode of + 1: StyleCode := 4; + 2: StyleCode := 8; + 3: StyleCode := 9; + end; + + if StyleCode > 0 then + Write( F, ':hp' + IntToStr( StyleCode ) + '.' ) + else + Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' ); + State.StyleCode := StyleCode; + end; + + ecLinkStart: + begin + Write( F, ':link reftype=hd' ); // link to heading + + Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) ); + + { + if EscapeLen >= 6 then + begin + GetExtraLinkData( Link, pData + 4 ); + end;} + +// if Link.Automatic then +// Write( F, ' auto' ); + + Write( F, '.' ); + + inc( State.LinkIndex ); + end; + + ecFootnoteLinkStart: + begin + Write( F, ':link reftype=fn refid=fn' + + IntToStr( pUInt16( pData + 2 )^ ) + + '.' ); + inc( State.LinkIndex ); + end; + + ecStartLinkByResourceID: + begin + Write( F, ':link reftype=hd res=' + + IntToStr( pUInt16( pData + 2 )^ ) + + '.' ); + + inc( State.LinkIndex ); + end; + + ecExternalLink: + begin + ExternalLinkFileIndex := ( pData + 2 )^; + ExternalLinkTopicID := StrNPas( pchar( pData + 4 ), ( pData + 3 )^ ); + Write( F, ':link reftype=hd ' + + ' refid=' + StrInSingleQuotes( ExternalLinkTopicID ) + + ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] ) + + '.' ); + + end; + + ecProgramLink: + begin + ProgramLink := StrNPas( pchar( pData + 3 ), EscapeLen - 3 ); + tmpProgramLinkParts := TStringList.Create; + StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0); + ProgramPath := tmpProgramLinkParts[0]; + tmpProgramLinkParts.Destroy; + + Write( F, ':link reftype=launch' + + ' object=' + StrInSingleQuotes( ProgramPath ) + + ' data=' + StrInSingleQuotes( ProgramLink ) + + '.' ); + end; + + ecLinkEnd: + begin + Write( F, ':elink.' ); + if State.FootnoteLink <> nil then + State.FootnoteLink := nil; + end; + + ecStartCharGraphics: + begin + State.FontState := fsFixed; + State.InCharGraphics := true; + WriteLn( F, '' ); + WriteLn( F, ':cgraphic.' ); + State.Spacing := false; + end; + + ecEndCharGraphics: + begin + State.FontState := fsNormal; + State.InCharGraphics := false; + WriteLn( F, '' ); + WriteLn( F, ':ecgraphic.' ); + State.Spacing := true; + end; + + ecImage: + begin + BitmapFlags := ( pData + 2 )^; + BitmapOffset := pUInt32( pData + 3 )^; + + SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets ); + + if State.Spacing then + Write( F, ' ' ); + end; + + ecLinkedImage: + begin + SaveLinkedImage( pData, F, ImageOffsets ); + // Note! Early exit, since the procedure + // will update pData. + exit; + end; + + ecStartLines: + begin + WriteLn( F, '' ); + // aligned text + case ( pData + 2 )^ of + 0, // just in case - to match image alignment oddities + 1: + begin + WriteLn( F, ':lines.' ); + State.Alignment := itaLeft; + end; + + 2: + begin + WriteLn( F, ':lines align=right.' ); + State.Alignment := itaRight; + end; + + 4: + begin + WriteLn( F, ':lines align=center.' ); + State.Alignment := itaCenter; + end; + end; + end; + + ecEndLines: + begin + // supposed to turn word wrap on, default font + WriteLn( F, '' ); + WriteLn( F, ':elines.' ); + State.Alignment := itaLeft; + end; + + ecForegroundColor: + begin + ColorCode := ( pData + 2 )^; + + if ColorCode < High( IPFColorNames ) then + Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' ); + end; + + ecBackgroundColor: + begin + ColorCode := ( pData + 2 )^; + if ColorCode < High( IPFColorNames ) then + Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' ); + end; + + ecFontChange: + begin + FontIndex := ( pData + 2 )^; + if FontIndex = 0 then + begin + // back to default font + Write( F, ':font facename=default.' ); + State.FontState := fsNormal; + end + else if FontIndex < _FontTable.Count then + begin + // valid font index + pFontSpec := _FontTable[ FontIndex ]; + + if pFontSpec = SubstituteFixedFont then + begin + // oops. + OutputString := '<tt>'; + State.FontState := fsFixed; + end + else + begin + pFontSpec := _FontTable[ FontIndex ]; + FaceName := StrNPas( pFontSpec^.FaceName, + sizeof( pFontSpec^.FaceName ) ); + Write( F, + ':font facename=' + StrInSingleQuotes( FaceName ) + + ' size=' + IntToStr( pFontSpec^.Height ) + + 'x' + IntToStr( pFontSpec^.Width ) + + '.' ); + State.FontState := fsCustom; + end; + end; + end + end; // case escape code of... + + // Write( F, OutputString ); + + inc( pData, EscapeLen ); +end; + +procedure TTopic.SaveToIPF( Var f: TextFile; + ImageOffsets: TList ); +var + SlotIndex: integer; + Slot: THelpTopicSlot; + pData: pUInt8; + pSlotEnd: pUInt8; + GlobalDictIndex: uint32; + StringToAdd: string; + LocalDictIndex: uint8; + State: TParseState; + SequenceStepIndex: longint; + LineLen: longint; + c: char; +begin + EnsureSlotsLoaded; + + State.LinkIndex := 0; + State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot + State.InCharGraphics := false; + State.Spacing := true; + State.ForegroundColorTag := '</color>'; + State.BackgroundColorTag := '</backcolor>'; + + State.StartOfTextBlock := -1; + State.TextBlock := ''; + + State.FootnoteLink := nil; + + State.StyleCode := 0; + + SequenceStepIndex := 0; + + LineLen := 0; + + for SlotIndex := 0 to _NumSlots - 1 do + begin + if not State.InCharGraphics then + State.Spacing := true; // this is just a guess as to the exact view behaviour. + // inf.txt indicates that spacing is reset to true at + // slot (cell) start, but that doesn't seem to be the + // case when in character graphics... hey ho. + + Slot := THelpTopicSlot(_Slots[ SlotIndex ]); + + pData := Slot.pData; + + pSlotEnd := pData + Slot.Size; + + State.Alignment := itaLeft; + + while pData < pSlotEnd do + begin + LocalDictIndex := pData^; + inc( pData ); + + if LocalDictIndex < Slot.LocalDictSize then + begin + // Normal word lookup + GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ]; + + // normal lookup + if GlobalDictIndex < _GlobalDictionary.Count then + StringToAdd := _GlobalDictionary[ GlobalDictIndex ] + else + StringToAdd := ''; + + if (Length( StringToAdd ) = 1) and Settings.IPFTopicSaveAsEscaped then + begin + // could be symbol + c := StringToAdd[ 1 ]; + case C of + '&': StringToAdd := '&.'; + '''': StringToAdd := '&apos.'; + '*': StringToAdd := '&asterisk.'; + '@': StringToAdd := '&atsign.'; + '\': StringToAdd := '&bsl.'; + '^': StringToAdd := '&caret.'; + '"': StringToAdd := '&osq.'; + ':': StringToAdd := '&colon.'; + '.': StringToAdd := '&per.'; + '(': StringToAdd := '&lpar.'; + ')': StringToAdd := '&rpar.'; + '/': StringToAdd := '&slash.'; + ',': StringToAdd := '&comma.'; + '-': StringToAdd := '&hyphen.'; + '_': StringToAdd := '&us.'; + '~': StringToAdd := '&tilde.'; + '+': StringToAdd := '&plus.'; + '>': StringToAdd := '>.'; + ';': StringToAdd := '&semi.'; + Chr($da): StringToAdd := '+'; + Chr($c4): StringToAdd := '-'; + Chr($b3): StringToAdd := '|'; + Chr($c3): StringToAdd := '|'; + Chr($bf): StringToAdd := '+'; + end; + end; + + inc( LineLen, Length( StringToAdd ) ); + if ( LineLen > 80 ) and ( not State.InCharGraphics ) then + begin + WriteLn( F ); + LineLen := 0; + end; + + Write( F, StringToAdd ); +{ + if State.FootnoteLink <> nil then + begin + State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd; + if State.Spacing then + begin + State.FootnoteLink.Title := State.FootnoteLink.Title + ' '; + end; + end; + } + if State.Spacing then + begin + Write( F, ' ' ); + inc( LineLen ); + end; + end + else + begin + // special code + + case LocalDictIndex of + IPF_END_PARA: + begin + WriteLn( F, '' ); + Write( F, ':p.' ); + LineLen := 3; + + if not State.InCharGraphics then + State.Spacing := true; + end; + + IPF_CENTER: + begin + WriteLn( F, '' ); + Write( F, '.ce ' ); // remainder of this line is centered. + LineLen := 4; + State.Alignment := itaCenterOnePara; + end; + + IPF_INVERT_SPACING: + begin + State.Spacing := not State.Spacing; + end; + + IPF_LINEBREAK: + begin + WriteLn( F, '' ); + if not State.InCharGraphics then + WriteLn( F, '.br ' ); // break must be the only thing on the line + + LineLen := 0; + if not State.InCharGraphics then + State.Spacing := true; + end; + + IPF_SPACE: + begin + if State.Spacing then + Write( F, ' ' ) + else + Write( F, ' ' ); + end; + + IPF_ESC: + begin + // escape sequence + SaveIPFEscapeCode( State, + pData, + F, + ImageOffsets ); + end; + + end; // case code of... + end; + end; // for slotindex = ... + end; + State.TextBlock := ''; + +end; + +// Compares two topics for purposes of sorting by +// search match relevance +function TopicRelevanceCompare( Item1, Item2: pointer ): longint; +var + Topic1, Topic2: TTopic; +begin + Topic1 := TTopic(Item1); + Topic2 := TTopic(Item2); + + if Topic1.SearchRelevance > Topic2.SearchRelevance then + Result := -1 + else if Topic1.SearchRelevance < Topic2.SearchRelevance then + Result := 1 + else + Result := 0; +end; + +// Compares two topics for purposes of sorting by title +function TopicTitleCompare( Item1, Item2: pointer ): longint; +begin + Result := CompareText( TTopic( Item1 )._Title, + TTopic( Item2 )._Title ); +end; + + +end. diff --git a/docview/src/HelpWindowDimensions.pas b/docview/src/HelpWindowDimensions.pas new file mode 100644 index 00000000..c8335176 --- /dev/null +++ b/docview/src/HelpWindowDimensions.pas @@ -0,0 +1,126 @@ +unit HelpWindowDimensions; + +{$mode objfpc}{$H+} + + // NewView - a new OS/2 Help Viewer + // Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) + // This software is released under the Gnu Public License - see readme.txt + +interface + +uses + IPFFileFormatUnit; + +const + ptCharacters = 0; + ptPercentage = 1; + ptPixels = 2; + ptPoints = 3; + ptDynamic = 4; + + XPosRight = 577; // some random values as markers + YPosTop = 577; + XYPosCenter = 578; + +type + THelpWindowRect = class(TObject) + public + Left: longint; // xposright means, right aligned + Bottom: longint; // xpostop means top aligned + // both: xyposcenter means centered + Width: longint; + Height: longint; + constructor Create; + procedure Assign(Rect: THelpWindowRect); + end; + +var + FootnoteRect: THelpWindowRect; + +procedure ReadHelpSize(const XY: THelpXYPair; var Rect: THelpWindowRect); +procedure ReadHelpPosition(const XY: THelpXYPair; var Rect: THelpWindowRect); + + +implementation + +constructor THelpWindowRect.Create; +begin + Left := -1; + Bottom := -1; + Width := -1; + Height := -1; +end; + +procedure THelpWindowRect.Assign(Rect: THelpWindowRect); +begin + Left := Rect.Left; + Bottom := Rect.Bottom; + Width := Rect.Width; + Height := Rect.Height; +end; + +function GetPos(const PositionType: uint8; const Value: longint): longint; +begin + case PositionType of + ptCharacters: + Result := Value; + ptPercentage: + Result := Value; + ptPixels: + Result := Value * 5; + ptPoints: + Result := Value; + ptDynamic: + case Value of + 1: + Result := 0; // left + 2: + Result := XPosRight; // right + 4: + Result := YPosTop; // top + 8: + Result := 0; // bottom + 16: + Result := XYPosCenter; // center. + end; + end; +end; + +procedure ReadHelpPosition(const XY: THelpXYPair; var Rect: THelpWindowRect); +var + XPositionType: uint8; + YPositionType: uint8; +begin + // read origin + XPositionType := XY.Flags div 16; + YPositionType := XY.Flags and 15; + + if XY.X <> $ffff then + Rect.Left := GetPos(XPositionType, XY.X); + if XY.Y <> $ffff then + Rect.Bottom := GetPos(YPositionType, XY.Y); +end; + +procedure ReadHelpSize(const XY: THelpXYPair; var Rect: THelpWindowRect); +begin + if XY.X <> $ffff then + Rect.Width := XY.X; + if XY.Y <> $ffff then + Rect.Height := XY.Y; +end; + +initialization + FootnoteRect := THelpWindowRect.Create; + with FootnoteRect do + begin + Left := 10; + Width := 80; + Bottom := 10; + Height := 40; + end; + +finalization + FootnoteRect.Free; + +end. + diff --git a/docview/src/IPFEscapeCodes.pas b/docview/src/IPFEscapeCodes.pas new file mode 100644 index 00000000..41e743d4 --- /dev/null +++ b/docview/src/IPFEscapeCodes.pas @@ -0,0 +1,47 @@ +Unit IPFEscapeCodes; + +{$mode objfpc}{$H+} + + +// NewView - a new OS/2 Help Viewer +// Copyright 2001 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// List of IPF escape codes. Not complete! Many are just used +// as magic numbers in HelpTopic.pas + +const + // Basic byte codes + IPF_END_PARA = $fa; + IPF_CENTER = $fb; + IPF_INVERT_SPACING = $fc; + IPF_LINEBREAK = $fd; + IPF_SPACE = $fe; + IPF_ESC = $ff; + + // Subescape codes of + HPART_DEFINE = 0; + HPART_PT_HDREF = 1; + HPART_PT_FNREF = 2; + HPART_PT_SPREF = 3; + HPART_HDREF = 4; + HPART_FNREF = 5; + HPART_SPREF = 6; + HPART_LAUNCH = 7; + HPART_PT_LAUNCH = 8; + HPART_INFORM = 9; + HPART_PT_INFORM = 10; + // ?? 11 ?? + HPART_EXTERN_PT_HDREF = 12; + HPART_EXTERN_PT_SPREF = 13; + HPART_EXTERN_HDREF = 14; + HPART_EXTERN_SPREF = 15; + HPART_GLOBAL_HDREF = 16; + HPART_GLOBAL_PT_HDREF = 17; + +Implementation + +Initialization +End. diff --git a/docview/src/IPFFileFormatUnit.pas b/docview/src/IPFFileFormatUnit.pas new file mode 100644 index 00000000..1acc7857 --- /dev/null +++ b/docview/src/IPFFileFormatUnit.pas @@ -0,0 +1,497 @@ +Unit IPFFileFormatUnit; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Definition of IPF file header and other structures + +uses + SysUtils; + +type + uint32 = longword; + uint16 = word; + uint8 = byte; + pUInt16 = ^uint16; + pUInt32 = ^uint32; + pUInt8 = ^uint8; + Unsigned_31 = 0 .. (1 shl 31) - 1; // 31-bit type + Unsigned_4 = 0 .. (1 shl 4) - 1; // 4-bit type + Unsigned_1 = 0 .. (1 shl 1) - 1; // 1-bit type + + + PCharArray = packed array[ 0..0 ] of PCHar; + UInt32Array = packed array[ 0..0 ] of UInt32; + UInt16Array = packed array[ 0..0 ] of UInt16; + UInt8Array = packed array[ 0..0 ] of UInt8; + + PCharArrayPointer = ^PCharArray; + UInt32ArrayPointer = ^UInt32Array; + UInt16ArrayPointer = ^UInt16Array; + UInt8ArrayPointer = ^UInt8Array; + + TBooleanArray = array[ 0..0 ] of boolean; + BooleanArrayPointer = ^TBooleanArray; + + + EHelpFileException = class( Exception ) + end; + + + EWindowsHelpFormatException = class( Exception ) + end; + + + TProgressCallback = procedure(n, outof: integer; AMessage: string) of object; + + +const + ErrorCorruptHelpFile = 'Corrupt help file, or something similar'; + +const + INF_HEADER_ID = 'HSP'; + +Type + THelpFileHeader = packed record + ID: array[0..2] of ansichar; // ID magic word "HSP" + flags: uint8; // probably a flag word... + // [0x01] bit 0: set if INF style file + // [0x10] bit 4: set if HLP style file + // patching this byte allows reading HLP files + // using the VIEW command, while help files + // seem to work with INF settings here as well. + hdrsize: uint16; // total size of header + version_hi: uint8; + version_lo: uint8; + ntoc: uint16; // number of entries in the tocarray + tocstart: uint32; // file offset of the start of the toc + toclen: uint32; // number of bytes in file occupied by the toc + tocoffsetsstart: uint32; // file offset of the start of array of toc offsets + nres: uint16; // number of panels with ressource numbers + resstart: uint32; // 32 bit file offset of ressource number table + nname: uint16; // number of panels with textual name + namestart: uint32; // 32 bit file offset to panel name table + nindex: uint16; // number of index entries + indexstart: uint32; // 32 bit file offset to index table + indexlen: uint32; // size of index table + icmdCount: uint16; // number of icmd index items + icmdOffset: uint32; // file offset to icmd index items + icmdSize: uint32; // size of icmd index table + searchstart: uint32; // 31 bit file offset of full text search table + // Note: top bit indicates 32 bit search record! + searchlen: uint32; // size of full text search table + nslots: uint16; // number of "slots" + slotsstart: uint32; // file offset of the slots array + dictlen: uint32; // number of bytes occupied by the "dictionary" + ndict: uint16; // number of entries in the dictionary + dictstart: uint32; // file offset of the start of the dictionary + imgstart: uint32; // file offset of image data + maxCVTIndex: byte; // highest index inside panel's local dictionary, + // always seems to be 245 + nlsstart: uint32; // 32 bit file offset of NLS table + nlslen: uint32; // size of NLS table + extstart: uint32; // 32 bit file offset of extended data block + reserved: array[ 0..11 ] of byte; // for future use. set to zero. + title: array[ 0..47 ] of ansichar; // ASCII title of database + end; + TPHelpFileHeader = ^THelpFileHeader; + + TExtendedHelpFileHeader = packed record + NumFontEntry: uint16; // FONT TABLE: Number entries + FontTableOffset: uint32; // FONT TABLE: Offset in file + NumDataBase: uint16; // DATA BASE: Number of files + DataBaseOffset: uint32; // DATA BASE: Offset in file + DataBaseSize: uint32; // DATA BASE: Size in bytes + EntryInGNameTable: uint16; // GLOBAL NAMES: Number entries + HelpPanelGNameTblOffset: uint32; // GLOBAL NAMES: Offset in file + StringsOffset: uint32; // STRINGS : Offset in file + StringsSize: uint16; // STRINGS : Total bytes of all strings + ChildPagesOffset: uint32; // CHILDPAGES : Offset in file + ChildPagesSize: uint32; // CHILDPAGES : Total bytes of all strings + NumGIndexEntry: uint32; // Total number of Global Index items + CtrlOffset: uint32; // CTRL BUTTONS : offset in file + CtrlSize: uint32; // CTRL BUTTONS : size in bytes + Reserved: array[0..3] of uint32; // For future use. Set to zero + end; + TPExtendedHelpFileHeader = ^TExtendedHelpFileHeader; + +Type + TTOCEntryStart = packed record + length: uint8; // length of the entry including this byte (but not including extended data) + flags: uint8; // flag byte, description folows (MSB first) + // bit8 haschildren; // following nodes are a higher level + // bit7 hidden; // this entry doesn't appear in VIEW.EXE's + // presentation of the toc + // bit6 extended; // extended entry format + // bit5 stuff; // ?? + // int4 level; // nesting level + numSlots: uint8; // number of "slots" occupied by the text for + // this toc entry + end; + pTTOCEntryStart = ^TTOCEntryStart; + + TExtendedTOCEntry = packed record + w1: uint8; + // bit 3: Window controls are specified + // bit 2: Viewport + // bit 1: Size is specified. + // bit 0: Position is specified. + w2: uint8; + // bit 3: + // bit 2: Group is specified. + // bit 1 + // bit 0: Clear (all windows before display) + end; + pExtendedTOCEntry = ^TExtendedTOCEntry; + + TTOCEntryOffsetArray = packed array[ 0..0 ] of uint32; + pTTOCEntryOffsetArray = ^TTOCEntryOffsetArray; + +const + TOCEntryExtended = $20; { extended entry format } + TOCEntryHidden = $40; { this entry doesn't appear in VIEW.EXE's presentation of the toc } + TOCEntryHasChildren = $80; { following nodes are a higher level } + TOCEntryLevelMask = $0f; + +type + THelpXYPair = packed record + Flags: uint8; + X: uint16; + Y: uint16; + end; + pHelpXYPair = ^THelpXYPair; + + TSlotHeader = packed record + stuff: uint8; // always 0?? + localdictpos: uint32; // file offset of the local dictionary + nlocaldict: uint8; // number of entries in the local dict + ntext: uint16; // number of bytes in the text + end; + pSlotHeader = ^TSlotHeader; + + THelpFontSpec = packed record + FaceName: array[ 0..32 ] of ansichar; + Height: uint16; + Width: uint16; + Codepage: uint16; + end; + pTHelpFontSpec = ^THelpFontSpec; + + TNlsHeader = packed record + NlsSize: uint16; + NlsType: uint8; + NlsFormat: uint8; + end; + + TNlsCountryDef = packed record + { if the following is true then... + NlsHeader.size = 10 + NlsHeader.type = NLSRecType.CONTROL + NlsHeader.format = 0 + } + Value: uint16; // =256 + Code: uint16; // country code + Page: uint16; // code page + Reserved: uint16; + end; + + // Single-byte character set + TSbcsNlsGrammerDef = packed record + { if the following is true then... + NlsHeader.size = 36 + NlsHeader.type = NLSRecType.WORD || NLSRecType.GRAPHIC + NlsHeader.format = 0 + } + bits: array[0..31] of uint8; // high-order bits first + end; + + TPanelControls = packed record + ControlCount: uint16; // number of ControlDef records + GroupCount: uint16; // number of GroupDef records + GroupIndex: uint16; // for cover page + Reserved: uint16; + end; + + TControlDef = packed record + CtrlType: uint16; // type of control + ResourceID: uint16; // resource id (panel) it belongs to + { variable length data follows, contains button text } + // DictString: array of char; + end; + + TControlGroupDef = packed record + Count: uint16; // number of indexes into ControlDef records + { variable length data follows } + // index[count] of type uint16 + end; + +// List of IPF escape codes. + +const + // Basic byte codes + IPF_END_PARA = $fa; + IPF_CENTER = $fb; + IPF_INVERT_SPACING = $fc; + IPF_LINEBREAK = $fd; + IPF_SPACE = $fe; + IPF_ESC = $ff; // followed by one of the ecXXX codes below + + // FF XX + ecSetLeftMargin = $02; + ecHighlight1 = $04; // hp1,2,3,5,6,7 + ecLinkStart = $05; + ecFootnoteLinkStart = $07; + ecLinkEnd = $08; + ecStartCharGraphics = $0b; + ecEndCharGraphics = $0c; + ecHighlight2 = $0d; // hp4,8,9 + ecImage = $0e; + ecLinkedImage = $0f; + ecProgramLink = $10; + ecSetLeftMarginNewLine = $11; + ecSetLeftMarginFit = $12; + ecForegroundColor = $13; + ecBackgroundColor = $14; + ecFontChange = $19; + ecStartLines = $1a; + ecEndLines = $1b; + ecSetLeftMarginHere = $1c; + ecStartLinkByResourceID = $1d; + ecExternalLink = $1f; + + // Subescape codes of + HPART_DEFINE = 0; + HPART_PT_HDREF = 1; + HPART_PT_FNREF = 2; + HPART_PT_SPREF = 3; + HPART_HDREF = 4; + HPART_FNREF = 5; + HPART_SPREF = 6; + HPART_LAUNCH = 7; + HPART_PT_LAUNCH = 8; + HPART_INFORM = 9; + HPART_PT_INFORM = 10; + // ?? 11 ?? + HPART_EXTERN_PT_HDREF = 12; + HPART_EXTERN_PT_SPREF = 13; + HPART_EXTERN_HDREF = 14; + HPART_EXTERN_SPREF = 15; + HPART_GLOBAL_HDREF = 16; + HPART_GLOBAL_PT_HDREF = 17; + +// ----------------------------------------------------------- +// Operations on Int32 arrays, used for searching +// These could be optimised heavily if needed. +procedure AllocUInt32Array( Var pArray: UInt32ArrayPointer; + Size: longint ); +procedure FreeUInt32Array( Var pArray: UInt32ArrayPointer; + Size: longint ); + +procedure FillUInt32Array( pArray: UInt32ArrayPointer; + Size: longint; + Value: UInt32 ); + +procedure AddUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +// Dest = Dest + source * Multiplier +procedure AddMultConstUInt32Array( pSource: UInt32ArrayPointer; + Multiplier: longint; + pDest: UInt32ArrayPointer; + Size: longint ); + +procedure AndUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +// If both source and dest > 0 then +// add source to dest +procedure AndAddUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +// if Source > 0 then dest is set to 0 +procedure AndNotUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +// dest = dest or source; +// if source > 0 then set dest to > 0 +procedure OrUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +// if source = 0 then dest set to >0 +procedure NotOrUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +procedure CopyUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); + +procedure ClearUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ); +procedure SetUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ); + +// returns the result of ORing every array element. +// Can be useful for debugging e.g. seeing at a glance +// if any element is non-zero +function OrAllUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ): longint; + + +Implementation + + +// Operations on int32 arrays +// ----------------------------------------------------------- + +procedure AllocUInt32Array( Var pArray: UInt32ArrayPointer; + Size: longint ); +begin + GetMem( pArray, + Size + * sizeof( UInt32 ) ); +end; + +procedure FreeUInt32Array( Var pArray: UInt32ArrayPointer; + Size: longint ); +begin + FreeMem( pArray, + Size + * sizeof( UInt32 ) ); +end; + +// This is a nice fast implementation of filling an +// array of dwords (Int32/longword) +procedure FillUInt32Array( pArray: UInt32ArrayPointer; + Size: longint; + Value: UInt32 ); +var + i: integer; +begin + assert( Size > 0 ); + if Size < 1 then + Exit; + for i := 0 to Size-1 do + begin + pArray^[i] := Value; + end; +end; + +procedure ClearUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ); +begin + FillUInt32Array( pArray, Size, 0 ); +end; + +procedure SetUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ); +begin + FillUInt32Array( pArray, Size, $ffffffff ); +end; + +procedure AddUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + inc( pDest^[ i ], pSource^[ i ] ); +end; + +procedure AddMultConstUInt32Array( pSource: UInt32ArrayPointer; + Multiplier: longint; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + inc( pDest^[ i ], pSource^[ i ] * Multiplier ); +end; + +procedure OrUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + pDest^[ i ] := pDest^[ i ] or pSource^[ i ]; +end; + +procedure CopyUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +begin + Move(pSource^, PDest^, Size * SizeOf(LongInt)); +end; + +procedure NotOrUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + if pSource^[ i ] = 0 then + pDest^[ i ] := 1; +end; + +procedure AndUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + pDest^[ i ] := pDest^[ i ] and pSource^[ i ]; +end; + +procedure AndAddUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + if ( pSource^[ i ] > 0 ) + and ( pDest^[ i ] > 0 ) then + inc( pDest^[ i ], pSource^[ i ] ) + else + pDest^[ i ] := 0; +end; + +procedure AndNotUInt32Array( pSource: UInt32ArrayPointer; + pDest: UInt32ArrayPointer; + Size: longint ); +var + i: longint; +begin + for i := 0 to Size - 1 do + if pSource^[ i ] > 0 then + pDest^[ i ] := 0; +end; + +function OrAllUInt32Array( pArray: UInt32ArrayPointer; + Size: longint ): longint; +var + i: longint; +begin + Result := 0; + for i := 0 to Size - 1 do + Result := Result or pArray^[ i ]; +end; + + +end. diff --git a/docview/src/NewViewConstantsUnit.pas b/docview/src/NewViewConstantsUnit.pas new file mode 100644 index 00000000..4e191b15 --- /dev/null +++ b/docview/src/NewViewConstantsUnit.pas @@ -0,0 +1,28 @@ +Unit NewViewConstantsUnit; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// Copyright 2006-2009 Ronald Brill (rbri at rbri dot de) +// This software is released under the Gnu Public License - see readme.txt + +// Common used constants for NewView + +Interface + +const + PARAM_LINK_NOTE = 'note'; + PARAM_LINK_PROGRAM = 'program'; + PARAM_LINK_URL = 'url'; + PARAM_LINK_EXTERNAL = 'external'; + + PRGM_EXPLORER = 'explore'; // web explorer + PRGM_NETSCAPE = 'netscape'; + PRGM_MOZILLA = 'mozilla'; + PRGM_FIREFOX = 'firefox'; + + +Implementation + +End. diff --git a/docview/src/SearchTable.pas b/docview/src/SearchTable.pas new file mode 100644 index 00000000..49c67ff5 --- /dev/null +++ b/docview/src/SearchTable.pas @@ -0,0 +1,298 @@ +Unit SearchTable; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +uses + Classes, IPFFileFormatUnit; + +// Code to read and use IPF search tables +// NB The RLE decompression was arrived at by trial and error +// it seems to be correct but it's difficult to test. + +type + TSearchTable = class(TObject) + protected + _Data: pointer; + _Entries: TList; // pointers to panel flag records + _RecordLengthIs16Bit: boolean; + _DictionaryCount: longint; + _TopicCount: longint; + + procedure ReadEntries; + + Procedure Check1ByteOfFlags( b: byte; + StartingIndex: longint; + Results: UInt32ArrayPointer ); + + procedure DoRLESearch( p: pbyte; + pDataEnd: pointer; + Results: UInt32ArrayPointer ); + + public + constructor Create( Data: pointer; + RecordLengthIs16Bit: boolean; + DictionaryCount: longint; + TopicCount: longint ); + destructor Destroy; override; + + // Sets Results to 1 for occurrences of DictIndex + procedure Search( DictIndex: uint16; + Results: UInt32ArrayPointer ); + + end; + +Implementation + +constructor TSearchTable.Create( Data: pointer; + RecordLengthIs16Bit: boolean; + DictionaryCount: longint; + TopicCount: longint ); +begin + _Data := Data; + _RecordLengthIs16Bit := RecordLengthIs16Bit; + _Entries := TList.Create; + _DictionaryCount := DictionaryCount; + _TopicCount := TopicCount; + ReadEntries; +end; + +destructor TSearchTable.Destroy; +begin + _Entries.Destroy; +end; + +procedure TSearchTable.ReadEntries; +var + pWordRecord: pointer; + RecordLen: uint16; + WordIndex: uint16; +begin + pWordRecord:= _Data; + + for WordIndex:= 0 to _DictionaryCount - 1 do + begin + _Entries.Add( pWordRecord ); + + if _RecordLengthIs16Bit then + RecordLen:= pUInt16( pWordRecord )^ + else // 8 bit + RecordLen:= pUInt8( pWordRecord )^; + inc( pWordRecord, RecordLen ); + end; +end; + + +// Search table decompression + +// Looks through a single byte of 8 flags, given by b, +// and updates topic entries within results for any flags +// that are set. +Procedure TSearchTable.Check1ByteOfFlags( b: byte; + StartingIndex: longint; + Results: UInt32ArrayPointer ); +var + TopicIndex: longint; +begin + TopicIndex:= StartingIndex; + while b > 0 do + begin + if b and $80 > 0 then + Results^[ TopicIndex ] := 1; + inc( TopicIndex ); + b:= b shl 1; + end; +end; + +// Decompress RLE compressed data starting at p, +// running til pDataEnd. Update topic entries in Results. +procedure TSearchTable.DoRLESearch( p: pbyte; + pDataEnd: pointer; + Results: UInt32ArrayPointer ); +var + TopicIndex: integer; + + N: integer; + thebyte: byte; + byte1, byte2: byte; +begin + assert( pbyte( p )^ = 1, 'Unexpected RLE type' ); + inc( p ); // skip header, always 1? + + TopicIndex:= 0; + + while p < pDataEnd do + begin + thebyte:= p^; + inc( p ); + + if thebyte = $80 then + begin + // escape + thebyte := p^; + inc( p ); + + if thebyte = 0 then + begin + // 16 bit repeat of zeroes?? + N := pUInt16( p )^ + 1; + inc( p, 2 ); + inc( TopicIndex, N ); + end + else + begin + // n+1 repeats of next 2 bytes??? + N := thebyte + 1; + byte1 := p^; + inc( p ); + byte2 := p^; + inc( p ); + while N > 0 do + begin + Check1ByteOfFlags( byte1, + TopicIndex, + Results ); + inc( TopicIndex, 8 ); + Check1ByteOfFlags( byte2, + TopicIndex, + Results ); + inc( TopicIndex, 8 ); + dec( N ); + end; + end; + end + else + begin + N:= thebyte and $7f + 1; + + if thebyte and $80 > 0 then + begin + // literal data + while N > 0 do + begin + Check1ByteOfFlags( p^, + TopicIndex, + Results ); + inc( TopicIndex, 8 ); + inc( p ); + dec( N ); + end; + end + else + begin + // repeat of next byte + thebyte := p^; + inc( p ); + while N > 0 do + begin + Check1ByteOfFlags( thebyte, + TopicIndex, + Results ); + inc( TopicIndex, 8 ); + dec( N ); + end; + end; + end; + end; +end; + +// This function finds uses of the given word (DictIndex) +// using the search table. Results[ topic ] is set to +// non-zero for topics which contain the word. +procedure TSearchTable.Search( DictIndex: uint16; + Results: UInt32ArrayPointer ); +var + TopicIndex: integer; + pWordRecord: pointer; + RecordLen: uint16; + CompressionCode: uint8; + pData: pointer; + pDataEnd: pointer; + Flags: uint8; +begin + FillUInt32Array( Results, _TopicCount, 0 ); + pWordRecord:= _Entries[ DictIndex ]; + + // Check search table format + if _RecordLengthIs16Bit then + begin + RecordLen:= pUInt16( pWordRecord )^; + CompressionCode:= pUInt8( pWordRecord + 2 )^; + pData:= pWordRecord + 3; + end + else // 8 bit + begin + RecordLen:= pUInt8( pWordRecord )^; + CompressionCode:= pUInt8( pWordRecord + 1 )^; + pData:= pWordRecord + 2; + end; + + // Decompress the search table for this word + pDataEnd:= pWordRecord + RecordLen; + case CompressionCode of + 0: // word not used anywhere. + ; + + 1: // used in all panels + FillUInt32Array( Results, _TopicCount, 1 ); + + 2: // RLE + begin + DoRLESearch( pData, + pDataEnd, + Results ); + end; + + 3: // list of topics containing word + begin + while pData < pDataEnd do + begin + TopicIndex:= pUInt16( pData )^; + Results^[ TopicIndex ] := 1; + inc( pData, 2 ); + end; + end; + + 4: // list of topics NOT containing word + begin + FillUInt32Array( Results, _TopicCount, 1 ); + + while pData < pDataEnd do + begin + TopicIndex:= pUInt16( pData )^; + Results^[ TopicIndex ] := 0; + inc( pData, 2 ); + end; + end; + + 5, // compressed by truncating bit stream at last byte containing a set bit. + 6: // same as above but starting at non-zero byte + begin + if CompressionCode = 5 then + TopicIndex:= 0 + else + begin + TopicIndex:= pUInt16( pData )^ * 8; + inc( pData, 2 ); + end; + + while pData < pDataEnd do + begin + Flags:= pUInt8( pData )^; + Check1ByteOfFlags( Flags, + TopicIndex, + Results ); + inc( TopicIndex, 8 ); + inc( pData ); + end; + end; + end; +end; + + +end. diff --git a/docview/src/SearchUnit.pas b/docview/src/SearchUnit.pas new file mode 100644 index 00000000..d8f9c6d6 --- /dev/null +++ b/docview/src/SearchUnit.pas @@ -0,0 +1,567 @@ +Unit SearchUnit; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Contains code to search help files. + +uses + Classes, + HelpFile, + TextSearchQuery, + IPFFileFormatUnit; + +const + // match weightings + mwOnlyTitleWord = 200; + mwFirstTitleWord = 50; + mwTitleWord = 20; + + mwOnlyIndexWord = 100; + mwFirstIndexWord = 20; + mwIndexWord = 10; + mwTopicTextWord = 1; + + // best case match weighting of a word + mwExactWord = 20; + + +// note on weightings. The title/index weightings +// are multipled by word weightings. +// Topic text matches are equal to word weighting +// times word weighting. + +procedure SearchHelpFile( HelpFile: THelpFile; + Query: TTextSearchQuery; + Results: TList; + WordSequences: TList ); + +// clear a lsit of word sequences (as produced by above) +procedure ClearWordSequences( WordSequences: TList; DictionaryCount: longint ); + +Implementation + +uses + SysUtils + ,HelpTopic + ,CompareWordUnit + ,nvUtilities + ,ACLStringUtility + ; + +type + TSearchType = ( stGeneral, stStarts, stExactMatch, stEnds ); + +procedure ClearWordSequence( WordSequence: TList; + DictionaryCount: longint ); +var + StepIndex: longint; + DictionaryRelevances: UInt32ArrayPointer; +begin + for StepIndex := 0 to WordSequence.Count - 1 do + begin + DictionaryRelevances := WordSequence[ StepIndex ]; + FreeUInt32Array( DictionaryRelevances, DictionaryCount ); + end; + WordSequence.Clear; +end; + +procedure ClearWordSequences( WordSequences: TList; DictionaryCount: longint ); +var + SequenceIndex: longint; + lWordSequence: TList; +begin + for SequenceIndex := 0 to WordSequences.Count - 1 do + begin + lWordSequence := TList(WordSequences[ SequenceIndex ]); + ClearWordSequence( lWordSequence, DictionaryCount ); + lWordSequence.Destroy; + end; + WordSequences.Clear; +end; + +// given a search word which is known to matche Reference word, +// return the relevance +function MatchedWordRelevance( const SearchWord: string; + const ReferenceWord: string ): longint; +begin + Result := mwExactWord + * Length( SearchWord ) + div Length( ReferenceWord ); + if Result = 0 then + Result := 1; +end; + +// Compares the given search word against the given +// reference word. Returns a value indicating how well the +// search word matches, 0 = not at all. +function CompareWord( const SearchWord: string; + const ReferenceWord: string ): longint; +var + OccurrencePos: longint; +begin + Result := 0; + OccurrencePos := CaseInsensitivePos( SearchWord, ReferenceWord ); + if OccurrencePos = 0 then + begin + // no match + exit; + end; + + Result := MatchedWordRelevance( SearchWord, ReferenceWord ); +end; + +// Search the help file dictionary for words that match +// the given search word. Partial matches are considered. +// Results returns the matching word indexes. +procedure SearchDictionary( HelpFile: THelpFile; + SearchWord: string; + Results: UInt32ArrayPointer ); +var + DictIndex: integer; + DictWord: string; +begin + for DictIndex := 0 to HelpFile.DictionaryCount - 1 do + begin + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + Results^[ DictIndex ] := CompareWord( SearchWord, DictWord ); + end; +end; + +// Search the help file dictionary for words that +// match the given search word exactly (except for case-insensitive) +procedure SearchDictionaryExact( HelpFile: THelpFile; + SearchWord: string; + Results: UInt32ArrayPointer ); +var + DictIndex: integer; + DictWord: string; +begin + FillUInt32Array( Results, HelpFile.DictionaryCount, 0 ); + + for DictIndex := 0 to HelpFile.DictionaryCount - 1 do + begin + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + if SameText( SearchWord, DictWord ) then + Results^[ DictIndex ] := mwExactWord; + end; +end; + +// Search the help file dictionary for words that +// start with the given word +procedure SearchDictionaryStarts( HelpFile: THelpFile; + SearchWord: string; + Results: UInt32ArrayPointer ); +var + DictIndex: integer; + DictWord: string; +begin + FillUInt32Array( Results, HelpFile.DictionaryCount, 0 ); + + for DictIndex := 0 to HelpFile.DictionaryCount - 1 do + begin + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + if StrStartsWithIgnoringCase(DictWord, SearchWord) then + Results^[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); + end; +end; + +// Search the help file dictionary for words that +// end with the given word +procedure SearchDictionaryEnds( HelpFile: THelpFile; + SearchWord: string; + Results: UInt32ArrayPointer ); +var + DictIndex: integer; + DictWord: string; +begin + FillUInt32Array( Results, HelpFile.DictionaryCount, 0 ); + + for DictIndex := 0 to HelpFile.DictionaryCount - 1 do + begin + DictWord := HelpFile.DictionaryWords[ DictIndex ]; + if StrEndsWithIgnoringCase( SearchWord, DictWord ) then + Results^[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); + end; +end; + +// Search titles of topics for given searchword +procedure SearchTopicTitles( HelpFile: THelpFile; + SearchWord: string; + Results: UInt32ArrayPointer ); +var + TopicIndex: longint; + Title: string; + TitleWord: string; + Topic: TTopic; + TitleWordIndex: longint; + WordRelevance: longint; + TitleWordRelevance: longint; + tmpTitleWords : TStringList; + i : integer; +begin + tmpTitleWords := TStringList.Create; + + // Search topic titles + for TopicIndex := 0 to HelpFile.TopicCount - 1 do + begin + Topic := HelpFile.Topics[ TopicIndex ]; + Title:= Topic.Title; + TitleWordIndex := 0; + + tmpTitleWords.Clear; + StrExtractStringsQuoted(tmpTitleWords, Title); + + for i := 0 to tmpTitleWords.count-1 do + begin + TitleWord := tmpTitleWords[i]; + + WordRelevance := CompareWord( SearchWord, + TitleWord ); + if WordRelevance > 0 then + begin + if TitleWordIndex = 0 then + begin + // matching the first word is best + if i = tmpTitleWords.count-1 then + begin + // in fact it's the only word + TitleWordRelevance := mwOnlyTitleWord * WordRelevance + end + else + TitleWordRelevance := mwFirstTitleWord * WordRelevance + end + else + begin + TitleWordRelevance := mwTitleWord * WordRelevance; + end; + inc( Results^[ Topic.Index ], TitleWordRelevance ); + end; + inc( TitleWordIndex ); + end; + end; + tmpTitleWords.Free; +end; + +// Search index entries for given searchword +procedure SearchIndex( HelpFile: THelpFile; SearchWord: string; Results: UInt32ArrayPointer ); +var + IndexIndex: longint; + IndexEntry: string; + IndexEntryWord: string; + tmpTopic: TTopic; + IndexEntryWordIndex: longint; + WordRelevance: longint; + IndexEntryWordRelevance: longint; + tmpIndexWords : TStringList; + i : integer; +begin + tmpIndexWords := TStringList.Create; + + for IndexIndex := 0 to HelpFile.Index.Count - 1 do + begin + IndexEntry := HelpFile.Index.GetLabels[IndexIndex]; + IndexEntryWordIndex := 0; + + tmpIndexWords.Clear; + StrExtractStringsQuoted(tmpIndexWords, IndexEntry); + + for i := 0 to tmpIndexWords.count-1 do + begin + IndexEntryWord := tmpIndexWords[i]; + + WordRelevance := CompareWord( SearchWord, IndexEntryWord ); + if WordRelevance > 0 then + begin + if IndexEntryWordIndex = 0 then + begin + // matching the first word is best + if i = tmpIndexWords.count-1 then + begin + // in fact it's the only word + IndexEntryWordRelevance := mwOnlyIndexWord * WordRelevance + end + else + IndexEntryWordRelevance := mwFirstIndexWord * WordRelevance + end + else + begin + IndexEntryWordRelevance := mwIndexWord * WordRelevance; + end; + tmpTopic := HelpFile.Index.getTopic(IndexIndex); + inc( Results^[ tmpTopic.Index ], IndexEntryWordRelevance ); + end; + inc( IndexEntryWordIndex ); + end; + end; + + tmpIndexWords.Free; +end; + +// ------------------------------------------------------ + +// Master search function. Given a search query, +// searches topic text, titles, index entries. +// Matching topics are added to TList, with their +// SearchRelevance set appropriately. +procedure SearchHelpFile( HelpFile: THelpFile; + Query: TTextSearchQuery; + Results: TList; + WordSequences: TList ); +var + TopicCount: longint; + Topic: TTopic; + TopicIndex: longint; + TermIndex: longint; + Term: TSearchTerm; + + DictionaryRelevances: UInt32ArrayPointer; + + TopicsMatchingDictWord: UInt32ArrayPointer; // flags + TopicsMatchingTermPart: UInt32ArrayPointer; // flags + TopicsMatchingTerm: UInt32ArrayPointer; // flag then relevances + TopicRelevances: UInt32ArrayPointer; + TopicsExcluded: UInt32ArrayPointer; + + TopicRelevanceForTerm: longint; + + WordRelevance: longint; + DictIndex: longint; + + TermPartIndex: longint; + TermPart: string; + + s: string; + + TermWordSequence: TList; +begin + if HelpFile.SearchTable = nil then + begin + exit; + end; + + // Reset flags per topic + TopicCount := HelpFile.TopicCount; + + // Get memory for topic relevance arrays + + AllocUInt32Array( TopicsMatchingDictWord, + TopicCount ); + AllocUInt32Array( TopicsMatchingTermPart, + TopicCount ); + AllocUInt32Array( TopicsMatchingTerm, + TopicCount ); + AllocUInt32Array( TopicRelevances, // functions as a flag and a cumulative relevance + TopicCount ); + AllocUInt32Array( TopicsExcluded, // Exclusions are treated as boolean only + TopicCount ); + + FillUInt32Array( TopicRelevances, TopicCount, 0); + FillUInt32Array( TopicsExcluded, TopicCount, 0); + + for TermIndex := 0 to Query.TermCount - 1 do + begin + Term := Query.Term[ TermIndex ]; + + LogEvent(LogSearch, 'Searching for term "' + + Term.Text + + '", ' + + IntToStr( Term.Parts.Count ) + + ' parts' ); + + // look thru all parts of the term. eg. CAKE_SAUSAGE + + TermWordSequence := TList.Create; + + if WordSequences <> nil then + if Term.CombineMethod <> cmExcluded then + // this term is an inclusive one, so we want to remember the matches + WordSequences.Add( TermWordSequence ); + + for TermPartIndex := 0 to Term.Parts.Count - 1 do + begin + TermPart := Term.Parts[ TermPartIndex ]; + + LogEvent(LogSearch, ' Searching for [' + TermPart + ']' ); + + AllocUInt32Array( DictionaryRelevances, + HelpFile.DictionaryCount ); + + TermWordSequence.Add( DictionaryRelevances ); + + // Search the dictionary for matches. + // alpha numeric match + + if Term.Parts.Count = 1 then + // general match allowing all kinds of partial matches + SearchDictionary( HelpFile, + TermPart, + DictionaryRelevances ) + + else if TermPartIndex = 0 then + // first term part: word must match end of a topic word e.g. must end in "cake" + SearchDictionaryEnds( HelpFile, + TermPart, + DictionaryRelevances ) + + else if TermPartIndex = Term.Parts.Count - 1 then + // last term part: word must match start of a topic word e.g. must start with "sausage" + SearchDictionaryStarts( HelpFile, + TermPart, + DictionaryRelevances ) + + else + // intermediate term part: word must match exactly e.g. must be "_" + SearchDictionaryExact( HelpFile, + TermPart, + DictionaryRelevances ); + + // For each word in the dictionary that matches + // this search term part, search topic texts + + LogEvent(LogSearch, ' Dictionary search done' ); + ClearUInt32Array( TopicsMatchingTermPart, + TopicCount ); + + for DictIndex := 0 to HelpFile.DictionaryCount - 1 do + begin + WordRelevance := DictionaryRelevances^[ DictIndex ]; + if WordRelevance > 0 then + begin + // Search for occurrences of this word + // within the text of topics + HelpFile.SearchTable.Search( DictIndex, + TopicsMatchingDictWord ); + + // debug + s := HelpFile.DictionaryWords[ DictIndex ]; + // TopicRelevancesForDictWord now contains 1 + // for topics that contain this word. + + OrUInt32Array( TopicsMatchingDictWord, + TopicsMatchingTermPart, + TopicCount ); + end + end; + + LogEvent(LogSearch, 'Topic searches done' ); + + if TermPartIndex = 0 then + // first part, just copy + CopyUInt32Array( TopicsMatchingTermPart, + TopicsMatchingTerm, + TopicCount ) + else + // and with previous term part results + AndUInt32Array( TopicsMatchingTermPart, + TopicsMatchingTerm, + TopicCount ); + + // loop for next term part (IPF word) + end; + + // Now we have searched the dictionary and worked out matching topics + // for all parts of the term. Now combine all together + + LogEvent(LogSearch, 'Checking for sequences' ); + for TopicIndex := 0 to TopicCount - 1 do + begin + if TopicsMatchingTerm^[ TopicIndex ] > 0 then + begin + Topic := HelpFile.Topics[ TopicIndex ]; + // Topic text contained a match for the all the parts + // of the term. + // Now we need to: + // - verify that they actually occur all in a sequence (if it's a multi-part term) + // - count occurrences for relevance. + + TopicRelevanceForTerm := + Topic.SearchForWordSequences( TermWordSequence, + false ); // don't stop at first match + + TopicRelevanceForTerm := + TopicRelevanceForTerm div Term.Parts.Count; // divide to bring back into scale + + TopicsMatchingTerm^[ TopicIndex ] := TopicRelevanceForTerm; + + end; + end; + + if WordSequences = nil then + begin + // we don't need to keep the sequence + ClearWordSequence( TermWordSequence, HelpFile.DictionaryCount ); + TermWordSequence.Free; + end; + + // Search titles and index + + LogEvent(LogSearch, ' Searching titles' ); + SearchTopicTitles( HelpFile, Term.Text, TopicsMatchingTerm ); + + LogEvent(LogSearch, ' Searching index' ); + SearchIndex( HelpFile, Term.Text, TopicsMatchingTerm ); + + LogEvent(LogSearch, ' Combining' ); + case Term.CombineMethod of + cmOptional: + AddUInt32Array( TopicsMatchingTerm, + TopicRelevances, + TopicCount ); + + cmRequired: + begin + // if zero then add to exclusions + NotOrUInt32Array( TopicsMatchingTerm, + TopicsExcluded, + TopicCount ); + + AddUInt32Array( TopicsMatchingTerm, + TopicRelevances, + TopicCount ); + end; + + cmExcluded: + OrUInt32Array( TopicsMatchingTerm, + TopicsExcluded, + TopicCount ); + end; + +// Term.ClearMatches; + + // loop for next term... + end; + + LogEvent(LogSearch, 'Search completed, converting to list' ); + + // Now convert to list form. + + for TopicIndex := 0 to TopicCount - 1 do + begin + if TopicsExcluded^[ TopicIndex ] = 0 then + begin + Topic := HelpFile.Topics[ TopicIndex ]; + Topic.SearchRelevance := TopicRelevances^[ TopicIndex ]; + if Topic.SearchRelevance > 0 then + begin + Results.Add( Topic ); + end; + end; + end; + + LogEvent(LogSearch, 'Freeing arrays' ); + FreeUInt32Array( TopicRelevances, TopicCount ); + FreeUInt32Array( TopicsExcluded, TopicCount ); + FreeUInt32Array( TopicsMatchingTerm, TopicCount ); + FreeUInt32Array( TopicsMatchingTermPart, TopicCount ); + FreeUInt32Array( TopicsMatchingDictWord, TopicCount ); + + LogEvent(LogSearch, 'Done' ); +end; + +End. diff --git a/docview/src/SettingsUnit.pas b/docview/src/SettingsUnit.pas new file mode 100644 index 00000000..f6b34bc4 --- /dev/null +++ b/docview/src/SettingsUnit.pas @@ -0,0 +1,527 @@ +Unit SettingsUnit; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Defines settings (options) in a record and contains functions +// for loading and saving them to ini file. + +Uses + Classes + ,fpg_base + ,fpg_main + ,CanvasFontManager + ; + +Const + ContentsBackgroundColorIndex = 0; + ContentsTextColorIndex = 1; + ContentsLinesColorIndex = 2; + IndexBackgroundColorIndex = 3; + IndexTextColorIndex = 4; + SearchBackgroundColorIndex = 5; + SearchTextColorIndex = 6; + NotesListBackgroundColorIndex = 7; + NotesListTextColorIndex = 8; + TopicBackgroundColorIndex = 9; + NotesTextColorIndex = 10; + SearchHighlightTextColorIndex = 11; + NumColorSettings = 12; + + // already defined, but these values are slightly different + //clLightYellow = $ffffc0; + //clLightBlue = $e0e0ff; + //clLightCyan = $c0ffff; + //clLightGreen = $e0ffe0; + + VGADefaultColors: array[ 0 .. NumColorSettings - 1 ] of TfpgColor + = ( clBoxColor, + clText1, + clText1, + clBoxColor, + clText1, + clBoxColor, + clText1, + clBoxColor, + clText1, + clBoxColor, + clGreen, + clYellow ); + + DefaultColors: array[ 0 .. NumColorSettings - 1 ] of TfpgColor + = ( clLightCyan, + clBlack, + clBlue, + clLightGreen, + clBlack, + clLightBlue, + clBlack, + clWhite, + clBlack, + clWhite, + clGreen, + clYellow ); + + ApplicationFontIndex = 0; + NumFontSettings = 1; + + DefaultTopicFont = DefaultTopicFont + '-' + DefaultTopicFontSize; + DefaultTopicFixedFont = DefaultTopicFixedFont + '-10' + DefaultTopicFixedFontSize; + + +Type + TIndexStyle = ( isFileOnly, isAlphabetical, isFull ); + TToolbarStyle = ( tsNone, tsImages, tsText, tsImagesAndText ); + TGlobalSearchLocation = ( gsHelpPaths, gsFixedDrives, gsSelectedHelpPaths, gsCustom ); + + TMRUItem = class(TObject) + public + Title: string; + Filenames: TStringList; + constructor Create; + destructor Destroy; override; + end; + + + TSettings = record + MRUList: TList; + LastOpenDirectory: string; + LastSaveDirectory: string; + StartupHelp: boolean; + LeftPanelWidth: longint; + ShowLeftPanel_Help: boolean; + ShowLeftPanel_Standalone: boolean; + FileDialogSplit: Double; + Colors: array[ 0..NumColorSettings - 1 ] of TfpgColor; + NormalFont: TfpgFont; + FixedFont: TfpgFont; + Fonts: array[ 0..NumFontSettings - 1 ] of TfpgFont; + FixedFontSubstitution: boolean; + FixedFontSubstitutes: string; + IndexStyle: TIndexStyle; + SmoothScrolling: boolean; + UseOriginalDialogs: boolean; + OpenWithExpandedContents: boolean; + ToolbarBackgroundImageFilename: string; + ToolbarStyle: TToolbarStyle; + ConfirmWinHelp: boolean; + GlobalSearchLocation: TGlobalSearchLocation; + SearchDirectories: TStringList; + IPFTopicSaveAsEscaped: boolean; + end; + +// global procs +procedure LoadSettings; +procedure SaveSettings; +procedure writeSettingsDetailsTo(aStrings : TStrings); +procedure AddToMRUList( const Title: string; Filenames: TStrings ); + +var + Settings: TSettings; + +Implementation + +Uses + SysUtils + ,fpg_iniutils + ,ACLStringUtility + ,nvUtilities + ; + +Const + IniFileName = 'NewView.ini'; + GeneralSection = 'General'; + FontsSection = 'Fonts'; + ColoursSection = 'Colours'; + MRUSection = 'RecentFiles'; + MRUItemBaseSection = 'RecentFile'; + SearchSection = 'Search'; + + DefaultWidth = 620; + DefaultHeight = 460; + + MaxMRUListEntries = 9; + +constructor TMRUItem.Create; +begin + Title := ''; + Filenames := TStringList.Create; +end; + +destructor TMRUItem.Destroy; +begin + Filenames.Free; + inherited Destroy; +end; + +Procedure LoadSettings; +var + ColorIndex: longint; + DefaultColor: TfpgColor; + FontName: string; + SettingString: string; + MRUItem: TMRUItem; + MRUItemSection: string; + MRUItemFileCount: longint; + MRUItemFileIndex: longint; + i: longint; + Count: longint; + MRUFilename: string; + MRUFileTitle: string; +begin + LogEvent(LogSettings, 'LoadSettings' ); + with gINI do + begin + EraseSection( 'Windows' ); + with Settings do + begin + LastOpenDirectory := ReadString( GeneralSection, 'LastOpenDirectory', '' ); + LastSaveDirectory := ReadString( GeneralSection, 'LastSaveDirectory', '' ); + + // Read split points, as units of 0.1% + LeftPanelWidth := ReadInteger( GeneralSection, 'LeftPanelWidth', 225 ); + FileDialogSplit := ReadInteger( GeneralSection, 'FileDialogSplit', 500 ) / 1000; + + ShowLeftPanel_Help := ReadBool( GeneralSection, 'ShowLeftPanel_Help', true ); + ShowLeftPanel_Standalone := ReadBool( GeneralSection, 'ShowLeftPanel_Standalone', true ); + + // Colours + for ColorIndex := 0 to High( Colors ) do + begin + //if GetScreenColorDepth > 8 then + DefaultColor := DefaultColors[ ColorIndex ]; + //else + // DefaultColor := VGADefaultColors[ ColorIndex ]; + Colors[ ColorIndex ] := ReadInteger( ColoursSection, + 'Color' + IntToStr( ColorIndex ), + DefaultColor ); + end; + + // Most Recently Used files list... + Count := ReadInteger( MRUSection, 'Count', 0 ); + for i := 0 to Count - 1 do + begin + MRUItemSection := MRUItemBaseSection + IntToStr( i ); + MRUItem := TMRUItem.Create; + MRUItem.Title := ReadString( MRUItemSection, 'Title', '' ); + MRUItemFileCount := ReadInteger( MRUItemSection, 'FileCount', 0 ); + for MRUItemFileIndex := 0 to MRUItemFileCount - 1 do + begin + MRUFilename := ReadString( MRUItemSection, + 'File' + IntToStr( MRUItemFileIndex ), + '' ); + if MRUFilename <> '' then + MRUItem.Filenames.Add( MRUFilename ); + end; + if ( MRUItem.Title <> '' ) and ( MRUItem.Filenames.Count > 0 ) then + // valid MRU item + MRUList.Add( MRUItem ) + else + begin + // not valid + MRUItem.Destroy; + MRUItem := nil; + end; + end; + + // Fonts + NormalFont := fpgGetFont(ReadString(FontsSection, 'NormalFont', DefaultTopicFont)); + if NormalFont = nil then + NormalFont := fpgStyle.DefaultFont; + + FixedFont := fpgGetFont(ReadString(FontsSection, 'FixedFont', DefaultTopicFixedFont)); + if FixedFont = nil then + FixedFont := fpgStyle.FixedFont; + + for i := 0 to NumFontSettings - 1 do + begin + FontName := 'Font' + IntToStr( i ); + Fonts[ i ] := nil; + if ReadBool( FontsSection, FontName + 'Customised', false ) then + Fonts[ i ] := fpgGetFont(ReadString(FontsSection, FontName + 'Desc', DefaultTopicFont)); + end; + + FixedFontSubstitution := ReadBool( FontsSection, 'FixedFontSubstitution', true ); + FixedFontSubstitutes := ReadString( FontsSection, 'FixedFontSubstitutes', 'Mono-10' ); + + // Index style + SettingString := ReadString( GeneralSection, 'IndexStyle', 'Full' ); + if SameText( SettingString, 'FileOnly' ) then + IndexStyle := isFileOnly + else if Sametext( SettingString, 'Alphabetical' ) then + IndexStyle := isAlphabetical + else + IndexStyle := isFull; + + StartupHelp := ReadBool( GeneralSection, 'StartupHelp', true ); + + SmoothScrolling := ReadBool( GeneralSection, 'SmoothScrolling', true ); +// UseOriginalDialogs := ReadBool( GeneralSection, 'UseOriginalDialogs', false ); + OpenWithExpandedContents := ReadBool( GeneralSection, 'OpenWithExpandedContents', false ); + +// ToolBarBackgroundImageFilename := ReadString( GeneralSection, 'ToolbarBackground', '' ); + SettingString := ReadString( GeneralSection, 'ToolbarStyle', 'ImagesAndText' ); + + if SameText( SettingString, 'None' ) then + ToolbarStyle := tsNone + else if SameText( SettingString, 'Images' ) then + ToolbarStyle := tsImages + else if SameText( SettingString, 'Text' ) then + ToolbarStyle := tsText + else + ToolbarStyle := tsImagesAndText; + + ConfirmWinHelp := ReadBool( GeneralSection, 'ConfirmWinHelp', true ); + IPFTopicSaveAsEscaped := ReadBool(GeneralSection, 'IPFTopicSaveAsEscaped', true); + + Count := ReadInteger( SearchSection, 'CustomDirCount', 0 ); + + SearchDirectories.Clear; + for i := 0 to Count - 1 do + begin + SettingString := ReadString( SearchSection, + 'CustomDir' + IntToStr( i ), + '' ); + if trim( SettingString ) <> '' then + SearchDirectories.Add( SettingString ); + end; + SettingString := ReadString( SearchSection, + 'Location', + 'HelpPaths' ); + if SameText( SettingString, 'HelpPaths' ) then + GlobalSearchLocation := gsHelpPaths + else if SameText( SettingString, 'FixedDrives' ) then + GlobalSearchLocation := gsFixedDrives + else if SameText( SettingString, 'SelectedHelpPaths' ) then + GlobalSearchLocation := gsSelectedHelpPaths + else + GlobalSearchLocation := gsCustom; + + end; + end; + LogEvent(LogSettings, ' Done' ); +end; + +procedure SaveSettings; +var + ColorIndex: longint; + FontIndex: longint; + FontName: string; + i: longint; + MRUItemFileIndex: longint; + SettingString: string; + MRUItem: TMRUItem; + MRUItemSection: string; +begin + LogEvent(LogSettings, 'SaveSettings' ); + with gINI do + begin + with Settings do + begin + WriteString( GeneralSection, 'LastOpenDirectory', LastOpenDirectory ); + WriteString( GeneralSection, 'LastSaveDirectory', LastSaveDirectory ); + + WriteInteger( GeneralSection, 'LeftPanelWidth', LeftPanelWidth ); + // Write split points, as units of 0.1% + WriteInteger( GeneralSection, 'FileDialogSplit', Round( FileDialogSplit * 1000 ) ); + + WriteBool( GeneralSection, 'ShowLeftPanel_Help', ShowLeftPanel_Help ); + WriteBool( GeneralSection, 'ShowLeftPanel_Standalone', ShowLeftPanel_Standalone ); + + // Colours + for ColorIndex := 0 to High( Colors ) do + WriteInteger( ColoursSection, + 'Color' + IntToStr( ColorIndex ), + Colors[ ColorIndex ] ); + + // MRU files + WriteInteger( MRUSection, 'Count', MRUList.Count ); + for i := 0 to MRUList.Count - 1 do + begin + MRUItem := TMRUItem(MRUList[ i ]); + MRUItemSection := MRUItemBaseSection + IntToStr( i ); + EraseSection( MRUItemSection ); + WriteString( MRUItemSection, 'Title', MRUItem.Title ); + WriteInteger( MRUItemSection, 'FileCount', MRUItem.Filenames.Count ); + for MRUItemFileIndex := 0 to MRUItem.Filenames.Count - 1 do + WriteString( MRUItemSection, + 'File' + IntToStr( MRUItemFileIndex ), + MRUItem.Filenames[ MRUItemFileIndex ] ); + end; + + // clear unused sections + for i := MRUList.Count to MaxMRUListEntries do + begin + MRUItemSection := MRUItemBaseSection + IntToStr( i ); + EraseSection( MRUItemSection ); + end; + + // Fonts + WriteString( FontsSection, 'NormalFont', NormalFont.FontDesc ); + WriteString( FontsSection, 'FixedFont', FixedFont.FontDesc ); + for FontIndex := 0 to NumFontSettings - 1 do + begin + FontName := 'Font' + IntToStr( FontIndex ); + WriteBool( FontsSection, FontName + 'Customised', Fonts[ FontIndex ] <> nil ); + if Fonts[ FontIndex ] <> nil then + WriteString( FontsSection, FontName + 'Desc', Fonts[ FontIndex ].FontDesc ); + end; + + WriteBool( FontsSection, 'FixedFontSubstitution', FixedFontSubstitution ); + WriteString( FontsSection, 'FixedFontSubstitutes', FixedFontSubstitutes ); + + case IndexStyle of + isFileOnly: + SettingString := 'FileOnly'; + isAlphabetical: + SettingString := 'Alphabetical'; + isFull: + SettingString := 'Full'; + end; + WriteString( GeneralSection, 'IndexStyle', SettingString ); + + WriteBool( GeneralSection, 'StartupHelp', StartupHelp ); + WriteBool( GeneralSection, 'SmoothScrolling', SmoothScrolling ); +// WriteBool( GeneralSection, 'UseOriginalDialogs', UseOriginalDialogs ); + WriteBool( GeneralSection, 'OpenWithExpandedContents', OpenWithExpandedContents ); +// WriteString( GeneralSection, 'ToolbarBackground', ToolbarBackgroundImageFilename ); + + case ToolbarStyle of + tsNone: + SettingString := 'None'; + tsImages: + SettingString := 'Images'; + tsText: + SettingString := 'Text'; + tsImagesAndText: + SettingString := 'ImagesAndText'; + end; + + WriteString( GeneralSection, 'ToolbarStyle', SettingString ); + WriteBool( GeneralSection, 'ConfirmWinHelp', ConfirmWinHelp ); + WriteBool( GeneralSection, 'IPFTopicSaveAsEscaped', IPFTopicSaveAsEscaped); + WriteInteger( SearchSection, 'CustomDirCount', SearchDirectories.Count ); + + SearchDirectories.Sorted := true; + SearchDirectories.CaseSensitive := True; + SearchDirectories.Duplicates := dupIgnore; + + for i := 0 to SearchDirectories.Count - 1 do + begin + WriteString( SearchSection, + 'CustomDir' + IntToStr( i ), + SearchDirectories[ i ] ); + end; + + case GlobalSearchLocation of + gsHelpPaths: + SettingString := 'HelpPaths'; + + gsFixedDrives: + SettingString := 'FixedDrives'; + + gsSelectedHelpPaths: + SettingString := 'SelectedHelpPaths'; + + gsCustom: + SettingString := 'Custom'; + end; + + WriteString( SearchSection, 'Location', SettingString ); + end; + end; + LogEvent(LogSettings, ' Done' ); +End; + +Procedure AddToMRUList( const Title: string; Filenames: TStrings ); +var + MRUIndex: longint; + PreviousMRUIndex: longint; + MRUItem: TMRUItem; +begin + PreviousMRUIndex := -1; + for MRUIndex := 0 to Settings.MRUList.Count - 1 do + begin + MRUItem := TMRUItem(Settings.MRUList[ MRUIndex ]); + if ( MRUItem.Title = Title ) + and ( MRUItem.Filenames.Equals( Filenames ) ) then + begin + // found identical entry in the list already. + PreviousMRUIndex := MRUIndex; + break; + end; + end; + + if PreviousMRUIndex > -1 then + begin + // is already in list, move to top of list + MRUItem := TMRUItem(Settings.MRUList[ PreviousMRUIndex ]); + Settings.MRUList.Delete( PreviousMRUIndex ); + end + else + begin + // not yet in list. Create new + MRUItem := TMRUItem.Create; + MRUItem.Title := Title; + MRUItem.Filenames.Assign( Filenames ); + end; + + Settings.MRUList.Insert( 0, MRUItem ); + while Settings.MRUList.Count > MaxMRUListEntries do + begin + MRUItem := TMRUItem(Settings.MRUList[ MaxMRUListEntries ]); + Settings.MRUList.Delete( MaxMRUListEntries ); + MRUItem.Destroy; + end; +end; + +procedure writeSettingsDetailsTo(aStrings : TStrings); +Begin + aStrings.Add(''); + aStrings.Add('---- Settings ----'); + aStrings.Add('info: Screenwidth=' + IntToStr(fpgApplication.ScreenWidth)); + aStrings.Add('info: Screenheight=' + IntToStr(fpgApplication.ScreenHeight)); + aStrings.Add('info: dpi=' + IntToStr(fpgApplication.Screen_dpi)); + + aStrings.Add('LastOpenDirectory: ' + Settings.LastOpenDirectory); + aStrings.Add('LastSaveDirectory: ' + Settings.LastSaveDirectory); + aStrings.Add('StartupHelp: ' + boolToStr(Settings.StartupHelp)); + // LeftPanelWidth: longint; + aStrings.Add('ShowLeftPanel_Help: ' + boolToStr(Settings.ShowLeftPanel_Help)); + aStrings.Add('ShowLeftPanel_Standalone: ' + boolToStr(Settings.ShowLeftPanel_Standalone)); + // FileDialogSplit: real; + // Colors: array[ 0..NumColorSettings - 1 ] of TColor; + // NormalFont: TFont; + // FixedFont: TFont; + // Fonts: array[ 0..NumFontSettings - 1 ] of TFont; + aStrings.Add('FixedFontSubstitution: ' + boolToStr(Settings.FixedFontSubstitution)); + aStrings.Add('FixedFontSubstitutes: ' + Settings.FixedFontSubstitutes); + // IndexStyle: TIndexStyle; + aStrings.Add('SmoothScrolling: ' + boolToStr(Settings.SmoothScrolling)); +// aStrings.Add('UseOriginalDialogs: ' + boolToStr(Settings.UseOriginalDialogs)); + aStrings.Add('OpenWithExpandedContents: ' + boolToStr(Settings.OpenWithExpandedContents)); +// aStrings.Add('ToolbarBackgroundImageFilename: ' + Settings.ToolbarBackgroundImageFilename); + // ToolbarStyle: TToolbarStyle; + aStrings.Add('ConfirmWinHelp: ' + boolToStr(Settings.ConfirmWinHelp)); + aStrings.Add('IPFTopicSaveAsEscaped: ' + BoolToStr(Settings.IPFTopicSaveAsEscaped)); + // GlobalSearchLocation: TGlobalSearchLocation; + // SearchDirectories: TStringList; +end; + + +Initialization + //Settings.NormalFont := fpgStyle.DefaultFont; + //Settings.FixedFont := fpgStyle.FixedFont; + //Settings.SearchDirectories := TStringList.Create; + +Finalization + Settings.NormalFont.Free; + Settings.FixedFont.Free; + Settings.SearchDirectories.Free; + +End. diff --git a/docview/src/TextSearchQuery.pas b/docview/src/TextSearchQuery.pas new file mode 100644 index 00000000..444b27f1 --- /dev/null +++ b/docview/src/TextSearchQuery.pas @@ -0,0 +1,208 @@ +Unit TextSearchQuery; + +{$mode objfpc}{$H+} + +// NewView - a new OS/2 Help Viewer +// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) +// This software is released under the Gnu Public License - see readme.txt + +Interface + +// Encapsulates a parsed search query. + +uses + Classes, SysUtils; + +Type + ESearchSyntaxError = class( Exception ) + end; + + TSearchTermCombineMethod = + ( + cmOptional, + cmRequired, + cmExcluded + ); + + TSearchTerm = class(TObject) + public + Text: string; + Parts: TStringList; + CombineMethod: TSearchTermCombineMethod; + constructor Create( const TheText: string; + const TheCombineMethod: TSearchTermCombineMethod ); + destructor Destroy; override; + end; + + + TTextSearchQuery = class(TObject) + protected + Terms: TList; + function GetTerm( Index: longint ): TSearchTerm; + function GetTermCount: longint; + public + constructor Create( const SearchString: string ); + destructor Destroy; override; + property Term[ Index: longint ]: TSearchTerm read GetTerm; + property TermCount: longint read GetTermCount; + end; + + +implementation + +uses + nvUtilities + ,ACLStringUtility + ; + + +const + QueryErrorMissingWord1 = 'No search word given after'; + QueryErrorMissingWord2 = ' before '; + + +constructor TTextSearchQuery.Create( const SearchString: string ); +var + TermText: string; + CombineMethod: TSearchTermCombineMethod; + lTerm: TSearchTerm; + tmpTerms : TStringList; + i : integer; +begin + inherited Create; + Terms := TList.Create; + try + tmpTerms := TStringList.Create; + StrExtractStringsQuoted(tmpTerms, SearchString); + + for i := 0 to tmpTerms.count-1 do + begin + TermText := tmpTerms[i]; + + // Check for modifiers: + // + word must be matched + // - word must not be matched + case TermText[ 1 ] of + '+': + CombineMethod := cmRequired; + '-': + CombineMethod := cmExcluded; + else + CombineMethod := cmOptional; + end; + + if CombineMethod <> cmOptional then + begin + // delete + or - + if Length( TermText ) = 1 then + if (i < tmpTerms.count-1) then + raise ESearchSyntaxError.Create( QueryErrorMissingWord1 + + StrInDoubleQuotes(TermText) + + QueryErrorMissingWord2 + + StrInDoubleQuotes(tmpTerms[i+1]) ) + else + raise ESearchSyntaxError.Create( QueryErrorMissingWord1 + + StrInDoubleQuotes(TermText)); + Delete( TermText, 1, 1 ); + end; + + lTerm := TSearchTerm.Create( TermText, + CombineMethod ); + Terms.Add( lTerm ); + end; + tmpTerms.Free; + except + while Terms.Count > 0 do + begin + lTerm := TSearchTerm(Terms.Last); + Terms.Remove(lTerm); + lTerm.Free; + end; + Terms.Free; + raise; // reraise exception + end; +end; + +destructor TTextSearchQuery.Destroy; +begin + DestroyListObjects( Terms ); + Terms.Free; + inherited Destroy; +end; + +function TTextSearchQuery.GetTerm( index: longint ): TSearchTerm; +begin + Result := TSearchTerm(Terms[ Index ]); +end; + +function TTextSearchQuery.GetTermCount: longint; +begin + Result := Terms.Count; +end; + +constructor TSearchTerm.Create( const TheText: string; + const TheCombineMethod: TSearchTermCombineMethod ); +var + TermParseIndex: longint; + TermChar: char; + TermPart: string; +begin + Parts := TStringList.Create; + + Text := TheText; + CombineMethod := TheCombineMethod; + + // Break out each part of the term as IPF does: + // consecutive alphanumeric chars become a "word" + // but each symbol is a separate word, and symbols break + // up alphanumerics into multiple words. e.g. + // CAKE_SAUSAGE becomes three words in IPF, + // one each for "CAKE" "_" and "SAUSAGE" + + TermParseIndex := 1; + while TermParseIndex <= Length( Text ) do + begin + // collect alphanumeric chars + TermPart := ''; + while TermParseIndex <= Length( Text ) do + begin + TermChar := Text[ TermParseIndex ]; + if ( IsAlpha( TermChar ) + or IsDigit( TermChar ) ) then + begin + // alpha numeric, collect it + TermPart := TermPart + TermChar; + inc( TermParseIndex ); + end + else + begin + // not alpha numeric, so stop + break; + end; + end; + if Length( TermPart ) > 0 then + begin + Parts.Add( TermPart ); // add collected alphanumeric part + end; + + if TermParseIndex <= Length( Text ) then + begin + // must be a symbol, + // each symbol (excluding space) is an individual item + if Text[ TermParseIndex ] <> ' ' then + Parts.Add( Text[ TermParseIndex ] ); + inc( TermParseIndex ); + end; + + end; + +end; + +destructor TSearchTerm.Destroy; +begin + Parts.Free; + inherited Destroy; +end; + + +end. diff --git a/docview/src/docdump/docdump.lpi b/docview/src/docdump/docdump.lpi new file mode 100644 index 00000000..440c482c --- /dev/null +++ b/docview/src/docdump/docdump.lpi @@ -0,0 +1,114 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="7"/> + <General> + <SessionStorage Value="InIDEConfig"/> + <MainUnit Value="0"/> + <TargetFileExt Value=""/> + <UseAppBundle Value="False"/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="15"> + <Unit0> + <Filename Value="docdump.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="docdump"/> + </Unit0> + <Unit1> + <Filename Value="../IPFEscapeCodes.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="IPFEscapeCodes"/> + </Unit1> + <Unit2> + <Filename Value="../IPFFileFormatUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="IPFFileFormatUnit"/> + </Unit2> + <Unit3> + <Filename Value="readheader.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readheader"/> + </Unit3> + <Unit4> + <Filename Value="filestreamhelper.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="filestreamhelper"/> + </Unit4> + <Unit5> + <Filename Value="readextfiles.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readextfiles"/> + </Unit5> + <Unit6> + <Filename Value="../../docs/inf04.txt"/> + <IsPartOfProject Value="True"/> + </Unit6> + <Unit7> + <Filename Value="readstrings.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readstrings"/> + </Unit7> + <Unit8> + <Filename Value="iterator_impl.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="iterator_impl"/> + </Unit8> + <Unit9> + <Filename Value="iterator_intf.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="iterator_intf"/> + </Unit9> + <Unit10> + <Filename Value="readnlsdata.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readnlsdata"/> + </Unit10> + <Unit11> + <Filename Value="readfonts.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readfonts"/> + </Unit11> + <Unit12> + <Filename Value="readcontrols.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readcontrols"/> + </Unit12> + <Unit13> + <Filename Value="readtoc.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="readtoc"/> + </Unit13> + <Unit14> + <Filename Value="u_Tools.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="u_Tools"/> + </Unit14> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)/"/> + <OtherUnitFiles Value="../"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/docview/src/docdump/docdump.lpr b/docview/src/docdump/docdump.lpr new file mode 100644 index 00000000..84077608 --- /dev/null +++ b/docview/src/docdump/docdump.lpr @@ -0,0 +1,98 @@ +{ + Dumps the structure of an OS/2 IPF help file +} +program docdump; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, IPFFileFormatUnit, IPFEscapeCodes, CustApp, readheader, + filestreamhelper, readextfiles, readstrings, iterator_intf, iterator_impl, + readnlsdata, readfonts, readcontrols, readtoc, u_Tools; + +type + + { TDocDump } + + TDocDump = class(TCustomApplication) + private + FIn: TFileStream; + FOut: TFileTextStream; + protected + procedure DoRun; override; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHelp; virtual; + end; + +{ TDocDump } + +procedure TDocDump.DoRun; +var + ErrorMsg: String; +begin + // quick check parameters + ErrorMsg:=CheckOptions('h','help'); + if ErrorMsg<>'' then begin + ShowException(Exception.Create(ErrorMsg)); + Terminate; + Exit; + end; + + // parse parameters + if HasOption('h','help') then begin + WriteHelp; + Terminate; + Exit; + end; + + FIn := TFileStream.Create(ParamStr(1), fmOpenRead); + FOut := TFileTextStream.Create(ExtractFileName(ParamStr(1))+'.txt', fmCreate); + try + FOut.WriteLn(Format('File name: %s (%d bytes)', [ExtractFileName(ParamStr(1)), FIn.Size])); + ProcessHeader(FIn, FOut); + ProcessExtFiles(FIn, FOut); + ProcessStringsTable(FIn, FOut); + ProcessNLSData(FIn, FOut); + ProcessFonts(FIn, FOut); + ProcessControls(FIn, FOut); + ProcessTOC(FIn, FOut); + finally + FIn.Free; + FOut.Free; + end; + // stop program loop + Terminate; +end; + +constructor TDocDump.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + StopOnException:=True; +end; + +destructor TDocDump.Destroy; +begin + inherited Destroy; +end; + +procedure TDocDump.WriteHelp; +begin + { add your help code here } + writeln('Usage: ',ExeName,' -h'); +end; + +var + Application: TDocDump; + + +begin + Application:=TDocDump.Create(nil); + Application.Run; + Application.Free; +end. + diff --git a/docview/src/docdump/filestreamhelper.pas b/docview/src/docdump/filestreamhelper.pas new file mode 100644 index 00000000..ff831a91 --- /dev/null +++ b/docview/src/docdump/filestreamhelper.pas @@ -0,0 +1,35 @@ +unit filestreamhelper; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TFileTextStream = class(TFileStream) + public + procedure WriteLn(const fmt: String; const args: array of const); + procedure WriteLn(const s: String); + end; + +implementation + +{ TFileTextStream } + +procedure TFileTextStream.WriteLn(const fmt: String; const args: array of const); +var + temp: String; +begin + temp := Format(fmt, args) + LineEnding; + Write(temp[1], Length(temp)); +end; + +procedure TFileTextStream.WriteLn(const s: String); +begin + self.WriteLn('%s', [s]); +end; + +end. + diff --git a/docview/src/docdump/iterator_impl.pas b/docview/src/docdump/iterator_impl.pas new file mode 100644 index 00000000..4ad88052 --- /dev/null +++ b/docview/src/docdump/iterator_impl.pas @@ -0,0 +1,480 @@ +unit iterator_impl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes + ,SysUtils + ,Regex { to be used with filtered string iterator } + ,iterator_intf + ,contnrs + ; + +type + + TTBStringsIterator = class(TInterfacedObject, ITBStringIterator, ITBStringAndObjectIterator) + private + FStrings: TStrings; + FCursor: Integer; + { Interface methods should always be private because + we will only ever access them via an Interface, + never via an Object instance } + + { Interface: ITBStringIterator and ITBStringAndObjectIterator } + function HasNext: Boolean; + function Next: string; + function HasPrevious: Boolean; + function Previous: string; + { Interface: ITBStringAndObjectIterator } + function HasNextObject: Boolean; + function NextObject: TObject; + function HasPreviousObject: Boolean; + function PreviousObject: TObject; + public + constructor CreateCustom(const ASource: TStrings); virtual; + end; + + + TTBListIterator = class(TInterfacedObject, ITBIterator) + private + FList: TList; + FCursor: Integer; + { Interface: ITBIterator } + function HasNext: Boolean; + function Next: TObject; + function HasPrevious: Boolean; + function Previous: TObject; + public + constructor CreateCustom(const ASource: TList); virtual; + end; + + + TTBCollectionIterator = class(TInterfacedObject, ITBIterator) + private + FCollection: TCollection; + FCursor: Integer; + { Interface: ITBIterator } + function HasNext: Boolean; + function Next: TObject; + function HasPrevious: Boolean; + function Previous: TObject; + public + constructor CreateCustom(const ASource: TCollection); virtual; + end; + + + TTBInterfaceListIterator = class(TInterfacedObject, ITBInterfaceIterator) + private + FList: TInterfaceList; + FCursor: integer; + { Interface: ITBinterfaceIterator } + function HasNext: Boolean; + function Next: IInterface; + function HasPrevious: Boolean; + function Previous: IInterface; + public + constructor CreateCustom(const ASource: TInterfaceList); virtual; + end; + + + TTBFilteredStringsIterator = class(TTBStringsIterator, ITBFilteredStringIterator) + private + FNextIndex: Integer; + FRegex: TRegexEngine; + { Interface: ITBFilteredStringIterator } + function GetFilter: string; + procedure SetFilter(const AValue: string); + { Interface: ITBStringIterator and ITBStringAndObjectIterator } + function HasNext: Boolean; + function Next: string; + function HasPrevious: Boolean; + function Previous: string; + public + constructor CreateCustom(const ASource: TStrings); override; + destructor Destroy; override; + end; + + + TTBObjectListIterator = class(TInterfacedObject, ITBIterator) + private + FList: TObjectList; + FCursor: Integer; + { Interface: ITBIterator } + function HasNext: Boolean; + function Next: TObject; + function HasPrevious: Boolean; + function Previous: TObject; + public + constructor CreateCustom(const ASource: TObjectList); virtual; + end; + + + +implementation + + +{ TTBStringsIterator } + +function TTBStringsIterator.HasNext: Boolean; +begin + Result := False; + if Assigned(FStrings) then + if FCursor < FStrings.Count - 1 then + Result := True; +end; + +function TTBStringsIterator.Next: string; +begin + Result := ''; + if HasNext then + begin + Inc(FCursor, 1); + Result := FStrings.Strings[FCursor]; + end; +end; + +function TTBStringsIterator.HasPrevious: Boolean; +begin + Result := False; + if Assigned(FStrings) then + if FCursor > 0 then + Result := True; +end; + +function TTBStringsIterator.Previous: string; +begin + Result := ''; + if HasPrevious then + begin + Dec(FCursor, 1); + Result := FStrings.Strings[FCursor]; + end; +end; + +function TTBStringsIterator.HasNextObject: Boolean; +begin + Result := False; + if Assigned(FStrings) then + if FCursor < FStrings.Count - 1 then + Result := FStrings.Objects[FCursor] <> nil; +end; + +function TTBStringsIterator.NextObject: TObject; +begin + Result := nil; + if HasNextObject then + // Note that Next(...) increments the FCursor + Result := FStrings.Objects[FCursor]; +end; + +function TTBStringsIterator.HasPreviousObject: Boolean; +begin + Result := False; + if Assigned(FStrings) then + if FCursor > 0 then + Result := FStrings.Objects[FCursor] <> nil; +end; + +function TTBStringsIterator.PreviousObject: TObject; +begin + Result := nil; + if HasPreviousObject then + // Note that Previous(...) decrements the FCursor + Result := FStrings.Objects[FCursor]; +end; + +constructor TTBStringsIterator.CreateCustom(const ASource: TStrings); +begin + inherited Create; + FStrings := ASource; + FCursor := -1; +end; + + +{ TTBListIterator } + +function TTBListIterator.HasNext: Boolean; +begin + Result := False; + if Assigned(FList) then + if FCursor < FList.Count - 1 then + Result := True; +end; + +function TTBListIterator.Next: TObject; +begin + Result := nil; + if HasNext then + begin + Inc(FCursor, 1); + result := TObject(FList.Items[FCursor]); + end; +end; + +function TTBListIterator.HasPrevious: Boolean; +begin + Result := False; + if Assigned(FList) then + begin + if FCursor > 0 then + Result := True; + end; +end; + +function TTBListIterator.Previous: TObject; +begin + Result := nil; + if HasPrevious then + begin + Dec(FCursor, 1); + Result := TObject(FList.Items[FCursor]); + end; +end; + +constructor TTBListIterator.CreateCustom(const ASource: TList); +begin + inherited Create; + FList := ASource; + FCursor := -1; +end; + + +{ TTBCollectionIterator } + +function TTBCollectionIterator.HasNext: Boolean; +begin + Result := False; + if Assigned(FCollection) then + if FCursor < FCollection.Count - 1 then + Result := True; +end; + +function TTBCollectionIterator.Next: TObject; +begin + Result := nil; + if HasNext then + begin + Inc(FCursor, 1); + result := FCollection.Items[FCursor]; + end; +end; + +function TTBCollectionIterator.HasPrevious: Boolean; +begin + Result := False; + if Assigned(FCollection) then + if FCursor > 0 then + Result := True; +end; + +function TTBCollectionIterator.Previous: TObject; +begin + Result := nil; + if HasPrevious then + begin + Dec(FCursor, 1); + Result := FCollection.Items[FCursor]; + end; +end; + +constructor TTBCollectionIterator.CreateCustom(const ASource: TCollection); +begin + inherited Create; + FCollection := ASource; + FCursor := -1; +end; + + +{ TTBFilteredStringsIterator } + +function TTBFilteredStringsIterator.GetFilter: string; +begin + Result := FRegex.RegexString; +end; + +procedure TTBFilteredStringsIterator.SetFilter(const AValue: string); +const + cFilterErr = 'Error in Filter string at position %d with ErrorCode %d. Filter string <%s>'; +var + LErrorCode: TRegexError; + LErrorPos: integer; +begin + if AValue <> FRegex.RegexString then + begin + FRegex.RegexString := AValue; + if not FRegex.Parse(LErrorPos, LErrorCode) then + raise Exception.CreateFmt(cFilterErr, [LErrorPos, Ord(LErrorCode), AValue]); + end; + FNextIndex := -1; +end; + +function TTBFilteredStringsIterator.HasNext: Boolean; +var + LIndex: integer; + LMatchPos: integer; + LOffset: integer; +begin + Result := False; + if GetFilter = '' then + begin + Result := inherited HasNext; + if Result then + FNextIndex := FCursor + 1; + end + else + begin + if FCursor < FStrings.Count - 1 then + begin + { If we haven't already calculated the next matching item } + if FNextIndex = -1 then + begin + LIndex := FCursor + 1; + { Peek ahead to find the next matching string } + while (LIndex < FStrings.Count) and (FNextIndex = -1) do + begin + { reset MatchString parameters } + LOffset := 0; + LMatchPos := 0; + if FRegex.MatchString(FStrings.Strings[LIndex], LMatchPos, LOffset) then + FNextIndex := LIndex; + Inc(LIndex); + end; + end; + if FNextIndex <> -1 then + Result := True; + end; + end; { if..else } +end; + +function TTBFilteredStringsIterator.Next: string; +begin + Result := ''; + if HasNext then + begin + FCursor := FNextIndex; + FNextIndex := -1; + Result := FStrings.Strings[FCursor]; + end; +end; + +function TTBFilteredStringsIterator.HasPrevious: Boolean; +begin + Result := False; // Filtered String is uni-directional +end; + +function TTBFilteredStringsIterator.Previous: string; +begin + Result := ''; + raise EUniDirectionalIterator.Create('Filtered String Iterator is uni-directional (forward) only.'); +end; + +constructor TTBFilteredStringsIterator.CreateCustom(const ASource: TStrings); +begin + inherited CreateCustom(ASource); + FRegex := TRegexEngine.Create(''); + FRegex.IgnoreCase := True; + FNextIndex := -1; +end; + +destructor TTBFilteredStringsIterator.Destroy; +begin + FRegex.Free; + inherited Destroy; +end; + + +{ TTBInterfaceListIterator } + +function TTBInterfaceListIterator.HasNext: Boolean; +begin + Result := False; + if Assigned(FList) then + if FCursor < FList.Count - 1 then + Result := True; +end; + +function TTBInterfaceListIterator.Next: IInterface; +begin + Result := nil; + if HasNext then + begin + Inc(FCursor, 1); + Result := FList.Items[FCursor]; + end; +end; + +function TTBInterfaceListIterator.HasPrevious: Boolean; +begin + Result := False; + if Assigned(FList) then + if FCursor > 0 then + Result := True; +end; + +function TTBInterfaceListIterator.Previous: IInterface; +begin + Result := nil; + if HasPrevious then + begin + Dec(FCursor, 1); + Result := FList.Items[FCursor]; + end; +end; + +constructor TTBInterfaceListIterator.CreateCustom(const ASource: TInterfaceList); +begin + inherited Create; + FList := ASource; + FCursor := -1; +end; + +{ TTBObjectListIterator } + +function TTBObjectListIterator.HasNext: Boolean; +begin + Result := False; + if Assigned(FList) then + if FCursor < FList.Count - 1 then + Result := True; +end; + +function TTBObjectListIterator.Next: TObject; +begin + result := nil; + if HasNext then + begin + Inc(FCursor); + result := FList.Items[FCursor]; + end; +end; + +function TTBObjectListIterator.HasPrevious: Boolean; +begin + Result := False; + if Assigned(FList) then + if FCursor > 0 then + Result := True; +end; + +function TTBObjectListIterator.Previous: TObject; +begin + result := nil; + if HasPrevious then + begin + Dec(FCursor); + result := FList.Items[FCursor]; + end; +end; + +constructor TTBObjectListIterator.CreateCustom(const ASource: TObjectList); +begin + inherited Create; + FList := ASource; + FCursor := -1; +end; + + +end. + diff --git a/docview/src/docdump/iterator_intf.pas b/docview/src/docdump/iterator_intf.pas new file mode 100644 index 00000000..e82b59a1 --- /dev/null +++ b/docview/src/docdump/iterator_intf.pas @@ -0,0 +1,169 @@ +unit iterator_intf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes + ,SysUtils + ; + +type + { A custom exception class } + ENoIteratorImpl = class(Exception); + EUniDirectionalIterator = class(Exception); + + + { Standard iterators } + + ITBIterator = interface(IInterface) + ['{9C2BC10D-54C8-4B59-88B5-A564921CF0E3}'] + function HasNext: Boolean; + function Next: TObject; + function HasPrevious: Boolean; + function Previous: TObject; + end; + + + ITBStringIterator = interface(IInterface) + ['{B2A449B4-5D0A-4F14-AC11-CA055EDA3ED7}'] + function HasNext: Boolean; + function Next: string; + function HasPrevious: Boolean; + function Previous: string; + end; + + + ITBStringAndObjectIterator = interface(ITBStringIterator) + ['{287373DC-A90D-400E-BAEE-C85474C317A8}'] + function HasNextObject: Boolean; + function NextObject: TObject; + function HasPreviousObject: Boolean; + function PreviousObject: TObject; + end; + + + ITBInterfaceIterator = interface + ['{9B599C5B-4BBB-43F6-AF8E-09FEE9AE0E20}'] + function HasNext: Boolean; + function Next: IInterface; + function HasPrevious: Boolean; + function Previous: IInterface; + end; + + { TODO: + More interfaces could be added for collections like: + TTreeView, TStringGrid etc... } + + + { Filtered iterators } + + ITBFilteredStringIterator = interface(ITBStringIterator) + ['{CF1B9E2D-DD05-4D15-95C6-686EAFA4ED82}'] + function GetFilter: string; + procedure SetFilter(const AValue: string); + property Filter: string read GetFilter write SetFilter; + end; + + + { TODO: + More filtered versions of the standard iterators could + be added here... } + + + + { Iterator Factory } + + TTBIteratorFactory = class(TObject) + function Iterator(const ASource: TObject): ITBIterator; + function StringIterator(const ASource: TObject): ITBStringIterator; + function StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator; + function InterfaceIterator(const ASource: TObject): ITBInterfaceIterator; + function FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator; + end; + + +{ Global iterator factory singleton } +function gIteratorFactory: TTBIteratorFactory; + + +implementation + +uses + iterator_impl; + +var + uIteratorFactory: TTBIteratorFactory; + +const + cNoIteratorImpl = 'No Iterator implementation found for <%s>'; + + +{ The lazy mans singleton implementation, but it does the job just fine. } +function gIteratorFactory: TTBIteratorFactory; +begin + if not Assigned(uIteratorFactory) then + uIteratorFactory := TTBIteratorFactory.Create; + Result := uIteratorFactory; +end; + + +{ TTBIteratorFactory } + +function TTBIteratorFactory.Iterator(const ASource: TObject): ITBIterator; +begin + if ASource is TList then + Result := TTBListIterator.CreateCustom(TList(ASource)) + else if ASource is TCollection then + Result := TTBCollectionIterator.CreateCustom(TCollection(ASource)) + //else if ASource is TTreeNodes then + //Result := TTBTreeNodesIterator.CreateCustom(TTreeNodes(ASource)) + else + raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]); +end; + +function TTBIteratorFactory.StringIterator(const ASource: TObject): ITBStringIterator; +begin + if ASource is TStrings then + Result := TTBStringsIterator.CreateCustom(TStrings(ASource)) + else + raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]); +end; + +function TTBIteratorFactory.StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator; +begin + if ASource is TStrings then + Result := TTBStringsIterator.CreateCustom(TStrings(ASource)) + else + raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]); +end; + +function TTBIteratorFactory.InterfaceIterator(const ASource: TObject): ITBInterfaceIterator; +begin + if ASource is TInterfaceList then + Result := TTBInterfaceListIterator.CreateCustom(TInterfaceList(ASource)) + else + raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]); +end; + +function TTBIteratorFactory.FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator; +begin + if ASource is TStrings then + begin + Result := TTBFilteredStringsIterator.CreateCustom(TStrings(ASource)); + Result.Filter := AFilter; + end + else + raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]); +end; + + +initialization + uIteratorFactory := nil; + +finalization + uIteratorFactory.Free; + +end. + diff --git a/docview/src/docdump/readcontrols.pas b/docview/src/docdump/readcontrols.pas new file mode 100644 index 00000000..395a36db --- /dev/null +++ b/docview/src/docdump/readcontrols.pas @@ -0,0 +1,44 @@ +{ + Dump the controls data +} +unit readcontrols; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper; + +procedure ProcessControls(AIn: TFileStream; AOut: TFileTextStream); + + +implementation + +uses + readheader, IPFFileFormatUnit; + +procedure ProcessControls(AIn: TFileStream; AOut: TFileTextStream); +var + ctrls: TPanelControls; + i: integer; +begin + AOut.WriteLn(''); + AOut.WriteLn('Panel Controls (Buttons)'); + if eHdr.CtrlOffset > 0 then + begin + AIn.Seek(eHdr.CtrlOffset, soBeginning); + AIn.Read(ctrls, SizeOf(TControlDef)); + AOut.WriteLn(Format(' PanelControls.ControlCount: %4.4x (%0:d)', [ctrls.ControlCount])); + AOut.WriteLn(Format(' PanelControls.GroupCount: %4.4x (%0:d)', [ctrls.GroupCount])); + AOut.WriteLn(Format(' PanelControls.GroupIndex: %4.4x (%0:d)', [ctrls.GroupIndex])); + AOut.WriteLn(Format(' PanelControls.Reserved: %4.4x (%0:d)', [ctrls.Reserved])); + AOut.WriteLn(' *****'); + AOut.WriteLn(' <todo - process CountrolCount and GroupCount data>'); + end + else + AOut.WriteLn(' No panel control found'); +end; + +end. + diff --git a/docview/src/docdump/readextfiles.pas b/docview/src/docdump/readextfiles.pas new file mode 100644 index 00000000..6ea979d9 --- /dev/null +++ b/docview/src/docdump/readextfiles.pas @@ -0,0 +1,53 @@ +{ + Dumps the names of external database (help) files referenced by this file +} +unit readextfiles; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, IPFFileFormatUnit, filestreamhelper; + +procedure ProcessExtFiles(AIn: TFileStream; AOut: TFileTextStream); + + +implementation + +uses + readheader; + +procedure ProcessExtFiles(AIn: TFileStream; AOut: TFileTextStream); +var + count: integer; + name: string; + pData: pointer; + p: pointer; + pLength: pByte; +begin + AOut.WriteLn(''); + AOut.WriteLn('External File References'); + + if eHdr.NumDataBase > 0 then + begin + pData := nil; + AIn.Seek(eHdr.DataBaseOffset, soBeginning); + GetMem(pData, eHdr.DataBaseSize); // allocate temp space for data + AIn.Read(pData^, eHdr.DataBaseSize); // read all data in one shot + p := pData; // p is our incrementing position in the data + for count := 0 to eHdr.NumDataBase-1 do + begin + pLength := p; // length byte, including itself + SetString(name, p+1, pLength^-1); // use length value minus the length byte to get the string length + AOut.WriteLn(Format(' File #%d: %s', [count, name])); + inc(p, pLength^); // skip to next entry using full length (including length byte) + end; + FreeMem(pData, eHdr.DataBaseSize); // free allocated space + end + else + AOut.WriteLn(' No external file references found'); +end; + +end. + diff --git a/docview/src/docdump/readfonts.pas b/docview/src/docdump/readfonts.pas new file mode 100644 index 00000000..6b684cac --- /dev/null +++ b/docview/src/docdump/readfonts.pas @@ -0,0 +1,47 @@ +{ + Dumps the font data +} +unit readfonts; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper; + +procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream); + + +implementation + +uses + readheader, IPFFileFormatUnit; + +procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream); +var + fnt: THelpFontSpec; + pData: pointer; + i: integer; +begin + AOut.WriteLn(''); + AOut.WriteLn('Font Data'); + if eHdr.NumFontEntry > 0 then + begin + AIn.Seek(eHdr.FontTableOffset, soBeginning); + for i := 0 to eHdr.NumFontEntry-1 do + begin + AIn.Read(fnt, SizeOf(THelpFontSpec)); + AOut.WriteLn(Format(' Font Entry #%d', [i+1])); + AOut.WriteLn(Format(' FontSpec.FaceName: %s', [fnt.FaceName])); + AOut.WriteLn(Format(' FontSpec.Height: %4.4x (%0:d)', [fnt.Height])); + AOut.WriteLn(Format(' FontSpec.Width: %4.4x (%0:d)', [fnt.Width])); + AOut.WriteLn(Format(' FontSpec.CodePage: %4.4x (%0:d)', [fnt.Codepage])); + end; + end + else + AOut.WriteLn(' No font data is present'); +end; + +end. + diff --git a/docview/src/docdump/readheader.pas b/docview/src/docdump/readheader.pas new file mode 100644 index 00000000..201fcb86 --- /dev/null +++ b/docview/src/docdump/readheader.pas @@ -0,0 +1,135 @@ +{ + Dump the INF header & extended header structures to a text file +} +unit readheader; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper, IPFFileFormatUnit; + +procedure ProcessHeader(AIn: TFileStream; AOut: TFileTextStream); + +var + hdr: THelpFileHeader; + eHdr: TExtendedHelpFileHeader; + + +implementation + + +type + TWord = record + b1: AnsiChar; + b2: AnsiChar; + end; + + TOverlayID = packed record + b1: Byte; + b2: Byte; + b3: Byte; + end; + + TOverlaySearchStart = bitpacked record + SearchOffset: Unsigned_31; + IsRec16bitSize: boolean; + end; + + +procedure ProcessHeader(AIn: TFileStream; AOut: TFileTextStream); +var + bytes: integer; + s: string; + w: TWord; + i: uint32; + t0: TOverlayID; + t1: TOverlaySearchStart; +begin + try + AIn.Seek(0, soBeginning); + bytes := AIn.Read(hdr, SizeOf(THelpFileHeader)); + if bytes <> SizeOf(THelpFileHeader) then + raise Exception.Create('Failed to read complete file header'); + + if hdr.ID <> INF_HEADER_ID then + raise Exception.Create('This is not an OS/2 help file'); + + AOut.WriteLn('Header Section'); + t0 := TOverlayID(hdr.ID); + s := hdr.ID; + AOut.WriteLn(Format(' ipfheader.id: %4.2x %2x %2x ("%s") : Magic word' ,[Byte(hdr.id[0]), Byte(hdr.id[1]), Byte(hdr.id[2]), s])); + if (hdr.flags and $01) > 0 then + s := 'INF' + else + s := 'HLP'; + AOut.WriteLn(Format(' ipfheader.flags: %8.2x (%s format) : File format' ,[hdr.flags, s])); + AOut.WriteLn(Format(' ipfheader.size: %8.4x (%0:7d bytes) : Size of this header structure', [hdr.hdrsize])); + AOut.WriteLn(Format(' ipfheader.version: %6d.%d : version of file format?', [hdr.version_hi, hdr.version_lo])); + AOut.WriteLn(Format(' ipfheader.ntoc: %8.4x (%0:13d) : No of TOC entries', [hdr.ntoc])); + AOut.WriteLn(Format(' ipfheader.tocstart: %8.8x (%0:7d bytes) : 32bit file offset to start of TOC', [hdr.tocstart])); + AOut.WriteLn(Format(' ipfheader.toclen: %8.8x (%0:7d bytes) : bytes occupied by TOC entries', [hdr.toclen])); + AOut.WriteLn(Format(' ipfheader.tocoffsetsstart: %8.8x (%0:7d bytes) : file offset to array of TOC offsets', [hdr.tocoffsetsstart])); + AOut.WriteLn(Format(' ipfheader.nres: %8.4x (%0:13d) : number of panels with resource numbers', [hdr.nres])); + AOut.WriteLn(Format(' ipfheader.resstart: %8.8x (%0:7d bytes) : 32bit file offset of ressource number table', [hdr.resstart])); + AOut.WriteLn(Format(' ipfheader.nname: %8.4x (%0:13d) : number of panels with textual name', [hdr.nname])); + AOut.WriteLn(Format(' ipfheader.namestart: %8.8x (%0:7d bytes) : 32bit file offset to panel name table', [hdr.namestart])); + AOut.WriteLn(Format(' ipfheader.nindex: %8.4x (%0:13d) : number of index entries', [hdr.nindex])); + AOut.WriteLn(Format(' ipfheader.indexstart: %8.8x (%0:7d bytes) : 32bit file offset to index table', [hdr.indexstart])); + AOut.WriteLn(Format(' ipfheader.indexlen: %8.8x (%0:7d bytes) : size of index table', [hdr.indexlen])); + AOut.WriteLn(Format(' ipfheader.icmdCount: %8.4x (%0:13d) : number of icmd index items', [hdr.icmdCount])); + AOut.WriteLn(Format(' ipfheader.icmdOffset: %8.8x (%0:7d bytes) : file offset to icmd index items', [hdr.icmdOffset])); + AOut.WriteLn(Format(' ipfheader.icmdSize: %8.8x (%0:7d bytes) : size of icmd index table', [hdr.icmdSize])); + t1 := TOverlaySearchStart(hdr.searchstart); + i := t1.SearchOffset; + AOut.WriteLn(Format(' ipfheader.searchstart :31 %8.8x (%0:7d bytes) : 31bit file offset of full text search table', [i, i])); + if t1.IsRec16bitSize then + s := 'search rec is 16bit size' + else + s := 'search rec is 8bit size'; + AOut.WriteLn(Format(' ipfheader.recSize :1 %s (%s) : if high bit set, search record size is 16bit', [BoolToStr(t1.IsRec16bitSize, True), s])); + AOut.WriteLn(Format(' ipfheader.searchlen: %8.8x (%0:7d bytes) : size of full text search table', [hdr.searchlen])); + AOut.WriteLn(Format(' ipfheader.nslots: %8.4x (%0:13d) : number of "slots"', [hdr.nslots])); + AOut.WriteLn(Format(' ipfheader.slotsstart: %8.8x (%0:7d bytes) : 32bit file offset of the slots array', [hdr.slotsstart])); + AOut.WriteLn(Format(' ipfheader.dictlen: %8.8x (%0:7d bytes) : bytes occupied by the "dictionary"', [hdr.dictlen])); + AOut.WriteLn(Format(' ipfheader.ndict: %8.4x (%0:13d) : number of entries in the dictionary', [hdr.ndict])); + AOut.WriteLn(Format(' ipfheader.dictstart: %8.8x (%0:7d bytes) : 32bit file offset to start of dictionary', [hdr.dictstart])); + AOut.WriteLn(Format(' ipfheader.imgstart: %8.8x (%0:7d bytes) : 32bit file offset to image data', [hdr.imgstart])); + AOut.WriteLn(Format(' ipfheader.maxCVTIndex: %8.2x (%0:13d) : highest index inside panel''s local dictionary', [hdr.maxCVTIndex])); + AOut.WriteLn(Format(' ipfheader.nlsstart: %8.8x (%0:7d bytes) : 32bit file offset of NLS table', [hdr.nlsstart, hdr.nlsstart])); + AOut.WriteLn(Format(' ipfheader.nlslen: %8.8x (%0:7d bytes) : size of NLS table', [hdr.nlslen])); + AOut.WriteLn(Format(' ipfheader.extstart: %8.8x (%0:7d bytes) : 32bit file offset of extended data block', [hdr.extstart])); + AOut.WriteLn(Format(' ipfheader.reserved: %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x : for future use. set to zero.', + [hdr.reserved[0], hdr.reserved[1], hdr.reserved[2], hdr.reserved[3], hdr.reserved[4], hdr.reserved[5], + hdr.reserved[6], hdr.reserved[7], hdr.reserved[8], hdr.reserved[9], hdr.reserved[10], hdr.reserved[11] ])); + AOut.WriteLn(Format(' ipfheader.title: "%s" : ASCII title of database', [hdr.title])); + + AOut.WriteLn(''); + AOut.WriteLn('Extended Header Section'); + AIn.Seek(hdr.extstart, soBeginning); + AIn.Read(eHdr, SizeOf(TExtendedHelpFileHeader)); + AOut.WriteLn(Format(' extheader.NumFontEntry %8.4x (%0:13d) : Font Table - number of entries', [eHdr.NumFontEntry])); + AOut.WriteLn(Format(' extheader.FontTableOffset %8.8x (%0:7d bytes) : Font Table - 32bit offset in file', [eHdr.FontTableOffset])); + AOut.WriteLn(Format(' extheader.NumDataBase %8.4x (%0:13d) : Data Base - No of files', [eHdr.NumDataBase])); + AOut.WriteLn(Format(' extheader.DataBaseOffset %8.8x (%0:7d bytes) : Data Base - 32bit offset in file', [eHdr.DataBaseOffset])); + AOut.WriteLn(Format(' extheader.DataBaseSize %8.8x (%0:7d bytes) : Data Base - Size in bytse', [eHdr.DataBaseSize])); + AOut.WriteLn(Format(' extheader.EntryInGNameTable %8.4x (%0:13d) : Global Names - No entries', [eHdr.EntryInGNameTable])); + AOut.WriteLn(Format(' extheader.HelpPanelGNameTblOffset %8.8x (%0:7d bytes) : Global Names - 32bit offset in file', [eHdr.HelpPanelGNameTblOffset])); + AOut.WriteLn(Format(' extheader.StringsOffset %8.8x (%0:7d bytes) : Strings - 32bit offset in file', [eHdr.StringsOffset])); + AOut.WriteLn(Format(' extheader.StringsSize %8.4x (%0:7d bytes) : Strings - Total bytes of all strings', [eHdr.StringsSize])); + AOut.WriteLn(Format(' extheader.ChildPagesOffset %8.8x (%0:7d bytes) : Child Pages - 32bit offset in file', [eHdr.ChildPagesOffset])); + AOut.WriteLn(Format(' extheader.ChildPagesSize %8.8x (%0:7d bytes) : Child Pages - Total bytes of all strings', [eHdr.ChildPagesSize])); + AOut.WriteLn(Format(' extheader.NumGIndexEntry %8.8x (%0:13d) : Total number of Global Index items', [eHdr.NumGIndexEntry])); + AOut.WriteLn(Format(' extheader.CtrlOffset %8.8x (%0:7d bytes) : Ctrl Buttons : offset in file', [eHdr.CtrlOffset])); + AOut.WriteLn(Format(' extheader.CtrlSize %8.8x (%0:7d bytes) : Ctrl Buttons : size in bytes', [eHdr.CtrlSize])); + AOut.WriteLn(Format(' extheader.reserved: %8.8x %8.8x %8.8x %8.8x : for future use. set to zero.', + [eHdr.reserved[0], eHdr.reserved[1], eHdr.reserved[2], eHdr.reserved[3]])); + + finally + // no nothing + end; +end; + +end. + diff --git a/docview/src/docdump/readnlsdata.pas b/docview/src/docdump/readnlsdata.pas new file mode 100644 index 00000000..68609235 --- /dev/null +++ b/docview/src/docdump/readnlsdata.pas @@ -0,0 +1,31 @@ +unit readnlsdata; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper; + +procedure ProcessNLSData(AIn: TFileStream; AOut: TFileTextStream); + +implementation + +uses + readheader; + +procedure ProcessNLSData(AIn: TFileStream; AOut: TFileTextStream); +begin + AOut.WriteLn(''); + AOut.WriteLn('NLS Data'); + if hdr.nlslen > 0 then + begin + AOut.WriteLn(' <todo - process NLS data>'); + + end + else + AOut.WriteLn('NLS Data is not present'); +end; + +end. + diff --git a/docview/src/docdump/readstrings.pas b/docview/src/docdump/readstrings.pas new file mode 100644 index 00000000..7b397408 --- /dev/null +++ b/docview/src/docdump/readstrings.pas @@ -0,0 +1,56 @@ +{ + Dump the String table data +} +unit readstrings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper; + +procedure ProcessStringsTable(AIn: TFileStream; AOut: TFileTextStream); + + +implementation + +uses + readheader; + +procedure ProcessStringsTable(AIn: TFileStream; AOut: TFileTextStream); +var + name: string; + pData: pointer; + p: pointer; + pLength: pByte; + bytes: integer; +begin + AOut.WriteLn(''); + AOut.WriteLn('Strings Data'); + + if eHdr.StringsSize > 0 then + begin + pData := nil; + AIn.Seek(eHdr.StringsOffset, soBeginning); + GetMem(pData, eHdr.StringsSize); // allocate temp space for data + AIn.Read(pData^, eHdr.StringsSize); // read all data in one shot + p := pData; // p is our incrementing position in the data + bytes := 0; + while bytes < eHdr.StringsSize do; + begin + pLength := p; // length byte, including itself + bytes := bytes + pLength^; + SetString(name, p+1, pLength^-1); // use length value minus the length byte to get the string length + AOut.WriteLn(Format(' %s', [name])); + inc(p, pLength^); // skip to next entry using full length (including length byte) + end; + FreeMem(pData, eHdr.StringsSize); // free allocated space + end + else + AOut.WriteLn(' There are no strings'); + +end; + +end. + diff --git a/docview/src/docdump/readtoc.pas b/docview/src/docdump/readtoc.pas new file mode 100644 index 00000000..0cfae395 --- /dev/null +++ b/docview/src/docdump/readtoc.pas @@ -0,0 +1,171 @@ +{ + Dump the Table of Contents data +} +unit readtoc; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, filestreamhelper; + +procedure ProcessTOC(AIn: TFileStream; AOut: TFileTextStream); + +implementation + +uses + IPFFileFormatUnit, readheader, u_Tools; + +type + TTOCOverlay = bitpacked record + length: uint8; // length of the entry including this byte (but not including extended data) + nestlevel: Unsigned_4; + unknown: boolean; + extended: boolean; + hidden: boolean; + haschildren: boolean; + numSlots: uint8; // number of "slots" occupied by the text for this toc entry + end; + + + TTOCExtendedOverlay = bitpacked record + setPos: boolean; + setSize: boolean; + setView: boolean; + setStyle: boolean; + noSearch: boolean; + noPrint: boolean; + setCtrl: boolean; + setTutor: boolean; + clear: boolean; + unknown1: Unsigned_1; + setGroup: boolean; + isParent: boolean; + unknown2: Unsigned_4; + end; + + +procedure ProcessTOC(AIn: TFileStream; AOut: TFileTextStream); +var + Count: integer; + VisCount: integer; + pOffsets: UInt32ArrayPointer; + toc: TTOCEntryStart; + olay: TTOCOverlay; + tocextolay: TTOCExtendedOverlay; + pData: pointer; + pEntry: pTTOCEntryStart; + pExtendedInfo: pExtendedTOCEntry; + p: PByte; + i: integer; + titleLen: integer; + title: string; +begin + AOut.WriteLn(''); + AOut.WriteLn('Table of Contents'); + VisCount := 0; + GetMem(pOffsets, SizeOf(uint32) * hdr.ntoc); + AIn.Seek(hdr.tocoffsetsstart, soBeginning); + AIn.Read(pOffsets^, SizeOf(uint32) * hdr.ntoc); // now we have array of toc offsets + + AIn.Seek(hdr.tocstart, soBeginning); + GetMem(pData, hdr.toclen); + AIn.Read(pData^, hdr.toclen); + pEntry := pData; + for count := 1 to hdr.ntoc do + begin +// AIn.Read(toc, SizeOf(TTOCEntryStart)); +// FillChar(olay, SizeOf(TTOCOverlay), 0); + p := PByte(pEntry) + sizeof(TTOCEntryStart); + i := Longint(p^); + + olay.extended := (pEntry^.flags and TOCEntryExtended ) = TOCEntryExtended; + olay.nestlevel := (pEntry^.flags and TOCEntryLevelMask); + olay.hidden := (pEntry^.flags and TOCEntryHidden) = TOCEntryHidden; + olay.haschildren := (pEntry^.flags and TOCEntryHasChildren) = TOCEntryHasChildren; + + AOut.WriteLn(Format(' TOC Entry #%d at offset %8.8x (%d bytes)', [count, p^, i])); + AOut.WriteLn(Format(' tocentry.length: %2.2x (%0:d bytes)', [pEntry^.length])); + AOut.WriteLn(Format(' tocentry.nestlevel: %d', [olay.nestlevel])); + AOut.WriteLn(Format(' tocentry.unknown: %s', [iif(olay.unknown, 'set', 'clear')])); + AOut.WriteLn(Format(' tocentry.extended: %s', [iif(olay.extended, 'yes', 'no')])); + AOut.WriteLn(Format(' tocentry.hidden: %s', [iif(olay.hidden, 'yes', 'no')])); + AOut.WriteLn(Format(' tocentry.haschildren: %s', [iif(olay.haschildren, 'yes', 'no')])); + AOut.WriteLn(Format(' tocentry.numSlots: %d', [pEntry^.numSlots])); + if not olay.hidden then + inc(VisCount); + if olay.extended then + begin + pExtendedInfo := pExtendedTOCEntry( p ); // next data to follow must be Extended TOC Entry + + AOut.WriteLn(' Extended TOC Entry'); + tocextolay := TTOCExtendedOverlay(pExtendedInfo^); + + AOut.Writeln(Format(' ExtTocEntry.setPos: %s', [iif(tocextolay.setPos, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.setSize: %s', [iif(tocextolay.setSize, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.setView: %s', [iif(tocextolay.setView, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.setStyle: %s', [iif(tocextolay.setStyle, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.noSearch: %s', [iif(tocextolay.noSearch, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.noPrint: %s', [iif(tocextolay.noPrint, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.setCtrl: %s', [iif(tocextolay.setCtrl, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.setTutor: %s', [iif(tocextolay.setTutor, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.clear: %s', [iif(tocextolay.clear, 'clear', 'set')])); + AOut.Writeln(Format(' ExtTocEntry.unknown1: %1.1x', [tocextolay.unknown1])); + AOut.Writeln(Format(' ExtTocEntry.setGroup: %s', [iif(tocextolay.setGroup, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.isParent: %s', [iif(tocextolay.isParent, 'yes', 'no')])); + AOut.Writeln(Format(' ExtTocEntry.unknown2: %1.1x', [tocextolay.unknown2])); + + inc( p, sizeof( TExtendedTOCEntry ) ); // move p past two flag bytes + + if ( pExtendedInfo^.w1 and 1 ) > 0 then + // skip position + inc( p, sizeof( THelpXYPair ) ); + + if ( pExtendedInfo^.w1 and 2 ) > 0 then + // skip size + inc( p, sizeof( THelpXYPair ) ); + + if ( pExtendedInfo^.w1 and 8 ) > 0 then + // skip window controls + inc( p, sizeof(word) ); // increment by 2 + + if ( pExtendedInfo^.w1 and $40 ) > 0 then + // skip something else, unknown... style? 2 bytes + inc( p, sizeof(word) ); // increment by 2 + + if ( pExtendedInfo^.w2 and 4 ) > 0 then + begin +// _ContentsGroupIndex := pUInt16(p)^; + // read group + inc( p, sizeof( uint16 ) ); + end; + end; + + // skip slot numbers for now. +// _pSlotNumbers := pUInt16(p); + inc( p, pEntry^.numSlots * sizeof(uint16) ); + + // Calculate the remainder of the tocentry length - that is the bytes used for TOC topic (title) text + titleLen := pEntry^.length - ( longword( p ) - longword( pEntry ) ); + + // Read title + if TitleLen > 0 then + SetString(Title, Pointer(p), TitleLen) + else + Title := '<unknown>'; + AOut.WriteLn(Format(' toc Title: %s', [title])); + + + p := PByte(pEntry); + inc(p, pEntry^.Length); + pEntry := pTTOCEntryStart(p); + end; + + AOut.WriteLn(Format(' TOC visible count: %d', [VisCount])); + FreeMem(pOffsets, SizeOf(uint32) * hdr.ntoc); + FreeMem(pData, hdr.toclen); +end; + +end. + diff --git a/docview/src/docdump/u_Tools.pas b/docview/src/docdump/u_Tools.pas new file mode 100644 index 00000000..96192db9 --- /dev/null +++ b/docview/src/docdump/u_Tools.pas @@ -0,0 +1,52 @@ +{ + This unit will grow to include all handy functions that can be used in + different Lazarus projects. + + There may be no links to other non-standard units! +} +unit u_Tools; + +{$mode objfpc}{$H+} + +interface + + { Missing iif() known from Visual Basic - return a string } + function iif(fCon: Boolean; sTrue, sFalse: String): String; + { Missing iif() known from Visual Basic - return an Integer } + function iif(fCon: Boolean; iTrue, iFalse: Integer): Integer; + { Missing iif() known from Visual Basic - return an Extended } + function iif(fCon: Boolean; iTrue, iFalse: Extended): Extended; + + +implementation +uses + SysUtils; + + +function iif(fCon: Boolean; sTrue, sFalse: String): String; +begin + if fCon then + Result := sTrue + else + Result := sFalse; +end; + +function iif(fCon: Boolean; iTrue, iFalse: Integer): Integer; +begin + if fCon then + Result := iTrue + else + Result := iFalse; +end; + +function iif(fCon: Boolean; iTrue, iFalse: Extended): Extended; +begin + if fCon then + Result := iTrue + else + Result := iFalse; +end; + + +end. + diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi new file mode 100644 index 00000000..2495cb6a --- /dev/null +++ b/docview/src/docview.lpi @@ -0,0 +1,197 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="7"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InIDEConfig"/> + <MainUnit Value="0"/> + <TargetFileExt Value=""/> + <Title Value="docview"/> + <UseAppBundle Value="False"/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="27"> + <Unit0> + <Filename Value="docview.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="docview"/> + </Unit0> + <Unit1> + <Filename Value="frm_main.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frm_main"/> + </Unit1> + <Unit2> + <Filename Value="IPFEscapeCodes.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="IPFEscapeCodes"/> + </Unit2> + <Unit3> + <Filename Value="HelpTopic.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="HelpTopic"/> + </Unit3> + <Unit4> + <Filename Value="HelpFile.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="HelpFile"/> + </Unit4> + <Unit5> + <Filename Value="CompareWordUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="CompareWordUnit"/> + </Unit5> + <Unit6> + <Filename Value="SearchTable.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="SearchTable"/> + </Unit6> + <Unit7> + <Filename Value="TextSearchQuery.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSearchQuery"/> + </Unit7> + <Unit8> + <Filename Value="nvUtilities.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="nvUtilities"/> + </Unit8> + <Unit9> + <Filename Value="nvNullObjects.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="nvNullObjects"/> + </Unit9> + <Unit10> + <Filename Value="../docs/inf04.txt"/> + <IsPartOfProject Value="True"/> + </Unit10> + <Unit11> + <Filename Value="SearchUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="SearchUnit"/> + </Unit11> + <Unit12> + <Filename Value="../components/richtext/RichTextStyleUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="RichTextStyleUnit"/> + </Unit12> + <Unit13> + <Filename Value="../components/richtext/CanvasFontManager.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="CanvasFontManager"/> + </Unit13> + <Unit14> + <Filename Value="../components/richtext/ACLStringUtility.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ACLStringUtility"/> + </Unit14> + <Unit15> + <Filename Value="../components/richtext/RichTextDocumentUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="RichTextDocumentUnit"/> + </Unit15> + <Unit16> + <Filename Value="../components/richtext/RichTextView.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="RichTextView"/> + </Unit16> + <Unit17> + <Filename Value="../components/richtext/RichTextLayoutUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="RichTextLayoutUnit"/> + </Unit17> + <Unit18> + <Filename Value="../components/richtext/RichTextDisplayUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="RichTextDisplayUnit"/> + </Unit18> + <Unit19> + <Filename Value="IPFFileFormatUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="IPFFileFormatUnit"/> + </Unit19> + <Unit20> + <Filename Value="HelpWindowDimensions.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="HelpWindowDimensions"/> + </Unit20> + <Unit21> + <Filename Value="NewViewConstantsUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="NewViewConstantsUnit"/> + </Unit21> + <Unit22> + <Filename Value="SettingsUnit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="SettingsUnit"/> + </Unit22> + <Unit23> + <Filename Value="dvconstants.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="dvconstants"/> + </Unit23> + <Unit24> + <Filename Value="dvHelpers.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="dvHelpers"/> + </Unit24> + <Unit25> + <Filename Value="HelpWindow.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="HelpWindow"/> + </Unit25> + <Unit26> + <Filename Value="../TODO.txt"/> + <IsPartOfProject Value="True"/> + </Unit26> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)/"/> + <OtherUnitFiles Value="../components/richtext/"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <IncludeAssertionCode Value="True"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> + </CodeGeneration> + <Other> + <CustomOptions Value="-O- +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr new file mode 100644 index 00000000..32a80f3b --- /dev/null +++ b/docview/src/docview.lpr @@ -0,0 +1,42 @@ +program docview; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + {$IFDEF Timing}EpikTimer,{$ENDIF} + fpg_main, frm_main, IPFEscapeCodes, HelpTopic, CompareWordUnit, SearchTable, + TextSearchQuery, nvUtilities, nvNullObjects, HelpFile, SearchUnit, + fpg_cmdlineparams, customstyle, IPFFileFormatUnit, HelpWindowDimensions, + NewViewConstantsUnit, SettingsUnit, RichTextStyleUnit, CanvasFontManager, + ACLStringUtility, RichTextDocumentUnit, RichTextView, RichTextLayoutUnit, + RichTextDisplayUnit, dvconstants, dvHelpers; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + + // always load custom style for help viewer + //if Assigned(fpgStyle) then + // fpgStyle.Free; + //fpgStyle := TMyStyle.Create; + + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + diff --git a/docview/src/dvHelpers.pas b/docview/src/dvHelpers.pas new file mode 100644 index 00000000..c5486bb7 --- /dev/null +++ b/docview/src/dvHelpers.pas @@ -0,0 +1,50 @@ +unit dvHelpers; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +const + OWN_HELP_MARKER = '[DOCVIEWHELP]'; + + +function GetOwnHelpFileName: String; +function FindHelpFile(const AFilename: string): string; + + +implementation + +uses + fpg_utils + ; + + +function GetOwnHelpFileName: String; +//var +// tmpLanguage : String; +begin + //tmpLanguage := getLanguage; + //if tmpLanguage = '' then + //begin + // tmpLanguage := GetEnv(LanguageEnvironmentVar) + //end; + // + //result := FindDefaultLanguageHelpFile('NewView', tmpLanguage); + + { TODO -oGraeme -cown help : Improve own help file location } + result := fpgExtractFilePath(ParamStr(0)) + 'docview.inf'; +end; + +// Given a "filename" which may include a path, find it in various paths and extensions +function FindHelpFile(const AFilename: string): string; +begin + { TODO -ograemeg -csearch files : Implement searching know locations } + Result := AFileName; +end; + + +end. + diff --git a/docview/src/dvconstants.pas b/docview/src/dvconstants.pas new file mode 100644 index 00000000..ae8b414d --- /dev/null +++ b/docview/src/dvconstants.pas @@ -0,0 +1,36 @@ +unit dvconstants; + +{$mode objfpc}{$H+} + +interface + +const + { DO NOT LOCALIZE } + HelpPathEnvironmentVar = 'HELP'; + BookshelfEnvironmentVar = 'BOOKSHELF'; + HELP_FILE_DELIMITER = '+'; + HELP_FILE_EXTENSION = ExtensionSeparator + 'hlp'; + INF_FILE_EXTENSION = ExtensionSeparator + 'inf'; + + +resourcestring + rsDVTitle = 'Documentation Viewer'; + rsDVSearchingMsg = 'Searching...'; + rsDVDisplaying = 'Displaying...'; + rsDVLoadingNotes = 'Loading notes...'; + rsDVDisplayContents = 'Display contents...'; + rsDVDisplayingFirstTopic = 'Display first topic...'; + rsDVDone = 'Done'; + rsDVNoFile = 'No file'; + rsDVOpenHelpFile = 'Open Help File'; + rsDVHelpFiles = 'Help Files'; + rsDVNoMatchesFound = '(No matches found for ''%s'')'; + rsDVSearchSyntaxError = 'Error in search syntax: '; + rsDVSearchFoundMsg = 'Found %d matches for '; + rsDVCouldNotOpen = 'Could not open <%s>'; + + +implementation + +end. + diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas new file mode 100644 index 00000000..0d1a8495 --- /dev/null +++ b/docview/src/frm_main.pas @@ -0,0 +1,2210 @@ +unit frm_main; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_panel, fpg_tab, + fpg_tree, fpg_splitter, fpg_menu, fpg_button, fpg_listbox, + fpg_label, fpg_edit, fpg_radiobutton, fpg_progressbar, fpg_mru, + HelpFile, RichTextView, HelpTopic; + +type + // Used by Index ListBox. We can generate a custom Index if the help file + // doesn't contain it's own index entries. + TListType = ( ltContents, ltIndex ); + + TMainForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: MainForm} + bvlStatusBar: TfpgBevel; + ProgressBar: TfpgProgressBar; + lblStatus: TfpgLabel; + bvlBody: TfpgBevel; + PageControl1: TfpgPageControl; + tsContents: TfpgTabSheet; + tvContents: TfpgTreeView; + btnGo: TfpgButton; + tsIndex: TfpgTabSheet; + btnIndex: TfpgButton; + lbIndex: TfpgListBox; + IndexSearchEdit: TfpgEdit; + tsSearch: TfpgTabSheet; + Label1: TfpgLabel; + edSearchText: TfpgEdit; + Label2: TfpgLabel; + RadioButton1: TfpgRadioButton; + RadioButton2: TfpgRadioButton; + RadioButton3: TfpgRadioButton; + RadioButton4: TfpgRadioButton; + RadioButton5: TfpgRadioButton; + RadioButton6: TfpgRadioButton; + lbSearchResults: TfpgListBox; + Label3: TfpgLabel; + btnSearch: TfpgButton; + tsNotes: TfpgTabSheet; + ListBox1: TfpgListBox; + btnNotesAdd: TfpgButton; + btnNotesEdit: TfpgButton; + btnNotesDel: TfpgButton; + btnNotesGoto: TfpgButton; + tsHistory: TfpgTabSheet; + lbHistory: TfpgListBox; + Splitter1: TfpgSplitter; + RichView: TRichTextView; + MainMenu: TfpgMenuBar; + miFile: TfpgPopupMenu; + miSettings: TfpgPopupMenu; + miBookmarks: TfpgPopupMenu; + miHelp: TfpgPopupMenu; + miDebug: TfpgPopupMenu; + miOpenRecentMenu: TfpgPopupMenu; + {@VFD_HEAD_END: MainForm} + Files: TList; // current open help files. + Debug: boolean; + mru: TfpgMRU; + FFileOpenRecent: TfpgMenuItem; + + LoadingFilenameList: TStringList; + LoadingFileIndex: integer; + LoadingTotalSize: longint; + LoadingSizeSoFar: longint; + AllFilesWordSequences: TList; // of lists; one per open file; of possible word sequences + CurrentOpenFiles: TList; // current open help files. + MainTitle: string; + InIndexSearch: boolean; // true while searching index + IndexLoaded: boolean; + ContentsLoaded: boolean; + DisplayedIndex: TStringList; // duplicate of index listbox, for fast case insensitive searching + CurrentTopic: TTopic; // so we can get easy access to current topic viewed + + procedure RichViewClickLink(Sender: TRichTextView; Link: string); + procedure IndexSearchEditKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure MainFormShow(Sender: TObject); + procedure MainFormDestroy(Sender: TObject); + procedure miFileQuitClicked(Sender: TObject); + procedure miFileOpenClicked(Sender: TObject); + procedure miFileCloseClicked(Sender: TObject); + procedure miHelpProdInfoClicked(Sender: TObject); + procedure miHelpAboutFPGui(Sender: TObject); + procedure miDebugHeader(Sender: TObject); + procedure miDebugHex(Sender: TObject); + procedure miFileSaveTopicAsIPF(Sender: TObject); + procedure miMRUClick(Sender: TObject; const FileName: String); + procedure btnShowIndex(Sender: TObject); + procedure btnGoClicked(Sender: TObject); + procedure tvContentsChange(Sender: TObject); + procedure edSearchTextKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure lbSearchResultsKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure MainFormException(Sender: TObject; E: Exception); + procedure MainFormCloseQuery(Sender: TObject; var CanClose: boolean); + procedure PageControl1Change(Sender: TObject; NewActiveSheet: TfpgTabSheet); + procedure tvContentsDoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure lbIndexDoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure lbSearchResultsDoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure btnSearchClicked(Sender: TObject); + procedure IndexSearchEditOnChange(Sender: TObject); + procedure DisplaySelectedSearchResultTopic; + procedure UpdateLocationPanel; + procedure EnableControls; + procedure ClearAllWordSequences; + procedure DoSearch; + procedure SetWaitCursor; + procedure ClearWaitCursor; + procedure SetMainCaption; + procedure DisplayFiles(NewFiles: TList; var FirstContentsNode: TfpgTreeNode); + procedure FileOpen; + function LoadFiles(const aFileNames: TStrings; aHelpFiles: TList): boolean; + function OpenFiles(const FileNames: TStrings; const AWindowTitle: string; const DisplayFirstTopic: boolean): boolean; + function OpenFile(const AFileName: string; const AWindowTitle: string; const DisplayFirstTopic: boolean): boolean; + procedure CloseFile(const ADestroying: boolean = False); + procedure OnHelpFileLoadProgress(n, outof: integer; AMessage: string); + procedure LoadNotes(AHelpFile: THelpFile); + procedure LoadContents(AFiles: TList; var FirstNode: TfpgTreeNode); + procedure LoadIndex; + // Used in loading contents + procedure AddChildNodes(AHelpFile: THelpFile; AParentNode: TfpgTreeNode; ALevel: longint; var ATopicIndex: longint ); + procedure ClearNotes; + procedure SaveNotes(AHelpFile: THelpFile); + procedure DisplayTopic(ATopic: TTopic = nil); + procedure ResetProgress; + procedure SetStatus(const AText: TfpgString); + function TranslateEnvironmentVar(AFilenames: TfpgString): TfpgString; + procedure RefreshFontSubstitutions; + procedure DisplaySelectedIndexTopic; + procedure ProcessCommandLineParams; + procedure ShowParamHelp; + function FindTopicForLink( Link: THelpLink ): TTopic; + function FindTopicByResourceID( ID: word ): TTopic; + function FindTopicByName(const AName: string): TTopic; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterCreate; override; + end; + +{@VFD_NEWFORM_DECL} + + +implementation + +uses + fpg_dialogs + ,fpg_constants + ,fpg_iniutils + ,fpg_cmdlineparams + ,nvUtilities + ,ACLStringUtility + ,TextSearchQuery + ,SearchUnit + ,dvconstants + ,IPFFileFormatUnit + ,SettingsUnit + ,dvHelpers + ; + +const + cLongName = 'fpGUI Documentation Viewer'; + cCreatedBy = 'Created by Graeme Geldenhuys'; + cVersion = 'Version 0.7 (alpha)'; + +{@VFD_NEWFORM_IMPL} + +procedure TMainForm.MainFormException(Sender: TObject; E: Exception); +begin + TfpgMessageDialog.Critical('An unexpected error occurred.', E.Message); +end; + +procedure TMainForm.RichViewClickLink(Sender: TRichTextView; Link: string); +var + LinkIndex: integer; + lLink: THelpLink; + lHelp: THelpFile; + i: integer; + lTopic: TTopic; + lFound: Boolean; +begin + // TODO: process other types of links (external, application etc...) too! + + LinkIndex := StrToInt( Link ); + lLink := THelpLink(CurrentTopic.Links[LinkIndex]); + lTopic := FindTopicForLink(lLink); + if lTopic <> nil then + DisplayTopic(lTopic); + exit; + + lHelp := THelpFile(lLink.HelpFile); + lTopic := nil; + lFound := False; + for i := 0 to CurrentOpenFiles.Count-1 do + begin + lHelp := THelpFile(CurrentOpenFiles[i]); + lTopic := lHelp.Topics[LinkIndex]; + if lTopic <> nil then + begin + lFound := True; + writeln('Found Topic! ', lTopic.Title); + break; + + end; + if lFound then + break; + end; + if lTopic <> nil then + begin + writeln('Displaying topic <', lTopic.Title, '>'); + DisplayTopic(lTopic); + end; + //lLink := SourceWindow.Topic.Links[ LinkIndex ]; + // + //PostMsg( Self.Handle, + // WM_FOLLOWLINK, + // longint( Link ), + // longint( SourceWindow ) ); + +end; + +procedure TMainForm.IndexSearchEditKeyPress(Sender: TObject; var KeyCode: word; + var ShiftState: TShiftState; var Consumed: boolean); +begin + if (KeyCode = keyEnter) or (KeyCode = keyPEnter) then + begin + Consumed := True; + DisplaySelectedIndexTopic; + end; +end; + +procedure TMainForm.MainFormShow(Sender: TObject); +begin + bvlBody.Realign; + + // restore previous window position and size + gINI.ReadFormState(self); + PageControl1.Width := gINI.ReadInteger('Options', 'SplitterLeft', 260); + UpdateWindowPosition; + + Settings.NormalFont := fpgStyle.DefaultFont; + Settings.FixedFont := fpgStyle.FixedFont; + Settings.SearchDirectories := TStringList.Create; + + LogEvent(LogSettings, 'Loading settings'); + LoadSettings; + + ProcessCommandLineParams; + +end; + +procedure TMainForm.MainFormDestroy(Sender: TObject); +begin + DisplayedIndex.Free; + // save splitter position + gINI.WriteInteger('Options', 'SplitterLeft', PageControl1.Width); + // save form size and position + gINI.WriteFormState(self); + LogEvent(LogSettings, 'Save settings'); + SaveSettings; + LogEvent(LogSettings, 'Save settings done'); +end; + +procedure TMainForm.miFileQuitClicked(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.miFileOpenClicked(Sender: TObject); +begin + FileOpen; +end; + +procedure TMainForm.miFileCloseClicked(Sender: TObject); +begin + CloseFile; +end; + +procedure TMainForm.miHelpProdInfoClicked(Sender: TObject); +var + s: TfpgString; +begin + s := cLongName + LineEnding + LineEnding + + cCreatedBy + LineEnding + + cVersion + ' - '+ {$I %date%} + ' ' + {$I %time%}; + + TfpgMessageDialog.Information('Product Information', s); +end; + +procedure TMainForm.miHelpAboutFPGui(Sender: TObject); +begin + TfpgMessageDialog.AboutFPGui; +end; + +procedure TMainForm.miDebugHeader(Sender: TObject); +var + f: THelpFile; + i: integer; + sl: TStringList; +begin + RichView.Clear; + sl := TStringList.Create; + RichView.AddText(PChar('FileCount = ' + IntToStr(CurrentOpenFiles.Count))); + for i := 0 to CurrentOpenFiles.Count-1 do + begin + f := THelpFile(CurrentOpenFiles[i]); + sl.Clear; + with sl do + begin + Add('<b><u>Filename:</u></b> <red>' + f.Filename + '<black>'); + Add(''); + Add('<b>Title:</b> ' + f.Title); + Add('<b>Dictionary count:</b> ' + IntToStr(f.DictionaryCount)); + Add('<b>Topic count:</b> ' + IntToStr(f.TopicCount)); + Add('<b>Index count:</b> ' + IntToStr(f.Index.Count)); + Add('<b>String resource id count:</b> ' + IntToStr(f.StringResourceIDCount)); + Add('<b>Numeric resource id count:</b> ' + IntToStr(f.NumericResourceIDCount)); + Add(' '); + //Add('Dictionary contents:'); + //for i := 0 to f.DictionaryCount-1 do + // Add('[' + IntToStr(i) + '] = <' + f.DictionaryWords[i] + '>'); + end; + RichView.AddParagraph(PChar(sl.Text)); + end; + sl.Free; +end; + +procedure TMainForm.miDebugHex(Sender: TObject); +begin + Debug := not Debug; + DisplayTopic(nil); +end; + +procedure TMainForm.miFileSaveTopicAsIPF(Sender: TObject); +var + F: TextFile; + T: TTopic; + dlg: TfpgFileDialog; + H: THelpFile; + i: integer; + filename: string; + imglist: TList; +begin +(* + H := THelpFile(CurrentOpenFiles[0]); + + FileName := ChangeFileExt( ExtractFileName( H.Filename ), '.ipf' ); + if not DoSaveFileDialog( FileSaveTitle, + 'IPF' + '|*.ipf', + Filename, + Settings.LastSaveDirectory, + Filename ) then + exit; + if FileExists( Filename ) then + if not DoConfirmDlg( FileSaveTitle, + ReplaceFilePromptA + + Filename + + ReplaceFilePromptB ) then + exit; + + ImageOffsets := TList.Create; + + AssignFile( F, FileName ); + Rewrite( F ); + WriteLn( F, ':userdoc.' ); + + // We can't tell if some levels of the contents were + // merged into the text of topics. So we just assume all are visible + WriteLn( F, ':docprof toc=123456.' ); + + ResourceIDs := TList.Create; + + WriteLn( F, ':title.' + H.Title ); + + for i := 0 to H.TopicCount - 1 do + begin + T := H.Topics[ i ]; + + SetProgress( i div 2, H.TopicCount , 'Saving text...' ); + + WriteLn( F, '' ); + + + if T.ContentsLevel = 0 then + begin + // perhaps it means footnote? + // Level := 1; + Write( F, ':fn id=fn' + IntToStr( i ) + '.' ); // use index as id + + T.SaveToIPF( F, ImageOffsets ); + + WriteLn( F, '' ); + WriteLn( F, ':efn.' ); + end + else + begin + Write( F, ':h' + IntToStr( T.ContentsLevel ) ); + Write( F, ' id=' + IntToStr( i ) ); // use index as id + + H.FindResourceIDsForTopic( T, ResourceIDs ); + if ResourceIDs.Count > 0 then + begin + Write( F, ' res=' + IntToStr( longint( ResourceIDs[ 0 ] ) ) ); + end; + + if not T.ShowInContents then + Write( F, ' hide' ); + + if T.ContentsGroupIndex > 0 then + Write( F, ' group=' + IntToStr( T.ContentsGroupIndex ) ); + + Write( F, '.' ); // end of header + WriteLn( F, T.Title ); + + T.SaveToIPF( F, ImageOffsets ); + end; + + + + end; + + ResourceIDs.Destroy; + + WriteLn( F, ':euserdoc.' ); + System.Close( F ); + + // Now write images + + for i := 0 to ImageOffsets.Count - 1 do + begin + ImageOffset := longint( ImageOffsets[ i ] ); + + SetProgress( i div 2 + ImageOffsets.Count div 2, + ImageOffsets.Count , + 'Saving images...' ); + + Image := H.GetImage( ImageOffset ); + + if Image <> nil then + begin + Image.SaveToFile( ExtractFilePath( Filename ) + + 'img' + + IntToStr( i ) + + '.bmp' ); + Image.Destroy; + end; + + end; + + ResetProgress; + SetStatus( 'Save complete' ); + ImageOffsets.Destroy; +*) + + + + //----------------------------- + if tvContents.Selection = nil then + Exit; //--> + + T := TTopic(tvContents.Selection.Data); + if T <> nil then + begin + dlg := TfpgFileDialog.Create(nil); + try + dlg.FileName := T.Title + '.ipf'; + if dlg.RunSaveFile then + begin + imglist := TList.Create; + AssignFile( F, dlg.FileName ); + Rewrite( F ); + T.SaveToIPF(F, imglist); + System.Close(F); + imglist.free; + dlg.Close; + dlg.Free; + end; + finally + end; + end; +end; + +procedure TMainForm.miMRUClick(Sender: TObject; const FileName: String); +begin + OpenFile(FileName, '', True); +end; + +procedure TMainForm.btnShowIndex(Sender: TObject); +begin + DisplaySelectedIndexTopic; +end; + +procedure TMainForm.btnGoClicked(Sender: TObject); +begin + if tvContents.Selection <> nil then + DisplayTopic(nil); +end; + +procedure TMainForm.tvContentsChange(Sender: TObject); +begin + DisplayTopic(nil); +end; + +procedure TMainForm.edSearchTextKeyPress(Sender: TObject; var KeyCode: word; + var ShiftState: TShiftState; var Consumed: boolean); +begin + if (KeyCode = keyReturn) or (KeyCode = keyPEnter) then + begin + Consumed := True; + btnSearch.Click; + end + else if (KeyCode = keyDown) then + begin + Consumed := True; + lbSearchResults.SetFocus; + end; +end; + +procedure TMainForm.lbSearchResultsKeyPress(Sender: TObject; var KeyCode: word; + var ShiftState: TShiftState; var Consumed: boolean); +begin + if (KeyCode = keyReturn) or (KeyCode = keyPEnter) then + begin + Consumed := True; + DisplayTopic(nil); + end +end; + +procedure TMainForm.MainFormCloseQuery(Sender: TObject; var CanClose: boolean); +begin + CloseFile(True); +end; + +procedure TMainForm.PageControl1Change(Sender: TObject; NewActiveSheet: TfpgTabSheet); +begin + if NewActiveSheet = tsIndex then + begin + if not IndexLoaded then + LoadIndex; + IndexSearchEdit.SetFocus; + end; +end; + +procedure TMainForm.tvContentsDoubleClick(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); +begin + if tvContents.Selection <> nil then + DisplayTopic(nil); +end; + +procedure TMainForm.lbIndexDoubleClick(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); +begin + InIndexSearch := True; // prevent edit.OnChange from executing too + try + IndexSearchEdit.Text := lbIndex.Items[lbIndex.FocusItem]; + DisplayTopic(nil); + finally + InIndexSearch := False; + end; +end; + +procedure TMainForm.lbSearchResultsDoubleClick(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); +begin + DisplaySelectedSearchResultTopic; +end; + +procedure TMainForm.btnSearchClicked(Sender: TObject); +begin + DoSearch; +end; + +procedure TMainForm.IndexSearchEditOnChange(Sender: TObject); +var + tmpMatchIndex: longint; + tmpSearchText: string; + i: longint; +begin + if InIndexSearch then + exit; + + tmpMatchIndex := -1; + tmpSearchText := trim(IndexSearchEdit.Text); + + for i := 0 to DisplayedIndex.Count - 1 do + begin + if StrStartsWithIgnoringCase(DisplayedIndex[i], tmpSearchText) then + begin + tmpMatchIndex := i; + break; + end; + end; + + if tmpMatchIndex = -1 then + exit; + + InIndexSearch:= true; + + + if lbIndex.FocusItem <> tmpMatchIndex then + lbIndex.FocusItem := tmpMatchIndex; + + InIndexSearch:= false; +end; + +procedure TMainForm.DisplaySelectedSearchResultTopic; +var + Topic: TTopic; +begin + if lbSearchResults.FocusItem = -1 then + exit; + if lbSearchResults.Items.Objects[lbSearchResults.FocusItem] = nil then + // the "no results" place holder + exit; + Topic := lbSearchResults.Items.Objects[lbSearchResults.FocusItem] as TTopic; + DisplayTopic( Topic ); +end; + +procedure TMainForm.UpdateLocationPanel; +var + i: integer; + s: string; + n: TfpgTreeNode; + sep: string; +begin + s := ''; + sep := ''; + n := tvContents.Selection; + while n.Parent <> nil do + begin + s := n.Parent.Text + sep + s; + n := n.Parent; + sep := ' > '; + end; + SetStatus(s); +end; + +procedure TMainForm.EnableControls; +begin + // +end; + +procedure TMainForm.ClearAllWordSequences; +var + i: longint; + FileWordSequences: TList; + HelpFile: THelpFile; +begin + if AllFilesWordSequences = nil then + exit; + + for i := 0 to AllFilesWordSequences.Count - 1 do + begin + FileWordSequences := TList(AllFilesWordSequences[ i ]); + HelpFile := THelpFile(CurrentOpenFiles[ i ]); + ClearWordSequences( FileWordSequences, HelpFile.DictionaryCount ); + FileWordSequences.Free; + end; + AllFilesWordSequences.Clear; +end; + +procedure TMainForm.DoSearch; +var + SearchResults: TList; + SearchText: string; + FileIndex: longint; + HelpFile: THelpFile; + TopicIndex: longint; + Topic: TTopic; + FileWordSequences: TList; + Query: TTextSearchQuery; +begin + SearchText := Trim(edSearchText.Text); + lbSearchResults.Items.Clear; + + if SearchText = '' then + exit; + + lbSearchResults.Items.Add(rsDVSearchingMsg); + SetStatus(rsDVSearchingMsg); + + try + Query := TTextSearchQuery.Create( SearchText ); + except + on e: ESearchSyntaxError do + begin + TfpgMessageDialog.Critical( rsSearch, rsDVSearchSyntaxError + e.Message ); + exit; + end; + end; + + ClearAllWordSequences; + + SetWaitCursor; + + SearchResults := TList.Create; + + // Search open help file + for FileIndex := 0 to CurrentOpenFiles.Count - 1 do + begin + HelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); + FileWordSequences := TList.Create; + try + SearchHelpFile( HelpFile, + Query, + SearchResults, + FileWordSequences ); + except + on E: EHelpFileException do + begin + TfpgMessageDialog.Critical(rsError , E.Message); + Query.Destroy; + ClearWaitCursor; + exit; + end; + end; + + AllFilesWordSequences.Add( FileWordSequences ); + end; + + // Sort results across all files by relevance + SearchResults.Sort( @TopicRelevanceCompare ); + + // Load topics into search results list. + lbSearchResults.Items.BeginUpdate; + lbSearchResults.Items.Clear; + + for TopicIndex := 0 to SearchResults.Count - 1 do + begin + Topic := TTopic(SearchResults[ TopicIndex ]); + lbSearchResults.Items.AddObject( Topic.Title + + ' [' + + IntToStr( Topic.SearchRelevance ) + + ']', + Topic ); + end; + + EnableControls; +// if lbSearchResults.Items.Count > 0 then + // there are some search matches, so highlight words +// ViewHighlightSearchWordsMI.Checked := true; + + lbSearchResults.FocusItem := -1; + lbSearchResults.Items.EndUpdate; + + Query.Free; + SearchResults.Free; + + if lbSearchResults.Items.Count > 0 then + begin + lbSearchResults.FocusItem := 0; + end + else + begin + lbSearchResults.Items.Add( Format(rsDVNoMatchesFound, [SearchText])); +// RefreshWindows( Windows ); // update to remove old highlights + end; + SetStatus( Format(rsDVSearchFoundMsg, [lbSearchResults.Items.Count]) + + StrInDoubleQuotes(SearchText)); + + ClearWaitCursor; + DisplaySelectedSearchResultTopic; +end; + +procedure TMainForm.SetWaitCursor; +begin + // +end; + +procedure TMainForm.ClearWaitCursor; +begin + // +end; + +procedure TMainForm.SetMainCaption; +begin + WindowTitle:= MainTitle; + fpgApplication.ProcessMessages; +end; + +procedure TMainForm.DisplayFiles(NewFiles: TList; var FirstContentsNode: TfpgTreeNode); +var + HelpFile: THelpFile; + FileIndex: longint; +begin + LogEvent(LogStartup, 'DisplayFiles' ); + // Now load the various parts of the file(s) + // into the user interface + ProgressBar.Position := 52; + SetStatus( rsDVDisplaying ); + + // Add our open files in the global filelist + { TODO -ograeme : implement global filelist support } + //for FileIndex := 0 to NewFiles.Count - 1 do + //begin + // HelpFile := NewFiles[ FileIndex ]; + // GlobalFilelist.AddFile( HelpFile.Filename, Frame.Handle ); + // // LoadNotes( HelpFile ); + // LoadBookmarks( HelpFile ); + //end; + + { TODO -ograeme : update notes display } + //UpdateNotesDisplay; + + { TODO -ograeme : bookmarks } + //BuildBookmarksMenu; + //UpdateBookmarksForm; + + ProgressBar.Position := 55; + + ContentsLoaded := false; + IndexLoaded := false; + + LoadContents( NewFiles, FirstContentsNode ); + + ProgressBar.Position := 75; + + LoadIndex; + + ProgressBar.Position := 100; + SetStatus( rsDVDone ); + + LogEvent(LogStartup, 'DisplayFiles Done' ); +end; + +procedure TMainForm.FileOpen; +var + dlg: TfpgFileDialog; +begin + dlg := TfpgFileDialog.Create(nil); + try + dlg.InitialDir := Settings.LastOpenDirectory; + dlg.WindowTitle := rsDVOpenHelpFile; + dlg.Filter := rsDVHelpFiles + ' (*.hlp, *.inf)|*.inf;*.hlp '; + // and a catch all filter + dlg.Filter := dlg.Filter + '|(' + rsAllFiles + ' (*)|*'; + + if dlg.RunOpenFile then + begin + mru.AddItem(dlg.Filename); + Settings.LastOpenDirectory := ExtractFilePath(dlg.Filename); + OpenFile(dlg.Filename, '', true); + end; + { TODO -oGraeme : Add support for multiple files. } + finally + dlg.Free; + end; +end; + +function TMainForm.LoadFiles(const aFileNames: TStrings; aHelpFiles: TList): boolean; +var + HelpFile: THelpFile; + FileIndex, i: longint; + FileName: string; + FullFilePath: string; +begin + LogEvent(LogStartup, 'LoadFiles' ); + LoadingFilenameList := TStringList.Create; + +// RBRi TranslateIPFEnvironmentVars( FileNames, LoadingFilenameList ); + for i := 0 to aFileNames.Count - 1 do + LoadingFilenameList.Add(aFileNames[i]); + + LogEvent(LogStartup, 'Finding files' ); + ProgressBar.Visible := True; + + // now find full file paths, + // and also the total file size for progress display + for FileIndex := 0 to LoadingFilenameList.Count - 1 do + begin + FileName := LoadingFilenameList[ FileIndex ]; + LogEvent(LogStartup, ' File: ' + FileName ); + + // Find the help file, if possible + if Filename = OWN_HELP_MARKER then + begin + FullFilePath := GetOwnHelpFileName; + end + else + begin + FullFilePath := FindHelpFile( Filename ); + end; + + if FullFilePath <> '' then + begin + LogEvent(LogStartup, ' Full path: ' + FullFilePath ); + end + else + begin + LogEvent(LogStartup, ' File not found' ); + FullFilePath := FileName; // we'll complain later. + end; + LoadingFilenameList[ FileIndex ] := FullFilePath; + end; + + // Now actually load the files + for FileIndex := 0 to LoadingFilenameList.Count - 1 do + begin + Filename := LoadingFilenameList[ FileIndex ]; + mru.AddItem(FileName); + LogEvent(LogStartup, ' Loading: ' + Filename ); + try + LoadingFileIndex := FileIndex; + + // load the file + HelpFile := THelpFile.Create( FileName ); + if Settings.FixedFontSubstitution then + HelpFile.SetupFontSubstitutes( Settings.FixedFontSubstitutes ); + + aHelpFiles.Add( HelpFile ); + + except + on E: Exception do + begin + + if E is EWindowsHelpFormatException then + begin + { TODO -ograeme -cnice to have : Implement opening Windows help } + //OpenWindowsHelp( Filename ); + end + else + begin + TfpgMessageDialog.Critical( rsDVOpenHelpFile, + Format(rsDVCouldNotOpen, [Filename]) + + ': ' + + E.Message ); + end; + + // back out of the load process + Result := false; + + DestroyListObjects( aHelpFiles ); + + LoadingFilenameList.Free; + ResetProgress; + exit; + end + end; + end; + + LoadingFilenameList.Free; + Result := true; +end; + +{ Open the file or list of files in FileNames + Set the window title if given, otherwise get it from first file } +function TMainForm.OpenFiles(const FileNames: TStrings; + const AWindowTitle: string; const DisplayFirstTopic: boolean): boolean; +var + tmpHelpFiles: TList; + FirstContentsNode: TfpgTreeNode; +begin + LogEvent(LogStartup, 'OpenFiles' ); + + //if not OKToCloseFile then + // exit; + + SetWaitCursor; + tmpHelpFiles := TList.Create; + +// RBRi Translate + if not LoadFiles(FileNames, tmpHelpFiles) then + begin + ClearWaitCursor; + tmpHelpFiles.Free; + exit; + end; + + Result := true; + + lbSearchResults.Items.Clear; + { TODO : page history support } +// PageHistory.Clear; +// CurrentHistoryIndex := -1; + + // Now that we have successfully loaded the new help file(s) + // close the existing one. + CloseFile; + + AssignList(tmpHelpFiles, CurrentOpenFiles ); + + ProgressBar.Position := 50; + SetStatus( rsDVDisplaying ); + +// AddCurrentToMRUFiles; + + if AWindowTitle = '' then + MainTitle := THelpFile( CurrentOpenFiles[ 0 ] ).Title + else + MainTitle := AWindowTitle; + SetMainCaption; + + // Now load the various parts of the file(s) + // into the user interface + tvContents.RootNode.Clear; + + DisplayFiles( tmpHelpFiles, FirstContentsNode ); + + //if CmdLineParameters.getHelpManagerFlag then + // ShowLeftPanel := Settings.ShowLeftPanel_Help + //else + // ShowLeftPanel := Settings.ShowLeftPanel_Standalone; + + // Select first contents node if there is one + if FirstContentsNode <> nil then + begin + LogEvent(LogStartup, ' Select first node' ); + tvContents.Selection := FirstContentsNode; + tvContents.SetFocus; + end; + + ClearWaitCursor; + + ResetProgress; + +// NotebookOnPageChanged( self ); // ensure e.g. index loaded + + EnableControls; + + if DisplayFirstTopic then + begin + LogEvent(LogStartup, 'Display first topic' ); + { TODO -oGraeme : Improved Display Topic method } +// DisplaySelectedContentsTopic; + DisplayTopic(nil); + end; + + LogEvent(LogStartup, 'OpenFiles complete' ); +end; + +{ Open a single file } +function TMainForm.OpenFile(const AFileName: string; const AWindowTitle: string; + const DisplayFirstTopic: boolean): boolean; +var + tmpFileNames: TStringList; +begin + tmpFileNames := TStringList.Create; + ParseAndExpandFileNames(AFileName, tmpFileNames); + Result := OpenFiles( tmpFileNames, AWindowTitle, DisplayFirstTopic ); + tmpFileNames.Free; +end; + +procedure TMainForm.CloseFile(const ADestroying: boolean = False); +var + FileIndex: longint; + lHelpFile: THelpFile; +begin + tvContents.Selection := nil; + tvContents.RootNode.Clear; + RichView.Clear(ADestroying); + if not ADestroying then + begin + WindowTitle := rsDVTitle + ' - ' + rsDVNoFile; + tvContents.Invalidate; + end; + + // First save notes. It's important we do this first + // since we scan all notes each time to find the ones + // belonging to this file. + for FileIndex := 0 to Files.Count - 1 do + begin + lHelpFile := THelpFile(Files[FileIndex]); + SaveNotes( lHelpFile ); + end; + + DisplayedIndex.Clear; + + // Now destroy help files + for FileIndex := 0 to Files.Count - 1 do + begin + lHelpFile := THelpFile(Files[FileIndex]); + lHelpFile.Free; + end; + + Files.Clear; + ClearNotes; +end; + +procedure TMainForm.OnHelpFileLoadProgress(n, outof: integer; AMessage: string); +begin + // +end; + +procedure TMainForm.LoadNotes(AHelpFile: THelpFile); +begin +// NotesFileName:= ChangeFileExt( HelpFile.FileName, '.nte' ); + +end; + +procedure TMainForm.LoadContents(AFiles: TList; var FirstNode: TfpgTreeNode); +var + FileIndex: integer; + HelpFile: THelpFile; + TopicIndex: integer; + Node: TfpgTreeNode; + Topic: TTopic; +begin + LogEvent(LogStartup, 'Load contents outline'); + // we don't clear treeview here in case we need to load more files later. + LogEvent(LogStartup, 'Loop files'); + + FirstNode := nil; + Node := nil; + + for FileIndex:= 0 to AFiles.Count - 1 do + begin + HelpFile:= THelpFile(AFiles[ FileIndex ]); + ProfileEvent( 'File ' + IntToStr( FileIndex ) ); + TopicIndex:= 0; + ProfileEvent('TopicCount=' + IntToStr(HelpFile.TopicCount)); + while TopicIndex < HelpFile.TopicCount do + begin + Topic := HelpFile.Topics[ TopicIndex ]; + if Topic.ShowInContents then + begin + if Topic.ContentsLevel = 1 then + begin + Node := tvContents.RootNode.AppendText(Topic.Title); + Node.Data := Topic; + if FirstNode = nil then + FirstNode := Node; + inc( TopicIndex ); + end + else + begin + // child nodes + AddChildNodes( HelpFile, + Node, + Topic.ContentsLevel, + TopicIndex ); + Node := nil; + end; + end + else + begin + inc( TopicIndex ); + end; + end; + end; + LogEvent(LogStartup, ' EndUpdate' ); + + if Settings.OpenWithExpandedContents then + begin + LogEvent(LogStartup, ' Expand all contents' ); + tvContents.RootNode.Expand; + node := tvContents.RootNode.Next; + while node <> nil do + begin + node.Expand; + node := tvContents.RootNode.Next; + end; + end + else + begin + LogEvent(LogStartup, ' Expand first node' ); + // Contents has only one top level node... expand it + FirstNode.Expand; + end; + + ContentsLoaded := true; + tvContents.Invalidate; + LogEvent(LogStartup, ' Contents loaded' ); +end; + +// Gets the contents from each file. Sorts it alphabetically. +// Merges all the sorted contents and indexes together, alphabetically. +procedure TMainForm.LoadIndex; +var + tmpHelpFile: THelpFile; + tmpTextCompareResult: integer; + FileIndex: longint; + Contents: TList; + ContentsLists: TList; // of tlist + tmpIndexLists: TList; // of tstringlist + ContentsNextIndex: array[ 0..255 ] of longint; + IndexNextIndex: array[ 0..255 ] of longint; + Topic: TTopic; + ListEntry: string; + LowestEntry: string; + LastEntry: string; + tmpLowestEntryListIndex: longint; + tmpLowestEntryListType: TListType; + tmpLowestEntryTopic: TTopic; + tmpIndex: TStringList; + i: longint; +begin + LogEvent(LogStartup, 'Create index' ); + SetWaitCursor; + LogEvent(LogStartup, ' Get/sort lists' ); + + ProgressBar.Position := 70; + SetStatus( 'Building index... ' ); + + ContentsLists := TList.Create; + tmpIndexLists := TList.Create; + + // collect the contents and index lists from the files + for FileIndex := 0 to CurrentOpenFiles.Count - 1 do + begin + tmpHelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); + ProgressBar.Position := 70 + 10 * FileIndex div CurrentOpenFiles.Count; + + if Settings.IndexStyle in [ isAlphabetical, isFull ] then + begin + Contents := TList.Create; + Contents.Capacity := tmpHelpFile.TopicCount; // speeds up inserts + // copy [contents] topic list + for i := 0 to tmpHelpFile.TopicCount - 1 do + begin + Topic := tmpHelpFile.Topics[ i ]; + if Topic.ShowInContents then + Contents.Add( Topic ); + end; + // sort by title + Contents.Sort( @TopicTitleCompare ); + ContentsLists.Add( Contents ); + // initialise list index + ContentsNextIndex[ ContentsLists.Count - 1 ] := 0; + end; + + if Settings.IndexStyle in [ isFileOnly, isFull ] then + begin + tmpIndexLists.Add(tmpHelpFile.Index.GetLabels); + IndexNextIndex[ tmpIndexLists.Count - 1 ] := 0; + end; + end; + + // Unlike contents, we do clear the index (even if we are adding more files) + // because we need to re-merge the whole thing + DisplayedIndex.Clear; + ProgressBar.Position := 80; + + LogEvent(LogStartup, ' Merge lists' ); + LastEntry := ''; + while true do + begin + LowestEntry := ''; + tmpLowestEntryListIndex := -1; + // Find alphabetically lowest (remaining) topic + // first, look in contents lists + LogEvent(LogDebug, ' Merge contents' ); + for i := 0 to ContentsLists.Count - 1 do + begin + Contents := TList(ContentsLists.Items[i]); + if ContentsNextIndex[i] < Contents.Count then + begin + // list is not yet finished, get next entry + Topic := TTopic(Contents[ ContentsNextIndex[i] ]); + ListEntry := Topic.Title; + + if LowestEntry <> '' then + tmpTextCompareResult := CompareText( ListEntry, LowestEntry ) + else + tmpTextCompareResult := -1; + + if tmpTextCompareResult < 0 then + begin + // this index entry comes before the lowest one so far + LowestEntry := ListEntry; + tmpLowestEntryListIndex := i; + tmpLowestEntryListType := ltContents; + tmpLowestEntryTopic := Topic; + end; + end; + end; + + // look in indices + LogEvent(LogDebug, ' Merge indices' ); + for i := 0 to tmpIndexLists.Count - 1 do + begin + LogEvent(LogDebug, ' Merge indices ' + IntToStr(i) ); + tmpIndex := TStringList(tmpIndexLists.Items[i]); + if IndexNextIndex[i] < tmpIndex.Count then + begin + // list is not yet finished, get next entry + ListEntry := tmpIndex.Strings[ IndexNextIndex[i] ]; + LogEvent(LogDebug, ' indices ListEntry=' + ListEntry ); + if LowestEntry <> '' then + tmpTextCompareResult := CompareText( ListEntry, LowestEntry ) + else + tmpTextCompareResult := -1; + + if tmpTextCompareResult < 0 then + begin + // this index entry comes before the lowest one so far + LowestEntry := ListEntry; + tmpLowestEntryListIndex := i; + tmpLowestEntryListType := ltIndex; + + LogEvent(LogDebug, ' Merge indices ' + tmpIndex.Objects[ IndexNextIndex[i] ].ClassName); + tmpLowestEntryTopic := TIndexEntry( tmpIndex.Objects[ IndexNextIndex[i] ] ).getTopic; + end; + end; + end; + + if tmpLowestEntryListIndex = -1 then + // we're out + break; + + if LowestEntry <> LastEntry then + // add, if different from last + DisplayedIndex.AddObject( LowestEntry, tmpLowestEntryTopic ); + LastEntry := LowestEntry; + + if tmpLowestEntryListType = ltContents then + begin + inc( ContentsNextIndex[ tmpLowestEntryListIndex ] ); + end + else + begin + // found in one of indices. + // Check for subsequent indented strings + tmpIndex := TStringList(tmpIndexLists[ tmpLowestEntryListIndex ]); + + i := IndexNextIndex[ tmpLowestEntryListIndex ] + 1; + while i < tmpIndex.Count do + begin + ListEntry := tmpIndex.Strings[ i ]; + if ListEntry = '' then + break; + + if ListEntry[ 1 ] <> ' ' then + // not indented, stop looking + break; + + // found one, + Topic := TIndexEntry(tmpIndex.Objects[ i ]).getTopic; + DisplayedIndex.AddObject( ListEntry, Topic ); + inc( i ); + end; + IndexNextIndex[ tmpLowestEntryListIndex ] := i; + end; + end; + + ProgressBar.Position := 95; + LogEvent(LogStartup, ' Display index (count = ' + IntToStr(DisplayedIndex.Count) + ')'); + + // Now display the final index list + lbIndex.Items.Assign( DisplayedIndex ); + + LogEvent(LogStartup, ' Tidy up' ); + tmpIndexLists.Free; + DestroyListAndObjects( ContentsLists ); + IndexLoaded := true; + + ClearWaitCursor; + + SetStatus( 'Index loaded' ); + LogEvent(LogStartup, ' Done' ); +end; + +procedure TMainForm.AddChildNodes(AHelpFile: THelpFile; AParentNode: TfpgTreeNode; + ALevel: longint; var ATopicIndex: longint); +var + Topic: TTopic; + Node: TfpgTreeNode; +begin + Node := nil; + while ATopicIndex < AHelpFile.TopicCount do + begin + Topic := AHelpFile.Topics[ ATopicIndex ]; + if Topic.ShowInContents then + begin + if Topic.ContentsLevel < ALevel then + break; + + if Topic.ContentsLevel = ALevel then + begin + Node := AParentNode.AppendText(Topic.Title); + Node.Data := Topic; + inc( ATopicIndex ); + end + else + begin + AddChildNodes( AHelpFile, + Node, + Topic.ContentsLevel, + ATopicIndex ); + Node := nil; + end + end + else + begin + inc( ATopicIndex ); + end; + end; { while } +end; + +procedure TMainForm.ClearNotes; +begin + { TODO -oGraeme : Implement me } +end; + +procedure TMainForm.SaveNotes(AHelpFile: THelpFile); +begin + { TODO -oGraeme : Implement me } +end; + +procedure TMainForm.DisplayTopic(ATopic: TTopic); +var + lText: String; + ImageIndices: TList; + LinkIndex: longint; + Link: THelpLink; + HelpFile: THelpFile; + Topic: TTopic; + HighlightWordSequences: TList; + FileIndex: integer; +Begin + ProfileEvent('DisplayTopic >>>>'); + if ATopic = nil then + begin + case PageControl1.ActivePageIndex of + 0: begin // TOC tab + if tvContents.Selection = nil then + begin + ShowMessage('You must select a topic first by clicking it.'); + Exit; //==> + end + else + Topic := TTopic(tvContents.Selection.Data); + ProfileEvent('Got Topic from Treeview'); + end; + 1: begin // Index tab + if lbIndex.FocusItem = -1 then + begin + ShowMessage('You must select a index first by clicking it.'); + Exit; //==> + end + else + Topic := TTopic(lbIndex.Items.Objects[lbIndex.FocusItem]); + ProfileEvent('Got Topic from Index listbox'); + end; + 2: begin // Search tab + if lbSearchResults.FocusItem = -1 then + begin + ShowMessage('You must select a search result first by clicking it.'); + Exit; //==> + end + else + Topic := TTopic(lbSearchResults.Items.Objects[lbSearchResults.FocusItem]); + ProfileEvent('Got Topic from Search Results listbox'); + end; + end; + end // case.. + else + Topic := ATopic; // use topic passed in as a parameter + + if Topic = nil then + raise Exception.Create('Unable to locate the Topic'); + + CurrentTopic:= Topic; + + RichView.Clear; + ImageIndices := TList.Create; + ProfileEvent('Cleared memo...'); + + HelpFile := TopicFile(CurrentTopic); + if HelpFile = nil then + raise Exception.Create('Failed to get active HelpFile from Topic'); + + if HelpFile.HighlightWords <> nil then + ProfileEvent('highlightwords is ok'); + + if (AllFilesWordSequences.Count > 0) // ie we have done a search... + {and ViewHighlightSearchWordsMI.Checked} then + begin + FileIndex := CurrentOpenFiles.IndexOf( HelpFile ); + HighlightWordSequences := TList(AllFilesWordSequences[ FileIndex ]); + end + else + HighlightWordSequences := nil; + + lText := ''; + ProfileEvent('Debug show hex values = ' + BoolToStr(Debug)); + if ImageIndices <> nil then + ProfileEvent('ImageIndices initialized'); + + CurrentTopic.GetText( HighlightWordSequences, + Debug {ShowCodes}, + False {ShowWordIndices}, + lText {TopicText}, + ImageIndices, + nil {Highlights} ); + + { TODO -oGraeme : We do not support images yet } + ImageIndices.Free; + + //writeln(lText); + //writeln('-----------------------------'); + RichView.AddText(PChar(lText)); + + tvContents.Selection := tvContents.RootNode.FindSubNode(CurrentTopic, True); + tvContents.Invalidate; + UpdateLocationPanel; +end; + +procedure TMainForm.ResetProgress; +begin + { TODO -oGraeme : implement ResetProgress } + ProgressBar.Visible := False; + ProgressBar.Position := 0; +end; + +procedure TMainForm.SetStatus(const AText: TfpgString); +begin + lblStatus.Text := AText; +end; + +function TMainForm.TranslateEnvironmentVar(AFilenames: TfpgString): TfpgString; +var + EnvironmentVarValue: string; +begin + EnvironmentVarValue := GetEnvironmentVariable(UpperCase(AFilenames)); + if EnvironmentVarValue <> '' then + Result := EnvironmentVarValue + else + Result := AFileNames; +end; + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + fpgApplication.OnException := @MainFormException; + OnShow := @MainFormShow; + OnDestroy :=@MainFormDestroy; + Files := TList.Create; + AllFilesWordSequences := TList.Create; + CurrentOpenFiles := TList.Create; + DisplayedIndex := TStringList.Create; + { TODO -oGraeme : Make Debug a menu option } + Debug := False; +end; + +destructor TMainForm.Destroy; +var + FileIndex: integer; + lHelpFile: THelpFile; +begin +writeln('DEBUG: TMainForm.Destroy >>>>'); + CurrentTopic := nil; // it was a reference only + FFileOpenRecent := nil; // it was a reference only + DestroyListAndObjects(Files); + DestroyListAndObjects(AllFilesWordSequences); + DestroyListAndObjects(CurrentOpenFiles); +writeln('DEBUG: TMainForm.Destroy 1'); + inherited Destroy; +writeln('DEBUG: TMainForm.Destroy <<<<'); +end; + +procedure TMainForm.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(602, 274, 654, 386); + WindowTitle := 'fpGUI Documentation Viewer'; + WindowPosition := wpUser; + OnCloseQuery := @MainFormCloseQuery; + + bvlStatusBar := TfpgBevel.Create(self); + with bvlStatusBar do + begin + Name := 'bvlStatusBar'; + SetPosition(0, 366, 653, 20); + Anchors := [anLeft,anRight,anBottom]; + Style := bsLowered; + end; + + ProgressBar := TfpgProgressBar.Create(bvlStatusBar); + with ProgressBar do + begin + Name := 'ProgressBar'; + SetPosition(501, 2, 150, 16); + Anchors := [anRight,anBottom]; + end; + + lblStatus := TfpgLabel.Create(bvlStatusBar); + with lblStatus do + begin + Name := 'lblStatus'; + SetPosition(4, 2, 380, 16); + Anchors := [anLeft,anRight,anBottom]; + FontDesc := '#Label1'; + Hint := ''; + Text := ''; + end; + + bvlBody := TfpgBevel.Create(self); + with bvlBody do + begin + Name := 'bvlBody'; + SetPosition(0, 25, 653, 340); + Anchors := [anLeft,anRight,anTop,anBottom]; + Shape := bsSpacer; + end; + + PageControl1 := TfpgPageControl.Create(bvlBody); + with PageControl1 do + begin + Name := 'PageControl1'; + SetPosition(0, 12, 260, 316); + ActivePageIndex := 4; + TabOrder := 0; + Align := alLeft; + OnChange := @PageControl1Change; + end; + + tsContents := TfpgTabSheet.Create(PageControl1); + with tsContents do + begin + Name := 'tsContents'; + SetPosition(3, 24, 254, 301); + Text := 'Contents'; + end; + + tvContents := TfpgTreeView.Create(tsContents); + with tvContents do + begin + Name := 'tvContents'; + SetPosition(4, 32, 242, 264); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#Label1'; + ScrollWheelDelta := 60; + ShowImages := True; + TabOrder := 0; + OnChange := @tvContentsChange; + //OnDoubleClick := @tvContentsDoubleClick; + end; + + btnGo := TfpgButton.Create(tsContents); + with btnGo do + begin + Name := 'btnGo'; + SetPosition(166, 4, 80, 24); + Anchors := [anRight,anTop]; + Text := 'Go to'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + OnClick := @btnGoClicked; + end; + + tsIndex := TfpgTabSheet.Create(PageControl1); + with tsIndex do + begin + Name := 'tsIndex'; + SetPosition(3, 24, 254, 301); + Text := 'Index'; + end; + + btnIndex := TfpgButton.Create(tsIndex); + with btnIndex do + begin + Name := 'btnIndex'; + SetPosition(166, 4, 80, 24); + Anchors := [anRight,anTop]; + Text := 'Go to'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + OnClick := @btnShowIndex; + end; + + lbIndex := TfpgListBox.Create(tsIndex); + with lbIndex do + begin + Name := 'lbIndex'; + SetPosition(4, 32, 242, 264); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#List'; + HotTrack := False; + PopupFrame := False; + TabOrder := 1; + OnDoubleClick := @lbIndexDoubleClick; + end; + + IndexSearchEdit := TfpgEdit.Create(tsIndex); + with IndexSearchEdit do + begin + Name := 'IndexSearchEdit'; + SetPosition(4, 4, 152, 24); + Anchors := [anLeft,anRight,anTop]; + TabOrder := 2; + Text := ''; + FontDesc := '#Edit1'; + OnChange := @IndexSearchEditOnChange; + OnKeyPress :=@IndexSearchEditKeyPress; + end; + + tsSearch := TfpgTabSheet.Create(PageControl1); + with tsSearch do + begin + Name := 'tsSearch'; + SetPosition(3, 24, 254, 301); + Text := 'Search'; + end; + + Label1 := TfpgLabel.Create(tsSearch); + with Label1 do + begin + Name := 'Label1'; + SetPosition(4, 4, 120, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Search for:'; + end; + + edSearchText := TfpgEdit.Create(tsSearch); + with edSearchText do + begin + Name := 'edSearchText'; + SetPosition(4, 20, 210, 26); + Anchors := [anLeft,anRight,anTop]; + TabOrder := 1; + Text := ''; + FontDesc := '#Edit1'; + OnKeyPress :=@edSearchTextKeyPress; + end; + + Label2 := TfpgLabel.Create(tsSearch); + with Label2 do + begin + Name := 'Label2'; + SetPosition(4, 48, 172, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Criteria:'; + end; + + RadioButton1 := TfpgRadioButton.Create(tsSearch); + with RadioButton1 do + begin + Name := 'RadioButton1'; + SetPosition(12, 68, 192, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 3; + Text := 'This section'; + Enabled := False; + end; + + RadioButton2 := TfpgRadioButton.Create(tsSearch); + with RadioButton2 do + begin + Name := 'RadioButton2'; + SetPosition(12, 88, 192, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 4; + Text := 'Marked sections'; + Enabled := False; + end; + + RadioButton3 := TfpgRadioButton.Create(tsSearch); + with RadioButton3 do + begin + Name := 'RadioButton3'; + SetPosition(12, 108, 192, 20); + Checked := True; + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 5; + Text := 'All sections'; + Enabled := False; + end; + + RadioButton4 := TfpgRadioButton.Create(tsSearch); + with RadioButton4 do + begin + Name := 'RadioButton4'; + SetPosition(12, 128, 192, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 6; + Text := 'Index'; + Enabled := False; + end; + + RadioButton5 := TfpgRadioButton.Create(tsSearch); + with RadioButton5 do + begin + Name := 'RadioButton5'; + SetPosition(12, 148, 192, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 7; + Text := 'Marked libraries'; + Enabled := False; + end; + + RadioButton6 := TfpgRadioButton.Create(tsSearch); + with RadioButton6 do + begin + Name := 'RadioButton6'; + SetPosition(12, 168, 192, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + TabOrder := 8; + Text := 'All libraries'; + Enabled := False; + end; + + lbSearchResults := TfpgListBox.Create(tsSearch); + with lbSearchResults do + begin + Name := 'lbSearchResults'; + SetPosition(4, 220, 242, 76); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#List'; + HotTrack := False; + PopupFrame := False; + TabOrder := 9; + OnDoubleClick := @lbSearchResultsDoubleClick; + OnKeyPress := @lbSearchResultsKeyPress; + end; + + Label3 := TfpgLabel.Create(tsSearch); + with Label3 do + begin + Name := 'Label3'; + SetPosition(4, 200, 196, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Search results:'; + end; + + btnSearch := TfpgButton.Create(tsSearch); + with btnSearch do + begin + Name := 'btnSearch'; + SetPosition(220, 20, 28, 26); + Anchors := [anRight,anTop]; + Text := 'Go'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 11; + OnClick := @btnSearchClicked; + end; + + tsNotes := TfpgTabSheet.Create(PageControl1); + with tsNotes do + begin + Name := 'tsNotes'; + SetPosition(3, 24, 254, 289); + Text := 'Notes'; + end; + + ListBox1 := TfpgListBox.Create(tsNotes); + with ListBox1 do + begin + Name := 'ListBox1'; + SetPosition(4, 32, 242, 252); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#List'; + HotTrack := False; + PopupFrame := False; + TabOrder := 0; + end; + + btnNotesAdd := TfpgButton.Create(tsNotes); + with btnNotesAdd do + begin + Name := 'btnNotesAdd'; + SetPosition(4, 4, 24, 24); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := 0; + ImageName := 'stdimg.add'; + TabOrder := 1; + end; + + btnNotesEdit := TfpgButton.Create(tsNotes); + with btnNotesEdit do + begin + Name := 'btnNotesEdit'; + SetPosition(32, 4, 24, 24); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := 0; + ImageName := 'stdimg.edit'; + TabOrder := 2; + end; + + btnNotesDel := TfpgButton.Create(tsNotes); + with btnNotesDel do + begin + Name := 'btnNotesDel'; + SetPosition(60, 4, 24, 24); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := 0; + ImageName := 'stdimg.remove'; + TabOrder := 3; + end; + + btnNotesGoto := TfpgButton.Create(tsNotes); + with btnNotesGoto do + begin + Name := 'btnNotesGoto'; + SetPosition(166, 4, 80, 24); + Anchors := [anRight,anTop]; + Text := 'Go to'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 4; + end; + + tsHistory := TfpgTabSheet.Create(PageControl1); + with tsHistory do + begin + Name := 'tsHistory'; + SetPosition(3, 24, 254, 289); + Text := 'History'; + end; + + lbHistory := TfpgListBox.Create(tsHistory); + with lbHistory do + begin + Name := 'lbHistory'; + SetPosition(4, 8, 242, 276); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#List'; + HotTrack := False; + PopupFrame := False; + TabOrder := 0; + end; + + Splitter1 := TfpgSplitter.Create(bvlBody); + with Splitter1 do + begin + Name := 'Splitter1'; + SetPosition(265, 4, 8, 284); + Align := alLeft; + end; + + RichView := TRichTextView.Create(bvlBody); + with RichView do + begin + Name := 'RichView'; + SetPosition(368, 192, 244, 92); + TabOrder := 2; + Align := alClient; + OnClickLink:=@RichViewClickLink; + end; + + MainMenu := TfpgMenuBar.Create(self); + with MainMenu do + begin + Name := 'MainMenu'; + SetPosition(0, 0, 654, 24); + Anchors := [anLeft,anRight,anTop]; + end; + + miFile := TfpgPopupMenu.Create(self); + with miFile do + begin + Name := 'miFile'; + SetPosition(292, 28, 132, 20); + AddMenuItem('Open...', '', @miFileOpenClicked); + AddMenuItem('Save current Topic to IPF...', '', @miFileSaveTopicAsIPF); + AddMenuItem('Close', '', @miFileCloseClicked); + AddMenuitem('-', '', nil); + FFileOpenRecent := AddMenuItem('Open Recent...', '', nil); + AddMenuitem('-', '', nil); + AddMenuItem('Quit', '', @miFileQuitClicked); + end; + + miSettings := TfpgPopupMenu.Create(self); + with miSettings do + begin + Name := 'miSettings'; + SetPosition(292, 76, 132, 20); + AddMenuItem('Options...', '', nil); + end; + + miBookmarks := TfpgPopupMenu.Create(self); + with miBookmarks do + begin + Name := 'miBookmarks'; + SetPosition(292, 100, 132, 20); + AddMenuItem('Add..', '', nil); + AddMenuItem('Show', '', nil); + end; + + miHelp := TfpgPopupMenu.Create(self); + with miHelp do + begin + Name := 'miHelp'; + SetPosition(292, 124, 132, 20); + AddMenuItem('Contents...', '', nil); + AddMenuItem('Help using help', '', nil); + AddMenuItem('-', '', nil); + AddMenuItem('About fpGUI Toolkit', '', @miHelpAboutFPGui); + AddMenuItem('Product Information...', '', @miHelpProdInfoClicked); + end; + + miDebug := TfpgPopupMenu.Create(self); + with miDebug do + begin + Name := 'miDebug'; + SetPosition(292, 148, 132, 20); + AddMenuItem('Debug: Header', '', @miDebugHeader); + AddMenuItem('Toggle Hex INF Values in Contents', '', @miDebugHex); + end; + + miOpenRecentMenu := TfpgPopupMenu.Create(self); + with miOpenRecentMenu do + begin + Name := 'miOpenRecentMenu'; + SetPosition(309, 52, 132, 20); + end; + + {@VFD_BODY_END: MainForm} + {%endregion} + + // hook up the sub-menus. + MainMenu.AddMenuItem('&File', nil).SubMenu := miFile; + MainMenu.AddMenuItem('&Settings', nil).SubMenu := miSettings; + MainMenu.AddMenuItem('&Bookmarks', nil).SubMenu := miBookmarks; + MainMenu.AddMenuItem('&Help', nil).SubMenu := miHelp; + MainMenu.AddMenuItem('&Debug', nil).SubMenu := miDebug; + FFileOpenRecent.SubMenu := miOpenRecentMenu; + + // correct default visible tabsheet + PageControl1.ActivePageIndex := 0; + + // most recently used files + mru := TfpgMRU.Create(self); + mru.Name := 'MRU'; + mru.ParentMenuItem := miOpenRecentMenu; + mru.OnClick :=@miMRUClick; + mru.MaxItems := gINI.ReadInteger('Options', 'MRUFileCount', 8); + mru.ShowFullPath := gINI.ReadBool('Options', 'ShowFullPath', True); + mru.LoadMRU; +end; + +procedure TMainForm.RefreshFontSubstitutions; +var + FileIndex: longint; + HelpFile: THelpFile; +begin + for FileIndex := 0 to CurrentOpenFiles.Count - 1 do + begin + HelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); + + if Settings.FixedFontSubstitution then + HelpFile.SetupFontSubstitutes( Settings.FixedFontSubstitutes ) + else + HelpFile.SetupFontSubstitutes( '' ); + end; +end; + +procedure TMainForm.DisplaySelectedIndexTopic; +var + Topic: TTopic; +Begin + if lbIndex.FocusItem = -1 then + exit; + Topic := DisplayedIndex.Objects[ lbIndex.FocusItem ] as TTopic; + DisplayTopic( Topic ); +end; + +procedure TMainForm.ProcessCommandLineParams; +var + showtopic: boolean; + t: TTopic; +begin + if ParamCount > 0 then + begin + if gCommandLineParams.IsParam('h') then + begin + ShowParamHelp; + Exit; //==> + end + else if gCommandLineParams.IsParam('debuglog') then + // do nothing + else + begin +//writeln('DEBUG: TMainForm.ProcessCommandLineParams - Open file...'); + showtopic := not gCommandLineParams.IsParam('k'); + OpenFile(ParamStr(1), '', showtopic); + end; + end; + + // now process all other parameters + if gCommandLineParams.IsParam('k') then + begin +//writeln('DEBUG: TMainForm.ProcessCommandLineParams - Keyword Search string'); + { Search for a string } + edSearchText.Text := gCommandLineParams.GetParam('k'); + PageControl1.ActivePage := tsSearch; + btnSearch.Click; + end + else if gCommandLineParams.IsParam('n') then + begin + { Display topic with numeric topic id } +//writeln('DEBUG: TMainForm.ProcessCommandLineParams - Display numeric topic id'); + t := FindTopicByResourceID(StrToInt(gCommandLineParams.GetParam('n'))); +//if not Assigned(t) then +// writeln(Format('Failed to find topic <%s>', [gCommandLineParams.GetParam('n')])); + DisplayTopic(t); + end + else if gCommandLineParams.IsParam('s') then + begin +//writeln('DEBUG: TMainForm.ProcessCommandLineParams - display string topic id'); + { Display topic with string topic id } + t := FindTopicByName(gCommandLineParams.GetParam('s')); +//if not Assigned(t) then +// writeln(Format('Failed to find topic <%s>', [gCommandLineParams.GetParam('k')])); + DisplayTopic(t); + end; +end; + +procedure TMainForm.ShowParamHelp; +const + le = LineEnding; +var + s: string; +begin + s := '<font "Arial" 12><b>' + cLongName + '</b></font>' + le + + cVersion + le + le + + 'Supported command line parameters:' + le + le + + '<tt>' + + ' <<filename> Load the help file <<filename>' + le + + ' -h Show this help' + le + + ' -k <<text> Search for keyword <<text> in open help files' + le + + ' -n <<id> Open Topic with numeric ID equal to <<id>' + le + + ' -s <<id> Open Topic with string ID equal to <<id>' + le + + ' -debuglog <<filename> Log information to a file' + le + + '</tt>' + ; + RichView.AddText(PChar(s)); +end; + +// Find the target topic for the given link +function TMainForm.FindTopicForLink(Link: THelpLink): TTopic; +var + HelpFile: THelpFile; +begin + HelpFile := Link.HelpFile as THelpFile; + if Link is TFootnoteHelpLink then + begin + Result := HelpFile.Topics[ TFootnoteHelpLink( Link ).TopicIndex ]; + end + else if Link is TInternalHelpLink then + begin + Result := HelpFile.Topics[ TInternalHelpLink( Link ).TopicIndex ]; + end + else if Link is THelpLinkByResourceID then + begin + Result := FindTopicByResourceID( THelpLinkByResourceID( Link ).ResourceID ); + end +end; + +// Find topic specified by numeric resource ID, in all open files +function TMainForm.FindTopicByResourceID(ID: word): TTopic; +var + FileIndex: longint; + HelpFile: THelpFile; +begin + for FileIndex := 0 to CurrentOpenFiles.Count - 1 do + begin + HelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); + + Result := HelpFile.FindTopicByResourceID( ID ); + if Result <> nil then + // found + exit; + end; + + // not found. + Result := nil; +end; + +function TMainForm.FindTopicByName(const AName: string): TTopic; +var + FileIndex: longint; + HelpFile: THelpFile; +begin + Result := nil; + for FileIndex := 0 to CurrentOpenFiles.Count - 1 do + begin + HelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); + Result := HelpFile.FindTopicByLocalName(AName); + if Result <> nil then + // found + exit; //==> + end; + // not found. + Result := nil; +end; + + +end. diff --git a/docview/src/nvNullObjects.pas b/docview/src/nvNullObjects.pas new file mode 100644 index 00000000..ee849b12 --- /dev/null +++ b/docview/src/nvNullObjects.pas @@ -0,0 +1,57 @@ +unit nvNullObjects; + +{$mode objfpc}{$H+} + +interface + +uses + contnrs, Classes, SysUtils; + +type + EHelpBitmapException = class(Exception); + + // forward declaration + THelpBitmap = class; + + + TImageList = class(TObjectList) + public + procedure Add(ABitmap: THelpBitmap; AParam2: TObject); + end; + + + THelpBitmap = class(TObject) + public + constructor CreateFromHelpFile( FileHandle: TFileStream; Offset: longint ); + procedure LoadFromResourceName(const AName: string); + end; + + + +implementation + + + +{ TImageList } + +procedure TImageList.Add(ABitmap: THelpBitmap; AParam2: TObject); +begin + // +end; + +{ THelpBitmap } + + +constructor THelpBitmap.CreateFromHelpFile(FileHandle: TFileStream; Offset: longint); +begin + inherited Create; +end; + +procedure THelpBitmap.LoadFromResourceName(const AName: string); +begin + // +end; + + +end. + diff --git a/docview/src/nvUtilities.pas b/docview/src/nvUtilities.pas new file mode 100644 index 00000000..aed9d392 --- /dev/null +++ b/docview/src/nvUtilities.pas @@ -0,0 +1,398 @@ +unit nvUtilities; + +{$mode objfpc}{$H+} + +// disable to remove debugging output +{.$Define DEBUG} + +interface + +uses + Classes, SysUtils, fpg_base; + +const + { TODO -oGraeme : Should this change to LineEnding (platfrom dependant) } + EndLine= chr(13)+chr(10); + TwoEndLines= chr(13)+chr(10)+chr(13)+chr(10); + Quote = ''''; + DoubleQuote = '"'; + + // -- Logging -- +type + LogAspect = ( LogStartup, + LogShutdown, + LogSettings, + LogI18n, + LogParse, + LogDisplay, + LogSearch, + LogNHM, + LogViewStub, + LogObjConstDest, + LogDebug + ); + LogAspects = SET OF LogAspect; + +procedure LogEvent(const aLogAspect: LogAspect; const anEventDescription: String); + +// Removes and returns the first value in a separated +// value list (removes quotes if found) +Function ExtractNextValue(var S: string; const Separator: string ): string; + +Function ExtractNextValueNoTrim(var S: string; const Separator: string ): string; + +function AllocateMemory( const Size: ValUInt ): pointer; +procedure DeallocateMemory( Var P: pointer ); + +// Alias method which is the same as Move() but with less confusing name +procedure MemCopy(const src; var dest; size: SizeInt); +// Allows for debug output and quite disable of output +procedure ProfileEvent(const AString: string); +// Return AFilename's size in bytes +function GetFileSize(const AFilename: string): integer; + +function IsDigit(const AChar: TfpgChar): boolean; +function IsAlpha(const AChar: TfpgChar): boolean; +function Between( const Value: longint; const Limit1: longint; const Limit2: longint ): boolean; + + +operator = (ARect: TRect; BRect: TRect): boolean; + +// Destroy the objects stored in List and clear the list. +procedure ClearListAndObjects( List: TList ); +// Destroy the objects stored in the list and then destroy the list itself +// And set the reference to nil +procedure DestroyListAndObjects( Var List: TList ); +// Destroy the objects stored in the list. +// You probably want to use one of the two functions above. +procedure DestroyListObjects( List: TList ); + +procedure AddList( Source, Dest: TList ); +procedure AssignList( Source, Dest: TList ); + +procedure ListFilesInDirectory(const aDirectory: String; const aFilter: String; const aWithDirectoryFlag: boolean; var aList: TStrings); + +// add all file name parts of aFileNameString to the aResult +// check for containing environment vars +// and include all help files if the environment var points +// to a directory +procedure ParseAndExpandFileNames(const aFileNameString: String; aResult: TStrings); + + + +var + startTime : Cardinal; + lastTime : Cardinal; + activeLogAspects : LogAspects; + infoMessage1 : String; + infoMessage2 : String; + + +implementation + +uses + fpg_utils + ,fpg_main + ,ACLStringUtility + ,dvconstants + ; + + Function GetAspectPrefix(const aLogAspect: LogAspect): String; + Begin + Case aLogAspect of + LogStartup : result := 'Startup'; + LogShutdown : result := 'Start'; + LogSettings : result := 'Settings'; + LogI18n : result := 'I18n'; + LogParse : result := 'Parse'; + LogDisplay : result := 'Display'; + LogSearch : result := 'Search'; + LogNHM : result := 'NewHelpManager'; + LogViewStub : result := 'ViewStub'; + LogObjConstDest : result := 'ObjConstDest'; + LogDebug : result := 'Debug'; + else result := 'Unknown'; + end; + End; + + + Procedure SetLogAspects(const aCommaSeparatedListOfAspectNames : String); + Var + tmpAspects : TStringList; + i : Integer; + Begin + tmpAspects := TStringList.Create; + StrExtractStrings(tmpAspects, aCommaSeparatedListOfAspectNames, [','], #0); + + for i:=0 to tmpAspects.count-1 do + begin + if tmpAspects[i] = 'LogStartup' then activeLogAspects := activeLogAspects + [ LogStartup ]; + if tmpAspects[i] = 'LogShutdown' then activeLogAspects := activeLogAspects + [ LogShutdown ]; + if tmpAspects[i] = 'LogSettings' then activeLogAspects := activeLogAspects + [ LogSettings ]; + if tmpAspects[i] = 'LogI18n' then activeLogAspects := activeLogAspects + [ LogI18n ]; + if tmpAspects[i] = 'LogParse' then activeLogAspects := activeLogAspects + [ LogParse ]; + if tmpAspects[i] = 'LogDisplay' then activeLogAspects := activeLogAspects + [ LogDisplay ]; + if tmpAspects[i] = 'LogSearch' then activeLogAspects := activeLogAspects + [ LogSearch ]; + if tmpAspects[i] = 'LogNHM' then activeLogAspects := activeLogAspects + [ LogNHM ]; + if tmpAspects[i] = 'LogViewStub' then activeLogAspects := activeLogAspects + [ LogViewStub ]; + if tmpAspects[i] = 'LogObjConstDest' then activeLogAspects := activeLogAspects + [ LogObjConstDest ]; + if tmpAspects[i] = 'LogDebug' then activeLogAspects := activeLogAspects + [ LogDebug ]; + end; + + tmpAspects.Destroy; + End; + +procedure LogEvent(const aLogAspect: LogAspect; const anEventDescription: String); +var + tmpMessage: String; +begin + if (aLogAspect IN activeLogAspects) then + begin + tmpMessage := 'Log[' + GetAspectPrefix(aLogAspect) + '] ' + anEventDescription; + debugln(tmpMessage); + end; +end; + +Function ExtractNextValue( var S: string; + const Separator: string ): string; +begin + Result := ExtractNextValueNoTrim( S, Separator ); + Result := trim( Result ); + + // Remove quotes if present + if Result <> '' then + if Result[ 1 ] = DoubleQuote then + Delete( Result, 1, 1 ); + + if Result <> '' then + if Result[ length( Result ) ] = DoubleQuote then + Delete( Result, length( Result ), 1 ); +end; + +Function ExtractNextValueNoTrim( var S: string; + const Separator: string ): string; +Var + SeparatorPos: integer; +Begin + SeparatorPos := Pos( Separator, S ); + if SeparatorPos > 0 then + begin + Result := Copy( S, 1, SeparatorPos-1 ); + Delete( S, 1, SeparatorPos + length( Separator ) - 1 ); + end + else + begin + Result := S; + S := ''; + end; +end; + +function AllocateMemory( const Size: ValUInt ): pointer; +begin + GetMem( Result, size + sizeof( Size ) ); + PtrUInt(Result^) := Size; + inc( Result, sizeof( Size ) ); +end; + +procedure DeallocateMemory( Var P: pointer ); +var + Size: ValUInt; +begin + if P = nil then + exit; + + dec( P, sizeof( size ) ); + Size := ValUInt(P^); + FreeMem( P, Size + sizeof( Size ) ); + P := nil; +end; + +procedure MemCopy(const src; var dest; size: SizeInt); +begin + Move(src, dest, size); +end; + +procedure ProfileEvent(const AString: string); +begin + {$IFDEF DEBUG} + writeln('DEBUG: ', AString); + {$ENDIF} +end; + +function GetFileSize(const AFilename: string): integer; +var + f: File; +begin + Result := 0; + {$i-} + FileMode := 0; // read-only + Assign(f, fpgToOSEncoding(AFileName)); + Reset(f); + {$i+} + Result := FileSize(f); + CloseFile(f); +end; + +function IsDigit(const AChar: TfpgChar): boolean; +begin + { TODO -oGraeme -cunicode : Not utf-8 compliant. } + Result := ( AChar>='0' ) and ( AChar<='9' ); + //Result := TCharacter.IsDigit(AChar); +end; + +function IsAlpha(const AChar: TfpgChar): boolean; +var + UppercaseC: TfpgChar; +Begin + { TODO -oGraeme -cunicode : Not utf-8 compliant. } + UppercaseC := UpperCase( AChar ); + Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' ); + //Result := TCharacter.IsLetter(AChar); +end; + +function Between( const Value: longint; const Limit1: longint; const Limit2: longint ): boolean; +begin + if Limit1 < Limit2 then + Result:= ( Value >= Limit1 ) and ( Value <= Limit2 ) + else + Result:= ( Value >= Limit2 ) and ( Value <= Limit1 ) +end; + +operator = (ARect: TRect; BRect: TRect): boolean; +begin + result := (ARect.Top = BRect.Top) and + (ARect.Left = BRect.Left) and + (ARect.Bottom = BRect.Bottom) and + (ARect.Right = BRect.Right); +end; + +// Destroy the objects stored in List +// and clear the list. +Procedure ClearListAndObjects( List: TList ); +begin + DestroyListObjects( List ); + List.Clear; +end; + +// Destroy the objects stored in the list +// and then destroy the list itself. +Procedure DestroyListAndObjects( Var List: TList ); +begin + if not Assigned( List ) then + exit; + + DestroyListObjects( List ); + List.Free; + List := nil; +end; + +Procedure DestroyListObjects( List: TList ); +var + Index: longint; +begin + for Index := 0 to List.Count - 1 do + begin + if List[ Index ] <> nil then + begin + TObject( List[ Index ] ).Free; + List[ Index ] := nil; + end; + end; +end; + +Procedure AddList( Source, Dest: TList ); +var + i: longint; +begin + // expand the destination list to what's required + Dest.Capacity := Dest.Capacity + Source.Capacity; + for i:= 0 to Source.Count - 1 do + Dest.Add( Source[ i ] ); +end; + +Procedure AssignList( Source, Dest: TList ); +begin + Dest.Clear; + AddList( Source, Dest ); +end; + +procedure ListFilesInDirectory(const aDirectory: String; const aFilter: String; + const aWithDirectoryFlag: boolean; var aList: TStrings); +var + tmpRC: longint; + tmpSearchResults: TSearchRec; + tmpMask: String; + tmpFilterParts : TStringList; + tmpDirectory: String; + i: integer; +begin + tmpFilterParts := TStringList.Create; + + StrExtractStrings(tmpFilterParts, aFilter, [PathSeparator], #0); + + for i:=0 to tmpFilterParts.count-1 do + begin + tmpMask := tmpFilterParts[i]; + tmpDirectory := IncludeTrailingPathDelimiter(aDirectory); + tmpRC := fpgFindFirst(tmpDirectory + tmpMask, faAnyFile, tmpSearchResults); + + while tmpRC = 0 do + begin + if (tmpSearchResults.Attr and faDirectory) = 0 then + begin + if (aWithDirectoryFlag) then + aList.Add(tmpDirectory + tmpSearchResults.Name) + else + aList.Add(tmpSearchResults.Name); + end; + + tmpRC := fpgFindNext(tmpSearchResults); + end; + + FindClose(tmpSearchResults); + end; + tmpFilterParts.Destroy; +end; + +procedure ParseAndExpandFileNames(const aFileNameString: String; aResult: TStrings); +var + i: longint; + tmpFileNamesList: TStringList; + tmpItem: String; + tmpEnvironmentVarValue: string; +begin + LogEvent(LogDebug, 'ParseAndExpandFileNames "' + aFileNameString + '"'); + tmpFileNamesList := TStringList.Create; + + StrExtractStrings(tmpFileNamesList, aFileNameString, [HELP_FILE_DELIMITER, PathSeparator], #0); + for i := 0 to tmpFileNamesList.Count - 1 do + begin + tmpItem := tmpFileNamesList[i]; + + // is this a environment var + tmpEnvironmentVarValue := GetEnvironmentVariable(tmpItem); + if tmpEnvironmentVarValue <> '' then // environment var exists + begin + LogEvent(LogStartup, ' Environment var found; translated to: "' + tmpEnvironmentVarValue + '"'); + ParseAndExpandFileNames(tmpEnvironmentVarValue, aResult); + end + else if fpgDirectoryExists(tmpItem) then + begin + ListFilesInDirectory(tmpItem, '*' + INF_FILE_EXTENSION, true, aResult); + end + else + begin + aResult.Add(tmpItem); + end; + end; + + tmpFileNamesList.Free; +end; + +{$IFDEF DEBUG} +initialization + SetLogAspects('LogDebug,LogStartup'); +{$ENDIF} + +end. + |