home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3001 / adjuncts.icn < prev    next >
Text File  |  1991-03-06  |  1KB  |  75 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.1
  10. #
  11. ############################################################################
  12. #  
  13. #  Pretty mundane stuff.  Basename(), Pathname(), Strip(), and a utility
  14. #  for creating index filenames.
  15. #
  16. ############################################################################
  17. #
  18. #  Links: none
  19. #
  20. #  See also: gettext.icn, idxtext,icn
  21. #
  22. ############################################################################
  23.  
  24.  
  25. procedure Basename(s)
  26.  
  27.     # global _slash
  28.     s ? {
  29.     while tab(find(_slash)+1)
  30.     return tab(0)
  31.     }
  32.  
  33. end
  34.  
  35.  
  36. procedure Pathname(s)
  37.  
  38.     # global _slash
  39.     s2 := ""
  40.     s ? {
  41.     while s2 ||:= tab(find(_slash)+1)
  42.     return s2
  43.     }
  44.  
  45. end
  46.  
  47.  
  48. procedure getidxname(FNAME)
  49.  
  50.     #
  51.     # Discard path component.  Cut basename down to a small enough
  52.     # size that the OS will be able to handle addition of the ex-
  53.     # tension ".IDX"
  54.     #
  55.  
  56.     # global _slash, _baselen
  57.     return right(Strip(Basename(FNAME,_slash),'.'), _baselen, "x") || ".IDX"
  58.  
  59. end
  60.  
  61.  
  62. procedure Strip(s,c)
  63.  
  64.     local s2
  65.  
  66.     s2 := ""
  67.     s ? {
  68.     while s2 ||:= tab(upto(c))
  69.     do tab(many(c))
  70.     s2 ||:= tab(0)
  71.     }
  72.     return s2
  73.  
  74. end
  75.