Trurl-based/Dev/Mod/Markers.txt

   1 MODULE DevMarkers;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Markers.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT
   7                 Kernel, Files, Stores, Fonts, Ports, Models, Views, Controllers, Properties, Dialog,
   8                 TextModels, TextSetters, TextViews, TextControllers, TextMappers;
   9
  10         CONST
  11                 (** View.mode **)
  12                 undefined* = 0; mark* = 1; message* = 2;
  13                 firstMode = 1; lastMode = 2;
  14
  15                 (** View.err **)
  16                 noCode* = 9999;
  17
  18                 errFile = "Errors"; point = Ports.point;
  19
  20         TYPE
  21                 View* = POINTER TO ABSTRACT RECORD (Views.View)
  22                         mode-: INTEGER;
  23                         err-: INTEGER;
  24                         msg-: POINTER TO ARRAY OF CHAR;
  25                         era: INTEGER
  26                 END;
  27
  28                 Directory* = POINTER TO ABSTRACT RECORD END;
  29
  30
  31                 StdView = POINTER TO RECORD (View) END;
  32
  33                 StdDirectory = POINTER TO RECORD (Directory) END;
  34
  35                 SetModeOp = POINTER TO RECORD (Stores.Operation)
  36                         view: View;
  37                         mode: INTEGER
  38                 END;
  39
  40
  41         VAR
  42                 dir-, stdDir-: Directory;
  43
  44                 globR: TextModels.Reader; globW: TextModels.Writer;     (* recycling done in Load, Insert *)
  45
  46                 thisEra: INTEGER;
  47
  48
  49         (** View **)
  50
  51         PROCEDURE (v: View) CopyFromSimpleView- (source: Views.View), EXTENSIBLE;
  52         BEGIN
  53                 (* v.CopyFrom^(source); *)
  54                 WITH source: View DO
  55                         v.err := source.err; v.mode := source.mode;
  56                         IF source.msg # NIL THEN
  57                                 NEW(v.msg, LEN(source.msg^)); v.msg^ := source.msg^$
  58                         END
  59                 END
  60         END CopyFromSimpleView;
  61
  62 (*
  63         PROCEDURE (v: View) InitContext* (context: Models.Context), EXTENSIBLE;
  64         BEGIN
  65                 ASSERT(v.mode # undefined, 20);
  66                 v.InitContext^(context)
  67         END InitContext;
  68 *)
  69
  70         PROCEDURE (v: View) InitErr* (err: INTEGER), NEW, EXTENSIBLE;
  71         BEGIN
  72                 ASSERT(v.msg = NIL, 20);
  73                 IF v.err # err THEN v.err := err; v.mode := mark END;
  74                 IF v.mode = undefined THEN v.mode := mark END
  75         END InitErr;
  76
  77         PROCEDURE (v: View) InitMsg* (msg: ARRAY OF CHAR), NEW, EXTENSIBLE;
  78                 VAR i: INTEGER; str: ARRAY 1024 OF CHAR;
  79         BEGIN
  80                 ASSERT(v.msg = NIL, 20);
  81                 Dialog.MapString(msg, str);
  82                 i := 0; WHILE str[i] # 0X DO INC(i) END;
  83                 NEW(v.msg, i + 1); v.msg^ := str$;
  84                 v.mode := mark
  85         END InitMsg;
  86
  87         PROCEDURE (v: View) SetMode* (mode: INTEGER), NEW, EXTENSIBLE;
  88                 VAR op: SetModeOp;
  89         BEGIN
  90                 ASSERT((firstMode <= mode) & (mode <= lastMode), 20);
  91                 IF v.mode # mode THEN
  92                         NEW(op); op.view := v; op.mode := mode;
  93                         Views.Do(v, "#System:ViewSetting", op)
  94                 END
  95         END SetMode;
  96
  97
  98         (** Directory **)
  99
 100         PROCEDURE (d: Directory) New* (type: INTEGER): View, NEW, ABSTRACT;
 101         PROCEDURE (d: Directory) NewMsg* (msg: ARRAY OF CHAR): View, NEW, ABSTRACT;
 102
 103
 104         (* SetModeOp *)
 105
 106         PROCEDURE (op: SetModeOp) Do;
 107                 VAR v: View; mode: INTEGER;
 108         BEGIN
 109                 v := op.view;
 110                 mode := v.mode; v.mode := op.mode; op.mode := mode;
 111                 Views.Update(v, Views.keepFrames);
 112                 IF v.context # NIL THEN v.context.SetSize(Views.undefined, Views.undefined) END
 113         END Do;
 114
 115         PROCEDURE ToggleMode (v: View);
 116                 VAR mode: INTEGER;
 117         BEGIN
 118                 IF ABS(v.err) # noCode THEN
 119                         IF v.mode < lastMode THEN mode := v.mode + 1 ELSE mode := firstMode END
 120                 ELSE
 121                         IF v.mode < message THEN mode := v.mode + 1 ELSE mode := firstMode END
 122                 END;
 123                 v.SetMode(mode)
 124         END ToggleMode;
 125
 126
 127         (* primitives for StdView *)
 128
 129         PROCEDURE NumToStr (x: INTEGER; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
 130                 VAR j: INTEGER; m: ARRAY 32 OF CHAR;
 131         BEGIN
 132                 ASSERT(x >= 0, 20);
 133                 j := 0; REPEAT m[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0;
 134                 i := 0; REPEAT DEC(j); s[i] := m[j]; INC(i) UNTIL j = 0;
 135                 s[i] := 0X
 136         END NumToStr;
 137
 138         PROCEDURE Load (v: StdView);
 139                 VAR view: Views.View; t: TextModels.Model; s: TextMappers.Scanner;
 140                         err: INTEGER; i: INTEGER; ch: CHAR; loc: Files.Locator;
 141                         msg: ARRAY 1024 OF CHAR;
 142         BEGIN
 143                 err := ABS(v.err); NumToStr(err, msg, i);
 144                 loc := Files.dir.This("Dev"); IF loc = NIL THEN RETURN END;
 145                 loc := loc.This("Rsrc"); IF loc = NIL THEN RETURN END;
 146                 view := Views.OldView(loc, errFile);
 147                 IF (view # NIL) & (view IS TextViews.View) THEN
 148                         t := view(TextViews.View).ThisModel();
 149                         IF t # NIL THEN
 150                                 s.ConnectTo(t);
 151                                 REPEAT
 152                                         s.Scan
 153                                 UNTIL ((s.type = TextMappers.int) & (s.int = err)) OR (s.type = TextMappers.eot);
 154                                 IF s.type = TextMappers.int THEN
 155                                         s.Skip(ch); i := 0;
 156                                         WHILE (ch >= " ") & (i < LEN(msg) - 1) DO
 157                                                 msg[i] := ch; INC(i); s.rider.ReadChar(ch)
 158                                         END;
 159                                         msg[i] := 0X
 160                                 END
 161                         END
 162                 END;
 163                 NEW(v.msg, i + 1); v.msg^ := msg$
 164         END Load;
 165
 166         PROCEDURE DrawMsg (v: StdView; f: Views.Frame; font: Fonts.Font; color: Ports.Color);
 167                 VAR w, h, asc, dsc: INTEGER;
 168         BEGIN
 169                 CASE v.mode OF
 170                   mark:
 171                         v.context.GetSize(w, h);
 172                         f.DrawLine(point, 0, w - 2 * point, h, 0, color);
 173                         f.DrawLine(w - 2 * point, 0, point, h, 0, color)
 174                 | message:
 175                         font.GetBounds(asc, dsc, w);
 176                         f.DrawString(2 * point, asc, color, v.msg^, font)
 177                 END
 178         END DrawMsg;
 179
 180         PROCEDURE ShowMsg (v: StdView);
 181         BEGIN
 182                 IF v.msg = NIL THEN Load(v) END;
 183                 Dialog.ShowStatus(v.msg^)
 184         END ShowMsg;
 185
 186         PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);
 187                 VAR c: Models.Context; t: TextModels.Model; u, w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
 188         BEGIN
 189                 v.context.GetSize(w, h); u := f.dot; in0 := FALSE;
 190                 in := (0 <= x) & (x < w) & (0 <= y) & (y < h);
 191                 REPEAT
 192                         IF in # in0 THEN
 193                                 f.MarkRect(u, 0, w - u, h, Ports.fill, Ports.invert, Ports.show); in0 := in
 194                         END;
 195                         f.Input(x, y, m, isDown);
 196                         in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
 197                 UNTIL ~isDown;
 198                 IF in0 THEN
 199                         f.MarkRect(u, 0, w - u, h, Ports.fill, Ports.invert, Ports.hide);
 200                         IF Dialog.showsStatus & ~(Controllers.modify IN buttons) & ~(Controllers.doubleClick IN buttons) THEN
 201                                 ShowMsg(v)
 202                         ELSE
 203                                 ToggleMode(v)
 204                         END;
 205                         c := v.context;
 206                         WITH c: TextModels.Context DO
 207                                 t := c.ThisModel();
 208                                 TextControllers.SetCaret(t, c.Pos() + 1)
 209                         ELSE
 210                         END
 211                 END
 212         END Track;
 213
 214         PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
 215                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, w: INTEGER;
 216         BEGIN
 217                 c := v.context;
 218                 IF (c # NIL) & (c IS TextModels.Context) THEN a := c(TextModels.Context).Attr(); font := a.font
 219                 ELSE font := Fonts.dir.Default()
 220                 END;
 221                 font.GetBounds(asc, dsc, w);
 222                 p.h := asc + dsc;
 223                 CASE v.mode OF
 224                   mark:
 225                         p.w := p.h + 2 * point
 226                 | message:
 227                         IF v.msg = NIL THEN Load(v) END;
 228                         p.w := font.StringWidth(v.msg^) + 4 * point
 229                 END
 230         END SizePref;
 231
 232
 233         (* StdView *)
 234
 235         PROCEDURE (v: StdView) ExternalizeAs (VAR s1: Stores.Store);
 236         BEGIN
 237                 s1 := NIL
 238         END ExternalizeAs;
 239
 240         PROCEDURE (v: StdView) SetMode(mode: INTEGER);
 241         BEGIN v.SetMode^(mode); ShowMsg(v)
 242         END SetMode;
 243
 244         PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
 245                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
 246                         w, h: INTEGER;
 247         BEGIN
 248                 c := v.context; c.GetSize(w, h);
 249                 WITH c: TextModels.Context DO a := c.Attr(); font := a.font ELSE font := Fonts.dir.Default() END;
 250                 IF TRUE (*f.colors >= 4*) THEN color := Ports.grey50 ELSE color := Ports.defaultColor END;
 251                 IF v.err >= 0 THEN
 252                         f.DrawRect(point, 0, w - point, h, Ports.fill, color);
 253                         DrawMsg(v, f, font, Ports.background)
 254                 ELSE
 255                         f.DrawRect(point, 0, w - point, h, 0, color);
 256                         DrawMsg(v, f, font, Ports.defaultColor)
 257                 END
 258         END Restore;
 259
 260         PROCEDURE (v: StdView) GetBackground (VAR color: Ports.Color);
 261         BEGIN
 262                 color := Ports.background
 263         END GetBackground;
 264
 265         PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
 266                                                                                                                                                 VAR focus: Views.View);
 267         BEGIN
 268                 WITH msg: Controllers.TrackMsg DO
 269                         Track(v, f, msg.x, msg.y, msg.modifiers)
 270                 ELSE
 271                 END
 272         END HandleCtrlMsg;
 273
 274         PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
 275                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, w: INTEGER;
 276         BEGIN
 277                 WITH msg: Properties.Preference DO
 278                         WITH msg: Properties.SizePref DO
 279                                 SizePref(v, msg)
 280                         | msg: Properties.ResizePref DO
 281                                 msg.fixed := TRUE
 282                         | msg: Properties.FocusPref DO
 283                                 msg.hotFocus := TRUE
 284 (*
 285                         | msg: Properties.StorePref DO
 286                                 msg.view := NIL
 287 *)
 288                         | msg: TextSetters.Pref DO
 289                                 c := v.context;
 290                                 IF (c # NIL) & (c IS TextModels.Context) THEN
 291                                         a := c(TextModels.Context).Attr(); font := a.font
 292                                 ELSE
 293                                         font := Fonts.dir.Default()
 294                                 END;
 295                                 font.GetBounds(asc, msg.dsc, w)
 296                         ELSE
 297                         END
 298                 ELSE
 299                 END
 300         END HandlePropMsg;
 301
 302
 303         (* StdDirectory *)
 304
 305         PROCEDURE (d: StdDirectory) New (err: INTEGER): View;
 306                 VAR v: StdView;
 307         BEGIN
 308                 NEW(v); v.InitErr(err); RETURN v
 309         END New;
 310
 311         PROCEDURE (d: StdDirectory) NewMsg (msg: ARRAY OF CHAR): View;
 312                 VAR v: StdView;
 313         BEGIN
 314                 NEW(v); v.InitErr(noCode); v.InitMsg(msg); RETURN v
 315         END NewMsg;
 316
 317
 318         (** Cleaner **)
 319
 320         PROCEDURE Cleanup;
 321         BEGIN
 322                 globR := NIL; globW := NIL
 323         END Cleanup;
 324
 325
 326         (** miscellaneous **)
 327
 328         PROCEDURE Insert* (text: TextModels.Model; pos: INTEGER; v: View);
 329                 VAR w: TextModels.Writer; r: TextModels.Reader;
 330         BEGIN
 331                 ASSERT(v.era = 0, 20);
 332                 Models.BeginModification(Models.clean, text);
 333                 v.era := thisEra;
 334                 IF pos > text.Length() THEN pos := text.Length() END;
 335                 globW := text.NewWriter(globW); w := globW; w.SetPos(pos);
 336                 IF pos > 0 THEN DEC(pos) END;
 337                 globR := text.NewReader(globR); r := globR; r.SetPos(pos); r.Read;
 338                 IF r.attr # NIL THEN w.SetAttr(r.attr) END;
 339                 w.WriteView(v, Views.undefined, Views.undefined);
 340                 Models.EndModification(Models.clean, text);
 341         END Insert;
 342
 343         PROCEDURE Unmark* (text: TextModels.Model);
 344                 VAR r: TextModels.Reader; v: Views.View; pos: INTEGER;
 345                         script: Stores.Operation;
 346         BEGIN
 347                 Models.BeginModification(Models.clean, text);
 348                 Models.BeginScript(text, "#Dev:DeleteMarkers", script);
 349                 r := text.NewReader(NIL); r.ReadView(v);
 350                 WHILE ~r.eot DO
 351                         IF r.view IS View THEN
 352                                 pos := r.Pos() - 1; text.Delete(pos, pos + 1); r.SetPos(pos)
 353                         END;
 354                         r.ReadView(v)
 355                 END;
 356                 INC(thisEra);
 357                 Models.EndScript(text, script);
 358                 Models.EndModification(Models.clean, text);
 359         END Unmark;
 360
 361         PROCEDURE ShowFirstError* (text: TextModels.Model; focusOnly: BOOLEAN);
 362                 VAR v1: Views.View; pos: INTEGER;
 363         BEGIN
 364                 globR := text.NewReader(globR); globR.SetPos(0);
 365                 REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
 366                 IF ~globR.eot THEN
 367                         pos := globR.Pos();
 368                         TextViews.ShowRange(text, pos, pos, focusOnly);
 369                         TextControllers.SetCaret(text, pos);
 370                         v1(View).SetMode(v1(View).mode)
 371                 END
 372         END ShowFirstError;
 373
 374
 375         (** commands **)
 376
 377         PROCEDURE UnmarkErrors*;
 378                 VAR t: TextModels.Model;
 379         BEGIN
 380                 t := TextViews.FocusText();
 381                 IF t # NIL THEN Unmark(t) END
 382         END UnmarkErrors;
 383
 384         PROCEDURE NextError*;
 385                 VAR c: TextControllers.Controller; t: TextModels.Model; v1: Views.View;
 386                         beg, pos: INTEGER;
 387         BEGIN
 388                 c := TextControllers.Focus();
 389                 IF c # NIL THEN
 390                         t := c.text;
 391                         IF c.HasCaret() THEN pos := c.CaretPos()
 392                         ELSIF c.HasSelection() THEN c.GetSelection(beg, pos)
 393                         ELSE pos := 0
 394                         END;
 395                         TextControllers.SetSelection(t, TextControllers.none, TextControllers.none);
 396                         globR := t.NewReader(globR); globR.SetPos(pos);
 397                         REPEAT globR.ReadView(v1) UNTIL globR.eot OR (v1 IS View);
 398                         IF ~globR.eot THEN
 399                                 pos := globR.Pos(); v1(View).SetMode(v1(View).mode);
 400                                 TextViews.ShowRange(t, pos, pos, TextViews.focusOnly)
 401                         ELSE
 402                                 pos := 0; Dialog.Beep
 403                         END;
 404                         TextControllers.SetCaret(t, pos);
 405                         globR := NIL
 406                 END
 407         END NextError;
 408
 409         PROCEDURE ToggleCurrent*;
 410                 VAR c: TextControllers.Controller; t: TextModels.Model; v: Views.View; pos: INTEGER;
 411         BEGIN
 412                 c := TextControllers.Focus();
 413                 IF (c # NIL) & c.HasCaret() THEN
 414                         t := c.text; pos := c.CaretPos();
 415                         globR := t.NewReader(globR); globR.SetPos(pos); globR.ReadPrev;
 416                         v := globR.view;
 417                         IF (v # NIL) & (v IS View) THEN ToggleMode(v(View)) END;
 418                         TextViews.ShowRange(t, pos, pos, TextViews.focusOnly);
 419                         TextControllers.SetCaret(t, pos);
 420                         globR := NIL
 421                 END
 422         END ToggleCurrent;
 423
 424
 425         PROCEDURE SetDir* (d: Directory);
 426         BEGIN
 427                 dir := d
 428         END SetDir;
 429
 430
 431         PROCEDURE Init;
 432                 VAR d: StdDirectory;
 433         BEGIN
 434                 thisEra := 1;
 435                 NEW(d); dir := d; stdDir := d
 436         END Init;
 437
 438 BEGIN
 439         Init; Kernel.InstallCleaner(Cleanup)
 440 CLOSE
 441         Kernel.RemoveCleaner(Cleanup)
 442 END DevMarkers.