Frozen Fish 1: Amiga/FrozenFish-Apr94.iso/bbs/alib/d9xx/d969/ace.lha/ACE/ACEupd240194.lha/AIDE/AIDE.b

Text File | 1994-01-24 | 34KB | 1,375 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
*}

version$ = "$VER: AIDE 1.01 (24.01.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 EXE     =2

'..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 iSep2.3     =10
CONST iViewAsm     =11
CONST iViewPrep     =12
CONST iShowErrs     =13

'..Compiler Menu
CONST mCompiler     =3
CONST iBreak     =1
CONST iComments  =2
CONST iIcon     =3
CONST iListLines =4
CONST iOptimise  =5
CONST iWindow     =6

'..Linker
CONST mLinker     =4
CONST iAddModule =1
CONST iRemModule =2
CONST iRemAllMod =3
CONST iSep4.1     =4

'..Help
CONST mHelp     =5
CONST iACEDoc     =1
CONST iA68KDoc     =2
CONST iBlinkDoc     =3
CONST iSep5.1     =4
CONST iACERef     =5

'..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
END STRUCT

STRUCT config_info
  STRING editor SIZE strSize
  STRING viewer SIZE strSize
  STRING tmpdir SIZE strSize
  STRING docdir SIZE strSize
  STRING bltdir SIZE strSize
  STRING agddir SIZE strSize
END STRUCT

STRUCT options_info
  LONGINT user_break
  LONGINT asm_comments
  LONGINT error_log
  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


