home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / based.icn < prev    next >
Text File  |  2000-07-29  |  14KB  |  541 lines
  1. ############################################################################
  2. #
  3. #    File:     based.icn
  4. #
  5. #    Subject:  Program to do BASIC-style editing
  6. #
  7. #    Author:   Chris Tenaglia
  8. #
  9. #    Date:     February 18, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program models a line editor for BASIC.
  18. #
  19. ############################################################################
  20.  
  21. global chars,program,cmd,token,name
  22.  
  23. procedure main(param)
  24.   local ff, old
  25.  
  26.   if find("p",map(param[1])) then ff := "\014"
  27.                              else ff := "\e[2J\e[H"
  28.   chars   := &cset -- '\t '
  29.   program := list()
  30.   name    := &null
  31.   write("Basic Line Editor V1.3 by Tenaglia 910104.1700")
  32.   write(&host," ",&dateline,"\n")
  33.  
  34.   repeat
  35.     {
  36.     writes(">")
  37.     (cmd   := read()) | { quit() ; next }
  38.     if cmd == "!!" then
  39.       {
  40.       cmd := old
  41.       write("> ",cmd)
  42.       }
  43.     token := parse(cmd)
  44.     if integer(token[1]) then
  45.       {
  46.       entry(token[1])
  47.       token[1] := ""
  48.       }
  49.     old := cmd
  50. #EJECT
  51.     case map(token[1]) of
  52.       {
  53.       ""       : "ignore this case"
  54.       "load"   : write(load())
  55.       "save"   : write(save())
  56.       "resave" : write(resave())
  57.       "read"   : write(basread())
  58.       "write"  : write(baswrite())                   
  59.       "merge"  : write(merge())
  60.       "new"    : write(new())
  61.       "list"   : write(print())
  62.       "renum"  : write(renum())
  63.       "del"    : write(del())
  64.       "dir"    : write(dir())
  65.       "size"   : write("Buffer contains ",*program," lines.")
  66.       "find"   : write(search())
  67.       "cls"    : write(ff)
  68.       "compile": write(compile())
  69.       "build"  : write(build())
  70.       "test"   : write(build(),run())
  71.       "run"    : write(run())
  72.       "ver"    : write("Basic Line Editor V1.3 by Tenaglia 910104.1700")
  73.       "date"   : write(&host," ",&dateline)
  74.       "time"   : write(&host," ",&dateline)
  75.       "help"   : write(help())
  76.       "?"      : write(help())
  77.       "$"      : write(shell())
  78.       "exit"   : break
  79.       "quit"   : break
  80.       default  : write("\007What ?")
  81.       }
  82.      }
  83.  
  84.   write("Returning to operating system")
  85.   write(&host," ",&dateline)
  86. end
  87.  
  88. procedure quit()           # allows CTRL_Z exit under VMS
  89.   local test
  90.  
  91.   writes("QUIT! Are you sure? Y/N :")
  92.   (test := read()) | stop("Returning to operating system\n",&host," ",&dateline)
  93.   if map(test)[1] == "y" then stop("Returning to operating system\n",&host," ",&dateline)
  94.   return
  95.   end
  96.   
  97. #SUB LOAD, SAVE, AND RESAVE COMMANDS
  98. #EJECT
  99. procedure load()
  100.   local file, in, lnum
  101.  
  102.   if not(token[2]) then
  103.     {
  104.     writes("_file:")
  105.     if (file := string(read())) == "" then return
  106.     } else file := token[2]
  107.   lnum  := 0
  108.   (in   := open(file)) | return ("Can't open " || file)
  109.   name  := file
  110.   program := []
  111.   while put(program,((lnum+:=10) || " " || read(in))) do
  112.     not(find("00",lnum)) | (writes("."))
  113.   close(in)
  114.   return ("\n" || file || " loaded.")
  115. end
  116.  
  117. procedure save()
  118.   local file, i, line, lnum, out, text
  119.  
  120.   if not(token[2]) then
  121.     {
  122.     writes("_file:")
  123.     if (file := string(read())) == "" then return
  124.     } else file := token[2]
  125.   (out  := open(file,"w")) | return ("Can't open " || file)
  126.   name  := file
  127.   every line := !program do
  128.     {
  129.     i    := upto(' \t',line)
  130.     lnum := line[1:i]
  131.     text := line[i+1:0]
  132.     write(out,text)
  133.     not(find("00",lnum)) | (writes("."))
  134.     }
  135.   close(out)
  136.   return ("\n" || file || " saved.")
  137. end
  138.  
  139. procedure resave()
  140.   local i, line, lnum, out, text
  141.  
  142.   if not(string(name)) then return("Nothing LOADed to resave.")
  143.   (out  := open(name,"w")) | return ("Can't open " || name)
  144.   every line := !program do
  145.     {
  146.     i    := upto(' \t',line)
  147.     lnum := line[1:i]
  148.     text := line[i+1:0]
  149.     write(out,text)
  150.     not(find("00",lnum)) | (writes("."))
  151.     }
  152.   close(out)
  153.   return ("\n" || name || " resaved.")
  154. end
  155. #SUB READ, WRITE, AND MERGE COMMANDS
  156. #EJECT
  157. procedure basread()
  158.   local file, in, line, lnum, test
  159.  
  160.   if not(token[2]) then
  161.     {
  162.     writes("_file:")
  163.     if (file := string(read())) == "" then return
  164.     } else file := token[2]
  165.   lnum  := 0
  166.   (in   := open(file)) | return ("Can't open " || file)
  167.   name  := file
  168.   program := []
  169.   while line := read(in) do
  170.     {
  171.     test := (line[1:upto(' \t',line)]) | ""
  172.     if integer(test) then put(program,line)
  173.     not(find("00",(lnum+:=10))) | (writes("."))
  174.     }
  175.   close(in)
  176.   return ("\n" || file || " read in.")
  177. end
  178.  
  179. procedure baswrite()
  180.   local file, lnum, out
  181.  
  182.   if not(token[2]) then
  183.     {
  184.     writes("_file:")
  185.     if (file := string(read())) == "" then return
  186.     } else file := token[2]
  187.   (out  := open(file,"w")) | return ("Can't open " || file)
  188.   name  := file ; lnum := 0
  189.   every write(out,!program) do
  190.     not(find("00",(lnum+:=10))) | (writes("."))
  191.   close(out)
  192.   return ("\n" || file || " writen out.")
  193. end
  194.  
  195. procedure merge()
  196.   local file, i, in, line, lnum
  197.  
  198.   if not(token[2]) then
  199.     {
  200.     writes("_file:")
  201.     if (file := string(read())) == "" then return
  202.     } else file := token[2]                    
  203.   (in  := open(file)) | return ("Can't open " || file)
  204.   every line := !in do
  205.     {
  206.     (lnum := integer(line[1:(i:=upto(' \t',line))])) | next
  207.     cmd   := line
  208.     entry(lnum)
  209.     not(find("00",lnum)) | writes(".")
  210.     }
  211.   close(in)
  212.   return (file || " merged in current buffer.")
  213. end
  214. #SUB DIR, DEL, AND NEW COMMANDS
  215. #EJECT   
  216. procedure dir()
  217.   local spec
  218.  
  219.   spec  := (token[2]) | ("")
  220.   if &host == "MS-DOS" then
  221.     {
  222.     system(("dir/w " || spec))
  223.     return ""
  224.     }
  225.   if find("nix",map(&host)) then
  226.    system(("ls -l " || spec || " | more")) else
  227.    system(("dir " || spec))
  228.   return ""
  229. end
  230.  
  231. procedure del()
  232.   local From, To, element, lnum, num, other
  233.  
  234.   if (From := integer(token[2])) & (To := integer(token[3])) then
  235.     {
  236.     other := []
  237.     every element := !program do
  238.       {
  239.       lnum := element[1:upto(' \t',element)]
  240.       if (lnum >= From) & (lnum <= To) then next
  241.       put(other,element)
  242.       }
  243.     program := copy(other)
  244.     return ("Lines " || From || " - " || To || " deleted.")
  245.     }
  246.  
  247.   if not(num := integer(token[2])) then
  248.     {
  249.     writes("_line:")
  250.     (num := integer(read())) | (return ("Not a line number."))
  251.     }
  252.   other := []
  253.   every element := !program do
  254.     {
  255.     lnum := element[1:upto(' \t',element)]
  256.     if lnum = num then next
  257.     put(other,element)
  258.     }
  259.   program := copy(other)
  260.   return ("Line " || num || " deleted.")
  261. end
  262.  
  263. procedure new()                 
  264.   program := []
  265.   name    := &null
  266.   return ("Buffer cleared.")
  267. end
  268. #SUB FIND COMMAND
  269. #EJECT
  270. procedure search()
  271.   local From, To, delta, diff, i, item, j, k, l, line, lnum
  272.  
  273.   if (From := token[2]) & (To := token[3]) then
  274.     {
  275.     diff    := (*token[3]) - (*token[2])
  276.     every i := 1 to *program do
  277.       {
  278.       line := program[i]
  279.       l    := upto(' \t',line) + 1
  280.       delta:= 0
  281.       every j := find(From,line,l) do
  282.         {
  283.         k := j + delta
  284.         line[k+:*From]      := ""
  285.         line[((k-1)|(1))] ||:= To
  286.         delta +:= diff
  287.         writes(".")
  288.         }
  289.       program[i] := line
  290.       }
  291.     return ""
  292.     }
  293.  
  294.   if not(item := token[2]) then
  295.     {
  296.     writes("_string:")
  297.     if (item := read()) == "" then return ""
  298.     }
  299.   every i := 1 to *program do
  300.     {
  301.     line := program[i]
  302.     l    := upto(' \t',line) + 1
  303.     if find(item,line,l) then
  304.       {
  305.       lnum := line[1:l-1]
  306.       writes(lnum,",")
  307.       }
  308.     }
  309.   return ""
  310. end
  311. #SUB COMPILATION AND RUNNING ROUTINES
  312. #EJECT
  313. procedure compile()       # compile only
  314.   local fid, opt
  315.   local i, ext, command, val
  316.  
  317.   find(".",name) | return "Can't compile! Language &or Filename not recognized"
  318.   i   := last(".",name)               
  319.   fid := map(name[1:i])
  320.   ext := map(name[i:0])
  321.   command := case ext of
  322.     {
  323.     ".icn" : "icont -c " || name
  324.     ".c"   : "cc " || opt || " " || name
  325.     ".f"   : "f77 "|| opt || " " || name
  326.     ".asm" : "asm "|| opt || " " || name
  327.     ".p"   : "pc " || opt || " " || name
  328.     ".for" : "fortran " || name
  329.     ".bas" : "basic "   || name
  330.     ".cob" : "cobol "   || name
  331.     ".mar" : "macro "   || name
  332.     ".pas" : "pascal "  || name
  333.     default: return "Can't compile! Language &or Filename not recognized"
  334.     }
  335.   write("Issuing -> ",command)
  336.   val := system(command)
  337.   return " Completion Status = " || val
  338.   end
  339.  
  340. procedure build()         # compile and link
  341.   local i, ext, command, val1, val2, fid
  342.  
  343.   find(".",name) | return "Can't compile! Language &or Filename not recognized"
  344.   i   := last(".",name)
  345.   fid := map(name[1:i])
  346.   ext := map(name[i:0])
  347.   command := case ext of
  348.     {
  349.     ".icn" : ["icont "   || name]
  350.     ".c"   : ["cc "      || name]
  351.     ".f"   : ["f77 "     || name]
  352.     ".asm" : ["asm "     || name]
  353.     ".p"   : ["pc "      || name]
  354.     ".for" : ["fortran " || name, "link " || fid]
  355.     ".bas" : ["basic "   || name, "link " || fid]
  356.     ".cob" : ["cobol "   || name, "link " || fid]
  357.     ".mar" : ["macro "   || name, "link " || fid]
  358.     ".pas" : ["pascal "  || name, "link " || fid]
  359.     default: return "Can't compile! Language &or Filename not recognized"
  360.     }
  361.   write("Issuing -> ",command[1])
  362.   val1 := system(command[1])
  363.   val2 := if *command = 2 then
  364.     {
  365.     write("And Issuing -> ",command[2])
  366.     system(command[2])
  367.     } else -1
  368.   return " Completion status = " || val1 || " and " || val2
  369.   end
  370.   
  371. procedure run()           # run built ware
  372.   local i, ext, command, val, fid
  373.  
  374.   find(".",name) | return "Can't compile! Language &or Filename not recognized"
  375.   i   := last(".",name)
  376.   fid := map(name[1:i])
  377.   ext := map(name[i:0])
  378.   command := case ext of
  379.     {
  380.     ".icn" : "iconx " || fid
  381.     ".c"   : fid
  382.     ".f"   : fid
  383.     ".asm" : fid
  384.     ".p"   : fid
  385.     ".com" : "@"    || name
  386.     ".for" : "run " || fid       
  387.     ".bas" : "run " || fid
  388.     ".cob" : "run " || fid
  389.     ".mar" : "run " || fid
  390.     ".pas" : "run " || fid
  391.     default: return "Can't Run ! Language &or Filename not recognized"
  392.     }
  393.   write("Issuing -> ",command)
  394.   val := system(command)
  395.   return " Completion status = " || val
  396.   end
  397. #SUB LIST AND RENUM COMMANDS
  398. #EJECT
  399. procedure print()          
  400.   local From, To, items, line
  401.  
  402.   if *token = 1 then
  403.     {
  404.     every write(!program)
  405.     return ""
  406.     }
  407.   if not(numeric(token[2])) then return proc_list()
  408.   From := integer(token[2])
  409.   To   := integer(token[3])
  410.   if not(integer(To)) then
  411.     {
  412.     every line := !program do
  413.       {
  414.       items := parse(line)
  415.       if items[1] > From then return ""
  416.       if items[1] = From then
  417.         {
  418.         write(line)
  419.         return ""
  420.         }
  421.       }
  422.     return ""
  423.     }
  424.   every line := !program do
  425.     {
  426.     items := parse(line)
  427.     if items[1] < From then next
  428.     if items[1] > To   then return ""
  429.     write(line)
  430.     }
  431.   return ""
  432. end
  433. #
  434. procedure proc_list()
  435.   local flag, line
  436.  
  437.   flag := 0
  438.   every line := !program do
  439.     {
  440.     if find("procedure",line) & find(token[2],line) then flag := 1
  441.     if flag = 1 then write(line)
  442.     if (parse(line)[2] == "end") & (flag = 1) then
  443.       {
  444.       write("")
  445.       flag := 0
  446.       }
  447.     }
  448.   return ""
  449.   end
  450. #
  451. procedure renum()
  452.   local inc, line, lnum, other
  453.  
  454.   (lnum := integer(token[2])) | (lnum := 10)
  455.   (inc  := integer(token[3])) | (inc  := 10)
  456.   other := list()
  457.   every line := !program do
  458.     {
  459.     line[1:upto(' \t',line)] := lnum
  460.     put(other,line)
  461.     not(find("00",lnum)) | (writes("."))
  462.     lnum +:= inc
  463.     }
  464.   program := copy(other)
  465.   return ("\nProgram renumbered.")
  466. end
  467. #SUB ON LINE HELP DISPLAY
  468. #EJECT
  469. procedure help()
  470.   write("Basic Line Editor V1.3 by Tenaglia")
  471.   write("     This editor works on the same principle as basic interpreter")
  472.   write("     environments.  The lines are all prefixed with line numbers.")
  473.   write("     These line numbers  are used to reference lines in the file.")
  474.   write("     The line numbers are not written to, or read from  the file.")
  475.   write("     This editor is designed to work on a hard copy terminal like")
  476.   write("     a teletype or decwriter as well as a crt.")
  477.   write("Command Summary : (parameters are space delimited)")
  478.   write("  NEW       - erase buffer        | CLS        - clear screen or form feed")
  479.   write("  LOAD file - load file           | SAVE file  - save file")
  480.   write("  READ file - read w/line numbers | WRITE file - write w/line numbers")
  481.   write("  RESAVE    - resave current file | MERGE file - insert w/line numbers")
  482.   write("  DIR [spec]- list directory      | SIZE       - lines in editing buffer")
  483.   write("  RENUM     - renumber the lines  | VER        - current version number")
  484.   write("  COMPILE   - current source      | BUILD      - compile & link")
  485.   write("  TEST      - compile,link, & run | RUN        - run last compiled")
  486.   write("  $ - command to system (shell)   | HELP or ?  - this help screen")
  487.   write("  TIME or DATE - displays time    | !!         - repeat last command")
  488.   write("*---------------------------------+--------------------------------------*")
  489.   write("  LIST or DEL [from [to]]  - list or delete line(s)")
  490.   write("  FIND str [repl]  - find or replace string")
  491.   return "  EXIT or QUIT     - return to operating system"
  492. end
  493. #SUB LINE ENTRY AND HANDY PARSER PROCEDURE
  494. #EJECT
  495. procedure entry(stuff)
  496.   local element, finish, flag, lnum, other
  497.  
  498.   other  := list()
  499.   flag   := "i"
  500.   finish := 9999999
  501.   every element := !program do
  502.     {
  503.     lnum := integer(element[1:upto(' \t',element)])
  504.     if stuff = lnum then
  505.       {
  506.       put(other,cmd)
  507.       stuff := finish
  508.       next
  509.       }
  510.     if stuff < lnum then
  511.       {                                  
  512.       put(other,cmd)
  513.       stuff := finish
  514.       }
  515.     put(other,element)
  516.     }
  517.   if stuff ~= finish then put(other,cmd)
  518.   program := copy(other)
  519.   end
  520.             
  521. procedure shell()
  522.   local command
  523.   command := cmd[find(" ",cmd):0]
  524.   if trim(detab(command))=="" then return "No shell command"
  525.   system(command)
  526.   return "\nReturn to editor"
  527.   end
  528.  
  529. procedure parse(line)
  530.   local tokens
  531.   tokens := []
  532.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  533.   return tokens
  534.   end
  535.                                 
  536. procedure last(substr,str)
  537.   local  i
  538.   every  i := find(substr,str)
  539.   return i
  540.   end
  541.