home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Fish 3
/
goldfish_volume_3.bin
/
files
/
dev
/
basic
/
ace
/
aide
/
aide.b
< prev
next >
Wrap
Text File
|
1994-10-22
|
45KB
|
1,801 lines
{*
** ACE Integrated Development Environment: AIDE **
**
** Author: David J Benn
** Date: 23rd,24th,28th-31st December 1993,
** 1st-3rd,5th,6th,8th,10th-12th,
** 14th,15th,17th,19th,23rd,24th January 1994,
** 3rd,4th,6th,8th,12th,15th,26th,28th February 1994,
** 1st,6th March 1994,
** 3rd,4th,11th April 1994,
** 31st July 1994,
** 18th September 1994,
** 2nd,9th October 1994
*}
'..version information
STRING vernum SIZE 5
vernum = "1.1"
version$ = "$VER: AIDE 1.1 (09.10.94)"
DEFLNG a-z
{*
** Menu Constants (prefixes: c=command, m=menu, i=menu item)
*}
'..basic values
CONST TRUE =-1&
CONST FALSE =0&
CONST NULL =0&
'..Object file types
CONST ASM =1
CONST OBJ =2
CONST EXE =3
'..Modes
CONST cDisable =0
CONST cEnable =1
CONST cCheck =2
'..Project Menu
CONST mProject =1
CONST iNew =1
CONST iOpen =2
CONST iView =3
CONST iSep1.1 =4
CONST iDelete =5
CONST iPrint =6
CONST iExecute =7
CONST iShell =8
CONST iSep1.2 =9
CONST iAbout =10
CONST iQuit =11
'..Program Menu
CONST mProgram =2
CONST iSetSource =1
CONST iEdit =2
CONST iSep2.1 =3
CONST iRun =4
CONST iRunInShell=5
CONST iSep2.2 =6
CONST iCompile =7
CONST iMake =8
CONST iBuild =9
CONST iModule =10
CONST iSep2.3 =11
CONST iViewAsm =12
CONST iViewPrep =13
CONST iShowErrs =14
'..Compiler Menu
CONST mCompiler =3
CONST iPreProcess=1
CONST iBreak =2
CONST iComments =3
CONST iIcon =4
CONST iListLines =5
CONST iOptimise =6
CONST iWindow =7
CONST iSep3.1 =8
CONST iSaveOpts =9
'..Linker
CONST mLinker =4
CONST iAddModule =1
CONST iRemModule =2
CONST iRemAllMod =3
CONST iSep4.1 =4
'..Utilities
CONST mUtils =5
CONST iCalc =1
CONST iFD2BMAP =2
CONST iAB2ASCII =3
'..Help
CONST mHelp =6
CONST iAIDEDoc =1
CONST iSep6.1 =2
CONST iACEDoc =3
CONST iA68KDoc =4
CONST iBlinkDoc =5
CONST iSep6.2 =6
CONST iACERef =7
CONST iACEWords =8
CONST iSep6.3 =9
CONST iExamples =10
CONST iSep6.4 =11
CONST iACEHist =12
'..Other stuff
CONST strSize =80
CONST maxModules=10
{*
** Structure Definitions
*}
STRUCT program_info
STRING source_file SIZE strSize
STRING source_dir SIZE strSize
LONGINT made
SHORTINT module_count
STRING default_args
STRING xtn SIZE 5
END STRUCT
STRUCT config_info
STRING editor SIZE strSize
STRING viewer SIZE strSize
STRING calc SIZE strSize
STRING agdtool SIZE strSize
STRING tmpdir SIZE strSize
STRING docdir SIZE strSize
STRING srcdir SIZE strSize
STRING bltdir SIZE strSize
END STRUCT
STRUCT options_info
LONGINT preprocess
LONGINT user_break
LONGINT asm_comments
LONGINT create_icon
LONGINT list_lines
LONGINT optimise
LONGINT window_close
END STRUCT
STRUCT DateStamp
LONGINT days
LONGINT mins
LONGINT ticks
END STRUCT
STRUCT FileInfoBlock
longint fib_DiskKey
longint fib_DirEntryType
string fib_FileName size 108
longint fib_Protection
longint fib_EntryType
longint fib_Size
longint fib_NumBlocks
string fib_Date size 12
string fib_Comment size 80
string fib_Reserved size 36
END STRUCT
{*
** Global Variables
*}
DECLARE STRUCT program_info prog
DECLARE STRUCT config_info config
DECLARE STRUCT options_info options
DIM module$(maxModules)
STRING default_command
ADDRESS main_wdw
{*
** Shared library function declarations (when used by more than one SUB)
** with their associated CONSTs.
*}
DECLARE FUNCTION SetWindowTitles(wdw&,wdw_title$,scr_title$) LIBRARY intuition
CONST LEAVE=-1&
{*
** Subprogram declarations
*}
SUB fexists(STRING fname)
OPEN "I",#255,fname
if HANDLE(255) then
fexists=TRUE
else
fexists=FALSE
end if
CLOSE #255
END SUB
SUB get_file_datestamp(STRING fname,ADDRESS ds_addr)
CONST ACCESS_READ = -2&
LONGINT mylock
DECLARE STRUCT FileInfoBlock file_info
DECLARE STRUCT DateStamp ds,Date
DECLARE FUNCTION Lock&(filename$,accessmode&) LIBRARY dos
DECLARE FUNCTION UnLock(filelock&) LIBRARY dos
DECLARE FUNCTION Examine(filelock&,fib_ptr&) LIBRARY dos
'..Return the datestamp of the file.
'..No checking beyond a test for NULL lock.
ds = ds_addr
mylock = Lock(fname,ACCESS_READ)
if mylock <> NULL then
Examine(mylock,file_info)
Date = @file_info->fib_Date
ds->days = Date->days
ds->mins = Date->mins
ds->ticks = Date->ticks
UnLock(mylock)
end if
END SUB
SUB SHORTINT datestamps_different(ADDRESS ds1_addr,ADDRESS ds2_addr)
DECLARE STRUCT DateStamp ds1,ds2
'..Return TRUE if the datestamps of 2 files
'..are different.
ds1 = ds1_addr
ds2 = ds2_addr
'..If one file doesn't exist but the
'..other does, then the datestamps
'..are different.
IF (ds1 = NULL and ds2 <> NULL) or (ds1 <> NULL and ds2 = NULL) THEN
datestamps_different = TRUE
EXIT SUB
END IF
'..If neither file exists, then the
'..datestamps aren't different.
IF ds1 = NULL and ds2 = NULL THEN
datestamps_different = FALSE
EXIT SUB
END IF
d1=ds1->days
d2=ds2->days
m1=ds1->mins
m2=ds2->mins
t1=ds1->ticks
t2=ds2->ticks
if (d1<>d2) or (m1<>m2) or (t1<>t2) then
datestamps_different=TRUE
else
datestamps_different=FALSE
end if
END SUB
SUB SHORTINT older(ADDRESS ds1_addr,ADDRESS ds2_addr)
DECLARE STRUCT DateStamp ds1,ds2
'..Return TRUE if first datestamp is older than second.
ds1 = ds1_addr
ds2 = ds2_addr
'..If first file doesn't exist it can't
'..be older than second.
IF ds1 = NULL THEN
older = FALSE
EXIT SUB
END IF
'..If second file doesn't exist
'..but the the first file does,
'..the first file must be older
'..than the second.
IF ds2 = NULL THEN
older = TRUE
EXIT SUB
END IF
d1=ds1->days
d2=ds2->days
m1=ds1->mins
m2=ds2->mins
t1=ds1->ticks
t2=ds2->ticks
IF (d1<d2) or (d1=d2 and m1<m2) or (d1=d2 and m1=m2 and t1<t2) THEN
older = TRUE
ELSE
older = FALSE
END IF
END SUB
SUB STRING quote(STRING x)
'..enclose x in quotes
quote = CHR$(34)+x+CHR$(34)
END SUB
SUB enable_misc_menu_items
SHARED prog, config
'..Enable all menu items disabled by setup_menus
'..whenever menus are reset.
if config->calc<>"" then MENU mUtils,iCalc,cEnable
'..Don't enable Program menu items if there's no source file set!
if prog->source_file = "" then exit sub
MENU mProgram,iEdit,cEnable
MENU mProgram,iRun,cEnable
MENU mProgram,iRunInShell,cEnable
MENU mProgram,iArguments,cEnable
MENU mProgram,iCompile,cEnable
MENU mProgram,iMake,cEnable
MENU mProgram,iBuild,cEnable
MENU mProgram,iModule,cEnable
MENU mProgram,iViewAsm,cEnable
MENU mProgram,iViewPrep,cEnable
MENU mProgram,iShowErrs,cEnable
END SUB
SUB menus_off
for i=mProject to mHelp
MENU i,0,cDisable
next
END SUB
SUB menus_on
for i=mProject to mHelp
MENU i,0,cEnable
next
END SUB
SUB show_free_mem(ADDRESS wdw)
SHARED vernum
STRING title SIZE 80
'..show free memory in main window.
title = "AIDE version "+vernum
title = title + " Free Memory: "
title = title + str$(FRE(-1))+" bytes"
SetWindowTitles(wdw,title,LEAVE)
END SUB
SUB clean_up
SHARED config
'..delete tmpdir files
SYSTEM "delete >NIL: "+quote(config->tmpdir+"#?")
KILL "ace.err"
END SUB
{------------------------------------------------------}
SUB abort_prog(STRING fname)
BEEP
PRINT fname;" error!"
PRINT
PRINT "press Q key to quit."
WHILE UCASE$(INKEY$)<>"Q":SLEEP:WEND
WINDOW CLOSE 1
STOP
END SUB
SUB STRING strip_whitespace(STRING X)
SHORTINT i,j,length
STRING ch SIZE 2
'..remove leading whitespace from X.
length = LEN(X)
i=1
repeat
ch = MID$(X,i,1)
if ch <= " " then ++i
until ch > " " or i > length
'..return the stripped string.
strip_whitespace = MID$(X,i)
END SUB
SUB append_slash(ADDRESS X_addr)
STRING X ADDRESS X_addr
STRING delimiter SIZE 2
delimiter = RIGHT$(X,1)
if delimiter <> "/" and delimiter <> ":" then
X = X+"/"
end if
END SUB
SUB get_config
SHARED config
CONST words=8
DIM keyword$(words) SIZE 9
SHORTINT i,posn
STRING config_file SIZE 12
STRING ln SIZE 81
STRING value SIZE strSize
config_file = "AIDE.config"
'..read the config file keywords
for i=1 to words
read keyword$(i)
next
DATA EDITOR,VIEWER,CALCTOOL,AGDTOOL
DATA TMPDIR,DOCDIR,SRCDIR,BLTDIR
'..open the configuration file
OPEN "I",#1,config_file
'..abort program if we can't open this!
if HANDLE(1)=NULL then CALL abort_prog(config_file)
'..search for config keywords and set
'..values in config structure (expects: <configvar>=<value>).
while not eof(1)
LINE INPUT #1,ln
ln = UCASE$(ln)
if LEFT$(ln,1) <> "#" then
i=1 : posn=0
while i<=words and posn=0
posn=INSTR(ln,keyword$(i))
if posn=0 then ++i
wend
if posn > 0 then
value = strip_whitespace(MID$(ln,INSTR(ln,"=")+1))
case
i=1 : config->editor = value
i=2 : config->viewer = value
i=3 : config->calc = value
i=4 : config->agdtool = value
i=5 : config->tmpdir = value
i=6 : config->docdir = value
i=7 : config->srcdir = value
i=8 : config->bltdir = value
end case
end if
end if
wend
CLOSE #1
'..Check we've got all the values, using defaults where necessary.
if config->editor="" then
config->editor="c:Ed"
end if
if config->viewer="" then
config->viewer="ACE:bin/muchmore"
end if
if config->calc<>"" then MENU mUtils,iCalc,cEnable
if config->tmpdir="" then
config->tmpdir="T:"
else
append_slash(@config->tmpdir)
'.."Ram Disk:" will cause Blink to choke
'..since it can't handle quoted args, and the 2.04
'..ASL file requester yields this name for "RAM:"
if LEFT$(config->tmpdir,9) = "RAM DISK:" then
config->tmpdir = "RAM:"+MID$(config->tmpdir,10)
end if
end if
if config->docdir="" then
config->docdir = "ACE:docs/"
else
append_slash(@config->docdir)
end if
if config->srcdir<>"" then
append_slash(@config->srcdir)
end if
if config->bltdir<>"" then
append_slash(@config->bltdir)
end if
END SUB
SUB initialise_config
SHARED config
config->editor=""
config->viewer=""
config->tmpdir=""
config->docdir=""
config->bltdir=""
config->agdtool=""
config->calc=""
END SUB
SUB initialise_program_info
SHARED prog, config
prog->source_file=""
prog->source_dir=config->srcdir
prog->made=FALSE
prog->module_count=0
prog->default_args=""
prog->xtn=""
END SUB
SUB LONGINT truth(x$,SHORTINT posn)
if mid$(x$,posn,1)="T" then
truth = TRUE
else
truth = FALSE
end if
END SUB
SUB show_compiler_option_status(LONGINT opt,SHORTINT opt_num)
if opt = TRUE then
MENU mCompiler,opt_num,cCheck
else
MENU mCompiler,opt_num,cEnable
end if
END SUB
SUB initialise_options
SHARED options
'..set defaults
options->preprocess=TRUE
options->user_break=FALSE
options->asm_comments=FALSE
options->create_icon=FALSE
options->list_lines=FALSE
options->optimise=TRUE
options->window_close=FALSE
'..check for options file
if fexists("AIDE.options") then
OPEN "I",#1,"AIDE.options"
IF NOT EOF(1) THEN LINE INPUT #1,opt$
CLOSE #1
if LEN(opt$) = 7 then
options->preprocess=truth(opt$,1)
options->user_break=truth(opt$,2)
options->asm_comments=truth(opt$,3)
options->create_icon=truth(opt$,4)
options->list_lines=truth(opt$,5)
options->optimise=truth(opt$,6)
options->window_close=truth(opt$,7)
else
PRINT "Format error in AIDE.options!"
end if
end if
'..show whether each is active.
show_compiler_option_status(options->preprocess,iPreProcess)
show_compiler_option_status(options->user_break,iBreak)
show_compiler_option_status(options->asm_comments,iComments)
show_compiler_option_status(options->create_icon,iIcon)
show_compiler_option_status(options->list_lines,iListLines)
show_compiler_option_status(options->optimise,iOptimise)
show_compiler_option_status(options->window_close,iWindow)
END SUB
SUB initialise_environment
SHARED module$
initialise_config
get_config
initialise_options
initialise_program_info
'..clear link modules array
for i=1 to maxModules:module$(i)="":next
END SUB
{------------------------------------------------------}
SUB setup_menus
SHARED config
'..Project Menu
MENU mProject,0,cEnable, "Project"
MENU mProject,iNew,cEnable, "New","N"
MENU mProject,iOpen,cEnable, "Open...","O"
MENU mProject,iView,cEnable, "View...","V"
MENU mProject,iSep1.1,cDisable, "-----------------"
MENU mProject,iDelete,cEnable, "Delete...","D"
MENU mProject,iPrint,cEnable, "Print...","P"
MENU mProject,iExecute,cEnable, "Execute...","X"
MENU mProject,iShell,cEnable, "Spawn Shell"
MENU mProject,iSep1.2,cDisable, "-----------------"
MENU mProject,iAbout,cEnable, "About..."
MENU mProject,iQuit,cEnable, "Quit AIDE","Q"
'..Program Menu
MENU mProgram,0,cEnable, "Program"
MENU mProgram,iSetSource,cEnable, "Set Source...","S"
MENU mProgram,iEdit,cDisable, "Edit Source","E"
MENU mProgram,iSep2.1,cDisable, "------------------------"
MENU mProgram,iRun,cDisable, "Run","R"
MENU mProgram,iRunInShell,cDisable, "Run in Shell..."
MENU mProgram,iSep2.2,cDisable, "------------------------"
MENU mProgram,iCompile,cDisable, "Compile","C"
MENU mProgram,iMake,cDisable, "Make Executable","M"
MENU mProgram,iBuild,cDisable, "Build Application","B"
MENU mProgram,iModule,cDisable, "Create Linkable Module"
MENU mProgram,iSep2.3,cDisable, "------------------------"
MENU mProgram,iViewAsm,cDisable, "View Assembly Source"
MENU mProgram,iViewPrep,cDisable, "View Preprocessed Source"
MENU mProgram,iShowErrs,cDisable, "View Compiler Errors"
'..Compiler Menu
MENU mCompiler,0,cEnable, "Compiler"
MENU mCompiler,iPreProcess,cCheck, " Preprocess Source"
MENU mCompiler,iBreak,cEnable, " Break Trapping"
MENU mCompiler,iComments,cEnable, " Assembly Comments"
MENU mCompiler,iIcon,cEnable, " Create Icon"
MENU mCompiler,iListLines,cEnable, " List Source Lines"
MENU mCompiler,iOptimise,cCheck, " Optimise Assembly"
MENU mCompiler,iWindow,cEnable, " Window Trapping"
MENU mCompiler,iSep3.1,cDisable, "---------------------"
MENU mCompiler,iSaveOpts,cEnable, " Save Options"
'..Linker Menu
MENU mLinker,0,cEnable, "Linker"
MENU mLinker,iAddModule,cEnable, "Add Module..."
MENU mLinker,iRemModule,cDisable, "Remove Module..."
MENU mLinker,iRemAllMod,cDisable, "Remove All Modules"
MENU mLinker,iSep4.1,cDisable, STRING$(18,"-")
'..Utilities Menu
MENU mUtils,0,cEnable, "Utilities"
MENU mUtils,iCalc,cDisable, "Calculator"
MENU mUtils,iFD2BMAP,cDisable, "Create BMAP file"
MENU mUtils,iAB2ASCII,cDisable, "AmigaBASIC to ASCII"
'..check for existence of FD2BMAP and AB2ASCII
if fexists("ACE:utils/fd2bmap/fd2bmap") then MENU mUtils,iFD2BMAP,cEnable
if fexists("ACE:utils/ab2ascii/ab2ascii") then MENU mUtils,iAB2ASCII,cEnable
'..Help Menu
MENU mHelp,0,cEnable, "Help"
MENU mHelp,iAIDEDoc,cEnable, "AIDE"
MENU mHelp,iSep6.1,cDisable, "------------------"
MENU mHelp,iACEDoc,cEnable, "Compiler"
MENU mHelp,iA68KDoc,cEnable, "Assembler"
MENU mHelp,iBlinkDoc,cEnable, "Linker"
MENU mHelp,iSep6.2,cDisable, "------------------"
MENU mHelp,iACERef,cEnable, "Language Reference"
MENU mHelp,iACEWords,cEnable, "ACE Reserved Words"
MENU mHelp,iSep6.3,cDisable, "------------------"
MENU mHelp,iExamples,cEnable, "ACE Examples"
MENU mHelp,iSep6.4,cDisable, "------------------"
MENU mHelp,iACEHist,cEnable, "ACE History"
END SUB
{------------------------------------------------------}
SUB new_file
SHARED config
SYSTEM config->editor
END SUB
SUB open_file
SHARED config
STRING file_name SIZE strSize
file_name = FileBox$("Open")
SYSTEM config->editor+" "+quote(file_name)
END SUB
SUB view_file
SHARED config
STRING file_name SIZE strSize
file_name = FileBox$("View")
SYSTEM config->viewer+" "+quote(file_name)
END SUB
SUB execute_command
SHARED default_command
SHARED config
STRING command, script_call
STRING title SIZE strSize
STRING prompt SIZE strSize
STRING script_name SIZE strSize
SHORTINT script_count
prompt = "Enter Command and Arguments:"
title = "Execute Command"
command = InputBox$(prompt,title,default_command,170,50)
if command <> "" then
'..construct a shell script: must have a unique name
'..since multiple shell scripts may be in use.
script_count=0
repeat
script_name=config->tmpdir+"command-script-"+MID$(STR$(script_count),2)
++script_count
until NOT fexists(script_name)
OPEN "O",254,script_name
PRINT #254,"failat 11"
PRINT #254,"echo "+CHR$(34)+"*E[0;0H*E[J"+CHR$(34) '..cls
PRINT #254,"prompt "+CHR$(34)+CHR$(34)
PRINT #254,"stack 40000"
PRINT #254,command
CLOSE #254
'..Execute it!
script_call = "NewShell "+CHR$(34)+"CON:0/90/640/100/Command Window/CLOSE"
script_call = script_call+CHR$(34)+" FROM "
script_call = script_call+script_name
SYSTEM script_call
'..Set new default command.
default_command = command
end if
END SUB
SUB print_file
STRING file_name SIZE strSize
STRING text_line
menus_off
file_name = FileBox$("Print")
OPEN "I",#1,file_name
if HANDLE(1) then
PRINT "Printing ";file_name;"..."
OPEN "O",#2,"PRT:"
while not eof(1)
LINE INPUT #1,text_line
PRINT #2,text_line
wend
CLOSE 1,2
CLS:LOCATE 1,1:PRINT "Done. ";file_name;" printed."
else
if file_name<>"" then print "Unable to print ";file_name
end if
menus_on
END SUB
SUB delete_file
STRING file_name SIZE strSize
menus_off
file_name = FileBox$("Delete")
if file_name<>"" then
if NOT MsgBox("Really delete "+file_name+"?","Yes","No!") then
PRINT file_name;" not deleted."
menus_on
EXIT SUB
end if
KILL file_name
if ERR then
PRINT "Error while deleting!"
else
PRINT file_name;" deleted."
end if
else
PRINT "No file/directory specified."
end if
menus_on
END SUB
SUB spawn_shell
SYSTEM "NewShell CON:0/90/640/100/AIDEshell/CLOSE"
END SUB
SUB about_box
SHARED main_wdw, vernum
SetWindowTitles(main_wdw,"AIDE version "+vernum,LEAVE)
x$="Written in ACE by David Benn "+CHR$(169)+" 1994"
MsgBox x$, "OK"
show_free_mem(main_wdw)
END SUB
SUB handle_project_menu(item)
SHARED main_wdw
SHORTINT result
show_free_mem(main_wdw)
case
item = iNew : new_file
item = iOpen : open_file
item = iView : view_file
item = iPrint : print_file
item = iExecute : execute_command
item = iDelete : delete_file
item = iShell : spawn_shell
item = iAbout : about_box
end case
END SUB
{------------------------------------------------------}
SUB set_source
SHARED prog, config
STRING file_name SIZE strSize
STRING tmp SIZE strSize
STRING delimiter SIZE 2
STRING extension SIZE 5
STRING orig_file SIZE strSize
STRING old_source_dir SIZE strSize
STRING old_source_file SIZE strSize
STRING old_xtn SIZE strSize
LONGINT posn,xtn_pos,ramdisk,dblslash,found
'..save old path+filename components
old_source_dir = prog->source_dir
old_source_file = prog->source_file
old_xtn = prog->xtn
'..get source file name (look in last referenced directory)
file_name = FileBox$("Select Source File", prog->source_dir)
if file_name="" then
PRINT "No source file specified."
EXIT SUB
end if
'..extract directory path and file
posn=LEN(file_name)
found=FALSE
repeat
delimiter = MID$(file_name,posn,1)
if delimiter=":" or delimiter="/" then
found=TRUE
else
--posn
end if
until posn=0 or found
if not found then
prog->source_file = file_name
prog->source_dir = ""
else
'..source directory
prog->source_dir = LEFT$(file_name,posn)
'..kludge for Wb 3.0 ASL requester when PARENT button
'..is selected. (??)
dblslash = INSTR(prog->source_dir,"//")
if dblslash then
tmp = prog->source_dir
prog->source_dir = MID$(tmp,1,dblslash) + MID$(tmp,dblslash+2)
end if
'..source file
prog->source_file = MID$(file_name,posn+1)
end if
{*
** Remove file extension (".b" or ".bas").
*}
xtn_pos = INSTR(prog->source_file,".bas")
if xtn_pos=0 then
xtn_pos = INSTR(prog->source_file,".BAS")
end if
if xtn_pos=0 then
xtn_pos = INSTR(prog->source_file,".b")
end if
if xtn_pos=0 then
xtn_pos = INSTR(prog->source_file,".B")
end if
if xtn_pos > 0 then extension = MID$(prog->source_file,xtn_pos)
if extension = "" then
extension = MID$(prog->source_file,xtn_pos)
end if
if ucase$(extension) <> ".B" and ucase$(extension) <> ".BAS" then
prog->xtn = ""
prog->source_file = ""
else
prog->xtn = extension
posn = INSTR(ucase$(prog->source_file),ucase$(prog->xtn))
prog->source_file = LEFT$(prog->source_file,posn-1)
end if
'..Prepare for new compilation.
if prog->source_file <> "" then
clean_up
prog->default_args=""
prog->made=FALSE
MENU mProgram,iEdit,cEnable
MENU mProgram,iRun,cEnable
MENU mProgram,iRunInShell,cEnable
MENU mProgram,iArguments,cEnable
MENU mProgram,iCompile,cEnable
MENU mProgram,iMake,cEnable
MENU mProgram,iBuild,cEnable
MENU mProgram,iModule,cEnable
MENU mProgram,iViewAsm,cEnable
MENU mProgram,iViewPrep,cEnable
MENU mProgram,iShowErrs,cEnable
'..does the file exist? -> invoke editor if not.
if NOT fexists(prog->source_dir+prog->source_file+prog->xtn) then
orig_file = prog->source_dir+prog->source_file+prog->xtn
SYSTEM config->editor+" "+quote(orig_file)
end if
CLS:LOCATE 1,1
PRINT "Source file is ";prog->source_dir;prog->source_file;prog->xtn
else
'..invalid source
prog->source_dir = old_source_dir
prog->source_file = old_source_file
prog->xtn = old_xtn
CLS:LOCATE 1,1
PRINT "No source file specified."
end if
END SUB
SUB edit_source
SHARED config,prog
STRING command
STRING orig_file SIZE strSize
DECLARE STRUCT DateStamp ds1,ds2
orig_file = prog->source_dir+prog->source_file+prog->xtn
IF NOT fexists(orig_file) THEN
PRINT "Unable to edit ";orig_file
EXIT SUB
END IF
'..Get datestamp of original file before editing
get_file_datestamp(orig_file,ds1)
'..Edit source file
SYSTEM config->editor+" "+quote(orig_file)
'..Get datestamp of original file after editing
get_file_datestamp(orig_file,ds2)
'..Flag file as "unmade" if it's changed;
'..delete any existing assembly source file
'..since it is now out of date.
IF datestamps_different(ds1,ds2) THEN
KILL config->tmpdir+prog->source_file+".s"
prog->made=FALSE
END IF
END SUB
SUB invoke_make_script(STRING target_dir,SHORTINT object_type)
SHARED prog,config,main_wdw
STRING command
STRING msg SIZE strSize
STRING target_file SIZE strSize
LONGINT target_ok
DECLARE STRUCT DateStamp old_target,new_target
CONST BOLD=2, NORMAL=0
menus_off
CLS:LOCATE 1,1
STYLE BOLD
PRINT "Making ";CHR$(34);prog->source_file;CHR$(34)
STYLE NORMAL
target_file = target_dir+prog->source_file
'..Delete the binaries from previous compilations
'..(if there were any) so we know whether the make
'..was successful or not.
KILL target_file
KILL target_file".o"
'..Rename assembly source file (if it exists) with a ".old" extension.
'..This is used below to check whether a new target file has been created.
if fexists(target_file+".s") then
NAME target_file+".s" AS target_file+".old"
else
'..Create a dummy assembly source file so
'..there is something to compare the new
'..assembly source file (about to be created) to.
OPEN "O",#1,target_file+".old"
PRINT #1,"; dummy assembly source"
PRINT #1,"END"
CLOSE #1
end if
'..Delete old error file in case we don't generate one now
'..(ie: don't want old ace.err to be associated with current
'..compilation).
KILL "ace.err"
'..start asynchronous process to Make the program.
command = "NewShell "+CHR$(34)+"CON:0/90/640/100/Make program: "
command = command + prog->source_file+CHR$(34)
command = command + " FROM " + config->tmpdir+"AIDE-newshell-startup"
SYSTEM command
'..**********************************
'..Display messages from Make process
'..and show free memory while waiting
'..for Make to complete.
'..**********************************
OPEN "I",#1,"PIPE:"
time0=TIMER
repeat
LINE INPUT #1,msg
if msg<>"MakeDone" and msg<>"MakeAborted" and msg<>"" then PRINT msg
if TIMER >= time0+1 then
show_free_mem(main_wdw)
time0=TIMER
end if
until msg = "MakeDone" or msg = "MakeAborted"
CLOSE #1
case
object_type = ASM : PRINT "Assembly source file ";
object_type = EXE : PRINT "Executable file ";
object_type = OBJ : PRINT "Linkable module ";
end case
'..***************
'..Successful Make
'..***************
if msg = "MakeDone" then
if object_type=ASM then
'..assembly source is target
get_file_datestamp(target_file+".old",old_target)
get_file_datestamp(target_file+".s",new_target)
if fexists(target_file+".s") and older(old_target,new_target) then
target_ok=TRUE
else
target_ok=FALSE
end if
else
'..executable is target
if object_type=EXE then
target_ok=fexists(target_file)
else
'..linkable (object) module is target
if object_type=OBJ then
target_ok=fexists(target_file+".o")
else
'..unknown target type!
target_ok=FALSE
end if
end if
end if
if target_ok then
PRINT "created."
prog->made=TRUE
else
PRINT "not created."
end if
end if
'..*****************
'..Unsuccessful Make
'..*****************
if msg = "MakeAborted" then
KILL target_dir+prog->source_file
KILL target_dir+prog->source_file+".o"
KILL target_dir+prog->source_file+".s"
KILL target_dir+prog->source_file+".old"
PRINT "not created."
prog->made=FALSE
end if
menus_on
END SUB
SUB make_program(STRING target_dir,SHORTINT object_type)
SHARED config,prog,options,module$
SHORTINT i
STRING command,opts
STRING ace_src_name SIZE strSize
STRING asm_src_name SIZE strSize
DECLARE STRUCT DateStamp ace_src,asm_src
'..Generate a shell script to make the program.
OPEN "O",#1,config->tmpdir+"AIDE-newshell-startup"
PRINT #1,"failat 11"
PRINT #1,"echo "+CHR$(34)+"*E[0;0H*E[J"+CHR$(34)
PRINT #1,"alias QuitMake echo >PIPE: MakeAborted"
PRINT #1,"stack 40000"
ace_src_name = prog->source_dir+prog->source_file+prog->xtn
asm_src_name = target_dir+prog->source_file+".s"
'..Compare datestamps of ACE source and assembly source (if it exists!)
get_file_datestamp(ace_src_name, ace_src)
get_file_datestamp(asm_src_name, asm_src)
'..We only want to compile the ACE source if it hasn't already been
'..compiled (by the user selecting "Compile Program" in the past).
IF NOT fexists(asm_src_name) OR NOT older(ace_src,asm_src) THEN
'*** APP ***
IF options->preprocess THEN
PRINT #1,"echo >PIPE: Preprocessing"
command = "ACE:bin/app "+quote(ace_src_name)
command = command +" "+quote(target_dir+prog->source_file+prog->xtn)
PRINT #1,command
'..preprocessor errors?
PRINT #1,"IF ERROR"
PRINT #1," echo >PIPE: Aborted!"
PRINT #1," echo >PIPE: MakeAborted"
PRINT #1," EndCLI"
PRINT #1,"ENDIF"
ELSE
'..Just copy file verbatim if APP not invoked.
command = "c:copy "+quote(ace_src_name)+" "
command = command + quote(target_dir+prog->source_file+prog->xtn)
PRINT #1,command
END IF
'*** ACE ***
PRINT #1,"echo >PIPE: Compiling"
command = "ACE:bin/ace -E"
'..Compiler switches? (the "i" switch is redundant here since
'..build_application copies the icon from ACE:icons/exe.info
'..but someone MAY expect the icon to also be in the working
'..directory when compiling/making!)
opts=""
if options->user_break then opts = opts + "b"
if options->asm_comments then opts = opts + "c"
if options->create_icon then opts = opts + "i"
if options->list_lines then opts = opts + "l"
if options->optimise then opts = opts + "O"
if options->window_close then opts = opts + "w"
if object_type = OBJ then opts = opts + "m"
command = command + opts+" "
command = command + quote(target_dir+prog->source_file+prog->xtn)
PRINT #1,command
'..compile-time errors?
PRINT #1,"IF ERROR"
PRINT #1," echo >PIPE: Aborted!"
PRINT #1," echo >PIPE: MakeAborted"
PRINT #1," EndCLI"
PRINT #1,"ENDIF"
END IF
IF object_type = EXE OR object_type = OBJ THEN
'*** A68K ***
PRINT #1,"echo >PIPE: Assembling"
command = "ACE:bin/a68k "+quote(asm_src_name)
PRINT #1,command
IF object_type = EXE THEN
'*** BLINK ***
PRINT #1,"echo >PIPE: Linking"
command = "ACE:bin/blink "+target_dir+prog->source_file+".o"
command = command + " LIB "
'..add link modules
for i=1 to prog->module_count
if module$(i)<>"" then command = command + module$(i) + "+"
next
command = command + "ACElib:startup.lib+ACElib:db.lib+ACElib:ami.lib"
'command = command + "SMALLCODE SMALLDATA"
PRINT #1,command
END IF
END IF
'..OK -> we're finished
PRINT #1,"echo >PIPE: MakeDone"
PRINT #1,"EndCLI"
CLOSE #1
'..do it!
invoke_make_script(target_dir,object_type)
END SUB
SUB compile_program
SHARED config,prog
if not prog->made or not fexists(config->tmpdir+prog->source_file+".s") then
make_program(config->tmpdir,ASM)
else
PRINT prog->source_file;" is up to date."
end if
END SUB
SUB make_executable
SHARED config,prog
if not prog->made or not fexists(config->tmpdir+prog->source_file) then
make_program(config->tmpdir,EXE)
else
PRINT prog->source_file;" is up to date."
end if
END SUB
SUB run_program
SHARED config,prog
make_executable
if prog->made then
menus_off
PRINT "Running ";prog->source_file;"..."
SYSTEM quote(config->tmpdir+prog->source_file)
CLS:LOCATE 1,1
PRINT prog->source_file;" finished."
menus_on
else
'..There (probably) was a compile error.
PRINT "Unable to run ";prog->source_file;"."
end if
END SUB
SUB run_program_in_shell
SHARED config,prog
STRING prompt SIZE strSize
STRING title SIZE strSize
STRING script_call,arguments
STRING script_name SIZE strSize
SHORTINT script_count
make_executable
if prog->made then
menus_off
'..get command-line arguments
prompt = "Command-Line Arguments?"
title = "Run in Shell"
arguments = InputBox$(prompt,title,prog->default_args,170,50)
'..construct a shell script: script must have a unique name
'..since multiple shell scripts may be in use.
script_count=0
repeat
script_name=config->tmpdir+"command-script-"+MID$(STR$(script_count),2)
++script_count
until NOT fexists(script_name)
OPEN "O",254,script_name
PRINT #254,"failat 11"
PRINT #254,"echo "+CHR$(34)+"*E[0;0H*E[J"+CHR$(34) '..cls
PRINT #254,"prompt "+CHR$(34)+CHR$(34)
PRINT #254,"stack 40000"
PRINT #254,quote(config->tmpdir+prog->source_file)+" "+arguments
CLOSE #254
'..Execute it!
script_call = "NewShell "+CHR$(34)
script_call = script_call+"CON:0/90/640/100/Running "
script_call = script_call+prog->source_file+"/CLOSE"
script_call = script_call+CHR$(34)+" FROM "
script_call = script_call+script_name
SYSTEM script_call
CLS:LOCATE 1,1
'..store default arguments for program.
prog->default_args = arguments
menus_on
else
'..There (probably) was a compile error.
PRINT "Unable to run ";prog->source_file;"."
end if
END SUB
SUB build_application
SHARED config,prog,options
STRING command,dest_dir
make_executable
'..where's the executable going?
if config->bltdir<>"" then
dest_dir = config->bltdir
else
dest_dir = prog->source_dir
end if
'..copy executable
command = "sys:c/copy >NIL: "+config->tmpdir+prog->source_file+" "
command = command + quote(dest_dir+prog->source_file)
SYSTEM command
'..copy icon?
if options->create_icon then
command = "sys:c/copy >NIL: ACE:icons/exe.info "
command = command + quote(dest_dir+prog->source_file+".info")
SYSTEM command
end if
'..were we successful?
if prog->made then
PRINT dest_dir+prog->source_file;" has been built."
end if
END SUB
SUB build_module
SHARED config,prog,options
STRING command,dest_dir
make_program(config->tmpdir,OBJ)
'..where's the linkable module going?
if config->bltdir<>"" then
dest_dir = config->bltdir
else
dest_dir = prog->source_dir
end if
'..copy module
command = "sys:c/copy >NIL: "+config->tmpdir+prog->source_file+".o "
command = command + quote(dest_dir+prog->source_file+".o")
SYSTEM command
END SUB
SUB view_assembly_source
SHARED config,prog
STRING fname SIZE strSize
fname = config->tmpdir+prog->source_file+".s"
if fexists(fname) then
SYSTEM config->viewer+" "+quote(fname)
else
PRINT "No assembly source present."
end if
END SUB
SUB view_preprocessed_source
SHARED config,prog
STRING fname SIZE strSize
fname = config->tmpdir+prog->source_file+prog->xtn
if fexists(fname) then
SYSTEM config->viewer+" "+quote(fname)
else
PRINT "No preprocessed source present."
end if
END SUB
SUB view_compiler_errors
SHARED config
OPEN "I",#1,"ace.err"
if HANDLE(1) then
if LOF(1)<>0 then
SYSTEM config->viewer+" ace.err"
else
PRINT "There were no compilation errors."
end if
else
PRINT "No ACE error log."
end if
CLOSE #1
END SUB
SUB handle_program_menu(item)
SHARED main_wdw
show_free_mem(main_wdw)
case
item = iSetSource : set_source
item = iEdit : edit_source
item = iRun : run_program
item = iRunInShell : run_program_in_shell
item = iCompile : compile_program
item = iMake : make_executable
item = iBuild : build_application
item = iModule : build_module
item = iViewAsm : view_assembly_source
item = iViewPrep : view_preprocessed_source
item = iShowErrs : view_compiler_errors
end case
END SUB
{------------------------------------------------------}
SUB change_option_state(ADDRESS opt,SHORTINT item)
if NOT *&opt then
*&opt:=TRUE
MENU mCompiler,item,cCheck
else
*&opt:=FALSE
MENU mCompiler,item,cEnable
end if
END SUB
SUB write_option(LONGINT opt_val)
if opt_val = TRUE then
PRINT #1,"T";
else
PRINT #1,"F";
end if
END SUB
SUB handle_compiler_menu(item)
SHARED options,config,prog,main_wdw
ADDRESS opt
show_free_mem(main_wdw)
if item <= iWindow then
'..toggle a compiler option
case
item = iPreProcess: opt = @options->preprocess
item = iBreak : opt = @options->user_break
item = iComments : opt = @options->asm_comments
item = iIcon : opt = @options->create_icon
item = iListLines : opt = @options->list_lines
item = iOptimise : opt = @options->optimise
item = iWindow : opt = @options->window_close
end case
change_option_state(opt,item)
'..previous MAKEs are invalidated
clean_up
prog->made = FALSE
else
if item = iSaveOpts then
'..save current option settings
OPEN "O",#1,"AIDE.options"
write_option(options->preprocess)
write_option(options->user_break)
write_option(options->asm_comments)
write_option(options->create_icon)
write_option(options->list_lines)
write_option(options->optimise)
write_option(options->window_close)
PRINT #1,CHR$(10)
CLOSE #1
PRINT "Compiler options saved."
end if
end if
END SUB
{------------------------------------------------------}
SUB add_link_module
SHARED module$,prog
SHORTINT maxMod,i
LONGINT found
STRING module SIZE strSize
'..add a module to the list of object files to link.
maxMod = prog->module_count + 1
if maxMod <= maxModules then
'..get name of module
module = FileBox$("Add Module")
if module <> "" then
'.."Ram Disk:" will cause Blink to choke
'..since it can't handle quoted args, and the 2.04
'..ASL file requester yields this name for "RAM:"
if UCASE$(LEFT$(module,9)) = "RAM DISK:" then
module = "RAM:"+MID$(module,10)
end if
'..is module already in the list?
found=FALSE
for i=1 to prog->module_count
if module$(i) = module then found=TRUE
next
if not found then
'..No -> add module to list
module$(maxMod) = module
MENU mLinker,iSep4.1+maxMod,cEnable,module$(maxMod)
'..increment module count
prog->module_count = prog->module_count + 1
'..program may need to be remade
prog->made=FALSE
PRINT module$(maxMod);" added to list."
'..enable "remove" menu items when there is 1 module in the list.
if prog->module_count = 1 then
MENU mLinker,iRemModule,cEnable
MENU mLinker,iRemAllMod,cEnable
end if
else
PRINT module;" already in list."
end if
else
PRINT "No module specified."
end if
else
PRINT "No more than";maxModules;"modules can be specified."
end if
END SUB
SUB remove_link_module
SHARED module$,prog
SHORTINT maxMod,n,i
LONGINT found
STRING module SIZE strSize
'..remove a module from the list of files to link.
maxMod = prog->module_count
if maxMod > 0 then
'..get module name
module = FileBox$("Remove Module")
'..remove module from list if it exists.
if module <> "" then
found=FALSE
for n=1 to maxMod
if module$(n) = module and not found then
found=TRUE
module$(n)=""
end if
next
if found then
'..restore module list
CLS:LOCATE 1,1
PRINT "Updating..."
'..shuffle module list entries
for n=1 to MaxMod
for i=maxMod to 2 step -1
if module$(i-1) = "" then
module$(i-1) = module$(i)
module$(i) = ""
end if
next
next
'.fix menus
menu clear
setup_menus
enable_misc_menu_items
MENU mLinker,iRemModule,cEnable
MENU mLinker,iRemAllMod,cEnable
for i=1 to maxMod
if module$(i)<>"" then MENU mLinker,iSep4.1+i,cEnable,module$(i)
next
CLS:LOCATE 1,1
'. decrement module count
prog->module_count = prog->module_count - 1
'..program may need to be remade
prog->made=FALSE
'..disable "remove" menu items if all have been removed.
if prog->module_count = 0 then
MENU mLinker,iRemModule,cDisable
MENU mLinker,iRemAllMod,cDisable
end if
else
PRINT module;" not in list."
end if
else
PRINT "No module specified."
end if
else
PRINT "No modules to remove."
end if
END SUB
SUB remove_all_modules
SHARED prog,module$
SHORTINT i
CLS:LOCATE 1,1
PRINT "Updating..."
menu clear
setup_menus
enable_misc_menu_items
for i=1 to maxModules
module$(i)=""
next
CLS:LOCATE 1,1
'..no modules left
prog->module_count = 0
'..program may need to be remade
prog->made=FALSE
END SUB
SUB handle_linker_menu(item)
SHARED main_wdw
show_free_mem(main_wdw)
case
item = iAddModule : add_link_module
item = iRemModule : remove_link_module
item = iRemAllMod : remove_all_modules
end case
END SUB
{------------------------------------------------------}
SUB calculator
SHARED config
'..invoke calculator
if config->calc<>"" and fexists(config->calc) then
SYSTEM config->calc
else
PRINT "Unable to invoke calculator."
PRINT "Check CALCTOOL entry in AIDE.config."
end if
END SUB
SUB fd2bmap
STRING fd_file SIZE strSize
STRING command
'..create a .bmap file for a library
'..(assumes ACE:utils/fd2bmap/fd2bmap
'..and ACEbmaps: exist).
menus_off
fd_file = FileBox$("Select FD file for library")
if fd_file = "" then
PRINT "No FD file specified."
else
fd_file = LEFT$(fd_file,INSTR(fd_file,"_")-1)
PRINT "Creating ";fd_file;".bmap..."
SYSTEM "ACE:utils/fd2bmap/fd2bmap "+fd_file+" ACEbmaps:"
CLS:LOCATE 1,1:PRINT "Done. BMAP file stored in ACEbmaps:"
end if
menus_on
END SUB
SUB ab2ascii
STRING ab_file SIZE strSize
'..convert a compressed AmigaBASIC file to ASCII
'..(assumes ACE:utils/ab2ascii/ab2ascii exists).
menus_off
ab_file = FileBox$("Select file to convert")
if ab_file = "" then
PRINT "No compressed AmigaBASIC file specified."
else
PRINT "Converting ";ab_file;"..."
SYSTEM "ACE:utils/ab2ascii/ab2ascii <"+ab_file+" >"+ab_file+".b"
CLS:LOCATE 1,1:PRINT "Done. ASCII source file ";ab_file;".b created."
end if
menus_on
END SUB
SUB handle_utils_menu(item)
SHARED main_wdw
show_free_mem(main_wdw)
case
item = iCalc : calculator
item = iFD2BMAP : fd2bmap
item = iAB2ASCII : ab2ascii
end case
END SUB
{------------------------------------------------------}
SUB aide_doc
SHARED config
'..aide.doc or aide.guide should be in one of two directories.
if config->agdtool="" then
'..AmigaGuide not installed -> use aide.doc
IF fexists(config->docdir+"aide.doc") THEN
SYSTEM config->viewer+" "+config->docdir+"aide.doc"
ELSE
SYSTEM config->viewer+" ACE:AIDE/aide.doc"
END IF
else
'..AmigaGuide installed -> use aide.guide
IF fexists(config->docdir+"aide.guide") THEN
SYSTEM config->agdtool+" "+config->docdir+"aide.guide"
ELSE
SYSTEM config->agdtool+" ACE:AIDE/aide.guide"
END IF
end if
END SUB
SUB ace_doc
SHARED config
if config->agdtool="" then
'..AmigaGuide not installed -> use ace.doc
SYSTEM config->viewer+" "+config->docdir+"ace.doc"
else
'..AmigaGuide installed -> use ace.guide
SYSTEM config->agdtool+" "+config->docdir+"ace.guide"
end if
END SUB
SUB a68k_doc
SHARED config
SYSTEM config->viewer+" "+config->docdir+"a68k.doc"
END SUB
SUB blink_doc
SHARED config
SYSTEM config->viewer+" "+config->docdir+"blink.doc"
END SUB
SUB ace_ref
SHARED config
if config->agdtool="" then
'..AmigaGuide not installed -> use ref.doc
SYSTEM config->viewer+" "+config->docdir+"ref.doc"
else
'..AmigaGuide installed -> use ref.guide
SYSTEM config->agdtool+" "+config->docdir+"ref.guide"
end if
END SUB
SUB ace_reserved_words
SHARED config
if fexists("ACE:docs/ace-rwords") then
SYSTEM config->viewer+" ACE:docs/ace-rwords"
else
PRINT "Unable to find ACE:docs/ace-rwords. Type:"
PRINT
PRINT " ACE WORDS > ACE:docs/ace-rwords"
PRINT
PRINT "from a shell prompt. Then select menu option again."
end if
END SUB
SUB ace_examples
SHARED config
if config->agdtool<>"" then
SYSTEM config->agdtool+" ACE:docs/Example.Guide"
end if
END SUB
SUB ace_history
SHARED config
SYSTEM config->viewer+" "+config->docdir+"history"
END SUB
SUB handle_help_menu(item)
SHARED main_wdw
show_free_mem(main_wdw)
case
item = iAIDEDoc : aide_doc
item = iACEDoc : ace_doc
item = iA68KDoc : a68k_doc
item = iBlinkDoc : blink_doc
item = iACERef : ace_ref
item = iACEWords : ace_reserved_words
item = iExamples : ace_examples
item = iACEHist : ace_history
end case
END SUB
{------------------------------------------------------}
SUB event_loop(SHORTINT first_menu_selection)
SHARED main_wdw
SHORTINT menuNum,itemNum
REPEAT
show_free_mem(main_wdw)
'..await menu activity
menu wait
if first_menu_selection then
CLS '..remove initial "Select a menu option" message.
LOCATE 1,1
first_menu_selection = FALSE
end if
'..handle menu
menuNum = MENU(0)
itemNum = MENU(1)
case
menuNum = mProject : handle_project_menu(itemNum)
menuNum = mProgram : handle_program_menu(itemNum)
menuNum = mCompiler : handle_compiler_menu(itemNum)
menuNum = mLinker : handle_linker_menu(itemNum)
menuNum = mUtils : handle_utils_menu(itemNum)
menuNum = mHelp : handle_help_menu(itemNum)
end case
UNTIL menuNum = mProject and itemNum = iQuit
END SUB
{*
** Main Program
*}
window 1,"AIDE version "+vernum,(0,10)-(640,90),22
main_wdw = WINDOW(7)
if SYSTEM >= 37 then
print "please wait..."
setup_menus
initialise_environment
CLS:LOCATE 1,1
print "Select a menu option."
event_loop(TRUE)
clean_up
else
MsgBox "Need Wb 2.04 or higher. See AIDE.doc for more.", "OK"
end if
window close 1