TCL Pascal LIVES!!!
Kevin Killian, TCL Programmer




Warnings, Caveats, Limitations - READ THIS FIRST!

No guarantees, warrantees, promises, or encouragements of any kind are given for these code snippets. They have not been thoroughly tested. They may not have been tested at all. The programmer(s) may have been asleep, hallucinating, or acting on a death wish at the time they were written. They may not be right for you. They may not work correctly. In fact, it's not clear if some of them do anything at all. Or they may do something worse. Maybe it would be better if you just logged off now and went to read a good book instead. Or visited your family. Or flossed. Or sorted out your sock drawer.

These bits and pieces are submitted by fellow TCL Pascal programmers No individual or company on earth takes any responsibilities for any of this.

Now that we all feel safer, let's see what we've got here ...

Contents

Notes:


BUG FIXES



Symantec support confirms that the parameter list for GenericMDEF is in error, the menuRect should be a VAR. This must be changed in TWO places.

{FW_Tearoffs.p} 
TYPE 
{--- ORIG ---} 
	CMenuDefProc = OBJECT(CObject) 
{---} 

PROCEDURE PlacePopup (macMenu: MenuHandle; 
				menuRect: Rect; 
				hitPt: Point; 
				VAR whichItem: integer); 

{---} 
END; 

{--- NEW ---} 
CMenuDefProc = OBJECT(CObject) 
{---} 

PROCEDURE PlacePopup (macMenu: MenuHandle; 
				VAR menuRect: Rect; 
				hitPt: Point; 
				VAR whichItem: integer); 

{---} 
END; 

{--- ORIG ---} 
PROCEDURE GenericMDEF (theMessage: integer; 
					macMenu: MenuHandle; 
					menuRect: Rect; 
					hitPt: Point; 
					VAR whichItem: integer); 
	BEGIN 
	END; 

{--- NEW ---} 
PROCEDURE GenericMDEF (theMessage: integer; 
					macMenu: MenuHandle; 
					VAR menuRect: Rect; 
					hitPt: Point; 
					VAR whichItem: integer); 
BEGIN 
END; 

{CMenuDefProc.p} 
{--- ORIG ---} 
PROCEDURE CMenuDefProc.PlacePopup (macMenu: MenuHandle; menuRect: 
						Rect; hitPt: Point; 
						VAR whichItem: integer); 
BEGIN 
END; 

{--- NEW ---} 
PROCEDURE CMenuDefProc.PlacePopup (macMenu: MenuHandle; 
						VAR menuRect: Rect; 
						hitPt: Point; 
						VAR whichItem: integer); 
BEGIN 
END;



In CResFile.p, we should only attempt to UseResFile if the res file is open. Without this fix, the rfRefNum=0 and we wind up referring to the System file!

PROCEDURE CResFile.MakeCurrent; 

BEGIN 
IF rfRefNum 0 THEN {this IF test added, KCK 1/8/96} 
	UseResFile(rfRefNum); 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



CBartender.p -- fix so that EnableMenuBar and DisableMenuBar redraw the menu bar after enabling menus

PROCEDURE CBartender.EnableMenuBar; 

BEGIN 
{---} 
DrawMenuBar; {added by KCK, 10/7/93} 
END; 

PROCEDURE CBartender.DisableMenuBar; 

BEGIN 
{---} 
DrawMenuBar; {added by KCK, 10/7/93} 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Changes so that printer driver would display correct name of document being printed

{IMPLEMENTATION} 
USES 
	PrintTraps, CFWDesktop; 

{add CFWDesktop so that we can get to topFloat} 
PROCEDURE CPrinter.PrintPageRange (firstPage, lastPage: Integer); 

VAR 
	{ - - - - - } 
	docName, topWindowTitle: Str255; 
	theTopWindow: CWindow; 
	{ - - - - - } 

