home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff321.lzh / IconJ / source / IconJ1_00.f < prev   
Text File  |  1990-02-27  |  19KB  |  468 lines
  1. \ IconJ utility; replacement for IconX
  2. \ Rich Franzen, 3 Feb 1990
  3. \ JForth Professional v2.01
  4. \
  5. \    tool types:    DELAY    as per IconX
  6. \            WINDOW    as per IconX, with WB-relative extensions
  7. \            PATHS    [OFF|SMART] [NOQUOTES] [NOCROP] [METOO]
  8. \            SCRIPT    identifies script location & type
  9. \                options: [(.|~)info] [REXX] [CLI] [VIEW]
  10. \                     [STARTUP]
  11. \
  12. \    Revision History
  13. \    0.2    added full pathname generation
  14. \    0.3    added relative window support and VIEW switch to SCRIPT=
  15. \    0.4    added PATHS= tool type
  16. \    0.41    @Window modified to open plain CON: window if 1st try fails
  17. \    0.42    fixed FindToolType() to handle case of toolTypes=null
  18. \    0.5    added METOO switch.
  19. \        added CleanExit.
  20. \        left ConsoleIn alone.
  21. \        changed call to execute() so that one param. always null.
  22. \    0.6    added support for output to any file/device.
  23. \        added STARTUP switch to SCRIPT=.
  24. \        allowed use of resident execute/rx.
  25. \        reorganized switch sensing.
  26. \        implemented optional automatic closure of CLI windows.
  27. \        fixed WB 1.2 RAM: bug.
  28. \        fixed current directory bug (couldn't find cd without ARP)
  29. \    0.61    fixed the fix to cd bug (acted improperly at :file level)
  30. \    1.00    altered version number to reflect public release
  31. \
  32.  
  33. getmodule includes
  34. include? DiskObject      ji:workbench/workbench.j
  35. include? WBstartup      ji:workbench/startup.j
  36. include? GetDiskObject()  ju:Icon-Support
  37. include? Lock()          ju:dos-support
  38.  
  39. anew task-IconJ
  40.  
  41. : temps.txt  ( -- a)      " T:t/" ;    \ default script directories
  42. : IconJ.txt  ( -- a)      " IconJ_" ;    \ base of temp.script name
  43. : version  ( -- a)      " v1.00, ©1990 Rich Franzen" ;  \ embedded ©
  44. : WINDOW.dflt  ( -- a)     0" con:0/50/640/80/IconJ" ;      \ default window
  45. : BL".txt  ( -- a)     0"   "    ;    \ 2 character string
  46.    ascii "  BL".txt 1+  c!         \ force quote as second char
  47. : <nl>.txt  ( -- a)     0"  " ;    \ 1 character string
  48.    10  <nl>.txt  c!             \ force <nl> as character
  49.  
  50. 256 constant Bytes/Path        \ max # of bytes allowed in pathname
  51. 255 constant maxLine        \ max # of char's in execute() string
  52.                  \ used only when cropping
  53. variable ?unlock        \ switch to control unlocking
  54. variable isConsole        \ flag; true iff console output
  55. variable output0        \ original output stream
  56. variable DELAY=            \ DELAY tool type value
  57. variable theDelay        \ DELAY tool type address (or 0)
  58. variable wb_height        \ workbench height
  59. variable wb_width        \ workbench width
  60. variable wb_dim            \ holds either wb_width or wb_height
  61. variable wi_top            \ console top edge
  62. variable wi_left        \ console left edge
  63. variable wi_height        \ console height
  64. variable wi_width        \ console width
  65. variable theIcon        \ diskobject pointer
  66. variable theToolTypes        \ tooltypes pointer
  67. variable theScript        \ SCRIPT= address
  68. variable thePath        \ PATHS= address
  69. variable myFIB            \ location of FileInfoBlock
  70. variable myArgs            \ location of argument list
  71. variable string.addr        \ last address used
  72. variable conID            \ console (or output file/device) filehandle
  73. variable fileID  40 allot    \ storage for created file name
  74.    \ 4-byte file_lock + 36 bytes file name for ID_Unique script file
  75.  
  76. code 4+  ( n -- n4+)        \ quick 4 +
  77.    4 #  tos dn  addq  inline   end-code
  78. code 8*  ( n -- 4n)        \ multiply by 8 quickly
  79.    3 #  tos dn  asl   inline   end-code
  80. code 4*  ( n -- 4n)        \ multiply by 4 quickly
  81.    2 #  tos dn  asl   inline   end-code
  82. code >Boolean  ( n -- f)    \ convert number to Boolean flag
  83.    tos dn  long tst    \ evaluate TopOfStack
  84.    tos dn  byte sne    \ set bottom byte to FF or 00; FF when non-zero
  85.    tos dn  word ext   tos dn  long ext    \ extend bottom byte to 32 bits
  86.    both   end-code
  87.  
  88. : delay()  ( n)                \ wait for n ticks, 50 ticks/sec
  89.    callvoid dos_lib delay ;
  90. : DeleteFile()  ( aa_0$)        \ dos_lib delete
  91.    callvoid dos_lib DeleteFile ;
  92. : execute()  ( aa_0$ in out -- f)    \ execute a command string
  93.    call dos_lib execute ;
  94. : unlock()  ( lock)            \ free a lock; dos-support form
  95.    callvoid dos_lib UnLock ;         \ contains unnecessary overhead
  96. : GetScreenData()  ( aa size type screen -- f)    \ acquire screen info
  97.    call intuition_lib GetScreenData ;
  98. : FindToolType()  ( a_toolTypes a_typeName -- a_0$|ff)
  99.    over if   call>abs icon_lib FindToolType  if>rel
  100.       else   drop    \ prevents fatal crash if a_toolTypes is NULL
  101.       then ;
  102. : MatchToolValue()  ( a_stringPointer a_subString -- f)
  103.    call>abs icon_lib MatchToolValue ;
  104.  
  105.     \ WBMessage Arguments:
  106.     \   1st will always be default tool
  107.     \   2nd will be main (sometimes calling) project
  108.     \   3rd & subsequent will be follow-on projects
  109.  
  110. : @ArgList  ( -- a)        \ fetch addr of workbench argument list
  111.    wbmessage @ if>rel  ..@ sm_ArgList if>rel ;
  112. : @Arg  ( n -- a)        \ fetch address of nth argument
  113.    8*  @ArgList + ;
  114. : WB#Args  ( -- n)        \ return # of WB arguments
  115.    wbmessage @ if>rel  ..@ sm_NumArgs ;
  116. : ArgName  ( n -- a)        \ return absolute addr of specified name
  117.    @Arg 4+  @ if>rel ;
  118. : SetDir  ( n)            \ set directory to that of calling icon
  119.    @Arg @  ( -- directory_lock)
  120.    ?dup if   dup WBLock !  callvoid DOS_lib CurrentDir   then ;
  121.  
  122. : CLI_Abort   wbmessage @    \ abort job if CLI task
  123.    0= abort" This command is used from WorkBench only." ;
  124. : NoProject_Abort        \ abort w/o comment if no project
  125.    WB#Args 2 < if   abort   then ;
  126.  
  127. : @Paths            \ find & store PATH= address
  128.    theToolTypes @  0" PATHS"  FindToolType()  thePath ! ;
  129. : MTV_Paths  ( f1 a_0$ -- f2)    \ MatchToolValuePaths
  130.    thePath @
  131.    dup if   swap MatchToolValue()  nip   else   2drop   then ;
  132. : ?PATHS  ( -- f)        \ use paths with filenames?
  133.    false  0" OFF"  MTV_Paths  0= ;
  134. : ?SMART  ( -- f)        \ use pathnames just on 1st occurances?
  135.    false  0" SMART"  MTV_Paths ;
  136. : ?QUOTES  ( -- f)        \ include quotes in pathname(s)?
  137.    false  0" NOQUOTES"  MTV_Paths  0= ;
  138. : ?CROP  ( -- f)        \ crop execute() string?
  139.    false  0" NOCROP"  MTV_Paths  0= ;
  140. : ?METOO  ( -- f)        \ include self as an argument?
  141.    false  0" METOO"  MTV_Paths ;
  142.  
  143. : @Script            \ find & store SCRIPT= address
  144.    theToolTypes @  0" SCRIPT"  FindToolType()  theScript ! ;
  145. : MTV_Script  ( f1 a_0$ -- f2)    \ MatchToolValueScript
  146.    theScript @
  147.    dup if   swap MatchToolValue()  nip   else   2drop   then ;
  148. : ?.info  ( -- f)        \ is it a self-contained script?
  149.    false  0" .info"  MTV_Script ;
  150. : ?~info  ( -- f)        \ is it a normal .info-mate script?
  151.    true  0" ~info"  MTV_Script ;  \ eg script for Fred.info = Fred
  152. : ?(CLI)  ( -- f)        \ is it an interactive script?
  153.    false  0" CLI"  MTV_Script ;  \ must be checked later against isConsole
  154. : ?REXX  ( -- f)        \ is it a Rexx script?
  155.    false  0" REXX"  MTV_Script ;
  156. : ?STARTUP  ( -- f)        \ execute s:IconJ-Startup?
  157.    false  0" STARTUP"  MTV_Script ;
  158. : ?VIEW  ( -- f)        \ view command string?
  159.    false  0" VIEW"  MTV_Script ;
  160. : ?CLI  ( -- f)        \ insure CLI is only applied to consoles
  161.    ?(CLI)  isConsole @  and ;
  162.  
  163. : @Delay            \ set delay from disk object
  164.    theToolTypes @  0" DELAY"  FindToolType()  theDelay ! ;
  165. : @!Delay            \ store delay parameter
  166.    @Delay  theDelay @
  167.    ?dup if   0. rot  1- convert  2drop  1 max  DELAY= !  \ if tool exists
  168.       else   ?CLI if   1   else   100   then   DELAY= !  \ if tool absent
  169.       then ;
  170.  
  171. : $Get-Icon  ( a_0$)        \ bring diskobject into memory
  172.    GetDiskObject()  dup theIcon !
  173.    ..@ do_ToolTypes  if>rel theToolTypes ! ;
  174. : Free-Icon            \ free diskobject
  175.    theIcon @  ?dup if   FreeDiskObject()  theIcon off   then
  176.    -icon ;
  177. : GetMem  ( n  -- a)        \ get a block of public memory
  178.    MemF_Public MemF_Clear or  swap AllocBlock
  179.    dup 0= abort"  Insufficient memory. " ;
  180. : PutMem  ( a)            \ release a block of memory
  181.    ?dup if   FreeBlock   then ;
  182. : GetFIB            \ get memory for FileInfoBlock
  183.    sizeof() FileInfoBlock  GetMem  MyFIB ! ;
  184. : PutFIB            \ release FIB memory
  185.    MyFIB @  PutMem   MyFIB off ;
  186. : GetArgMem            \ get memory for arguments (256 bytes per)
  187.    WB#Args   ?CROP if   drop  2   then
  188.    Bytes/Path w*  GetMem  myArgs ! ;
  189. : PutArgMem            \ release argument memory
  190.    myArgs @  PutMem   myArgs off ;
  191.  
  192. : Delete?File            \ delete temporary script file
  193.    fileID @ if   fileID 4+ >abs DeleteFile()   then
  194.    fileID off ;
  195. : CloseConsole            \ "safe" closing of console window
  196.    conID @  ?dup if   FClose   then
  197.    conID off ;
  198. : CleanExit            \ insure everything gets released on aborts
  199.    Delete?File  PutArgMem  PutFIB
  200.    CloseConsole  Free-Icon ;
  201.  
  202. : nTool  ( n -- aa)        \ return absolute pointer to nth ToolType
  203.    4*  theToolTypes @  +  @ ;
  204. : 1stLine  ( -- n)        \ find nth tool, which contains SCRIPT=
  205.    theScript @  7 -  >abs  ( aa_of_SCRIPT_tool)  >r
  206.    -1  Begin   1+ dup nTool  r@ = until
  207.    rdrop ;
  208. : xfrLine  ( a_0$)        \ transfer line from *.info to ID_Unique
  209.    fileID @  swap 0count  fwrite
  210.    0< abort"  Unable to transfer line. "
  211.    fileID @  10 femit ;
  212. : xfrScript   1stLine        \ transfer all lines to ID_Unique
  213.    begin   1+ dup nTool if>rel
  214.       ?dup while   xfrLine   repeat
  215.    drop   fileID @  dup unmarkfclose  fclose ;
  216.  
  217. : ID_Unique   no-commas        \ make a unique file ID
  218.    IconJ.txt count +DOS   \ assume string already started (T: etc)
  219.    0 >abs  36 base !  n>text +DOS   decimal ;
  220. : tryOpen  ( -- handle|ff)    \ attempt to open a file MODE_NEWFILE
  221.    ID_Unique  new  DOS0 0fopen ;
  222. : .infoScript            \ create a temporary script file
  223.    temps.txt 1+ 2 >DOS  tryOpen                \   T:ID_Unique
  224.    ?dup if-not   temps.txt 2+ 3 >DOS  tryOpen    then    \  :t/ID_Unique
  225.    ?dup if-not   dosstring off  tryOpen        then    \     ID_Unique
  226.    ?dup if-not   " RAM:" count >DOS  tryOpen    then    \ RAM:ID_Unique
  227.    ?dup if-not   abort                then    \ we tried...
  228.    fileID !   DOS0 0count  fileID 4+  swap 1+ cmove
  229.    fileID @ markfclose ;
  230. : ~infoScript   fileID off    \ identify non-.info script file
  231.    ?~info if   1 argname  0count
  232.     else
  233.        theScript @  0count   \ strip off anything from | onward
  234.        2dup ascii | scan  nip  - 
  235.     then
  236.    fileID 4+  swap  dup>r cmove
  237.    0  fileID 4+ r> +  c!  ( place null at end of string) ;
  238. : ScriptName            \ store final script name at fileID 4+
  239.    ?.info if   .infoScript  xfrScript   else   ~infoScript   then ;
  240.  
  241. \ interpret relative con: window spec
  242.  
  243. : crop  ( n min max -- n|min|max)    \ crop n between min & max
  244.    rot min  max ;
  245. : *%  ( dim %n -- scaled_dim)    \ take n% of dim, dpl known >0
  246.    *   dpl @ 0 do   10 /   loop ;   
  247. : get_w&h   intuition?        \ get workbench width & height
  248.    myFIB @ >abs  16  WBenchScreen  0 GetScreenData()
  249.    0= abort"  Unable to acquire screen sizes. "
  250.    myFIB @  dup ..@ sc_width  wb_width !
  251.    ..@ sc_height  wb_height !
  252.    -intuition ;
  253. : >$Num   ( a1 -- a2 a1 | ff)    \ convert :# or /# to Forth numeric string
  254.    dup>r 1+  9  ascii /  scan
  255.    dup if   negate 9 +  r@ c!   r>
  256.       else   2drop  rdrop  0
  257.       then ;
  258. : #dim  ( a -- n|tf)        \ left edge, width, top edge, or height
  259.    number? if   drop  >r
  260.     dpl @ 0> if   wb_dim @  r> *%  >r   then    \ 1st, do %
  261.     dpl @ 0= if   rdrop  wb_dim @  >r   then    \ 2nd, check 1.
  262.     r@ 0<    if   wb_dim @  r> +   >r   then    \ 3rd, do neg
  263.     r>  0  wb_dim @  crop                \ 4th, crop
  264.       else   -1                        \ non-number flag
  265.       then ;
  266. : #left  ( a)            \ calculate left edge
  267.    wb_width @  wb_dim !
  268.    #dim  0 max  wi_left ! ;
  269. : #width  ( a)            \ calculate width
  270.    wb_width @  wb_dim !
  271.    #dim  50 max  wi_width ! ;
  272. : #top  ( a)            \ calculate top edge
  273.    wb_height @  wb_dim !
  274.    #dim  0 max  wi_top ! ;
  275. : #height  ( a)            \ calculate height
  276.    wb_height @  wb_dim !
  277.    #dim  20 max  wi_height ! ;
  278. : valid_l&w            \ insure left+width <= wb_width
  279.    wb_width @  wi_left @ -  wi_width @ -
  280.    dup 0< if   wi_left +!   else   drop   then ;
  281. : valid_t&h            \ insure top+height <= wb_height
  282.    wb_height @  wi_top @ -  wi_height @ -
  283.    dup 0< if   wi_top +!   else   drop   then ;
  284. : GetWin#s  ( a1 -- a2|ff)    \ parse #'s in CON: spec between : & last /
  285.    get_w&h
  286.    >$Num dup if-not   EXIT   then   #left
  287.    >$Num dup if-not   EXIT   then   #top
  288.    >$Num dup if-not   EXIT   then   #width
  289.    >$Num dup if-not   EXIT   then   #height
  290.    valid_l&w  valid_t&h ;
  291. : PutWin#  ( n)            \ transfer one # to dos buffer
  292.    n>text  +dos   0" /" 1 +dos  ;
  293. : PutWin#s            \ convert valid numbers back to CON: strings
  294.    no-commas
  295.    wi_left  @  PutWin#   wi_top    @  PutWin#
  296.    wi_width @  PutWin#   wi_height @  PutWin# ;
  297. : a_WINDOW=  ( -- a_0$|0)    \ get address of WINDOW=
  298.    theToolTypes @  0" WINDOW"  FindToolType() ;
  299. : a_file|dev  ( -- a_0$)    \ perform a_WINDOW= & do non-Console stuff
  300.    a_WINDOW=
  301.    isConsole off    \ output will not be to console
  302.    new ;        \ set mode_newfile for subsequent 0Fopen
  303.  
  304. : WINDOW.parse  ( a_src -- a_end)  \ parse a CON: spec
  305.    0count  pad  swap cmove    \ move name to work buffer
  306.    pad dup  20  ascii :  scan        ( a_src2 a_of_: char's_left|ff)
  307.    ?dup if
  308.     swap >r  negate 20 + 1+ >dos    \ "CON:" text or equivalent
  309.     r> GetWin#s
  310.     ?dup if   PutWin#s  1+ 0count +dos  dos0
  311.         else   a_file|dev        \ if CON: doesn't parse right
  312.         then    ( dos0 | a_WINDOW=)
  313.       else   2drop  a_file|dev        \ if no ":" in window spec
  314.       then ;
  315. : @Window            \ open console window
  316.    isConsole on                \ assume CON: window
  317.    a_WINDOW=  ?dup if   WINDOW.parse   else   WINDOW.dflt   then
  318.    0FOpen  ?dup if-not
  319.     isConsole on            \ will be a console window
  320.     WINDOW.dflt  0FOpen        \ try a 2nd time
  321.     ?dup if-not   abort   then    \ when CON: not available
  322.       then
  323.    conID ! ;
  324.  
  325.  
  326. \ build complete pathnames with average pathname length < 256 chars
  327.  
  328. : LockIs  ( lock -- fl_Key fl_Volume)    \ get a lock's block# & volume #
  329.    4* >rel   dup>r ..@ fl_Key   r> ..@ fl_Volume ;
  330. : ?Lock=  ( lock1 lock2 -- f)    \ determine if locks represent same item
  331.    LockIs  rot LockIs  d= ;
  332.  
  333. : cmdstring  ( -- a)        \ return base addr of command buffer
  334.    myArgs @ ;
  335. : cmd0                \ return base addr of command string
  336.    cmdstring 2+ ;
  337. : +cmd  ( adr cnt)        \ move string to command buffer
  338.    dup>r  cmd0                ( src_adr cnt cmd_base)
  339.    cmdstring w@ +            ( src_adr cnt cmd_end)
  340.    swap  2dup + >r   ( save end addr )    ( fr to cnt -- )
  341.    cmove   0 r> c!   ( null-terminate it!)
  342.    cmdstring  dup w@ r> + swap  w!   ( inc the text forth cnt ) ;
  343. : >cmd  ( adr cnt)        \ initialize command buffer with text
  344.    cmdstring off   +cmd ;
  345. : _+cmd  ( adr cnt)        \ +cmd, but appends BL before string
  346.    BL".txt    2 +cmd   +cmd     \ and surrounds string with quotes
  347.    BL".txt 1+ 1 +cmd ;
  348. : BL+cmd  ( adr cnt)        \ +cmd, but appends BL before string
  349.    BL".txt   1 +cmd   +cmd ;
  350. : <nl>+cmd  ( adr cnt)        \ +cmd, but append <nl> before string
  351.    <nl>.txt  1 +cmd   +cmd ;
  352.  
  353. DEFER !cmd            \ deferred word to xfr text
  354. : !cmd?  ( adr cnt -- f)    \ !cmd with optional cropping
  355.    ?CROP if   cmdstring w@ >r        \ save for restoration of null
  356.     !cmd  cmdstring w@  maxLine >  dup if
  357.         r@ cmdstring w!   0  r@ cmd0 +  c!    \ restore string pointers
  358.       then
  359.     rdrop
  360.       else   !cmd   false
  361.       then ;
  362.  
  363. : .version            \ type version #
  364.    f:3  IconJ.txt count 1- type
  365.    space  version count type  f:1  cr ;
  366. : .view                \ view command string
  367.    .version
  368.    cmd0  cmdstring w@ type  cr cr ;
  369.  
  370. : next.addr  ( cnt -- adr)    \ compute location for next string
  371.    1+ negate             \ leave room for null
  372.    string.addr @ +  dup string.addr ! ;
  373.  
  374. : path_segment  ( lock -- a_0$)    \ get lock's text name
  375.    myFIB @  Examine()
  376.    0= abort"  Unable to build pathname. "
  377.    myFIB @ .. fib_FileName ;
  378. : path_init  ( n)        \ initialize pathname with nth filename
  379.    myArgs @  dup SizeMem +  1-  string.addr !
  380.    ArgName 0count  dup next.addr  swap 1+ cmove
  381.    ?unlock off ;
  382. : root_colon            \ write : after root name
  383.    myFIB @ .. fib_FileName c@  BL < if
  384.     0" RAM:"  0count        \ for WB1.2, which didn't have
  385.     dup next.addr 1+  swap cmove     \ rootname for ramdisk
  386.     1 string.addr +!        \ since ":" already present
  387.       else
  388.     string.addr @  81  ascii /  scan    ( adr cnt)  \ find 1st "/"
  389.     if   ascii :  swap  c!   else  drop  then
  390.       then ;
  391. : FileName  ( n -- f)        \ xfr filename without path-spec
  392.    ArgName 0count !cmd? ;
  393. : PathName  ( n -- f)        \ build pathname for nth argument
  394.    dup path_init   @Arg @        ( lock)
  395.    Begin
  396.     dup path_segment  0count    ( lock a_0$ cnt)
  397.     dup if
  398.         string.addr @ 1- >r        \ save connector address
  399.         dup next.addr  swap cmove
  400.         ascii /  r>  c!        \ store connector
  401.       else   2drop            \ case of RAM: & WB1.2
  402.       then                ( lock)
  403.     dup>r ParentDir()        ( Parent_lock)
  404.     ?unlock @ if
  405.         r> unlock()
  406.       else
  407.         rdrop   ?unlock on
  408.       then
  409.       ?dup  0= until
  410.    root_colon
  411.    string.addr @  0count !cmd? ;
  412. : SmartPath  ( n -- f)        \ build pathname only when path 1st in seq.
  413.    dup>r 3 < if   r@ PathName        \ always use full path on 1st args.
  414.       else   r@  @Arg @   r@ 1-  @Arg @        ( lock_n lock_n-1)
  415.     ?Lock= if   r@ FileName   else   r@ PathName   then
  416.       then
  417.    rdrop ; 
  418. : BuildPath  ( n -- f)        \ build pathname using ?PATHS and ?SMART
  419.    ?PATHS if   
  420.     ?SMART if   SmartPath   else   PathName   then
  421.       else   FileName
  422.       then ;
  423.  
  424. : ?CD:  ( a c -- a ff | a+1 tf) \ keep : as part of CD string
  425.    ascii :  =  if   1+  TRUE   else   FALSE   then ;
  426. : myCD                \ init execute() string with CD to cd
  427.    0" CD"  2 >cmd            \ initialize execute() string
  428.    1 PathName  drop            \ build full pathname for 1st arg
  429.    cmd0  cmdstring w@ +            \ find last ":" or "/"
  430.    begin   1-  dup c@   dup>r ?CD:   r>  ascii /  =   or until
  431.    ?QUOTES if   ascii "  over c!   1+   then    \ enplace 2nd quote
  432.    0 swap c!                \ chop-off filename portion
  433.    cmd0 0count  cmdstring w!   drop ;    \ update string count
  434.  
  435. : Command  ( -- a_0$)        \ build command string
  436.    ?QUOTES if   ' _+cmd   else   ' BL+cmd   then   is !cmd
  437.    myCD        \ this is necessary kludge on non-ARP systems
  438.    ?STARTUP if   " Execute s:IconJ-Startup"  count <nl>+cmd   then
  439.    ?REXX if   " Rx "   else   " Execute "   then    \ dos command
  440.    count <nl>+cmd   fileID 4+ 0count +cmd        \ scriptname
  441.    ?METOO if   1 PathName  drop   then            \ include self?
  442.    wb#args 2 > if                    \ include others?
  443.     wb#args 2 do   i BuildPath   if  leave  then   loop
  444.     then
  445.    ?CLI  theDelay @ >Boolean    \ if interactive, but delay specified
  446.    and if   " EndCLI"  count <nl>+cmd   then
  447.    cmd0 ;
  448.  
  449. : IconJ                \ top level command
  450.    CLI_Abort  NoProject_Abort        \ when there's nothing to do
  451.    ' CleanExit IS ErrorCleanUp        \ try to insure clean aborts
  452.    ConsoleOut @ output0 !        \ save original i/o
  453.    1 SetDir   1 ArgName $Get-Icon    \ setup environment
  454.    GetFIB                \ get work/FIB buffer
  455.    @Window  @Script  @Paths  @!Delay    \ gather information
  456.    conID @  ConsoleOut !        \ place for error messages
  457.    GetArgMem                \ create memory buffer for command
  458.    ScriptName  Command >abs        \ build command string
  459.    ?View if   .View   then        \ type command string
  460.    0  conID @  ?CLI if   swap   then    \ set i/o for con: (1 param = 0!)
  461.    Free-Icon  PutFIB            \ free-up icon and FIB mem
  462.    ( aa_0$ IN OUT)  execute()  drop    \ (R)execute script
  463.    PutArgMem                \ free-up memory buffers
  464.    DELAY= @  delay()            \ wait user-specified time
  465.    CloseConsole                \ close console window
  466.    Delete?File                \ delete temporary file, if nec.
  467.    output0 @  ConsoleOut ! ;
  468.