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