1 | unit GlobalFilelistUnit;
|
---|
2 |
|
---|
3 | // NewView - a new OS/2 Help Viewer
|
---|
4 | // Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
|
---|
5 | // This software is released under the Gnu Public License - see readme.txt
|
---|
6 |
|
---|
7 | interface
|
---|
8 |
|
---|
9 | // Maintains a linked list in shared memory
|
---|
10 | // Mapping files (full path) to newview windows (frames)
|
---|
11 |
|
---|
12 | uses
|
---|
13 | OS2Def,
|
---|
14 | SharedMemoryUnit,
|
---|
15 | Semaphores;
|
---|
16 |
|
---|
17 | const
|
---|
18 | // size of shared mem used for storing global filelist
|
---|
19 | GLOBAL_FILELIST_SIZE = 64000;
|
---|
20 |
|
---|
21 | type
|
---|
22 | TOpenFileEntry = record
|
---|
23 | Next: ^TOpenFileEntry;
|
---|
24 | Window: HWND;
|
---|
25 | FilePath: array[ 0..255] of char;
|
---|
26 | end;
|
---|
27 | TPOpenFileEntry = ^ TOpenFileEntry;
|
---|
28 |
|
---|
29 | TGlobalFilelist = class
|
---|
30 | protected
|
---|
31 | FMem: TSuballocatedSharedMemory;
|
---|
32 | FMutex: TMutex;
|
---|
33 | function GetHead: TPOpenFileEntry;
|
---|
34 | procedure SetHead( pEntry: TPOpenFileEntry );
|
---|
35 |
|
---|
36 | function FindEntry( const FilePath: string ): TPOpenFileEntry;
|
---|
37 | public
|
---|
38 | constructor Create;
|
---|
39 | destructor Destroy; override;
|
---|
40 | function FindFile( const FilePath: string ): HWND;
|
---|
41 | procedure AddFile( const FilePath: string;
|
---|
42 | Window: HWND );
|
---|
43 |
|
---|
44 | procedure RemoveFile( Window: HWND;
|
---|
45 | const FilePath: string );
|
---|
46 | procedure RemoveWindowFiles( Window: HWND );
|
---|
47 | end;
|
---|
48 |
|
---|
49 | implementation
|
---|
50 |
|
---|
51 | uses
|
---|
52 | StringUtilsUnit,
|
---|
53 | DebugUnit,
|
---|
54 | SysUtils;
|
---|
55 |
|
---|
56 | constructor TGlobalFilelist.Create;
|
---|
57 | begin
|
---|
58 | LogEvent(LogObjConstDest, '+ TGlobalFilelist.Create');
|
---|
59 |
|
---|
60 | FMem := TSuballocatedSharedMemory.Create( 'NEWVIEW_GLOBAL_FILELIST',
|
---|
61 | GLOBAL_FILELIST_SIZE,
|
---|
62 | 4 ); // space for head pointer
|
---|
63 | FMutex := TMutex.CreateNamed( 'NEWVIEW_FILELIST' );
|
---|
64 |
|
---|
65 | // hm. What about initialising the head pointer?
|
---|
66 | // well I have changed suballocatedsharedmemory constructor
|
---|
67 | // so that the first instance accessing the memory will clear the
|
---|
68 | // reserved space to null...
|
---|
69 | end;
|
---|
70 |
|
---|
71 | destructor TGlobalFilelist.Destroy;
|
---|
72 | begin
|
---|
73 | LogEvent(LogObjConstDest, '- TGlobalFilelist.Destroy');
|
---|
74 |
|
---|
75 | FMem.Destroy;
|
---|
76 | FMutex.Destroy;
|
---|
77 | end;
|
---|
78 |
|
---|
79 | function TGlobalFilelist.GetHead: TPOpenFileEntry;
|
---|
80 | begin
|
---|
81 | Result := TPOpenFileEntry( FMem.Data ^ );
|
---|
82 | end;
|
---|
83 |
|
---|
84 | procedure TGlobalFilelist.SetHead( pEntry: TPOpenFileEntry );
|
---|
85 | begin
|
---|
86 | TPOpenFileEntry( FMem.Data ^ ) := pEntry;
|
---|
87 | end;
|
---|
88 |
|
---|
89 | procedure TGlobalFilelist.AddFile( const FilePath: string;
|
---|
90 | Window: HWND );
|
---|
91 | var
|
---|
92 | pEntry: TPOpenFileEntry;
|
---|
93 | begin
|
---|
94 | FMutex.Get;
|
---|
95 |
|
---|
96 | try
|
---|
97 | FMem.Allocate( pEntry,
|
---|
98 | sizeof( TPOpenFileEntry )
|
---|
99 | + sizeof( HWND )
|
---|
100 | + 1 // string length byte
|
---|
101 | + Length( FilePath ) );
|
---|
102 | except
|
---|
103 | begin
|
---|
104 | // didn't fit: discard
|
---|
105 | FMutex.Release;
|
---|
106 | exit;
|
---|
107 | end;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | // store handle, filename
|
---|
111 | pEntry ^. Window := Window;
|
---|
112 | StrPCopy( pEntry ^. FilePath, FilePath );
|
---|
113 |
|
---|
114 | // link into list at head
|
---|
115 | pEntry ^. Next := GetHead;
|
---|
116 | SetHead( pEntry );
|
---|
117 |
|
---|
118 | FMutex.Release;
|
---|
119 | end;
|
---|
120 |
|
---|
121 | function TGlobalFilelist.FindEntry( const FilePath: string ): TPOpenFileEntry;
|
---|
122 | begin
|
---|
123 | Result := GetHead;
|
---|
124 | while ( Result <> nil ) do
|
---|
125 | begin
|
---|
126 | if ( StrEqualIgnoringCase( StrPas( Result ^. FilePath ), FilePath ) ) then
|
---|
127 | begin
|
---|
128 | // found
|
---|
129 | exit;
|
---|
130 | end;
|
---|
131 | Result := Result ^. Next;
|
---|
132 | end;
|
---|
133 | // not found
|
---|
134 | end;
|
---|
135 |
|
---|
136 | function TGlobalFilelist.FindFile( const FilePath: string ): HWND;
|
---|
137 | var
|
---|
138 | pEntry: TPOpenFileEntry;
|
---|
139 | begin
|
---|
140 | FMutex.Get;
|
---|
141 | pEntry := FindEntry( FilePath );
|
---|
142 |
|
---|
143 | if pEntry <> nil then
|
---|
144 | Result := pEntry ^. Window
|
---|
145 | else
|
---|
146 | Result := NULLHANDLE;
|
---|
147 |
|
---|
148 | FMutex.Release;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | // Remove specified file from list
|
---|
152 | procedure TGlobalFilelist.RemoveFile( Window: HWND;
|
---|
153 | const FilePath: string );
|
---|
154 | var
|
---|
155 | pEntry: TPOpenFileEntry;
|
---|
156 | pPrevious: TPOpenFileEntry;
|
---|
157 | begin
|
---|
158 | FMutex.Get;
|
---|
159 |
|
---|
160 | pEntry := GetHead;
|
---|
161 | pPrevious := nil;
|
---|
162 | while ( pEntry <> nil ) do
|
---|
163 | begin
|
---|
164 | if ( pEntry ^. Window = Window ) then
|
---|
165 | begin
|
---|
166 | if ( StrEqualIgnoringCase( StrPas( pEntry ^. FilePath ), FilePath ) ) then
|
---|
167 | begin
|
---|
168 | // found
|
---|
169 | // remove node from list
|
---|
170 | if pPrevious = nil then
|
---|
171 | // head node has changed
|
---|
172 | SetHead( pEntry ^.Next )
|
---|
173 | else
|
---|
174 | // point previous node to next node
|
---|
175 | pPrevious ^.Next := pEntry ^.Next;
|
---|
176 |
|
---|
177 | FMem.Free( pEntry );
|
---|
178 |
|
---|
179 | // done
|
---|
180 | FMutex.Release;
|
---|
181 | exit;
|
---|
182 | end;
|
---|
183 | end;
|
---|
184 | pPrevious := pEntry;
|
---|
185 | pEntry := pEntry ^. Next;
|
---|
186 | end;
|
---|
187 |
|
---|
188 | // not found! Bad programmer event
|
---|
189 | FMutex.Release;
|
---|
190 |
|
---|
191 | raise Exception.Create( 'GlobalFilelist: File cannot be removed, since not added: ' + FilePath );
|
---|
192 | end;
|
---|
193 |
|
---|
194 | procedure TGlobalFilelist.RemoveWindowFiles( Window: HWND );
|
---|
195 | var
|
---|
196 | pEntry: TPOpenFileEntry;
|
---|
197 | pPrevious: TPOpenFileEntry;
|
---|
198 | begin
|
---|
199 | FMutex.Get;
|
---|
200 |
|
---|
201 | pEntry := GetHead;
|
---|
202 | pPrevious := nil;
|
---|
203 | while ( pEntry <> nil ) do
|
---|
204 | begin
|
---|
205 | if ( pEntry ^. Window = Window ) then
|
---|
206 | begin
|
---|
207 | // found
|
---|
208 | // remove node from list
|
---|
209 | if pPrevious = nil then
|
---|
210 | // head node has changed
|
---|
211 | SetHead( pEntry ^.Next )
|
---|
212 | else
|
---|
213 | // point previous node to next node
|
---|
214 | pPrevious ^.Next := pEntry ^.Next;
|
---|
215 |
|
---|
216 | FMem.Free( pEntry );
|
---|
217 | // continue looking - there could be more for this window
|
---|
218 | end;
|
---|
219 | pPrevious := pEntry;
|
---|
220 | pEntry := pEntry ^. Next;
|
---|
221 | end;
|
---|
222 | FMutex.Release;
|
---|
223 | end;
|
---|
224 |
|
---|
225 | begin
|
---|
226 | end.
|
---|