BEGIN 
CatchFailures(fi, HandleFailure); 
IF Member(gDesktop, CFWDesktop) THEN 				{If we are using floating windows,} 
	theTopWindow := CFWDesktop(gDesktop).topFloat; 	{ get the topmost floating window.} 
IF theTopWindow = NIL THEN 						{If no floating windows,} 
	theTopWindow := gDesktop.GetTopWindow; 			{ get the topmost regular window.} 
IF theTopWindow NIL THEN 						{let laser driver show correct name} 
	BEGIN 
	theTopWindow.GetTitle(topWindowTitle); 
	itsDocument.GetName(docName); 
	theTopWindow.SetTitle(docName); {temporarily give doc's name to whatever is on top, regardless of what it is} 
	END; 
{ - - - - - } 
IF theTopWindow NIL THEN {restore top window's correct name} 
	theTopWindow.SetTitle(topWindowTitle); 
END;

Submitted by Kevin Killion, kevin@shsmedia.com


SMALL TWEAKS



Change the name of a variable to more accurately identify what it is

{OLD} 
{FUNCTION CPrinter.DoPageSetup: Boolean;} 
VAR 
	changed: Boolean; (* Has print record changed? *) 

{NEW} 
{FUNCTION CPrinter.DoPageSetup: Boolean;} 
VAR 
	userClickedOK: Boolean; (* Did user click the "OK" button? *)

Submitted by Kevin Killion, kevin@shsmedia.com



Change names of two instance variables to avoid confusion between CDataFile and CRefFile:

Submitted by Kevin Killion, kevin@shsmedia.com


NEW FEATURES



Method added to CResFile to add a new resource to the file. Also needs to be listed in the CResFile definition in MoreTCL.p

PROCEDURE CResFile.NewResource (theHandle: Handle; rType: ResType; rID: integer; rName: str255); 

VAR 
	savedRefnum: integer; 

BEGIN 
IF IsOpen THEN 
	BEGIN 
	savedRefnum := CurResFile; 
	MakeCurrent; 
	AddResource(theHandle, rType, rID, rName); 
	FailResError; 
	UseResFile(savedRefnum); 
	WriteResource(theHandle); 
	FailResError; 
	UpdateResFile(rfRefNum); 
	FailResError; 
	FailOSErr(FlushVol(NIL, volNum)); 
	END 
ELSE 
	Failure(fnOpnErr, 0); 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Changes to support additional spacing commands

{UNIT TCL.p} 
CONST 
	cmdSingleSpace = 50; 
	cmd1HalfSpace = 51; 
	cmdDoubleSpace = 52; 
	cmdNarrowSpacing = 1026; {make text spacing narrower (added by KK) } 
	cmdWidenSpacing = 1027; {make text spacing wider (added by KK) } 

{unit CEditText} 
PROCEDURE CEditText.SetSpacingCmd (aSpacingCmd: Longint); 

VAR 
	{---} 
	normalSpacing: integer; 
	{---} 

BEGIN 
{---} 
{old:} 
macTE^^.lineHeight := macFontInfo.ascent + macFontInfo.descent + macFontInfo.leading; 
macTE^^.lineHeight := macFontInfo.ascent + macFontInfo.descent + macFontInfo.leading; 
macTE^^.fontAscent := macFontInfo.ascent; 
CASE aSpacingCmd OF 
	cmdSingleSpace: extra := 0; 
	cmd1HalfSpace: extra := macTE^^.lineHeight DIV 2; 
	cmdDoubleSpace: extra := macTE^^.lineHeight; 
	END; 
macTE^^.lineHeight := macTE^^.lineHeight + extra; 

{now:} 
normalSpacing := macFontInfo.ascent + macFontInfo.descent + macFontInfo.leading; 
extra := macTE^^.lineHeight - normalSpacing; {see if there already was some extra} 
macTE^^.fontAscent := macFontInfo.ascent; 
CASE aSpacingCmd OF 
	cmdSingleSpace: extra := 0; 
	cmd1HalfSpace: extra := normalSpacing DIV 2; {extra: half again as much} 
	cmdDoubleSpace: extra := normalSpacing; 
	cmdNarrowSpacing: extra := extra - 1; 
	cmdWidenSpacing: extra := extra + 1; 
	END; 
macTE^^.lineHeight := normalSpacing + extra; 
{---} 
END; 

{unit CAbstractText} 
{in CAbstractText.DoCommand (theCommand: Longint), change:} 
{ old: (other stuff), cmdSingleSpace, cmd1HalfSpace, cmdDoubleSpace: } 
{ doMakeStyleTask := TRUE; } 
{ new: (other stuff), cmdSingleSpace, cmd1HalfSpace, cmdDoubleSpace, cmdNarrowSpacing, cmdWidenSpacing: } 
{ doMakeStyleTask := TRUE; } 

{unit CTextStyleTask} 
{in CTextStyleTask.DoTask, change:} 
{ old: cmdSingleSpace, cmd1HalfSpace, cmdDoubleSpace: } 
{ new: cmdSingleSpace, cmd1HalfSpace, cmdDoubleSpace, cmdNarrowSpacing, cmdWidenSpacing: }

Submitted by Kevin Killion, kevin@shsmedia.com



Changes to support stationery; 8/1/95

{Revise OpenDocument to accept finder flags} 
PROCEDURE CApplication.OpenDocument (macSFReply: SFReply; finderFlags: integer); 

BEGIN 
END; 

{Also make this change to the original declaration in TCL.p} 

{Revise DoCommand's processing of cmdOpen, to get finder flags and pass them to OpenDocument} 
PROCEDURE CApplication.DoCommand (theCommand: Longint); (* Command number *) 

VAR 
	fndrInfo: FInfo; {added by KCK, 8/1/95} 
	finderFlags: integer; {added by KCK, 8/1/95} 
	{ - - - - - } 

BEGIN 
{ - - - - - } 
IF gSystem.systemVersion >= $0700 THEN 
	BEGIN 
	WITH macSFReply DO 
		err := GetFInfo(fName, vRefNum, fndrInfo); 
	finderFlags := fndrInfo.fdFlags; 
	END 
ELSE 
	finderFlags := 0; 
OpenDocument(macSFReply, finderFlags); 
{ - - - - - } 
END; 

{Revise Preload to get finder flags and pass them to OpenDocument} 
PROCEDURE CApplication.Preload; 

VAR 
	fndrInfo: FInfo; {added by KCK, 8/1/95} 
	finderFlags: integer; {added by KCK, 8/1/95} 
	{ - - - - - } 

BEGIN 
{ - - - - - } 
{Get finder flags so that OpenDocument can determine whether this is stationery} 
{added by KCK, 8/1/95} 
IF gSystem.systemVersion >= $0700 THEN 
	BEGIN 
	WITH macSFReply DO 
		err := GetFInfo(fName, vRefNum, fndrInfo); 
	finderFlags := fndrInfo.fdFlags; 
	END 
ELSE 
	finderFlags := 0; 
OpenDocument(macSFReply, finderFlags); 
{ - - - - - } 
END; 

{Revise DoOpenOrPrintDocEvent to get finder flags and pass them to OpenDocument} 
PROCEDURE CApplication.DoOpenOrPrintDocEvent (theEvent: CAppleEvent); 

BEGIN 
{ - - - - - } 
{Get finder flags so that OpenDocument can determine whether this is stationery} 
{added by KCK, 8/1/95} 
IF gSystem.systemVersion >= $0700 THEN 
	finderFlags := fileInfo.fdFlags ELSE finderFlags := 0; 
OpenDocument(reply, finderFlags); 
{ - - - - - } 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



{Added a "DrawSICNMode" routine to TCL.p, by modifying the existing DrawSICN routine}



Changes in order to implement handling of a "Repeat" command

{TCL.p} 
cmdRepeat = 1025; 
{in definition of CBartender:} 
lastCommandNum: longint; 
{instance variables added by KK to implement "Repeat" command} 
mayHaveRepeatCommand: Boolean; 

PROCEDURE CDesktop.DispatchClick (VAR macEvent: EventRecord); (* Mouse down event record *) 

BEGIN 
{---} 
CASE thePart OF 
	{---} 
	inMenuBar: (* Selection from a menu *) 
			BEGIN 
			{--- OLD ---} 
			IF HiWord(theMenuChoice) 0 THEN { a selection was made. Execute the corresponding command.} 
				gGopher.DoCommand(gBartender.FindCmdNumber(HiWord(theMenuChoice), LoWord(theMenuChoice))); 

			{--- NEW ---} 
			IF HiWord(theMenuChoice) 0 THEN { a selection was made. Execute the corresponding command.} 
				gBartender.DispatchCommand(gBartender.FindCmdNumber(HiWord(theMenuChoice), 
							LoWord(theMenuChoice))); 
			END; 
	{---} 
	END; 
{---} 
END; 

PROCEDURE CSwitchboard.DoKeyEvent (macEvent: EventRecord); (* The keyboard event *) 

BEGIN 
{---} 
{--- OLD ---} 
IF (HiWord(menuChoice) 0) THEN 
	BEGIN 
	gGopher.DoCommand(gBartender.FindCmdNumber(HiWord(menuChoice), LoWord(menuChoice))); (* Unhighlight the menu title *) 
	HiliteMenu(0); 
	END; 

{--- NEW ---} 
IF (HiWord(menuChoice) 0) THEN 
	BEGIN 
	gBartender.DispatchCommand(gBartender.FindCmdNumber(HiWord(menuChoice), LoWord(menuChoice))); 
	HiliteMenu(0); 
	END; 
{---} 
END; 

PROCEDURE CBartender.IBartender (MBARid: integer); 

BEGIN 
{---} 
lastCommandNum := 0; {instance variables added by KK to implement "Repeat" command} 
mayHaveRepeatCommand := TRUE; 
{---} 
END; 

PROCEDURE CBartender.GetCmdText; 

BEGIN 
{revised so that if command cannot be found, returned text is set to ""} 
END; 

PROCEDURE CBartender.UpdateAllMenus; 

VAR 
	{---} 
	MENUid, itemNo: integer; 
	rptCmdText, lastCmdText: Str255; 

BEGIN 
{--- disable everything ---} 
{--- call "gGopher.UpdateMenus" so that the host application enables all of the menu items it permits ---} 
{the Repeat command is only enabled if the command it intends to repeat is also enabled} 
IF (lastCommandNum 0) & mayHaveRepeatCommand THEN 
	BEGIN 
	{Prepare to fix the wording of the Repeat command} 
	GetCmdText(cmdRepeat, rptCmdText); 
	{Get text of the "Repeat Xxxxxx" command} 
	IF rptCmdText = '' THEN 
		mayHaveRepeatCommand := FALSE 
	ELSE 
		BEGIN
		i := POS(' ', rptCmdText); 
		{Is the word "Repeat" followed by a space?} 
		IF i > 0 THEN {If so, then it says name of last command it tried to repeat} 
			BEGIN 
{$PUSH} 
{$R-} 
			rptCmdText[0] := CHR(i - 1); 
{$POP} 
			END; 
		{now see if the last command is still available} 
		FindMenuItem(lastCommandNum, MENUid, macMenu, itemNo); 
		IF (MENUid NOTHING) & (itemNo <= 31) & BTST(macMenu^^.enableFlags, itemNo) THEN 
			BEGIN 
			{last command IS ok to use, enable the Repeat command and fix its name accordingly} 
			EnableCmd(cmdRepeat); GetCmdText(lastCommandNum, lastCmdText); 
			SetCmdText(cmdRepeat, CONCAT(rptCmdText, ' ', lastCmdText)); 
			END 
		ELSE 
			SetCmdText(cmdRepeat, rptCmdText); 
		END; 
	END; 
END; 

PROCEDURE CBartender.DispatchCommand (cmdNo: longint); 

VAR 
	MENUid: integer; 
	macMenu: MenuHandle; 
	itemNo: integer 

BEGIN 
IF (lastCommandNum 0) & (repeatCommandNum 0) & (repeatCommandNum = cmdNo) THEN 
	BEGIN 
	{REPEAT Command} 
	{determine if the last command is currently enabled -- can't repeat it if it's disabled} 
	FindMenuItem(lastCommandNum, MENUid, macMenu, itemNo); 
	IF (MENUid NOTHING) & (itemNo <= 31) & BTST(macMenu^^.enableFlags, itemNo) THEN 
		BEGIN 
		cmdNo := lastCommandNum; 
		gGopher.DoCommand(cmdNo); 
		END; 
	END 
ELSE 
	BEGIN 
	lastCommandNum := cmdNo; 
	gGopher.DoCommand(cmdNo);
	END; 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



CClipboard.p -- Two new methods provide simpler access to a number or text on the Clipboard. They are added immediately after GetData:

FUNCTION CClipboard.GetString (VAR clipString: str255): Boolean; 

VAR 
	theData: Handle; 
	sss: str255; 
	len: longint; 

BEGIN 
IF GetData('TEXT', theData) THEN 
	BEGIN 
	len := GetHandleSize(theData); 
	IF len > 255 THEN 
		len := 255; 
	BlockMove(theData^, PTR(1 + ORD4(@sss)), len); 
{$PUSH} 
{$R-} 
	sss[0] := CHR(len); 
{$POP} 
	ForgetHandle(theData); 
	clipString := sss; 
	GetString := TRUE; 
	END 
ELSE 
	BEGIN 
	clipString := ''; 
	GetString := FALSE; 
	END; 
END; 

FUNCTION CClipboard.GetNum (VAR num: longint): Boolean; 

VAR 
	sss: str255; 

BEGIN 
IF GetString(sss) THEN 
	BEGIN 
	StringToNum(sss, num); 
	GetNum := TRUE; 
	END 
ELSE 
	BEGIN num := 0; 
	GetNum := FALSE; 
	END; 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



CFile.p -- ResolveFileAlias is used by the file specification calls; changed because we don't want to Fail if resolve fails

PROCEDURE CFile.ResolveFileAlias; 

BEGIN 
{---} 
{OLD version:} 
{ FailOSErr(ResolveAliasFile(fileSpec, TRUE, isFolder, wasAliased)); } 

{NEW version:} 
dummy := ResolveAliasFile(fileSpec, TRUE, isFolder, wasAliased); 
{ignore error} 
{---} 
END;

{-----------}

KCK change 2/18/94: special handling for aliases. If alias file exists but can't be resolved, then ExistsOnDisk=FALSE

{OLD VERSION:} 
FUNCTION CFile.ExistsOnDisk: Boolean; 

VAR 
	fileInfo: FInfo; 
	err: Integer; 

BEGIN 
err := HGetFInfo(volNum, dirID, name, fileInfo); 
ExistsOnDisk := err = noErr; 
END; 

{NEW VERSION:} 
FUNCTION CFile.ExistsOnDisk: Boolean; 

VAR 
	fileInfo: FInfo; 
	err: Integer; 
	fileSpec: FSSpec; 
	isFolder: Boolean; 
	wasAliased: Boolean; 

BEGIN 
IF gSystem.hasAliasMgr THEN {test for existence with ResolveAliasFile} 
	BEGIN 
	fileSpec.name := name; 
	fileSpec.parID := dirID; 
	fileSpec.vRefNum := volNum; 
	err := ResolveAliasFile(fileSpec, TRUE, isFolder, wasAliased); 
	ExistsOnDisk := (err = noerr) & (NOT isFolder); 
	{spec points to a real thing, and it's not a folder} 
	IF wasAliased THEN 
		BEGIN 
		(* copy back resolved specification*) 
		name := fileSpec.name; 
		dirID := fileSpec.parID; 
		volNum := fileSpec.vRefNum; 
		END; 
	END 
ELSE {test for existence with HGetFInfo} 
	BEGIN 
	err := HGetFInfo(volNum, dirID, name, fileInfo); 
	ExistsOnDisk := err = noErr; 
	END; 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Add a flag variable to CDocument, so that we have a record of whether the user clicked OK to the last page setup dialog

{In PROCEDURE CDocument.IDocument...} 
{lastPageSetupOK := TRUE;} 
PROCEDURE CDocument.DoCommand (theCommand: Longint); 

{---} 
BEGIN 
CASE theCommand OF 

{--- OLD ---} 
	cmdPageSetup: 	IF (itsPrinter NIL) THEN ignore := itsPrinter.DoPageSetup; 

{--- NEW ---} 
	cmdPageSetup: 	BEGIN 
				lastPageSetupOK := FALSE; 
				IF (itsPrinter NIL) THEN 
					lastPageSetupOK := itsPrinter.DoPageSetup; 
				END; 
	{---} 
	END; 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Add a "creationDateTime" instance variable to CDocument.p. I wanted it to be a part of CDocument rather than my subclass so that all units could all reach it.

{ TCL.p: add this item to CDocument: } 
{ creationDateTime: longint; } 
PROCEDURE CDocument.IDocument (aSupervisor: CApplication; printable: Boolean); 

BEGIN 
{---} 
GetDateTime(creationDateTime); 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



We want an edited text object to have an edit area that is fully the same height as the text object. There may be some better way to handle this (SetWholeLines does NOT do the job), be we didn't find a nice way. This works for now.

{PROCEDURE CEditText.IEditText; } 
wholeLines := FALSE; 
{changed to FALSE by KK on 8/24/93, previously was TRUE}

Submitted by Kevin Killion, kevin@shsmedia.com



Add a new method to CPrinter to conduct the print job dialog. This had been a line in the CPrinter.DoPrint method. We are making it a separate method so that we can more easily override it. We do that in order to add custom items to our print dialog -- see KPrinter.

FUNCTION CPrinter.ConductJobDialog: Boolean; 

{NEW METHOD} 
BEGIN 
ConductJobDialog := PrJobDialog(THPrint(macTPrint)); 
END; 

PROCEDURE CPrinter.DoPrint; 

{REVISED} 
BEGIN 
{---} 
{ORIGINAL:} 
wantsToPrint := PrJobDialog(THPrint(macTPrint)); 

{REVISED:} 
wantsToPrint := ConductJobDialog;
{---} 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Revise CApplication.SetUpMenus so that commands with cmd numbers on the Apple menu are dimmed by default. This is needed to allow us control over a Help command on the Apple menu.

PROCEDURE CApplication.SetUpMenus; 

BEGIN 
{---} 
{ORIGINAL:} 
gBartender.SetDimOption(MENUapple, dimNONE); 

{REVISED:} 
gBartender.SetDimOption(MENUapple, dimSOME); 
{---}
END; 

PROCEDURE KFlowApp.UpdateMenus; 

BEGIN 
{---} 
{ADDED:} 
gBartender.EnableCmd(cmdAbout); 
{we now explicitly enable cmdAbout} 
{---} 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



More support for "MenuChoice" so that we can provide help if user tries to choose a greyed-out cmd

PROCEDURE CDesktop.DispatchClick (VAR macEvent: EventRecord); 

(* Mouse down event record *) 
VAR 
	{---} 
	menuChoice: Longint; 
{ORIGINAL} 
	theMenuChoice: Longint; 

{REVISED} 
BEGIN 
{---} 
CASE thePart OF 
{ORIGINAL:} 
	inMenuBar: 	BEGIN 
				gBartender.UpdateAllMenus; 
				menuChoice := MenuSelect(macEvent.where); 
				IF (HiWord(menuChoice) 0) THEN 
					(* A selection was made. Execute *) 
					(* the corresponding command. *) 
					gGopher.DoCommand(gBartender.FindCmdNumber(HiWord(menuChoice), LoWord(menuChoice))); 
				(* Unhighlight the menu title *) 
				HiliteMenu(0); 
				END; 

{REVISED:} 
	inMenuBar: 	BEGIN 
				gBartender.UpdateAllMenus; 
				theMenuChoice := MenuSelect(macEvent.where); 
				IF theMenuChoice = 0 THEN {user has either "selected" a greyed-out menu item, or dragged off of a hierarchical menu} 
					BEGIN 
					theMenuChoice := MenuDisable^; 
					{see if command was actually greyed-out; if so, call GreyCommand} 
					theCommand := gBartender.FindCmdNumber(HiWord(theMenuChoice), LoWord(theMenuChoice)); 
					FindMenuItem(theCommand, MENUid, macMenu, itemNo); 
					IF (MENUid NOTHING) & (itemNo <= 31) & BTST(macMenu^^.enableFlags, itemNo) THEN 
						gApplication.GreyCommand(theCommand); 
					END 
				ELSE IF HiWord(theMenuChoice) 0 THEN { a selection was made. Execute the corresponding command.} 
					gGopher.DoCommand(gBartender.FindCmdNumber(HiWord(theMenuChoice), LoWord(theMenuChoice))); 
				HiliteMenu(0);  {Unhighlight the menu title} 
				END; 
	END; 
{---} 
END;

GreyCommand -- added by KCK, 7/23/93

Notify app that the user has tried to choose a greyed-out command. This is useful for perhaps providing a helpful alert. Our default action: Search for a 'HLPC' (help command) resource with the same ID as the command number. HLPC resources are in the same format as 'STR ' resources. Show this string in an alert.

PROCEDURE CApplication.GreyCommand (theCommand: Longint); {command number} 

VAR 
	sh: StringHandle; 
	temp: integer; 

BEGIN 
IF theCommand > 0 THEN 
	BEGIN 
	sh := StringHandle(GetResource('HLPC', theCommand)); 
	IF sh NIL THEN 
		BEGIN 
		ParamText(sh^^, '', '', ''); 
		PositionDialog('ALRT', ALRTgeneral); 
		InitCursor; 
		temp := Alert(ALRTgeneral, NIL); 
		DisposHandle(Handle(sh)); 
		END; 
	END; 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Some changes are required to use range checking with TCL:

FUNCTION CDLOGDialog.AddDITLStatText (aWidth: Integer; 
							aHeight: Integer; 
							hEncl: Integer; 
							vEncl: Integer; 
							enclosure: CView; 
							ditlItem: tDITLItemPtr): CPane; 

BEGIN 
{---} 
{$PUSH} 
{$R-} 
atSign := (StringPtr(@ditlItem^.itemData[0])^[0] = '@');  {to avoid string range err} 
{$POP} 
IF atSign THEN 
	{---} 
{---} 
END; {in CDLOGDialog unit...} 

{Reverse short-circuited args so that text[i] isn't used until we are sure that i is in legal range} 
PROCEDURE CollectUntil (delimiter: Char; 
				VAR text: Str255; 
				VAR index: Integer; 
				VAR returnStr: Str255); 

BEGIN 
{---} 
WHILE (i <= limit) & (text[i] delimiter) DO {new version, KK} 
	; 
WHILE (text[i] delimiter) & (i <= limit) DO {old version} 
	; 
END;

MORE CHANGES DUE TO ADDING RANGE CHECKING TO TCL CLASSES:

Submitted by Kevin Killion, kevin@shsmedia.com



Process1Event revised for smarter handling of urgent chores.

We have modified the method used to process all urgent chores. In the original TCL, urgent chores could not post other urgent chores. This means that a chore couldn't do anything that might have caused a menu bar update, since that is an urgent chore. That's ugly. So now, we first detach the cluster of chores to be done, and re-init the app's chore list. Then, we do our chores. If one of them causes a new urgent chore, everything is fine because it will get posted to that new list, not the one we are working our way through.

PROCEDURE CApplication.Process1Event; 

CONST 
	kevinImproved = TRUE; {added by KK, 5/3/93} 

VAR 
	aDAIsActive: Boolean; 
	minSleep: Longint; 
	thingsToDo: CCluster; {added by KK, 5/3/93} 

PROCEDURE Chore_Perform (theChore: CChore); 
	
VAR 
	maxSleep: Longint; 

BEGIN 
maxSleep := MAXLONGINT; 
theChore.Perform(maxSleep); 
END; 

BEGIN 
aDAIsActive := IsSystemWindow(WindowPeek(FrontWindow)); {Is a DA the front window?} 
gDesktop.Cleanup; 
itsSwitchboard.ProcessEvent; 
{A user command may have initiated a critical operation, e.g. Save, but it is complete once the event is handled} 
SetCriticalOperation(FALSE); 
tempAllocation := 0; 
{any temporary allocations should have been released by now} 
gLastError := 0; 
gLastMessage := 0; 
IF urgentsToDo THEN {Carry out urgent chores} 
	BEGIN 
	IF kevinImproved THEN 
		BEGIN 
		thingsToDo := itsUrgentChores; 
		{detach list of things to do, and} 
		NEW(itsUrgentChores); 
		{reset the "urgent" list back to empty} 
		itsUrgentChores.ICluster; 
		urgentsToDo := FALSE; 
		thingsToDo.DoForEach(Chore_Perform); 
		{Now we can process those things w/o worrying} 
		thingsToDo.DisposeAll; 
		{whether they might post urgent tasks themselves} 
		END 
	ELSE 
		BEGIN 
		itsUrgentChores.DoForEach(Chore_Perform); 
		itsUrgentChores.DisposeItems; 
		urgentsToDo := FALSE; 
		END; 
	END; 
IF IsSystemWindow(WindowPeek(FrontWindow)) THEN {Check for context-switch with Desk Accessories} 
	BEGIN 
	gSleepTime := 0; 
	IF NOT aDAIsActive THEN 
		BEGIN 
		aDAIsActive := TRUE; 
		SwitchToDA; 
		END; 
	END 
ELSE 
	BEGIN 
	IF (aDAIsActive) THEN 
		BEGIN 
		aDAIsActive := FALSE; 
		SwitchFromDA; 
		END; 
	END; 
ForceNextPrepare; 
ForgetObject(unhandledTask); 
END;

Submitted by Kevin Killion, kevin@shsmedia.com



Open Issues, Mystery Bugs and Other Puzzlements

Here are some issues and reported bugs awaiting a good answer or solution. If you can supply any insight on any of these, please write!


Send Mail!
SEND YOUR TCL FIXES!

Your submissions, bug fixes, new classes are heartily welcomed! The more of us who contribute our discoveries and inventions, the better for all of us. I will gladly add your materials to this page, with your name duly credited. All I ask is that you make your submission as "camera-ready" as possible for inclusion on this page.

I make no pretense that this page is complete, well-written, or well-edited. It is simply offered to fill the gap that exists for material about TCL Pascal. If someone (anyone!) can suggest a better web source, or would like to take a crack at creating one, that would be great for the whole community. In the meantime, please be gentle with your criticisms -- this page about TCL Pascal is like sex -- even if it's bad, it's better than nothing at all.

[ Return to Contents ]


Copyright © 1996 Kevin Killion. All Rights Reserved.