fptemplt.pas 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Template support routines for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPTemplt;
  12. interface
  13. uses FPViews;
  14. const
  15. tsDate = '$DATE';
  16. tsDateCustom = '$DATE(';
  17. tsTime = '$TIME';
  18. tsPrompt = '$PROMPT(';
  19. function GetTemplateCount: integer;
  20. function GetTemplateName(Index: integer): string;
  21. function StartTemplate(Index: integer; Editor: PSourceEditor): boolean;
  22. procedure InitTemplates;
  23. procedure DoneTemplates;
  24. implementation
  25. uses
  26. Dos,Objects,
  27. FVConsts,
  28. MsgBox,
  29. WUtils,
  30. WEditor,
  31. FPConst,FPVars,FPString,FPUtils;
  32. type
  33. PTemplate = ^TTemplate;
  34. TTemplate = record
  35. Name : PString;
  36. Path : PString;
  37. end;
  38. PTemplateCollection = ^TTemplateCollection;
  39. TTemplateCollection = object(TSortedCollection)
  40. function At(Index: Integer): PTemplate;
  41. procedure FreeItem(Item: Pointer); virtual;
  42. function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
  43. end;
  44. const Templates : PTemplateCollection = nil;
  45. function NewTemplate(const Name, Path: string): PTemplate;
  46. var P: PTemplate;
  47. begin
  48. New(P);
  49. FillChar(P^,SizeOf(P^),0);
  50. P^.Name:=NewStr(Name);
  51. P^.Path:=NewStr(Path);
  52. NewTemplate:=P;
  53. end;
  54. procedure DisposeTemplate(P: PTemplate);
  55. begin
  56. if assigned(P) then
  57. begin
  58. if assigned(P^.Name) then
  59. DisposeStr(P^.Name);
  60. if assigned(P^.Path) then
  61. DisposeStr(P^.Path);
  62. Dispose(P);
  63. end;
  64. end;
  65. function TTemplateCollection.At(Index: Integer): PTemplate;
  66. begin
  67. At:=inherited At(Index);
  68. end;
  69. procedure TTemplateCollection.FreeItem(Item: Pointer);
  70. begin
  71. if assigned(Item) then
  72. DisposeTemplate(Item);
  73. end;
  74. function TTemplateCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
  75. var R: Sw_integer;
  76. K1: PTemplate absolute Key1;
  77. K2: PTemplate absolute Key2;
  78. begin
  79. if K1^.Name^<K2^.Name^ then R:=-1 else
  80. if K1^.Name^>K2^.Name^ then R:= 1 else
  81. R:=0;
  82. Compare:=R;
  83. end;
  84. function GetTemplateCount: integer;
  85. var Count: integer;
  86. begin
  87. if Templates=nil then Count:=0 else Count:=Templates^.Count;
  88. GetTemplateCount:=Count;
  89. end;
  90. function GetTemplateName(Index: integer): string;
  91. begin
  92. GetTemplateName:=Templates^.At(Index)^.Name^;
  93. end;
  94. function SearchStr(const InS, SubS: string; var P: sw_integer): boolean;
  95. begin
  96. P:=Pos(SubS,InS);
  97. SearchStr:=(P<>0);
  98. end;
  99. procedure ReplaceStr(var S: string; StartP,Len: sw_integer; const NewS: string);
  100. begin
  101. Delete(S,StartP,Len);
  102. Insert(NewS,S,StartP);
  103. end;
  104. function ReadStringPos(const InS: string; StartP: sw_integer; var Expr: string; var EndPos: sw_integer): sw_integer;
  105. const Enclosers : string[2] = '''"';
  106. var OK: boolean;
  107. Encloser: char;
  108. P: sw_integer;
  109. begin
  110. OK:=false; Expr:=''; P:=StartP; EndPos:=-1;
  111. if length(InS)>=P then
  112. begin
  113. P:=Pos(InS[P],Enclosers);
  114. OK:=(P<>0);
  115. if OK then
  116. begin
  117. OK:=false;
  118. Encloser:=Enclosers[P];
  119. P:=StartP;
  120. Inc(P);
  121. while (P<=length(InS)) do
  122. begin
  123. if InS[P]<>Encloser then
  124. Expr:=Expr+InS[P]
  125. else
  126. if (P+1<=length(InS)) and (InS[P+1]=Encloser) then
  127. Expr:=Expr+InS[P]
  128. else
  129. begin
  130. OK:=true;
  131. Break;
  132. end;
  133. Inc(P);
  134. end;
  135. EndPos:=P;
  136. end;
  137. end;
  138. if OK then
  139. ReadStringPos:=length(Expr)
  140. else
  141. ReadStringPos:=-1;
  142. end;
  143. {function ReadString(const InS: string; StartP: sw_integer; var Expr: string): sw_integer;
  144. var P: sw_integer;
  145. begin
  146. ReadString:=ReadStringPos(InS,StartP,Expr,P);
  147. end;}
  148. function ProcessTemplateLine(var S: string): boolean;
  149. var OK: boolean;
  150. P,EndP: sw_integer;
  151. Name,Expr: string;
  152. begin
  153. OK:=true;
  154. repeat
  155. P:=0; Expr:='';
  156. if OK and SearchStr(S,tsPrompt,P) then
  157. if ReadStringPos(S,P+length(tsPrompt),Name,EndP)>=0 then
  158. if copy(S,EndP+1,1)=')' then
  159. begin
  160. OK:=InputBox(dialog_fillintemplateparameter,Name,Expr,255)=cmOK;
  161. if OK then
  162. ReplaceStr(S,P,EndP-P+1+1,Expr);
  163. end;
  164. if OK and SearchStr(S,tsDateCustom,P) then
  165. if ReadStringPos(S,P+length(tsDateCustom),Expr,EndP)>=0 then
  166. if copy(S,EndP+1,1)=')' then
  167. ReplaceStr(S,P,EndP-P+1+1,FormatDateTimeL(Now,Expr));
  168. if OK and SearchStr(S,tsDate,P) then
  169. ReplaceStr(S,P,length(tsDate),FormatDateTimeL(Now,'yyyy/mm/dd'));
  170. if OK and SearchStr(S,tsTime,P) then
  171. ReplaceStr(S,P,length(tsTime),FormatDateTimeL(Now,'hh:nn:ss'));
  172. until P=0;
  173. ProcessTemplateLine:=OK;
  174. end;
  175. function ProcessTemplate(Editor: PSourceEditor): boolean;
  176. var OK: boolean;
  177. I: sw_integer;
  178. S,OrigS: string;
  179. begin
  180. OK:=true;
  181. with Editor^ do
  182. for I:=0 to GetLineCount-1 do
  183. begin
  184. S:=GetDisplayText(I); OrigS:=S;
  185. OK:=ProcessTemplateLine(S);
  186. if OK=false then Break;
  187. if S<>OrigS then
  188. begin
  189. SetDisplayText(I,S);
  190. UpdateAttrs(I,attrAll);
  191. DrawView;
  192. end;
  193. end;
  194. ProcessTemplate:=OK;
  195. end;
  196. function StartTemplate(Index: integer; Editor: PSourceEditor): boolean;
  197. var
  198. T: PTemplate;
  199. OK: boolean;
  200. begin
  201. T:=Templates^.At(Index);
  202. OK:=StartEditor(Editor,T^.Path^);
  203. if OK then
  204. begin
  205. ProcessTemplate(Editor);
  206. end;
  207. StartTemplate:=OK;
  208. end;
  209. {*****************************************************************************
  210. InitTemplates
  211. *****************************************************************************}
  212. procedure InitTemplates;
  213. procedure ScanDir(Dir: PathStr);
  214. var SR: SearchRec;
  215. S: string;
  216. PT : PTemplate;
  217. i : sw_integer;
  218. begin
  219. if copy(Dir,length(Dir),1)<>DirSep then Dir:=Dir+DirSep;
  220. FindFirst(Dir+'*'+TemplateExt,AnyFile,SR);
  221. while (DosError=0) do
  222. begin
  223. S:=NameOf(SR.Name);
  224. S:=LowerCaseStr(S);
  225. S[1]:=Upcase(S[1]);
  226. PT:=NewTemplate(S,FExpand(Dir+SR.Name));
  227. if not Templates^.Search(PT,i) then
  228. Templates^.Insert(PT)
  229. else
  230. DisposeTemplate(PT);
  231. FindNext(SR);
  232. end;
  233. {$ifdef FPC}
  234. FindClose(SR);
  235. {$endif def FPC}
  236. end;
  237. begin
  238. New(Templates, Init(10,10));
  239. ScanDir('.');
  240. ScanDir(IDEDir);
  241. end;
  242. procedure DoneTemplates;
  243. begin
  244. if assigned(Templates) then
  245. begin
  246. Dispose(Templates, Done);
  247. Templates:=nil;
  248. end;
  249. end;
  250. END.