home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21eb.zip / octave / PATOS2.ZIP / updt-octave.cmd < prev   
OS/2 REXX Batch file  |  1999-04-14  |  26KB  |  741 lines

  1. /*
  2. *******************************************************************************
  3. ** Update an previous Octave/2 Installation                                  **
  4. ** (c) Klaus Gebhardt, 1996 - 1997                                           **
  5. *******************************************************************************
  6. */
  7.  
  8. /*
  9. *******************************************************************************
  10. ** This script will make all the necessary changes in the following files:   **
  11. **                                                                           **
  12. **   1. CONFIG.SYS                                                           **
  13. **   2. .emacs                                                               **
  14. **   3. .octaverc                                                            **
  15. **     (or the file pointed to by the environment variable OCTAVE_INITFILE)  **
  16. **   4. %INFOPATH%dir                                                        **
  17. *******************************************************************************
  18. ** It will also copy the info files to the directoy pointed to by the        **
  19. ** variable INFOPATH, and it replaces emx.dll, emxlibcs.dll and              **
  20. ** termcap.dat, if the files coming with Octave/2 are newer than those       **
  21. ** on your system.                                                           **
  22. *******************************************************************************
  23. ** This script also creates a folder with a program object for Octave/2      **
  24. ** on the WPS.                                                               **
  25. *******************************************************************************
  26. ** ALL ORIGINAL FILES, WHICH ARE MODIFIED OR REPLACED BY THIS SCRIPT         **
  27. ** ARE BACKUPED IN THE DIRECTORY YOU HAVE OCTAVE/2 INSTALLED IN.             **
  28. *******************************************************************************
  29. ** NO WARRANTY!                                                              **
  30. *******************************************************************************
  31. */
  32.  
  33. "@echo off"
  34. debug = ">NUL 2>NUL"
  35. debug_mode = 0;
  36.  
  37. version     = "2.1.14";
  38. script_arc  = "SCRIPTS.ZIP";
  39. dlfcn_arc   = "DLFCN.ZIP";
  40.  
  41. default_dir.0 = 3;
  42. default_dir.1 = "h:/apps/science/octave";
  43. default_dir.2 = "h:/apps/science/octave-";
  44. default_dir.3 = "i:/apps/octave-";
  45.  
  46. config_modified   = 0;
  47. config.0.nr =  9;
  48. config.1.nr =  8; config.1.name = "LIBPATH=";             config.1.zeile = "";
  49. config.2.nr =  9; config.2.name = "SET PATH=";            config.2.zeile = "";
  50. config.3.nr = 16; config.3.name = "SET OCTAVE_HOME=";     config.3.zeile = "";
  51. config.4.nr = 12; config.4.name = "SET TERMCAP=";         config.4.zeile = "";
  52. config.5.nr =  9; config.5.name = "SET TERM=";            config.5.zeile = "";
  53. config.6.nr =  9; config.6.name = "SET HOME=";            config.6.zeile = "";
  54. config.7.nr = 20; config.7.name = "SET OCTAVE_INITFILE="; config.7.zeile = "";
  55. config.8.nr = 13; config.8.name = "SET INFOPATH=";        config.8.zeile = "";
  56. config.9.nr = 12; config.9.name = "SET GNUPLOT=";         config.9.zeile = "";
  57.  
  58. emacs_modified = 0;
  59. octaverc_modified = 0;
  60. dir_modified = 0;
  61.  
  62.  
  63. call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
  64. call SysLoadFuncs
  65.  
  66. parse upper arg option cmdl
  67.  
  68. /*
  69. *******************************************************************************
  70. ** Debug-Mode                                                                **
  71. *******************************************************************************
  72. */
  73. if (option == "/DEBUG") then
  74.   do
  75.     say "info: Running in DEBUG mode!";
  76.     "@echo on"
  77.     debug = ""
  78.     debug_mode = 1;
  79.   end
  80. else
  81.   do
  82.     debug_mode = 0;
  83.     cmdl = option;
  84.   end
  85.  
  86. /*
  87. *******************************************************************************
  88. ** Wrong argument and usage message                                          **
  89. *******************************************************************************
  90. */
  91. if ((cmdl <> "/USAGE") & (cmdl <> "")) then
  92.   do
  93.     say "error: Unknown command line option!";
  94.     say "";
  95.     cmdl = "/USAGE";
  96.   end
  97.  
  98. if (cmdl == "/USAGE") then
  99.   do
  100.     say "Usage:"
  101.     say "  Type 'updt-octave' to update your Octave/2" version "Installation";
  102.     say "  Type 'updt-octave /usage'   to see this message.";
  103.     say "on FAT systems you must type 'updt-oct' instead of 'updt-octave'";
  104.     exit;
  105.   end
  106.  
  107. /*
  108. *******************************************************************************
  109. ** Updating the installation                                 **
  110. *******************************************************************************
  111. */
  112. say "info: Updating Octave/2" version "..."
  113.  
  114. octave_home = to_unix_sep(directory());
  115. octave_dll = octave_home || "/dll";
  116. if (check_octave_files(octave_home, 1) == 0) then
  117.   do
  118.     say "error: Run this script from within in the directory octave is"
  119.     say "error: installed in!"
  120.     exit;
  121.   end
  122. say "info: Octave/2 is installed in" octave_home || ".";
  123.  
  124. /* Removing old files */
  125. "del doc\refcard*" debug
  126.  
  127. /* Unzip the files for dynamic loading */
  128. call unzip_dlfcn_files dlfcn_arc
  129.  
  130. /* Unzip the script files */
  131. call unzip_script_files script_arc
  132.  
  133. say "info: Done.";
  134. exit;
  135.  
  136. /*
  137. *******************************************************************************
  138. ** This is from inst-octave.cmd                                              **
  139. *******************************************************************************
  140. */
  141.  
  142. /*
  143. *******************************************************************************
  144. ** Write the modified config.sys                                             **
  145. *******************************************************************************
  146. */
  147. write_config_new: procedure expose config. debug version
  148. parse arg boot, dir
  149.   config_old = to_os2_sep(dir) || "\config.old";
  150.   config_new = to_os2_sep(dir) || "\config.new";
  151.   "del" config_new debug
  152.  
  153.   rc = stream(config_old, "C", "open read");
  154.   if rc <> "READY:" then
  155.     do
  156.       say "error: Cannot open the backup of CONFIG.SYS!";
  157.       exit;
  158.     end
  159.  
  160.   rc = stream(config_new, "C", "open write");
  161.   if rc <> "READY:" then
  162.     do
  163.       say "error: Cannot open CONFIG.NEW!";
  164.       rc = stream(config_old, "C", "close");
  165.       exit;
  166.     end
  167.  
  168.   say "info: Writing" config_new "...";
  169.   do while(lines(config_old))
  170.     line = linein(config_old);
  171.     do i=1 to config.0.nr
  172.       if (to_upper(substr(strip(line), 1, config.i.nr)) == config.i.name) then
  173.         do
  174.           if config.i.zeile <> "" then
  175.             do
  176.               p = pos(to_upper(config.i.name), to_upper(config.i.name));
  177.               if (p <= 1) then
  178.                 line = config.i.name || config.i.zeile;
  179.               else
  180.                 line = substr(" ",1,p," ") || config.i.name || config.i.zeile;
  181.               config.i.zeile = "";
  182.             end
  183.           leave;
  184.         end
  185.     end
  186.     call lineout config_new, line
  187.   end
  188.  
  189.   sep = 0;
  190.   do i=1 to config.0.nr
  191.     if (config.i.zeile <> "") then
  192.       do
  193.         if (sep == 0) then
  194.           do
  195.             call lineout config_new, ""
  196.             call lineout config_new, "REM Octave/2" version
  197.             sep = 1;
  198.           end
  199.         call lineout config_new, config.i.name || config.i.zeile;
  200.         config.i.zeile = "";
  201.       end
  202.   end
  203.  
  204.   rc = stream(config_new, "C", "close");
  205.   rc = stream(config_old, "C", "close");
  206.   return;
  207.  
  208. /*
  209. *******************************************************************************
  210. ** Analysing CONFIG.SYS:                                                     **
  211. *******************************************************************************
  212. */
  213. read_config_sys: procedure expose config. default_dir. debug
  214. parse arg boot, dir
  215.   config_old = to_os2_sep(dir) || "\config.old";
  216.   say "info: Copying" boot || "\config.sys to" config_old "...";
  217.   "copy" boot || "\config.sys" config_old debug
  218.  
  219.   rc = stream(config_old, "C", "open read");
  220.   if (rc <> "READY:") then
  221.     do
  222.       say "error: Cannot open the backup of CONFIG.SYS!";
  223.       exit;
  224.     end
  225.  
  226.   say "info: Analysing" config_old "...";
  227.   do while(lines(config_old))
  228.     line  = strip(linein(config_old));
  229.     do i=1 to config.0.nr
  230.       strupper = to_upper(substr(line, 1, config.i.nr));
  231.       if (strupper == config.i.name) then
  232.         do
  233.           config.i.zeile = substr(line, config.i.nr+1);
  234.           leave;
  235.         end
  236.     end
  237.   end
  238.   rc = stream(config_old, "C", "close");
  239.  
  240.   if (config.1.zeile == "") then
  241.     do
  242.       say "error: No "LIBPATH" statement found!";
  243.       exit;
  244.     end
  245.   else libpath = config.1.zeile;
  246.  
  247.   if (config.2.zeile == "") then
  248.     do
  249.       say "error: No "SET PATH" statement found!";
  250.       exit;
  251.     end
  252.   else path = config.2.zeile;
  253.  
  254.   oh = config.3.zeile;
  255.   if (oh <> "") then return to_unix_sep(oh);
  256.   else
  257.     do
  258.       do i = 1 to default_dir.0
  259.         oh = check_octave_old_home(default_dir.i, libpath, path);
  260.         if (oh <> "") then return to_unix_sep(oh);
  261.       end
  262.     end
  263.   return "";
  264.  
  265. check_octave_old_home: procedure expose debug
  266. parse arg str, libpath, path
  267.   string = to_os2_sep(str);
  268.   pa = 0;
  269.   do while(1)
  270.     pa = pos(to_upper(string), to_upper(path), pa + 1);
  271.     if (pa == 0) then return "";
  272.     if (pa <> 1) then
  273.       do
  274.         if (substr(path, pa - 1, 1) <> ";") then iterate;
  275.       end
  276.     pe = pos(";", path, pa);
  277.     if (pe == 0) then old_home = substr(path, pa);
  278.     else              old_home = substr(path, pa, pe-pa);
  279.     qa = pos(to_upper(old_home || "\DLL"), to_upper(libpath));
  280.     if (qa == 0) then iterate;
  281.     if (qa <> 1) then
  282.       do
  283.         if (substr(path, qa - 1, 1) <> ";") then iterate;
  284.       end
  285.     qe = pos(";", libpath, qa);
  286.     if qe == 0 then old_dll = to_upper(substr(libpath, qa));
  287.     else            old_dll = to_upper(substr(libpath, qa, qe-qa));
  288.     if (to_upper(old_home || "\DLL") == old_dll) then
  289.       do
  290.     flag = check_octave_files(old_home, 0);
  291.     if (flag == 0) then
  292.           do
  293.             say "notice: I FOUND AN OLD OCTAVE DIRECTORY ("fullpath") IN";
  294.             say "notice: LIBPATH AND PATH, BUT WITHOUT ANY OCTAVE FILES.";
  295.             say "notice: SHOULD I REMOVE ALL ENTRIES IN LIBPATH AND PATH";
  296.             say "notice: POINTING TO THAT DIRECTORY [Y/N]";
  297.             parse pull in;
  298.             flag = (in == "Y") | (in == "y");
  299.           end
  300.         if (flag) then return to_unix_sep(old_home);
  301.       end
  302.     else  return "";
  303.   end
  304.  
  305. check_octave_files: procedure expose debug
  306. parse arg string, flag
  307.   path = to_os2_sep(string);
  308.   rc = SysFileTree(path || "\octave.exe",     exe, "FO");
  309.   rc = SysFileTree(path || "\octave.ico",     ico, "FO");
  310.   rc = SysFileTree(path || "\dll\cruft?.dll", crt, "FO");
  311.   if (flag <> 0) then rc = SysFileTree(path || "\dll\octave?.dll", oct, "FO");
  312.   else                oct.0 = 2;
  313.   res = (exe.0 == 1) & (ico.0 == 1) & (crt.0 == 4) & (oct.0 == 2);
  314.   return res;
  315.  
  316. /*
  317. *******************************************************************************
  318. ** Updating the emx TERMCAP.DAT                                              **
  319. *******************************************************************************
  320. */
  321. emx_termcap: procedure expose debug
  322. parse arg termcap
  323.   call SysFileTree "etc\termcap.dat", oct_datei, "FT";
  324.   if oct_datei.0 <> 1 then return termcap;
  325.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  326.   else                 oct = "20" || oct_datei.1;
  327.  
  328.   call SysFileTree to_os2_sep(termcap), emx_datei, "FT";
  329.   if emx_datei.0 <> 1 then return "";
  330.   if datei.1 > 80 then emx = "19" || emx_datei.1;
  331.   else                 emx = "20" || emx_datei.1;
  332.  
  333.   if oct == emx then return termcap;
  334.   if oct > emx then
  335.     do
  336.       say "info: Replacing" to_os2_sep(termcap) "...";
  337.       "copy" to_os2_sep(termcap) "termcap.old" debug
  338.       "copy etc\termcap.dat" to_os2_sep(termcap) debug
  339.     end
  340.   else
  341.     do
  342.       say "info: Removing termcap.dat coming with Octave/2 ...";
  343.       "del etc\termcap.dat" debug
  344.       "rd etc" debug
  345.     end
  346.  
  347.   return termcap;
  348.  
  349. /*
  350. *******************************************************************************
  351. ** Replacing the emx-DLLs                                                    **
  352. *******************************************************************************
  353. */
  354. emx_dlls: procedure expose debug
  355. parse arg libpath, file
  356.   call SysFileTree "dll\" || file, oct_datei, "FT";
  357.   if oct_datei.0 <> 1 then return;
  358.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  359.   else                 oct = "20" || oct_datei.1;
  360.  
  361.   count = 0;
  362.   do while(1)
  363.     n = setlocal();
  364.     "SET OCTAVE_LIBPATH=" || libpath
  365.     fullpath = SysSearchPath(OCTAVE_LIBPATH, file);
  366.     if fullpath == "" then leave;
  367.     call SysFileTree fullpath, emx_datei, "FT";
  368.     if emx_datei.0 <> 1 then leave;
  369.     if datei.1 > 80 then emx = "19" || emx_datei.1;
  370.     else                 emx = "20" || emx_datei.1;
  371.     n = endlocal();
  372.  
  373.     if oct == emx then leave;
  374.     if oct > emx then
  375.       do
  376.         count = count+1;
  377.         bak_file = substr(file, 1, length(file)-3) || count;
  378.         "copy" fullpath bak_file debug
  379.         say "info: Older DLL (" || file || ") saved as:" bak_file;
  380.         say "info: Removing DLL (" || file || ") ...";
  381.         rc = 1;
  382.         do while(rc <> 0)
  383.           rc = SysFileDelete(fullpath);
  384.           if rc <> 0 then
  385.             do
  386.               say "notice: UNABLE TO DELETE FILE:" fullpath;
  387.               say "notice: THE DLL IS USED BY ONE OR MORE EMX PROGRAMS!";
  388.               say "notice: KILL ALL THOSE PROGRAMS BEFORE CONTINUING!";
  389.               say "notice: PRESS ENTER, WHEN READY ...";
  390.               parse pull in;
  391.             end
  392.         end            
  393.       end
  394.     else
  395.       do
  396.         say "info: Removing" file "coming with Octave/2 ...";
  397.         "del dll\" || file debug;
  398.         leave;
  399.       end
  400.   end
  401.   return;
  402.  
  403. /*
  404. *******************************************************************************
  405. ** Updating .octaverc                                                        **
  406. *******************************************************************************
  407. */
  408. update_octaverc: procedure expose debug debug_mode version
  409. parse arg home, initfile, old, new
  410.   if (initfile == "") then octrc = ".octaverc";
  411.   else                     octrc = initfile;
  412.  
  413.   octrc_new = "octaverc.new";
  414.   rc = ini_files(home, octrc, "octaverc", old, new);
  415.   if (rc == -1) then
  416.     do
  417.       "del" octrc_new debug
  418.       rc = stream(octrc_new, "C", "open write");
  419.       if (rc == "READY:") then
  420.         do
  421.           call lineout octrc_new, "# Startup file"
  422.           call lineout octrc_new, "# Octave" version "for OS/2"
  423.           call lineout octrc_new, "# (c) 1996 - 1997, Klaus Gebhardt"
  424.           rc = stream(octrc_new, "C", "close");
  425.           rc = 2;
  426.         end
  427.       else
  428.         do
  429.           say "error: Cannot create octaverc.new!";
  430.          exit;
  431.         end
  432.     end
  433.  
  434.   if (rc == 2) then
  435.     do
  436.       "del" to_os2_sep(home) || "\" || octrc debug
  437.       octrc_ini = to_os2_sep(home) || "\octave.ini"
  438.       "copy" octrc_new octrc_ini debug
  439.       "ren" octrc_ini ".octaverc" debug
  440.       rc = stream(octrc_ini, "C", "open read");
  441.       if (rc == "READY:") then
  442.         do
  443.           rc = stream(octrc_new, "C", "close");
  444.           rc = stream(octrc_ini, "C", "open write");
  445.           call lineout octrc_new, ''
  446.           call lineout octrc_new, 'history_file = "octave.hst"'
  447.           rc = stream(octrc_new, "C", "close");
  448.           return "octave.ini";
  449.         end
  450.       return "";
  451.     end
  452.   return initfile;
  453.  
  454. /*
  455. *******************************************************************************
  456. ** Modify the files .emacs, .octaverc                                        **
  457. *******************************************************************************
  458. */
  459. ini_files: procedure expose debug
  460. parse arg home, inifile, newfile, oldpath, newpath
  461.   file = to_os2_sep(home) || "\" || inifile;
  462.   ini_old = newfile || ".old";
  463.   ini_new = newfile || ".new";
  464.   say "info: Copying" file "to" ini_old "...";
  465.   "copy" file ini_old debug
  466.  
  467.   old = to_unix_sep(oldpath);
  468.   new = to_unix_sep(newpath);
  469.  
  470.   rc = stream(ini_old, "C", "open read");
  471.   if (rc <> "READY:") then return -1;
  472.  
  473.   "del" ini_new debug;
  474.   rc = stream(ini_new, "C", "open write");
  475.   if (rc <> "READY:") then
  476.     do
  477.       say "info: Cannot open" ini_new || "!";
  478.       rc = stream(ini_old, "C", "close");
  479.       exit;
  480.     end
  481.  
  482.   if (to_upper(old) == to_upper(new)) then return 0;
  483.  
  484.   rv = 1;
  485.   do while(lines(ini_old))
  486.     line  = linein(ini_old);
  487.     p = pos(to_upper(old), to_upper(line));
  488.     if (p <> 0) then
  489.       do
  490.         rv = 2;
  491.         if (p == 1) then
  492.           do
  493.             line = new || substr(line, 1+length(old));
  494.           end
  495.         else
  496.           do
  497.             line = substr(line, 1, p-1) || new || substr(line, p+length(old));
  498.           end
  499.       end
  500.     call lineout ini_new, line
  501.   end
  502.  
  503.   rc = stream(ini_new, "C", "close");
  504.   rc = stream(ini_old, "C", "close");
  505.   return rv;
  506.  
  507. /*
  508. *******************************************************************************
  509. ** Remove old INFO files, modify all dir files                               **
  510. *******************************************************************************
  511. */
  512. info_path_dir: procedure expose debug
  513. parse arg info_path, octave_home, version
  514.   infopath = to_os2_sep(info_path);
  515.   octaveinfopath = to_os2_sep(octave_home || "/doc");
  516.  
  517.   p = 1;
  518.   q = 1;
  519.   do while (q > 0)
  520.     q = pos(";", infopath, p);
  521.     if (q == 0) then infodir = substr(infopath, p);
  522.     else             infodir = substr(infopath, p, q - p);
  523.     p = q + 1;
  524.  
  525.     if (infodir == "")  then iterate;
  526.     if (infodir == ".")  then iterate;
  527.     if (to_upper(infodir) == to_upper(octaveinfopath)) then iterate;
  528.  
  529.     say "info: Removing old info files in" infodir;
  530.     "del" infodir || "\octave" debug
  531.     "del" infodir || "\octave.i0?" debug
  532.     "del" infodir || "\octave.i1?" debug
  533.     "del" infodir || "\liboct" debug
  534.     "del" infodir || "\liboct.i0?" debug
  535.     "del" infodir || "\faq" debug
  536.     "del" infodir || "\oct-faq" debug
  537.  
  538.     file = infodir || "\dir"
  539.     dir_old = "dir" || p || ".old";
  540.     dir_new = "dir" || p || ".new";
  541.     say "info: Copying" file "to" dir_old "...";
  542.     "copy" file dir_old debug
  543.  
  544.     rc = stream(dir_old, "C", "open read");
  545.     if (rc <> "READY:") then return;
  546.  
  547.     "del" dir_new debug;
  548.     rc = stream(dir_new, "C", "open write");
  549.     if (rc <> "READY:") then
  550.       do
  551.         say "error: Cannot open" dir_new || "!";
  552.         rc = stream(dir_old, "C", "close");
  553.         exit;
  554.       end
  555.  
  556.     line = " ";
  557.     do while(lines(dir_old))
  558.       if line == d2c(31) then call lineout dir_new, line
  559.       line  = linein(dir_old);
  560.       parse var line w1 w2 ":" w3 "." w4
  561.       if ((w1 <> "*") | ((to_upper(w3) <> "(FAQ)") & (to_upper(w3) <> "(OCT-FAQ)") & (to_upper(w3) <> "(OCTAVE)") & (to_upper(w3) <> "(LIBOCT)"))) then
  562.         do
  563.           if line <> d2c(31) then call lineout dir_new, line
  564.         end
  565.     end
  566.  
  567.     call lineout dir_new, "* octave:    (octave).      Octave" version || "."
  568.     call lineout dir_new, "* liboctave: (liboct).      Info about liboctave" version || "."
  569.     call lineout dir_new, "* octave-faq:(oct-faq).     FAQs about Octave" version || "."
  570.    call lineout dir_new, d2c(31)
  571.  
  572.     rc = stream(dir_new, "C", "close");
  573.     rc = stream(dir_old, "C", "close");
  574.  
  575.     say "info: Copying" dir_new "to" file "...";
  576.     "copy" dir_new file debug
  577.   end
  578.   return;
  579.  
  580. /*
  581. *******************************************************************************
  582. ** Unzip DLFCN files                                                         **
  583. *******************************************************************************
  584. */
  585. unzip_dlfcn_files: procedure expose debug
  586. parse arg dlfcn
  587.   ".\unzip -uo" dlfcn debug
  588.   return;
  589.  
  590. /*
  591. *******************************************************************************
  592. ** Unzip script files                                                        **
  593. *******************************************************************************
  594. */
  595. unzip_script_files: procedure expose debug
  596. parse arg zipfile
  597.   rc = SysFileTree(zipfile, fs, "F");
  598.   if fs.0 = 0 then return;
  599.   rc = SysFileTree("ChangeLog", fs, "F");
  600.   if fs.0 = 1 then scr = "scripts/*";
  601.   else             scr = "scripts.fat/*";
  602.   say "info: Unzipping scriptfiles ...";
  603.   if fs.0 = 0 then "ren scripts scripts.fat";
  604.   ".\unzip -uo" zipfile scr debug
  605.   if fs.0 = 0 then "ren scripts.fat scripts";
  606.   return;
  607.  
  608. /*
  609. *******************************************************************************
  610. ** Create a WPS object for Octave/2                                          **
  611. *******************************************************************************
  612. */
  613. create_wps_object: procedure expose debug
  614. parse arg octave_home, version
  615.  
  616.   octave_folder_id = "<HWB_OCTAVE_FOLDER>";
  617.  
  618.   call SysCreateObject "WPFolder", "Octave/2", "<WP_DESKTOP>", ,
  619.        "OBJECTID="||octave_folder_id, "fail"
  620.  
  621.   object_name = "Octave" version;
  622.   octave_file = to_os2_sep(octave_home) || "\octave.exe";
  623.   octave_icon = to_os2_sep(octave_home) || "\octave.ico";
  624.  
  625.   rc = SysCreateObject("WPProgram", object_name, octave_folder_id, ,
  626.        "EXENAME="octave_file";PROGTYPE=WINDOWABLEVIO;ICONFILE="octave_icon||,
  627.        ";OBJECTID=<HWB_OCTAVE>", "replace");
  628.  
  629.   if rc == 1 then say "info: Program object for Octave created successfully."
  630.   else            say "notice: Could not create program object for Octave."
  631.  
  632.   call make_book 'oct-faq.inf', 'FAQ about Octave', ''
  633.   call make_book 'octave.inf', 'GNU Octave', ''
  634.   call make_book 'liboct.inf', 'Octave C++ Classes', ''
  635.  
  636.   return;
  637.  
  638. make_book: procedure expose octave_folder_id octave_home
  639. parse arg name, title, parm
  640.  
  641.   file = to_os2_sep(octave_home) || "\doc\" || name;
  642.  
  643.   rc = SysCreateObject('WPProgram', title, octave_folder_id, ,
  644.                       'PROGTYPE=PM;EXENAME=VIEW.EXE;PARAMETERS='||file||parm, ,
  645.                       'replace');
  646.  
  647.   if rc == 1 then say "info: Book object" title "created successfully."
  648.   else            say "notice: Could not create book object" title "."
  649.   return;
  650.  
  651. /*
  652. *******************************************************************************
  653. ** Determine the drive OS/2 is booted from                                   **
  654. *******************************************************************************
  655. */
  656. get_boot_drive: procedure expose debug
  657.   irc = SysIni("BOTH", "FolderWorkareaRunningObjects",,
  658.                "ALL:", "Objects");
  659.   boot1 = left(Objects.1, 2);;
  660.   do i = 2 to Objects.0
  661.     if (to_upper(right(Objects.i, 7)) == "DESKTOP")           then boot1 = left(Objects.i, 2);
  662.     if (to_upper(right(Objects.i,17)) == "ARBEITSOBERFLÄCHE") then boot1 = left(Objects.i, 2);
  663.     if (to_upper(right(Objects.i, 9)) == "SKRIVBORD")         then boot1 = left(Objects.i, 2);
  664.   end
  665.   boot2 = substr(translate(value("PATH", , "OS2ENVIRONMENT")), pos("\OS2\SYSTEM", translate(value("PATH", , "OS2ENVIRONMENT")))-2, 2);
  666.   rc = SysFileTree(boot1 || "\config.sys", cfg, "FO");
  667.   if ((to_upper(boot1) == to_upper(boot2)) & (cfg.0 == 1)) then return boot1;
  668.   else
  669.     do
  670.       say "error: Unable to determine the boot drive!";
  671.       do while (1)
  672.         say "error: Available disk drives are:"
  673.         drivelist = SysDriveMap()
  674.         say "error:   " drivelist
  675.  
  676.         say "error: Please enter the OS/2 boot drive OS/2 (example, c:)?  "
  677.         pull drive
  678.  
  679.         rc = SysFileTree(drive || "\config.sys", cfg, "FO");
  680.         if ((wordpos(drive, drivelist) == 0) & (cfg.0 <> 1)) then
  681.           do
  682.             say "error: You must enter a proper drive letter with colon."
  683.             say "error: There must also be the file CONFIG.SYS in the root!"
  684.           end
  685.         else return drive;
  686.       end
  687.     end
  688.   return boot1;
  689.  
  690. /*
  691. *******************************************************************************
  692. ** Replace old pathes                                                        **
  693. *******************************************************************************
  694. */
  695. subst_paths: procedure expose debug
  696. parse arg path_arg, old_path, new_path
  697.   path= to_os2_sep(path_arg);
  698.   old = to_os2_sep(old_path);
  699.   new = to_os2_sep(new_path);
  700.  
  701.   p = 0;
  702.   do while(1)
  703.     p = pos(to_upper(old), to_upper(path), p + 1);
  704.     if (p == 0) then
  705.       do
  706.         if (substr(path, length(path)) == ";") then return path || new || ";";
  707.         else                                        return path || ";" || new;
  708.       end
  709.     if (p <> 1) then
  710.       do
  711.         if (substr(path, p - 1, 1) <> ";") then iterate;
  712.       end
  713.     q = pos(";", path, p);
  714.     if (q == 0) then old_path = substr(path, p);
  715.     else             old_path = substr(path, p, q - p);
  716.     if (to_upper(old_path) <> to_upper(old)) then iterate;
  717.     if (q == 0) then return substr(path, 1, p-1) || new;
  718.     else             return substr(path, 1, p-1) || new || substr(path, q);
  719.   end
  720.  
  721. /*
  722. *******************************************************************************
  723. ** Utilities                                                                 **
  724. *******************************************************************************
  725. */
  726. to_upper: procedure
  727. parse arg string
  728.   return translate(string, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz");
  729.  
  730. to_lower: procedure
  731. parse arg string
  732.   return translate(string, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
  733.  
  734. to_unix_sep: procedure
  735. parse arg string
  736.   return translate(string, "/", "\");
  737.  
  738. to_os2_sep: procedure
  739. parse arg string
  740.   return translate(string, "\", "/");
  741.