home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-06-29 | 42.2 KB | 1,380 lines |
- (*************************************************************************
-
- $RCSfile: OCPrefsGUI.mod $
- Description: Implements a GUI for OCPrefs using EAGUI.library.
-
- Created by: fjc (Frank Copeland)
- $Revision: 2.2 $
- $Author: fjc $
- $Date: 1995/06/29 19:13:34 $
-
- Copyright © 1995, Frank Copeland
- This module forms part of the OC program
- See OCPrefs.doc for conditions of use and distribution
-
- Log entries are at the end of the file.
-
- *************************************************************************)
-
- <* STANDARD- *> <* MAIN- *>
-
- MODULE OCPrefsGUI;
-
- IMPORT
- SYS := SYSTEM, Kernel, Errors, str := Strings, s := Sets, e := Exec,
- es := ExecSupport, eu := ExecUtil, u := Utility, d := Dos,
- gfx := Graphics, i := Intuition, gt := GadTools, df := DiskFont,
- ea := EAGUI, eam := EAGUI_Macros, spt := EASupport, lbl := EALabels,
- frm := EAFrames, ead := EADialogs, OCPrefsRev, OCM,
- cat := OCPrefsStrings, Events, ASL, wb := Workbench, du := DosUtil,
- Icon;
-
- (* ---------------------------------- *)
-
- CONST
-
- (* Gadget IDs *)
-
- PrefsFileID = 0;
- PathID = 1;
- PathStrID = 2;
- DeleteID = 3;
- SymPathID = 4;
- SymExtID = 5;
- ObjPathID = 6;
- ObjExtID = 7;
- ErrPathID = 8;
- ErrExtID = 9;
- SetNamesID = 10;
- ClearNamesID = 11;
- CodeSizeID = 12;
- ConstSizeID = 13;
-
- VerboseID = 14;
- MakeIconsID = 15;
-
- NumGadgets1 = 16;
-
- StandardID = 0;
- InitialiseID = 1;
- MainID = 2;
- WarningsID = 3;
- RegisterID = 4;
- DebugID = 5;
- SmallCodeID = 6;
- SmallDataID = 7;
- ResidentID = 8;
-
- TypeChkID = 9;
- OvflChkID = 10;
- IndexChkID = 11;
- RangeChkID = 12;
- CaseChkID = 13;
- NilChkID = 14;
- ReturnChkID = 15;
- StackChkID = 16;
- AssertChkID = 17;
- LongVarsID = 18;
- ClearVarsID = 19;
-
- NumGadgets2 = 20;
-
- BrowseID = 101;
- AboutID = 102;
- SaveID = 103;
- SaveAsID = 104;
- QuitID = 105;
- AddID = 106;
- MoreID = 107;
- AcceptID = 108;
- CancelID = 109;
-
- (* ---------------------------------- *)
-
- TYPE
-
- SettingsDialog = POINTER TO SettingsDialogRec;
- OptionsDialog = POINTER TO OptionsDialogRec;
-
- SettingsDialogRec = RECORD (ead.EADialogRec)
- label : ARRAY 6 OF lbl.Label;
- frame : ARRAY 6 OF frm.Frame;
- gadget : ARRAY NumGadgets1 OF i.GadgetPtr;
- pathLabels : e.ListPtr;
- selectedPath : INTEGER;
- optionsDlg : OptionsDialog;
- END; (* SettingsDialogRec *)
-
- OptionsDialogRec = RECORD (ead.EADialogRec)
- label : ARRAY 2 OF lbl.Label;
- frame : ARRAY 2 OF frm.Frame;
- gadget : ARRAY NumGadgets2 OF i.GadgetPtr;
- END; (* OptionsDialogRec *)
-
- (* ---------------------------------- *)
-
- VAR
-
- scr : i.ScreenPtr;
- visualInfo : gt.VisualInfo;
- drawInfo : i.DrawInfoPtr;
- textFont : gfx.TextFontPtr;
- textAttr : ARRAY 2 OF gfx.TextAttr;
- settingsDlg : SettingsDialog;
- hSpace, vSpace : LONGINT;
- tags1, tags2 : ARRAY 2 OF u.TagItem;
-
-
- (* ---------------------------------- *)
- PROCEDURE Notice* ( msg : LONGINT );
-
- VAR es : i.EasyStruct; text : e.LSTRPTR;
-
- BEGIN (* Notice *)
- es.structSize := SIZE (i.EasyStruct);
- es.flags := {};
- es.title := cat.GetString (cat.gui1);
- es.gadgetFormat := cat.GetString (cat.gui2);
- es.textFormat := SYS.ADR ("%s");
- text := cat.GetString (msg);
- IF i.EasyRequest ( NIL, SYS.ADR (es), NIL, text ) = 0
- THEN
- END
- END Notice;
-
- (* ---------------------------------- *)
- PROCEDURE Notice1* ( fmt : LONGINT; msg : ARRAY OF CHAR );
-
- VAR es : i.EasyStruct; text : e.LSTRPTR;
-
- <*$CopyArrays-*>
- BEGIN (* Notice1 *)
- es.structSize := SIZE (i.EasyStruct);
- es.flags := {};
- es.title := cat.GetString (cat.gui1);
- es.gadgetFormat := cat.GetString (cat.gui2);
- es.textFormat := cat.GetString (fmt);
- IF i.EasyRequest ( NIL, SYS.ADR (es), NIL, SYS.ADR (msg) ) = 0
- THEN
- END
- END Notice1;
-
- (* ---------------------------------- *)
- PROCEDURE RequestFile
- ( window : i.WindowPtr;
- title : ARRAY OF CHAR;
- pattern : ARRAY OF CHAR;
- VAR drawer : ARRAY OF CHAR;
- VAR file : ARRAY OF CHAR;
- save : BOOLEAN )
- : BOOLEAN;
-
- VAR
- fr : ASL.FileRequesterPtr;
- flags : s.SET32;
- result : BOOLEAN;
-
- <*$CopyArrays-*>
- BEGIN (* RequestFile *)
- IF save THEN flags := {ASL.frDoPatterns, ASL.frDoSaveMode}
- ELSE flags := {ASL.frDoPatterns}
- END;
- fr := SYS.VAL (ASL.FileRequesterPtr,
- ASL.AllocAslRequestTags ( ASL.fileRequest,
- ASL.window, window,
- ASL.titleText, SYS.ADR (title),
- ASL.initialDrawer, SYS.ADR (drawer),
- ASL.initialFile, SYS.ADR (file),
- ASL.initialPattern, SYS.ADR (pattern),
- ASL.flags1, flags,
- ASL.flags2, {ASL.frRejectIcons},
- u.end ));
- IF fr # NIL THEN
- result := ASL.AslRequestTags (fr, u.end);
- IF result THEN
- COPY (fr.drawer^, drawer);
- COPY (fr.file^, file)
- END;
- ASL.FreeAslRequest (fr)
- ELSE
- result := FALSE
- END;
-
- RETURN result
- END RequestFile;
-
- (*------------------------------------*)
- PROCEDURE MakeIcon ( file : ARRAY OF CHAR );
-
- CONST defPrefsIcon = "def_prefs";
-
- VAR
- icon : ARRAY 256 OF CHAR;
- diskObj : wb.DiskObjectPtr;
- oldTool : e.LSTRPTR;
-
- <*$CopyArrays-*>
- BEGIN (* MakeIcon *)
- ASSERT (Icon.base # NIL, 100);
- COPY (file, icon); str.Append (".info", icon);
- IF ~du.FileExists (icon) THEN
- diskObj := Icon.GetDiskObject ("ENV:OCPrefs/def_prefs");
- IF diskObj = NIL THEN
- diskObj := Icon.GetDefDiskObject (wb.project)
- END;
- IF diskObj # NIL THEN
- oldTool := diskObj.defaultTool;
- diskObj.defaultTool := SYS.ADR ("OCPrefs");
- diskObj.currentX := wb.noIconPosition;
- diskObj.currentY := wb.noIconPosition;
- IF ~Icon.PutDiskObject (file, diskObj) THEN
- Notice1 (cat.gui42, icon)
- END;
- diskObj.defaultTool := oldTool;
- Icon.FreeDiskObject (diskObj)
- ELSE
- Notice (cat.gui43)
- END
- END
- END MakeIcon;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) SetAttrs;
-
- VAR node : e.NodePtr; label : e.LSTRPTR; x : INTEGER;
-
- BEGIN (* SetAttrs *)
- gt.SetGadgetAttrs ( dlg.gadget[PrefsFileID]^, dlg.win, NIL,
- gt.txText, SYS.ADR (OCM.PrefsFile),
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, NIL,
- u.done );
- IF dlg.pathLabels = NIL THEN
- NEW (dlg.pathLabels);
- es.NewList (dlg.pathLabels^)
- ELSE
- LOOP
- node := SYS.VAL (e.NodePtr, e.RemHead (dlg.pathLabels^));
- IF node = NIL THEN EXIT END;
- SYS.DISPOSE (node.name);
- SYS.DISPOSE (node)
- END
- END;
- FOR x := 0 TO OCM.pathx - 1 DO
- SYS.NEW (label, str.Length (OCM.searchPath[x]^) + 1);
- COPY (OCM.searchPath[x]^, label^);
- NEW (node); node.name := label;
- e.AddTail (dlg.pathLabels^, node)
- END;
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, dlg.pathLabels,
- gt.lvTop, 0,
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[PathStrID]^, dlg.win, NIL,
- gt.stString, NIL,
- i.gaDisabled, TRUE,
- u.done );
- dlg.selectedPath := -1;
-
- gt.SetGadgetAttrs ( dlg.gadget[DeleteID]^, dlg.win, NIL,
- i.gaDisabled, TRUE,
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[SymPathID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.SymPath),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[SymExtID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.SymExt),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ObjPathID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.ObjPath),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ObjExtID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.ObjExt),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ErrPathID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.ErrPath),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ErrExtID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.ErrExt),
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[VerboseID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Verbose,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[MakeIconsID]^, dlg.win, NIL,
- gt.cbChecked, OCM.MakeIcons,
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[SetNamesID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.SetNames),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ClearNamesID]^, dlg.win, NIL,
- gt.stString, SYS.ADR (OCM.ClearNames),
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[CodeSizeID]^, dlg.win, NIL,
- gt.inNumber, OCM.CodeSize,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ConstSizeID]^, dlg.win, NIL,
- gt.inNumber, OCM.ConstSize,
- u.done );
- END SetAttrs;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) SetAttrs;
-
- BEGIN (* SetAttrs *)
- gt.SetGadgetAttrs ( dlg.gadget[StandardID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Standard,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[InitialiseID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Initialise,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[MainID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Main,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[WarningsID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Warnings,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[RegisterID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Register,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[DebugID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Debug,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[SmallCodeID]^, dlg.win, NIL,
- gt.cbChecked, OCM.SmallCode,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[SmallDataID]^, dlg.win, NIL,
- gt.cbChecked, OCM.SmallData,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ResidentID]^, dlg.win, NIL,
- gt.cbChecked, OCM.Resident,
- u.done );
-
- gt.SetGadgetAttrs ( dlg.gadget[TypeChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.TypeChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[OvflChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.OvflChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[IndexChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.IndexChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[RangeChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.RangeChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[CaseChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.CaseChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[NilChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.NilChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ReturnChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.ReturnChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[StackChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.StackChk,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[LongVarsID]^, dlg.win, NIL,
- gt.cbChecked, OCM.LongVars,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[ClearVarsID]^, dlg.win, NIL,
- gt.cbChecked, OCM.ClearVars,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[AssertChkID]^, dlg.win, NIL,
- gt.cbChecked, OCM.AssertChk,
- u.done );
- END SetAttrs;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) GetAttrs;
-
- VAR stringInfo : i.StringInfoPtr; node : e.NodePtr;
-
- PROCEDURE GetString ( gad : i.GadgetPtr; VAR str : ARRAY OF CHAR );
-
- VAR stringInfo : i.StringInfoPtr;
-
- BEGIN (* GetString *)
- stringInfo := SYS.VAL (i.StringInfoPtr, gad.specialInfo);
- COPY (stringInfo.buffer^, str);
- END GetString;
-
- BEGIN (* GetAttrs *)
- OCM.ClearSearchPaths;
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, gt.noList,
- u.done );
- LOOP
- node := SYS.VAL (e.NodePtr, e.RemHead (dlg.pathLabels^));
- IF node = NIL THEN EXIT END;
- OCM.AddSearchPath (node.name);
- SYS.DISPOSE (node)
- END; (* LOOP *)
- GetString (dlg.gadget[SymPathID], OCM.SymPath);
- GetString (dlg.gadget[SymExtID], OCM.SymExt);
- GetString (dlg.gadget[ObjPathID], OCM.ObjPath);
- GetString (dlg.gadget[ObjExtID], OCM.ObjExt);
- GetString (dlg.gadget[ErrPathID], OCM.ErrPath);
- GetString (dlg.gadget[ErrExtID], OCM.ErrExt);
- GetString (dlg.gadget[SetNamesID], OCM.SetNames);
- GetString (dlg.gadget[ClearNamesID], OCM.ClearNames);
-
- OCM.Verbose := (i.selected IN dlg.gadget[VerboseID].flags);
- OCM.MakeIcons := (i.selected IN dlg.gadget[MakeIconsID].flags);
-
- stringInfo :=
- SYS.VAL (i.StringInfoPtr, dlg.gadget[CodeSizeID].specialInfo);
- OCM.CodeSize := stringInfo.longInt;
- stringInfo :=
- SYS.VAL (i.StringInfoPtr, dlg.gadget[ConstSizeID].specialInfo);
- OCM.ConstSize := stringInfo.longInt;
- END GetAttrs;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) GetAttrs;
-
- BEGIN (* GetAttrs *)
- OCM.Standard := (i.selected IN dlg.gadget[StandardID].flags);
- OCM.Initialise := (i.selected IN dlg.gadget[InitialiseID].flags);
- OCM.Main := (i.selected IN dlg.gadget[MainID].flags);
- OCM.Warnings := (i.selected IN dlg.gadget[WarningsID].flags);
- OCM.Register := (i.selected IN dlg.gadget[RegisterID].flags);
- OCM.Debug := (i.selected IN dlg.gadget[DebugID].flags);
- OCM.SmallCode := (i.selected IN dlg.gadget[SmallCodeID].flags);
- OCM.SmallData := (i.selected IN dlg.gadget[SmallDataID].flags);
- OCM.Resident := (i.selected IN dlg.gadget[ResidentID].flags);
-
- OCM.TypeChk := (i.selected IN dlg.gadget[TypeChkID].flags);
- OCM.OvflChk := (i.selected IN dlg.gadget[OvflChkID].flags);
- OCM.IndexChk := (i.selected IN dlg.gadget[IndexChkID].flags);
- OCM.RangeChk := (i.selected IN dlg.gadget[RangeChkID].flags);
- OCM.CaseChk := (i.selected IN dlg.gadget[CaseChkID].flags);
- OCM.NilChk := (i.selected IN dlg.gadget[NilChkID].flags);
- OCM.ReturnChk := (i.selected IN dlg.gadget[ReturnChkID].flags);
- OCM.StackChk := (i.selected IN dlg.gadget[StackChkID].flags);
- OCM.AssertChk := (i.selected IN dlg.gadget[AssertChkID].flags);
- OCM.ClearVars := (i.selected IN dlg.gadget[ClearVarsID].flags);
- OCM.LongVars := (i.selected IN dlg.gadget[LongVarsID].flags);
- END GetAttrs;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) SetupWindow ( win : i.WindowPtr );
- BEGIN (* SetupWindow *)
- dlg.SetupWindow^ (win);
- dlg.SetAttrs
- END SetupWindow;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) SetupWindow ( win : i.WindowPtr );
- BEGIN (* SetupWindow *)
- dlg.SetupWindow^ (win);
- dlg.SetAttrs
- END SetupWindow;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) HandleGadgetUp
- ( msg : i.IntuiMessagePtr )
- : INTEGER;
-
- VAR
- result, gadgetID : INTEGER;
- gadget : i.GadgetPtr;
- stringInfo : i.StringInfoPtr;
- buffer : e.LSTRPTR;
- code : INTEGER;
- node : e.NodePtr;
-
- (* ---------------------------------- *)
- PROCEDURE DoAbout;
-
- VAR es : i.EasyStruct;
-
- BEGIN (* DoAbout *)
- dlg.Block;
- es.structSize := SIZE (i.EasyStruct);
- es.flags := {};
- es.title := cat.GetString (cat.gui4);
- es.gadgetFormat := cat.GetString (cat.gui2);
- es.textFormat := SYS.ADR ("%s (%s)\n%s");
- IF 0 = i.EasyRequest ( NIL, SYS.ADR (es), NIL,
- SYS.ADR (OCPrefsRev.vers), SYS.ADR (OCPrefsRev.date),
- cat.GetString (cat.gui5),
- NIL )
- THEN
- END;
- dlg.UnBlock
- END DoAbout;
-
- (* ---------------------------------- *)
- PROCEDURE DoBrowse;
-
- VAR
- drawer : ARRAY 256 OF CHAR; file : ARRAY 32 OF CHAR;
- str : e.LSTRPTR;
-
- BEGIN (* DoBrowse *)
- COPY (OCM.PrefsFile, drawer);
- str := d.PathPart (drawer);
- str[0] := 0X;
-
- str := d.FilePart (OCM.PrefsFile);
- COPY (str^, file);
-
- dlg.Block;
- str := cat.GetString (cat.gui13);
- IF RequestFile ( dlg.win, str^, "#?.prefs",
- drawer, file, FALSE )
- THEN
- IF d.AddPart (drawer, file, LEN (drawer))
- & OCM.LoadPrefs (drawer) THEN
- dlg.SetAttrs
- ELSE
- Notice (cat.gui14)
- END
- END;
- dlg.UnBlock
- END DoBrowse;
-
- (* ---------------------------------- *)
- PROCEDURE DoSaveAs;
-
- VAR
- drawer : ARRAY 256 OF CHAR; file : ARRAY 32 OF CHAR;
- str : e.LSTRPTR;
-
- BEGIN (* DoSaveAs *)
- COPY (OCM.PrefsFile, drawer);
- str := d.PathPart (drawer);
- str[0] := 0X;
-
- str := d.FilePart (OCM.PrefsFile);
- COPY (str^, file);
-
- dlg.Block;
- str := cat.GetString (cat.gui13);
- IF RequestFile ( dlg.win, str^, "#?.prefs",
- drawer, file, TRUE )
- THEN
- dlg.GetAttrs;
- IF ( d.AddPart (drawer, file, LEN (drawer))
- & OCM.SavePrefs (drawer) )
- THEN
- gt.SetGadgetAttrs ( dlg.gadget[PrefsFileID]^, dlg.win, NIL,
- gt.txText, SYS.ADR (OCM.PrefsFile),
- u.done );
- MakeIcon (drawer)
- ELSE
- Notice (cat.gui15)
- END
- END;
- dlg.UnBlock;
- END DoSaveAs;
-
- BEGIN (* HandleGadgetUp *)
- result := Events.Continue;
-
- code := msg.code;
- gadget := msg.iAddress;
- gt.ReplyIMsg (msg);
-
- gadgetID := gadget.gadgetID;
- CASE gadgetID OF
- BrowseID:
- DoBrowse
- |
- AboutID:
- DoAbout
- |
- SaveID:
- dlg.GetAttrs;
- IF OCM.SavePrefs (OCM.PrefsFile) THEN
- MakeIcon (OCM.PrefsFile)
- ELSE
- dlg.Block;
- Notice (cat.gui15);
- dlg.UnBlock
- END
- |
- SaveAsID:
- DoSaveAs()
- |
- QuitID:
- result := Events.Stop
- |
- PathID:
- node := SYS.VAL (e.NodePtr, eu.NodeAt (dlg.pathLabels^, code));
- gt.SetGadgetAttrs ( dlg.gadget[PathStrID]^, dlg.win, NIL,
- gt.stString, node.name,
- i.gaDisabled, FALSE,
- u.done );
- IF i.ActivateGadget ( dlg.gadget[PathStrID]^, dlg.win, NIL ) THEN END;
- gt.SetGadgetAttrs ( dlg.gadget[DeleteID]^, dlg.win, NIL,
- i.gaDisabled, FALSE,
- u.done );
- dlg.selectedPath := code
- |
- PathStrID:
- stringInfo := SYS.VAL (i.StringInfoPtr, gadget.specialInfo);
- buffer := stringInfo.buffer;
- IF (buffer # NIL) & (buffer^ # "") THEN
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, gt.noList,
- u.done );
- IF dlg.selectedPath >= 0 THEN
- node := SYS.VAL ( e.NodePtr,
- eu.NodeAt (dlg.pathLabels^, dlg.selectedPath) );
- SYS.DISPOSE (node.name)
- ELSE
- NEW (node);
- e.AddTail (dlg.pathLabels^, node)
- END;
- SYS.NEW (node.name, str.Length (buffer^) + 1);
- COPY (buffer^, node.name^);
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, dlg.pathLabels,
- u.done )
- END;
- gt.SetGadgetAttrs ( dlg.gadget[PathStrID]^, dlg.win, NIL,
- gt.stString, NIL,
- i.gaDisabled, TRUE,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[DeleteID]^, dlg.win, NIL,
- i.gaDisabled, TRUE,
- u.done );
- dlg.selectedPath := -1
- |
- AddID:
- gt.SetGadgetAttrs ( dlg.gadget[PathStrID]^, dlg.win, NIL,
- gt.stString, NIL,
- i.gaDisabled, FALSE,
- u.done );
- IF i.ActivateGadget ( dlg.gadget[PathStrID]^, dlg.win, NIL ) THEN END;
- gt.SetGadgetAttrs ( dlg.gadget[DeleteID]^, dlg.win, NIL,
- i.gaDisabled, FALSE,
- u.done );
- dlg.selectedPath := -1
- |
- DeleteID:
- IF dlg.selectedPath >= 0 THEN
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, gt.noList,
- u.done );
- node := SYS.VAL ( e.NodePtr,
- eu.NodeAt (dlg.pathLabels^, dlg.selectedPath) );
- e.Remove (node);
- SYS.DISPOSE (node.name);
- SYS.DISPOSE (node);
- gt.SetGadgetAttrs ( dlg.gadget[PathID]^, dlg.win, NIL,
- gt.lvLabels, dlg.pathLabels,
- u.done )
- END;
- gt.SetGadgetAttrs ( dlg.gadget[PathStrID]^, dlg.win, NIL,
- gt.stString, NIL,
- i.gaDisabled, TRUE,
- u.done );
- gt.SetGadgetAttrs ( dlg.gadget[DeleteID]^, dlg.win, NIL,
- i.gaDisabled, TRUE,
- u.done );
- dlg.selectedPath := -1
- |
- MoreID:
- IF dlg.optionsDlg = NIL THEN NEW (dlg.optionsDlg) END;
- dlg.Block;
- IF dlg.optionsDlg.Open (visualInfo, drawInfo) THEN
- Events.SimpleLoop (dlg.optionsDlg, Events.NoGC);
- dlg.optionsDlg.Close
- ELSE
- Errors.Abort ("Failed to open Options Dialog")
- END;
- dlg.UnBlock;
- ELSE (* NOP *)
- END;
-
- RETURN result
- END HandleGadgetUp;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) HandleGadgetUp
- ( msg : i.IntuiMessagePtr )
- : INTEGER;
-
- VAR
- result : INTEGER;
- gadget : i.GadgetPtr;
-
- BEGIN (* HandleGadgetUp *)
- result := Events.Continue;
-
- gadget := msg.iAddress;
- gt.ReplyIMsg (msg);
-
- CASE gadget.gadgetID OF
- SmallDataID:
- IF i.selected IN dlg.gadget[SmallDataID].flags THEN
- gt.SetGadgetAttrs ( dlg.gadget[ResidentID]^, dlg.win, NIL,
- gt.cbChecked, FALSE,
- u.done )
- END
- |
- ResidentID:
- IF i.selected IN dlg.gadget[ResidentID].flags THEN
- gt.SetGadgetAttrs ( dlg.gadget[SmallDataID]^, dlg.win, NIL,
- gt.cbChecked, FALSE,
- u.done )
- END
- |
- AcceptID:
- dlg.GetAttrs;
- result := Events.Stop
- |
- CancelID:
- result := Events.Stop
- ELSE (* Oops... *)
- END;
-
- RETURN result
- END HandleGadgetUp;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) InitObjects () : BOOLEAN;
-
- CONST
- template1 = "000000000000";
- template2 = "000000";
- template3 = "0000000000000000000000000000";
-
- VAR
- obj : ARRAY 15 OF ea.OPTR; obj2 : ARRAY 14 OF ea.OPTR;
- x, w1, w2, w3, ignore, hPlus2, vPlus1, vDiv2 : LONGINT;
- gad : ARRAY NumGadgets1 OF SYS.ADDRESS; ta : SYS.ADDRESS;
- txt : ARRAY 11 OF e.LSTRPTR; tags : ARRAY 2 OF u.TagItem;
-
- PROCEDURE StringGroup1
- ( title : e.LSTRPTR;
- gadget1,
- gadget2 : SYS.ADDRESS )
- : ea.OPTR;
-
- BEGIN (* StringGroup1 *)
- RETURN eam.HGroup (
- ea.Child, eam.EmptyBox (1, u.done),
- ea.Child, eam.GTString ( title,
- ea.GTTagList, SYS.ADR (tags1),
- ea.InstanceAddress, gadget1,
- ea.MinWidth, w1 + 10,
- u.done ),
- ea.Child, eam.GTString ( NIL,
- ea.GTTagList, SYS.ADR (tags2),
- ea.InstanceAddress, gadget2,
- ea.MinWidth, w2 + 10,
- u.done ),
- u.done );
- END StringGroup1;
-
- PROCEDURE StringGroup2
- ( title : e.LSTRPTR;
- gadget : SYS.ADDRESS )
- : ea.OPTR;
-
- BEGIN (* StringGroup2 *)
- RETURN eam.HGroup (
- ea.Child, eam.EmptyBox (1, u.done),
- ea.Child, eam.GTString ( title,
- ea.GTTagList, SYS.ADR (tags1),
- ea.InstanceAddress, gadget,
- ea.MinWidth, w3 + 10,
- u.done ),
- u.done );
- END StringGroup2;
-
- PROCEDURE IntegerGroup
- ( title : e.LSTRPTR;
- gadget : SYS.ADDRESS )
- : ea.OPTR;
-
- BEGIN (* IntegerGroup *)
- RETURN eam.HGroup (
- ea.Child, eam.EmptyBox (1, u.done),
- ea.Child, eam.GTInteger ( title,
- ea.InstanceAddress, gadget,
- ea.MinWidth, w2 + 10,
- u.done ),
- u.done );
- END IntegerGroup;
-
- BEGIN
- FOR x := 0 TO NumGadgets1 - 1 DO
- gad[x] := SYS.ADR (dlg.gadget[x])
- END;
- ta := SYS.ADR (textAttr[0]);
-
- w1 := ea.TextLength (textAttr[0], template1, 0X);
- w2 := ea.TextLength (textAttr[0], template2, 0X);
- w3 := ea.TextLength (textAttr[0], template3, 0X);
-
- hPlus2 := hSpace + 2;
- vPlus1 := vSpace + 1;
- vDiv2 := vSpace DIV 2;
-
- (* set up some defaults for all objects *)
- ignore := ea.SetAttr ( NIL, ea.DefGTTextAttr, ta );
-
- (* build the object tree *)
- obj[0] := eam.HGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, 2,
- ea.BorderTop, 1,
- ea.BorderBottom, 1,
- ea.Child, frm.NewFrame ( dlg.frame[0], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[0],
- ea.BorderTop, 1,
- ea.BorderRight, hSpace,
- u.done ),
- ea.Child, eam.GTText ( NIL,
- ea.InstanceAddress, gad[PrefsFileID],
- ea.Weight, 1,
- u.done ),
- ea.Child, eam.GTButton ( SYS.ADR ("..."),
- ea.ID, BrowseID,
- u.done ),
- u.done );
- frm.InitFrame ( dlg.frame[0],
- {frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[0], cat.GetString (cat.gui16),
- ta, gfx.jam2, {lbl.ShadowText}, dlg.drawInfo );
-
- obj[1] := eam.GTButton ( cat.GetString (cat.gui17),
- ea.ID, AddID,
- ea.Weight, 1,
- u.done );
- obj[2] := eam.GTButton ( cat.GetString (cat.gui18),
- ea.InstanceAddress, gad[DeleteID],
- ea.ID, DeleteID,
- ea.Weight, 1,
- u.done );
- obj[3] := eam.HGroup (
- ea.Child, obj[1],
- ea.Child, obj[2],
- u.done );
- ignore := ea.NewRelation ( obj[3], spt.SameSizeHook,
- ea.Object, obj[1],
- ea.Object, obj[2],
- u.done );
-
- obj[4] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- (* ea.Weight, 1, *)
- ea.Child, frm.NewFrame ( dlg.frame[1], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[1],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, eam.GTListView ( NIL,
- ea.MinWidth, w1 + 20,
- ea.Weight, 1,
- ea.InstanceAddress, gad[PathID],
- ea.ID, PathID,
- u.done ),
- ea.Child, eam.GTString ( NIL,
- ea.GTTagList, SYS.ADR (tags1),
- ea.InstanceAddress, gad[PathStrID],
- ea.ID, PathStrID,
- u.done ),
- ea.Child, obj[3],
- u.done );
- frm.InitFrame ( dlg.frame[1],
- {frm.DoubleBorder, frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[1],
- cat.GetString (cat.gui19), ta,
- gfx.jam2, {lbl.ShadowText}, dlg.drawInfo );
-
- obj[5] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, frm.NewFrame ( dlg.frame[2], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[2],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, eam.HGroup (
- ea.Child, eam.EmptyBox ( 1, u.done ),
- ea.Child, eam.VGroup (
- ea.Child, StringGroup1 ( cat.GetString (cat.gui20),
- gad[SymPathID], gad[SymExtID] ),
- ea.Child, StringGroup1 ( cat.GetString (cat.gui21),
- gad[ObjPathID], gad[ObjExtID] ),
- ea.Child, StringGroup1 ( cat.GetString (cat.gui22),
- gad[ErrPathID], gad[ErrExtID] ),
- u.done ),
- ea.Child, eam.EmptyBox ( 1, u.done ),
- u.done ),
- u.done );
- frm.InitFrame ( dlg.frame[2],
- {frm.DoubleBorder, frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[2],
- cat.GetString (cat.gui23), ta,
- gfx.jam2, {lbl.ShadowText}, dlg.drawInfo );
-
- obj[6] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, frm.NewFrame ( dlg.frame[3], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[3],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, eam.HGroup (
- ea.Child, eam.EmptyBox ( 1, u.done ),
- ea.Child, eam.VGroup (
- ea.Child, StringGroup2 ( cat.GetString (cat.gui31), gad[SetNamesID] ),
- ea.Child, StringGroup2 ( cat.GetString (cat.gui32), gad[ClearNamesID] ),
- u.done ),
- ea.Child, eam.EmptyBox ( 1, u.done ),
- u.done ),
- u.done );
- frm.InitFrame ( dlg.frame[3],
- {frm.DoubleBorder, frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[3], cat.GetString (cat.gui33), ta,
- gfx.jam2, {lbl.ShadowText}, dlg.drawInfo );
-
- txt[0] := SYS.ADR ("Verbose");
- txt[1] := SYS.ADR ("Make Icons");
-
- obj2[0] := eam.GTCheckBox ( txt[0],
- ea.GTFlags, {gt.placeTextRight},
- ea.InstanceAddress, gad[VerboseID],
- ea.ID, VerboseID,
- u.done );
- obj2[1] := eam.GTCheckBox ( txt[1],
- ea.GTFlags, {gt.placeTextRight},
- ea.InstanceAddress, gad[MakeIconsID],
- ea.ID, MakeIconsID,
- u.done );
-
- obj[7] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, frm.NewFrame ( dlg.frame[4], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[4],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, obj2[0],
- ea.Child, obj2[1],
- u.done );
- frm.InitFrame ( dlg.frame[4], {frm.DoubleBorder, frm.Recessed},
- dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[4],
- cat.GetString (cat.gui24), ta, gfx.jam2,
- {lbl.ShadowText}, dlg.drawInfo );
-
- obj[8] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- (* ea.Weight, 100, *)
- ea.Child, frm.NewFrame ( dlg.frame[5], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[5],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, eam.HGroup (
- ea.Child, eam.EmptyBox ( 1, u.done ),
- ea.Child, eam.VGroup (
- ea.Child, IntegerGroup ( cat.GetString (cat.gui34), gad[CodeSizeID] ),
- ea.Child, IntegerGroup ( cat.GetString (cat.gui35), gad[ConstSizeID] ),
- u.done ),
- ea.Child, eam.EmptyBox ( 1, u.done ),
- u.done ),
- u.done );
- frm.InitFrame ( dlg.frame[5],
- {frm.DoubleBorder, frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[5],
- cat.GetString (cat.gui36), ta, gfx.jam2,
- {lbl.ShadowText}, dlg.drawInfo );
-
- obj[9] := eam.GTButton ( cat.GetString (cat.gui26),
- ea.ID, MoreID,
- ea.Weight, 100,
- u.done );
-
- obj[10] := eam.GTButton ( cat.GetString (cat.gui40),
- ea.ID, AboutID,
- ea.Weight, 1,
- u.done );
- obj[11] := eam.GTButton ( cat.GetString (cat.gui37),
- ea.ID, SaveID,
- ea.Weight, 1,
- u.done );
- obj[12] := eam.GTButton ( cat.GetString (cat.gui41),
- ea.ID, SaveAsID,
- ea.Weight, 1,
- u.done );
- obj[13] := eam.GTButton ( cat.GetString (cat.gui9),
- ea.ID, QuitID,
- ea.Weight, 1,
- u.done );
- obj[14] := eam.HGroup (
- ea.BorderBottom, vSpace,
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[10],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[11],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[12],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[13],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- u.done );
- ignore := ea.NewRelation ( obj[14], spt.SameSizeHook,
- ea.Object, obj[10],
- ea.Object, obj[11],
- ea.Object, obj[12],
- ea.Object, obj[13],
- u.done );
-
- dlg.winObj := eam.VGroup (
- ea.Child, eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, eam.VGroup (
- ea.Child, obj[0],
- ea.Child, eam.EmptyBox (1, ea.MinHeight, vSpace, u.done),
- ea.Child, eam.HGroup (
- ea.Child, obj[4],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, eam.VGroup (
- ea.Child, obj[5],
- ea.Child, eam.EmptyBox (1, ea.MinHeight, vSpace, u.done),
- ea.Child, obj[6],
- u.done ),
- u.done ),
- u.done ),
- ea.Child, eam.EmptyBox (1, ea.MinHeight, vSpace, u.done),
- ea.Child, eam.HGroup (
- ea.Child, obj[7],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[8],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[9],
- u.done ),
- u.done ),
- ea.Child, obj[14],
- u.done );
-
- RETURN (dlg.winObj # NIL)
- END InitObjects;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) InitObjects () : BOOLEAN;
-
- VAR
- obj : ARRAY 5 OF ea.OPTR;
- obj2 : ARRAY 11 OF ea.OPTR;
- x, ignore, vDiv2 : LONGINT;
- gad : ARRAY NumGadgets2 OF SYS.ADDRESS;
- ta : SYS.ADDRESS;
- txt : ARRAY 11 OF e.LSTRPTR;
-
- BEGIN
- FOR x := 0 TO NumGadgets2 - 1 DO
- gad[x] := SYS.ADR (dlg.gadget[x])
- END;
- ta := SYS.ADR (textAttr[0]);
-
- vDiv2 := vSpace DIV 2;
-
- (* set up some defaults for all objects *)
- ignore := ea.SetAttr ( NIL, ea.DefGTTextAttr, ta );
-
- (* build the object tree *)
- txt[0] := SYS.ADR ("STANDARD");
- txt[1] := SYS.ADR ("INITIALISE");
- txt[2] := SYS.ADR ("MAIN");
- txt[3] := SYS.ADR ("WARNINGS");
- txt[4] := SYS.ADR ("REGISTER");
- txt[5] := SYS.ADR ("DEBUG");
- txt[6] := SYS.ADR ("SMALLCODE");
- txt[7] := SYS.ADR ("SMALLDATA");
- txt[8] := SYS.ADR ("RESIDENT");
-
- FOR x := 0 TO 8 DO
- obj2[x] := eam.GTCheckBox ( txt[x],
- ea.GTFlags, {gt.placeTextRight},
- ea.InstanceAddress, gad[StandardID + x],
- ea.ID, StandardID + x,
- ea.Weight, 1,
- u.done )
- END;
-
- obj[0] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, frm.NewFrame ( dlg.frame[0], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[0],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, obj2[0],
- ea.Child, obj2[1],
- ea.Child, obj2[2],
- ea.Child, obj2[3],
- ea.Child, obj2[4],
- ea.Child, obj2[5],
- ea.Child, obj2[6],
- ea.Child, obj2[7],
- ea.Child, obj2[8],
- u.done );
- frm.InitFrame ( dlg.frame[0], {frm.DoubleBorder, frm.Recessed},
- dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[0],
- cat.GetString (cat.gui30), ta, gfx.jam2,
- {lbl.ShadowText}, dlg.drawInfo );
-
- txt[0] := SYS.ADR ("TypeChk");
- txt[1] := SYS.ADR ("OvflChk");
- txt[2] := SYS.ADR ("IndexChk");
- txt[3] := SYS.ADR ("RangeChk");
- txt[4] := SYS.ADR ("CaseChk");
- txt[5] := SYS.ADR ("NilChk");
- txt[6] := SYS.ADR ("ReturnChk");
- txt[7] := SYS.ADR ("StackChk");
- txt[8] := SYS.ADR ("AssertChk");
- txt[9] := SYS.ADR ("LongVars");
- txt[10] := SYS.ADR ("ClearVars");
-
- FOR x := 0 TO 10 DO
- obj2[x] := eam.GTCheckBox ( txt[x],
- ea.GTFlags, {gt.placeTextRight},
- ea.InstanceAddress, gad[TypeChkID + x],
- ea.ID, TypeChkID + x,
- u.done )
- END;
-
- obj[1] := eam.VGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, frm.NewFrame ( dlg.frame[1], u.done ),
- ea.Child, lbl.NewLabel ( dlg.label[1],
- ea.BorderBottom, vDiv2,
- u.done ),
- ea.Child, obj2[0],
- ea.Child, obj2[1],
- ea.Child, obj2[2],
- ea.Child, obj2[3],
- ea.Child, obj2[4],
- ea.Child, obj2[5],
- ea.Child, obj2[6],
- ea.Child, obj2[7],
- ea.Child, obj2[8],
- ea.Child, obj2[9],
- ea.Child, obj2[10],
- u.done );
- frm.InitFrame ( dlg.frame[1],
- {frm.DoubleBorder, frm.Recessed}, dlg.visualInfo, dlg.drawInfo );
- lbl.InitLabel ( dlg.label[1],
- cat.GetString (cat.gui25), ta, gfx.jam2,
- {lbl.ShadowText}, dlg.drawInfo );
-
- obj[2] := eam.GTButton ( cat.GetString (cat.gui27),
- ea.ID, AcceptID,
- ea.Weight, 1,
- u.done );
- obj[3] := eam.GTButton ( cat.GetString (cat.gui28),
- ea.ID, CancelID,
- ea.Weight, 1,
- u.done );
- obj[4] := eam.HGroup (
- ea.BorderBottom, vSpace,
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[2],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[3],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- u.done );
- ignore := ea.NewRelation ( obj[4], spt.SameSizeHook,
- ea.Object, obj[2],
- ea.Object, obj[3],
- u.done );
-
- dlg.winObj := eam.VGroup (
- ea.Child, eam.HGroup (
- ea.BorderLeft, hSpace,
- ea.BorderRight, hSpace,
- ea.BorderTop, vSpace,
- ea.BorderBottom, vSpace,
- ea.Child, obj[0],
- ea.Child, eam.EmptyBox (1, ea.MinWidth, hSpace, u.done),
- ea.Child, obj[1],
- u.done ),
- ea.Child, obj[4],
- u.done );
-
- RETURN (dlg.winObj # NIL)
- END InitObjects;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : SettingsDialog) OpenWindow () : BOOLEAN;
-
- BEGIN
- dlg.title := cat.GetString (cat.gui39);
- dlg.flags := {i.windowDrag, i.windowDepth, i.windowClose, i.activate};
- dlg.IDCMP := {i.closeWindow, i.refreshWindow}
- + gt.buttonIDCMP + gt.stringIDCMP
- + gt.checkBoxIDCMP + gt.numberIDCMP;
-
- RETURN dlg.OpenWindow^()
- END OpenWindow;
-
- (* ---------------------------------- *)
- PROCEDURE (dlg : OptionsDialog) OpenWindow () : BOOLEAN;
-
- BEGIN
- dlg.title := cat.GetString (cat.gui29);
- dlg.flags := {i.windowDrag, i.windowDepth, i.windowClose, i.activate};
- dlg.IDCMP := {i.closeWindow, i.refreshWindow}
- + gt.buttonIDCMP + gt.checkBoxIDCMP;
-
- RETURN dlg.OpenWindow^()
- END OpenWindow;
-
- (* ---------------------------------- *)
- PROCEDURE* Cleanup ( VAR rc : LONGINT );
-
- BEGIN (* Cleanup *)
- IF settingsDlg # NIL THEN
- settingsDlg.Close; settingsDlg := NIL
- END;
-
- IF drawInfo # NIL THEN
- i.FreeScreenDrawInfo (scr, drawInfo);
- drawInfo := NIL;
- END;
-
- IF visualInfo # NIL THEN
- gt.FreeVisualInfo (visualInfo);
- visualInfo := NIL;
- END;
-
- IF scr # NIL THEN
- i.UnlockPubScreen (e.NILSTR, scr);
- scr := NIL;
- END;
-
- IF textFont # NIL THEN
- gfx.CloseFont (textFont);
- textFont := NIL;
- END;
- END Cleanup;
-
-
- (* ---------------------------------- *)
- PROCEDURE Open*;
-
- (* ---------------------------------- *)
- PROCEDURE InitDisplay;
-
- VAR
- scrFont : gfx.TextFontPtr;
-
- BEGIN (* InitDisplay *)
- (* lock the screen *)
- scr := i.LockPubScreen (e.NILSTR);
- ASSERT (scr # NIL, Errors.postCondition);
-
- (* get VisualInfo and DrawInfo *)
- visualInfo := gt.GetVisualInfo (scr, u.done);
- drawInfo := i.GetScreenDrawInfo (scr);
- ASSERT ((visualInfo # NIL) & (drawInfo # NIL), Errors.postCondition);
-
- (* Calculate spacing from screen dimensions *)
- hSpace := scr.width DIV 80;
- vSpace := scr.height DIV 64;
-
- (* get the font(s) *)
- scrFont := drawInfo.font;
- SYS.NEW ( textAttr[0].name,
- str.Length (scrFont.message.node.name^) + 1 );
- COPY (scrFont.message.node.name^, textAttr[0].name^);
- textAttr[0].ySize := scrFont.ySize;
- textAttr[0].style := scrFont.style;
- textAttr[0].flags := scrFont.flags;
-
- textAttr[1].name := SYS.ADR ("helvetica.font");
- textAttr[1].ySize := 24;
- textAttr[1].style := gfx.normal;
- textAttr[1].flags := {gfx.diskFont, gfx.romFont};
-
- textFont := df.OpenDiskFont (textAttr[1]);
- IF textFont = NIL THEN textAttr[1] := textAttr[0] END
- END InitDisplay;
-
- BEGIN (* Open *)
- ASSERT (ea.base # NIL, Errors.noLibrary);
- ASSERT (settingsDlg = NIL, Errors.preCondition);
- Kernel.SetCleanup (Cleanup);
- InitDisplay;
- NEW (settingsDlg);
- IF settingsDlg.Open (visualInfo, drawInfo) THEN
- Events.SimpleLoop (settingsDlg, Events.NoGC);
- settingsDlg.Close; settingsDlg := NIL
- END
- END Open;
-
- BEGIN
- tags1[0].tag := gt.stMaxChars; tags1[0].data := OCM.PathLen;
- tags1[1].tag := u.done;
- tags2[0].tag := gt.stMaxChars; tags2[0].data := OCM.ExtLen;
- tags2[1].tag := u.done;
- END OCPrefsGUI.
-
- (*************************************************************************
-
- $Log: OCPrefsGUI.mod $
- # Revision 2.2 1995/06/29 19:13:34 fjc
- # - OCPrefs_2_3
- #
- # Revision 2.1 1995/06/15 18:21:44 fjc
- # - Fixed event handling code to make SMALLDATA and RESIDENT
- # mutually exclusive.
- #
- # Revision 1.7 1995/06/04 22:57:19 fjc
- # *** empty log message ***
- #
- # Revision 1.6 1995/06/03 19:39:13 fjc
- # - Split off options and pragmas groups into a seperate
- # dialog.
- #
- # Revision 1.5 1995/06/02 18:50:24 fjc
- # - Yet more fiddling with the layout.
- #
- # Revision 1.4 1995/05/31 23:47:11 fjc
- # - Redesigned to reflect changes in preferences settings.
- #
- # Revision 1.3 1995/05/30 23:34:29 fjc
- # - More fiddling with layout.
- #
- # Revision 1.2 1995/05/29 21:30:02 fjc
- # - Moved EADialog declarations to EADialogs.
- # - Numerous changes to the layout and presentation.
- #
- # Revision 1.1 1995/05/19 16:14:28 fjc
- # Initial revision
- #
- *************************************************************************)
-