{*
** 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
DECLARE FUNCTION UnLock(filelock&) LIBRARY
DECLARE FUNCTION Examine(filelock&,fib_ptr&) LIBRARY

  '..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 abort_prog(STRING fname)
SINGLE  time0
  BEEP
  PRINT fname;" error!"
  PRINT
  PRINT "press 'q' key to quit."
  WHILE UCASE$(INKEY$)<>"Q":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=6
DIM      keyword$(words) SIZE 7
SHORTINT i,posn
LONGINT  abort
STRING   config_file SIZE 12
STRING   ln SIZE 81
STRING   value SIZE strSize

  config_file = "AIDE.config"

  abort=FALSE

  '..read the config file keywords
  for i=1 to words
    read keyword$(i)
  next
  DATA EDITOR,VIEWER,TMPDIR,DOCDIR,BLTDIR,AGDDIR

  '..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->tmpdir = value
      i=4 : config->docdir = value
      i=5 : config->bltdir = value
      i=6 : config->agddir = value
        end case
      end if
    end if
  wend
  CLOSE #1

  '..Check we've got all the non-optional values and
  '..make changes where necessary.

  if config->editor="" then abort=TRUE

  if config->viewer="" then abort=TRUE

  if config->tmpdir="" then
    abort=TRUE
  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
    abort=TRUE
  else
    append_slash(@config->docdir)
  end if

  if config->bltdir<>"" then
    append_slash(@config->bltdir)
  end if

  '..AmigaGuide is optional since no files are yet supplied for this.
  if config->agddir<>"" then
    append_slash(@config->agddir)
  end if

  if abort then CALL abort_prog(config_file)
END SUB

SUB initialise_config
SHARED config
  config->editor=""
  config->viewer=""
  config->tmpdir=""
  config->docdir=""
  config->bltdir=""
  config->agddir=""
END SUB

SUB initialise_program_info
SHARED prog
  prog->source_file=""
  prog->source_dir=""
  prog->made=FALSE
  prog->module_count=0
  prog->default_args=""
END SUB

SUB initialise_options
SHARED options
  options->user_break=FALSE
  options->asm_comments=FALSE
  options->error_log=FALSE
  options->create_icon=FALSE
  options->list_lines=FALSE
  options->optimise=TRUE
  options->window_close=FALSE
END SUB

SUB initialise_environment
SHARED module$
  PRINT "Initialising..."
  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
  '..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,iSep2.3,cDisable,      "------------------------"
  MENU mProgram,iViewAsm,cDisable,    "View Assembly Source"
  MENU mProgram,iViewPrep,cDisable,    "View Preprocessed Source"
  MENU mProgram,iShowErrs,cDisable,      "Show Compiler Errors"

  '..Compiler Menu
  MENU mCompiler,0,cEnable,        "Compiler"
  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"

  '..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,"-")

  '..Help Menu
  MENU mHelp,0,cEnable,            "Help"
  MENU mHelp,iACEDoc,cEnable,        "Compiler"
  MENU mHelp,iA68KDoc,cEnable,        "Assembler"
  MENU mHelp,iBlinkDoc,cEnable,        "Linker"
  MENU mHelp,iSep5.1,cDisable,        "------------"
  MENU mHelp,iACERef,cEnable,        "ACE Language"
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/125/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
  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
  else
    if file_name<>"" then print "Unable to print ";file_name
  end if
END SUB

SUB delete_file
STRING file_name SIZE strSize
  file_name = FileBox$("Delete")
  if file_name<>"" then
    if NOT MsgBox("Really delete "+file_name+"?","Yes","No!") then
      PRINT file_name;" not deleted."
      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
END SUB

SUB spawn_shell
  SYSTEM "NewShell CON:0/125/640/100/AIDEshell/CLOSE"
END SUB

SUB about_box
  x$="Written in ACE by David Benn "+CHR$(169)+" 1994"
  dummy = MsgBox(x$,"OK")
END SUB

SUB handle_project_menu(item)
SHORTINT result
  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
STRING  file_name SIZE strSize
STRING  tmp SIZE strSize
STRING  delimiter SIZE 2
STRING  extension SIZE 3
LONGINT posn,ramdisk,dblslash,found

  '..get source file name
  file_name = FileBox$("Select Source File")

  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
  extension = RIGHT$(prog->source_file,2)
  if ucase$(extension) <> ".B" then
    prog->source_file = ""
  else
    posn = INSTR(ucase$(prog->source_file),".B")
     prog->source_file = LEFT$(prog->source_file,posn-1)
  end if

  '..enable inactive program menu items?
  if prog->source_file <> "" then
    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,iViewAsm,cEnable
    MENU mProgram,iViewPrep,cEnable
    MENU mProgram,iShowErrs,cEnable
    PRINT "Source file is ";prog->source_dir;prog->source_file;".b"
  else
    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+".b"

  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
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&,ALLBITS=255&
DECLARE FUNCTION SetSoftStyle(Rp&,textstyle&,bitmask&) LIBRARY

  CLS
  library "graphics.library"
  SetSoftStyle(WINDOW(8),BOLD,ALLBITS)
  PRINT "Making ";CHR$(34);prog->source_file;CHR$(34)
  SetSoftStyle(WINDOW(8),NORMAL,ALLBITS)
  library close "graphics.library"

  target_file = target_dir+prog->source_file

  '..Delete the executable from previous compilations
  '..(if there were any) so we know whether the make
  '..was successful or not.
  KILL target_file

  '..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/125/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
  '..while waiting for it to complete.
  '..**********************************
  OPEN "I",#1,"PIPE:"
  repeat
    LINE INPUT #1,msg
    if msg<>"MakeDone" and msg<>"MakeAborted" and msg<>"" then PRINT msg
  until msg = "MakeDone" or msg = "MakeAborted"
  CLOSE #1

  case
    object_type = ASM : PRINT "Assembly source file ";
    object_type = EXE : PRINT "Executable file ";
  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
      '..unknown target type!
      target_ok=FALSE
       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+".s"
    KILL target_dir+prog->source_file+".old"
    PRINT "not created."
    prog->made=FALSE
  end if
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+".b"
  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 ***
    PRINT #1,"echo >PIPE: Preprocessing"
    command = "ACE:bin/app "+quote(ace_src_name)
    command = command +" "+quote(target_dir+prog->source_file+".b")
    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"

    '*** 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 opts <> "" then command = command + opts+" "

    command = command + quote(target_dir+prog->source_file+".b")
    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 THEN
    '*** A68K ***
    PRINT #1,"echo >PIPE: Assembling"
    command = "ACE:bin/a68k "+quote(asm_src_name)
    PRINT #1,command

    '*** 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

  '..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
    PRINT "Running ";prog->source_file;"..."
    SYSTEM quote(config->tmpdir+prog->source_file)
    CLS
    PRINT prog->source_file;" finished."
  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
    '..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/125/640/100/Run Window/CLOSE"
    script_call = script_call+CHR$(34)+" FROM "
    script_call = script_call+script_name
    SYSTEM script_call
    CLS

    '..store default arguments for program.
    prog->default_args = arguments
  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 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+".b"
  if fexists(fname) then
    SYSTEM config->viewer+" "+quote(fname)
  else
    PRINT "No preprocessed source present."
  end if
END SUB

SUB show_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)
  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 = iViewAsm    : view_assembly_source
    item = iViewPrep    : view_preprocessed_source
    item = iShowErrs    : show_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 handle_compiler_menu(item)
