home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / snobol4 / vsnobol4.arc / GENTRAN.SNO < prev    next >
Text File  |  1987-12-04  |  9KB  |  326 lines
  1. * GENTRAN.SNO        see GENTRAN.DOC for instructions
  2. *
  3. * Generic text translation utility for SNOBOL4.
  4. * Primarily intended for reformatting ASCII files for input to
  5. * text formatting or composition software systems.
  6. *
  7. * This is the rudimentary prototype of MASSAGE, a complete character trans-
  8. * lation utility which also features conditional logic, full I/O control,
  9. * translation sub-tables, and other capabilities.  Contact the author
  10. * for additional information.
  11. *
  12. * While this particular hunk of code is neither elegant nor particularly
  13. * efficient, it showcases the versatility of the SNOBOL4 language and
  14. * demonstrates the relative ease with which it is possible to develop
  15. * useful software in a short time frame.  It took under two hours to
  16. * write and debug (as it is, anyway).
  17. *
  18. * Copyright 1987 by Kevin G. Barkes Consulting Services
  19. * 4107 Overlook Street
  20. * Library, PA 15129
  21. * SYS$OUTPUT BBS (Fido 129/38) 412-854-0511
  22. *
  23. * Only non-commercial distribution of this software is permitted.
  24. * All other rights reserved.
  25. *
  26. * This software is provided "as-is", without either expressed or implied
  27. * warranties.
  28. *
  29. * EVAL of expressions moved outside of file copy loop.--Catspaw, Inc. 4/15/87
  30. * Minor cleanup for release with Vanilla SNOBOL4 -- Catspaw, Inc. 8/15/87
  31. *
  32. * Distributed with Vanilla SNOBOL4 by permission of the author.
  33. *
  34.  
  35.     
  36. *    QUOTE function to adjust double quote marks to some combination
  37. *    of opening and closing single quote mark according to
  38. *    typographic conventions.  Transformations:
  39. *
  40. *    Left Margin "    --> ``
  41. *    Right Margin "    --> ''
  42. *        ""    --> ' ''
  43. *        '"    --> ' ''
  44. *        "'    --> `` `
  45. *        Blank "    --> Blank ``
  46. *        " Blank --> '' Blank
  47. *        ("    --> (``
  48. *        "(    --> ``(
  49. *        ```    --> `` `
  50. *        '''    --> ' ''
  51. *        "    --> ''
  52. *
  53. *    QUOTE conversion is defaulted OFF.
  54.  
  55.     DEFINE('QUOTE()')
  56.     Q_PAT1    = POS(0) '"'
  57.     Q_PAT2    = RTAB(1) . QTEMP '"'
  58.     Q_PAT3    = "'" '"'
  59.     Q_PAT4    = '"' "'"                :(QUOTE_END)
  60. *
  61. *    No point proceeding unless " appears somewhere in the record.
  62. QUOTE    RECORD '"'                    :F(RETURN)
  63. *
  64.     RECORD Q_PAT1 = '``'
  65.     RECORD Q_PAT2 = QTEMP "''"
  66. *
  67. QT1    RECORD '""' = "' ''"                :S(QT1)
  68. QT2    RECORD Q_PAT3 = "' ''"                :S(QT2)
  69. QT3    RECORD Q_PAT4 = "`` `"                :S(QT3)
  70. QT4    RECORD ' "' = ' ``'                :S(QT4)
  71. QT5    RECORD '" ' = "'' "                :S(QT5)
  72. QT6    RECORD '("' = '(``'                :S(QT6)
  73. QT7    RECORD '"(' = '``('                :S(QT7)
  74. QT8    RECORD "```" = "`` `"                :S(QT8)
  75. QT9    RECORD "'''" = "' ''"                :S(QT9)
  76. QT10    RECORD '"' = "''"                :S(QT10)F(RETURN)
  77. QUOTE_END
  78.  
  79.  
  80. ******* MAIN PROGRAM *********
  81. *
  82.     VERSION    = "V. 0.2"
  83.  
  84.     &TRIM    = 1
  85.     REC_LEN    = 80
  86.  
  87.     SEARCH    = ARRAY(100)
  88.     REPLACE    = ARRAY(100)
  89.  
  90.     DIRECTIVES = TABLE()
  91.     DIRECTIVES['TRIM']    = "Y"
  92.     DIRECTIVES['LTRIM']    = "N"
  93.     DIRECTIVES['ATRIM']    = "N"
  94.     DIRECTIVES['COMPRESS']    = "N"
  95.     DIRECTIVES['COLLAPSE']    = "N"
  96.     DIRECTIVES['TRACE']    = "N"
  97.     DIRECTIVES['QUOTE']    = "N"
  98.  
  99.     POSSIBLES = "%TRIM%LTRIM%ATRIM%TRACE%QUOTE%COMPRESS%COLLAPSE"
  100.  
  101.     DELIMITER = '\'
  102.     BELL    = CHAR(7)
  103.  
  104.     INCOUNT    = 0
  105.     ERRORS    = 0
  106. *
  107. *
  108.     INPUT(.USERIN,15,,"CON:")
  109.     SCREEN    = "Generic Translator, " VERSION
  110.     SCREEN    = "For use with Vanilla SNOBOL4"
  111.     SCREEN    = ""
  112.  
  113. *
  114. *    Get name of translation file.
  115. *
  116. OPEN_TFILE
  117.     SCREEN    = "Name of Translation Table input file[.TTI]"
  118. +          " (<CR> = terminal): " CHAR(26)
  119.     TTI    = REPLACE(USERIN,&LCASE,&UCASE)
  120. *
  121. *    Use console if file omitted.  Default .TTI suffix if needed.
  122. *
  123.     TTI = IDENT(TTI,"") "CON:"            :S(DO_TFILE_OPEN)
  124.     TTI "."                        :S(DO_TFILE_OPEN)
  125.     TTI = TTI ".TTI"
  126.  
  127. DO_TFILE_OPEN
  128.     INPUT(.TFILE,16,,TTI)                :S(READ_TT_FILE)
  129.     SCREEN    = BELL
  130.     SCREEN    = "Cannot open " TTI "; try again..."
  131.     SCREEN    = ""                    :(OPEN_TFILE)
  132. *
  133. *    Read translation file
  134. *
  135. READ_TT_FILE
  136.     SCREEN    = "Reading file: " TTI
  137.     IDENT(TTI,"CON:")                :F(PARSE_FILE)
  138.     SCREEN    = "Enter Control-Z when finished."
  139. *
  140. PARSE_FILE
  141.     PARSE    = TFILE                    :F(PARSE_END)
  142.     PARSE POS(0) SPAN(" ") = ""
  143.     IDENT(PARSE,"")                    :S(PARSE_FILE)
  144.     SCREEN    = "TTI line: " PARSE
  145. *
  146. *    Check for comment or directive
  147. *
  148.     PARSE POS(0) "!"                :S(PARSE_FILE)
  149.     PARSE POS(0) "%"                :F(PARSE_REPLACE)
  150. *
  151. *    Process directive.  Convert to upper case and see if legal
  152. *
  153.     PARSE    = REPLACE(PARSE,&LCASE,&UCASE)
  154.     POSSIBLES PARSE                    :S(PF1)
  155.     SCREEN    = BELL
  156.     SCREEN    = "Error - Invalid Directive: " PARSE
  157. CNT_ERR    ERRORS    = ERRORS + 1
  158.     SCREEN    = "Press <ENTER> to continue..."
  159.     SCRATCH    = USERIN                :(PARSE_FILE)
  160. *
  161. *    Remove leading "%" and set directive true in table.
  162. *
  163. PF1    PARSE LEN(1) REM . PARSE
  164.     DIRECTIVES[PARSE] = "Y"                :(PARSE_FILE)
  165. *
  166. *    If not comment or directive, must be search and replace string.
  167. *    Count it and isolate search string.
  168. *
  169. PARSE_REPLACE
  170.     INCOUNT    = INCOUNT + 1
  171.     PARSE DELIMITER BREAK(DELIMITER) . SSTR        :S(PR_CONT)
  172. PR_2    SCREEN    = BELL
  173.     SCREEN    = "Error parsing translation line: " PARSE
  174.     SCREEN    = "Required delimiter pair (" DELIMITER ") not found."
  175.     INCOUNT    = INCOUNT - 1                :(CNT_ERR)
  176. *
  177. *    Compile the search string.  This will much more efficient
  178. *    during the search and replace phase if it is a true pattern.
  179. *
  180. PR_CONT
  181.     IDENT(SSTR,"")                    :S(PR_1)
  182.     SEARCH[INCOUNT] = EVAL(SSTR)            :S(PR_CONT_1)
  183.     SCREEN    = BELL
  184.     SCREEN    = "Search string contains SNOBOL4 syntax error: " SSTR
  185.     INCOUNT    = INCOUNT - 1                :(CNT_ERR)
  186. *
  187. *    Now find the replacement string
  188. *
  189. PR_CONT_1
  190.     PARSE (DELIMITER SSTR DELIMITER)
  191. +         ARB DELIMITER BREAK(DELIMITER) . RSTR    :F(PR_2)
  192. *
  193. *    Error if search and replace strings are the same
  194. *
  195.     IDENT(SSTR,RSTR)                :F(PR_CONT_2)
  196.     SCREEN    = BELL
  197.     SCREEN    = "Search and replace strings cannot be identical: " SSTR
  198.     INCOUNT    = INCOUNT - 1                :(CNT_ERR)
  199. *
  200. *    Compile the replacement string.  This will usually result in
  201. *    a pure string (for simple replacements).  It will result in
  202. *    an EXPRESSION if the replacement uses *(expression), where
  203. *    "expression" may use variables that are set during the
  204. *    string search.
  205. *
  206. PR_CONT_2
  207.     REPLACE[INCOUNT] = EVAL(RSTR)            :S(PARSE_FILE)
  208.     SCREEN    = BELL
  209.     SCREEN    = "Replace string contains SNOBOL4 syntax error: " RSTR
  210.     INCOUNT    = INCOUNT - 1                :(CNT_ERR)
  211. *
  212. *    Error message for null search string.
  213. *
  214. PR_1
  215.     SCREEN    = BELL
  216.     SCREEN    = "No search string found in " PARSE
  217.     INCOUNT    = INCOUNT - 1                :(CNT_ERR)
  218. *
  219. *    Here at end of TTI file.  Check for errors.
  220. *
  221. PARSE_END
  222.     EQ(ERRORS,0)                    :S(DO_STARTUP)
  223.     SCREEN    = BELL
  224.     SCREEN    = "Errors in translation file: " ERRORS
  225.     SCREEN    = "Correct or remove erroneous lines and rerun."
  226.     SCREEN    = ""                    :(END)
  227.  
  228. ******* Start of file translation *******
  229. *
  230. DO_STARTUP
  231. *
  232. *    COLLAPSE implies ATRIM and COMPRESS.
  233. *
  234.     DIRECTIVES['ATRIM']    = IDENT(DIRECTIVES['COLLAPSE'],'Y') 'Y'
  235.     DIRECTIVES['COMPRESS'] = IDENT(DIRECTIVES['COLLAPSE'],'Y') 'Y'
  236. *
  237. *    ATRIM implies LTRIM and TRIM.
  238. *
  239.     DIRECTIVES['LTRIM']    = IDENT(DIRECTIVES['ATRIM'],'Y') 'Y'
  240.     DIRECTIVES['TRIM']     = IDENT(DIRECTIVES['ATRIM'],'Y') 'Y'
  241.  
  242.     &TRIM = IDENT(DIRECTIVES['TRIM'],"N") 0
  243.  
  244.     LTRIM_PAT = ""
  245.     LTRIM_PAT = IDENT(DIRECTIVES['LTRIM'],"Y")
  246. +            POS(0) SPAN(" " CHAR(9)) REM . RECORD
  247.  
  248.     COMPRESS_PAT = &ABORT
  249.     COMPRESS_PAT = IDENT(DIRECTIVES['COMPRESS'],"Y")
  250. +            ANY(" " CHAR(9)) SPAN(" " CHAR(9))
  251. *
  252. *    Get I/O file names and open files
  253. *
  254. OPEN_INFILE
  255.     SCREEN    = ""
  256.     SCREEN    = "Name of file to be translated: " CHAR(26)
  257.     INFILE    = REPLACE(TRIM(USERIN),&LCASE,&UCASE)
  258.     IDENT(INFILE,"")                :S(OPEN_INFILE)
  259.     INPUT(.FILEIN,,REC_LEN,INFILE)            :S(OPEN_OUTFILE)
  260.     SCREEN    = BELL
  261.     SCREEN    = "Cannot open " INFILE "; try again..."
  262.     SCREEN    = ""                    :(OPEN_INFILE)
  263. *
  264. OPEN_OUTFILE
  265.     SCREEN    = ""
  266.     SCREEN    = "Name of output file: " CHAR(26)
  267.     OUTFILE    = REPLACE(TRIM(USERIN),&LCASE,&UCASE)
  268.     IDENT(OUTFILE,"")                :S(OPEN_OUTFILE)
  269.     OUTPUT(.FILEOUT,,REC_LEN,OUTFILE)        :S(INIT_TCOUNT)
  270.     SCREEN    = BELL
  271.     SCREEN    = "Cannot open " OUTFILE "; try again..."
  272.     SCREEN    = ""                    :(OPEN_OUTFILE)
  273. *
  274. ******* MAIN LOOP FOR EACH RECORD *******
  275. *
  276. *    TCOUNT steps through the search and replace records.
  277. *
  278. INIT_TCOUNT
  279.     TCOUNT    = 0
  280. *
  281. *    Read record, trimming trailing blanks if necessary via &TRIM
  282. *
  283.     RECORD    = FILEIN                :F(DONE)
  284. *
  285. *    Perform leading trimming (or no-operation)
  286. *
  287.     RECORD LTRIM_PAT
  288. *
  289. *    Perform space and tab compression (or no-operation)
  290. *
  291. DT_B1    RECORD COMPRESS_PAT = " "            :S(DT_B1)
  292. *
  293. *    Perform quote conversion if requested
  294. *
  295.     IDENT(DIRECTIVES['QUOTE'],"Y") QUOTE()
  296. *
  297. *    Perform search and replace
  298. *
  299. DT_X    TCOUNT    = TCOUNT + 1
  300.     GT(TCOUNT,INCOUNT)                 :S(RECORD_DONE)
  301. *
  302. *    Get next search/replace pair.
  303. *    If replacement is an expression, handle separately.
  304. *
  305.     PATTERN    = SEARCH[TCOUNT]
  306.     REPL    = REPLACE[TCOUNT]
  307.     IDENT(DATATYPE(REPL),"EXPRESSION")        :S(DO_EXP)
  308.  
  309. LOOPER    RECORD PATTERN = REPL                :S(LOOPER)F(DT_X)
  310. *
  311. DO_EXP    RECORD PATTERN = EVAL(REPL)            :S(DO_EXP)F(DT_X)
  312. *
  313. *    Here when all search/replaces have been applied to the record.
  314. *
  315. RECORD_DONE
  316.     FILEOUT    = RECORD
  317.     SCREEN    = IDENT(DIRECTIVES['TRACE'],"Y") RECORD    :(INIT_TCOUNT)
  318. *
  319. *    Fini
  320. *
  321. DONE
  322.     SCREEN    = ""
  323.     SCREEN    = BELL
  324.     SCREEN    = "Translation completed."
  325. END
  326.