1 MODULE StdLinks;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Links.odc *)
5 IMPORT Kernel, Services,
6 Stores, Ports, Fonts, Models, Views, Controllers, Properties, Dialog, Containers,
7 TextModels, TextMappers, TextViews, TextControllers, TextSetters, TextRulers,
8 Strings, StdCmds;
10 CONST
11 kind* = 0; cmd* = 1; close* = 2; (* constants for Prop.valid *)
12 always* = 0; ifShiftDown* = 1; never* = 2; (* constants for close attrubute *)
13 minLinkVersion = 0; maxLinkVersion = 1;
14 minTargVersion = 0; maxTargVersion = 0;
16 TYPE
17 Directory* = POINTER TO ABSTRACT RECORD END;
19 Link* = POINTER TO RECORD (Views.View)
20 leftSide-: BOOLEAN;
21 cmd: POINTER TO ARRAY OF CHAR;
22 close: INTEGER
23 END;
25 Target* = POINTER TO RECORD (Views.View)
26 leftSide-: BOOLEAN;
27 ident: POINTER TO ARRAY OF CHAR
28 END;
30 Prop* = POINTER TO RECORD (Properties.Property)
31 cmd*: POINTER TO ARRAY OF CHAR;
32 link-: BOOLEAN;
33 close*: INTEGER
34 END;
36 ChangeAttrOp = POINTER TO RECORD (Stores.Operation)
37 v: Views.View;
38 cmd: POINTER TO ARRAY OF CHAR;
39 close: INTEGER;
40 valid: SET
41 END;
43 StdDirectory = POINTER TO RECORD (Directory) END;
45 TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
47 VAR
48 dir-, stdDir-: Directory;
49 par-: Link;
50 iconFont: Fonts.Typeface;
51 linkLeft, linkRight, targetLeft, targetRight: ARRAY 8 OF SHORTCHAR;
52 coloredBackg: BOOLEAN;
54 cleaner: TrapCleaner;
56 dialog*: RECORD
57 cmd*: ARRAY 512 OF CHAR;
58 type-: ARRAY 32 OF CHAR;
59 close*: Dialog.List;
60 known, valid: SET;
61 END;
62 fingerprint: INTEGER;
64 (** Cleaner **)
66 PROCEDURE (c: TrapCleaner) Cleanup;
67 BEGIN
68 par := NIL
69 END Cleanup;
71 (** Properties **)
73 PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
74 VAR valid: SET;
75 BEGIN
76 WITH q: Prop DO
77 valid := p.valid * q.valid; equal := TRUE;
78 IF (cmd IN valid) & (p.cmd^ # q.cmd^) THEN EXCL(valid, cmd) END;
79 IF (kind IN valid) & (p.link # q.link) THEN EXCL(valid, kind) END;
80 IF (close IN valid) & (p.close # q.close) THEN EXCL (valid, close) END;
81 IF p.valid # valid THEN p.valid := valid; equal := FALSE END
82 END
83 END IntersectWith;
85 PROCEDURE (op: ChangeAttrOp) Do;
86 VAR v: Views.View; s: POINTER TO ARRAY OF CHAR; c: INTEGER;
87 BEGIN
88 v := op.v;
89 WITH
90 | v: Link DO
91 IF cmd IN op.valid THEN s := op.cmd; op.cmd := v.cmd; v.cmd := s END;
92 IF close IN op.valid THEN c := op.close; op.close := v.close; v.close := c END
93 | v: Target DO
94 IF cmd IN op.valid THEN s := op.cmd; op.cmd := v.ident; v.ident := s END
95 END
96 END Do;
98 PROCEDURE DoChangeAttrOp (v: Views.View; s: POINTER TO ARRAY OF CHAR; c: INTEGER; valid: SET);
99 VAR op: ChangeAttrOp;
100 BEGIN
101 NEW(op); op.v := v; op.valid := valid;
102 IF close IN valid THEN
103 op.close := c END;
104 IF cmd IN valid THEN NEW(op.cmd, LEN(s)+1); op.cmd^ := s$ END;
105 Views.Do(v, "#Std:LinkChange", op)
106 END DoChangeAttrOp;
108 PROCEDURE SetProp(v: Views.View; msg: Properties.SetMsg);
109 VAR p: Properties.Property;
110 BEGIN
111 p := msg.prop;
112 WHILE p # NIL DO
113 WITH p: Prop DO
114 IF (cmd IN p.valid) OR (close IN p.valid) THEN DoChangeAttrOp(v, p.cmd, p.close, p.valid) END
115 ELSE
116 END;
117 p := p.next
118 END
119 END SetProp;
121 PROCEDURE PollProp(v: Views.View; VAR msg: Properties.PollMsg);
122 VAR p: Prop;
123 BEGIN
124 NEW(p);
125 WITH v: Link DO
126 p.known := {kind, cmd, close};
127 p.link := TRUE;
128 p.cmd := v.cmd;
129 p.close := v.close
130 | v: Target DO
131 p.known := {kind, cmd};
132 p.link := FALSE;
133 p.cmd := v.ident
134 ELSE
135 END;
136 p.valid := p.known;
137 Properties.Insert(msg.prop, p)
138 END PollProp;
140 PROCEDURE InitDialog*;
141 VAR p: Properties.Property;
142 BEGIN
143 dialog.cmd := ""; dialog.type := ""; dialog.close.index := -1;
144 dialog.known := {}; dialog.valid := {};
145 Properties.CollectProp(p);
146 WHILE p # NIL DO
147 WITH p: Prop DO
148 dialog.valid := p.valid; dialog.known := p.known;
149 IF cmd IN p.valid THEN
150 dialog.cmd := p.cmd$
151 END;
152 IF kind IN p.valid THEN
153 IF p.link THEN Dialog.MapString("#Std:Link", dialog.type)
154 ELSE Dialog.MapString("#Std:Target", dialog.type)
155 END
156 END;
157 IF close IN p.valid THEN
158 dialog.close.index := p.close
159 END
160 ELSE
161 END;
162 p := p.next
163 END;
164 Dialog.Update(dialog)
165 END InitDialog;
167 PROCEDURE Set*;
168 VAR p: Prop;
169 BEGIN
170 NEW(p);
171 p.valid := dialog.valid;
172 IF cmd IN p.valid THEN
173 NEW(p.cmd, LEN(dialog.cmd) + 1);
174 p.cmd^ := dialog.cmd$
175 END;
176 p.close := dialog.close.index;
177 Properties.EmitProp(NIL, p);
178 fingerprint := 0 (* force actualization of fields *)
179 END Set;
181 PROCEDURE CmdGuard* (VAR par: Dialog.Par);
182 VAR c: Containers.Controller; v: Views.View; fp: INTEGER;
183 BEGIN
184 IF ~(cmd IN dialog.known) THEN par.disabled := TRUE
185 ELSIF ~(cmd IN dialog.valid) THEN par.undef := TRUE
186 END;
187 Controllers.SetCurrentPath(Controllers.targetPath);
188 fp := 0;
189 c := Containers.Focus();
190 IF c # NIL THEN
191 c.GetFirstView(Containers.selection, v);
192 WHILE v # NIL DO fp := fp + Services.AdrOf(v); c.GetNextView(TRUE, v) END
193 END;
194 IF fp # fingerprint THEN fingerprint := fp; InitDialog END;
195 Controllers.ResetCurrentPath()
196 END CmdGuard;
198 PROCEDURE CloseGuard* (VAR par: Dialog.Par);
199 BEGIN
200 IF ~(close IN dialog.known) THEN par.disabled := TRUE
201 ELSIF ~(close IN dialog.valid) THEN par.undef := TRUE
202 END;
203 END CloseGuard;
205 PROCEDURE Notifier* (idx, op, from, to: INTEGER);
206 BEGIN
207 IF op = Dialog.changed THEN INCL(dialog.valid, idx) END
208 END Notifier;
210 PROCEDURE (d: Directory) NewLink* (IN cmd: ARRAY OF CHAR): Link, NEW, ABSTRACT;
211 PROCEDURE (d: Directory) NewTarget* (IN ident: ARRAY OF CHAR): Target, NEW, ABSTRACT;
214 PROCEDURE InFrame (f: Views.Frame; x, y: INTEGER): BOOLEAN;
215 BEGIN
216 RETURN (f.l <= x) & (x < f.r) & (f.t <= y) & (y < f.b)
217 END InFrame;
219 PROCEDURE Mark (f: Views.Frame; show: BOOLEAN);
220 BEGIN
221 f.MarkRect(f.l, f.t, f.r, f.b, Ports.fill, Ports.hilite, show)
222 END Mark;
224 PROCEDURE ThisPos (v: TextViews.View; f: Views.Frame; x, y: INTEGER): INTEGER;
225 (* "corrected" v.ThisPos: does not adjust position when crossing 50% boundary of characters *)
226 VAR loc: TextViews.Location; pos: INTEGER;
227 BEGIN
228 pos := v.ThisPos(f, x, y); v.GetThisLocation(f, pos, loc);
229 IF (loc.y <= y) & (y < loc.y + loc.asc + loc.dsc) & (x < loc.x) THEN DEC(pos) END;
230 RETURN pos
231 END ThisPos;
233 PROCEDURE GetLinkPair (this: Link; VAR l, r: Link);
234 (* POST: BalancedPair(l, r) & (l # r) & (l = this OR r = this) OR (l = r = NIL) *)
235 VAR t: TextModels.Model; rd: TextModels.Reader; v: Views.View; level: INTEGER;
236 BEGIN
237 l := NIL; r := NIL; level := 1;
238 IF (this.context # NIL) & (this.context IS TextModels.Context) THEN
239 t := this.context(TextModels.Context).ThisModel();
240 rd := t.NewReader(NIL);
241 IF this.leftSide THEN
242 rd.SetPos(this.context(TextModels.Context).Pos() + 1);
243 REPEAT
244 rd.ReadView(v);
245 IF (v # NIL) & (v IS Link) THEN
246 IF v(Link).leftSide THEN INC(level) ELSE DEC(level) END
247 END
248 UNTIL (v = NIL) OR (level = 0);
249 IF v # NIL THEN l := this; r := v(Link) END
250 ELSE
251 rd.SetPos(this.context(TextModels.Context).Pos());
252 REPEAT
253 rd.ReadPrevView(v);
254 IF (v # NIL) & (v IS Link) THEN
255 IF v(Link).leftSide THEN DEC(level) ELSE INC(level) END
256 END
257 UNTIL (v = NIL) OR (level = 0);
258 IF v # NIL THEN l := v(Link); r := this END
259 END
260 END
261 END GetLinkPair;
263 PROCEDURE GetTargetPair (this: Target; VAR l, r: Target);
264 (* POST: BalancedPair(l, r) & (l # r) & (l = this OR r = this) OR (l = r = NIL) *)
265 VAR t: TextModels.Model; rd: TextModels.Reader; v: Views.View; level: INTEGER;
266 BEGIN
267 l := NIL; r := NIL; level := 1;
268 IF (this.context # NIL) & (this.context IS TextModels.Context) THEN
269 t := this.context(TextModels.Context).ThisModel();
270 rd := t.NewReader(NIL);
271 IF this.leftSide THEN
272 rd.SetPos(this.context(TextModels.Context).Pos() + 1);
273 REPEAT
274 rd.ReadView(v);
275 IF (v # NIL) & (v IS Target) THEN
276 IF v(Target).leftSide THEN INC(level) ELSE DEC(level) END
277 END
278 UNTIL (v = NIL) OR (level = 0);
279 IF v # NIL THEN l := this; r := v(Target) END
280 ELSE
281 rd.SetPos(this.context(TextModels.Context).Pos());
282 REPEAT
283 rd.ReadPrevView(v);
284 IF (v # NIL) & (v IS Target) THEN
285 IF v(Target).leftSide THEN DEC(level) ELSE INC(level) END
286 END
287 UNTIL (v = NIL) OR (level = 0);
288 IF v # NIL THEN l := v(Target); r := this END
289 END
290 END
291 END GetTargetPair;
293 PROCEDURE GetRange (l, r: Link; VAR beg, end: INTEGER);
294 BEGIN
295 beg := l.context(TextModels.Context).Pos();
296 end := r.context(TextModels.Context).Pos() + 1
297 END GetRange;
299 PROCEDURE MarkRange (v: TextViews.View; f: Views.Frame; beg, end: INTEGER; show: BOOLEAN);
300 VAR b, e: TextViews.Location; r, t: INTEGER;
301 BEGIN
302 ASSERT(beg < end, 20);
303 v.GetThisLocation(f, beg, b); v.GetThisLocation(f, end, e);
304 IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
305 IF b.start # e.start THEN
306 r := f.r; t := b.y + b.asc + b.dsc;
307 f.MarkRect(b.x, b.y, r, t, Ports.fill, Ports.hilite, show);
308 IF t < e.y THEN f.MarkRect(0, t, r, e.y, Ports.fill, Ports.hilite, show) END;
309 b.x := f.l; b.y := e.y
310 END;
311 f.MarkRect(b.x, b.y, e.x, e.y + e.asc + e.dsc, Ports.fill, Ports.hilite, show)
312 END
313 END MarkRange;
315 PROCEDURE Reveal (left, right: Views.View; str: ARRAY OF CHAR; opname: Stores.OpName);
316 VAR con: TextModels.Context; t: TextModels.Model; pos: INTEGER;
317 w: TextMappers.Formatter; op: Stores.Operation;
318 BEGIN
319 con := left.context(TextModels.Context);
320 t := con.ThisModel(); pos := con.Pos();
321 w.ConnectTo(t); w.SetPos(pos);
322 IF con.Attr() # NIL THEN w.rider.SetAttr(con.Attr()) END;
323 Models.BeginScript(t, opname, op);
324 t.Delete(pos, pos + 1);
325 w.WriteChar("<");
326 IF str # "" THEN w.WriteString(str) END;
327 w.WriteChar(">");
328 con := right.context(TextModels.Context);
329 pos := con.Pos();
330 w.SetPos(pos);
331 IF con.Attr() # NIL THEN w.rider.SetAttr(con.Attr()) END;
332 t.Delete(pos, pos + 1);
333 w.WriteString("<>");
334 Models.EndScript(t, op)
335 END Reveal;
337 PROCEDURE RevealCmd (v: Link);
338 VAR left, right: Link;
339 BEGIN GetLinkPair(v, left, right);
340 IF left # NIL THEN
341 IF v.cmd # NIL THEN Reveal(left, right, v.cmd^, "#StdLinks:Reveal Link Command")
342 ELSE Reveal(left, right, "", "#StdLinks:Reveal Link Command")
343 END
344 END
345 END RevealCmd;
347 PROCEDURE RevealTarget (targ: Target);
348 VAR left, right: Target;
349 BEGIN GetTargetPair(targ, left, right);
350 IF left # NIL THEN
351 IF left.ident # NIL THEN Reveal(left, right, left.ident^, "#SdtLinks:Reveal Target Ident")
352 ELSE Reveal(left, right, "", "#SdtLinks:Reveal Target Ident")
353 END
354 END
355 END RevealTarget;
357 PROCEDURE CallCmd (v: Link; close: BOOLEAN);
358 VAR res: INTEGER;
359 BEGIN
360 Kernel.PushTrapCleaner(cleaner);
361 par := v;
362 IF v.cmd^ # "" THEN
363 IF close & (v.close = ifShiftDown) OR (v.close = always) THEN
364 StdCmds.CloseDialog
365 END;
366 Dialog.Call(v.cmd^, "#StdLinks:Link Call Failed", res)
367 END;
368 par := NIL;
369 Kernel.PopTrapCleaner(cleaner)
370 END CallCmd;
372 PROCEDURE TrackSingle (f: Views.Frame; VAR in: BOOLEAN);
373 VAR x, y: INTEGER; modifiers: SET; in0, isDown: BOOLEAN;
374 BEGIN
375 in := FALSE;
376 REPEAT
377 f.Input(x, y, modifiers, isDown);
378 in0 := in; in := InFrame(f, x, y);
379 IF in # in0 THEN Mark(f, in) END
380 UNTIL ~isDown;
381 IF in THEN Mark(f, FALSE) END
382 END TrackSingle;
384 PROCEDURE TrackRange (v: TextViews.View; f: Views.Frame; l, r: Link; x, y: INTEGER;
385 VAR in: BOOLEAN);
386 VAR pos, beg, end: INTEGER; modifiers: SET; in0, isDown: BOOLEAN;
387 BEGIN
388 in := FALSE;
389 GetRange(l, r, beg, end); pos := ThisPos(v, f, x, y);
390 IF (beg <= pos) & (pos < end) THEN
391 REPEAT
392 f.Input(x, y, modifiers, isDown); pos := ThisPos(v, f, x, y);
393 in0 := in; in := (beg <= pos) & (pos < end);
394 IF in # in0 THEN MarkRange(v, f, beg, end, in) END
395 UNTIL ~isDown;
396 IF in THEN
397 MarkRange(v, f, beg, end, FALSE)
398 END
399 END
400 END TrackRange;
402 PROCEDURE Track (v: Link; f: Views.Frame; c: TextControllers.Controller;
403 x, y: INTEGER; modifiers: SET);
404 (* PRE: (c # NIL) & (f.view.ThisModel() = v.context.ThisModel()) OR (c = NIL) & (f.view = v) *)
405 VAR l, r: Link; in: BOOLEAN;
406 BEGIN
407 GetLinkPair(v, l, r);
408 IF l # NIL THEN
409 IF c # NIL THEN TrackRange(c.view, f, l, r, x, y, in)
410 ELSE TrackSingle(f, in)
411 END;
412 IF in THEN
413 IF (Controllers.modify IN modifiers) & ((c = NIL) OR ~(Containers.noCaret IN c.opts)) THEN
414 RevealCmd(l)
415 ELSE
416 CallCmd(l, Controllers.extend IN modifiers)
417 END
418 END
419 END
420 END Track;
422 PROCEDURE TrackTarget (targ: Target; f: Views.Frame; modifiers: SET);
423 VAR in: BOOLEAN;
424 BEGIN
425 TrackSingle(f, in);
426 IF in & (Controllers.modify IN modifiers) THEN RevealTarget(targ) END
427 END TrackTarget;
429 PROCEDURE (v: Link) CopyFromSimpleView- (source: Views.View);
430 BEGIN
431 WITH source: Link DO
432 ASSERT(source.leftSide = (source.cmd # NIL), 100);
433 v.leftSide := source.leftSide;
434 v.close := source.close;
435 IF source.cmd # NIL THEN
436 NEW(v.cmd, LEN(source.cmd^));
437 v.cmd^ := source.cmd^$
438 ELSE v.cmd := NIL
439 END
440 END
441 END CopyFromSimpleView;
443 PROCEDURE (t: Target) CopyFromSimpleView- (source: Views.View);
444 BEGIN
445 WITH source: Target DO
446 ASSERT(source.leftSide = (source.ident # NIL), 100);
447 t.leftSide := source.leftSide;
448 IF source.ident # NIL THEN
449 NEW(t.ident, LEN(source.ident^));
450 t.ident^ := source.ident^$
451 ELSE t.ident := NIL
452 END
453 END
454 END CopyFromSimpleView;
456 PROCEDURE (v: Link) Internalize- (VAR rd: Stores.Reader);
457 VAR len: INTEGER; version: INTEGER; pos: INTEGER;
458 BEGIN
459 v.Internalize^(rd);
460 IF rd.cancelled THEN RETURN END;
461 rd.ReadVersion(minLinkVersion, maxLinkVersion, version);
462 IF rd.cancelled THEN RETURN END;
463 rd.ReadBool(v.leftSide);
464 rd.ReadInt(len);
465 IF len = 0 THEN v.cmd := NIL
466 ELSE NEW(v.cmd, len); rd.ReadXString(v.cmd^)
467 END;
468 v.leftSide := v.cmd # NIL;
469 IF v.leftSide THEN
470 IF version = 1 THEN
471 rd.ReadInt(v.close)
472 ELSE
473 Strings.Find(v.cmd, "StdLinks.ShowTarget", 0, pos);
474 IF (pos # 0) THEN v.close := ifShiftDown
475 ELSE v.close := never
476 END
477 END
478 END
479 END Internalize;
481 PROCEDURE (v: Link) Externalize- (VAR wr: Stores.Writer);
482 VAR pos, version: INTEGER;
483 BEGIN
484 v.Externalize^(wr);
485 IF v.leftSide THEN
486 Strings.Find(v.cmd, "StdLinks.ShowTarget", 0, pos);
487 IF (pos = 0) & (v.close = never) OR (v.close = ifShiftDown) THEN version := 0
488 ELSE version := 1
489 END
490 ELSE
491 version := 0
492 END;
493 wr.WriteVersion(version);
494 wr.WriteBool(v.cmd # NIL);
495 IF v.cmd = NIL THEN wr.WriteInt(0)
496 ELSE wr.WriteInt(LEN(v.cmd^)); wr.WriteXString(v.cmd^)
497 END;
498 IF version = 1 THEN wr.WriteInt(v.close) END
499 END Externalize;
501 PROCEDURE (t: Target) Internalize- (VAR rd: Stores.Reader);
502 VAR len: INTEGER; version: INTEGER;
503 BEGIN
504 t.Internalize^(rd);
505 IF rd.cancelled THEN RETURN END;
506 rd.ReadVersion(minTargVersion, maxTargVersion, version);
507 IF rd.cancelled THEN RETURN END;
508 rd.ReadBool(t.leftSide);
509 rd.ReadInt(len);
510 IF len = 0 THEN t.ident := NIL
511 ELSE NEW(t.ident, len); rd.ReadXString(t.ident^)
512 END;
513 t.leftSide := t.ident # NIL
514 END Internalize;
516 PROCEDURE (t: Target) Externalize- (VAR wr: Stores.Writer);
517 BEGIN
518 t.Externalize^(wr);
519 wr.WriteVersion(maxTargVersion);
520 wr.WriteBool(t.ident # NIL);
521 IF t.ident = NIL THEN wr.WriteInt(0)
522 ELSE wr.WriteInt(LEN(t.ident^)); wr.WriteXString(t.ident^)
523 END
524 END Externalize;
526 PROCEDURE RestoreView (v: Views.View; f: Views.Frame; icon: ARRAY OF SHORTCHAR);
527 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
528 asc, dsc, w: INTEGER;
529 BEGIN
530 c := v.context;
531 IF (c # NIL) & (c IS TextModels.Context) THEN
532 a := c(TextModels.Context).Attr();
533 font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal);
534 color := a.color
535 ELSE font := Fonts.dir.Default(); color := Ports.black
536 END;
537 IF coloredBackg THEN
538 f.DrawRect(f.l, f.t, f.r, f.b, Ports.fill, Ports.grey25) END;
539 font.GetBounds(asc, dsc, w);
540 f.DrawSString(1*Ports.mm DIV 2, asc, color, icon, font)
541 END RestoreView;
543 PROCEDURE (v: Link) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
544 BEGIN
545 IF v.leftSide THEN RestoreView(v, f, linkLeft)
546 ELSE RestoreView(v, f, linkRight)
547 END
548 END Restore;
550 PROCEDURE (targ: Target) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
551 BEGIN
552 IF targ.leftSide THEN RestoreView(targ, f, targetLeft)
553 ELSE RestoreView(targ, f, targetRight)
554 END
555 END Restore;
557 PROCEDURE SizePref (v: Views.View; icon: ARRAY OF SHORTCHAR; VAR msg: Properties.SizePref);
558 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font;
559 asc, dsc, w: INTEGER;
560 BEGIN
561 c := v.context;
562 IF (c # NIL) & (c IS TextModels.Context) THEN
563 a := c(TextModels.Context).Attr();
564 font := Fonts.dir.This(iconFont, a.font.size, {}, Fonts.normal)
565 ELSE
566 font := Fonts.dir.Default()
567 END;
568 msg.w := font.SStringWidth(icon) + 1*Ports.mm;
569 font.GetBounds(asc, dsc, w);
570 msg.h := asc + dsc
571 END SizePref;
573 PROCEDURE (v: Link) HandlePropMsg- (VAR msg: Properties.Message);
574 VAR a: TextModels.Attributes; c: Models.Context; asc, dsc, w: INTEGER; l, r: Link;
575 BEGIN
576 WITH msg: Properties.SizePref DO
577 IF v.leftSide THEN SizePref(v, linkLeft, msg)
578 ELSE SizePref(v, linkRight, msg)
579 END
580 | msg: Properties.FocusPref DO
581 msg.hotFocus := TRUE
582 | msg: Properties.ResizePref DO
583 msg.fixed := TRUE
584 | msg: TextModels.Pref DO
585 msg.opts := {TextModels.hideable}
586 | msg: TextControllers.FilterPref DO
587 msg.filter := TRUE
588 | msg: TextSetters.Pref DO c := v.context;
589 IF (c # NIL) & (c IS TextModels.Context) THEN
590 a := c(TextModels.Context).Attr();
591 a.font.GetBounds(asc, dsc, w);
592 msg.dsc := dsc
593 END
594 | msg: Properties.PollMsg DO
595 IF v.leftSide THEN PollProp(v, msg)
596 ELSE
597 GetLinkPair(v, l, r);
598 IF l # NIL THEN PollProp(l, msg) END
599 END
600 | msg: Properties.SetMsg DO
601 IF v.leftSide THEN SetProp(v, msg)
602 ELSE GetLinkPair(v, l, r); SetProp(l, msg)
603 END
604 ELSE
605 END
606 END HandlePropMsg;
608 PROCEDURE (targ: Target) HandlePropMsg- (VAR msg: Properties.Message);
609 VAR a: TextModels.Attributes; c: Models.Context; asc, dsc, w: INTEGER; l, r: Target;
610 BEGIN
611 WITH msg: Properties.SizePref DO
612 IF targ.leftSide THEN SizePref(targ, targetLeft, msg)
613 ELSE SizePref(targ, targetRight, msg)
614 END
615 | msg: Properties.FocusPref DO
616 msg.hotFocus := TRUE
617 | msg: Properties.ResizePref DO
618 msg.fixed := TRUE
619 | msg: TextModels.Pref DO
620 msg.opts := {TextModels.hideable}
621 | msg: TextSetters.Pref DO c := targ.context;
622 IF (c # NIL) & (c IS TextModels.Context) THEN
623 a := c(TextModels.Context).Attr();
624 a.font.GetBounds(asc, dsc, w);
625 msg.dsc := dsc
626 END
627 | msg: Properties.PollMsg DO
628 IF targ.leftSide THEN PollProp(targ, msg)
629 ELSE
630 GetTargetPair(targ, l, r);
631 IF l # NIL THEN PollProp(l, msg) END
632 END
633 | msg: Properties.SetMsg DO
634 IF targ.leftSide THEN SetProp(targ, msg)
635 ELSE GetTargetPair(targ, l, r); SetProp(l, msg)
636 END
637 ELSE
638 END
639 END HandlePropMsg;
641 PROCEDURE (v: Link) HandleCtrlMsg* (f: Views.Frame;
642 VAR msg: Controllers.Message; VAR focus: Views.View);
644 PROCEDURE isHot(c: TextControllers.Controller; x, y: INTEGER; mod: SET): BOOLEAN;
645 VAR pos, beg, end: INTEGER;
646 BEGIN
647 (* ignore alt, cmd, and middle clicks in edit mode *)
648 IF ~(Containers.noCaret IN c.opts) & (mod * {17, 27, 28} # {}) THEN RETURN FALSE END;
649 pos := ThisPos(c.view, f, x, y);
650 (* ignore clicks in selection *)
651 c.GetSelection(beg, end);
652 IF (end > beg) & (pos >= beg) & (pos <= end) THEN RETURN FALSE END;
653 IF v.leftSide THEN RETURN pos >= v.context(TextModels.Context).Pos()
654 ELSE RETURN pos < v.context(TextModels.Context).Pos()
655 END
656 END isHot;
658 BEGIN
659 WITH msg: Controllers.PollCursorMsg DO
660 msg.cursor := Ports.refCursor
661 | msg: TextControllers.FilterPollCursorMsg DO
662 IF isHot(msg.controller, msg.x, msg.y, {}) THEN
663 msg.cursor := Ports.refCursor; msg.done := TRUE
664 END
665 | msg: Controllers.TrackMsg DO
666 Track(v, f, NIL, msg.x, msg.y, msg.modifiers)
667 | msg: TextControllers.FilterTrackMsg DO
668 IF isHot(msg.controller, msg.x, msg.y, msg.modifiers) THEN
669 Track(v, f, msg.controller, msg.x, msg.y, msg.modifiers);
670 msg.done := TRUE
671 END
672 ELSE
673 END
674 END HandleCtrlMsg;
676 PROCEDURE (targ: Target) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message;
677 VAR focus: Views.View);
678 BEGIN
679 WITH msg: Controllers.TrackMsg DO TrackTarget(targ, f, msg.modifiers)
680 ELSE
681 END
682 END HandleCtrlMsg;
684 PROCEDURE (v: Link) GetCmd* (OUT cmd: ARRAY OF CHAR), NEW;
685 BEGIN
686 ASSERT(v.leftSide, 20);
687 ASSERT(v.cmd # NIL, 100);
688 cmd := v.cmd$
689 END GetCmd;
691 PROCEDURE (t: Target) GetIdent* (OUT ident: ARRAY OF CHAR), NEW;
692 BEGIN
693 ASSERT(t.leftSide, 20);
694 ASSERT(t.ident # NIL, 100);
695 ident := t.ident$
696 END GetIdent;
698 (* --------------- create commands and menu guards ------------------------ *)
700 PROCEDURE GetParam (c: TextControllers.Controller; VAR param: ARRAY OF CHAR;
701 VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER);
702 VAR rd: TextModels.Reader; i, beg, end: INTEGER;
703 ch0, ch1, ch2: CHAR;
704 BEGIN
705 param[0] := 0X;
706 IF (c # NIL) & c.HasSelection() THEN
707 c.GetSelection(beg, end);
708 IF end - beg > 4 THEN
709 rd := c.text.NewReader(NIL);
710 rd.SetPos(beg); rd.ReadChar(ch0);
711 rd.SetPos(end-2); rd.ReadChar(ch1); rd.ReadChar(ch2);
712 IF (ch0 = "<") & (ch1 = "<") & (ch2 = ">") THEN
713 rd.SetPos(beg+1); rd.ReadChar(ch0); i := 0;
714 WHILE ~rd.eot & (ch0 # ">") DO
715 IF i < LEN(param) - 1 THEN param[i] := ch0; INC(i) END;
716 rd.ReadChar(ch0)
717 END;
718 param[i] := 0X;
719 lbrBeg := beg; lbrEnd := rd.Pos();
720 rbrBeg := end -2; rbrEnd := end
721 END
722 END
723 END
724 END GetParam;
726 PROCEDURE CreateGuard* (VAR par: Dialog.Par);
727 VAR param: ARRAY 512 OF CHAR; lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
728 BEGIN
729 GetParam(TextControllers.Focus(), param, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
730 par.disabled := param = ""
731 END CreateGuard;
733 PROCEDURE InsertionAttr (c: TextControllers.Controller; pos: INTEGER): TextModels.Attributes;
734 VAR rd: TextModels.Reader; r: TextRulers.Ruler; a: TextModels.Attributes; ch: CHAR;
735 BEGIN
736 rd := c.text.NewReader(NIL); a := NIL;
737 rd.SetPos(pos); rd.ReadChar(ch); a := rd.attr;
738 IF a = NIL THEN c.view.PollDefaults(r, a) END;
739 RETURN a
740 END InsertionAttr;
742 PROCEDURE CreateLink*;
743 VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
744 left, right: Link; c: TextControllers.Controller;
745 cmd: ARRAY 512 OF CHAR;
746 op: Stores.Operation;
747 w: TextModels.Writer; a: TextModels.Attributes;
748 BEGIN
749 c := TextControllers.Focus();
750 GetParam(TextControllers.Focus(), cmd, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
751 IF cmd # "" THEN
752 w := c.text.NewWriter(NIL);
753 Models.BeginScript(c.text, "#StdLinks:Create Link", op);
754 a := InsertionAttr(c, rbrBeg);
755 c.text.Delete(rbrBeg, rbrEnd);
756 right := dir.NewLink("");
757 w.SetPos(rbrBeg);
758 IF a # NIL THEN w.SetAttr(a) END;
759 w.WriteView(right, 0, 0);
760 a := InsertionAttr(c, lbrBeg);
761 c.text.Delete(lbrBeg, lbrEnd);
762 left := dir.NewLink(cmd);
763 w.SetPos(lbrBeg);
764 IF a # NIL THEN w.SetAttr(a) END;
765 w.WriteView(left, 0, 0);
766 Models.EndScript(c.text, op)
767 END
768 END CreateLink;
770 PROCEDURE CreateTarget*;
771 VAR lbrBeg, lbrEnd, rbrBeg, rbrEnd: INTEGER;
772 left, right: Target; c: TextControllers.Controller;
773 ident: ARRAY 512 OF CHAR;
774 op: Stores.Operation;
775 w: TextModels.Writer; a: TextModels.Attributes;
776 BEGIN
777 c := TextControllers.Focus();
778 GetParam(TextControllers.Focus(), ident, lbrBeg, lbrEnd, rbrBeg, rbrEnd);
779 IF ident # "" THEN
780 w := c.text.NewWriter(NIL);
781 Models.BeginScript(c.text, "#StdLinks:Create Target", op);
782 a := InsertionAttr(c, rbrBeg);
783 c.text.Delete(rbrBeg, rbrEnd);
784 right := dir.NewTarget("");
785 w.SetPos(rbrBeg);
786 IF a # NIL THEN w.SetAttr(a) END;
787 w.WriteView(right, 0, 0);
788 a := InsertionAttr(c, lbrBeg);
789 c.text.Delete(lbrBeg, lbrEnd);
790 left := dir.NewTarget(ident);
791 w.SetPos(lbrBeg);
792 IF a # NIL THEN w.SetAttr(a) END;
793 w.WriteView(left, 0, 0);
794 Models.EndScript(c.text, op)
795 END
796 END CreateTarget;
798 PROCEDURE ShowTarget* (IN ident: ARRAY OF CHAR);
799 VAR c: TextControllers.Controller; rd: TextModels.Reader;
800 v: Views.View; left, right: Target; beg, end: INTEGER;
801 BEGIN
802 c := TextControllers.Focus();
803 IF c # NIL THEN
804 rd := c.text.NewReader(NIL);
805 REPEAT rd.ReadView(v)
806 UNTIL rd.eot OR (v # NIL) & (v IS Target) & v(Target).leftSide & (v(Target).ident^ = ident);
807 IF ~rd.eot THEN
808 GetTargetPair(v(Target), left, right);
809 IF (left # NIL) & (right # NIL) THEN
810 beg := left.context(TextModels.Context).Pos();
811 end := right.context(TextModels.Context).Pos() + 1;
812 c.SetSelection(beg, end);
813 c.view.SetOrigin(beg, 0)
814 ELSE
815 Dialog.ShowParamMsg("target '^0' not found", ident, "", "")
816 END
817 ELSE
818 Dialog.ShowParamMsg("target '^0' not found", ident, "", "")
819 END
820 END
821 END ShowTarget;
824 (* programming interface *)
826 PROCEDURE (d: StdDirectory) NewLink (IN cmd: ARRAY OF CHAR): Link;
827 VAR link: Link; i: INTEGER;
828 BEGIN
829 NEW(link); link.leftSide := cmd # "";
830 IF link.leftSide THEN
831 i := 0; WHILE cmd[i] # 0X DO INC(i) END;
832 NEW(link.cmd, i + 1); link.cmd^ := cmd$
833 ELSE
834 link.cmd := NIL
835 END;
836 link.close := ifShiftDown;
837 RETURN link
838 END NewLink;
840 PROCEDURE (d: StdDirectory) NewTarget (IN ident: ARRAY OF CHAR): Target;
841 VAR t: Target; i: INTEGER;
842 BEGIN
843 NEW(t); t.leftSide := ident # "";
844 IF t.leftSide THEN
845 i := 0; WHILE ident[i] # 0X DO INC(i) END;
846 NEW(t.ident, i + 1); t.ident^ := ident$
847 ELSE
848 t.ident := NIL
849 END;
850 RETURN t
851 END NewTarget;
853 PROCEDURE SetDir* (d: Directory);
854 BEGIN
855 ASSERT(d # NIL, 20);
856 dir := d
857 END SetDir;
859 PROCEDURE Init;
860 VAR font: Fonts.Font; d: StdDirectory;
862 PROCEDURE DefaultAppearance;
863 BEGIN font := Fonts.dir.Default(); iconFont := font.typeface;
864 linkLeft := "Link"; linkRight := "~";
865 targetLeft := "Targ"; targetRight := "~";
866 coloredBackg := TRUE
867 END DefaultAppearance;
869 BEGIN
870 NEW(d); dir := d; stdDir := d;
871 IF Dialog.platform DIV 10 = 1 THEN (* Windows *)
872 iconFont := "Wingdings";
873 font := Fonts.dir.This(iconFont, 10*Fonts.point (*arbitrary*), {}, Fonts.normal);
874 IF font.IsAlien() THEN DefaultAppearance
875 ELSE
876 linkLeft[0] := SHORT(CHR(246)); linkLeft[1] := 0X;
877 linkRight[0] := SHORT(CHR(245)); linkRight[1] := 0X;
878 targetLeft[0] := SHORT(CHR(164)); targetLeft[1] := 0X;
879 targetRight[0] := SHORT(CHR(161)); targetRight[1] := 0X;
880 coloredBackg := FALSE
881 END
882 ELSIF Dialog.platform DIV 10 = 2 THEN (* Mac *)
883 DefaultAppearance
884 ELSE
885 DefaultAppearance
886 END;
887 NEW(cleaner);
888 dialog.close.SetResources("#Std:links")
889 END Init;
891 BEGIN
892 Init
893 END StdLinks.