Dev/Mod/Dependencies.odc

MODULE DevDependencies;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		Kernel, Files, Dialog, TextMappers, TextControllers, StdDialog, StdFolds, Strings, Views, Ports, 
		Fonts, Properties, Controllers, Stores, HostMenus, HostPorts, StdCmds, Math, 
		TextModels, TextViews, Dates, DevCommanders;
	
	CONST 
		bold = 0; italic = 1;	(* used with SetStyle *)
		full = TRUE;			(* used with DependencyList *)
		implicit = TRUE; 	   (* used with GetNode *)
		
	TYPE 
		String = ARRAY 256 OF CHAR;
		
		(** Data structure types **)
		
		Subgraph = POINTER TO RECORD (Stores.Store)
			node: List;
			isImplicit: BOOLEAN;
			next: Subgraph
		END;
		SubsystemList = POINTER TO RECORD (Stores.Store)
			name:  String;
			isExpanded, isLayedout, isHidden, isBasic, isStart, isSelected: BOOLEAN;
			l, b, w, h, level: INTEGER;
			next: SubsystemList
		END;
		List = POINTER TO RECORD (Stores.Store)
			name: String;
			imports: Subgraph;
			subsystem: SubsystemList;
			l, b, w, h: INTEGER;
			isLayedout, isHidden, isStart, isSelected, isImported, onlyImplicit: BOOLEAN;
			next: List
		END;
		NameList = POINTER TO RECORD (Stores.Store)
			name: String; 
			next: NameList
		END;
		
		(** View type **)
		
		View = POINTER TO RECORD (Views.View)
			list: List;
			startList: NameList;
			subsystems: SubsystemList;
			maxLevel, nofMods: INTEGER;
			selfont, normfont: Fonts.Font;
			showBasic: BOOLEAN
		END;
		
		(** Meta types **)
		
		MetaList = POINTER TO RECORD list: List; next: MetaList END;
		MetaSSList = POINTER TO RECORD sslist: SubsystemList; next: MetaSSList END;
		
		(** Operation types **)
		
		DepOp = POINTER TO ABSTRACT RECORD (Stores.Operation)
			view: View;
			mods: MetaList; subs: MetaSSList
		END;
		ExpandOp = POINTER TO RECORD (DepOp) expand: BOOLEAN END;
		MoveOp = POINTER TO RECORD (DepOp) dx, dy, l, t, r, b: INTEGER END;
		HideOp = POINTER TO RECORD (DepOp) END;
		HideBasicOp = POINTER TO RECORD (Stores.Operation) view: View END;
		ShowAllOp = POINTER TO RECORD (DepOp) END;	
		ExpandAllOp = POINTER TO RECORD (DepOp) expand: BOOLEAN END;	
			
	(** Forward declaragions **)		

	PROCEDURE^ StartAnalysis (startList: NameList; font: Fonts.Font; incImpl: BOOLEAN; OUT v: View);
	
	(** Auxiliary procedures **)
	
	PROCEDURE RWord (reader: Files.Reader; OUT x: INTEGER);
		VAR b: BYTE; y: INTEGER;
	BEGIN
		reader.ReadByte(b); y := b MOD 256;
		reader.ReadByte(b); y := y + 100H * (b MOD 256);
		reader.ReadByte(b); y := y + 10000H * (b MOD 256);
		reader.ReadByte(b); x := y + 1000000H * b
	END RWord;
	
	PROCEDURE RNum (reader: Files.Reader; OUT x: INTEGER);
		VAR b: BYTE; s, y: INTEGER;
	BEGIN
		s := 0; y := 0; reader.ReadByte(b);
		WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); reader.ReadByte(b) END;
		x := ASH((b + 64) MOD 128 - 64, s) + y
	END RNum;
	
	PROCEDURE RName (reader: Files.Reader; OUT name: ARRAY OF CHAR);
		VAR b: BYTE; i, n: INTEGER;
	BEGIN
		i := 0; n := LEN(name) - 1; reader.ReadByte(b);
		WHILE (i < n) & (b # 0) DO name[i] := SHORT(CHR(b)); INC(i); reader.ReadByte(b) END;
		WHILE b # 0 DO reader.ReadByte(b) END;
		name[i] := 0X
	END RName;
				
	PROCEDURE GetImports(IN name: String; 
									OUT imps: POINTER TO ARRAY OF String; OUT nofImps: INTEGER; OUT found: BOOLEAN);
		VAR 
			file: Files.File; loc: Files.Locator; fileName: Files.Name; reader: Files.Reader;
			n, i, j, tmpWord: INTEGER; 
			impName, dollarStr: String; tmpImps: POINTER TO ARRAY OF String;
	BEGIN
		found := TRUE;
		StdDialog.GetSubLoc(name, "Code", loc, fileName);
		file := Files.dir.Old(loc, fileName, Files.shared);
		IF file # NIL THEN
			reader := file.NewReader(NIL); reader.SetPos(0); RWord(reader, n);
			IF n = 6F4F4346H THEN
				RWord(reader, tmpWord); RWord(reader, tmpWord); RWord(reader, tmpWord); RWord(reader, tmpWord);
				RWord(reader, tmpWord); RWord(reader, tmpWord); RNum(reader, n); RName(reader, impName); 
				i := 0; nofImps := n; IF nofImps > 0 THEN NEW(imps, nofImps) END;
				FOR i :=0 TO n - 1 DO
					RName(reader, impName); Strings.Extract(impName$, 0, 1, dollarStr);
					IF dollarStr = "$" THEN (* To avoid analysis of windows platform imports *)
						imps[i] := ""; DEC(nofImps)
					ELSE
						imps[i] := impName$
					END
				END;
				IF nofImps # n THEN (* some names are empty, delete them *)
					IF nofImps = 0 THEN 
						imps := NIL
					ELSE
						NEW(tmpImps, nofImps); j := 0;
						FOR i := 0 TO n-1 DO IF imps[i] # "" THEN tmpImps[j] := imps[i]; INC(j) END END;
						imps := tmpImps
					END
				END
			END
		ELSE 
			found := FALSE
		END
	END GetImports;
	
	PROCEDURE GetImplicitDependencies(
		IN name: String; OUT imps: POINTER TO ARRAY OF String; OUT nofImps: INTEGER
	);
		VAR deps: String; t: TextModels.Model; s: TextMappers.Scanner; i: INTEGER;
	BEGIN
		Dialog.MapString("#Dev:Implicit." + name, deps);
		IF deps # "Implicit." + name THEN
			t := TextModels.dir.NewFromString(deps); s.ConnectTo(t); s.SetPos(0); s.Scan; i := 0;
			WHILE s.type # TextMappers.eot DO
				IF s.type = TextMappers.string THEN INC(i) END;
				s.Scan
			END;
			nofImps := i; NEW(imps, nofImps); 
			s.SetPos(0); s.Scan; i := 0;
			WHILE s.type # TextMappers.eot DO
				IF s.type = TextMappers.string THEN imps[i] := s.string$; INC(i) END;
				s.Scan
			END
		ELSE
			imps := NIL; nofImps := 0
		END
	END GetImplicitDependencies;
	
	PROCEDURE GetModuleList (OUT modList: NameList);
		VAR c: TextControllers.Controller; s: TextMappers.Scanner; beg, end: INTEGER; l: NameList;
	BEGIN
		modList := NIL;
		c := TextControllers.Focus();
		IF (c # NIL) & c.HasSelection() THEN
			c.GetSelection(beg, end);
			s.ConnectTo(c.text); s.SetPos(beg); s.Scan;
			WHILE (s.start < end) & (s.type # TextMappers.invalid) DO
				IF (s.type = TextMappers.string) THEN
					NEW(l); IF modList # NIL THEN Stores.Join(modList, l) END;
					l.next := modList; l.name := s.string$; modList := l; s.Scan
				ELSE
					s.Scan
				END
			END
		END
	END GetModuleList;
	
	(** List **)
	
	PROCEDURE (l: List) GetExtent(OUT w, h: INTEGER), NEW;
	BEGIN
		IF l.subsystem.isExpanded THEN w := l.w; h:= l.h
		ELSE w := l.subsystem.w; h := l.subsystem.h END
	END GetExtent;

	PROCEDURE (l: List) GetPosition(OUT x, y: INTEGER), NEW;
	BEGIN
		IF l.subsystem.isExpanded THEN x := l.l; y:= l.b
		ELSE x := l.subsystem.l; y := l.subsystem.b END
	END GetPosition;
	
	PROCEDURE (l: List) SetPosition(x, y: INTEGER), NEW;
	BEGIN
		IF x < 1 THEN x := 1 END; IF y < 1 THEN y := 1 END; (* To keep objects in the second quadrant *)
		IF l.subsystem.isExpanded THEN  l.l := x; l.b:= y
		ELSE l.subsystem.l := x; l.subsystem.b := y END
	END SetPosition;
	
	PROCEDURE (l: List) Selected(): BOOLEAN, NEW;
	BEGIN
		RETURN l.subsystem.isExpanded & l.isSelected
	END Selected;
	
	PROCEDURE (l: List) Visible(showBasic: BOOLEAN): BOOLEAN, NEW;
	BEGIN
		RETURN l.subsystem.isExpanded
			& ~l.isHidden & ~l.subsystem.isHidden & (~l.subsystem.isBasic OR showBasic)
	END Visible;
	
	
	(** SubsystemList **)
	
	PROCEDURE (s: SubsystemList) Selected(): BOOLEAN, NEW;
	BEGIN
		RETURN ~s.isExpanded & s.isSelected
	END Selected;
	
	PROCEDURE (s: SubsystemList) Visible(showBasic: BOOLEAN): BOOLEAN, NEW;
	BEGIN
		RETURN ~s.isExpanded & ~s.isHidden & (~s.isBasic OR showBasic)
	END Visible;
	
	
	(** View **)
	
	PROCEDURE (v: View) GetNode (name: String; incImpl: BOOLEAN; VAR node: List), NEW;
		VAR 
			tmpList, tmpNode: List; sl: NameList;
			tmpGraph, prevGraph: Subgraph;
			nofImps, i: INTEGER; found: BOOLEAN;
			head, tail: String;
			sslist: SubsystemList;
			imps: POINTER TO ARRAY OF String;
	BEGIN
		(* First check if a node with the sought name exists in the nodeList. 
		   Otherwise build a new subgraph from objectfiles. *)
		tmpList := v.list;
		WHILE (tmpList # NIL) & (tmpList.name # name) DO tmpList := tmpList.next END;
		IF tmpList # NIL THEN
			node := tmpList
		ELSE
			(* Create a new node from an objectfile. *)
			GetImports(name, imps, nofImps, found); 
			IF found THEN
				NEW(tmpList); Stores.Join(v, tmpList); INC(v.nofMods);
				tmpList.name := name; 
				(* if subsystem exists then use it otherwise create a new one *) 
				Kernel.SplitName(name, head, tail); IF head = "" THEN head := "System" END;
				sslist := v.subsystems;
				WHILE (sslist # NIL) & (sslist.name # head) DO sslist := sslist.next END;
				IF sslist = NIL THEN
					NEW (sslist); Stores.Join(v, sslist); sslist.name := head; sslist.next := v.subsystems;
					sslist.level := v.maxLevel; sslist.isExpanded := FALSE;
					v.subsystems := sslist 
				END;
				sl := v.startList; (* If it is one of the start modules it should be expanded *)
				WHILE (sl # NIL) & (sl.name # name) DO sl := sl.next END; 
				IF sl # NIL THEN
					sslist.isExpanded := TRUE; sslist.level := 1; sslist.isStart := TRUE; tmpList.isStart := TRUE
				END;
				tmpList.subsystem := sslist; tmpList.imports := NIL; 
				tmpList.next := v.list; v.list := tmpList; tmpGraph := NIL;
				FOR i := 0 TO nofImps - 1 DO
					prevGraph := tmpGraph; NEW(tmpGraph); tmpGraph.isImplicit := FALSE; Stores.Join(v, tmpGraph);
					v.GetNode(imps[i], incImpl, tmpNode);
					tmpNode.isImported := TRUE; (* to be able to identify root modules *)
					tmpGraph.node := tmpNode; tmpGraph.next := prevGraph
				END;
				IF incImpl THEN
					GetImplicitDependencies(name, imps, nofImps);
					FOR i := 0 TO nofImps - 1 DO
						prevGraph := tmpGraph; NEW(tmpGraph); tmpGraph.isImplicit := TRUE; Stores.Join(v, tmpGraph);
						v.GetNode(imps[i], incImpl, tmpNode);
						tmpGraph.node := tmpNode; tmpGraph.next := prevGraph
					END
				END;
				tmpList.imports := tmpGraph; node := tmpList
			ELSE 
				Dialog.ShowParamMsg("#Dev:ModuleNotFound", name, "", "")
			END		
		END
	END GetNode;
	
	PROCEDURE (v: View) OnSelectedObject(x, y: INTEGER): BOOLEAN, NEW;
		VAR 
			l: List; s: SubsystemList;
	BEGIN
		l := v.list; 
		WHILE l # NIL DO
			IF l.Visible(v.showBasic) &  l.Selected() & (x > l.l) & (x < l.l + l.w) & (y < l.b) & (y > l.b - l.h) THEN
				RETURN TRUE
			END;
			l := l.next
		END;
		s := v.subsystems;
		WHILE s # NIL DO
			IF s.Visible(v.showBasic) & s.Selected() & (x > s.l) & (x < s.l + s.w) & (y < s.b) & (y > s.b - s.h) THEN
				RETURN TRUE
			END;
			s := s.next
		END;
		RETURN FALSE
	END OnSelectedObject;
	
	PROCEDURE (v: View) OnObject(x, y: INTEGER): BOOLEAN, NEW;
		VAR 
			l: List; s: SubsystemList;
	BEGIN
		l := v.list; 
		WHILE l # NIL DO
			IF l.Visible(v.showBasic) & (x > l.l) & (x < l.l + l.w) & (y < l.b) & (y > l.b - l.h) THEN
				RETURN TRUE
			END;
			l := l.next
		END;
		s := v.subsystems;
		WHILE s # NIL DO
			IF s.Visible(v.showBasic) & (x > s.l) & (x < s.l + s.w) & (y < s.b) & (y > s.b - s.h) THEN
				RETURN TRUE
			END;
			s := s.next
		END;
		RETURN FALSE
	END OnObject;
	
	PROCEDURE OverLap(l1, t1, r1, b1, l2, t2, r2, b2: INTEGER): BOOLEAN;
	BEGIN
		RETURN  ~((l1 > r2) OR (l2 > r1) OR (t1 > b2) OR (t2 > b1))
	END OverLap;
	
	PROCEDURE (v: View) Select(x1, y1, x2, y2: INTEGER; modifiers: SET), NEW;
		VAR l: List; s: SubsystemList;
	BEGIN
		l := v.list; 
		WHILE l # NIL DO
			IF l.Visible(v.showBasic) & OverLap(l.l, l.b - l.h, l.l + l.w, l.b, x1, y1, x2, y2) THEN 
				IF (Controllers.extend IN modifiers) OR (Controllers.modify IN modifiers) THEN
					l.isSelected := ~l.isSelected
				ELSE
					l.isSelected := TRUE
				END
			ELSE
				IF ~(Controllers.extend IN modifiers) & ~(Controllers.modify IN modifiers) THEN l.isSelected := FALSE END
			END;
			l := l.next
		END;
		s := v.subsystems;
		WHILE s # NIL DO
			IF s.Visible(v.showBasic) & OverLap(s.l, s.b - s.h, s.l + s.w, s.b, x1, y1, x2, y2)  THEN 
				IF (Controllers.extend IN modifiers) OR (Controllers.modify IN modifiers) THEN
					s.isSelected := ~s.isSelected
				ELSE
					s.isSelected := TRUE
				END
			ELSE
				IF ~(Controllers.extend IN modifiers) & ~(Controllers.modify IN modifiers) THEN
					s.isSelected := FALSE
				END
			END;
			s := s.next
		END
	END Select;
	
	PROCEDURE (v: View) SelectAll(set: BOOLEAN), NEW;
		VAR l: List; s: SubsystemList;
	BEGIN
		l := v.list; 
		WHILE l # NIL DO l.isSelected := set & l.Visible(v.showBasic); l := l.next END;
		s := v.subsystems;
		WHILE s # NIL DO s.isSelected := set & s.Visible(v.showBasic); s := s.next END;
		Views.Update(v, Views.keepFrames)
	END SelectAll;
		

	(** Operations on the View **)
	
	PROCEDURE (dop: DepOp) AddSelection(), NEW;
		VAR ml: MetaList; ms: MetaSSList; l: List; s: SubsystemList;
	BEGIN
		ASSERT(dop.view # NIL, 20);
		l := dop.view.list; 
		WHILE l # NIL DO
			IF l.Selected() THEN NEW(ml); ml.list := l; ml.next := dop.mods; dop.mods := ml END; l := l.next
		END;
		s := dop.view.subsystems;
		WHILE s # NIL DO
			IF s.Selected() THEN NEW(ms); ms.sslist := s; ms.next := dop.subs; dop.subs := ms END; s := s.next
		END
	END AddSelection;
	
	PROCEDURE (e: ExpandOp) Do;
		VAR l: MetaList; s: MetaSSList;
	BEGIN
		l := e.mods;
		WHILE l # NIL DO l.list.subsystem.isExpanded := e.expand; l := l.next END;
		s := e.subs;
		WHILE s # NIL DO s.sslist.isExpanded := e.expand; s := s.next END;
		e.expand := ~e.expand;
		Views.Update(e.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (m: MoveOp) BoundingBox, NEW;
		VAR l: MetaList; s: MetaSSList; h, d, w: INTEGER;
	BEGIN
		m.l := MAX(INTEGER); m.t := m.l; m.b := 0; m.r := 0;
		l := m.mods;
		WHILE l # NIL DO
			IF (l.list.l < m.l) THEN m.l := l.list.l END;
			IF (l.list.b - l.list.h < m.t) THEN m.t := l.list.b - l.list.h END;
			IF (l.list.l + l.list.w >  m.r) THEN m.r := l.list.l + l.list.w END;
			IF (l.list.b > m.b) THEN m.b := l.list.b END;
			l := l.next 
		END;
		s := m.subs;
		WHILE s # NIL DO
			IF (s.sslist.l < m.l) THEN m.l := s.sslist.l END;
			IF (s.sslist.b - s.sslist.h < m.t) THEN m.t := s.sslist.b - s.sslist.h END;
			IF (s.sslist.l + s.sslist.w >  m.r) THEN m.r := s.sslist.l + s.sslist.w END;
			IF (s.sslist.b > m.b) THEN m.b := s.sslist.b END;
			s := s.next 
		END;
		m.view.selfont.GetBounds(h, d, w);
		m.b := m.b + d; (* correction for descent *)
		m.r := m.r + w; m.l := m.l - w (* correction for incorrect values by italic fonts *)
	END BoundingBox;
	
	PROCEDURE (m: MoveOp) Do;
		VAR l: MetaList; s: MetaSSList;
	BEGIN
		l := m.mods;
		WHILE l # NIL DO l.list.l := l.list.l + m.dx; l.list.b := l.list.b + m.dy; l := l.next END;
		s := m.subs;
		WHILE s # NIL DO s.sslist.l := s.sslist.l + m.dx; s.sslist.b := s.sslist.b + m.dy; s := s.next END;
		m.dx := -m.dx; m.dy := -m.dy;
		Views.Update(m.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (h: HideOp) Do;
		VAR l: MetaList; s: MetaSSList;
	BEGIN
		l := h.mods;
		WHILE l # NIL DO l.list.isHidden := ~l.list.isHidden; l := l.next END;
		s := h.subs;
		WHILE s # NIL DO s.sslist.isHidden := ~s.sslist.isHidden; s := s.next END;
		Views.Update(h.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (h: HideBasicOp) Do;
	BEGIN
		h.view.showBasic := ~h.view.showBasic;
		Views.Update(h.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (s: ShowAllOp) Do;
		VAR ml: MetaList; mssl: MetaSSList;
	BEGIN
		ml := s.mods; mssl := s.subs;
		WHILE ml # NIL DO ml.list.isHidden := ~ml.list.isHidden; ml := ml.next END;
		WHILE mssl # NIL DO mssl.sslist.isHidden := ~mssl.sslist.isHidden; mssl := mssl.next END;
		Views.Update(s.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (e: ExpandAllOp) Do;
		VAR mssl: MetaSSList;
	BEGIN
		mssl := e.subs;
		WHILE mssl # NIL DO mssl.sslist.isExpanded := e.expand; mssl := mssl.next END;
		e.expand := ~e.expand;
		Views.Update(e.view, Views.keepFrames)
	END Do;
	
	PROCEDURE (v: View) ExpandCollapse(expand: BOOLEAN), NEW;
		VAR e: ExpandOp;
	BEGIN
		NEW(e); e.view := v; e.AddSelection; e.expand := expand;
		IF e.expand THEN e.mods := NIL ELSE e.subs := NIL END;
		Views.Do(v, "Toggle Expand/Collapse", e)
	END ExpandCollapse;
	
	
	(** Redrawing the view **)
	
	PROCEDURE (v: View) SetExtents, NEW;
		VAR tmpList: List; ssList: SubsystemList; h, d, w: INTEGER;
	BEGIN
		tmpList := v.list; v.selfont.GetBounds(h, d, w);
		WHILE tmpList # NIL DO
			tmpList.w := v.selfont.StringWidth(tmpList.name); tmpList.h := h; tmpList := tmpList.next
		END;
		ssList := v.subsystems;
		WHILE ssList # NIL DO
			ssList.w := v.selfont.StringWidth("[" + ssList.name + "]"); ssList.h := h; ssList := ssList.next
		END
	END SetExtents;
	
	PROCEDURE (v: View)  Layout, NEW;
		CONST space = 5 * Ports.mm;
		VAR
			width, height, xindent, yindent, level: INTEGER;
			levelIndent: POINTER TO ARRAY OF INTEGER;
			tmpList: List; 
	BEGIN
		NEW(levelIndent, v.maxLevel + 1); v.context.GetSize(width, height);
		tmpList := v.list;
		WHILE tmpList # NIL DO
			IF tmpList.isStart THEN 
				yindent := space; level := 0 
			ELSE 
				level := tmpList.subsystem.level;
				yindent := space + (15 * Ports.mm * level)
			END;
			xindent := space + levelIndent[level];
			WHILE xindent + v.normfont.StringWidth(tmpList.name) > width DO
				xindent := xindent - width;
				yindent := yindent + (4 * Ports.mm)
			END;
			IF  ~tmpList.subsystem.isBasic OR v.showBasic THEN
				IF tmpList.subsystem.isExpanded THEN
					IF ~tmpList.isHidden & ~tmpList.isLayedout THEN
						levelIndent[level] := levelIndent[level] + tmpList.w + space;
						tmpList.SetPosition(xindent, yindent); tmpList.isLayedout := TRUE
					END
				ELSIF ~ tmpList.subsystem.isHidden & ~tmpList.subsystem.isLayedout THEN
					levelIndent[level] := levelIndent[level] + tmpList.subsystem.w + space;
					tmpList.SetPosition(xindent, yindent); tmpList.subsystem.isLayedout := TRUE
				END
			END;
			tmpList := tmpList.next
		END
	END Layout;
	
	PROCEDURE (v: View) DrawArrow(f: Views.Frame; ax, ay, bx, by, s: INTEGER), NEW;
		CONST ArrowLen = 1 * Ports.mm;
		TYPE Vector = RECORD x, y: REAL END;
		VAR a, b, c, d, e, v1, v2: Vector; lenc, m, x, y: REAL; p: ARRAY 3 OF Ports.Point;
	BEGIN
		a.x := ax; a.y := ay; b.x := bx; b.y := by; c.x := b.x - a.x; c.y := b.y - a.y;
		m := MAX(ABS(c.x), ABS(c.y)); x := c.x / m; y := c.y / m;
		lenc := m * Math.Sqrt(x * x + y * y); s := MAX(1, SHORT(ENTIER(1.5 * s)) DIV Ports.point); (* scaling factor *)
		e.x := c.x * s / lenc; e.y := c.y * s / lenc; 
		d.x := e.y; d.y := - e.x; (* first orthogonal vector *)
		v1.x := (e.x + d.x) * ArrowLen; v1.y := (e.y + d.y) * ArrowLen; 
		v1.x := -v1.x; v1.y := -v1.y; (* mirror vector *)
		d.x := -d.x; d.y := -d.y; (* second orthogonal vector *)
		v2.x := (e.x + d.x) * ArrowLen; v2.y := (e.y + d.y) * ArrowLen; 
		v2.x := -v2.x; v2.y := -v2.y; (* mirror vector *)
		p[0].x := SHORT(ENTIER(b.x));p[0].y := SHORT(ENTIER(b.y));
		p[1].x := SHORT(ENTIER(b.x + v1.x)); p[1].y := SHORT(ENTIER(b.y + v1.y));
		p[2].x := SHORT(ENTIER(b.x + v2.x)); p[2].y := SHORT(ENTIER(b.y + v2.y));
		f.DrawPath(p, 3, Ports.fill, Ports.black, Ports.closedPoly)
	END DrawArrow;
	
	PROCEDURE (v: View)  DrawDependencies (f: Views.Frame; l, t, r, b: INTEGER), NEW;
		VAR
			xindent, yindent, startx, starty, middlex, middley, sx, sy, thickness: INTEGER;
			subgraph: Subgraph; tmpList: List; s: SubsystemList;
	BEGIN
		thickness := MAX(2, (v.normfont.size DIV 8));
		f.DrawRect(l, t, r, b, Ports.fill, Ports.white);
		tmpList := v.list;
		WHILE tmpList # NIL DO
			IF tmpList.Visible(v.showBasic) OR tmpList.subsystem.Visible(v.showBasic) THEN
				subgraph := tmpList.imports;
				tmpList.GetPosition(startx, starty);
				WHILE subgraph # NIL DO
					IF subgraph.node.Visible(v.showBasic) OR subgraph.node.subsystem.Visible(v.showBasic) THEN
						subgraph.node.GetPosition(sx, sy);
						middlex := ABS(startx - ((startx - sx) DIV 2));
						middley := ABS(starty - ((starty - sy) DIV 2));
						IF ~subgraph.isImplicit THEN
							f.DrawLine(startx, starty, middlex, middley, thickness, Ports.red);
							f.DrawLine(middlex, middley, sx, sy, thickness, Ports.blue)
						ELSE
							f.DrawLine(startx, starty, middlex, middley, thickness, Ports.grey25);
							f.DrawLine(middlex, middley, sx, sy, thickness, Ports.grey25)
						END;
						IF (middlex # startx) OR (middley # starty) THEN
							v.DrawArrow(f, startx, starty, middlex, middley, thickness)
						END
					END;
					subgraph := subgraph.next
				END
			END;
			tmpList := tmpList.next
		END;
		(* Draw the names of the modules last, so they end up on top *)
		tmpList := v.list;
		WHILE tmpList # NIL DO
			IF tmpList.Visible(v.showBasic) THEN
				tmpList.GetPosition(xindent, yindent);
				IF tmpList.Selected() THEN
					f.DrawString(xindent, yindent, Ports.black, tmpList.name, v.selfont)
				ELSE
					f.DrawString(xindent, yindent, Ports.black, tmpList.name, v.normfont)
				END;
				f.DrawOval(xindent - (Ports.mm DIV 2), yindent - (Ports.mm DIV 2), xindent + (Ports.mm DIV 2), yindent + 
					(Ports.mm DIV 2), Ports.fill, Ports.black)
			END;
			tmpList := tmpList.next
		END;
		s := v.subsystems;
		WHILE s # NIL DO
			IF s.Visible(v.showBasic) THEN
				xindent := s.l; yindent := s.b;
				IF s.Selected() THEN
					f.DrawString(xindent, yindent, Ports.black, "[" + s.name + "]", v.selfont)
				ELSE
					f.DrawString(xindent, yindent, Ports.black, "[" + s.name + "]", v.normfont)
				END;
				f.DrawOval(xindent - (Ports.mm DIV 2), yindent - (Ports.mm DIV 2), xindent + (Ports.mm DIV 2), yindent + 
					(Ports.mm DIV 2), Ports.fill, Ports.black)
			END;
			s := s.next
		END
	END DrawDependencies;
	
	PROCEDURE (v: View)  Restore (f: Views.Frame; l, t, r, b: INTEGER);
	BEGIN
		v.Layout();
		v.DrawDependencies(f, l, t, r, b)
	END Restore;
	
	
	(** Handle view messages **)
	
	PROCEDURE (v: View) SetProps(p: Properties.Property), NEW;
		VAR 
			size: INTEGER;
			typeface: Fonts.Typeface;
			prop: Properties.StdProp;
			style: SET;
	BEGIN
		WHILE (p # NIL) & ~(p IS Properties.StdProp) DO p := p.next END;
		IF p # NIL THEN
			prop := p(Properties.StdProp); size := v.normfont.size; 
			typeface := v.normfont.typeface; style := v.normfont.style;
			IF Properties.size IN prop.valid THEN size := prop.size END;
			IF Properties.typeface IN prop.valid THEN typeface := prop.typeface END;
			IF Properties.style IN prop.valid THEN 
				IF Fonts.underline IN prop.style.mask THEN
					IF Fonts.underline IN prop.style.val THEN style := style + {Fonts.underline} 
					ELSE style := style - {Fonts.underline} END
				END;
				IF Fonts.italic IN prop.style.mask THEN
					IF Fonts.italic IN prop.style.val THEN style := style + {Fonts.italic}
					ELSE style := style - {Fonts.italic} END
				END;
				IF Fonts.strikeout IN prop.style.mask THEN
					IF Fonts.strikeout IN prop.style.val THEN style := style + {Fonts.strikeout}
					ELSE style := style - {Fonts.strikeout} END
				END
			END;
			v.normfont := Fonts.dir.This(typeface, size, style, Fonts.normal);
			v.selfont := Fonts.dir.This(typeface, size, style, Fonts.bold); v.SetExtents();
			Views.Update(v, Views.keepFrames)
		END
	END SetProps;
	
	PROCEDURE (v: View) GetProps(OUT p: Properties.Property), NEW;
		VAR
			prop: Properties.StdProp;
	BEGIN
			NEW(prop); prop.known := {Properties.weight, Properties.size, Properties.typeface, Properties.style};
			prop.valid := {Properties.weight, Properties.size, Properties.typeface, Properties.style};
			prop.typeface := v.normfont.typeface; prop.size := v.normfont.size; prop.weight := v.normfont.weight; 
			prop.style.val := v.normfont.style; prop.style.mask := v.normfont.style;
			p := prop
	END GetProps;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
		CONST min = 50 * Ports.mm; max = 500 * Ports.mm;
	BEGIN
		WITH msg: Properties.SizePref DO
			IF (msg.w = Views.undefined) OR (msg.h = Views.undefined) THEN
				 msg.w := 200 * Ports.mm; msg.h := 100 * Ports.mm
			ELSE
				Properties.ProportionalConstraint(2, 1, msg.fixedW, msg.fixedH,
										msg.w, msg.h);
				IF msg.h < min THEN
					msg.h := min; msg.w := 2 * min
				ELSIF msg.h > max THEN
					msg.h := max; msg.w := 2 * max
				END
			END
		| msg: Properties.ResizePref DO
			msg.horFitToWin := TRUE; msg.verFitToWin := TRUE
		| msg: Properties.FocusPref DO
			msg.setFocus := TRUE
		| msg: Properties.PollMsg DO
			v.GetProps(msg.prop)
		| msg: Properties.SetMsg DO
			v.SetProps(msg.prop)
		ELSE	(* ignore other messages *)
		END
	END HandlePropMsg;
	
	PROCEDURE (v: View) HandleMultiSelect (f: Views.Frame; VAR msg: Controllers.TrackMsg), NEW;
		VAR
			x, y, x1, y1: INTEGER; 
			isDown, first: BOOLEAN; m: SET;
	BEGIN
		first := TRUE; x1 := -1; y1 := -1;
		REPEAT 
			f.Input(x, y, m, isDown); 
			IF (x1 # x) OR (y1 # y) THEN
				IF first THEN
					first := FALSE
				ELSE
					f.MarkRect(MIN(x1, msg.x), MIN(y1, msg.y), MAX(x1, msg.x), MAX(y1, msg.y), 0, Ports.dim50, FALSE)
				END;
				x1 := x; y1 := y;
				f.MarkRect(MIN(x1, msg.x), MIN(y1, msg.y), MAX(x1, msg.x), MAX(y1, msg.y), 0, Ports.dim50, TRUE)
			END
		UNTIL ~isDown;
		f.MarkRect(MIN(x1, msg.x), MIN(y1, msg.y), MAX(x1, msg.x), MAX(y1, msg.y), 0, Ports.dim50, FALSE);
		v.Select(MIN(x1, msg.x), MIN(y1, msg.y), MAX(x1, msg.x), MAX(y1, msg.y), msg.modifiers);
		Views.Update(v, Views.keepFrames)
	END HandleMultiSelect;
	
	PROCEDURE (v: View) HandleMove (f: Views.Frame; VAR msg: Controllers.TrackMsg), NEW;
		VAR
			x1, y1, x, y, res: INTEGER; mo: MoveOp; m: SET; isDown: BOOLEAN;
			ml: MetaList; ms: MetaSSList;
	BEGIN
		NEW(mo); mo.view := v; mo.AddSelection; mo.BoundingBox;
		x1 := msg.x; y1 := msg.y;
		f.SaveRect(f.l, f.t, f.r, f.b, res);
		REPEAT 
			f.Input(x, y, m, isDown); 
			IF (res = 0) & ((x # x1) OR (y # y1)) THEN
				x1 := x; y1 := y;
				f.RestoreRect(mo.l + mo.dx, mo.t + mo.dy, mo.r + mo.dx, mo.b + mo.dy, Ports.keepBuffer);
				mo.dx := x - msg.x; mo.dy := y - msg.y; 
				IF mo.l + mo.dx < f.l THEN mo.dx := f.l - mo.l END; IF mo.r + mo.dx > f.r THEN mo.dx := f.r - mo.r END;
				IF mo.t + mo.dy < f.t THEN mo.dy := f.t - mo.t END; IF mo.b + mo.dy > f.b THEN mo.dy := f.b - mo.b END;
				ml := mo.mods;
				WHILE ml # NIL DO
					f.DrawString(ml.list.l + mo.dx, ml.list.b + mo.dy, Ports.grey50, ml.list.name, v.selfont); ml := ml.next
				END;
				ms := mo.subs;
				WHILE ms # NIL DO
					f.DrawString(ms.sslist.l + mo.dx, ms.sslist.b + mo.dy, Ports.grey50, '[' + ms.sslist.name + ']', v.selfont); 
					ms := ms.next
				END
			END
		UNTIL ~isDown;
		f.RestoreRect(f.l, f.t, f.r, f.b, Ports.disposeBuffer);
		Views.Do(v, "Move", mo)
	END HandleMove;
	
	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;  VAR focus: Views.View);
		CONST movedist = Ports.mm * Ports.mm; arrowdist = Ports.mm;
		VAR
			w, h, x, y, delta: INTEGER; m: SET; 
			isDown, isMove: BOOLEAN;
			mo: MoveOp; e: ExpandOp;
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			IF HostPorts.right IN msg.modifiers THEN
				HostMenus.PopupMenu
			ELSIF (Controllers.doubleClick IN msg.modifiers) THEN
				IF v.OnSelectedObject(msg.x, msg.y) THEN
					NEW(e); e.view := v; e.AddSelection;
					IF (e.mods # NIL) & (e.subs = NIL) & (e.mods.next = NIL) THEN
						e.expand := FALSE; Views.Do(v, "Collapse " + e.mods.list.name, e)
					ELSIF (e.mods = NIL) & (e.subs # NIL) & (e.subs.next = NIL) THEN
						e.expand := TRUE; Views.Do(v, "Expand " + e.subs.sslist.name, e)
					END
				END
			ELSE
				isMove := FALSE;
				REPEAT 
					f.Input(x, y, m, isDown); 	
					IF ~isMove & ((ABS(x - msg.x) * ABS(x - msg.x) + ABS(y - msg.y) * ABS(y - msg.y)) > movedist) THEN
						isMove := TRUE
					END	
				UNTIL ~isDown OR isMove;
				IF isMove THEN
					IF v.OnSelectedObject(msg.x, msg.y) THEN 
						v.HandleMove(f, msg) 
					ELSIF v.OnObject(msg.x, msg.y) THEN
						v.Select(msg.x, msg.y, msg.x, msg.y, {}); v.HandleMove(f, msg)
					ELSE v.HandleMultiSelect(f, msg) END
				ELSE
					v.Select(msg.x, msg.y, msg.x, msg.y, msg.modifiers); Views.Update(v, Views.keepFrames)
				END
			END
		| msg: Controllers.PollOpsMsg DO
			msg.valid := {Controllers.copy}; msg.selectable := TRUE; msg.type := "DevDependencies.View"
		| msg: Properties.CollectMsg DO
			v.GetProps(msg.poll.prop)
		| msg: Properties.EmitMsg DO
			v.SetProps(msg.set.prop); v.context.GetSize(w, h); v.Restore(f, 0, 0, w, h)
		| msg: Controllers.SelectMsg DO
			v.SelectAll(msg.set)
		| msg: Controllers.EditMsg DO
			IF (msg.op = Controllers.pasteChar) & (ORD(msg.char) >= 28) & (ORD(msg.char) <= 31) THEN
				NEW(mo); mo.view := v; mo.AddSelection; mo.BoundingBox; mo.dx := 0; mo.dy := 0;
				IF Controllers.modify IN msg.modifiers THEN delta := f.unit ELSE delta := arrowdist END;
				CASE msg.char OF
				| CHR(28): mo.dx := -delta | CHR(29): mo.dx := delta 
				| CHR(30): mo.dy := -delta | CHR(31): mo.dy := delta
				END;
				IF mo.l + mo.dx < f.l THEN mo.dx := f.l - mo.l END; IF mo.r + mo.dx > f.r THEN mo.dx := f.r - mo.r END;
				IF mo.t + mo.dy < f.t THEN mo.dy := f.t - mo.t END; IF mo.b + mo.dy > f.b THEN mo.dy := f.b - mo.b END;
				IF (mo.dy # 0) OR (mo.dx # 0) THEN Views.Do(v, "Move", mo) END
			END
		ELSE (* Ignore other messages *)
		END
	END HandleCtrlMsg;

	
	(** Internalize/Externalize and Copy **)
	
	PROCEDURE (s: SubsystemList) Internalize (VAR rd: Stores.Reader);
		VAR 
			store: Stores.Store;
	BEGIN
		rd.ReadString(s.name); rd.ReadBool(s.isExpanded);
		rd.ReadBool(s.isLayedout); rd.ReadBool(s.isHidden); rd.ReadBool(s.isBasic); rd.ReadBool(s.isStart);
		rd.ReadInt(s.l); rd.ReadInt(s.b); rd.ReadInt(s.w); rd.ReadInt(s.h); rd.ReadInt(s.level);
		rd.ReadStore(store); 
		IF store # NIL THEN
			s.next := store(SubsystemList)
		ELSE
			s.next := NIL
		END
	END Internalize;

	PROCEDURE (s: SubsystemList) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteString(s.name); wr.WriteBool(s.isExpanded);
		wr.WriteBool(s.isLayedout);wr.WriteBool(s.isHidden); wr.WriteBool(s.isBasic); wr.WriteBool(s.isStart);
		wr.WriteInt(s.l); wr.WriteInt(s.b); wr.WriteInt(s.w); wr.WriteInt(s.h); wr.WriteInt(s.level);
		wr.WriteStore(s.next)
	END Externalize;
	
	PROCEDURE (l: List) Internalize (VAR rd: Stores.Reader);
		VAR 
			store: Stores.Store;
	BEGIN
		rd.ReadString(l.name); rd.ReadInt(l.l); rd.ReadInt(l.b); rd.ReadInt(l.w); rd.ReadInt(l.h);
		rd.ReadBool(l.isLayedout); rd.ReadBool(l.isHidden); rd.ReadBool(l.isStart);
		rd.ReadStore(store); l.subsystem := store(SubsystemList);
		rd.ReadStore(store); 
		IF store # NIL THEN l.imports := store(Subgraph) ELSE l.imports := NIL END;
		rd.ReadStore(store); 
		IF store # NIL THEN l.next := store(List) ELSE l.next := NIL END
	END Internalize;

	PROCEDURE (l: List) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteString(l.name); wr.WriteInt(l.l); wr.WriteInt(l.b); wr.WriteInt(l.w); wr.WriteInt(l.h);
		wr.WriteBool(l.isLayedout);wr.WriteBool(l.isHidden); wr.WriteBool(l.isStart);
		wr.WriteStore(l.subsystem); wr.WriteStore(l.imports); 
		wr.WriteStore(l.next)
	END Externalize;
	
	PROCEDURE (l: NameList) Internalize (VAR rd: Stores.Reader);
		VAR 
			store: Stores.Store;
	BEGIN
		rd.ReadString(l.name); 
		rd.ReadStore(store); 
		IF store # NIL THEN l.next := store(NameList) ELSE l.next := NIL END
	END Internalize;

	PROCEDURE (l: NameList) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteString(l.name); wr.WriteStore(l.next)
	END Externalize;
	
	PROCEDURE (g: Subgraph) Internalize (VAR rd: Stores.Reader);
		VAR 
			store: Stores.Store;
	BEGIN
		rd.ReadBool(g.isImplicit);
		rd.ReadStore(store); g.node := store(List); 
		rd.ReadStore(store);
		IF store # NIL THEN g.next := store(Subgraph) ELSE g.next := NIL END
	END Internalize;

	PROCEDURE (g: Subgraph) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteBool(g.isImplicit); wr.WriteStore(g.node); wr.WriteStore(g.next) 
	END Externalize;

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR 
			version, size: INTEGER;
			store: Stores.Store;
			typeface: Fonts.Typeface;
			style: SET;
	BEGIN
		rd.ReadVersion(0, 0, version);
		IF ~rd.cancelled THEN
			rd.ReadInt(v.maxLevel); rd.ReadBool(v.showBasic);
			rd.ReadString(typeface); rd.ReadInt(size); rd.ReadSet(style);
			v.normfont := Fonts.dir.This(typeface, size, style, Fonts.normal);
			v.selfont := Fonts.dir.This(typeface, size, style, Fonts.bold);
			rd.ReadStore(store); v.startList := store(NameList); 
			rd.ReadStore(store); v.subsystems := store(SubsystemList);
			rd.ReadStore(store); v.list := store(List)
		END
	END Internalize;
		
	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteVersion(0);
		wr.WriteInt(v.maxLevel); wr.WriteBool(v.showBasic);
		wr.WriteString(v.normfont.typeface); wr.WriteInt(v.normfont.size); wr.WriteSet(v.normfont.style);
		wr.WriteStore(v.startList); wr.WriteStore(v.subsystems); wr.WriteStore(v.list)
	END Externalize;
	
	PROCEDURE (s: SubsystemList) CopyFrom(source: Stores.Store);
	BEGIN
		WITH source: SubsystemList DO
			s.name := source.name;
			s.isExpanded := source.isExpanded; 
			s.isLayedout := source.isLayedout;
			s.isHidden := source.isHidden;
			s.isBasic := source.isBasic;
			s.isStart := source.isStart;
			s.l := source.l; s.b := source.b; s.w := source.w; s.h := source.h; s.level := source.level;
			IF source.next # NIL THEN s.next := Stores.CopyOf(source.next)(SubsystemList) END
		END
	END CopyFrom;
	
	PROCEDURE (l: List) CopyFrom(source: Stores.Store);
	BEGIN
		WITH source: List DO
			l.name := source.name; l.l := source.l; l.b := source.b; l.w := source.w; l.h := source.h;  
			l.isLayedout := source.isLayedout; l.isHidden := source.isHidden; l.isStart := source.isStart;
			IF source.imports # NIL THEN l.imports := Stores.CopyOf(source.imports)(Subgraph) END;
			IF source.subsystem # NIL THEN
				 l.subsystem := Stores.CopyOf(source.subsystem)(SubsystemList)
			END;
			IF source.next # NIL THEN l.next := Stores.CopyOf(source.next)(List) END
		END
	END CopyFrom;

	PROCEDURE (l: NameList) CopyFrom(source: Stores.Store);
	BEGIN
		WITH source: NameList DO
			l.name := source.name;
			IF source.next # NIL THEN l.next := Stores.CopyOf(source.next)(NameList) END
		END
	END CopyFrom;
	
	PROCEDURE (g: Subgraph) CopyFrom(source: Stores.Store);
	BEGIN
		WITH source: Subgraph DO
			g.isImplicit := source.isImplicit;
			IF source.node # NIL THEN g.node := Stores.CopyOf(source.node)(List) END;
			IF source.next # NIL THEN g.next := Stores.CopyOf(source.next)(Subgraph) END
		END
	END CopyFrom;
	
	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		WITH source: View DO
			v.maxLevel := source.maxLevel; 
			v.normfont := source.normfont;
			v.selfont := source.selfont;
			v.showBasic := source.showBasic;
			v.startList := Stores.CopyOf(source.startList)(NameList);
			v.subsystems := Stores.CopyOf(source.subsystems)(SubsystemList);
			v.list := Stores.CopyOf(source.list)(List)
		END
	END CopyFromSimpleView;
	
	
	(** Guards and Interactors **)
	
	PROCEDURE ExpandClick*;
		VAR v: View;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN v.ExpandCollapse(TRUE) END
	END ExpandClick;
		
	PROCEDURE CollapseClick*;
		VAR v: View;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN v.ExpandCollapse(FALSE) END
	END CollapseClick;
	
	PROCEDURE HideClick*;
		VAR v: View; hop: HideOp;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN
			NEW(hop); hop.view := v; hop.AddSelection;
			Views.Do(v, "Hide Item", hop)
		END
	END HideClick;
	
	PROCEDURE ToggleBasicSystemsClick*;
		VAR v: View; hbop: HideBasicOp;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			NEW(hbop); hbop.view := v; 
			IF v.showBasic THEN Views.Do(v, "Hide Basic Systems", hbop) 
			ELSE Views.Do(v, "Show Basic Systems", hbop)
			END
		END
	END ToggleBasicSystemsClick;
	
	PROCEDURE ShowAllClick*;
		VAR v: View; l: List; sl: SubsystemList;
				so: ShowAllOp; ml: MetaList; ssl: MetaSSList;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			NEW(so); l := v.list;
			WHILE l # NIL DO 
				IF l.isHidden THEN NEW(ml); ml.list := l; ml.next := so.mods; so.mods := ml END;
				l := l.next 
			END;
			sl := v.subsystems;
			WHILE sl # NIL DO 
				IF sl.isHidden THEN NEW(ssl); ssl.sslist := sl; ssl.next := so.subs; so.subs := ssl END;
				sl := sl.next
			END;
			IF (so.mods # NIL) OR (so.subs # NIL) THEN so.view := v; Views.Do(v, "Show All", so) END
		END
	END ShowAllClick;
	
	PROCEDURE ECAll(eo: ExpandAllOp);
		VAR v: View; sl: SubsystemList; ssl: MetaSSList;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			sl := v.subsystems;
			WHILE sl # NIL DO 
				IF (sl.isExpanded # eo.expand) & ~sl.isHidden & (~sl.isBasic OR v.showBasic) THEN
					NEW(ssl); ssl.sslist := sl; ssl.next := eo.subs; eo.subs := ssl
				END;
				sl := sl.next
			END;
			IF eo.subs # NIL THEN eo.view := v; Views.Do(v, "Show All", eo) END
		END
	END ECAll;
	
	PROCEDURE ExpandAllClick*;
		VAR eo: ExpandAllOp; 
	BEGIN
		NEW(eo); eo.expand := TRUE; ECAll(eo)
	END ExpandAllClick;
	
	PROCEDURE CollapseAllClick*;
		VAR eo: ExpandAllOp; 
	BEGIN
		NEW(eo); eo.expand := FALSE; ECAll(eo)
	END CollapseAllClick;
	
	PROCEDURE ArrangeClick*; (* Not undoable *)
		VAR v: View; l: List; sl: SubsystemList;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			Views.BeginModification(Views.notUndoable, v);
			l := v.list; 
			WHILE l # NIL DO l.isLayedout := FALSE; l := l.next END;
			sl := v.subsystems;
			WHILE sl # NIL DO sl.isLayedout := FALSE; sl := sl.next END;
			Views.Update(v, Views.keepFrames);
			Views.EndModification(Views.notUndoable, v)
		END
	END ArrangeClick;
	
	PROCEDURE DependencyList(v: View; full: BOOLEAN; VAR clist: MetaList);
		VAR l: List;
		PROCEDURE RecursiveList(node: List; VAR clist: MetaList);
			VAR imports: Subgraph; ml, prev: MetaList;
		BEGIN
			IF full OR node.subsystem.isExpanded THEN
				ml := clist; 
				WHILE (ml # NIL) & (ml.list # node) DO ml := ml.next END;
				IF ml = NIL THEN
					imports := node.imports;
					WHILE imports # NIL DO
						IF ~imports.isImplicit THEN RecursiveList(imports.node, clist) END;
						imports := imports.next
					END;
					ml := clist; prev := ml;
					WHILE (ml # NIL) & (ml.list # node)  DO
						(* could have been implicitly imported *)
						prev := ml; ml := ml.next
					END;
					IF ml = NIL THEN
						NEW(ml); ml.list := node;
						IF prev # NIL THEN prev.next := ml END
					END;
					IF clist = NIL THEN clist := ml END;
					imports := node.imports;
					WHILE imports # NIL DO
						IF imports.isImplicit THEN RecursiveList(imports.node, clist) END;
						imports := imports.next
					END
				END
			END
		END RecursiveList;
	BEGIN
		l := v.list; 
		WHILE l # NIL DO
			RecursiveList(l, clist);
			l := l.next
		END
	END DependencyList;

	PROCEDURE SortMetaList(VAR ml: MetaList);
		VAR l, p, cur, pcur: MetaList;
	BEGIN
		ASSERT(ml # NIL, 20);
		cur := ml.next; pcur := ml;
		WHILE cur # NIL DO
			p := NIL; l := ml;
			WHILE  (l # cur) & (cur.list.name$ > l.list.name$) DO p := l; l := l.next END;
			IF l = cur THEN
				pcur := cur; cur := cur.next
			ELSE
				pcur.next := cur.next; cur.next := l;
				IF p = NIL THEN ml := cur ELSE p.next := cur END;
				cur := pcur.next
			END
		END
	END SortMetaList;

	PROCEDURE MarkImplicitModules(v: View);
		VAR 
			fullList, nonImplList: MetaList; v2: View;
	BEGIN
		IF v.nofMods <= 0 THEN RETURN END;
		DependencyList(v, full, fullList);
		SortMetaList(fullList);
		StartAnalysis(v.startList, NIL, ~implicit, v2);
		DependencyList(v2, full, nonImplList);
		SortMetaList(nonImplList);
		WHILE nonImplList # NIL DO
			IF nonImplList.list.name$ = fullList.list.name$ THEN
				fullList.list.onlyImplicit := FALSE
			ELSE
				WHILE nonImplList.list.name$ # fullList.list.name$ DO
					fullList.list.onlyImplicit := TRUE; fullList := fullList.next
				END
			END;
			fullList := fullList.next;
			nonImplList := nonImplList.next
		END;
		WHILE fullList # NIL DO fullList.list.onlyImplicit := TRUE; fullList := fullList.next END
	END MarkImplicitModules;
	
	PROCEDURE SetStyle(f: TextMappers.Formatter; style: SET);
		VAR prop: Properties.StdProp;
	BEGIN
		prop := f.rider.attr.Prop()(Properties.StdProp); 
		IF bold IN style THEN prop.weight := Fonts.bold ELSE prop.weight := Fonts.normal END;
		IF italic IN style THEN INCL(prop.style.val, Fonts.italic); prop.style.mask := prop.style.val 
		ELSE EXCL(prop.style.val, Fonts.italic) END;
		f.rider.SetAttr(TextModels.ModifiedAttr(f.rider.attr, prop))
	END SetStyle;
	
	PROCEDURE SetGray(f: TextMappers.Formatter);
		VAR prop: Properties.StdProp;
	BEGIN
		prop := f.rider.attr.Prop()(Properties.StdProp);
		prop.color.val := Ports.grey25;
		f.rider.SetAttr(TextModels.ModifiedAttr(f.rider.attr, prop))
	END SetGray;
	
	PROCEDURE SetDefColor(f: TextMappers.Formatter);
		VAR prop: Properties.StdProp;
	BEGIN
		prop := f.rider.attr.Prop()(Properties.StdProp);
		prop.color.val := Ports.defaultColor;
		f.rider.SetAttr(TextModels.ModifiedAttr(f.rider.attr, prop))
	END SetDefColor;

	PROCEDURE WritePackList(f: TextMappers.Formatter; v: View);
		CONST colsPerRow = 3;
		VAR head, tail: Files.Name; l: List; col: INTEGER;
	BEGIN
		l := v.list; col := 0;
		WHILE l # NIL DO
			IF l.onlyImplicit THEN SetGray(f) ELSE SetDefColor(f) END;
			Kernel.SplitName(l.name, head, tail); IF head = "" THEN head := "System" END;
			f.WriteString(head + "/Code/" + tail + ".ocf ");
			INC(col); IF col >= colsPerRow THEN f.WriteLn; col := 0 END;
			l := l.next
		END;
		SetGray(f); f.WriteString("System/Rsrc/Menus.odc")
	END WritePackList;
	
	PROCEDURE WriteCommand (IN f: TextMappers.Formatter; title: Dialog.String; cmd: TextModels.Model);
	BEGIN
		SetStyle(f, {bold}); f.WriteString(title); f.WriteLn; 
		SetStyle(f, {});
		f.WriteView(StdFolds.dir.New(StdFolds.collapsed, "", cmd)); 
		 f.WriteString('command');
		f.WriteView(StdFolds.dir.New(StdFolds.collapsed, "", NIL)); 
		f.WriteLn; f.WriteLn
	END WriteCommand;
	
	PROCEDURE AddHeader (IN f: TextMappers.Formatter; v: View);
		VAR sl: NameList; date: Dates.Date; time: Dates.Time; ds, ts: String;
	BEGIN
		Dates.GetDate(date); Dates.DateToString(date, Dates.plainLong, ds);
		Dates.GetTime(time); Dates.TimeToString(time, ts);
		SetStyle(f, {bold});
		f.WriteString('Tool for: '); sl := v.startList;
		WHILE sl # NIL DO f.WriteString(sl.name + ' '); sl := sl.next END; f.WriteLn; 
		SetStyle(f, {italic});f.WriteString('Created: ' + ds + ', ' + ts); f.WriteLn; f.WriteLn
	END AddHeader;
	
	PROCEDURE AddCompileList (IN f: TextMappers.Formatter; v: View);
		VAR l: MetaList; m: TextModels.Model; hf:TextMappers.Formatter;
	BEGIN
		m := TextModels.dir.New(); hf.ConnectTo(m);
		SetStyle(hf, {}); hf.WriteLn;
		hf.WriteView(DevCommanders.dir.New()); hf.WriteString(' DevCompiler.CompileThis '); hf.WriteLn;
		DependencyList(v, ~full, l);
		WHILE l # NIL DO 
			IF l.list.onlyImplicit THEN SetGray(hf) ELSE SetDefColor(hf) END;
			hf.WriteString(l.list.name + ' '); 
			l := l.next
		END; 
		hf.WriteView(DevCommanders.dir.NewEnd()); hf.WriteLn; 
		WriteCommand(f, 'To compile:', m)
	END AddCompileList;

	PROCEDURE WriteUnloadList(f: TextMappers.Formatter; l: MetaList);
	BEGIN
		IF l # NIL THEN
			WriteUnloadList(f, l.next);
			IF l.list.onlyImplicit THEN SetGray(f) ELSE SetDefColor(f) END;
			f.WriteString(l.list.name + ' ')
		END
	END WriteUnloadList;
	
	PROCEDURE AddUnloadList (IN f: TextMappers.Formatter; v: View);
		VAR l: MetaList; m: TextModels.Model; hf:TextMappers.Formatter;
	BEGIN
		m := TextModels.dir.New(); hf.ConnectTo(m);
		SetStyle(hf, {}); hf.WriteLn;
		hf.WriteView(DevCommanders.dir.New()); hf.WriteString(' DevDebug.UnloadThis '); hf.WriteLn; 
		DependencyList(v, ~full, l);
		WriteUnloadList(hf, l); hf.WriteView(DevCommanders.dir.NewEnd()); hf.WriteLn;
		WriteCommand(f, 'To unload:', m)
	END AddUnloadList;
	
	PROCEDURE AddLinkList (IN f: TextMappers.Formatter);
		VAR m: TextModels.Model; hf:TextMappers.Formatter;
	BEGIN
		m := TextModels.dir.New(); hf.ConnectTo(m);
		SetStyle(hf, {}); hf.WriteLn;
		hf.WriteView(DevCommanders.dir.New()); hf.WriteString(' DevLinker.Link exefilename.exe := '); hf.WriteLn;
		hf.WriteString('Kernel$+ Files HostFiles HostPackedFiles StdLoader'); hf.WriteLn;
		hf.WriteString('1 Applogo.ico 2 Doclogo.ico 3 SFLogo.ico 4 CFLogo.ico 5 DtyLogo.ico'); hf.WriteLn;
		hf.WriteString('6 folderimg.ico 7 openimg.ico 8 leafimg.ico'); hf.WriteLn; 
		hf.WriteString('1 Move.cur 2 Copy.cur 3 Link.cur 4 Pick.cur 5 Stop.cur 6 Hand.cur 7 Table.cur');
		hf.WriteView(DevCommanders.dir.NewEnd()); hf.WriteLn;
		WriteCommand(f, 'To link (executable to which files can be packed):', m)
	END AddLinkList;
	
	PROCEDURE AddPackList (IN f: TextMappers.Formatter; v: View);
		VAR m: TextModels.Model; hf:TextMappers.Formatter;
	BEGIN
		m := TextModels.dir.New(); hf.ConnectTo(m);
		SetStyle(hf, {}); hf.WriteLn;
		hf.WriteView(DevCommanders.dir.New()); hf.WriteString(' DevPacker.PackThis exefilename.exe :='); hf.WriteLn;
		WritePackList(hf, v);
		hf.WriteView(DevCommanders.dir.NewEnd()); hf.WriteLn;
		WriteCommand(f, 'To pack:', m)
	END AddPackList;
	
	PROCEDURE AddRootList (IN f: TextMappers.Formatter; v: View);
		VAR m: TextModels.Model; hf:TextMappers.Formatter; l: List;
	BEGIN
		m := TextModels.dir.New(); hf.ConnectTo(m);
		SetStyle(hf, {italic}); hf.WriteLn;
		hf.WriteString('(modules which are not imported from any other modules)'); hf.WriteLn;
		SetStyle(hf, {});
		l := v.list;
		WHILE l # NIL DO
			IF ~l.isImported THEN
				IF l.onlyImplicit THEN SetGray(hf) ELSE SetDefColor(hf) END;
				hf.WriteString(l.name + ' ') 
			END;
			l := l.next
		END;
		hf.WriteLn;
		WriteCommand(f, 'Root modules:', m)
	END AddRootList;
	
	PROCEDURE (v: View) CreateTool, NEW;
		VAR t: TextModels.Model; f: TextMappers.Formatter; tv: TextViews.View; 
	BEGIN
		MarkImplicitModules(v);
		t := TextModels.dir.New(); f.ConnectTo(t); f.SetPos(0); SetStyle(f, {bold});
		AddHeader(f, v);
		AddCompileList(f, v);
		AddUnloadList(f, v);
		AddLinkList(f);
		AddPackList(f, v);
		AddRootList(f, v);
		tv := TextViews.dir.New(t); Views.OpenView(tv)
	END CreateTool;
	
	PROCEDURE CreateToolClick*;
		VAR v: View; 
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN v.CreateTool END
	END CreateToolClick;
	
	PROCEDURE SelGuard* (VAR par: Dialog.Par);
		VAR e: ExpandOp; v: View;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v = NIL THEN 
			par.disabled := TRUE
		ELSE
			NEW(e); e.view := v; e.AddSelection;
			par.disabled := (e.mods = NIL) & (e.subs = NIL)
		END
	END SelGuard;
	
	PROCEDURE ModsGuard* (VAR par: Dialog.Par);
		VAR e: ExpandOp; v: View;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v = NIL THEN 
			par.disabled := TRUE
		ELSE
			NEW(e); e.view := v; e.AddSelection;
			par.disabled := e.mods = NIL
		END
	END ModsGuard;
	
	PROCEDURE SubsGuard* (VAR par: Dialog.Par);
		VAR e: ExpandOp; v: View;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v = NIL THEN 
			par.disabled := TRUE
		ELSE
			NEW(e); e.view := v; e.AddSelection;
			par.disabled := e.subs = NIL
		END
	END SubsGuard;
	
	PROCEDURE ShowBasicGuard* (VAR par: Dialog.Par);
		VAR v: View; 
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			par.checked := v.showBasic
		ELSE
			par.disabled := TRUE
		END
	END ShowBasicGuard;
	
	(** Initialization **)
	
	PROCEDURE SetBasic(v: View);
		VAR str: String; t: TextModels.Model; s: TextMappers.Scanner; l, n, sl: NameList; sslist: SubsystemList;
			sub, mod: String;
	BEGIN
		Dialog.MapString("#Dev:BasicSystems", str);
		l := NIL;
		IF str # "BasicSystems" THEN
			t := TextModels.dir.NewFromString(str); s.ConnectTo(t); s.SetPos(0); s.Scan;
			WHILE s.type # TextMappers.eot DO
				IF s.type = TextMappers.string THEN
					sl := v.startList;
					Kernel.SplitName(sl.name, sub, mod); IF sub = "" THEN sub := "System" END;
					WHILE (sl # NIL) & (sub # s.string) DO
						Kernel.SplitName(sl.name, sub, mod); IF sub = "" THEN sub := "System" END;
						sl := sl.next
					END;
					IF sl = NIL THEN NEW(n); n.name := s.string$; n.next := l;  l := n END
				END;
				s.Scan
			END;
			sslist := v.subsystems; INC(v.maxLevel);
			WHILE sslist # NIL DO
				n := l;
				WHILE (n # NIL) & (sslist.name # n.name) DO n := n.next END;
				IF n # NIL THEN
					sslist.isBasic := TRUE; INC(sslist.level)
				END;
				sslist := sslist.next
			END
		END
	END SetBasic;
	
	PROCEDURE StartAnalysis(startList: NameList; font: Fonts.Font; incImpl: BOOLEAN; OUT v: View);
		VAR rootNode: List; sl: NameList;
	BEGIN
		NEW(v); Stores.Join(v, startList);
		v.showBasic := FALSE; 
		IF font = NIL THEN font := Fonts.dir.Default() END;
		v.normfont := Fonts.dir.This(font.typeface, font.size, font.style, Fonts.normal);
		v.selfont := Fonts.dir.This(font.typeface, font.size, font.style, Fonts.bold);
		v.startList := startList; v.subsystems := NIL; v.list := NIL; v.maxLevel := 2; v.nofMods := 0;
		sl := startList;
		WHILE sl # NIL DO
			v.GetNode(sl.name, incImpl, rootNode);
			sl := sl.next
		END;
		SetBasic(v); v.SetExtents()
	END StartAnalysis;
	
	PROCEDURE NewAnalysisClick*;
		VAR 
			v, nv: View;
			l: List; nl, start: NameList;
	BEGIN
		v := Controllers.FocusView()(View); 
		IF v # NIL THEN 
			l := v.list; start := NIL;
			WHILE l # NIL DO
				IF l.Selected() THEN NEW(nl); nl.name := l.name; nl.next := start; start := nl END;
				l := l.next
			END;
			IF start # NIL THEN
				StartAnalysis(start, v.normfont, implicit, nv); 
				IF nv.list # NIL THEN Views.Deposit(nv); StdCmds.Open END
			END
		END
	END NewAnalysisClick;

	PROCEDURE Analyze (OUT v: View);
		VAR startList: NameList;
	BEGIN
		GetModuleList(startList);
		IF startList # NIL THEN StartAnalysis(startList, NIL, implicit, v)
		ELSE Dialog.ShowMsg("#Dev:NoModuleNameSelected")
		END
	END Analyze;
	
	PROCEDURE Deposit*;
		VAR v: View;
	BEGIN
		Analyze(v); Views.Deposit(v)
	END Deposit;
	
	PROCEDURE CreateTool*;
		VAR v: View;
	BEGIN
		Analyze(v); IF v.list # NIL THEN v.CreateTool END
	END CreateTool;

END DevDependencies.

 "DevDependencies.Deposit;StdCmds.Open"
 DevDependencies.CreateTool