home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / ADJUNCTS.ICN next >
Text File  |  1991-09-05  |  1KB  |  76 lines
  1. ############################################################################
  2. #
  3. #    Name:     adjuncts.icn
  4. #
  5. #    Title:     adjuncts (adjunct utilities for gettext and idxtext)
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Version: 1.2
  10. #
  11. #    Date:     June 1, 1991
  12. #
  13. ############################################################################
  14. #  
  15. #  Pretty mundane stuff.  Basename(), Pathname(), Strip(), and a utility
  16. #  for creating index filenames.
  17. #
  18. ############################################################################
  19. #
  20. #  See also: gettext.icn, idxtext,icn
  21. #
  22. ############################################################################
  23.  
  24. global _slash, _baselen
  25.  
  26. procedure Basename(s)
  27.  
  28.     # global _slash
  29.     s ? {
  30.     while tab(find(_slash)+1)
  31.     return tab(0)
  32.     }
  33.  
  34. end
  35.  
  36.  
  37. procedure Pathname(s)
  38.  
  39.     # global _slash
  40.     s2 := ""
  41.     s ? {
  42.     while s2 ||:= tab(find(_slash)+1)
  43.     return s2
  44.     }
  45.  
  46. end
  47.  
  48.  
  49. procedure getidxname(FNAME)
  50.  
  51.     #
  52.     # Discard path component.  Cut basename down to a small enough
  53.     # size that the OS will be able to handle addition of the ex-
  54.     # tension ".IDX"
  55.     #
  56.  
  57.     # global _slash, _baselen
  58.     return right(Strip(Basename(FNAME,_slash),'.'), _baselen, "x") || ".IDX"
  59.  
  60. end
  61.  
  62.  
  63. procedure Strip(s,c)
  64.  
  65.     local s2
  66.  
  67.     s2 := ""
  68.     s ? {
  69.     while s2 ||:= tab(upto(c))
  70.     do tab(many(c))
  71.     s2 ||:= tab(0)
  72.     }
  73.     return s2
  74.  
  75. end
  76.