OpenVMS Source-Code Demos
TOOL_WEBIFY_SOURCE_CODE
1000 %title "tool_webify_source_code_xxx" !
%ident "version_105.1" !
declare string constant k_version = "105.1" , ! &
k_program = "tool_webify_source_code" !
!==============================================================================================================
! title : tool_webify_source_code
! author : Neil Rieck (http://www3.sympatico.ca/n.rieck/)
! notes : this program has no commercial value and has been put into public domain for educational use only
! history:
! ver who when what
! --- --- ------ ----------------------------------------------------------------------------------------------
! 100 NSR 110415 1. started original effort
! NSR 110416 2. much more work
! 101 NSR 110417 1. removed the path from fs2$ (which is now only a filename)
! NSR 110422 2. added an option to remove source code version numbers from the filename
! NSR 110423 3. added a tweak (drop trailing whitespace) bf_101.3
! 102 NSR 110820 1. improved default logic
! 2. added code to allow the use of simpler methods (like CDATA)
! (which did not work si I just disabled for now :-) bf_102.2
! 103 NSR 110820 1. replaced lib$spawn (temporary file stuff) with call to lib$find_file
! 104 NSR 120727 1. added email synonym "neil"
! NSR 120825 2. now optionaly also delete the created document
! 3. replaced BASIC "kill" statements with calls to lib$spawn
! NSR 120910 4. now ask before removing suplerfluous file prefixes bf_104.4
! 5. now "remove source code number?" defaults to "Y" bf_104.5
! 105 NSR 120910 1. now ask client for output file format bf_105.1
!==============================================================================================================
option type=explicit ! no kid stuff
set no prompt !
%let %neil=1% ! %neil=0 :general use
! %neil=1 :enable stuff for neil's app
! %neil=2 :neil's app requires ODS-5
!
%include "lib$routines" %from %library "sys$library:basic$starlet" ! for lib$spawn
%include "$rmsdef" %from %library "sys$library:basic$starlet" ! rms$
!
declare string fs0$ , ! file spec0 (search) &
fs1$ , ! file spec1 (read) &
fs1_short$ , ! file spec1 short &
fs2$ , ! file spec2 (write) &
ext$ , ! &
junk$ , ! &
cmd$ , ! DCL command &
choice$ , ! &
ip$ , ! &
op$ , ! &
processing_mode$ , ! &
email_dst$ , ! &
general_custom_default$ , ! &
custom_page$ , ! &
long remove_scvn% , ! &
i% , ! &
j% , ! &
semicolon_pos% , ! semicolon position &
rbracket_pos% , ! right bracket position &
colon_pos% , ! colon position &
sentinel_pos% , ! sentinel position &
dot_pos% , ! dot position &
us_pos% , ! underscore position &
debug% , ! &
junk% , ! &
custom% , ! &
temp% , ! &
open_mode% , ! &
rc% , ! &
count% , ! &
choice% , ! &
source_line% , ! &
dest_line% , ! &
mode% , ! &
stage% !
!
declare string constant exclam = '33'C ! exclamation
declare string constant ctag1$ = "<" + exclam + "[" + "CDATA" + "[" ! do it this way for web display of this code
declare string constant ctag2$ = "]" + "]" + ">" ! do it this way for web display of this code
!
!====================================================================================================
! <<< main >>>
!====================================================================================================
2000 main:
junk$ = k_program + "_" + k_version !
print string$( len(junk$), ascii("=") ) ! print a line
print junk$ ! print program title
print string$( len(junk$), ascii("=") ) ! print a line
!
get_fs: !
print "============================================================"
print " Question 1/10"
print "============================================================"
print "input filespec to search:" !
print "examples: yada*.bas" !
print " yada*.inc" !
print " yada*.fun" !
print " yada*.c" !
print " yada*.cxx" !
print " exact-name.ext" !
print " or Q/uit" !
input "full/partial file spec? (filespec,Q,default=*.bas) ";fs0$ !
junk% = 0 ! init our test
junk% = 1 if pos(edit$(fs0$,32),".HTM",1)>0 ! .HTM or. HTML ?
junk% = 1 if pos(edit$(fs0$,32),".XML",1)>0 ! .XML ?
if junk% = 1 > 0 then !
print "-e-error: you may not enter extensions of: .htm or .html or .xml"
goto get_fs !
end if !
fs0$ = edit$(fs0$,4+2) ! remove controls + white space
select edit$(fs0$,32) ! upcase for test
case "Q","E","X" !
goto sortie !
case "" !
fs0$ = "*.bas" !
end select !
if pos(fs0$,"/",0)>0 then !
print "-e-oops: your entry doesn't make sense" !
goto get_fs !
end if !
if (pos(fs0$,".",0) = 0) then !
print "-e-oops, you must enter a dot" !
goto get_fs !
end if !
if (len(fs0$) < 2) then !
print "-e-oops, a filespec must contain at least two characters" !
goto get_fs !
end if !
if (pos(fs0$,";",0) = 0) then ! if a specific version isn't desired
fs0$ = fs0$ +";" ! then only show the most recent version
end if !
print "============================================================"
print " Question 2/10"
print "============================================================"
if (pos(fs0$,"]",0) = 0) and (pos(fs0$,"[",0) = 0) ! if no directoy specs &
then !
search_menu_loop: !
print "search menu: " !
print " 1) only search the current directory" !
print " 2) only search subdirectories" !
print " 3) search current and subdirectories" !
print " Q) quit" !
input "choice? (1-3,default=1) ";choice$ !
choice$ = left$( edit$(choice$,4+2), 1) !
select choice$ !
case "1","" !
case "2" !
fs0$ = "[...]"+fs0$ !
case "3" !
fs0$ = fs0$ +",[...]"+ fs0$ !
case "Q","X","E" !
goto sortie !
case else !
print "-e-oops, bad choice" !
goto search_menu_loop !
end select !
end if !
!
print "-i-target fs: "+ fs0$ !
!
declare long constant k_max_file_names = 500 !
declare long file_context% !
declare long file_name_pointer% !
file_name_pointer% = 0 !
dim string file_names$(k_max_file_names) ! init
!
file_context% = 0 ! init (for good form)
read_loop1: !
rc% = lib$find_file(fs0$, junk$, file_context%) ! does the folder/file exist?
select rc% !
case RMS$_NORMAL ! found something
if file_name_pointer% < k_max_file_names then !
file_name_pointer% = file_name_pointer% + 1 !
file_names$(file_name_pointer%)=junk$ !
goto read_loop1 ! yeah, I know, bad form
end if !
case RMS$_NMF ! no more files
case RMS$_FNF ! file-not-found
print "-e- oops, file not found" !
case RMS$_DNF ! directory-not-found
print "-e- oops, directory not found" !
case else ! oops
print "-e- lib$find_file error: "+ str$(rc%) !
end select !
!
if file_name_pointer% = 0 then !
print "-e-no files were detected using your search criteria" !
goto get_fs ! ***--->>>
end if !
!
print "============================================================"
print " Question 3/10"
print "============================================================"
when error in !
count% = 1 !
print "Directory:" !
print "#### File name________________________________________" !
while count% <= file_name_pointer% !
print format$(count%,"#### ") + file_names$(count%) !
count% = count% + 1 !
next !
use !
end when !
!
! now let the user choose a file number
!
choice_loop: !
print "Note: your original file will not be modified" !
print "Webify which file? (1-"+ str$(file_name_pointer%) +", 0=none) "; !
input choice$ ! get his choice (number)
when error in !
choice% = integer(choice$) !
use !
choice% = -1 !
end when !
select choice% !
case 0 !
goto sortie ! ***--->>>
case -1, > file_name_pointer% !
print "-e-bad input" !
goto choice_loop !
end select !
fs1$ = file_names$(choice%) ! this is the filespec he wants
!
! now get a few options before processing this file
!
found_it: !
print "============================================================"
print " Question 4/10"
print "============================================================"
print "menu:" !
print " 1) minimal cleanup jammed between <pre> and </pre>" !
print " 2) full cleanup (builds a full web page)" !
print " Q) quit" !
input "choice? (default=2) ";junk$ !
junk$ = edit$(junk$,32+4+2) !
select left$(junk$,1) !
case "" !
processing_mode$ = "2" !
case "1","2" !
processing_mode$ = left$(junk$,1) !
case "Q","E","X" !
goto sortie !
case else !
print "-e-oops, bad choice..." !
goto found_it !
end select !
!
get_mode: !
print "============================================================"
print " Question 5/10"
print "============================================================"
%let %cdata=0% !
%if %cdata=0% %then !
print "-i-question 5 (CDATA) is bypassed for now" !
mode% = 2 ! HTML entities
%else !
print "mode:" !
print " 1) use CDATA method with minimal processing" !
print " 2) translate special characters into HTML Entities" !
print " Q) quit" !
input "choice? (default=1) ";junk$ !
junk$ = left$(edit$(junk$,32+4+2),1) !
select junk$ !
case "" !
mode% = 1 !
case "1","2" !
mode% = integer(junk$) !
case "Q","E","X" !
goto sortie !
case else !
print "-e-oops, bad choice..." !
goto get_mode !
end select !
%end %if !
!
email_prompt: !
print "============================================================"
print " Question 6/10"
print "============================================================"
input "-?-email address? (default=none) ";email_dst$ !
email_dst$ = edit$(email_dst$,4+2) ! no white-space
select edit$(email_dst$,32) ! upcase for tests
case "" !
email_dst$ = "" !
case "XXX" ! change to your own initials
email_dst$ = "neil@home.com" ! change to your own email address
case "NSR" ! my initials
email_dst$ = "n.rieck@sympatico.ca" ! my email address (res)
custom_page$ = "1" ! see next prompt
case "NEIL","BELL" !
email_dst$ = "neil.rieck@bell.ca" ! my email address (biz)
custom_page$ = "G" ! see next prompt
case else !
print "-e-oops, bad email option" !
goto email_prompt !
end select !
!
if email_dst$ <> "" then !
sentinel_pos% = pos(email_dst$,"@",0) !
dot_pos% = pos(email_dst$,"@",sentinel_pos%) !
if sentinel_pos% <= 3 or ! need space for 3 characters (eg. xyz@yada) &
dot_pos% > len(email_dst$) -2 ! need space for 2 characters (eg. yada.ca)
then !
print "-e-oops, bad email format" !
goto email_prompt !
end if !
print "-i-email destination: "+ email_dst$ !
sleep 1 !
end if !
print "============================================================"
print " Question 7/10"
print "============================================================"
print "General / Custom HTML:" !
print " G/eneral : STYLES in HEAD" !
print " 1 = Custom-1: STYLES imported via LINK in HEAD (for NSR)" !
print " 2 = Custom-2: STYLES imported via LINK in HEAD" !
print " 3 = Custom-3: STYLES imported via LINK in HEAD" !
if custom_page$ = "" then !
general_custom_default$ = "G" ! G/eneral
else !
general_custom_default$ = custom_page$ ! custom
end if !
print "General-page or Custom-page? (G,1-3,default="+ general_custom_default$ +") ";
input junk$ !
junk$ = edit$(junk$,32+4+2) !
select junk$ !
case "" ! he's going with the default
when error in !
custom% = integer(junk$) !
use !
custom% = 0 !
end when !
case "1" ! reserved for NSR
custom% = 1 !
case "2" ! add your own initials here
custom% = 2 !
case "3" ! add your own initials here
custom% = 3 !
case else !
custom% = 0 !
end select !
!
print "============================================================"
print " Question 8/10"
print "============================================================"
print "Note: For file names of the format: program64_123.bas," !
print "'_123' is the source code version number" !
print !
input "Remove source code version number? (y/n, default=Y) ";junk$ ! bf_104.5
select left$(edit$(junk$,32+2),1) !
case "Y","" ! bf_104.5
remove_scvn% = 1 !
case else !
remove_scvn% = 0 !
end select !
!
! now isolate the filename for various purposes
! note: vms filenames contain a version number (eg. name.ext;123 where 123 is the version number)
!
rbracket_pos% = pos(fs1$,"]",1) ! this might not exist
colon_pos% = pos(fs1$,":",1) ! this might not exist
junk% = max(rbracket_pos%,colon_pos%) !
fs1_short$ = right$(fs1$, junk%+1) !
semicolon_pos% = pos(fs1_short$,";",1) ! this should exist
fs1_short$ = left$(fs1_short$,semicolon_pos%-1) if semicolon_pos% <> 0 !
!
! Our shop does not have a source code repository so we manage code the old fashioned way:
! by appending an underscore and version number to the filename.
! (eg. program64_123.bas where 123 is our source code version number)
!
goto rscvn_exit if remove_scvn% = 0 !
remove_src_code_version_number: !
for i% = len(fs1_short$) to 1 step -1 !
if mid$(fs1_short$,i%,1) = "." then ! dot?
dot_pos% = i% ! Spock says remember
goto rscvn2 !
end if !
next i% !
goto rscvn_exit ! oops
!
rscvn2: ! remove_source_code_version_number - step 2
for i% = dot_pos% to 1 step -1 !
if mid$(fs1_short$,i%,1) = "_" then ! underscore?
us_pos% = i% ! Spock says remember this
goto rscvn3 !
end if !
next i% !
goto rscvn_exit ! oops
!
rscvn3: ! remove_source_code_version_number - step 3
when error in !
junk$ = seg$(fs1_short$, us_pos%+1, dot_pos%-1) !
junk% = integer(junk$) !
use !
junk% = 0 !
end when !
if junk% > 0 then !
!
! entry: fs1_short$ program64_123.bas
! exit : program64.bas
!
fs1_short$ = left$(fs1_short$,us_pos%-1) + right$(fs1_short$,dot_pos%)
end if !
rscvn_exit: !
!
! my previously published public-domain demos contained prefixes which I (may) want to remove here
! entry: fs1_short$ BASIC_program_name.bas
! exit: program_name.bas
!
%if %neil>0% %then !
junk% = 0 ! init
junk$ = edit$(fs1_short$, 32) ! prep for test
junk% = 2 if pos(junk$,"C-" ,1) = 1 !
junk% = 2 if pos(junk$,"C_" ,1) = 1 !
junk% = 4 if pos(junk$,"BAS-" ,1) = 1 !
junk% = 4 if pos(junk$,"BAS_" ,1) = 1 !
junk% = 6 if pos(junk$,"BASIC-" ,1) = 1 !
junk% = 6 if pos(junk$,"BASIC_" ,1) = 1 !
junk% = 4 if pos(junk$,"COM-" ,1) = 1 !
junk% = 4 if pos(junk$,"COM_" ,1) = 1 !
if junk% > 0 then !
print "============================================================"
print " Question 9/10"
print "============================================================"
question9:
print "Remove superfluous file-name prefix? (y/n,default=N) "; ! bf_104.4
input junk$ ! bf_104.4
select left$(edit$(junk$,32+2),1) ! bf_104.4
case "Y" !
fs1_short$ = right$(fs1_short$,junk%+1) !
case "N",""
case else
print "-e-Oops! Bad choice."
goto question9
end select !
end if !
%end %if
!
!========================================================================================================================
! now process the selected file
!========================================================================================================================
3000 process: !
close #1 !
!
! entry: fs1_short$ = program-name.bas (will be used in <title> etc.)
! exit: fs2$ = program-name.html or
! = bas_program-name.html or
! = program-name_bas.html or
! = program-name.bas.html or (requires 'ODS-5 formatted' VMS volume)
!
junk% = pos(fs1_short$,".",1) ! find a dot (should always be one)
if junk% > 0 then ! if "a" dot was found...
find_next_dot: !
temp% = pos(fs1_short$,".",junk%+1) ! any more dots?
if temp% > 0 then ! if yes...
junk% = temp% !
goto find_next_dot ! loop until we find the last one
end if !
!
ext$ = right$(fs1_short$, junk%+1) ! isolate extension
fs1_short$ = left$(fs1_short$, junk%-1) ! drop the trailing dot
end if !
!
if ext$ = "" then ! no extension
fs2$ = fs1_short$ +".html" ! ...so just tack on an extension
else
get_file_format: !
print "============================================================"
print " Question 10/10"
print "============================================================"
print "desired output file format:" !
print " 1. program-name.html" !
print " 2. ext_program-name.html (<<< default)" !
print " 3. program-name_ext.html" !
print " 4. program-name.ext.html (requires ODS-5 volume)" !
input "Output File Format? (1-4, default=2) ";junk$ !
!
select left$(edit$(junk$,4+2),1) !
case "1" !
!
! produces: program-name.html
!
fs2$ = fs1_short$ +".html" !
case "2","" ! <--- default
!
! produces: ext_program-name.html
!
fs2$ = ext$ +"_"+ fs1_short$ +".html" !
case "3"
!
! produces: program-name_ext.html
!
fs2$ = fs1_short$ +"_"+ ext$ +".html" !
case "4"
!
! produces: program-name.ext.html
!
fs2$ = fs1_short$ +".html" !
case else !
print "-e-Oops, bad choice" !
goto get_file_format !
end select !
end if !
!
print "======================================================================"
print " starting webification"
print "======================================================================"
when error in !
print "-i-open input : ";fs1$ !
open fs1$ for input as #1 ! open the source file &
,recordsize 32700 !
!
print "-i-open output: ";fs2$ !
open fs2$ for output as #2 ! &
,recordsize 32700 !
!
if processing_mode$ = "2" then !
print #2, '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">'
print #2, '<html>' !
print #2, '<head>' !
print #2, '<title>'+ fs1_short$ + '</title>' !
select custom% !
case 1 ! Neil's custom style
print #2, '<link href="../css/nsr-20100801.css" rel="stylesheet" type="text/css">'
case else ! General style
print #2, '<style type="text/css">' !
print #2, ' body { font-family: Verdana, Helvetica, Arial, sans-serif; font-size: 10pt; '+ &
'background-color: #fff; min-width: 850px }'
print #2, ' pre { font-family: "Courier New", monospace}'
print #2, ' a { text-decoration: none; color: blue }'
print #2, ' a:link { text-decoration: none; color: blue }'
print #2, ' a:visited { text-decoration: none; color: blue }'
print #2, ' a:hover { text-decoration: none; color: blue; background-color: #ffb; cursor: pointer }'
print #2, ' a:active { text-decoration: none; color: blue }'
print #2, ' h1 { color: red }'
print #2, ' h2 { color: white; padding: 4px; background-color: green }'
print #2, ' h3 { color: white; padding: 4px; background-color: #369; width: 98% }'
print #2, '</style>'
end select !
print #2, '</head>' !
print #2, '<body>' !
print #2, '<h1>OpenVMS Source-Code Demos</h1>' !
print #2, '<h2>'+ fs1_short$ +'</h2>' !
end if !
print #2, '<pre style="font-weight:700">' !
print #2, ctag1$ if mode% = 1 ! CDATA opening tag
!
while 1 !
linput #1, ip$ ! read input
source_line% = source_line% + 1 !
if mode% = 1 then !
gosub process_a_line_cdata !
else !
gosub process_a_line_html !
end if !
print #2, op$ ! write output
dest_line% = dest_line% + 1 !
next !
use !
select err !
case 11 !
print "-i-status: "+ str$(err) !
print "-i-last line detected" !
case else !
print "-e-status: "+ str$(err) !
print "-i-error exit during source file read" !
end select !
end when !
print #2, ctag2$ if mode% = 1 ! CDATA closing tag
print #2, '</pre>' !
!
goto no_more_html if processing_mode$ <> "2" !
select custom% !
case 1 ! Neil's custom footer
print #2, '<hr>' !
print #2, '<p><strong>' !
print #2, '<a href="../links/openvms_resources.html">' !
print #2, '<img alt="" height="14" src="../images/hand_left.gif" width="33"></a>'
print #2, 'Back to <a href="../links/openvms_resources.html">OpenVMS</a><br>'
print #2, '<a href="openvms_demo_index.html">'
print #2, '<img alt="" height="14" src="../images/hand_left.gif" width="33"></a>'
print #2, 'Back to <a href="openvms_demo_index.html">OpenVMS Demo Index</a><br>'
print #2, '<a href="../index.html"><span style="text-decoration: none;">'
print #2, '<img alt="" height="34" src="../images/home04.gif" width="34"></span></a>'
print #2, 'Back to <a href="../index.html">Home</a><br>'
print #2, 'Neil Rieck<br>Kitchener - Waterloo - Cambridge, Ontario, Canada.<br>'
print #2, '<img alt=""'
print #2, ' src="http://www3.sympatico.ca/cgi-bin/Count.cgi?dd=E|df=nrieck20041019|sh=0|incr=1"></strong></p>'
end select !
print #2, '</body>' !
print #2, '</html>' !
no_more_html:
print "------------------------------------------------------------"
print str$(source_line%)+" lines were read" !
print str$(dest_line%)+" lines were written" !
if source_line% <> dest_line% then !
print "*** Danger: lines read <> lines written ***"+ bel !
end if !
close #1, #2 !
!
if email_dst$ <> "" then !
cmd$ = "$zip "+ k_program +".zip "+ fs2$ !
print "-i-executing DCL cmd: "+ cmd$ !
rc% = lib$spawn(cmd$) ! let DCL execute this command
if ((rc% and 7%) <> 1%) then !
print "-e-lib$spawn error: "+ str$(rc%) !
goto sortie ! ***--->>>
end if !
end if !
!
if email_dst$ <> "" then !
!
! LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
!
rc% = lib$get_logical("TCPWARE", junk$,,"LNM$SYSTEM_TABLE") !
if ((rc% and 7%) <> 1%) then !
cmd$ = '$mail /subject='+ k_program +' '+ k_program +'.zip; "'+ email_dst$ +'"'
else ! TCPWARE method to send attachments
print "-i-TCPWARE detected (the next command only works properly with TCPware 5.7-2 and higher)"
cmd$ = '$mail/for/type=1/subject='+ k_program +' '+ k_program +'.zip; "'+ email_dst$ +'"'
end if !
print "-i-executing DCL cmd: "+ cmd$ !
rc% = lib$spawn(cmd$) ! let DCL execute this command
if ((rc% and 7%) <> 1%) then !
print "-e-lib$spawn error: "+ str$(rc%) !
goto sortie ! ***--->>>
end if !
end if !
!
goto sortie ! ***--->>>
!
!=======================================================================
! process a line (xlate into HTML entities)
!=======================================================================
declare long pos1% ,&
pos2%
!
process_a_line_html: !
ip$ = edit$(ip$,128) ! drop trailing white space bf_101.3
op$ = "" ! init output buffer
!
! replace ampersand ("&") with equivalient HTML entity ("&")
!
amper_init: !
pos1% = 0 ! init starting ptr
amper_loop: !
pos2% = pos(ip$, "&", pos1%+1) ! find the ampersand
if pos2% = 0 then ! if none or no more
op$ = op$ + seg$(ip$, pos1%+1, len(ip$)) !
else !
op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) +"&" !
pos1% = pos2% ! advance starting pointer
goto amper_loop !
end if !
!
! replace left caret ("<") with equivalient HTML entity ("<")
!
lt_init: ! a.k.a. less-than
ip$ = op$ ! init
op$ = "" !
pos1% = 0 ! init starting ptr
lt_loop: !
pos2% = pos(ip$, "<", pos1%+1) ! find the left caret
if pos2% = 0 then ! if none or no more
op$ = op$ + seg$(ip$, pos1%+1, len(ip$)) !
else !
op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) +"<" !
pos1% = pos2% ! advance starting pointer
goto lt_loop !
end if !
!
! replace right caret (">") with equivalient HTML entity (">")
!
! caveat: many html docs say you do not need to do this, however, many web tools like
! MS-FrontPage and MS-ExpressionWeb are happier with it (see highlighting in code mode)
!
gt_init: ! a.k.a. greater-than
ip$ = op$ ! init
op$ = "" !
pos1% = 0 ! init starting ptr
gt_loop: !
pos2% = pos(ip$, ">", pos1%+1) ! find the left caret
if pos2% = 0 then ! if none or no more
op$ = op$ + seg$(ip$, pos1%+1, len(ip$)) !
else !
op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) +">" !
pos1% = pos2% ! advance starting pointer
goto gt_loop !
end if !
return !
!
!=======================================================================
! process a line (CDATA)
!=======================================================================
process_a_line_cdata: !
ip$ = edit$(ip$,128) ! drop trailing white space bf_102.2
op$ = "" ! init output buffer
!
! replace opening CDATA tag with equivalient HTML entities
!
o_cdata_init: !
pos1% = 0 ! init starting ptr
o_cdata_loop: !
pos2% = pos(ip$, ctag1$, pos1%+1) ! find CDATA tag
if pos2% = 0 then ! if none or no more
op$ = op$ + seg$(ip$, pos1%+1, len(ip$)) !
else !
op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) +"<"+ "![[CDATA[" !
pos1% = pos2% ! advance starting pointer
goto o_cdata_loop !
end if !
!
! replace closing CDATA tag with equivalient HTML entities
!
c_cdata_init: !
ip$ = op$ ! init
op$ = "" !
pos1% = 0 ! init starting ptr
c_cdata_loop: !
pos2% = pos(ip$, ctag2$, pos1%+1) ! find the left caret
if pos2% = 0 then ! if none or no more
op$ = op$ + seg$(ip$, pos1%+1, len(ip$)) !
else !
op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) + "]]" + ">" ! modified equivalent
pos1% = pos2% ! advance starting pointer
goto c_cdata_loop !
end if !
!
return !
!=======================================================================
! <<< adios >>>
!=======================================================================
sortie: !
close #1,2 !
print "<<< cleanup area >>>" !
print " scratch files:" !
print " "+ k_program +".zip" !
print " "+ fs2$ if fs2$ <> "" !
input "-?-erase these scratch files? (y/n,default=y) ";junk$ !
select left$(edit$(junk$,32+4+2),1) ! upcase for test
case "","Y" !
print "-i-deleting: "+ k_program +".zip" !
cmd$ = "delete/log/noconfirm "+ k_program +".zip;" !
junk% = lib$spawn(cmd$) !
if (junk% and 7%) <> 1% then !
print "-e-lib$spawn-rc: "+str$(junk%) !
end if !
!
if fs2$ <> "" then !
print "-i-deleting: "+ fs2$ !
cmd$ = "delete/log/noconfirm "+ fs2$ +";" !
junk% = lib$spawn(cmd$) !
if (junk% and 7%) <> 1% then !
print "-e-lib$spawn-rc: "+str$(junk%) !
end if !
end if !
end select !
!=======================================================================
! final exit
!=======================================================================
final_exit:
print "Adios..." !
end !
!#######################################################################