Folds.txt 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779
  1. MODULE StdFolds;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Folds.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT
  5. Domains := Stores, Ports, Stores, Containers, Models, Views, Controllers, Fonts,
  6. Properties,Controls,
  7. TextModels, TextViews, TextControllers, TextSetters,
  8. Dialog, Services;
  9. CONST
  10. expanded* = FALSE; collapsed* = TRUE;
  11. minVersion = 0; currentVersion = 0;
  12. collapseFoldKey = "#Std:Collapse Fold";
  13. expandFoldKey = "#Std:Expand Fold";
  14. zoomInKey = "#Std:Zoom In";
  15. zoomOutKey = "#Std:Zoom Out";
  16. expandFoldsKey = "#Std:Expand Folds";
  17. collapseFoldsKey = "#Std:Collapse Folds";
  18. insertFoldKey = "#Std:Insert Fold";
  19. setLabelKey = "#Std:Set Label";
  20. TYPE
  21. Label* = ARRAY 32 OF CHAR;
  22. Fold* = POINTER TO RECORD (Views.View)
  23. leftSide-: BOOLEAN;
  24. collapsed-: BOOLEAN;
  25. label-: Label; (* valid iff leftSide *)
  26. hidden: TextModels.Model (* valid iff leftSide; NIL if no hidden text *)
  27. END;
  28. Directory* = POINTER TO ABSTRACT RECORD END;
  29. StdDirectory = POINTER TO RECORD (Directory) END;
  30. FlipOp = POINTER TO RECORD (Domains.Operation)
  31. text: TextModels.Model; (* containing text *)
  32. leftpos, rightpos: INTEGER (* position of left and right Fold *)
  33. END;
  34. SetLabelOp = POINTER TO RECORD (Domains.Operation)
  35. text: TextModels.Model; (* containing text *)
  36. pos: INTEGER; (* position of fold in text *)
  37. oldlabel: Label
  38. END;
  39. Action = POINTER TO RECORD (Services.Action) END;
  40. VAR
  41. dir-, stdDir-: Directory;
  42. foldData*: RECORD
  43. nested*: BOOLEAN;
  44. all*: BOOLEAN;
  45. findLabel*: Label;
  46. newLabel*: Label
  47. END;
  48. iconFont: Fonts.Typeface;
  49. leftExp, rightExp, leftColl, rightColl: ARRAY 8 OF SHORTCHAR;
  50. coloredBackg: BOOLEAN;
  51. action: Action;
  52. fingerprint: INTEGER; (* for the property inspector *)
  53. PROCEDURE (d: Directory) New* (collapsed: BOOLEAN; label: Label;
  54. hiddenText: TextModels.Model): Fold, NEW, ABSTRACT;
  55. PROCEDURE GetPair (fold: Fold; VAR l, r: Fold);
  56. VAR c: Models.Context; text: TextModels.Model; rd: TextModels.Reader; v: Views.View;
  57. nest: INTEGER;
  58. BEGIN
  59. c := fold.context; l := NIL; r := NIL;
  60. WITH c: TextModels.Context DO
  61. text := c.ThisModel(); rd := text.NewReader(NIL);
  62. IF fold.leftSide THEN l := fold;
  63. rd.SetPos(c.Pos()+1); nest := 1;
  64. REPEAT rd.ReadView(v);
  65. IF (v # NIL) & (v IS Fold) THEN
  66. IF v(Fold).leftSide THEN INC(nest) ELSE DEC(nest) END
  67. END
  68. UNTIL (v = NIL) OR (nest = 0);
  69. IF v # NIL THEN r := v(Fold) ELSE r := NIL END
  70. ELSE r := fold;
  71. rd.SetPos(c.Pos()); nest := 1;
  72. REPEAT rd.ReadPrevView(v);
  73. IF (v # NIL) & (v IS Fold) THEN
  74. IF ~v(Fold).leftSide THEN INC(nest) ELSE DEC(nest) END
  75. END
  76. UNTIL (v = NIL) OR (nest = 0);
  77. IF v # NIL THEN l := v(Fold) ELSE l := NIL END
  78. END
  79. ELSE (* fold not embedded in a text *)
  80. END;
  81. ASSERT((l = NIL) OR l.leftSide & (l.hidden # NIL), 100);
  82. ASSERT((r = NIL) OR ~r.leftSide & (r.hidden = NIL), 101)
  83. END GetPair;
  84. PROCEDURE (fold: Fold) HiddenText* (): TextModels.Model, NEW;
  85. VAR l, r: Fold;
  86. BEGIN
  87. IF fold.leftSide THEN RETURN fold.hidden
  88. ELSE GetPair(fold, l, r);
  89. IF l # NIL THEN RETURN l.hidden ELSE RETURN NIL END
  90. END
  91. END HiddenText;
  92. PROCEDURE (fold: Fold) MatchingFold* (): Fold, NEW;
  93. VAR l, r: Fold;
  94. BEGIN
  95. GetPair(fold, l, r);
  96. IF l # NIL THEN
  97. IF fold = l THEN RETURN r ELSE RETURN l END
  98. ELSE RETURN NIL
  99. END
  100. END MatchingFold;
  101. PROCEDURE GetIcon (fold: Fold; VAR icon: ARRAY OF SHORTCHAR);
  102. BEGIN
  103. IF fold.leftSide THEN
  104. IF fold.collapsed THEN icon := leftColl$ ELSE icon := leftExp$ END
  105. ELSE
  106. IF fold.collapsed THEN icon := rightColl$ ELSE icon := rightExp$ END
  107. END
  108. END GetIcon;
  109. PROCEDURE CalcSize (f: Fold; VAR w, h: INTEGER);
  110. VAR icon: ARRAY 8 OF SHORTCHAR; c: Models.Context; a: TextModels.Attributes; font: Fonts.Font;
  111. asc, dsc, fw: INTEGER;
  112. BEGIN
  113. GetIcon(f, icon);
  114. c := f.context;
  115. IF (c # NIL) & (c IS TextModels.Context) THEN
  116. a := c(TextModels.Context).Attr();
  117. font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal)
  118. ELSE font := Fonts.dir.Default()
  119. END;
  120. w := font.SStringWidth(icon);
  121. font.GetBounds(asc, dsc, fw);
  122. h := asc + dsc
  123. END CalcSize;
  124. PROCEDURE Update (f: Fold);
  125. VAR w, h: INTEGER;
  126. BEGIN
  127. CalcSize(f, w, h);
  128. f.context.SetSize(w, h);
  129. Views.Update(f, Views.keepFrames)
  130. END Update;
  131. PROCEDURE FlipPair (l, r: Fold);
  132. VAR text, hidden: TextModels.Model; cl, cr: Models.Context;
  133. lpos, rpos: INTEGER;
  134. BEGIN
  135. IF (l # NIL) & (r # NIL) THEN
  136. ASSERT(l.leftSide, 100);
  137. ASSERT(~r.leftSide, 101);
  138. ASSERT(l.hidden # NIL, 102);
  139. ASSERT(r.hidden = NIL, 103);
  140. cl := l.context; cr := r.context;
  141. text := cl(TextModels.Context).ThisModel();
  142. lpos := cl(TextModels.Context).Pos() + 1; rpos := cr(TextModels.Context).Pos();
  143. ASSERT(lpos <= rpos, 104);
  144. hidden := TextModels.CloneOf(text);
  145. hidden.Insert(0, text, lpos, rpos);
  146. text.Insert(lpos, l.hidden, 0, l.hidden.Length());
  147. l.hidden := hidden; Stores.Join(l, hidden);
  148. l.collapsed := ~l.collapsed;
  149. r.collapsed := l.collapsed;
  150. Update(l); Update(r);
  151. TextControllers.SetCaret(text, lpos)
  152. END
  153. END FlipPair;
  154. PROCEDURE (op: FlipOp) Do;
  155. VAR rd: TextModels.Reader; left, right: Views.View;
  156. BEGIN
  157. rd := op.text.NewReader(NIL);
  158. rd.SetPos(op.leftpos); rd.ReadView(left);
  159. rd.SetPos(op.rightpos); rd.ReadView(right);
  160. FlipPair(left(Fold), right(Fold));
  161. op.leftpos := left.context(TextModels.Context).Pos();
  162. op.rightpos := right.context(TextModels.Context).Pos()
  163. END Do;
  164. PROCEDURE (op: SetLabelOp) Do;
  165. VAR rd: TextModels.Reader; fold: Views.View; left, right: Fold; lab: Label;
  166. BEGIN
  167. rd := op.text.NewReader(NIL);
  168. rd.SetPos(op.pos); rd.ReadView(fold);
  169. WITH fold: Fold DO
  170. GetPair(fold, left, right);
  171. IF left # NIL THEN
  172. lab := fold.label; left.label := op.oldlabel; op.oldlabel := lab;
  173. right.label := left.label
  174. END
  175. END
  176. END Do;
  177. PROCEDURE SetProp (fold: Fold; p : Properties.Property);
  178. VAR op: SetLabelOp; left, right: Fold;
  179. BEGIN
  180. WHILE p # NIL DO
  181. WITH p: Controls.Prop DO
  182. IF (Controls.label IN p.valid) & (p.label # fold.label) THEN
  183. GetPair(fold, left, right);
  184. IF left # NIL THEN
  185. NEW(op); op.oldlabel := p.label$;
  186. op.text := fold.context(TextModels.Context).ThisModel();
  187. op.pos := fold.context(TextModels.Context).Pos();
  188. Views.Do(fold, setLabelKey, op)
  189. END
  190. END
  191. ELSE
  192. END;
  193. p := p.next
  194. END
  195. END SetProp;
  196. PROCEDURE (fold: Fold) Flip*, NEW;
  197. VAR op: FlipOp; left, right: Fold;
  198. BEGIN
  199. ASSERT(fold # NIL, 20);
  200. NEW(op);
  201. GetPair(fold, left, right);
  202. IF (left # NIL) & (right # NIL) THEN
  203. op.text := fold.context(TextModels.Context).ThisModel();
  204. op.leftpos := left.context(TextModels.Context).Pos();
  205. op.rightpos := right.context(TextModels.Context).Pos();
  206. Views.BeginModification(Views.clean, fold);
  207. IF ~left.collapsed THEN Views.Do(fold, collapseFoldKey, op)
  208. ELSE Views.Do(fold, expandFoldKey, op)
  209. END;
  210. Views.EndModification(Views.clean, fold)
  211. END
  212. END Flip;
  213. PROCEDURE ReadNext (rd: TextModels.Reader; VAR fold: Fold);
  214. VAR v: Views.View;
  215. BEGIN
  216. REPEAT rd.ReadView(v) UNTIL rd.eot OR (v IS Fold);
  217. IF ~rd.eot THEN fold := v(Fold) ELSE fold := NIL END
  218. END ReadNext;
  219. PROCEDURE (fold: Fold) FlipNested*, NEW;
  220. VAR text: TextModels.Model; rd: TextModels.Reader; l, r: Fold; level: INTEGER;
  221. op: Domains.Operation;
  222. BEGIN
  223. ASSERT(fold # NIL, 20);
  224. GetPair(fold, l, r);
  225. IF (l # NIL) & (l.context # NIL) & (l.context IS TextModels.Context) THEN
  226. text := l.context(TextModels.Context).ThisModel();
  227. Models.BeginModification(Models.clean, text);
  228. rd := text.NewReader(NIL);
  229. rd.SetPos(l.context(TextModels.Context).Pos());
  230. IF l.collapsed THEN
  231. Models.BeginScript(text, expandFoldsKey, op);
  232. ReadNext(rd, fold); level := 1;
  233. WHILE (fold # NIL) & (level > 0) DO
  234. IF fold.leftSide & fold.collapsed THEN fold.Flip END;
  235. ReadNext(rd, fold);
  236. IF fold.leftSide THEN INC(level) ELSE DEC(level) END
  237. END
  238. ELSE (* l.state = expanded *)
  239. Models.BeginScript(text, collapseFoldsKey, op);
  240. level := 0;
  241. REPEAT ReadNext(rd, fold);
  242. IF fold.leftSide THEN INC(level) ELSE DEC(level) END;
  243. IF (fold # NIL) & ~fold.leftSide & ~fold.collapsed THEN
  244. fold.Flip;
  245. rd.SetPos(fold.context(TextModels.Context).Pos()+1)
  246. END
  247. UNTIL (fold = NIL) OR (level = 0)
  248. END;
  249. Models.EndScript(text, op);
  250. Models.EndModification(Models.clean, text)
  251. END
  252. END FlipNested;
  253. PROCEDURE (fold: Fold) HandlePropMsg- (VAR msg: Properties.Message);
  254. VAR prop: Controls.Prop; c: Models.Context; a: TextModels.Attributes; asc, w: INTEGER;
  255. BEGIN
  256. WITH msg: Properties.SizePref DO
  257. CalcSize(fold, msg.w, msg.h)
  258. | msg: Properties.ResizePref DO
  259. msg.fixed := TRUE
  260. | msg: Properties.FocusPref DO msg.hotFocus := TRUE
  261. | msg: Properties.PollMsg DO NEW(prop);
  262. prop.known := {Controls.label}; prop.valid := {Controls.label}; prop.readOnly := {};
  263. prop.label := fold.label$;
  264. msg.prop := prop
  265. | msg: Properties.SetMsg DO SetProp(fold, msg.prop)
  266. | msg: TextSetters.Pref DO c := fold.context;
  267. IF (c # NIL) & (c IS TextModels.Context) THEN
  268. a := c(TextModels.Context).Attr();
  269. a.font.GetBounds(asc, msg.dsc, w)
  270. END
  271. ELSE
  272. END
  273. END HandlePropMsg;
  274. PROCEDURE Track (fold: Fold; f: Views.Frame; x, y: INTEGER; buttons: SET; VAR hit: BOOLEAN);
  275. VAR a: TextModels.Attributes; font: Fonts.Font; c: Models.Context;
  276. w, h, asc, dsc, fw: INTEGER; isDown, in, in0: BOOLEAN; modifiers: SET;
  277. BEGIN
  278. c := fold.context; hit := FALSE;
  279. WITH c: TextModels.Context DO
  280. a := c.Attr(); font := a.font;
  281. c.GetSize(w, h); in0 := FALSE;
  282. in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
  283. REPEAT
  284. IF in # in0 THEN
  285. f.MarkRect(0, 0, w, h, Ports.fill, Ports.hilite, FALSE); in0 := in
  286. END;
  287. f.Input(x, y, modifiers, isDown);
  288. in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
  289. UNTIL ~isDown;
  290. IF in0 THEN hit := TRUE;
  291. font.GetBounds(asc, dsc, fw);
  292. f.MarkRect(0, 0, w, asc + dsc, Ports.fill, Ports.hilite, FALSE)
  293. END
  294. ELSE
  295. END
  296. END Track;
  297. PROCEDURE (fold: Fold) HandleCtrlMsg* (f: Views.Frame; VAR msg: Views.CtrlMessage;
  298. VAR focus: Views.View);
  299. VAR hit: BOOLEAN; pos: INTEGER; l, r: Fold;
  300. context: TextModels.Context; text: TextModels.Model;
  301. BEGIN
  302. WITH msg: Controllers.TrackMsg DO
  303. IF fold.context IS TextModels.Context THEN
  304. Track(fold, f, msg.x, msg.y, msg.modifiers, hit);
  305. IF hit THEN
  306. IF Controllers.modify IN msg.modifiers THEN
  307. fold.FlipNested
  308. ELSE
  309. fold.Flip;
  310. context := fold.context(TextModels.Context);
  311. text := context.ThisModel();
  312. IF TextViews.FocusText() = text THEN
  313. GetPair(fold, l, r);
  314. pos := context.Pos();
  315. IF fold = l THEN
  316. TextControllers.SetCaret(text, pos + 1)
  317. ELSE
  318. TextControllers.SetCaret(text, pos)
  319. END;
  320. TextViews.ShowRange(text, pos, pos + 1, TRUE)
  321. END
  322. END
  323. END
  324. END
  325. | msg: Controllers.PollCursorMsg DO
  326. msg.cursor := Ports.refCursor
  327. ELSE
  328. END
  329. END HandleCtrlMsg;
  330. PROCEDURE (fold: Fold) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
  331. VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
  332. icon: ARRAY 8 OF SHORTCHAR; w, h: INTEGER; asc, dsc, fw: INTEGER;
  333. BEGIN
  334. GetIcon(fold, icon); c := fold.context;
  335. IF (c # NIL) & (c IS TextModels.Context) THEN
  336. a := fold.context(TextModels.Context).Attr();
  337. font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal);
  338. color := a.color
  339. ELSE font := Fonts.dir.Default(); color := Ports.black
  340. END;
  341. IF coloredBackg THEN
  342. fold.context.GetSize(w, h);
  343. f.DrawRect(f.l, f.dot, f.r, h-f.dot, Ports.fill, Ports.grey50);
  344. color := Ports.white
  345. END;
  346. font.GetBounds(asc, dsc, fw);
  347. f.DrawSString(0, asc, color, icon, font)
  348. END Restore;
  349. PROCEDURE (fold: Fold) CopyFromSimpleView- (source: Views.View);
  350. BEGIN
  351. (* fold.CopyFrom^(source); *)
  352. WITH source: Fold DO
  353. ASSERT(source.leftSide = (source.hidden # NIL), 100);
  354. fold.leftSide := source.leftSide;
  355. fold.collapsed := source.collapsed;
  356. fold.label := source.label;
  357. IF source.hidden # NIL THEN
  358. fold.hidden := TextModels.CloneOf(source.hidden); Stores.Join(fold.hidden, fold);
  359. fold.hidden.InsertCopy(0, source.hidden, 0, source.hidden.Length())
  360. END
  361. END
  362. END CopyFromSimpleView;
  363. PROCEDURE (fold: Fold) Internalize- (VAR rd: Stores.Reader);
  364. VAR version: INTEGER; store: Stores.Store; xint: INTEGER;
  365. BEGIN
  366. fold.Internalize^(rd);
  367. IF rd.cancelled THEN RETURN END;
  368. rd.ReadVersion(minVersion, currentVersion, version);
  369. IF rd.cancelled THEN RETURN END;
  370. rd.ReadXInt(xint);fold.leftSide := xint = 0;
  371. rd.ReadXInt(xint); fold.collapsed := xint = 0;
  372. rd.ReadXString(fold.label);
  373. rd.ReadStore(store);
  374. IF store # NIL THEN fold.hidden := store(TextModels.Model); Stores.Join(fold.hidden, fold)
  375. ELSE fold.hidden := NIL
  376. END;
  377. fold.leftSide := store # NIL
  378. END Internalize;
  379. PROCEDURE (fold: Fold) Externalize- (VAR wr: Stores.Writer);
  380. VAR xint: INTEGER;
  381. BEGIN
  382. fold.Externalize^(wr);
  383. wr.WriteVersion(currentVersion);
  384. IF fold.hidden # NIL THEN xint := 0 ELSE xint := 1 END;
  385. wr.WriteXInt(xint);
  386. IF fold.collapsed THEN xint := 0 ELSE xint := 1 END;
  387. wr.WriteXInt(xint);
  388. wr.WriteXString(fold.label);
  389. wr.WriteStore(fold.hidden)
  390. END Externalize;
  391. (* --------------------- expanding and collapsing in focus text ------------------------ *)
  392. PROCEDURE ExpandFolds* (text: TextModels.Model; nested: BOOLEAN; IN label: ARRAY OF CHAR);
  393. VAR op: Domains.Operation; fold, l, r: Fold; rd: TextModels.Reader;
  394. BEGIN
  395. ASSERT(text # NIL, 20);
  396. Models.BeginModification(Models.clean, text);
  397. IF nested THEN Models.BeginScript(text, expandFoldsKey, op)
  398. ELSE Models.BeginScript(text, zoomInKey, op)
  399. END;
  400. rd := text.NewReader(NIL); rd.SetPos(0);
  401. ReadNext(rd, fold);
  402. WHILE ~rd.eot DO
  403. IF fold.leftSide & fold.collapsed THEN
  404. IF (label = "") OR (label = fold.label) THEN
  405. fold.Flip;
  406. IF ~nested THEN
  407. GetPair(fold, l, r);
  408. rd.SetPos(r.context(TextModels.Context).Pos())
  409. END
  410. END
  411. END;
  412. ReadNext(rd, fold)
  413. END;
  414. Models.EndScript(text, op);
  415. Models.EndModification(Models.clean, text)
  416. END ExpandFolds;
  417. PROCEDURE CollapseFolds* (text: TextModels.Model; nested: BOOLEAN; IN label: ARRAY OF CHAR);
  418. VAR op: Domains.Operation; fold, r, l: Fold; rd: TextModels.Reader;
  419. BEGIN
  420. ASSERT(text # NIL, 20);
  421. Models.BeginModification(Models.clean, text);
  422. IF nested THEN Models.BeginScript(text, collapseFoldsKey, op)
  423. ELSE Models.BeginScript(text, zoomOutKey, op)
  424. END;
  425. rd := text.NewReader(NIL); rd.SetPos(0);
  426. ReadNext(rd, fold);
  427. WHILE ~rd.eot DO
  428. IF ~fold.leftSide & ~fold.collapsed THEN
  429. GetPair(fold, l, r);
  430. IF (label = "") OR (label = l.label) THEN
  431. fold.Flip;
  432. GetPair(l, l, r);
  433. rd.SetPos(r.context(TextModels.Context).Pos()+1);
  434. IF ~nested THEN REPEAT ReadNext(rd, fold) UNTIL rd.eot OR fold.leftSide
  435. ELSE ReadNext(rd, fold)
  436. END
  437. ELSE ReadNext(rd, fold)
  438. END
  439. ELSE ReadNext(rd, fold)
  440. END
  441. END;
  442. Models.EndScript(text, op);
  443. Models.EndModification(Models.clean, text)
  444. END CollapseFolds;
  445. PROCEDURE ZoomIn*;
  446. VAR text: TextModels.Model;
  447. BEGIN
  448. text := TextViews.FocusText();
  449. IF text # NIL THEN ExpandFolds(text, FALSE, "") END
  450. END ZoomIn;
  451. PROCEDURE ZoomOut*;
  452. VAR text: TextModels.Model;
  453. BEGIN
  454. text := TextViews.FocusText();
  455. IF text # NIL THEN CollapseFolds(text, FALSE, "") END
  456. END ZoomOut;
  457. PROCEDURE Expand*;
  458. VAR text: TextModels.Model;
  459. BEGIN
  460. text := TextViews.FocusText();
  461. IF text # NIL THEN ExpandFolds(text, TRUE, "") END
  462. END Expand;
  463. PROCEDURE Collapse*;
  464. VAR text: TextModels.Model;
  465. BEGIN
  466. text := TextViews.FocusText();
  467. IF text # NIL THEN CollapseFolds(text, TRUE, "") END
  468. END Collapse;
  469. (* ---------------------- foldData dialogbox --------------------------- *)
  470. PROCEDURE FindLabelGuard* (VAR par: Dialog.Par);
  471. BEGIN
  472. par.disabled := (TextViews.Focus() = NIL) OR foldData.all
  473. END FindLabelGuard;
  474. PROCEDURE SetLabelGuard* ( VAR p : Dialog.Par );
  475. VAR v: Views.View;
  476. BEGIN
  477. Controllers.SetCurrentPath(Controllers.targetPath);
  478. v := Containers.FocusSingleton();
  479. p.disabled := (v = NIL) OR ~(v IS Fold) OR ~v(Fold).leftSide;
  480. Controllers.ResetCurrentPath()
  481. END SetLabelGuard;
  482. PROCEDURE ExpandLabel*;
  483. VAR text: TextModels.Model;
  484. BEGIN
  485. IF foldData.all & (foldData.findLabel # "") THEN
  486. foldData.findLabel := ""; Dialog.Update(foldData)
  487. END;
  488. text := TextViews.FocusText();
  489. IF text # NIL THEN
  490. IF ~foldData.all THEN ExpandFolds(text, foldData.nested, foldData.findLabel)
  491. ELSE ExpandFolds(text, foldData.nested, "")
  492. END
  493. END
  494. END ExpandLabel;
  495. PROCEDURE CollapseLabel*;
  496. VAR text: TextModels.Model;
  497. BEGIN
  498. IF foldData.all & (foldData.findLabel # "") THEN
  499. foldData.findLabel := ""; Dialog.Update(foldData)
  500. END;
  501. text := TextViews.FocusText();
  502. IF text # NIL THEN
  503. IF ~foldData.all THEN CollapseFolds(text, foldData.nested, foldData.findLabel)
  504. ELSE CollapseFolds(text, foldData.nested, "")
  505. END
  506. END
  507. END CollapseLabel;
  508. PROCEDURE FindFold(first: BOOLEAN);
  509. VAR c : TextControllers.Controller; r: TextModels.Reader;
  510. v : Views.View; pos, i : INTEGER;
  511. BEGIN
  512. c := TextControllers.Focus();
  513. IF c # NIL THEN
  514. IF first THEN pos := 0
  515. ELSE
  516. pos := c.CaretPos();
  517. IF pos = TextControllers.none THEN
  518. c.GetSelection(i, pos);
  519. IF pos = i THEN pos := 0 ELSE INC(pos) END;
  520. pos := MIN(pos, c.text.Length()-1)
  521. END
  522. END;
  523. r := c.text.NewReader(NIL); r.SetPos(pos);
  524. REPEAT r.ReadView(v)
  525. UNTIL r.eot OR ((v IS Fold) & v(Fold).leftSide) & (foldData.all OR (v(Fold).label$ = foldData.findLabel$));
  526. IF r.eot THEN
  527. c.SetCaret(0); Dialog.Beep
  528. ELSE
  529. pos := r.Pos();
  530. c.view.ShowRange(pos-1, pos, FALSE);
  531. c.SetSelection(pos-1, pos);
  532. IF LEN(v(Fold).label) > 0 THEN
  533. foldData.newLabel := v(Fold).label
  534. END;
  535. Dialog.Update(foldData)
  536. END
  537. ELSE
  538. Dialog.Beep
  539. END
  540. END FindFold;
  541. PROCEDURE FindNextFold*;
  542. BEGIN
  543. FindFold(FALSE)
  544. END FindNextFold;
  545. PROCEDURE FindFirstFold*;
  546. BEGIN
  547. FindFold(TRUE)
  548. END FindFirstFold;
  549. PROCEDURE SetLabel*;
  550. VAR v: Views.View;
  551. BEGIN
  552. Controllers.SetCurrentPath(Controllers.targetPath);
  553. v := Containers.FocusSingleton();
  554. IF (v # NIL) & (v IS Fold) & (LEN(foldData.newLabel) > 0) THEN
  555. v(Fold).label := foldData.newLabel
  556. ELSE
  557. Dialog.Beep
  558. END;
  559. Controllers.ResetCurrentPath()
  560. END SetLabel;
  561. PROCEDURE (a: Action) Do;
  562. VAR v: Views.View; fp: INTEGER;
  563. BEGIN
  564. Controllers.SetCurrentPath(Controllers.targetPath);
  565. v := Containers.FocusSingleton();
  566. IF (v = NIL) OR ~(v IS Fold) THEN
  567. fingerprint := 0;
  568. foldData.newLabel := ""
  569. ELSE
  570. fp := Services.AdrOf(v);
  571. IF fp # fingerprint THEN
  572. foldData.newLabel := v(Fold).label;
  573. fingerprint := fp;
  574. Dialog.Update(foldData)
  575. END
  576. END;
  577. Controllers.ResetCurrentPath();
  578. Services.DoLater(action, Services.Ticks() + Services.resolution DIV 2)
  579. END Do;
  580. (* ------------------------ inserting folds ------------------------ *)
  581. PROCEDURE Overlaps* (text: TextModels.Model; beg, end: INTEGER): BOOLEAN;
  582. VAR n, level: INTEGER; rd: TextModels.Reader; v: Views.View;
  583. BEGIN
  584. ASSERT(text # NIL, 20);
  585. ASSERT((beg >= 0) & (end <= text.Length()) & (beg <= end), 21);
  586. rd := text.NewReader(NIL); rd.SetPos(beg);
  587. n := 0; level := 0;
  588. REPEAT rd.ReadView(v);
  589. IF ~rd.eot & (rd.Pos() <= end) THEN
  590. WITH v: Fold DO INC(n);
  591. IF v.leftSide THEN INC(level) ELSE DEC(level) END
  592. ELSE
  593. END
  594. END
  595. UNTIL rd.eot OR (level < 0) OR (rd.Pos() >= end);
  596. RETURN (level # 0) OR ODD(n)
  597. END Overlaps;
  598. PROCEDURE InsertionAttr (text: TextModels.Model; pos: INTEGER): TextModels.Attributes;
  599. VAR rd: TextModels.Reader; ch: CHAR;
  600. BEGIN
  601. rd := text.NewReader(NIL);
  602. rd.SetPos(pos); rd.ReadChar(ch);
  603. RETURN rd.attr
  604. END InsertionAttr;
  605. PROCEDURE Insert* (text: TextModels.Model; label: Label; beg, end: INTEGER; collapsed: BOOLEAN);
  606. VAR w: TextModels.Writer; fold: Fold; insop: Domains.Operation; a: TextModels.Attributes;
  607. BEGIN
  608. ASSERT(text # NIL, 20);
  609. ASSERT((beg >= 0) & (end <= text.Length()) & (beg <= end), 21);
  610. a := InsertionAttr(text, beg);
  611. w := text.NewWriter(NIL); w.SetPos(beg);
  612. IF a # NIL THEN w.SetAttr(a) END;
  613. NEW(fold);
  614. fold.leftSide := TRUE; fold.collapsed := collapsed;
  615. fold.hidden := TextModels.CloneOf(text); Stores.Join(fold, fold.hidden);
  616. fold.label := label$;
  617. Models.BeginScript(text, insertFoldKey, insop);
  618. w.WriteView(fold, 0, 0);
  619. w.SetPos(end+1);
  620. a := InsertionAttr(text, end+1);
  621. IF a # NIL THEN w.SetAttr(a) END;
  622. NEW(fold);
  623. fold.leftSide := FALSE; fold.collapsed := collapsed;
  624. fold.hidden := NIL; fold.label := "";
  625. w.WriteView(fold, 0, 0);
  626. Models.EndScript(text, insop)
  627. END Insert;
  628. PROCEDURE CreateGuard* (VAR par: Dialog.Par);
  629. VAR c: TextControllers.Controller; beg, end: INTEGER;
  630. BEGIN c := TextControllers.Focus();
  631. IF (c # NIL) & ~(Containers.noCaret IN c.opts) THEN
  632. IF c.HasSelection() THEN c.GetSelection(beg, end);
  633. IF Overlaps(c.text, beg, end) THEN par.disabled := TRUE END
  634. END
  635. ELSE par.disabled := TRUE
  636. END
  637. END CreateGuard;
  638. PROCEDURE Create* (state: INTEGER); (* menu cmd parameters don't accept Booleans *)
  639. VAR c: TextControllers.Controller; beg, end: INTEGER; collapsed: BOOLEAN;
  640. BEGIN
  641. collapsed := state = 0;
  642. c := TextControllers.Focus();
  643. IF (c # NIL) & ~(Containers.noCaret IN c.opts) THEN
  644. IF c.HasSelection() THEN c.GetSelection(beg, end);
  645. IF ~Overlaps(c.text, beg, end) THEN Insert(c.text, "", beg, end, collapsed) END
  646. ELSE beg := c.CaretPos(); Insert(c.text, "", beg, beg, collapsed)
  647. END
  648. END
  649. END Create;
  650. PROCEDURE InitIcons;
  651. VAR font: Fonts.Font;
  652. PROCEDURE DefaultAppearance;
  653. BEGIN
  654. font := Fonts.dir.Default(); iconFont := font.typeface$;
  655. leftExp := ">"; rightExp := "<";
  656. leftColl := "=>"; rightColl := "<=";
  657. coloredBackg := TRUE
  658. END DefaultAppearance;
  659. BEGIN
  660. IF Dialog.platform = Dialog.linux THEN (* Linux *)
  661. DefaultAppearance;
  662. coloredBackg := FALSE
  663. ELSIF Dialog.platform DIV 10 = 1 THEN (* Windows *)
  664. iconFont := "Wingdings";
  665. font := Fonts.dir.This(iconFont, 10*Fonts.point (*arbitrary*), {}, Fonts.normal);
  666. IF font.IsAlien() THEN DefaultAppearance
  667. ELSE
  668. leftExp[0] := SHORT(CHR(240)); leftExp[1] := 0X;
  669. rightExp[0] := SHORT(CHR(239)); rightExp[1] := 0X;
  670. leftColl[0] := SHORT(CHR(232)); leftColl[1] := 0X;
  671. rightColl[0] := SHORT(CHR(231)); rightColl[1] := 0X;
  672. coloredBackg := FALSE
  673. END
  674. ELSIF Dialog.platform DIV 10 = 2 THEN (* Mac *)
  675. iconFont := "Chicago";
  676. font := Fonts.dir.This(iconFont, 10*Fonts.point (*arbitrary*), {}, Fonts.normal);
  677. IF font.IsAlien() THEN DefaultAppearance
  678. ELSE
  679. leftExp := ">"; rightExp := "<";
  680. leftColl := "»"; rightColl := "«";
  681. coloredBackg := TRUE
  682. END
  683. ELSE
  684. DefaultAppearance
  685. END
  686. END InitIcons;
  687. PROCEDURE (d: StdDirectory) New (collapsed: BOOLEAN; label: Label;
  688. hiddenText: TextModels.Model): Fold;
  689. VAR fold: Fold;
  690. BEGIN
  691. NEW(fold); fold.leftSide := hiddenText # NIL; fold.collapsed := collapsed;
  692. fold.label := label; fold.hidden := hiddenText;
  693. IF hiddenText # NIL THEN Stores.Join(fold, fold.hidden) END;
  694. RETURN fold
  695. END New;
  696. PROCEDURE SetDir* (d: Directory);
  697. BEGIN
  698. ASSERT(d # NIL, 20);
  699. dir := d
  700. END SetDir;
  701. PROCEDURE InitMod;
  702. VAR d: StdDirectory;
  703. BEGIN
  704. foldData.all := TRUE; foldData.nested := FALSE; foldData.findLabel := ""; foldData.newLabel := "";
  705. NEW(d); dir := d; stdDir := d;
  706. InitIcons;
  707. NEW(action); Services.DoLater(action, Services.now);
  708. END InitMod;
  709. BEGIN
  710. InitMod
  711. END StdFolds.