SHARED  options
ADDRESS opt
  case
    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)
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
      '..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 enable_menu_items
SHARED prog
  '..enable menu items disabled by setup_menus

  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,iViewAsm,cEnable
  MENU mProgram,iViewPrep,cEnable
  MENU mProgram,iShowErrs,cEnable
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
       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_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

      '. 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
  PRINT "Updating..."
  menu clear
  setup_menus
  enable_menu_items
  for i=1 to maxModules
    module$(i)=""
  next
  CLS
  '..no modules left
  prog->module_count = 0
  '..program may need to be remade
  prog->made=FALSE
END SUB

SUB handle_linker_menu(item)
  case
    item = iAddModule : add_link_module
    item = iRemModule : remove_link_module
    item = iRemAllMod : remove_all_modules
  end case
END SUB

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

SUB ace_doc
SHARED config
  SYSTEM config->viewer+" "+quote(config->docdir+"ace.doc")
END SUB

SUB a68k_doc
SHARED config
  SYSTEM config->viewer+" "+quote(config->docdir+"a68k.doc")
END SUB

SUB blink_doc
SHARED config
  SYSTEM config->viewer+" "+quote(config->docdir+"blink.doc")
END SUB

SUB ace_ref
SHARED config
  if config->agddir="" then
    '..AmigaGuide not installed -> use ref.doc
      SYSTEM config->viewer+" "+quote(config->docdir+"ref.doc")
  else
    '..AmigaGuide installed -> use ref.guide
      SYSTEM config->agddir+"AmigaGuide "+quote(config->docdir+"ref.guide")
  end if
END SUB

SUB handle_help_menu(item)
  case
    item = iACEDoc     : ace_doc
    item = iA68KDoc     : a68k_doc
    item = iBlinkDoc     : blink_doc
    item = iACERef     : ace_ref
  end case
END SUB

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

SUB event_loop(SHORTINT first_menu_selection)
SHORTINT menuNum,itemNum
  repeat
    menu wait
    if first_menu_selection then
    cls   '..remove initial "Select a menu option" message.
    first_menu_selection = FALSE
    end if
    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 = mHelp     : handle_help_menu(itemNum)
    end case
  until menuNum = mProject and itemNum = iQuit
END SUB

SUB clean_up
SHARED config
  '..delete tmpdir files
  SYSTEM "delete >NIL: "+quote(config->tmpdir+"#?")
  KILL "ace.err"
END SUB


{*
** Main Program
*}

window 1,"AIDE version 1.01",(0,10)-(640,125),22
if SYSTEM >= 37 then
  initialise_environment
  setup_menus
  cls
  print "Select a menu option."
  event_loop(TRUE)
  clean_up
else
  reply=MsgBox("Need Wb 2.04 or higher. See AIDE.doc for more.","OK")
end if
window close 1