Trurl-based/Std/Mod/Folds.txt

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