home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / makobj05.zip / makeobj.cmd next >
OS/2 REXX Batch file  |  1999-06-29  |  40KB  |  1,071 lines
  1. /* Makes a WPS object out of the filepath it receives as an argument. */
  2.  
  3. /* GNU GENERAL PUBLIC LICENSE */
  4.  
  5. /* TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION */
  6.  
  7. /*  0. This License applies to any program or other work which contains */
  8. /* a notice placed by the copyright holder saying it may be distributed */
  9. /* under the terms of this General Public License.  The "Program", below, */
  10. /* refers to any such program or work, and a "work based on the Program" */
  11. /* means either the Program or any derivative work under copyright law:  */
  12. /* that is to say, a work containing the Program or a portion of it, */
  13. /* either verbatim or with modifications and/or translated into another */
  14. /* language.  (Hereinafter, translation is included without limitation in */
  15. /* the term "modification".)  Each licensee is addressed as "you". */
  16.  
  17. /* Activities other than copying, distribution and modification are not */
  18. /* covered by this License; they are outside its scope.  The act of */
  19. /* running the Program is not restricted, and the output from the Program */
  20. /* is covered only if its contents constitute a work based on the */
  21. /* Program (independent of having been made by running the Program).  */
  22. /* Whether that is true depends on what the Program does. */
  23.  
  24. /*  1. You may copy and distribute verbatim copies of the Program's */
  25. /* source code as you receive it, in any medium, provided that you */
  26. /* conspicuously and appropriately publish on each copy an appropriate */
  27. /* copyright notice and disclaimer of warranty; keep intact all the */
  28. /* notices that refer to this License and to the absence of any warranty; */
  29. /* and give any other recipients of the Program a copy of this License */
  30. /* along with the Program.  */
  31.  
  32. /* You may charge a fee for the physical act of transferring a copy, and */
  33. /* you may at your option offer warranty protection in exchange for a */
  34. /* fee.  */
  35.  
  36. /*  2. You may modify your copy or copies of the Program or any portion */
  37. /* of it, thus forming a work based on the Program, and copy and */
  38. /* distribute such modifications or work under the terms of Section 1 */
  39. /* above, provided that you also meet all of these conditions:  */
  40.  
  41. /*    a) You must cause the modified files to carry prominent notices */
  42. /*    stating that you changed the files and the date of any change. */
  43.  
  44. /*    b) You must cause any work that you distribute or publish, that in */
  45. /*    whole or in part contains or is derived from the Program or any */
  46. /*    part thereof, to be licensed as a whole at no charge to all third */
  47. /*    parties under the terms of this License.  */
  48.  
  49. /*    c) If the modified program normally reads commands interactively */
  50. /*    when run, you must cause it, when started running for such */
  51. /*    interactive use in the most ordinary way, to print or display an */
  52. /*    announcement including an appropriate copyright notice and a */
  53. /*    notice that there is no warranty (or else, saying that you provide */
  54. /*    a warranty) and that users may redistribute the program under */
  55. /*    these conditions, and telling the user how to view a copy of this */
  56. /*    License.  (Exception: if the Program itself is interactive but */
  57. /*    does not normally print such an announcement, your work based on */
  58. /*    the Program is not required to print an announcement.)  */
  59.  
  60. /* These requirements apply to the modified work as a whole.  If */
  61. /* identifiable sections of that work are not derived from the Program, */
  62. /* and can be reasonably considered independent and separate works in */
  63. /* themselves, then this License, and its terms, do not apply to those */
  64. /* sections when you distribute them as separate works.  But when you */
  65. /* distribute the same sections as part of a whole which is a work based */
  66. /* on the Program, the distribution of the whole must be on the terms of */
  67. /* this License, whose permissions for other licensees extend to the */
  68. /* entire whole, and thus to each and every part regardless of who wrote */
  69. /* it.  */
  70.  
  71.  
  72. /* Thus, it is not the intent of this section to claim rights or contest */
  73. /* your rights to work written entirely by you; rather, the intent is to */
  74. /* exercise the right to control the distribution of derivative or */
  75. /* collective works based on the Program.  */
  76.  
  77. /* In addition, mere aggregation of another work not based on the Program */
  78. /* with the Program (or with a work based on the Program) on a volume of */
  79. /* a storage or distribution medium does not bring the other work under */
  80. /* the scope of this License.    */
  81.  
  82. /*  3. You may copy and distribute the Program (or a work based on it, */
  83. /* under Section 2) in object code or executable form under the terms of */
  84. /* Sections 1 and 2 above provided that you also do one of the following: */
  85.  
  86. /*    a) Accompany it with the complete corresponding machine-readable */
  87. /*    source code, which must be distributed under the terms of Sections */
  88. /*    1 and 2 above on a medium customarily used for software inter- */
  89. /*    change; or, */
  90.  
  91. /*    b) Accompany it with a written offer, valid for at least three */
  92. /*    years, to give any third party, for a charge no more than your */
  93. /*    cost of physically performing source distribution, a complete */
  94. /*    machine-readable copy of the corresponding source code, to be */
  95. /*    distributed under the terms of Sections 1 and 2 above on a medium */
  96. /*    customarily used for software interchange; or, */
  97.  
  98. /*    c) Accompany it with the information you received as to the offer */
  99. /*    to distribute corresponding source code.  (This alternative is */
  100. /*    allowed only for noncommercial distribution and only if you */
  101. /*    received the program in object code or executable form with such */
  102. /*    an offer, in accord with Subsection b above.)  */
  103.  
  104. /* The source code for a work means the preferred form of the work for */
  105. /* making modifications to it.  For an executable work, complete source */
  106. /* code means all the source code for all modules it contains, plus any */
  107. /* associated interface definition files, plus the scripts used to */
  108. /* control compilation and installation of the executable.  However, as a */
  109. /* special exception, the source code distributed need not include */
  110. /* anything that is normally distributed (in either source or binary */
  111. /* form) with the major components (compiler, kernel, and so on) of the */
  112. /* operating system on which the executable runs, unless that component */
  113. /* itself accompanies the executable.    */
  114.  
  115. /* If distribution of executable or object code is made by offering */
  116. /* access to copy from a designated place, then offering equivalent */
  117. /* access to copy the source code from the same place counts as */
  118. /* distribution of the source code, even though third parties are not */
  119. /* compelled to copy the source along with the object code.  */
  120.  
  121. /*  4. You may not copy, modify, sublicense, or distribute the Program */
  122. /* except as expressly provided under this License.  Any attempt */
  123. /* otherwise to copy, modify, sublicense or distribute the Program is */
  124. /* void, and will automatically terminate your rights under this License.  */
  125. /* However, parties who have received copies, or rights, from you under */
  126. /* this License will not have their licenses terminated so long as such */
  127. /* parties remain in full compliance.    */
  128.  
  129. /*  5. You are not required to accept this License, since you have not */
  130. /* signed it.    However, nothing else grants you permission to modify or */
  131. /* distribute the Program or its derivative works.  These actions are */
  132. /* prohibited by law if you do not accept this License.  Therefore, by */
  133. /* modifying or distributing the Program (or any work based on the */
  134. /* Program), you indicate your acceptance of this License to do so, and */
  135. /* all its terms and conditions for copying, distributing or modifying */
  136. /* the Program or works based on it.  */
  137.  
  138. /*  6. Each time you redistribute the Program (or any work based on the */
  139. /* Program), the recipient automatically receives a license from the */
  140. /* original licensor to copy, distribute or modify the Program subject to */
  141. /* these terms and conditions.  You may not impose any further */
  142. /* restrictions on the recipients' exercise of the rights granted herein.  */
  143. /* You are not responsible for enforcing compliance by third parties to */
  144. /* this License.  */
  145.  
  146. /*  7. If, as a consequence of a court judgment or allegation of patent */
  147. /* infringement or for any other reason (not limited to patent issues), */
  148. /* conditions are imposed on you (whether by court order, agreement or */
  149. /* otherwise) that contradict the conditions of this License, they do not */
  150. /* excuse you from the conditions of this License.  If you cannot */
  151. /* distribute so as to satisfy simultaneously your obligations under this */
  152. /* License and any other pertinent obligations, then as a consequence you */
  153. /* may not distribute the Program at all.  For example, if a patent */
  154. /* license would not permit royalty-free redistribution of the Program by */
  155. /* all those who receive copies directly or indirectly through you, then */
  156. /* the only way you could satisfy both it and this License would be to */
  157. /* refrain entirely from distribution of the Program.    */
  158.  
  159. /* If any portion of this section is held invalid or unenforceable under */
  160. /* any particular circumstance, the balance of the section is intended to */
  161. /* apply and the section as a whole is intended to apply in other */
  162. /* circumstances.  */
  163.  
  164. /* It is not the purpose of this section to induce you to infringe any */
  165. /* patents or other property right claims or to contest validity of any */
  166. /* such claims; this section has the sole purpose of protecting the */
  167. /* integrity of the free software distribution system, which is */
  168. /* implemented by public license practices.  Many people have made */
  169. /* generous contributions to the wide range of software distributed */
  170. /* through that system in reliance on consistent application of that */
  171. /* system; it is up to the author/donor to decide if he or she is willing */
  172. /* to distribute software through any other system and a licensee cannot */
  173. /* impose that choice.  */
  174.  
  175. /* This section is intended to make thoroughly clear what is believed to */
  176. /* be a consequence of the rest of this License.  */
  177.  
  178. /*  8. If the distribution and/or use of the Program is restricted in */
  179. /* certain countries either by patents or by copyrighted interfaces, the */
  180. /* original copyright holder who places the Program under this License */
  181. /* may add an explicit geographical distribution limitation excluding */
  182. /* those countries, so that distribution is permitted only in or among */
  183. /* countries not thus excluded.  In such case, this License incorporates */
  184. /* the limitation as if written in the body of this License.  */
  185.  
  186. /*  9. The Free Software Foundation may publish revised and/or new */
  187. /* versions of the General Public License from time to time.  Such new */
  188. /* versions will be similar in spirit to the present version, but may */
  189. /* differ in detail to address new problems or concerns.  */
  190.  
  191. /* Each version is given a distinguishing version number.  If the Program */
  192. /* specifies a version number of this License which applies to it and */
  193. /* "any later version", you have the option of following the terms and */
  194. /* conditions either of that version or of any later version published by */
  195. /* the Free Software Foundation.  If the Program does not specify a */
  196. /* version number of this License, you may choose any version ever pub- */
  197. /* lished by the Free Software Foundation.  */
  198.  
  199. /*  10. If you wish to incorporate parts of the Program into other free */
  200. /* programs whose distribution conditions are different, write to the */
  201. /* author to ask for permission.  For software which is copyrighted by */
  202. /* the Free Software Foundation, write to the Free Software Foundation; */
  203. /* we sometimes make exceptions for this.  Our decision will be guided by */
  204. /* the two goals of preserving the free status of all derivatives of our */
  205. /* free software and of promoting the sharing and reuse of software */
  206. /* generally.   */
  207.  
  208. /* NO WARRANTY */
  209.  
  210. /*  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO */
  211. /* WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  */
  212. /* EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR */
  213. /* OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY */
  214. /* KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE */
  215. /* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR */
  216. /* PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE */
  217. /* PROGRAM IS WITH YOU.   SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME */
  218. /* THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.   */
  219.  
  220. /*  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN */
  221. /* WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY */
  222. /* AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU */
  223. /* FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUEN-*/
  224. /* TIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM */
  225. /* (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED IN- */
  226. /* ACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF */
  227. /* THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER */
  228. /* OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.  */
  229.  
  230. /* END OF TERMS AND CONDITIONS */
  231.  
  232. /* MAIN                                          */
  233.  
  234. /* Initialize */
  235. call on ERROR
  236. call on FAILURE
  237. call on HALT
  238. call on NOTREADY
  239. signal on NOVALUE
  240. signal on SYNTAX
  241.  
  242. parse source OS Call_Mode My_Name
  243. version = '1.05'
  244. description = "Make Object"
  245. copyright = "Copyright (C) 1999 by John Merryweather Cooper.  All rights reserved."
  246. contact = 'jmcoopr@webmail.bmi.net'
  247. freeware = "is free software.  The source includes the General Public License."
  248. call LOAD_UTIL_FUNC 'SysLoadFuncs'
  249. call SysLoadFuncs
  250. program_filename = translate(filespec('NAME', My_Name))
  251. program_name = BASENAME(My_Name)
  252. call LOAD_UTIL_FUNC 'SysOS2Ver'
  253. say "REXX <" || Call_Mode || "> " || BASENAME(My_Name) || " on " || OS || " v." || SysOS2Ver() || ".  " || description || " v." || version || "."
  254. say copyright
  255. say contact
  256. say
  257. say program_name || ' ' || freeware
  258. say
  259.  
  260. /* This program allows Unix-style path separator '/' */
  261. arg path_name
  262. path_name = translate(path_name, '\', '/')
  263. if path_name = '' | path_name = '-?' | path_name = '--HELP' | arg() = 0 then
  264.     call USAGE
  265. else
  266. do
  267.     call LOAD_UTIL_FUNC 'SysFileTree'
  268.     call SysFileTree path_name, 'treelist', 'FO', '**-*-'
  269.     if treelist.0 > 1 then
  270.     do I = 1 to treelist.0
  271.      call MAIN_MAKEOBJECT treelist.I
  272.     end I
  273.     else
  274.      call MAIN_MAKEOBJECT path_name
  275. end  /* main program block */
  276. exit
  277.  
  278. /* MAIN exit                                             */
  279. exit
  280.  
  281. /* MAIN_MAKEOBJECT start */
  282. MAIN_MAKEOBJECT:  procedure expose program_name
  283. arg path_name
  284.     if PATHNAME_EXISTS(path_name) \= '' then
  285.     do
  286.      ext = GET_TYPE(path_name)
  287.      select
  288.          when ext = 'EXE' then call MAKEPRG path_name
  289.          when ext = 'INF' then call MAKEBOOK path_name
  290.          when ext = 'HLP' then call MAKEHELP path_name
  291.          when ext = 'PS' then call MAKEPS path_name
  292.          when ext = 'PDF' then call MAKEPDF path_name
  293.          when ext = 'HTML' then call MAKEHTML path_name
  294.      otherwise call MAKESHADOW path_name
  295.      end     /* select */
  296.     end     /* if */
  297.     else
  298.     do
  299.      say "Can't find "path_name"."
  300.      say program_name || " <no argument>, -?, or --help for usage."
  301.     end     /* else */
  302.     return ""
  303. /* MAIN_MAKEOBJECT end */
  304.  
  305. /* Error handling start */
  306. ERROR:
  307. return SAY_TRAP(sigl, "OS/2 program reports error.")
  308.  
  309. FAILURE:
  310. return SAY_TRAP(sigl, "OS/2 program could not execute.")
  311.  
  312. HALT:
  313.     rc = SAY_TRAP('', "User Abort Request.")
  314.     say "Terminate " || BASENAME(program_name) || '?  Y/N'
  315.     reply = translate(KEYPRESS())
  316.     if left(reply,1) = 'Y' then exit rc; else return rc
  317.  
  318. NOTREADY:
  319. return SAY_TRAP(sigl, "File system permission/exists error.")
  320.  
  321. NOVALUE:
  322.     SAY_TRAP_EXIT(sigl, "Undefined variable(s).")
  323.  
  324. SYNTAX:
  325.     SAY_TRAP_EXIT(sigl, errortext(rc))
  326.  
  327. /* User Trap */
  328. FATAL_ERROR:
  329. exit '1'
  330.  
  331. /* Error handling end */
  332.  
  333. /***************************************************************************/
  334. /* Firewall:  END OF MAIN                                    */
  335. say "Error:  Firewall breached--this message should never display!"
  336. exit '1'
  337. /* Firewall:  END OF MAIN                                    */
  338. /***************************************************************************/
  339.  
  340. /* Procedure GET_TYPE start */
  341. GET_TYPE:  procedure
  342. arg path_name
  343.     path_name = translate(path_name, '\', '/')
  344.     if IS_EXECUTABLE(path_name) \= '' then
  345.      return 'EXE'
  346.     else if IS_ACROBAT(path_name) \= '' then
  347.      return 'PDF'
  348.     else if IS_HTML(path_name) \= '' then
  349.      return 'HTML'
  350.     else if IS_BOOK(path_name) \= '' then
  351.      return 'INF'
  352.     else if IS_HELP(path_name) \= '' then
  353.      return 'HLP'
  354.     else if IS_POSTSCRIPT(path_name) \= '' then
  355.      return 'PS'
  356.     else
  357.      return ''
  358. /* Procedure GET_TYPE end */
  359.  
  360. /* Procedure GET_TYPE_EA start */
  361. GET_TYPE_EA:  procedure
  362. arg path_name
  363.     path_name = translate(path_name, '\', '/')
  364.     call LOAD_UTIL_FUNC 'SysGetEA'
  365.     type = ''
  366.     if SysGetEA(path_name, '.TYPE', 'typeinfo') = 0 then
  367.      parse var typeinfo 11 type
  368. return type
  369. /* Procedure GET_TYPE_EA end */
  370.  
  371. /* Procedure TEST_TYPE start */
  372. TEST_TYPE:  procedure
  373. parse arg type, test_type
  374. return wordpos(test_type, type)
  375. /* Procedure TEST_TYPE end */
  376.  
  377. /* Procedure GET_EXT start */
  378. GET_EXT:  procedure
  379. arg path_name
  380.     path_name = translate(path_name, '\', '/')
  381.     file_name = filespec('NAME', path_name)
  382. return right(file_name, length(file_name) - lastpos(".", file_name))
  383. /* Procedure GET_EXT end */
  384.  
  385. /* Procedure IS_EXECUTABLE start */
  386. IS_EXECUTABLE:  procedure
  387. arg path_name
  388.     path_name = translate(path_name, '\', '/')
  389.     type_string = GET_TYPE_EA(path_name)
  390.     if TEST_TYPE(type_string, 'DOS Command File') \= 0 then
  391.      return 'EXE'
  392.     else if TEST_TYPE(type_string, 'Executable') \= 0 then
  393.      return 'EXE'
  394.     else if TEST_TYPE(type_string, 'OS/2 Command File') \= 0 then
  395.      return 'EXE'
  396.     else
  397.     do
  398.      extension = GET_EXT(path_name)
  399.      select
  400.          when extension = 'BAT' then return 'EXE'
  401.          when extension = 'CMD' then return 'EXE'
  402.          when extension = 'COM' then return 'EXE'
  403.          when extension = 'EXE' then return 'EXE'
  404.          otherwise return ''
  405.      end /* select */
  406.     end /* else */
  407. /* Procedure IS_EXECUTABLE end */
  408.  
  409. /* Procedure IS_ACROBAT start */
  410. IS_ACROBAT:  procedure
  411. arg path_name
  412.     path_name = translate(path_name, '\', '/')
  413.     type_string = GET_TYPE_EA(path_name)
  414.     if TEST_TYPE(type_string, 'Acrobat Document') \= 0 then
  415.      return 'PDF'
  416.     else
  417.     do
  418.      extension = GET_EXT(path_name)
  419.      select
  420.          when extension = 'PDF' then return 'PDF'
  421.          otherwise return ''
  422.      end /* select */
  423.     end /* else */
  424. /* Procedure IS_ACROBAT end */
  425.  
  426. /* Procedure IS_HTML start */
  427. IS_HTML:  procedure
  428. arg path_name
  429.     path_name = translate(path_name, '\', '/')
  430.     type_string = GET_TYPE_EA(path_name)
  431.     if TEST_TYPE(type_string, 'HTML') \= 0 then
  432.      return 'HTML'
  433.     else if TEST_TYPE(type_string, 'text/html') \= 0 then
  434.      return 'HTML'
  435.     else
  436.     do
  437.      extension = GET_EXT(path_name)
  438.      select
  439.          when extension = 'HTM' then return 'HTML'
  440.          when extension = 'HTML' then return 'HTML'
  441.          otherwise return ''
  442.      end /* select */
  443.     end /* else */
  444. /* Procedure IS_HTML end */
  445.  
  446. /* Procedure IS_BOOK start */
  447. IS_BOOK:  procedure
  448. arg path_name
  449.     path_name = translate(path_name, '\', '/')
  450.     extension = GET_EXT(path_name)
  451.     select
  452.      when extension = 'INF' then return 'INF'
  453.      otherwise return ''
  454.     end /* select */
  455. /* Procedure IS_BOOK end */
  456.  
  457. /* Procedure IS_HELP start */
  458. IS_HELP:  procedure
  459. arg path_name
  460.     path_name = translate(path_name, '\', '/')
  461.     extension = GET_EXT(path_name)
  462.     select
  463.      when extension = 'HLP' then return 'HLP'
  464.      otherwise return ''
  465.     end /* select */
  466. /* Procedure IS_HELP end */
  467.  
  468. /* Procedure IS_POSTSCRIPT start */
  469. IS_POSTSCRIPT:  procedure
  470. arg path_name
  471.     path_name = translate(path_name, '\', '/')
  472.     extension = GET_EXT(path_name)
  473.     select
  474.      when extension = 'PS' then return 'PS'
  475.      when extension = 'EPS' then return 'PS'
  476.      otherwise return ''
  477.     end /* select */
  478. /* Procedure IS_POSTSCRIPT end */
  479.  
  480. /* Procedure KEYPRESS start */
  481. KEYPRESS:  procedure
  482.     LOAD_UTIL_FUNC 'SysGetKey'
  483.  
  484.     /* Need to consume NUL byte of extended key codes */
  485.     key = 0
  486.     do while key = 0
  487.      key = SysGetKey('NOECHO')
  488.     end /* do */
  489. return key
  490. /* Procedure KEYPRESS end */
  491.  
  492. /* Procedure SAY_TRAP start */
  493. SAY_TRAP:  procedure expose rc
  494. parse arg error_line, message
  495.     parse source os cm Prog_name
  496.  
  497.     trap_error = condition('C')
  498.     say 'TRAP:  ' || BASENAME(Prog_name) || '(' || error_line || ') ' || message
  499.     if (trap_error = 'ERROR') | (trap_error = 'FAILURE') then
  500.      say condition('D') || ' is in ' || trap_error || ' with Return Code = ' || rc
  501.     else if trap_error = 'NOVALUE' then
  502.      say condition('D') || ' has ' || trap_error
  503.     else if trap_error = 'HALT' then
  504.      say BASENAME(Prog_name) || ' has ' || trap_error || 'ed'
  505.     else if trap_error = 'SYNTAX' then
  506.      say condition('D') || ' has ' || trap_error || ' error(s)'
  507.     else if trap_error = 'NOTREADY' then
  508.      say condition('D') || ' is ' || trap_error
  509.     else
  510.      say condition('D') || ' is in ' || trap_error
  511.     say
  512.     if (trap_error \= 'NOVALUE') & (trap_error \= 'SYNTAX') then say "Continuing . . ."
  513.     say
  514. return rc
  515. /* Procedure SAY_TRAP end */
  516.  
  517. /* Procedure SAY_TRAP_EXIT start */
  518. SAY_TRAP_EXIT:  procedure expose rc
  519. parse arg fatal_line, message
  520.     call SAY_FATAL 'Fatal Trap', '<---Trap Dump Follows--->'
  521.     call SAY_TRAP fatal_line, message
  522.     say '********** (' || fatal_line - 1 || ') **********'
  523.     say sourceline(fatal_line - 1)
  524.     say ""
  525.     say 'VVVVVVVVVV (' || fatal_line || ') VVVVVVVVVV'
  526.     say '>>' || sourceline(fatal_line)
  527.     say 'AAAAAAAAAA (' || fatal_line || ') AAAAAAAAAA'
  528.     say ""
  529.     say sourceline(fatal_line + 1)
  530.     say '********** (' || fatal_line + 1 || ') **********'
  531. exit rc
  532. /* Procedure SAY_TRAP_EXIT end */
  533.  
  534. /* Procedure SAY_FATAL start */
  535. SAY_FATAL:  procedure
  536. parse arg func_name, message
  537.     parse source os cm Prg_Name
  538.     say BASENAME(Prg_Name) || ":  " || func_name || " " || message
  539.     say "Exiting . . ."
  540. return ''
  541. /* Procedure SAY_FATAL end */
  542.  
  543. /* Procedure LOAD_UTIL_FUNC  start */
  544. LOAD_UTIL_FUNC:  procedure
  545. parse arg func_name
  546.  
  547.     /* already loaded? */
  548.     rc_query = RxFuncQuery(func_name)
  549.  
  550.     /* if SysLoadFuncs exists, then we'll assume that it has been called . . . loading all funcs */
  551.     if func_name \= 'SysLoadFuncs' then rc_query = RxFuncQuery('SysLoadFuncs')
  552.     if rc_query = 0 then return '0'
  553.  
  554.     /* attempt to load */
  555.     rc_add = RxFuncAdd(func_name, 'RexxUtil', func_name)
  556.     rc_query = RxFuncQuery(func_name)
  557.     if (rc_add \= 0) | (rc_query \= 0) then
  558.     do
  559.      call SAY_FATAL func_name, "in RexxUtil.DLL failed to load.  Check LIBPATH."
  560.      signal FATAL_ERROR
  561.     end /* if do */
  562. return '0'
  563. /* Procedure LOAD_UTIL_FUNC end */
  564.  
  565. /* Procedure BASENAME start */
  566. BASENAME:  procedure
  567. arg path_name
  568.     path_name = translate(path_name, '\', '/')
  569.     /* take a filename or filepath and remove the last extension */
  570.     path_name = filespec('NAME', path_name)
  571.     if lastpos(".", path_name) \= 0 then
  572.     do
  573.      temp = left(path_name, lastpos(".", path_name) - 1)
  574.      if temp \= '' then
  575.          path_name = temp
  576.      else  /* to handle files that only have an "extension" */
  577.          path_name = '.'
  578.     end     /* if */
  579. return path_name
  580. /* Procedure BASENAME end */
  581.  
  582. /* Procedure MAKEOBJECT start */
  583. MAKEOBJECT:  procedure
  584. parse arg obj_setup, obj_type, obj_raw_title
  585.  
  586.     call LOAD_UTIL_FUNC 'SysCreateObject'
  587.  
  588.     /* Create desktop objects based on "obj_setup" and "obj_type" with a */
  589.     /* if raw_title is a filepath then chop to BASENAME */
  590.     if stream(obj_raw_title, 'C', 'QUERY EXISTS') \= '' then
  591.      title = BASENAME(obj_raw_title)
  592.     else
  593.     title = obj_raw_title
  594.  
  595.     /* try to create object */
  596.     call SysCreateObject obj_type, title, '<WP_DESKTOP>', obj_setup, 'f'
  597.  
  598.     /* handle error created by pre-existing object with title clash */
  599.     do while result = 0
  600.      call INCREMENT_TITLE obj_type, title, obj_setup
  601.    end      /* do until */
  602. return result
  603. /* Procedure MAKEOBJECT end */
  604.  
  605. /* Procedure MAKEPRG start */
  606. MAKEPRG:  procedure
  607. parse arg prog_name
  608.     setup = ''
  609.     /* create program objects for programs */
  610.     setup = 'EXENAME='prog_name';PARAMETERS=%*'
  611.     type = 'WPProgram'
  612.     call MAKEOBJECT setup, type, prog_name
  613. return result
  614. /* Procedure MAKEPRG end */
  615.  
  616. /* Procedure MAKEBOOK start */
  617. MAKEBOOK:  procedure
  618. parse arg book_name
  619.     setup = ''
  620.     title = BOOK_TITLE(book_name)
  621.     /* create view objects for books */
  622.     setup = 'EXENAME=view.exe;PARAMETERS='book_name
  623.     type = 'WPProgram'
  624.     call MAKEOBJECT setup, type, title
  625. return result
  626. /* Procedure MAKEBOOK end */
  627.  
  628. /* Procedure MAKEHELP start */
  629. MAKEHELP:  procedure
  630. parse arg help_name
  631.     setup = ''
  632.     title = BOOK_TITLE(help_name)
  633.     /* create view objects for help files */
  634.     /* On Warp 4, you can find viewhelp.exe in your \mptn\bin path */
  635.     /* Substitute your favorite browser as necessary */
  636.  
  637.     browser = 'viewhelp.exe'
  638.     setup = 'EXENAME=' || browser || ';PARAMETERS=' || help_name
  639.     type = 'WPProgram'
  640.     call MAKEOBJECT setup, type, title
  641. return result
  642. /* Procedure MAKEHELP end */
  643.  
  644. /* Procedure MAKEPS start */
  645. MAKEPS:  procedure
  646. parse arg ps_name
  647.     setup = ''
  648.     /* create view objects for PostScript */
  649.     /* GhostView needs to be in PATH or else you'll need to fully */
  650.     /* qualify the executable below */
  651.  
  652.     browser = 'e:\gstools\gsview\gvpm.exe'
  653.  
  654.     setup = 'EXENAME=' || browser || ';PARAMETERS=' || ps_name
  655.     type = 'WPProgram'
  656.     call MAKEOBJECT setup, type, ps_name
  657. return result
  658. /* Procedure MAKEPS end */
  659.  
  660. /* Procedure MAKEPDF start */
  661. MAKEPDF:  procedure
  662. parse arg pdf_name
  663.     setup = ''
  664.     /* create view objects for Adobe Acrobat */
  665.     /* Adobe Acrobat for OS/2 needs to be in the PATH */
  666.     /* Alternately, one could use GhostView (see above) */
  667.  
  668.     browser = 'd:\acrobat3\reados2\acroread.exe'
  669.  
  670.     setup = 'EXENAME=' || browser || ';PARAMETERS=' || pdf_name
  671.     type = 'WPProgram'
  672.     call MAKEOBJECT setup, type, pdf_name
  673. return result
  674. /* Procedure MAKEPDF end */
  675.  
  676. /* Procedure MAKEHTML start */
  677. MAKEHTML:  procedure
  678. parse arg html_name
  679.     setup = ''
  680.     /* create view objects for html programming documents on my local drives */
  681.     /* I prefer the Kiosk mode (-k option) for files */
  682.     /* You may need to modify this option if netscape is not your default browser */
  683.  
  684.     browser_option = '-k'
  685.  
  686.     html_name = MAKE_ABSOLUTE(html_name)
  687.     setup = 'URL=file:///' || html_name || ';PARAMETERS=' || browser_option
  688.     type = 'WPUrl'
  689.     title = HTML_TITLE(html_name)
  690.     call MAKEOBJECT setup, type, title
  691. return result
  692. /* Procedure MAKEHTML end */
  693.  
  694. /* Procedure MAKESHADOW start */
  695. MAKESHADOW:  procedure
  696. parse arg shadow_name
  697.  
  698.     call LOAD_UTIL_FUNC 'SysCreateShadow'
  699.     /* With Warp 4, SysCreateShadow "mechanizes" shadow creation and */
  700.     /* it's therefore a better choice now than SysCreateObject */
  701.     /* shadow_name must be an absolute path */
  702.     shadow_name = MAKE_ABSOLUTE(shadow_name)
  703.     call SysCreateShadow shadow_name, '<WP_DESKTOP>'
  704. return result
  705. /* Procedure MAKESHADOW end */
  706.  
  707. /* Procedure MAKE_ABSOLUTE start */
  708. MAKE_ABSOLUTE:  procedure
  709. arg path_name
  710.     path_name = translate(path_name, '\', '/')
  711.     cw_dir = directory()     /* push current working directory */
  712.  
  713.     /* check if directory/subdirectory */
  714.     is_directory = directory(path_name)
  715.     if is_directory = -1 | is_directory = 'X' then
  716.      return path_name
  717.  
  718.     /* parse path_name */
  719.     drive = filespec('DRIVE', path_name)
  720.     path = filespec('PATH', path_name)
  721.     name = filespec('NAME', path_name)
  722.  
  723.     /* substitute for missing parts--should only happen from command line */
  724.     if drive = '' & path = '' then
  725.     do
  726.      drive = '.'
  727.      path = '\'
  728.     end /* if */
  729.  
  730.     if drive \= '' & path = '' then
  731.     do
  732.      new_drive_path = directory(drive)
  733.      new_drive_path = new_drive_path || '\'
  734.      path = filespec('PATH', new_drive_path)
  735.     end /* if */
  736.  
  737.     if drive = '' & path \= '' then
  738.      drive = filespec('DRIVE', cw_dir)
  739.     abs_name = drive || path || name
  740.     call directory cw_dir   /* pop current working directory */
  741. return abs_name
  742. /* Procedure MAKE_ABSOLUTE end */
  743.  
  744. /* Procedure TAB start */
  745. TAB_REL:  procedure
  746. parse arg tab_cnt, in_string
  747.     in_string = copies('    ', tab_cnt) || in_string
  748. return in_string
  749. /* Procedure TAB end */
  750.  
  751. /* Procedure USAGE start */
  752. USAGE:  procedure
  753.     parse source OS Call_Mode My_Name
  754.     program_filename = translate(filespec('NAME', My_Name))
  755.     program_name = BASENAME(My_Name)
  756.     say 'Usage:  ' || program_name || ' pathname'
  757.     say
  758.     say TAB_REL(1, '"pathname" may specify a file or a folder.')
  759.     say TAB_REL(1, 'Wildcards are allowed in filespecs.')
  760.     say
  761.     say TAB_REL(1, 'Creates a WPS object on the desktop for pathname.')
  762.     say TAB_REL(1, 'Excellent for drag and drop operation.')
  763.     say
  764.     say TAB_REL(1, 'Recognizes the following extensions:  ')
  765.     say
  766.     say TAB_REL(2, '.EXE    .COM    .CMD    .BAT')
  767.     say TAB_REL(2, '.INF    .HLP    .PS     .PDF')
  768.     say TAB_REL(2, '.HTM    .HTML   .EPS')
  769.     say
  770.     say TAB_REL(1, 'Original file taken from FM/2 utilities by M. Kimes')
  771.     say TAB_REL(1, 'Extensively modified by John Merryweather Cooper :-)')
  772. return ''
  773. /* Procedure USAGE end */
  774.  
  775. /* Procedure BOOK_TITLE start */
  776. BOOK_TITLE:  procedure
  777. arg path_name
  778.     path_name = translate(path_name, '\', '/')
  779.     title_length = 0
  780.     offset = 108
  781.     title = 'Untitled:'
  782.  
  783.     /* title starts at 108 in INF file */
  784.     /* determine length of title */
  785.     do while chars(path_name) > 0
  786.      c = charin(path_name, title_length + offset, 1)
  787.      if c2d(c) = 0 then
  788.          leave
  789.      else
  790.          title_length = title_length + 1
  791.     end /* do */
  792.  
  793.     if title_length \= 0 then
  794.      title = strip(charin(path_name, offset, title_length))
  795.     else
  796.      title = title || '  ' || BASENAME(path_name)
  797. return MAP_OBJECT_TITLE(title)
  798. /* Procedure BOOK_TITLE end */
  799.  
  800. /* Procedure MAP_OBJECT_TITLE start */
  801. MAP_OBJECT_TITLE:  procedure
  802. parse arg title
  803.      /* translate ':./\' to '_' so title is not truncated */
  804.      title = translate(title, '____', ':./\')
  805. return title
  806. /* Procedure MAP_OBJECT_TITLE end */
  807.  
  808. /* Procedure MAP_HTML_TITLE start */
  809. MAP_HTML_TITLE:  procedure
  810. parse arg title
  811.  
  812.     /* defined HTML special codes from the HTML 4.0 Reference */
  813.     special_code.1 = '®'
  814.     special_code.2 = '"  "'
  815.     special_code.3 = '<  <'
  816.     special_code.4 = '>  >'
  817.     special_code.5 = 'Œ'
  818.     special_code.6 = 'œ'
  819.     special_code.7 = 'Š'
  820.     special_code.8 = 'š'
  821.     special_code.9 = 'Ÿ  Y'
  822.     special_code.10 = 'ˆ'
  823.  
  824.     special_code.11 = '˜  ~'
  825.     special_code.12 = ' '
  826.     special_code.13 = ' '
  827.     special_code.14 = ' '
  828.     special_code.15 = '‌'
  829.     special_code.16 = '‍'
  830.     special_code.17 = '‎'
  831.     special_code.18 = '‏'
  832.     special_code.19 = '–  -'
  833.     special_code.20 = '—  --'
  834.  
  835.     special_code.21 = '‘  `'
  836.     special_code.22 = "’  '"
  837.     special_code.23 = '‚'
  838.     special_code.24 = '“  "'
  839.     special_code.25 = '”  "'
  840.     special_code.26 = '„'
  841.     special_code.27 = '†'
  842.     special_code.28 = '‡'
  843.     special_code.29 = '‰'
  844.     special_code.30 = '‹'
  845.  
  846.     special_code.31 = '›'
  847.     special_code.32 = '€'
  848.     special_code.33 = ' '
  849.     special_code.34 = '¡'
  850.     special_code.35 = '¢'
  851.     special_code.36 = '£'
  852.     special_code.37 = '¤'
  853.     special_code.38 = '¥'
  854.     special_code.39 = '¦'
  855.     special_code.40 = '§'
  856.  
  857.     special_code.41 = '¨'
  858.     special_code.42 = '©'
  859.     special_code.43 = 'ª'
  860.     special_code.44 = '«'
  861.     special_code.45 = '¬'
  862.     special_code.46 = '­  -'
  863.     special_code.47 = '¯'
  864.     special_code.48 = '°'
  865.     special_code.49 = '±'
  866.     special_code.50 = '²';
  867.  
  868.     special_code.51 = '³'
  869.     special_code.52 = '´'
  870.     special_code.53 = 'µ'
  871.     special_code.54 = '¶'
  872.     special_code.55 = '·'
  873.     special_code.56 = '¸'
  874.     special_code.57 = '¹'
  875.     special_code.58 = 'º'
  876.     special_code.59 = '»'
  877.     special_code.60 = '¼'
  878.  
  879.     special_code.61 = '½'
  880.     special_code.62 = '¾'
  881.     special_code.63 = '¿'
  882.     special_code.64 = 'À  A'
  883.     special_code.65 = 'Æ'
  884.     special_code.66 = 'Ç  C'
  885.     special_code.67 = 'È  E'
  886.     special_code.68 = 'É  E'
  887.     special_code.69 = 'Ê  E'
  888.     special_code.70 = 'Ë  E'
  889.  
  890.     special_code.71 = 'Ì  I'
  891.     special_code.72 = 'Í  I'
  892.     special_code.73 = 'Á  A'
  893.     special_code.74 = '  A'
  894.     special_code.75 = 'à A'
  895.     special_code.76 = 'Ä  A'
  896.     special_code.77 = 'Π I'
  897.     special_code.78 = 'Ï  I'
  898.     special_code.79 = 'Р D'
  899.     special_code.80 = '&Ntiled;  N'
  900.  
  901.     special_code.81 = 'Ò  O'
  902.     special_code.82 = 'Ó  O'
  903.     special_code.83 = 'Ô  O'
  904.     special_code.84 = 'Õ  O'
  905.     special_code.85 = 'Ö  O'
  906.     special_code.86 = '×  O'
  907.     special_code.87 = 'Ø  O'
  908.     special_code.88 = 'Ù  U'
  909.     special_code.89 = 'Ú  U'
  910.     special_code.90 = 'Û  U'
  911.  
  912.     special_code.91 = 'Ü  U'
  913.     special_code.92 = 'Ý  Y'
  914.     special_code.93 = 'Þ  P'
  915.     special_code.94 = 'ß  ss'
  916.     special_code.95 = 'à  a'
  917.     special_code.96 = 'á  a'
  918.     special_code.97 = 'â  a'
  919.     special_code.98 = 'ã  a'
  920.     special_code.99 = 'ä  a'
  921.     special_code.100 = 'å  a'
  922.  
  923.     special_code.101 = 'æ'
  924.     special_code.102 = 'ç  c'
  925.     special_code.103 = 'è  e'
  926.     special_code.104 = 'é  e'
  927.     special_code.105 = 'ê  e'
  928.     special_code.106 = 'ë  e'
  929.     special_code.107 = 'ì  i'
  930.     special_code.108 = 'í  i'
  931.     special_code.109 = 'î  i'
  932.     special_code.110 = 'ï  i'
  933.  
  934.     special_code.111 = 'ð  d'
  935.     special_code.112 = 'ñ  n'
  936.     special_code.113 = 'ò  o'
  937.     special_code.114 = 'ó  o'
  938.     special_code.115 = 'ô  o'
  939.     special_code.116 = 'õ  o'
  940.     special_code.117 = 'ö  o'
  941.     special_code.118 = '÷'
  942.     special_code.119 = 'ø  o'
  943.     special_code.120 = 'ù  u'
  944.  
  945.     special_code.121 = 'ú  u'
  946.     special_code.122 = 'û  u'
  947.     special_code.123 = 'ü  u'
  948.     special_code.124 = 'ý y'
  949.     special_code.125 = 'þ  p'
  950.     special_code.126 = 'ÿ  y'
  951.     special_code.0 = 126
  952.  
  953.     /* scan for special character codes listed in stem special code and delete */
  954.     do index = 1 to special_code.0
  955.      parse var special_code.index HTML_code replaces
  956.      if pos(HTML_code, translate(title)) \= 0 then
  957.          title = changestr(HTML_code, title, replaces)
  958.     end /* do */
  959. return MAP_OBJECT_TITLE(title)
  960. /* Procedure MAP_HTML_TITLE end */
  961.  
  962. /* Procedure HTML_TITLE start */
  963. HTML_TITLE:  procedure
  964. arg path_name
  965.     path_name = translate(path_name, '\', '/')
  966.     title = 'Untitled:'
  967.     title_start_line = 1
  968.     title_end_line = 1
  969.  
  970.     /* find line for <TITLE> */
  971.     do while lines(path_name) > 0
  972.      line_buffer = linein(path_name, title_start_line, 1)
  973.      if pos('<TITLE>', translate(line_buffer), 1) \= 0 then
  974.          leave
  975.      else
  976.          title_start_line = title_start_line + 1
  977.     end /* do */
  978.  
  979.     /* find line for </TITLE> */
  980.     title_end_line = title_start_line
  981.     ln = 1
  982.     if pos('</TITLE>', translate(line_buffer), 1) \= 0 then
  983.      raw_title = line_buffer
  984.     else
  985.     do while lines(path_name) > 0
  986.      title_buffer.ln = linein(path_name, title_end_line, 1)
  987.      if pos('</TITLE>', title_buffer.ln, 1) \= 0 then
  988.          leave
  989.      else
  990.      do
  991.          title_end_line = title_end_line + 1
  992.          ln = ln + 1
  993.      end /* do */
  994.  
  995.      /* concat raw title, if needed */
  996.      if title_buffer.0 > 1 then
  997.      do I = 1 to ln
  998.          raw_title = raw_title || title_buffer.ln
  999.      end I
  1000.     end /* do */
  1001.  
  1002.     /* strip TITLE HTML codes and spaces */
  1003.     parse var raw_title junk_before '>' title '<' junk_after
  1004.     title = strip(title)
  1005.     title_length = length(title)
  1006.  
  1007.     if title_length = 0 then
  1008.      title = 'Untitled:  ' || BASENAME(path_name)
  1009. return MAP_HTML_TITLE(title)
  1010. /* Procedure HTML_TITLE end */
  1011.  
  1012. /* Procedure PATHNAME_EXISTS start */
  1013. PATHNAME_EXISTS:  procedure
  1014. arg path_name
  1015.     path_name = translate(path_name, '\', '/')
  1016.     it_exists = ''
  1017.  
  1018.     path_name = MAKE_ABSOLUTE(path_name)
  1019.  
  1020.     /* if path_name is a filepath then it_exists */
  1021.     if stream(path_name, 'C', 'QUERY EXISTS') \= '' then
  1022.      it_exists = path_name
  1023.     /* else if path_name is a directory then it_exists */
  1024.     else
  1025.     do
  1026.     cw_dir = directory()     /* push current working directory */
  1027.     dir_flag = directory(path_name)
  1028.  
  1029.     if dir_flag \= -1 & dir_flag \= 'X' & dir_flag \= '' then
  1030.      it_exists = path_name
  1031.    /* else path_name does not exist */
  1032.     else
  1033.      it_exists = ''
  1034.  
  1035.     call directory cw_dir   /* pop current working directory */
  1036.     end /* else */
  1037.  
  1038. return it_exists
  1039. /* Procedure PATHNAME_EXISTS end */
  1040.  
  1041. /* Procedure INCREMENT_TITLE start */
  1042. INCREMENT_TITLE:  procedure
  1043. parse arg type, title, setup
  1044.     /* handle error created by pre-existing object with title clash */
  1045.     suffix = c2x('1')
  1046.     do forever
  1047.      new_title = title || ':' || x2c(suffix)
  1048.      call SysCreateObject type, new_title, '<WP_DESKTOP>', setup, 'f'
  1049.      if result \= 0 then
  1050.          leave
  1051.      else
  1052.          suffix = suffix + 1
  1053.    end      /* do */
  1054. return title
  1055. /* Procedure INCREMENT_TITLE end */
  1056.  
  1057. /*******************************************************************/
  1058. /*  HISTORY */
  1059. /*******************************************************************/
  1060.  
  1061. /* Version History */
  1062.  
  1063. /* 1.00:  original version */
  1064. /* 1.01:  Added ability to search INF files for titles--06/01/1999 */
  1065. /* 1.02:  Added ability to search HTML files for titles--06/02/1999 */
  1066. /* 1.03:  Added improved error checking--06/05/1999 */
  1067. /* 1.04:  Added wildcard support; fixed HTML title bug; added support */
  1068. /*     for titles with *.HLP files--06/27/1999 */
  1069. /* 1.05:  Added support the EA .TYPE in addition to extensions for */
  1070. /*     standard extensions--06/27/1999 */
  1071.