/* EXTEND.LOD - Actor development extensions load file * Copyright(C) 1991 Steve Hatchett. All rights reserved. * Steve Hatchett 14352 Mussey Grade Rd. * CIS: 70304,1423 Ramona, CA 92065 * Use this file to load the development environment * extensions for use with the Actor programming * language. * load("extend.lod"); * load(); */ #define MAXSOURCENEST 5; /* max directory nesting */ Actor[#Programmer] := " "; /* set this in workspace */ Actor[#StampText] := "Stamp";/* time stamp header. Another * useful stamp header would be * "Copyright (C) 1991 XYZ, Inc."*/ LoadFiles := { /* Your path may be different. */ load(new(SourceFile),"c:\actor\general\classes\string.clx"); load(#("classes\extsource.cls" "c:\actor\general\classes\symbol.clx")); /* The minimum code necessary to navigate the directory * hierarchy has now been loaded, paths are no longer needed. */ do(#(Behavior Browser ClassDialog ClVarDialog Function SourceFile System ToolWind WorkEdit), {using(cl) loadExtensions(cl); }); }!! ----------------------------------------------------------------- /* EXTSOURCE.CLS - Actor development extensions Copyright (C) 1991 Steve Hatchett. All rights reserved. Provides access to class source code. Allows the source code for a class to be contained in more than one file ordered hierarchically by directory structure. There is one .cls file containing the actual class definition. Additional .clx files may be exist at lower levels of the hierarchy. They can contain methods and class initialization code. */!! inherit(Object, #ExtSourceFiler, #(clName /* Name of class being handled. */ ownsClass /* True if the .cls file for class is in this session's directory. */ fileNames /* Source code file names with paths. */ ownsLast /* True if we owned the last method we read. */), 2, nil)!! now(class(ExtSourceFiler))!! /* Return a new ExtSourceFiler, initialized to handle source code for the class whose name Symbol was given. */ Def openClass(self className) { ^init(new(self),className); } !! now(ExtSourceFiler)!! /* Load class extension files (.clx) for the class, but don't load the class file (.cls). This is useful for loading extensions to the standard Actor classes. Looks for all files in CLASSES subdirectories. */ Def loadExtensions(self | work fNames fnm) { work := loadString(332); if size(fileNames) > 0 cand subString(first(fileNames),0,size(work))=work fileNames[0] := loadString(331) + getFileName(self); if not(exists(File,fileNames[0],0)) removeFirst(fileNames); endif; endif; if size(fileNames) > 0 fNames := copy(fileNames); fnm := last(fNames); if fnm[size(fnm)-1] == 's' pop(fNames); /* removes the .cls file */ endif; ^do(reverse(fNames), {using(fnm) load(new(SourceFile),fnm); }); endif; ^nil; }!! /* Recompile the class by loading all its source code. Looks in WORK for own source file if class is dirty. */ Def recompile(self) { ^do(reverse(fileNames), {using(fnm) load(new(SourceFile),fnm); }); }!! /* Return an open SourceFile with given file name (which should include path). */ Def openSourceFile(self fName | sFile) { sFile := new(SourceFile); setName(sFile,fName); if not(open(sFile,0)) errorBox(loadString(311), clName + loadString(312)+fName+"."); ^nil; endif; ^sFile; }!! /* If no source file exists for the class at the directory level of this actor session, then create an extension file in WORK, and mark the class as dirty. */ Def mustHaveOwn(self | sFile) { if size(fileNames) == 0 cor first(fileNames)[0] == '.' add(DirtyClasses,clName); insert(fileNames,loadString(332) +subString(clName,0,8)+".clx",0); makeClassExtFile(new(SourceFile),self); endif; }!! /* Replace the the fSym method text with methtext, or add the method text if it wasn't already in the source file. The mode determines whether the method is a class or object method. These changes will only be made in the source file owned by this actor session. Returns nil if not successful. */ Def saveMethText(self methtext fSym mode | rFile wFile) { mustHaveOwn(self); if (rFile := openClass(SourceFile,self)) wFile := saveMethText(rFile,methtext,fSym,mode); reName(wFile,(fileNames[0] := condDelCFile(rFile,self))); endif; ^rFile; }!! /* Replace the the class initialization code, with the given code. The change will only be made in the source file owned by this actor session. Returns nil if not successful. */ Def replaceClassInit(self text | rFile wFile) { mustHaveOwn(self); if (rFile := openClass(SourceFile,self)) wFile := replaceClassInit(rFile,text); reName(wFile,(fileNames[0] := condDelCFile(rFile,self))); close(rFile); endif; ^rFile; }!! /* Return the class init code for this class as a TextCollection. */ Def readClassInit(self | rFile text) { /* look through source files until some * class initialization text is found. */ ownsLast := false; do(fileNames,{using(fnm) if (rFile := openSourceFile(self,fnm)) text := readClassInit(rFile); close(rFile); if size(text) > 0 ownsLast := (fnm[0] <> '.'); ^text; endif; endif; }); ^new(TextCollection,5); }!! /* Remove the fSym method text if it is found in the source file owned by this actor session. The mode determines whether the method is a class or object method. Returns nil if not successful or if the method was not in the owned source file. */ Def removeMethod(self fSym mode | rFile wFile) { if size(fileNames) > 0 cand first(fileNames)[0] <> '.' cand (rFile := openClass(SourceFile,self)) if wFile := replaceMethod(rFile,nil,fSym,mode) reName(wFile,(fileNames[0] := condDelCFile(rFile,self))); endif; close(rFile); endif; ^wFile; }!! /* Load the class by loading all its source code. Looks in CLASSES for all source files. */ Def load(self | work) { work := loadString(332); if size(fileNames) > 0 cand subString(first(fileNames),0,size(work))=work fileNames[0] := loadString(331) + getFileName(self); if not(exists(File,fileNames[0],0)) removeFirst(fileNames); endif; endif; ^do(reverse(fileNames), {using(fnm) load(new(SourceFile),fnm); }); } !! /* Return true if the last method read using loadMethText was from a source file at the directory level of this actor session. */ Def ownsLast(self) { ^ownsLast; }!! /* Initialize a new ExtSourceFiler. */ Def init(self nm | metaNm) { if class(nm) <> Symbol nm := name(nm); endif; if (metaNm := isMetaName(nm)) clName := name(value(metaNm)); else clName := nm; endif; getFileNames(self); }!! /* Return true if the .cls file for the class this filer is handling exists at the directory level of this actor session. */ Def ownsClass(self) { ^ownsClass; }!! /* Return the text of aMethod. Note accordingly if the source code is missing. The mode indicates type of method, either class (BR_CMETH) or object (BR_OMETH). Looks through all the source files for the class. */ Def loadMethText(self aMethod mode | text rFile) { /* look through source files until the * text for the given method is found. */ ownsLast := false; rFile := new(SourceFile); do(fileNames,{using(fnm) if not(rFile := openSourceFile(self,fnm)) errorBox(loadString(311), clName +loadString(312)+fnm+"."); else text := findMethod(rFile,aMethod,mode); close(rFile); if text ownsLast := (fnm[0] <> '.'); ^leftJustify(text[0]); endif; endif; }); ^aMethod + loadString(310); }!! /* Return the class's name the way Behavior would do it. */ Def name(self) { ^clName; }!! /* Return the class's filename the way Behavior would do it. */ Def getFileName(self | dir) { /* return name + ext */ ^subString(clName,0,8) + if ownsClass ".cls" else ".clx" endif; }!! /* Get the names of the files containing this class' source code. */ Def getFileNames(self | dir fRoot base) { fileNames := new(OrderedCollection,MAXSOURCENEST); dir := loadString(if clName in DirtyClasses 332 else 331 endif); base := subString(clName,0,8); fRoot := dir + base; do(MAXSOURCENEST, {using(i | fnm) /* if the original .cls file or a .clx file is * found for the class, add it to list if it's * above this session's directory. */ if exists(File,(fnm:=fRoot+".cls"),0) add(fileNames,fnm); if i==0 ownsClass := true; endif; ^fileNames; endif; if exists(File,(fnm:=fRoot+".clx"),0) add(fileNames,fnm); endif; /* construct the path name of the next higher level. */ if i==0 fRoot := "..\classes\"+base; else fRoot := "..\"+fRoot; endif; }); ^fileNames; }!! /* Return the names of the files containing this class' source code (including own source file). */ Def fileNames(self) { ^fileNames; }!! ----------------------------------------------------------------- /* BEHAVIOR.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(Behavior))!! now(Behavior)!! /* Backup the original class source file by moving it to the BACKUP directory. Then move the source file in WORK directory to the CLASSES directory. swh modified to support extended source files */ Def bak_Save(self | name, theFile) { name := getFileName(self); /* mod to support extended source files */ if not(exists(File,loadString(332)+name,0)) name[size(name)-1] := 'x'; endif; /* end mod */ theFile := new(File); ... }!! /* Return true is the .cls file defining this class exists at the directory level of this actor session. */ Def isOwnClass(self | dir fileName) { dir := loadString(if name in DirtyClasses 332 else 331 endif); fileName := subString(name,0,8)+".cls"; if exists(File,dir+fileName,0) ^fileName; else ^nil; endif; }!! ----------------------------------------------------------------- /* BROWSER.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(Browser))!! now(Browser)!! /* Setup for editing a newly selected or created class. swh modified to support extended source files */ Def initClassEdit(self | class, clsStrNum) {... if selClass /* mod to support extended source files * show ownership info in title bar. */ setTitleClass(self); if mode == BR_CMETH class := class(selClass); else class := selClass; endif; /* end mod */ loadMethods(self); ... }!! /* Let ancestor save the method text, then reset the method name in the title bar since ownership could have changed. */ Def saveMethText(self text fSym | ret) { if fSym cand (ret := saveMethText(self:ancestor,text,fSym)) setTitleMethod(self,asString(fSym),true); endif; ^ret; }!! /* Set the title bar to the selected class, placing brackets around unowned class. */ Def setTitleClass(self | classNm text) { text := name(class(self)); if selClass classNm := name(if mode == BR_CMETH class(selClass) else selClass endif); text := text + " " + (if isOwnClass(selClass) classNm else "<" + classNm + ">" endif); endif; setText(self,text); }!! /* Add the method name portion of the title bar, replacing previous method name if any. Place brackets around unowned method name. The own parameter is true if we own the method. */ Def setTitleMethod(self methodName own | text idx methText) { text := getText(self); idx := indexOf(text,':',0) cor size(text); methText := ":" + if own methodName else "<" + methodName + ">" endif; setText(self,replace(text,methText,0,size(methText), idx,size(text))); }!! /* See if the user wants to overwrite class init code. swh modified to support extended source files */ Def saveClassInit(self | rFile, wFile, txt) { if (new(ErrorBox, self, loadString(384), loadString(383), 1) = IDOK) cand /* mod to support extended source files */ (rFile := openClass(ExtSourceFiler, selClass)) replaceClassInit(rFile, txt := workText(ew)); /* end mod */ makeDirty(self); initClassEdit(self); endif; }!! /* Load the class init code into Browser's edit window. swh rewritten to support extended source files */ Def loadClassInit(self | rFile text) { if doDirtyWork(self) cand (rFile := openClass(ExtSourceFiler, selClass)) loadMethods(self); /* Reload the method list box with no selection */ text := readClassInit(rFile); setTitleMethod(self,"Class Init",text cand ownsLast(rFile)); if size(text) = 0 add(text, "/* "+name(selClass)+" Class Initialization Code */"); endif; setWorkText(ew, text); repaint(ew); endif; }!! /* Remove the selected method from the selected class. swh modified to support extended source files */ Def delSelMethod(self | cls method rFile wFile fName selIdx) {... initCache(); /* mod to support extended source files */ if rFile := openClass(ExtSourceFiler, selClass) showWaitCurs(); if removeMethod(rFile, nil, method, mode) makeDirty(self); endif; showOldCurs(); /* end mod */ endif; loadMethods(self); ... }!! /* Load and return the text for the selected method. If the source code for the selected method isn't found, return nil. swh modified to support extended source files. */ Def loadSelMethod(self | rFile) { showWaitCurs(); selMethod := getSelMethod(lb2); /* mod to support extended source files */ rFile := openClass(ExtSourceFiler,selClass); copyMethod(ew,loadMethText(rFile,selMethod,mode) cor ""); setTitleMethod(self,selMethod,ownsLast(rFile)); /* end mod */ enableMenuItem(self, BR_DELME); repaint(ew); setFocus(ew); showOldCurs(); }!! ----------------------------------------------------------------- /* CLASSDIA.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(ClassDialog))!! now(ClassDialog)!! /* Fill dialog with class information. swh mod to support extended source files */ Def initDialog(self, wp, lp | ivars) { if theClass then /* About Class */ /* mod to support extended source files * If we don't 'own' the class, show this in * the title bar, and don't allow user to accept * changes to class. */ if not(isOwnClass(theClass)) disableItem(self,IDOK); setText(self,getText(self)+" (NOT class owner)"); endif; /* end mod */ disableItem(self, CLASS_NAME); ... }!! ----------------------------------------------------------------- /* CLVARDIA.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(ClVarDialog))!! now(ClVarDialog)!! /* Initialize the dialog text. swh mod to support extended source files */ Def initDialog(self, wp, lp) { /* mod to support extended source files * If we don't 'own' the class, show this in * the title bar, and don't allow user to * change class vars. */ if not(isOwnClass(selClass(parent))) disableItem(self,IDOK); setText(self:ancestor,getText(self:ancestor)+" (NOT class owner)"); endif; /* end mod */ setItemText(self, 100, text); ^1; }!! ----------------------------------------------------------------- /* FUNCTION.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(Function))!! now(Function)!! /* Load the source code for self from the disk. swh modified to support extended source files */ Def methodText(self | rFile, oFC) { /* mod to support extended source files */ if (oFC := ownerFile(self)) cand (rFile := openClass(ExtSourceFiler, oFC)) /* end mod */ ^loadMethText(rFile, keyAt(methods(owner(self)), self), ( ... }!! ----------------------------------------------------------------- /* METHODBR.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(MethodBrowser))!! now(MethodBrowser)!! /* Load and return the text for the selected method. If the source code for the selected method isn't found, return nil. swh modified to support extended source files */ Def loadSelMethod(self | str, rFile, idx, clName, assoc, class) {... mode := BR_OMETH; endif; /* mod to support extended source files * Removed previous setText message. * end mod */ if find(str, "(prim)", idx) == idx ... fill(lb2, class); /* mod to support extended source files */ rFile := openClass(ExtSourceFiler,selClass); copyMethod(ew,loadMethText(rFile, selMethod, mode)); setTitleClass(self); setTitleMethod(self,selMethod,ownsLast(rFile)); /* end mod */ repaint(ew); ... }!! ----------------------------------------------------------------- /* SOURCEFI.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(SourceFile))!! now(SourceFile)!! /* Create a new class source extension file for the class with the specified name. */ Def makeClassExtFile(self class) { setName(self, condDelCFile(self,class)); create(self); writeChunk(self, "now(class("+name(class)+"))"); write(self, "now("+name(class)+")"+delimiter); close(self); }!! /* Recompile the source code for all the classes in the specified collection of classes. swh rewritten to support extended source files */ Def recompClasses(self, clColl) { do(clColl, {using(aCl) recompile(openClass(ExtSourceFiler,aCl)); }); }!! /* Private method. Try to open specified class file in the appropriate directory. swh rewritten to support extended source files If the file is a .cls file, look up the directory hierarchy for it. */ Def openClassFile(self, class | dir base) { dir := loadString(if (name(class) in DirtyClasses) 332 else 331 endif); base := getFileName(class); setName(self, dir+base); if open(self, 0) ^self endif; if base[size(base)-1] == 's' base := "..\" + loadString(331) + base; do(MAXSOURCENEST-1, {using(i) if open(setName(self,base),0) ^self; endif; base := "..\" + base; }); endif; errorBox(loadString(311), name(class) +loadString(312)+dir+"."); ^nil; }!! ----------------------------------------------------------------- /* STRING.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(String))!! now(String)!! /* Open and compile the file named by self. swh rewritten to support hierarchical dir's. Look first in the current directory of this actor session, and then look progressively up the directory hierarchy. */ Def load(self) { showWaitCurs(); load(new(SourceFile),findPath(self) cor self); showOldCurs(); }!! /* Find and return the 'closest' directory path +filename where the file named by self exists */ Def findPath(self | fileNm) { fileNm := self; do(MAXSOURCENEST, {using(i) if exists(File,fileNm,0) ^fileNm; endif; fileNm := "..\"+fileNm; }); ^nil; }!! ----------------------------------------------------------------- /* SYMBOL.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(Symbol))!! now(Symbol)!! /* Load class extension files (.clx) for the class whose name is this symbol, but don't load the class file (.cls). This is useful for loading extensions to the standard Actor classes. */ Def loadExtensions(self) { ^loadExtensions(openClass(ExtSourceFiler,self)); }!! /* Load the class whose name is this symbol. Loads the original class file (.cls) followed by class extension files (.clx). */ Def load(self) { ^load(openClass(ExtSourceFiler,self)); }!! ----------------------------------------------------------------- /* SYSTEM.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(System))!! /* Return date & time as a string: yyyy/mm/dd hh:mm. */ Def timeStamp(self | ds tempStr) { ds := new(Struct, 18); putMSB(ds, 0x2a, 4); call(ds); tempStr:= asPaddedString(wordAt(ds, 8),4) + "/" + asPaddedString(atMSB(ds, 10),2) + "/" + asPaddedString(atLSB(ds,10),2); putMSB(ds, 0x2c, 4); call(ds); /* get system time */ ^tempStr + " " + asPaddedString(atMSB(ds, 8),2) + ":" + asPaddedString(atLSB(ds, 8),2); }!! /* Return the initials of the programmer for this Actor session. */ Def programmer(self) { ^Programmer; }!! now(System)!! ----------------------------------------------------------------- /* TOOLWIND.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(ToolWindow))!! /* Used by the system to initialize the DirtyClasses Set backup file. DirtyClasses is assumed to be empty on entry. For each class found in the backup file, ask the user whether to re-load the dirty class file or use the old class file. swh modified to support extended source files. swh modified to support unique dirty class file names between images. */ Def loadDirty(self | dName) { /* mod for unique dirty file name - base the dirty * file name on the image name. */ setName($DFile,subString(imageName(TheApp),0, indexOf(imageName(TheApp),'.',0)) +".drt"); /* end mod */ if open($DFile, 0) then ... if size(DirtyClasses) > 0 then do(copy(DirtyClasses), {using(clName) /* mod for extended source file support - if the dirty * class exists in the system, let it tell us its file * name (.cls or .clx), otherwise the class was created * since the last snapshot, so it should be a .cls file. */ dName := loadString(332) + subString(clName,0,8) + if not(Classes[clName]) cor isOwnClass(Classes[clName]) ".cls" else ".clx" endif; /* end mod */ dName := loadString(332) + subString(clName,0,8) + ".cls"; ... }!! now(ToolWindow)!! /* Insert/overwrite a time stamp as the first line of the method text. */ Def stampMethText(self text fSym mode | stampHead) { stampHead := "/*"+StampText; /* if method doesn't already have a stamp, insert * a line for it. */ if left(text[0],size(stampHead),' ') <> stampHead insert(text,"",0); endif; /* construct the time stamp. */ text[0] := stampHead+" "+timeStamp(System)+" " +programmer(System)+" "+name(selClass) +if mode == BR_CMETH "(Class)" else "" endif +":"+fSym+" */"; }!! /* Save the new text for current method into the source file. The first argument, text, is the method text. The second, fSym, is the symbol with the name of the method, e.g. #print. The new or revised method text ends up in a class source file in WORK. Also, write the text to the change log. swh modified to support extended source files swh modified to support automatic time stamping */ Def saveMethText(self, text, fSym | textEnd, nowCl, rFile, wFile) {... changeLog(ew, "now(" + nowCl + ")" + Chunk + subText(text, 0, 0, textEnd, size(text[textEnd]))); /* mod for automatic time stamps * place time stamp in method text. */ if text stampMethText(self,text,fSym,mode); endif; /* end mod */ /* mod to support extended source files */ saveMethText(openClass(ExtSourceFiler,selClass), text, fSym, mode); /* end mod */ makeDirty(self); endif; ^fSym; }!! /* ToolWindow class initialization Rewritten to override ToolWindow.cls class initialization to support unique dirty file names between images - base the dirty file name on the image name. */ $DFile := setName(new(TextFile), subString(imageName(TheApp),0, indexOf(imageName(TheApp),'.',0)) +".drt"); ----------------------------------------------------------------- /* WORKEDIT.CLX - Actor development extensions * * Copyright(C) 1991 Steve Hatchett. All rights reserved. */!! now(class(WorkEdit))!! now(WorkEdit)!! /* Write the given string to the Change Log File. swh modified to support unique change log file names between images. */ Def changeLog(self, aStr | file) { file := new(File); /* mod for unique change log name - base the change * log name on the image name. */ setName(file,subString(imageName(TheApp),0, indexOf(imageName(TheApp),'.',0)) +".log"); /* end mod */ open(file,1) cor create(file); lseek(file, 0, 2); write(file, aStr + Chunk); close(file); }!! Set backup file. DirtyClasses is assumed to be empty on entry. For each class found in the