UNIXworkcode

1 eval 'exec perl -S $0 ${1+"$@"}' 2 if $running_under_some_shell; 3 4 #----------------------------------------------------------------------------- 5 # 6 # setext.pl -- Structure Enhanced Text Converter (to HTML or simple text) 7 # 8 # $Id: setext,v 1.14 2008/01/13 02:48:02 yooden Exp $ 9 # 10 # Copyright (c) 2000 Steven Haehn 11 # 12 # This is free software; you can redistribute it and/or modify it under the 13 # terms of the GNU General Public License as published by the Free Software 14 # Foundation; either version 2 of the License, or (at your option) any later 15 # version. 16 # 17 # In addition, as a special exception to the GNU GPL, the copyright holders 18 # give permission to link the code of this program with the Motif and Open 19 # Motif libraries (or with modified versions of these that use the same 20 # license), and distribute linked combinations including the two. You must 21 # obey the GNU General Public License in all respects for all of the code used 22 # other than linking with Motif/Open Motif. If you modify this file, you may 23 # extend this exception to your version of the file, but you are not obligated 24 # to do so. If you do not wish to do so, delete this exception statement from 25 # your version. 26 # 27 # This software is distributed in the hope that it will be useful, but WITHOUT 28 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 29 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 30 # more details. 31 # 32 # You should have received a copy of the GNU General Public License along with 33 # software; if not, write to the Free Software Foundation, Inc., 59 Temple 34 # Place, Suite 330, Boston, MA 02111-1307 USA 35 # 36 #----------------------------------------------------------------------------- 37 # 38 # The concept of setext documents is the brain child of Ian Feldman. 39 # Some typotag terms used herein were originally implemented in a perl script 40 # by Tony Sanders, which is the inspirational source for this work. 41 # This perl script understands the original typotags, plus extras needed for 42 # hypertext links, conditional text, and variables. 43 # 44 # Samples of setext documents are regularly provided to those folks which 45 # receive the TidBITS publication from www.tidbits.com in their e-mail. 46 # 47 # This program is really two programs crammed into one file. The two separate 48 # pieces share lots of code. Instead of having 3 separate files, one of 49 # them being a perl library with the shared code, there was a desire to keep 50 # everything rolled up in one suitcase. 51 # 52 #----------------------------------------------------------------------------- 53 # 54 # GENERAL TRANSLATOR ROUTINES NEDIT HELP SOURCE CODE GENERATION ROUTINES 55 # 56 # check_target_reference collect_internal_hypertext_references 57 # count emit_copyright 58 # date emit_helpText 59 # emit_paragraph emit_helpTitles 60 # emit_setext_definition emit_help_header 61 # extract_fields emit_help_label 62 # extract_menu_info emit_help_menu 63 # extract_menu_init emit_help_menu_text 64 # get_menu_item emit_help_topic 65 # get_setext get_menu_text 66 # is_member get_newline 67 # parse_setext get_style 68 # preserve_html get_style_name 69 # recover_extractions is_known_link 70 # replace_underlines locate_menu_text 71 # show_usage make_NEdit_menu_code 72 # to_state print_menu 73 # translate_setext 74 # 75 # 76 # TYPOTAG TRANSLATION ROUTINES 77 # 78 # help_bold_tt text_bold_tt html_bold_tt 79 # help_bullet_tt text_bullet_tt html_bullet_tt 80 # help_emit_line text_emit_line html_emit_line 81 # help_final text_final html_final 82 # help_finishing text_finishing html_finishing 83 # help_hot_tt text_hot_tt html_hot_tt 84 # help_indent text_indent html_indent 85 # help_init text_init html_init, html_init_title 86 # help_italic_tt text_italic_tt html_italic_tt 87 # help_line_break text_line_break html_line_break 88 # help_list_tt text_list_tt html_list_tt 89 # help_line_tt text_line_tt html_line_tt 90 # help_quote_tt text_quote_tt html_quote_tt 91 # help_section_tt text_section_tt html_section_tt 92 # help_target_tt text_target_tt html_target_tt 93 # help_title text_title html_title 94 # help_underline_tt text_underline_tt html_underline_tt 95 # 96 # help_fixed_styles html_enter_list, html_leave_list 97 # help_proportional_styles html_enter_pre, html_leave_pre 98 # fix_target_tt html_enter_quote, html_leave_quote 99 # html_emit_header, html_emit_footer 100 # getHtmlAttributes 101 # 102 #----------------------------------------------------------------------------- 103 104 use Getopt::Long; # for parsing the program command line (GetOptions) 105 use File::Basename; # for trimming off directory names from files (basename) 106 use English; 107 108 #------------------------------------------------------------------------------- 109 110 sub emit_version 111 { 112 my $version = "1.9"; 113 my $date = "Oct 01, 2003"; 114 115 print "$pgm: Version $version, $date.\n"; 116 exit 0; 117 } 118 119 #------------------------------------------------------------------------------- 120 121 sub show_usage 122 { 123 print "\n"; 124 print "Usage: $pgm [ -dhtTVw ][-D directory][-H [hfile]][-S [htmlExt]] \\\n"; 125 print " [-c conditional][-v name=value][setext_file [converted_file]]\n"; 126 print "\n"; 127 print " $pgm {-mp} [-c conditional][-M menuSuffix][-v name=value] setext_file\n"; 128 print "\n"; 129 print " The first form of $pgm is used to convert Structure Enhanced TEXT\n"; 130 print " documents into HTML or simple text documents.\n"; 131 print " The second form is specific to generating NEdit help menu code\n"; 132 print " from a setext document with Menu and Help directives.\n"; 133 print "\n"; 134 print " -c conditional text definitions, separated by commas.\n"; 135 print " -d do not automatically make titles hypertext references (HTML only)\n"; 136 print " -D specify destination directory for separate HTML files. This also sets\n"; 137 print " the value for the variable HTML_DIR.\n"; 138 print " -h show this usage clause.\n"; 139 print " -H convert setext_file to HyperText Markup Language (HTML).\n"; 140 print " Optional file parameter specifies file containing HTML header\n"; 141 print " and footer definition overrides. The current defaults are:\n"; 142 print " \$htmlHeader = <HTML>\n"; 143 print " <TITLE>\$HTML_TITLE</TITLE>\n"; 144 print " <HEAD></HEAD>\n"; 145 print " <BODY>\n"; 146 print " \$htmlFooter = </BODY>\n"; 147 print " </HTML>\n"; 148 print " where \$HTML_TITLE is replaced with an appropriate title.\n\n"; 149 print " -m generate NEdit help menu code files.\n"; 150 print " -M name NEdit help code files with this suffix.\n"; 151 print " -p do option -m and print out NEdit help elements.\n"; 152 print " -S convert setext_file into separate HTML files.\n"; 153 print " (the default name extension is '$htmlExt', but it can be\n"; 154 print " changed by specifying it as an argument to this option)\n"; 155 print " -t convert setext_file to simple text (default).\n"; 156 print " -T emit setext typotag definitions in use.\n"; 157 print " -v defines variable name and assigns it the given value.\n"; 158 print " (more than one occurrence of -v can be made) The variables\n"; 159 print " are made available for use within the setext document parsing.\n"; 160 print " -V display the version of this setext script.\n"; 161 print " -w do not emit warnings about missing variables.\n"; 162 print "\n"; 163 print " When the converted_file argument is missing, STDOUT is used.\n"; 164 print " When the setext_file argument is missing, STDIN is used.\n"; 165 print "\n"; 166 print " To get conditional text within a setext document to be displayed,\n"; 167 print " supply a definition tag through the -c option. For example,\n"; 168 print "\n"; 169 print " $pgm -c NEDITDOC help.etx nedit.doc\n"; 170 print "\n"; 171 print " would generate a plain text document, nedit.doc, from the source\n"; 172 print " help.etx, including/excluding text marked with 'NEDITDOC'\n"; 173 print " conditional text markers, also known as 'maybe' typotags.\n"; 174 print "\n"; 175 176 exit 0; 177 } 178 179 #--------------------------------------------------------------------------- 180 # This is a GetOptions call back function for gleaning variables from 181 # the command line so that they can be available to the setext parsing 182 # without having to appear in the setext document. The expected form 183 # on the command line is: -v variableName=value. For example, -v version=5.2 184 #--------------------------------------------------------------------------- 185 sub declare_variable 186 { 187 my $optionName = shift; 188 my $optionValue = shift; 189 my ( $varName, $varValue ) = split( "=", $optionValue ); 190 191 $varValue or do { 192 print STDERR "Missing value for variable '$varName'\n"; 193 $Getopt::Long::error++; 194 return 195 }; 196 197 #----------------------------------------------------- 198 # By trimming off leading and trailing spaces allows 199 # data entry like this: "version = 5.2 of Oct. 2001". 200 #----------------------------------------------------- 201 $varName =~ s/$trim_spaces/$2/o; 202 $varValue =~ s/$trim_spaces/$2/o; 203 204 $variables{ $varName } = $varValue; 205 } 206 207 #------------------------------------------------------------------------------- 208 209 sub emit_setext_definition 210 { 211 print <<END_OF_DEFINITION_TEXT; 212 213 Typotags Available 214 ------------------ 215 216 The following table contains typotags recognized by 217 $pgm. The "setext form" column in the table 218 is formatted such that the left most character of 219 the column represents the first character in a line 220 of setext. The circumflex character (^) means that 221 the characters of the typotag are significant only 222 when they are anchored to the front of the setext 223 line. This definition is a sample of a setext document. 224 Consequently, it must be put through the program so 225 that you can view the actual "setext form" of some 226 of the typotags. Thus, issue the following commands 227 to get a proper text view of the table below. 228 229 $pgm -T > typotags.etx 230 $pgm -w typotags.etx 231 232 ============ =================== ================== 233 ! name of setext form acted upon or 234 ! the typotag of typotag displayed as 235 !============ =================== ================== 236 ! title-tt "Title a title 237 ! =====" in chosen style 238 !------------ ------------------- ------------------ 239 ! subhead-tt "Subhead a subhead 240 ! -------" in chosen style 241 !------------ ------------------- ------------------ 242 ! section-tt ^#> section-text a section heading 243 ! with '#' from 1..9 244 ! in chosen style 245 !------------ ------------------- ------------------ 246 ! indent-tt ^ lines indented lines undented 247 ! ^ by 2 spaces and unfolded 248 !------------ ------------------- ------------------ 249 ! bold-tt **[multi]word** 1+ bold word(s) 250 ! italic-tt ~multi word~ 1+ italic word(s) 251 !underline-tt [_multi]_word_ underlined text 252 ! hot-tt [multi_]word_ 1+ hot word(s) 253 ! quote-tt ^>[space][text] > [mono-spaced] 254 ! bullet-tt ^*[space][text] [bullet] [text] 255 ! untouch-tt `_quoted typotag!_` `_left alone!_` 256 ! notouch-tt ^!followed by text text-left-alone 257 ! field-tt |>name[=value]<| value of name 258 ! line-tt ^ --- horizontal rule 259 !------------ ------------------- ------------------ 260 ! list-tt .([space]list start multiple line list 261 ! element ends with 262 ! empty line 263 ! endlist-tt .) denotes list end 264 !------------ ------------------- ------------------ 265 ! href-tt ^.. \@_word URL jump to address 266 ! note-tt ^.. \@_word Note:("*") ("cause error") 267 ! target-tt \@_[multi_]word [multi ]word 268 !------------ ------------------- ------------------ 269 ! twobuck-tt \$\$ [last on a line] [parse another] 270 ! suppress-tt ^..[space][not dot] [line hidden] 271 ! twodot-tt ^..[alone on a line] [taken note of] 272 !------------ ------------------- ------------------ 273 ! maybe-tt ^.. ? name[~] text show text when 274 ! name defined 275 ! maybenot-tt ^.. ! name[~] text show text when 276 ! name NOT defined 277 ! endmaybe-tt ^.. ~ name end of a multi- 278 ! line maybe[not]-tt 279 !------------ ------------------- ------------------ 280 ! passthru-tt ^!![text] text emitted 281 ! without processing 282 !------------ ------------------- ------------------ 283 ! escape-tt @\@x where 'x' is x is what remains 284 ! escaped character @@@@ needed for 1 @@ 285 ============ =================== ================== 286 287 Only one instance of the element subhead-tt (or, in its 288 absence, title-tt) is absolutely _required_ for a text to 289 be considered a valid setext. 290 291 All the elements, but subhead-tt, are in effect optional, 292 that is, not necessary for a setext to be declared as 293 such. The target-tt element allows the hypertext link 294 definition of href-tt to be within the same setext. The 295 actual reference (href-tt) of the target would look like: 296 297 .. _word #reference_within_document 298 299 !Multiple line maybe[not]-tt (conditional text regions) 300 !are introduced as ".. ? name~" or ".. ! name~" and are 301 !terminated with ".. ~ name", on a separate line. Single 302 !line maybe[not]-tt do not use the '~' character and are 303 !terminated with the end of the line. The special 304 !conditional text region named "html" allows a mixture of 305 !setext and HTML tags. Nesting of these typotags is 306 !allowed. For instance, if there are three conditional 307 !regions, A, B, and C, C can be nested inside B, which can 308 !be nested inside A (eg. A-B-C...C-B-A). Note that a 309 !surrounding region cannot end before one of its inner 310 !regions is terminated (eg. of illegal nesting 311 !A-B-C...C-A-B, where A terminated prior to B. 312 313 Multiple line list-tt are introduced as ".(". Each line 314 belongs to the current list element until an empty line 315 is encountered. Once a list-tt is encountered, line 316 separated paragraphs constitute list elements. A list-tt 317 is terminated by endlist-tt. The list-tt/endlist-tt 318 typotags are allowed to be nested (unlike the bullet-tt). 319 These typo-tags do not have to start in the first column 320 of a line, but must have leading whitespace if they are 321 indented at all. 322 323 Field typotags are used to define and reference values. 324 Field definitions can only occur within a suppress-tt. 325 For example: ".. `|>author=Steven Haehn<|`" 326 Field references (eg. |>author<|) can occur in any 327 printable text. If there is no known value for the 328 field, it will remain unchanged and appear as written 329 in the setext. 330 END_OF_DEFINITION_TEXT 331 332 #--------------------------------------------------------------- 333 # Emit any predefined variables so user knows what is available. 334 #--------------------------------------------------------------- 335 if( %variables ) 336 { 337 print "\n"; 338 print " The following are predefined for use in a field-tt\n"; 339 print " for any setext document translated by this utility.\n"; 340 print "\n"; 341 342 foreach $key ( sort keys %variables ) 343 { 344 print " $key = $variables{$key}\n"; 345 } 346 } 347 348 print "\n \$\$\n"; 349 exit 0; 350 } 351 352 #------------------------------------------------------------------------------- 353 354 $pgm = basename( $PROGRAM_NAME ); 355 356 #========================== 357 # Global shared definitions 358 #========================== 359 $um = "\375"; # untouchable marker 360 $vm = "\374"; # variable marker 361 $escMrk = "\33"; # internal escape marker 362 $trim_spaces = '(\s*)(.*?)(\s*)$'; 363 $list_level = 0; 364 $listIndent = 2; 365 @bullet_list = qw( * * o + * o + * o + ); 366 %variables = ( date => &date(), Date => &date("D"), year => &date("y") ); 367 @cond_text_definitions = (); 368 $make_title_href = 1; 369 370 #--------------------------------------- 371 # Variables needed for HTML conversions. 372 #--------------------------------------- 373 $lt = "\376"; # "<" marker 374 $gt = "\377"; # ">" marker 375 $amp = "\373"; # "&" marker 376 $htmlExt = "html"; # default HTML file name extension 377 378 $htmlHeader = 379 "<HTML>\n<HEAD>\n" . 380 "<TITLE>\$HTML_TITLE</TITLE>\n" . 381 "</HEAD>\n" . 382 "<BODY>\n"; 383 384 $htmlFooter = "</BODY>\n</HTML>\n"; 385 386 #--------------------------------------------------------- 387 # Look for following options, complain about unknown ones. 388 #--------------------------------------------------------- 389 Getopt::Long::config( "noignorecase" ); 390 391 GetOptions( 392 393 'c=s', # conditional text definitions, separated by commas 394 'd', # do not make titles hypertext references (HTML only) 395 'D=s', # specify destination directory for separate HTML files 396 'h', \&show_usage, 397 'H:s', # create HTML from setext input 398 'm', # create NEdit help menu code from setext input 399 'M=s', # name NEdit help code files with this suffix 400 'p', # same as 'm' but with debug printout 401 'S:s', # generate separate HTML files for each subsection 402 't', # create text from setext input 403 'T', # emit setext typo-tag document 404 'v=s', \&declare_variable, 405 'V', # emit setext script version information 406 'w' # do not emit warning messages. 407 408 ) || &show_usage; 409 410 #----------------------------------- 411 # Glean only those options specified 412 #----------------------------------- 413 $opt_c && (@cond_text_definitions = split( ",", $opt_c )); 414 $opt_d && ($make_title_href=0); 415 $opt_D && do { $variables{HTML_DIR}=$opt_D; $outputDirectory="$opt_D/" }; 416 $opt_h && show_usage(); 417 defined $opt_H && do { $convert_to = "html"; getHtmlAttributes( $opt_H ) }; 418 $opt_m && do { $make_menu = 1; $convert_to = "help" }; 419 $opt_M && ($helpSuffix = $opt_M ); 420 $opt_p && do { $make_menu = 1; $convert_to = "help"; $print_menu = 1 }; 421 defined $opt_S && do { 422 $convert_to = "html"; 423 $htmlExt = $opt_S if $opt_S; # user can specify file extension 424 $separate_html_files=1; 425 $make_title_href=1 426 }; 427 $opt_t && ($convert_to = "text"); 428 $opt_T && emit_setext_definition(); 429 $opt_V && (emit_version()); 430 $opt_w && ($noWarn = 1); 431 432 #-------------------------------------------------------------- 433 # Setext Parser states. 434 # 435 # The names are used to construct "enter_" & "leave_" elements 436 # in the state_change hash table required to be initialized 437 # by language specific initialization routines (see html_init). 438 #-------------------------------------------------------------- 439 $FMT = "fmt"; 440 $LIST = "list"; 441 $PRE_FMT = "pre"; 442 $QUOTE = "quote"; 443 444 #---------------------------- 445 # Typotag Pattern Definitions 446 #---------------------------- 447 $bold_tt = '\*\*([^\*]+)\*\*([^\*]|$)'; 448 $bullet_tt = '^\* ([^ ])'; 449 $empty_line = '^\s*$'; 450 $fld_left = '\|>'; 451 $fld_right = '<\|'; 452 $field_tt = "(${fld_left}.+?$fld_right)"; 453 $field_content = "${fld_left}(.+?)$fld_right"; 454 #$field_tt = "(${fld_left}[^<]+$fld_right)"; 455 #$field_content = "${fld_left}([^<]+)$fld_right"; 456 $hot_tt = '\b([\S]*)_\b'; 457 $href_tt = '^\.\.\s+_([\S]*)\s+(.*)\s*'; 458 $indent_tt = '^ ([^ ])'; 459 $intHrefMrk = "#"; 460 $internal_href = "^$intHrefMrk(.*)\$"; 461 $italic_tt = '~([^~]*)~'; 462 $line_tt = '^ ---*$'; 463 $list_tt = '^\s*\.([()])'; 464 $notouch_tt = '^!'; 465 $passthru_tt = '^!!'; 466 $quote_tt = '^> '; 467 $section_tt = '^([1-6])>'; 468 $subtitle_tt = '^---'; 469 $suppress_tt = '^\.\.'; 470 $target_tt = '(?!(^|\s)_[\S]+_(\s|\W|$))(^|\s)_([\S]+)'; # not underline, then target 471 $title_tt = '^==='; 472 $twobuck_tt = '^\s*\$\$\s*$'; 473 $underline_tt = '\b_([\S]*)_\b'; 474 $untouch_tt = "\\s*(`[^`]+[`'])(?=\\s|\\W|\$)"; 475 $variable_def = '\s*(\w+)\s*([^=]*(=(.*)))?'; # $1 = name, $4 = value 476 477 $escape_tt = "@"; # the character escape symbol (need @@ to escape @) 478 $needEscaping = "$escape_tt(.)"; 479 $escapedFound = "$escMrk(\\d+)$escMrk"; 480 481 if( $make_menu ) 482 { 483 $setext_file = $ARGV[0]; 484 open SETEXT, "<$setext_file" or die "Can't access $setext_file, $OS_ERROR"; 485 make_NEdit_menu_code(); 486 } 487 else # Global elements for parsing setext 488 { 489 #------------------------- 490 # Program option defaults. 491 #------------------------- 492 $setext_file = "-"; # STDIN, allows program to be used as a filter 493 $converted_file = "-"; # STDOUT 494 $convert_to = "text" if $convert_to eq ""; 495 496 #-------------------------------------- 497 # Begin processing file specifications. 498 #-------------------------------------- 499 $setext_file = $ARGV[0] if $ARGV[0] ne ""; 500 open SETEXT, "<$setext_file" or die "Can't access $setext_file, $OS_ERROR"; 501 502 if( $ARGV[1] ne "" ) 503 { 504 $converted_file = $ARGV[1]; 505 $convert_to = "html" if $converted_file =~ /\.$htmlExt$/; # in case -H forgotten 506 507 if( $converted_file eq basename( $converted_file ) ) 508 { 509 if( $outputDirectory ) 510 { 511 $converted_file = "$outputDirectory/$converted_file"; 512 } 513 } 514 } 515 516 open CONVERT, ">$converted_file" or die "Can't create $converted_file, $OS_ERROR"; 517 translate_setext(); 518 } 519 520 #------------------------------------------------------------------------------- 521 #------------------------------------------------------------------------------- 522 #------------------------------------------------------------------------------- 523 524 sub translate_setext 525 { 526 #-------------------------------------- 527 # Adding conversion type to conditional 528 # text definitions for convenience. 529 #-------------------------------------- 530 push @cond_text_definitions, $convert_to; 531 532 get_setext( SETEXT, \@cond_text_definitions, \@data ); 533 534 extract_menu_info( \@data ) 535 if( $convert_to eq "html" && $separate_html_files ); 536 537 chomp @data; # remove the newline character from each line. 538 539 register_tt_translationFunctions( $convert_to ); 540 541 parse_setext( \@data ); 542 } 543 544 #------------------------------------------------------------------------------- 545 546 sub make_NEdit_menu_code 547 { 548 #-------------------------------- 549 # Supply a default NEdit version. 550 #-------------------------------- 551 $neditDefaultMarker = "NEdit release of "; 552 $variables{ version } = $neditDefaultMarker . date() 553 if (not exists $variables{ version } or 554 $variables{ version } eq "default"); 555 556 #-------------------------------------- 557 # Adding conversion type to conditional 558 # text definitions for convenience. 559 #-------------------------------------- 560 push @cond_text_definitions, $convert_to; 561 562 get_setext( SETEXT, \@cond_text_definitions, \@data ); 563 extract_menu_info( \@data ); 564 register_tt_translationFunctions( $convert_to ); 565 } 566 567 #------------------------------------------------------------------------------- 568 569 sub parse_setext 570 { 571 my $setextData = shift; 572 573 local($crnt_state, $fold, $a, $i, $unt, $lineNo); 574 575 $crnt_state = $FMT; 576 $lineNo = -1; 577 @untouchable = (); 578 $fold = 0; 579 580 foreach (@$setextData) 581 { 582 $lineNo++; # current location in data array 583 584 #-------------------------- 585 # process title information 586 #-------------------------- 587 (/$title_tt/i or /$subtitle_tt/i) && do { 588 &$do_title(); 589 $fold = 0; 590 next; 591 }; 592 593 /$section_tt/o && do { 594 &$do_section_tt($1); 595 $fold = 0; 596 next; 597 }; 598 599 /$passthru_tt/ && do { 600 &$do_emit_line(); 601 next; 602 }; 603 604 next if ( /$suppress_tt/ or /$twobuck_tt/ ); 605 606 $list_level = 0 if $list_level < 0; # paranoia protection 607 608 #-------------------------------------------------- 609 # handle line breaks, only one empty line gets out. 610 #-------------------------------------------------- 611 if ( /$empty_line/o ) { 612 to_state( $FMT ); 613 614 if( $list_level and not $fold ) { 615 &$do_list_tt(); 616 $fold = 1; 617 } 618 else { 619 $fold = &$do_line_break( $fold ); 620 } 621 next; 622 } 623 624 $fold = 0; # no more empty lines 625 626 /$line_tt/ && do { &$do_line_tt(); next; }; 627 628 #----------------------------------- 629 # No change to current state allowed 630 # during list processing. 631 #----------------------------------- 632 if( $list_level == 0 ) 633 { 634 #------------------ 635 # State transitions 636 #------------------ 637 if ( /$quote_tt/o ) { &to_state( $QUOTE ) } 638 elsif ( /$bullet_tt/o ) { &to_state( $LIST ) } 639 elsif ( /$indent_tt/o ) { &to_state( $FMT ) } 640 elsif ( /$list_tt/o ) { &to_state( $FMT ) } 641 else { &to_state( $PRE_FMT ) } 642 } 643 644 if( /$notouch_tt/o ) { s/$notouch_tt/ /o; } 645 else 646 { 647 #-------------------------------------------- 648 # Handle the untouchables first. 649 # Mark their locations for later replacement. 650 # (see recover_extractions) 651 #-------------------------------------------- 652 for( $i = scalar( @untouchable ); /$untouch_tt/o; $i++ ) 653 { 654 $unt = $1; 655 $unlen = length( $unt ); 656 $unloc = index( $_, $unt ); 657 $untouchable[ $i ] = $unt; 658 $front = substr( $_, 0, $unloc ); 659 $back = substr( $_, $unloc+$unlen ); 660 $_ = $front . $um . $back; 661 } 662 663 &$do_list_tt(); 664 &$do_bullet_tt(); 665 &$do_quote_tt(); 666 &$do_bold_tt(); 667 &$do_italic_tt(); 668 &$do_underline_tt(); 669 &$do_target_tt(); 670 &$do_hot_tt(); 671 &$do_indent_tt(); 672 } 673 &$do_emit_line(); 674 } 675 676 &$do_final(); 677 } 678 679 #------------------------------------------------------------------------------- 680 681 sub register_tt_translationFunctions 682 { 683 my $conversion_type = shift; 684 685 #---------------------------------------------------- 686 # Register call-back functions for typotag processing 687 #---------------------------------------------------- 688 $do_bold_tt = "${conversion_type}_bold_tt"; 689 $do_bullet_tt = "${conversion_type}_bullet_tt"; 690 $do_emit_line = "${conversion_type}_emit_line"; 691 $do_final = "${conversion_type}_final"; 692 $do_hot_tt = "${conversion_type}_hot_tt"; 693 $do_indent_tt = "${conversion_type}_indent"; 694 $do_initialize = "${conversion_type}_init"; 695 $do_italic_tt = "${conversion_type}_italic_tt"; 696 $do_line_break = "${conversion_type}_line_break"; 697 $do_line_tt = "${conversion_type}_line_tt"; 698 $do_list_tt = "${conversion_type}_list_tt"; 699 $do_quote_tt = "${conversion_type}_quote_tt"; 700 $do_section_tt = "${conversion_type}_section_tt"; 701 $do_target_tt = "${conversion_type}_target_tt"; 702 $do_title = "${conversion_type}_title"; 703 $do_underline_tt = "${conversion_type}_underline_tt"; 704 705 &$do_initialize; # do any necessary initialization 706 } 707 708 #------------------------------------------------------------------------------- 709 710 sub date 711 { 712 $format = $_[0]; 713 714 ( $sec,$min,$hour,$mday,$mon,$year,@ignore ) = localtime( time ); 715 $month = (January,February,March,April,May,June,July, 716 August,September,October,November,December)[$mon]; 717 $year = $year + 1900; 718 719 return $year if $format eq "y"; 720 return "$month $mday, $year" if $format eq "D"; 721 return substr($month,0,3) . " $mday, $year"; 722 } 723 724 #------------------------------------------------------------------------------- 725 726 sub to_state 727 { 728 my $given_state = shift; 729 730 if ( $crnt_state ne $given_state ) 731 { 732 if( exists $state_change{ "leave_$crnt_state" } ) 733 { 734 $doStateChange = $state_change{ "leave_$crnt_state" }; 735 &$doStateChange(); 736 } 737 738 if( exists $state_change{ "enter_$given_state" } ) 739 { 740 $doStateChange = $state_change{ "enter_$given_state" }; 741 &$doStateChange(); 742 } 743 744 $crnt_state = $given_state; 745 } 746 } 747 748 #------------------------------------------------------------------------------- 749 750 sub count 751 { 752 my $whatToCount = shift; 753 my $line = shift; 754 my $howMany = 0; 755 756 $howMany++ while( $line =~ /$whatToCount/g ); 757 return $howMany; 758 } 759 760 #------------------------------------------------------------------------------- 761 762 sub extract_fields 763 { 764 local $_ = shift; 765 local $cond_text_region = shift; 766 767 my ( $field, $variable, $flen, $floc, $front, $back, $v_name, $v_value ); 768 my @variable_list = (); 769 770 #------------------------------------------ 771 # Mark all the escaped character sequences. 772 #------------------------------------------ 773 while( /$needEscaping/o ) 774 { 775 $subChar = ord( $1 ); 776 s/$needEscaping/$escMrk$subChar$escMrk/o; 777 } 778 779 #----------------------------------------------------- 780 # Collect any field typotags found for later expansion. 781 #----------------------------------------------------- 782 while( /$field_tt/o ) 783 { 784 $field = $1; 785 $field =~ /$field_content/ && ( $variable = $1 ); 786 787 if( $variable =~ /$variable_def/ ) { 788 789 $v_name = $1; 790 791 #---------------------------------------------- 792 # When fields 2 and 3 contain identical strings 793 # then a valid field has been encountered. 794 #---------------------------------------------- 795 if( $2 eq $3 ) { 796 $v_value = $4; 797 } 798 else 799 { 800 #----------------------------------- 801 # This is NOT a variable definition. 802 # Have to recover original string. 803 #----------------------------------- 804 $v_name = "_A_${v_name}_Z_"; #internal name 805 $v_value = $variable; 806 } 807 808 #---------------------------------------- 809 # Is this only a reference to a variable? 810 #---------------------------------------- 811 if ( ! defined $v_value ) { 812 #------------------------------------------------ 813 # Only put definitions in the list when it is not 814 # part of a comment. (comments are not emitted) 815 #------------------------------------------------ 816 push @variable_list, $v_name unless /$suppress_tt/o; 817 } 818 else { 819 #------------------------------------------------ 820 # setting the variable ( |>varName = value<| ) 821 # (here $v_value is the value assignment portion) 822 #------------------------------------------------ 823 if( /$suppress_tt/o ) { 824 $variables{ $v_name } = 825 preserve_html( $v_value, $cond_text_region ); 826 } else { 827 push @variable_list, $variable; 828 } 829 } 830 } 831 832 #-------------------------------------- 833 # Remove field and replace with marker. 834 #-------------------------------------- 835 $flen = length( $field ); 836 $floc = index( $_, $field ); 837 $front = substr( $_, 0, $floc ); 838 $back = substr( $_, $floc+$flen ); 839 $_ = $front . $vm . $back; 840 } 841 842 #---------------------------- 843 # Fill in any variables found 844 #---------------------------- 845 foreach $element ( @variable_list ) 846 { 847 if( exists $variables{ $element } ) { 848 $value = $variables{ $element } 849 } else { 850 $value = "|>$element<|"; 851 print STDERR "$pgm: Undefined variable '$element' used in $setext_file.\n" unless $noWarn; 852 } 853 s/$vm/$value/; 854 } 855 856 $_ = preserve_html( $_, $cond_text_region ); 857 858 return $_; 859 } 860 861 #------------------------------------------------------------------------------- 862 863 sub preserve_html 864 { 865 my $text = shift; 866 my $cond_text_region = shift; 867 868 #-------------------------------------------------------- 869 # When in a conditional text region that only applies to 870 # HTML translation, change the angle brackets to internal 871 # definitions that will be fixed later. This should allow 872 # for a mixture of setext and HTML language together. 873 #-------------------------------------------------------- 874 if ( $cond_text_region eq "html" ) 875 { 876 $text =~ s/</${lt}/go; 877 $text =~ s/>/${gt}/go; 878 $text =~ s/\&/${amp}/go; 879 } 880 881 return $text; 882 } 883 884 #=================================================================== 885 # Import setext data from given data stream and pay attention to 886 # conditional text considerations, as described below. 887 # 888 # ^.. ? name Conditional text when 'name' is defined. 889 # ^.. ! name Conditional text when 'name' is NOT defined. 890 # 891 # ^.. ? name~ 892 # Multiple line conditional text when 'name' is defined. 893 # (without suppress-tt, will always appear in translated 894 # document going through non-conditional setext conversion) 895 # ^.. ~ name 896 # 897 # ^.. ! name~ 898 # Multiple line conditional text when 'name' is NOT defined. 899 # (without suppress-tt, will always appear in translated 900 # document going through non-conditional setext conversion) 901 # ^.. ~ name 902 # 903 # This procedure also extracts and applies variable definitions 904 # to the text to be emitted. 905 #=================================================================== 906 907 sub get_setext 908 { 909 my $stream = shift; 910 my $cond_text_definitions = shift; 911 my $data = shift; 912 913 my $conditional_text_marker = '^\.\. ([\?!~])\s*(\S+)\s?(.*)$'; 914 my $lineNbr = 0; 915 my $i = 0; 916 my $element = ""; 917 my ($tense,$def_nm,$text,$multi_line,$crnt_def); 918 my @cond_text_stack = (); 919 920 while( $_ = <$stream> ) 921 { 922 $lineNbr++; 923 924 if( /$conditional_text_marker/o ) 925 { 926 $tense = $1; # positive, negative, or end-of conditional text 927 $def_nm = $2; 928 $text = $3; 929 930 $multi_line = $def_nm =~ s/~//o; 931 932 #--------------------------------------------- 933 # Reach end of multiple line conditional text? 934 #--------------------------------------------- 935 if( $tense eq "~" ) 936 { 937 $crnt_def = substr( pop @cond_text_stack, 1 ); 938 939 if( $crnt_def ne $def_nm ) 940 { 941 print STDERR "Incorrectly nested conditinal text sections near line $lineNbr.\n"; 942 print STDERR "Expected end of '$crnt_def', but saw end of '$def_nm'\n"; 943 exit 1; 944 } 945 } 946 else 947 { 948 #----------------------------------------- 949 # Entering multiple line conditional text? 950 #----------------------------------------- 951 if( $multi_line ) { 952 push @cond_text_stack, "$tense$def_nm"; 953 } 954 955 #------------------------------------------ 956 # This will also catch any non-space 957 # text found on multiple line conditionals. 958 #------------------------------------------ 959 if( $text =~ /\S/o ) 960 { 961 $$data[$i++] = extract_fields( "$text\n", $def_nm ) 962 if ($tense eq "?") and is_member( $def_nm, $cond_text_definitions ); 963 $$data[$i++] = extract_fields( "$text\n", $def_nm ) 964 if ($tense eq "!") and not is_member( $def_nm, $cond_text_definitions ); 965 } 966 } 967 } 968 elsif( scalar( @cond_text_stack ) == 0 ) 969 { 970 $$data[$i++] = extract_fields( $_, "" ); 971 } 972 else 973 { 974 #-------------------------------------------------------------------- 975 # The top element of the conditional text stack is the current 976 # conditional text area. See if it exists in the definitions list. 977 # When present, we want this line of text, depending on 'tense'. 978 #-------------------------------------------------------------------- 979 $element = $cond_text_stack[-1]; 980 $tense = substr( $element, 0, 1 ); 981 $def_nm = substr( $element, 1 ); 982 983 if( $tense eq "?") 984 { 985 if( is_member( $def_nm, $cond_text_definitions ) ) { 986 s/$suppress_tt //o; 987 $$data[$i++] = extract_fields( $_, $def_nm ); 988 } 989 } 990 elsif( ! is_member( $def_nm, $cond_text_definitions ) ) 991 { 992 s/$suppress_tt //o; 993 $$data[$i++] = extract_fields( $_, $def_nm ); 994 } 995 } 996 } 997 } 998 999 #------------------------------------------------------------------------------- 1000 1001 sub extract_menu_init 1002 { 1003 %MenuNames = (); 1004 @helpMenu = (); 1005 @menuStack = \@helpMenu; 1006 $crntMenu = \@helpMenu; 1007 @indentStack = ( 0 ); 1008 $menuLevel = 0; 1009 $comment_ind = "^\\.\\."; # setext comment indicator ("..") 1010 $menu_element = "${comment_ind} Menu: "; 1011 $help_element = "${comment_ind} Help: "; 1012 $drop_marker = "_(.)_"; 1013 $separator = "-"; 1014 $help_code = 9; # special hide-it code indicating not part of help menu 1015 $name_length = 0; # determines padding alignment in HelpMenu data emission 1016 $crntIndent = 0; 1017 $subMenuIndicator = "\377"; 1018 } 1019 1020 #------------------------------------------------------------------------------- 1021 1022 sub extract_menu_info 1023 { 1024 my $thisData = shift; 1025 my $dataIndex = 0; 1026 1027 extract_menu_init(); 1028 1029 #---------------------------------------------------------------------- 1030 # For each and every menu item found in the original data (*.etx) file. 1031 #---------------------------------------------------------------------- 1032 while( $_ = get_menu_item( $thisData, \$dataIndex ) ) 1033 { 1034 #---------------------------------------------------------------------- 1035 # Here we want to extract the menu title, help name, optional hideIt 1036 # numerical indicator, and optional menu association name. 1037 # 1038 # Expecting: MenuTitle # HelpName [[,]HideItIndicator] [# Association] 1039 #---------------------------------------------------------------------- 1040 if( /^([^#]+)#\s*(\w*)(\s*,\s*)?(\d+)?(\s*#\s*)?(\w+)?/o ) 1041 { 1042 $menuTitle = $1; 1043 $helpName = $2; 1044 $hideItInd = ($4 eq "") ? "0" : $4; 1045 $assocName = ($6 eq "") ? $helpName : $6; 1046 $helpName =~ s/$trim_spaces/$2/; 1047 $assocName =~ s/$trim_spaces/$2/; 1048 1049 #------------------------------------------------ 1050 # Determine to which menu this menu item belongs 1051 # using leading whitespace indentation. 1052 # Extract menu character mneumonic. 1053 #------------------------------------------------ 1054 $menuTitle =~ /^(\s*)/ && ($nextMenu = length($1)-$crntIndent); 1055 $menuTitle =~ s/$trim_spaces/$2/o; 1056 1057 $mneumonic = (/$drop_marker/) ? $1 : substr( $menuTitle, 0, 1 ); 1058 1059 #-------------------------------------------------- 1060 # Identation greater than previous menu element 1061 # indicates that this element is part of a submenu. 1062 #-------------------------------------------------- 1063 if( $nextMenu > 0 ) 1064 { 1065 @$crntMenu[ $end ] .= $subMenuIndicator; # mark previous element 1066 ($menu = $previousTitle) =~ s/ /_/g; 1067 @$menu = (); 1068 push @menuStack, \@$menu; 1069 push @indentStack, $nextMenu; 1070 $menuLevel++; 1071 } 1072 #-------------------------------------- 1073 # Indentation less than previous menu 1074 # element indicates leaving a submenu. 1075 #-------------------------------------- 1076 elsif( $nextMenu < 0 ) 1077 { 1078 $indentLevel = $indentStack[$menuLevel] + $nextMenu; 1079 do { 1080 pop @menuStack; 1081 pop @indentStack; 1082 $menuLevel--; 1083 1084 } while( $indentLevel < $indentStack[$menuLevel] ); 1085 } 1086 1087 $crntIndent += $nextMenu; 1088 $crntMenu = $menuStack[ $#menuStack ]; 1089 $end = scalar( @$crntMenu ); 1090 @$crntMenu[ $end ] = "$mneumonic,$menuTitle,$helpName,$hideItInd"; 1091 $thisTitle = $menuTitle; 1092 $thisTitle =~ s/$drop_marker/$1/; 1093 $thisTitle =~ s/ /_/go; 1094 $MenuNames{ $thisTitle } = "$menuLevel$assocName"; 1095 $previousTitle = $menuTitle; 1096 1097 #--------------------------------- 1098 # update data for padding purposes 1099 #--------------------------------- 1100 if( $mneumonic ne $separator and $name_length < length( $helpName ) ) 1101 { 1102 $name_length = length( $helpName ); 1103 } 1104 } 1105 } 1106 } 1107 1108 #------------------------------------------------------------------------------- 1109 1110 sub get_menu_item 1111 { 1112 my $setext = shift; 1113 my $line = shift; 1114 1115 #------------------------------------------- 1116 # Search each and every data line for either 1117 # a '# Menu: ' line or a '# Help: ' line and 1118 # return remainder of the line. 1119 #------------------------------------------- 1120 while( $$line < scalar( @$setext ) ) 1121 { 1122 $_ = $$setext[ $$line++ ]; 1123 return $_ if s/$menu_element//o; 1124 return "$_, $help_code" if s/$help_element//o; 1125 } 1126 1127 return ""; 1128 } 1129 1130 #------------------------------------------------------------------------------- 1131 1132 sub check_target_reference 1133 { 1134 local($_) = @_; 1135 my $index; 1136 my $target = ""; 1137 1138 if( /$target_tt/ ){ 1139 $target = $4; 1140 } 1141 #----------------------------------- 1142 # Are all titles automatically being 1143 # made into hypertext references? 1144 #----------------------------------- 1145 elsif( $make_title_href ) { 1146 /$title_tt/ && ( $target = $2 ); 1147 $target =~ s/$trim_spaces/$2/o; 1148 $target =~ s/ /_/go; 1149 } 1150 1151 if( $target ) { 1152 print CONVERT "<A NAME=\"$target\"></A>\n"; 1153 1154 # only one target-tt reference of this kind allowed per file. 1155 ($index = is_member( $target, \@nm_ref )) 1156 && do{ splice( @nm_ref, $index-1, 1 ); }; 1157 } 1158 } 1159 1160 #------------------------------------------------------------------------------- 1161 1162 sub is_member 1163 { 1164 $item = shift; 1165 $this_list = shift; 1166 my $index = 1; 1167 1168 foreach $member ( @$this_list ) 1169 { 1170 if( $item eq $member ) 1171 { 1172 return $index; 1173 } 1174 $index++; 1175 } 1176 1177 return 0; 1178 } 1179 1180 #------------------------------------------------------------------------------- 1181 1182 sub replace_underlines 1183 { 1184 my $pattern = shift; 1185 s#$pattern#($text = $1) =~ s,_, ,go; $text; #eg; 1186 } 1187 1188 #------------------------------------------------------------------------------- 1189 1190 sub reclaim_escapes 1191 { 1192 #----------------------------------------- 1193 # Put back any escaped characters in text. 1194 #----------------------------------------- 1195 while( /$escapedFound/ ) 1196 { 1197 $subChar = chr( $1 ); 1198 s/$escapedFound/$escape_tt$subChar/; 1199 } 1200 } 1201 1202 #------------------------------------------------------------------------------- 1203 1204 sub recover_extractions 1205 { 1206 my $element; 1207 1208 #------------------------------------ 1209 # Replace escaped characters in text. 1210 #------------------------------------ 1211 while( /$escapedFound/ ) 1212 { 1213 $subChar = chr( $1 ); 1214 s/$escapedFound/$subChar/; 1215 } 1216 1217 foreach $element ( @untouchable ) { s/$um/$element/; } 1218 @untouchable = (); 1219 } 1220 1221 #------------------------------------------------------------------------------- 1222 1223 sub emit_paragraph 1224 { 1225 my $paragraph = shift; 1226 my $line = $left_margin; 1227 1228 @words = split ' ', $paragraph; 1229 1230 #------------------------------------------------------------- 1231 # Flow words onto a line up until the right margin is reached. 1232 #------------------------------------------------------------- 1233 foreach $word ( @words ) 1234 { 1235 if( length( $line ) + length( $word ) + 1 <= $right_margin ) 1236 { 1237 $line = "$line$word "; 1238 } 1239 else 1240 { 1241 print CONVERT "$line\n"; 1242 $line = "$left_margin$word "; 1243 } 1244 } 1245 1246 #-------------------- 1247 # emit any remainder. 1248 #-------------------- 1249 print CONVERT "$line\n" if( length( $line ) > length( $left_margin ) ); 1250 } 1251 1252 #------------------------------------------------------------------------------- 1253 1254 # This routine is used to override program defaults for HTML settings. 1255 # Two variables are expected to be defined; $htmlHeader and $htmlFooter 1256 1257 sub getHtmlAttributes 1258 { 1259 my $attrFile = shift; 1260 1261 if( $attrFile ) 1262 { 1263 unless( $return = do $attrFile ) 1264 { 1265 warn "Could not parse $attrFile: $@" if $@; 1266 warn "Could not do $attrFile: $!" unless defined $return; 1267 warn "Could not run $attrFile" unless $return; 1268 exit 1; 1269 } 1270 } 1271 } 1272 1273 #------------------------------------------------------------------------------- 1274 # setext to text conversion call-back routines. 1275 # ( in alphabetical order ) 1276 #------------------------------------------------------------------------------- 1277 1278 sub text_bold_tt { s/$bold_tt/$1$2/g } 1279 1280 #------------------------------------------------------------------------------- 1281 1282 sub text_bullet_tt 1283 { 1284 # don't do anything if this is no bulleted line. 1285 if (/$bullet_tt/) 1286 { 1287 # remove lead-in from paragraph and put the rest in an array 1288 my $paragraph = $_; 1289 $paragraph =~ s/$bullet_tt/$1/; 1290 @words = split ' ', $paragraph; 1291 $paragraph = ""; 1292 1293 # start with text mode bullet character 1294 my $line = ' * '; 1295 foreach $word (@words) 1296 { 1297 if (length($line) + length($word) + 1 <= $right_margin) 1298 { 1299 # put every word in a line if there's still room 1300 $line = "$line$word "; 1301 } else 1302 { 1303 # append line to paragraph if full and start a new line 1304 $paragraph = "$paragraph$line\n"; 1305 $line = " $word "; 1306 } 1307 } 1308 # get last line 1309 $paragraph = "$paragraph$line"; 1310 1311 # remove trailing white space 1312 $paragraph =~ s/\s$//; 1313 $_ = $paragraph; 1314 } 1315 } 1316 1317 #------------------------------------------------------------------------------- 1318 1319 sub text_emit_line 1320 { 1321 if( /$passthru_tt/ ) 1322 { 1323 s/$passthru_tt//o; # remove typotag and pass line out as is. 1324 reclaim_escapes(); 1325 print CONVERT "$_\n"; 1326 } 1327 else 1328 { 1329 #----------------------------- 1330 # Handling nested lists first. 1331 #----------------------------- 1332 if( $list_level ) 1333 { 1334 my $pad = " " x ($list_level * $listIndent); 1335 my $bullet = ($atListStart) ? "$bullet_list[$list_level] " : " "; 1336 s/^\s*/ $pad$bullet/; 1337 $atListStart = 0; 1338 } 1339 elsif( $crnt_state ne $FMT && $text_unfolded_line ne "" ) 1340 { 1341 emit_paragraph( &text_finishing($text_unfolded_line) ); 1342 $text_unfolded_line = ""; 1343 } 1344 1345 #------------------------------------------- 1346 # This keeps extra newlines from popping out 1347 # when a list has been terminated. 1348 #------------------------------------------- 1349 unless( $terminatedList ) 1350 { 1351 print CONVERT &text_finishing( $_ ), "\n" unless $_ eq $indentingMode; 1352 } 1353 else 1354 { 1355 $terminatedList = 0; 1356 } 1357 } 1358 } 1359 1360 #------------------------------------------------------------------------------- 1361 1362 sub text_final { emit_paragraph( &text_finishing($text_unfolded_line) ) } 1363 1364 #------------------------------------------------------------------------------- 1365 1366 sub text_finishing 1367 { 1368 local($_) = @_; 1369 recover_extractions(); 1370 $_; 1371 } 1372 1373 #------------------------------------------------------------------------------- 1374 1375 sub text_hot_tt 1376 { 1377 if ( /$hot_tt/ ) { 1378 #--------------------------------------------------------- 1379 # The heuristic to prevent Internet addresses from having 1380 # underlines removed, is to check for an '@' character. 1381 #--------------------------------------------------------- 1382 if (($text = $1) !~ /\@/ ) { 1383 $text =~ s/_/ /g; 1384 } 1385 s/$hot_tt/$text/; 1386 } 1387 } 1388 1389 #------------------------------------------------------------------------------- 1390 1391 sub text_indent 1392 { 1393 s/$indent_tt/$1/o && do { 1394 $text_unfolded_line = "$text_unfolded_line$_ "; 1395 $_ = $indentingMode; 1396 }; 1397 } 1398 1399 #------------------------------------------------------------------------------- 1400 1401 sub text_init 1402 { 1403 %state_change = (); 1404 $text_unfolded_line = ""; # to be used by text_indent & text_emit_line 1405 $left_margin = " "; # for emit_paragraph 1406 $right_margin = 79; # for emit_paragraph 1407 $indentingMode = "?#."; # hopefully unique string not normally found 1408 1409 #---------------------------------------------------------------- 1410 # Take all the titles, capitalize and remove title indicator. 1411 #---------------------------------------------------------------- 1412 for ($i = 0; $i <= $#data; $i++) 1413 { 1414 $_ = $data[$i]; # $_ is default for searches 1415 1416 (/$title_tt/ or /$subtitle_tt/) && do { 1417 $titleType = ( /$title_tt/ ) ? "=" : "-"; 1418 $data[$i--] = ".."; # suppress title indicator ( --- or === ) 1419 $data[$i] =~ s/^\s*//o; # get rid of any leading space. 1420 $this_title = $data[$i]; 1421 1422 # Have to fix title if it also happens to be a target-tt. 1423 $this_title =~ /$target_tt/ && do { ($tmp = $4) =~ s,_, ,go; $this_title = $tmp }; 1424 $data[$i] = "..$titleType \U$this_title"; 1425 }; 1426 } 1427 1428 #---------------------------------------------------- 1429 # NOTE: changing original subtitle-tt search pattern 1430 # to match what was done above. 1431 #---------------------------------------------------- 1432 $subtitle_tt = "^\\.\\.- (.*)"; 1433 $title_tt = "^\\.\\.= (.*)"; 1434 } 1435 1436 #------------------------------------------------------------------------------- 1437 1438 sub text_italic_tt { s/$italic_tt/$1/g } 1439 1440 #------------------------------------------------------------------------------- 1441 1442 sub text_line_break 1443 { 1444 my $fold = shift; 1445 emit_paragraph( &text_finishing($text_unfolded_line) ); 1446 $text_unfolded_line = ""; 1447 print CONVERT "\n" unless $fold++; 1448 return $fold; 1449 } 1450 1451 #------------------------------------------------------------------------------- 1452 1453 sub text_line_tt { } 1454 1455 #------------------------------------------------------------------------------- 1456 1457 sub text_list_tt 1458 { 1459 if( /$list_tt/o ) 1460 { 1461 if ( $1 eq '(' ) 1462 { 1463 $list_level++; 1464 s/$list_tt\s*//; 1465 $atListStart = 1; 1466 } 1467 else 1468 { 1469 $list_level--; 1470 s/$list_tt//; 1471 $terminatedList = 1; 1472 } 1473 } 1474 1475 #----------------------------------------------------- 1476 # An empty line terminates a multiple line list entry. 1477 #----------------------------------------------------- 1478 elsif( /$empty_line/o ) 1479 { 1480 print CONVERT "\n"; 1481 #text_line_break( 0 ); 1482 $atListStart = 1 if $list_level; 1483 } 1484 } 1485 1486 #------------------------------------------------------------------------------- 1487 1488 sub text_quote_tt { } 1489 1490 #------------------------------------------------------------------------------- 1491 1492 sub text_section_tt 1493 { 1494 my $hdr_level = shift; 1495 1496 s/$section_tt//; 1497 print CONVERT "\n \U$_\n" if $hdr_level <= 3; # converted to uppercase 1498 print CONVERT "\n $_\n" if $hdr_level > 3; # left alone 1499 } 1500 1501 1502 #------------------------------------------------------------------------------- 1503 1504 sub text_target_tt 1505 { 1506 s#$target_tt#($text = $4) =~ s,_, ,go; " $text"; #eg; 1507 } 1508 1509 #------------------------------------------------------------------------------- 1510 1511 sub text_title 1512 { 1513 my $size; 1514 my $line = ""; 1515 my $lc = substr( $_, 2, 1 ); 1516 1517 #----------------------------------------------------------------- 1518 # Incoming text looks like ..= <title text> or ..- <subtitle text> 1519 #----------------------------------------------------------------- 1520 to_state( $FMT ); 1521 $_ = substr( $_, 4 ); 1522 text_target_tt(); 1523 $size = length( $_ ); 1524 1525 #------------------------------------------------- 1526 # Going to wrap titles with lines as long as title 1527 #------------------------------------------------- 1528 for( $size = length( $_ ); $size > 0; $size-- ) 1529 { 1530 $line="$line$lc"; 1531 } 1532 print CONVERT "$line\n$_\n$line\n"; 1533 } 1534 1535 sub text_underline_tt { replace_underlines( $underline_tt ) } 1536 1537 #------------------------------------------------------------------------------- 1538 # setext to HTML conversion call-back routines. 1539 # ( in alphabetical order ) 1540 #------------------------------------------------------------------------------- 1541 1542 sub html_bold_tt 1543 { 1544 #--------------------------------------- 1545 # Turn all "**text**" into "<B>text</B>" 1546 #--------------------------------------- 1547 s#$bold_tt#${lt}B${gt}$1${lt}/B${gt}$2#g; 1548 } 1549 1550 #------------------------------------------------------------------------------- 1551 1552 sub html_bullet_tt 1553 { 1554 s/$bullet_tt(.*)/ ${lt}li${gt}$1$2${lt}\/li${gt}/; 1555 } 1556 1557 #------------------------------------------------------------------------------- 1558 1559 sub html_emit_footer 1560 { 1561 print CONVERT "</P>\n$htmlFooter"; 1562 $closePgf = ""; 1563 } 1564 1565 #------------------------------------------------------------------------------- 1566 1567 sub html_emit_header 1568 { 1569 my $htitle = shift; 1570 my $header = $htmlHeader; 1571 1572 $header =~ s/\$HTML_TITLE/$htitle/o; 1573 print CONVERT $header; 1574 } 1575 1576 #------------------------------------------------------------------------------- 1577 1578 sub html_emit_line 1579 { 1580 print CONVERT "<LI>" if $atListStart == 1 and not /${lt}LI${gt}/o; 1581 $atListStart = 0; 1582 1583 if( /$passthru_tt/ ) 1584 { 1585 s/$passthru_tt//o; # remove typotag and pass line out as is. 1586 reclaim_escapes(); 1587 print CONVERT "$_\n" 1588 } 1589 else 1590 { 1591 print CONVERT &html_finishing( $_ ), "\n"; 1592 } 1593 } 1594 1595 #------------------------------------------------------------------------------- 1596 1597 sub html_enter_list { print CONVERT "<UL>\n" } # state change activities 1598 sub html_leave_list { print CONVERT "</UL>\n" } 1599 1600 sub html_enter_pre { print CONVERT "<PRE>\n"; $insideNoFormatArea = 1 } 1601 sub html_leave_pre { print CONVERT "</PRE>\n"; $insideNoFormatArea = 0 } 1602 1603 sub html_enter_quote { print CONVERT "<BLOCKQUOTE><PRE>\n"; $insideNoFormatArea = 1 } 1604 sub html_leave_quote { print CONVERT "</PRE></BLOCKQUOTE>\n"; $insideNoFormatArea = 0 } 1605 1606 #------------------------------------------------------------------------------- 1607 1608 sub html_final 1609 { 1610 &to_state( $FMT ); 1611 html_emit_footer(); 1612 1613 #---------------------------------------------------- 1614 # Report on all internal name references not used up. 1615 #---------------------------------------------------- 1616 if( scalar( @nm_ref ) > 0 ) 1617 { 1618 print STDERR "\nMissing reference (target-tt) to the following:\n\n"; 1619 for( $i=0; $i < scalar( @nm_ref ); $i++ ) 1620 { 1621 print STDERR " $nm_ref[ $i ]\n"; 1622 } 1623 } 1624 } 1625 1626 #------------------------------------------------------------------------------- 1627 1628 sub html_finishing { 1629 local($_) = @_; 1630 my $unt; 1631 s/\&/\&\#38\;/go; s/\</\&\#60\;/go; s/\>/\&\#62\;/go; 1632 s/$lt/</go; s/$gt/>/go; s/$amp/\&/go; # convert markers to real symbols 1633 1634 #----------------------------------------------- 1635 # This fixes the case where an untouchable 1636 # string includes these special html characters. 1637 #----------------------------------------------- 1638 foreach $element ( @untouchable ) 1639 { 1640 $element =~ s/\&/\&\#38\;/go; 1641 $element =~ s/\</\&\#60\;/go; 1642 $element =~ s/\>/\&\#62\;/go; 1643 } 1644 recover_extractions(); 1645 $_; 1646 } 1647 1648 #------------------------------------------------------------------------------- 1649 1650 sub html_hot_tt 1651 { 1652 #---------------------------------------------------- 1653 # After finding a hot-tt, substitute all underlines 1654 # with spaces and check to see if the hot-tt had 1655 # a corresponding hypertext reference. Flag it in 1656 # bright, bold red when no hypertext record found. 1657 # Allow user to define the variable HTML_DIR as the 1658 # destination directory for the HTML code. 1659 # Note, the files may have to actually be placed 1660 # in such directory by hand after they are generated. 1661 #---------------------------------------------------- 1662 s#$hot_tt# 1663 $h = $href{$1}; ($text = $1) =~ s,_, ,go; 1664 $h ? qq'${lt}A HREF="$variables{HTML_DIR}$h"${gt}$text${lt}/A${gt}' 1665 : "${lt}B${gt}${lt}font color=red${gt}--> $text <-- NO HREF!!${lt}/font${gt}${lt}/B${gt}"; #eg; 1666 } 1667 1668 #------------------------------------------------------------------------------- 1669 1670 sub html_indent { s/$indent_tt/$1/ } # get rid of indent-tt characters 1671 1672 #------------------------------------------------------------------------------- 1673 1674 sub html_init 1675 { 1676 local $title, $aTitle; 1677 my $target; 1678 1679 %state_change = ( 1680 1681 enter_list => "html_enter_list", 1682 leave_list => "html_leave_list", 1683 1684 enter_pre => "html_enter_pre", 1685 leave_pre => "html_leave_pre", 1686 1687 enter_quote => "html_enter_quote", 1688 leave_quote => "html_leave_quote", 1689 ); 1690 1691 $veryFirstTime = 1; # used to force table of content header out 1692 1693 #------------------------------------------ 1694 # Make a first pass over the data, looking 1695 # for hypertext linking information. 1696 #------------------------------------------ 1697 for ($i = 0; $i <= $#data; $i++) 1698 { 1699 $_ = $data[$i]; # $_ is default for searches 1700 1701 #--------------------------------------------------------- 1702 # This will pick out targets found in the setext not 1703 # hidden by a suppress-tt, that is, the href-tt below. 1704 # With this check, it is unnecessary to have to include 1705 # the href-tt which uses identical text for internal 1706 # document references. External references need href-tt. 1707 # Have to make sure the match does not pick up elements 1708 # inside a notouch-tt ( eg. `_do_not_want_this_as_target`) 1709 #--------------------------------------------------------- 1710 if( /$target_tt/ && substr($`,length($`)-1,1) ne "`" && 1711 (not /$suppress_tt/) ) 1712 { 1713 $href{ $4 } = "$intHrefMrk$4"; 1714 push @nm_ref, $4; 1715 } 1716 1717 #------------------------------------------------- 1718 # Locate HREF's and save. When no target is given, 1719 # assume the target is internal, with same name. 1720 #------------------------------------------------- 1721 if( /$href_tt/ ) 1722 { 1723 $hrefID = $1; 1724 $target = ($2) ? $2 : "$intHrefMrk$hrefID"; # assume internal href. 1725 $href{$hrefID} = $2; 1726 1727 #------------------------------ 1728 # Remember internal HREF's not 1729 # already seen for target-tt. 1730 #------------------------------ 1731 if( $target =~ /$internal_href/ ) { 1732 if( not is_member( substr( $target, 1), \@nm_ref ) ) { 1733 push @nm_ref, $1; 1734 } 1735 } 1736 next; 1737 } 1738 1739 #--------------------------------------------------------- 1740 # The first title-tt or subhead-tt gets <TITLE>...</TITLE> 1741 #--------------------------------------------------------- 1742 /$title_tt/ && do { $htmlTitle = html_init_title("H1", $i); next; }; 1743 /$subtitle_tt/ && do { $htmlTitle = html_init_title("H2", $i); next; }; 1744 } 1745 1746 html_emit_header( $htmlTitle ); 1747 1748 #---------------------------------------------------- 1749 # NOTE: changing original title-tt search pattern 1750 # to match what was done in html_init_title. 1751 #---------------------------------------------------- 1752 $title_tt = "^\\.\\.\\s+(<H.>)(.*)(<\\/H.>)"; 1753 } 1754 1755 #------------------------------------------------------------------------------- 1756 1757 sub html_init_title 1758 { 1759 local($head, $i) = @_; 1760 my $hyper_ref; 1761 1762 $data[$i--] = ".."; # suppress title indicator ( --- or === ) 1763 $data[$i] =~ s/^\s*//; # get rid of any leading space in actual title 1764 $this_title = $data[$i]; 1765 1766 # Have to fix title if it also happens to be a target-tt. 1767 $this_title =~ /$target_tt/ && do { ($tmp = $4) =~ s,_, ,go; $this_title = $tmp }; 1768 1769 #--------------------------------------------------- 1770 # Are all titles automatically considered target-tt? 1771 #--------------------------------------------------- 1772 if( $make_title_href ) 1773 { 1774 $hyper_ref = $this_title; 1775 $hyper_ref =~ s/ /_/go; 1776 $externalReference = 1777 ($separate_html_files) ? substr("$MenuNames{ $hyper_ref }.$htmlExt", 1) : ""; 1778 1779 $href{ $hyper_ref } ="$externalReference$intHrefMrk$hyper_ref"; 1780 1781 #------------------------------ 1782 # Remember internal HREF's not 1783 # already seen for target-tt. 1784 #------------------------------ 1785 if( not is_member( $hyper_ref, \@nm_ref ) ) { 1786 push @nm_ref, $hyper_ref; 1787 } 1788 } 1789 1790 #----------------------------------------------------------------- 1791 # Put out the HTML title and then suppress it for later processing 1792 #----------------------------------------------------------------- 1793 $aTitle = "$this_title" unless $title++; 1794 $data[$i] = ".. <$head> " . $data[$i] . " </$head>"; 1795 1796 return $aTitle; 1797 } 1798 1799 #------------------------------------------------------------------------------- 1800 1801 sub html_italic_tt 1802 { 1803 #--------------------------------------- 1804 # Turn all "~text~" into "<I>text</I>" 1805 #--------------------------------------- 1806 s#$italic_tt#${lt}I${gt}$1${lt}/I${gt}#g; 1807 } 1808 1809 #------------------------------------------------------------------------------- 1810 1811 sub html_line_break 1812 { 1813 my $fold = shift; 1814 1815 print CONVERT "$closePgf<P>\n" unless $fold++; 1816 $closePgf = "</P>"; 1817 return $fold; 1818 } 1819 1820 #------------------------------------------------------------------------------- 1821 1822 sub html_line_tt 1823 { 1824 if( not $insideNoFormatArea ) 1825 { 1826 s/$line_tt/${lt}P${gt}${lt}HR${gt}/; 1827 print CONVERT html_finishing( $_ ), "\n"; 1828 } 1829 } 1830 1831 #------------------------------------------------------------------------------- 1832 1833 sub html_list_tt 1834 { 1835 if( /$list_tt/o ) 1836 { 1837 if ( $1 eq '(' ) # open list level 1838 { 1839 $list_level++; 1840 s/$list_tt/${lt}UL${gt}${lt}LI${gt}/; 1841 } 1842 else # close list level 1843 { 1844 $list_level--; 1845 s,$list_tt,${lt}/LI${gt}${lt}/UL${gt},; 1846 $atListStart = 2 if $list_level; 1847 $terminatedList = 1; 1848 } 1849 } 1850 1851 #----------------------------------------------------- 1852 # An empty line terminates a multiple line list entry. 1853 #----------------------------------------------------- 1854 elsif( /$empty_line/o ) 1855 { 1856 print CONVERT "</LI>\n" unless $terminatedList; 1857 print CONVERT "</P><P>\n"; 1858 $atListStart = 1 if $list_level; 1859 $terminatedList = 0; 1860 } 1861 } 1862 1863 #------------------------------------------------------------------------------- 1864 1865 sub html_quote_tt 1866 { 1867 s/$quote_tt\s*//; 1868 } 1869 1870 #------------------------------------------------------------------------------- 1871 1872 sub html_section_tt 1873 { 1874 my $hdr_level = shift; 1875 1876 print CONVERT "<H$_</H$hdr_level>\n"; 1877 } 1878 1879 #------------------------------------------------------------------------------- 1880 1881 sub html_target_tt 1882 { 1883 check_target_reference( $_ ); 1884 /$target_tt/ && do { ($a = $4) =~ s,_, ,go; s/$target_tt/ $a/; }; 1885 } 1886 1887 #------------------------------------------------------------------------------- 1888 1889 sub html_title 1890 { 1891 my $titleHolder = $_; 1892 1893 to_state( $FMT ); 1894 /$target_tt/ && do { ($a = $4) =~ s,_, ,go; s/$target_tt/$a/; }; 1895 1896 if( /$title_tt/i ) # this is the new title-tt from html_init 1897 { 1898 $frontMrk = $1; $thisTitle = $2; $backMrk = $3; 1899 1900 if( not $separate_html_files or $veryFirstTime ) 1901 { 1902 check_target_reference( $titleHolder ); 1903 print CONVERT $frontMrk, &html_finishing($thisTitle), $backMrk, "\n"; 1904 $veryFirstTime = 0; 1905 } 1906 elsif( $frontMrk eq "<H1>" ) 1907 { 1908 $savedTitle = $thisTitle; 1909 $savedTitleHolder = $titleHolder; 1910 } 1911 else 1912 { 1913 #-------------------------- 1914 # Create another HTML file? 1915 #-------------------------- 1916 $hyper_ref = $thisTitle; 1917 $hyper_ref =~ s/$trim_spaces/$2/o; 1918 $hyper_ref =~ s/ /_/go; 1919 $association = $MenuNames{ $hyper_ref }; 1920 1921 if( $association ne "" ) 1922 { 1923 $assocLevel = substr( $association, 0, 1 ); 1924 $association = substr( $association, 1 ); 1925 $newFile = "$outputDirectory$association.$htmlExt"; 1926 1927 if( $converted_file ne $newFile ) 1928 { 1929 #----------------------------- 1930 # Finish off the current file. 1931 #----------------------------- 1932 html_emit_footer(); 1933 close CONVERT; 1934 1935 #----------------------------------------------------- 1936 # This realigns title after nested sublevels complete. 1937 #----------------------------------------------------- 1938 if ( $assocLevel == 0 ) { 1939 $savedTitle = $thisTitle; 1940 } 1941 1942 $converted_file = $newFile; 1943 open CONVERT, ">$converted_file" or die "Can't create $converted_file, $OS_ERROR"; 1944 html_emit_header( $savedTitle ); 1945 1946 #-------------------------------------------- 1947 # This puts target reference in correct file. 1948 #-------------------------------------------- 1949 if( $savedTitleHolder ) 1950 { 1951 check_target_reference( $savedTitleHolder ); 1952 if( $savedTitleHolder =~ /$title_tt/i ) 1953 { 1954 print CONVERT $1, &html_finishing($2), $3, "\n"; 1955 } 1956 $savedTitleHolder = ""; 1957 } 1958 } 1959 } 1960 1961 check_target_reference( $titleHolder ); 1962 print CONVERT $frontMrk, &html_finishing($thisTitle), $backMrk, "\n"; 1963 } 1964 } 1965 } 1966 1967 #------------------------------------------------------------------------------- 1968 1969 sub html_underline_tt 1970 { 1971 #-------------------------------------------- 1972 # Turn all "_text_" into "<I><U>text</U></I>" 1973 # Remembering to substitute intervening 1974 # underlines with spaces. 1975 #-------------------------------------------- 1976 s#$underline_tt# 1977 ($text = $1) =~ s,_, ,go; 1978 "${lt}I${gt}${lt}U${gt}$text${lt}/U${gt}${lt}/I${gt}"; #eg; 1979 } 1980 1981 #------------------------------------------------------------------------------- 1982 # setext to NEdit HELP conversion call-back routines. 1983 # ( in alphabetical order ) 1984 #------------------------------------------------------------------------------- 1985 1986 sub help_bold_tt 1987 { 1988 #---------------------------------------------------- 1989 # Turn all "**text**" into "<stlMrk_B>text<stlMrk_B>" 1990 #---------------------------------------------------- 1991 s#$bold_tt#${stlMrk}$TKN_BOLD$1${stlMrk}$TKN_BOLD$2#g; 1992 } 1993 1994 #------------------------------------------------------------------------------- 1995 1996 sub help_bullet_tt { s/$bullet_tt/ * $1/ } 1997 1998 #------------------------------------------------------------------------------- 1999 2000 sub help_emit_line 2001 { 2002 #------------------------------------------------------ 2003 # The following is here to help us generate conditional 2004 # compilation elements for the 'C' compiler. 2005 #------------------------------------------------------ 2006 if( /$passthru_tt/ ) 2007 { 2008 s/$passthru_tt//o; # remove typotag and pass line out as is. 2009 reclaim_escapes(); 2010 print HELP "$_\n" 2011 } 2012 else 2013 { 2014 #------------------------------------------------- 2015 # This seems to be the only good place to take 2016 # care of style changes that have occurred between 2017 # usage of proportional and fixed font styles. 2018 #------------------------------------------------- 2019 if( $styleChanged ) 2020 { 2021 $_ = $styleMark . get_style_name( $crntStyle ) . $_; 2022 $styleChanged = ""; 2023 } 2024 2025 my $finishedLine = help_finishing( $_ ); 2026 2027 print HELP "\"", $finishedLine, "\",\n"; 2028 2029 #---------------------------------------------------------------- 2030 # To minimize newline output for the empty line elements, 2031 # the algorithm remembers if its last line had a newline emitted. 2032 #---------------------------------------------------------------- 2033 $newLinePresentInLastLine = $finishedLine =~ /\\n$/; 2034 } 2035 } 2036 2037 #------------------------------------------------------------------------------- 2038 2039 sub help_final {} 2040 2041 #------------------------------------------------------------------------------- 2042 2043 sub help_finishing 2044 { 2045 local($_) = @_; 2046 2047 #---------------------------- 2048 # When finishing a heading... 2049 #---------------------------- 2050 if( $headingLevel ) 2051 { 2052 #-------------------------------------------------- 2053 # ... destroy any styles inadvertantly placed there 2054 #-------------------------------------------------- 2055 if( /$stlMrk/o ) 2056 { 2057 my @line = split $stlMrk; 2058 $_ = join '', @line; 2059 } 2060 2061 #------------------------------------ 2062 # ... because only one style allowed. 2063 #------------------------------------ 2064 $stlFront = $styleMark . get_style_name( "" ); 2065 $headingLevel = 0; 2066 $stlEnd = $styleMark . get_style_name( $initialStyle ); 2067 $stlFront = "" if /^$styleToken/ ; # remove redundancy when present 2068 $_ = $stlFront . $_ .$stlEnd; 2069 } 2070 2071 #--------------------------------------------- 2072 # Any style markers found in the current line? 2073 #--------------------------------------------- 2074 elsif( /$stlMrk/ ) 2075 { 2076 #---------------------------------------- 2077 # Break line up into style word elements. 2078 #---------------------------------------- 2079 my $line = ""; 2080 my @line = split $stlMrk; 2081 2082 foreach $element ( @line ) 2083 { 2084 #-------------------------------------------------- 2085 # Extract word emphasis token and associated words. 2086 # Embed style marker into text line. 2087 #-------------------------------------------------- 2088 $element =~ /^($aStyleToken)?(.*)$/o && do { 2089 2090 $token = ($1) ? $1 : $TKN_TEXT; # $TKN_xxx 2091 $words = $2; 2092 my $nextStyle = get_style( $crntStyle, $token ); 2093 2094 if( $crntStyle eq $nextStyle ) 2095 { 2096 $line .= $words; 2097 } 2098 else 2099 { 2100 $stlNm = get_style_name( $nextStyle ); 2101 $line .= "$styleMark$stlNm$words"; 2102 $crntStyle = $nextStyle; 2103 } 2104 }; 2105 } 2106 2107 $_ = $line; 2108 } 2109 2110 recover_extractions(); 2111 fix_target_tt(); 2112 2113 #------------------------------------------- 2114 # Apply any initial style change introduced. 2115 #------------------------------------------- 2116 $_ = $newLeadStyle . $_; 2117 $newLeadStyle = ""; 2118 2119 #---------------------------------------------------------------- 2120 # Add newline element to all lines which are not being currently 2121 # formatted into a flowing paragraph. It is done here because the 2122 # character also has to get included in the character counts. 2123 #---------------------------------------------------------------- 2124 $_ .= get_newline( 1 ) if $crnt_state ne $FMT; 2125 2126 #---------------------------------------------------------------------- 2127 # Since 2 characters (\ and n) are occupying the space of one newline, 2128 # we need to subract out the number of new lines from the total offset. 2129 #---------------------------------------------------------------------- 2130 my $styleCount = count( $styleToken, $_ ); 2131 my $newLineCount = count( "\\\\n", $_ ); 2132 my $quoteCount = count( '"', $_ ); 2133 my $backslashCount = count( "\\\\", $_ ) - $styleCount - 2134 $newLineCount - $quoteCount; 2135 2136 my $adjustment = ($styleCount * $styleTokenSize) + 2137 ($backslashCount / 2) + $newLineCount + $quoteCount; 2138 2139 #----------------------------------------------------------- 2140 # Now keep a running total of how many characters to emit. 2141 # (Keep 2 forms, total number for compiler string length 2142 # considerations, and another for target-tt section offsets. 2143 #----------------------------------------------------------- 2144 $sectionCharacterCnt += length( $_ ); 2145 $targetOffset += length( $_ ) - $adjustment; 2146 2147 $_; 2148 } 2149 2150 #------------------------------------------------------------------------------- 2151 2152 sub help_fixed_styles 2153 { 2154 #---------------------------------------------------------------- 2155 # All proportional styles in the style state transition table 2156 # begin with the "_" character. If we are already in the 2157 # proportional styles arena, a link, or header, no change occurs. 2158 #---------------------------------------------------------------- 2159 if( $crntStyle =~ /^_/ ) 2160 { 2161 $crntStyle =~ s/^_//o; 2162 $styleChanged = $crntStyle unless $styleChanged; 2163 } 2164 } 2165 2166 #------------------------------------------------------------------------------- 2167 2168 sub help_hot_tt 2169 { 2170 my ( $text, $stlNm, $h ); 2171 2172 #-------------------------------------------------- 2173 # After finding a hot-tt, substitute all underlines 2174 # with spaces and check to see if the hot-tt had 2175 # a corresponding hypertext reference. Make it 2176 # unadorned text when no reference found. 2177 #-------------------------------------------------- 2178 s#$hot_tt# 2179 ($text = $1) =~ s,_, ,go; 2180 $h = is_known_link( $text ); 2181 $stlNm = get_style_name( $crntStyle ); 2182 2183 $h ? "$stlMrk$TKN_LINK$text$stlMrk$TKN_LINK" 2184 : $text; 2185 #eg; 2186 } 2187 2188 #------------------------------------------------------------------------------- 2189 2190 sub help_indent 2191 { 2192 if( /$indent_tt/ ) 2193 { 2194 s/$indent_tt/$1/; # get rid of indent-tt characters 2195 /\S$/ && do { $_ .= ' ' }; # make sure space available for remaining 2196 } # text in this kind of paragraph 2197 } 2198 2199 #------------------------------------------------------------------------------- 2200 2201 sub help_init 2202 { 2203 %state_change = ( 2204 2205 enter_pre => "help_fixed_styles", 2206 leave_pre => "help_proportional_styles", 2207 2208 enter_quote => "help_fixed_styles", 2209 leave_quote => "help_proportional_styles", 2210 ); 2211 2212 #-------------------------------------------- 2213 # Global elements needed for making menu code 2214 #-------------------------------------------- 2215 %href = (); 2216 2217 $copy_right_holder = "Mark Edel"; 2218 $hlptxt = "help_data$helpSuffix.h"; # name of file holding help data structures 2219 $hlphdr = "help_topic$helpSuffix.h"; # name of file holding help definitions 2220 $stlMrk = "\01"; # this is the character code 2221 $styleMark = '\01'; # this is the text string 2222 $styleToken = "\\$styleMark"; # this for splitting strings on styleMark 2223 $styleTokenSize = length( $styleToken ); # accounts for '\01A' 2224 $illegal_help = "HELP_none"; 2225 2226 $menu_record = "(.),(.*),(.*),(\\d)"; 2227 $tgtIndx = 0; # target-tt index for hypertext reference array (@href) 2228 2229 #------------------------------------------------------------------- 2230 # The following data is used to embed style data into the help text. 2231 #------------------------------------------------------------------- 2232 2233 # TOKENS => text bold italic underline 2234 %styles_stt = ( 2235 2236 # fixed font styles 2237 2238 plain => { style => "A", states => [ "plain", "bold", "italic", "u_plain" ] }, 2239 bold => { style => "B", states => [ "bold", "plain", "b_ital", "u_bold" ] }, 2240 italic => { style => "C", states => [ "italic", "b_ital", "plain", "u_italic" ] }, 2241 b_ital => { style => "D", states => [ "b_ital", "italic", "bold", "u_b_ital" ] }, 2242 2243 u_plain => { style => "E", states => [ "u_plain", "u_bold", "u_italic", "plain" ] }, 2244 u_bold => { style => "F", states => [ "u_bold", "u_plain", "u_b_ital", "bold" ] }, 2245 u_italic => { style => "G", states => [ "u_italic", "u_b_ital", "u_plain", "italic" ] }, 2246 u_b_ital => { style => "H", states => [ "u_b_ital", "u_italic", "u_bold", "bold_ital" ] }, 2247 2248 # proportional font styles 2249 2250 _plain => { style => "I", states => [ "_plain", "_bold", "_italic", "_u_plain" ] }, 2251 _bold => { style => "J", states => [ "_bold", "_plain", "_b_ital", "_u_bold" ] }, 2252 _italic => { style => "K", states => [ "_italic", "_b_ital", "_plain", "_u_italic" ] }, 2253 _b_ital => { style => "L", states => [ "_b_ital", "_italic", "_bold", "_u_b_ital" ] }, 2254 2255 _u_plain => { style => "M", states => [ "_u_plain", "_u_bold", "_u_italic", "_plain" ] }, 2256 _u_bold => { style => "N", states => [ "_u_bold", "_u_plain", "_u_b_ital", "_bold" ] }, 2257 _u_italic => { style => "O", states => [ "_u_italic", "_u_b_ital", "_u_plain", "_italic" ] }, 2258 _u_b_ital => { style => "P", states => [ "_u_b_ital", "_u_italic", "_u_bold", "_bold_ital" ] }, 2259 2260 # hyperLink style => "Q", 2261 2262 # header1 style => "R", -- 2263 # header2 style => "S", |_ MAX_HEADER 2264 # header3 style => "T", -- 2265 ); 2266 2267 #----------------------------------------------------------- 2268 # The link index is the position in a font style table 2269 # where the linking font will reside. It appears immediately 2270 # after the styles from the table above. 2271 #----------------------------------------------------------- 2272 $linkIndex = scalar( keys %styles_stt ); 2273 $maxTokens = scalar( @{ $styles_stt{plain}{states} } ); 2274 2275 $STYLE_PLAIN = $styles_stt{plain}{style}; 2276 $STYLE_LINK = "Q"; # link style marker, a continuation from style table 2277 $STYLE_HDR = "R"; # beginning of header style markers 2278 $MAX_HEADER = 3; # the maximum number of header styles in use 2279 2280 $TKN_TEXT = 0; # used in style state transition, order important 2281 $TKN_BOLD = 1; # used in style state transition, order important 2282 $TKN_ITALIC = 2; # used in style state transition, order important 2283 $TKN_ULINE = 3; # used in style state transition, order important 2284 $TKN_LINK = 4; 2285 2286 $aStyleToken = "[$TKN_TEXT$TKN_BOLD$TKN_ITALIC$TKN_ULINE$TKN_LINK]"; 2287 2288 $initialStyle = "_plain"; # the initial style for help text. 2289 $crntStyle = $initialStyle; 2290 $headingLevel = 0; 2291 2292 print_menu( $crntMenu, "" ) if $print_menu; # sort of debug info 2293 2294 #---------------------------------- 2295 # Create help header (help_topic.h) 2296 #---------------------------------- 2297 open HLPHDR, ">$hlphdr" or die "Can't create $hlphdr, $OS_ERROR"; 2298 emit_help_header( HLPHDR, $crntMenu ); 2299 close HLPHDR; 2300 2301 #------------------------------------------- 2302 # Create help text data header (help_data.h) 2303 #------------------------------------------- 2304 open HELP, ">$hlptxt" or die "Can't create $hlptxt, $OS_ERROR"; 2305 emit_helpTitles( HELP, $crntMenu ); 2306 2307 collect_internal_hypertext_references( \@data ); 2308 $whence = 0; 2309 emit_helpText( HELP, $crntMenu, \@data ); 2310 } 2311 2312 #------------------------------------------------------------------------------- 2313 2314 sub help_italic_tt 2315 { 2316 s/$italic_tt/${stlMrk}$TKN_ITALIC$1${stlMrk}$TKN_ITALIC/g 2317 } 2318 2319 #------------------------------------------------------------------------------- 2320 2321 sub help_line_break 2322 { 2323 my $fold = shift; 2324 $_ .= get_newline( 2 ); 2325 help_emit_line() unless $fold++; 2326 return $fold; 2327 } 2328 2329 #------------------------------------------------------------------------------- 2330 2331 sub help_line_tt {} 2332 sub help_list_tt { text_list_tt() } 2333 sub help_quote_tt {} 2334 2335 #------------------------------------------------------------------------------- 2336 2337 sub help_proportional_styles 2338 { 2339 #---------------------------------------------------------------- 2340 # All proportional styles in the style state transition table 2341 # begin with the "_" character. If we are already in the 2342 # proportional styles arena, a link, or header, no change occurs. 2343 #---------------------------------------------------------------- 2344 unless( $crntStyle =~ /^_/ or 2345 $crntStyle eq "link" or 2346 $crntStyle eq "header" ) { 2347 2348 $crntStyle = "_$crntStyle"; 2349 $newLeadStyle = $styleMark . get_style_name( $crntStyle ); 2350 } 2351 } 2352 2353 #------------------------------------------------------------------------------- 2354 2355 sub help_section_tt 2356 { 2357 $headingLevel = shift; 2358 #---------------------------------------------------------- 2359 # Heading levels for sectioning are being required to start 2360 # at level 3 (considered the first level). This keeps the 2361 # X-resources down inside NEdit. So here is the mapping. 2362 # 1> level-1 2363 # 2> level-1 2364 # 3> level-1 2365 # 4> level-2 2366 # 5> level-3 2367 #---------------------------------------------------------- 2368 $headingLevel = ($headingLevel > 2 ) ? $headingLevel - 2 : 1; 2369 $headingLevel = $MAX_HEADER if $headingLevel > $MAX_HEADER; # 2370 s/$section_tt//; 2371 &help_emit_line; 2372 $crntStyle = $initialStyle; 2373 2374 } 2375 2376 #------------------------------------------------------------------------------- 2377 2378 sub help_target_tt { } # cannot process target-tt at this time because 2379 # calculation of the hypertext offset requires 2380 # a fully expanded text line (see help_finishing). 2381 2382 sub fix_target_tt 2383 { 2384 if( /$target_tt/ and exists $href{ $4 } ) 2385 { 2386 my ( $text, $tgtOffset, $originalLine ); 2387 2388 #--------------------------------------------------- 2389 # Have to compute target's offset into help section. 2390 # Need actual text sans styling information. Assuming 2391 # all other text replacement has already occurred. 2392 #--------------------------------------------------- 2393 $originalLine = $_; 2394 2395 s/$styleToken.//g; # remove all styling markers 2396 2397 #-------------------------------------------------------- 2398 # Inside this special substitution, a computation of the 2399 # target's offset from the beginning of the section is 2400 # being computed and applied to the hyper-reference array 2401 # element which will be emitted after all text sections 2402 # have been processed. 2403 #-------------------------------------------------------- 2404 s#$target_tt# 2405 ($text = $4) =~ s,_, ,go; 2406 $tgtOffset = index( $_, $text ) + $targetOffset -1; 2407 $tgtOffset = sprintf( "%6d", $tgtOffset ); 2408 $href[ $tgtIndx++ ] =~ s /^0/$tgtOffset/o; 2409 " $text"; 2410 #eg; 2411 2412 #------------------------------------------------------- 2413 # Now fix hyper-references in actual line to be emitted. 2414 #------------------------------------------------------- 2415 $_ = $originalLine; 2416 2417 s#$target_tt# 2418 ($text = $4) =~ s,_, ,go; 2419 " $text"; 2420 #eg; 2421 } 2422 } 2423 2424 #------------------------------------------------------------------------------- 2425 2426 sub help_title {&help_emit_line} 2427 2428 #------------------------------------------------------------------------------- 2429 2430 sub help_underline_tt 2431 { 2432 #-------------------------------------------------- 2433 # Turn all "_text_" into "<stlMrk_U>text<stlMrk_U>" 2434 # Remembering to substitute intervening 2435 # underlines with spaces. 2436 #-------------------------------------------------- 2437 s#$underline_tt# 2438 ($text = $1) =~ s,_, ,go; 2439 "${stlMrk}$TKN_ULINE$text${stlMrk}$TKN_ULINE"; 2440 #eg; 2441 } 2442 2443 #------------------------------------------------------------------------------- 2444 2445 sub get_newline 2446 { 2447 $howMany = shift; 2448 2449 $howMany-- if $newLinePresentInLastLine && $howMany > 1; 2450 return '\n' x $howMany; 2451 } 2452 2453 #------------------------------------------------------------------------------- 2454 2455 sub is_known_link 2456 { 2457 my $linkName = shift; 2458 2459 for( $index = 0; $index < scalar( @hot_tt_links ); $index++ ) 2460 { 2461 $element = $hot_tt_links[ $index ]; 2462 return 1 if( $hot_tt_links[ $index ] eq $linkName ); 2463 } 2464 2465 return 0; 2466 } 2467 2468 #------------------------------------------------------------------------------- 2469 2470 sub get_style 2471 { 2472 my $crntStyle = shift; # plain, bold, italic, etc. 2473 my $token = shift; # $TKN_xxx 2474 my $style = "header"; # assume working on header 2475 2476 if( $headingLevel == 0 ) 2477 { 2478 if( $token == $TKN_LINK ) 2479 { 2480 if( $crntStyle eq "link" ) 2481 { 2482 $style = $prevStyle; 2483 } 2484 else 2485 { 2486 $prevStyle = $crntStyle; 2487 $style = "link"; 2488 } 2489 } 2490 else 2491 { 2492 @transitions = @{ $styles_stt{$crntStyle}{states} }; 2493 $style = $transitions[ $token ]; 2494 } 2495 } 2496 2497 return $style; 2498 } 2499 2500 #------------------------------------------------------------------------------- 2501 2502 sub get_style_name 2503 { 2504 my $crntStyle = shift; # plain, bold, italic, etc. 2505 my $styleName; 2506 2507 if( $headingLevel ) 2508 { 2509 $styleName = chr(ord( $STYLE_HDR )+$headingLevel-1); 2510 } 2511 elsif( $crntStyle eq "link" ) 2512 { 2513 $styleName = $STYLE_LINK; 2514 } 2515 else 2516 { 2517 $styleName = $styles_stt{$crntStyle}{style}; 2518 } 2519 2520 return $styleName; 2521 } 2522 2523 #------------------------------------------------------------------------------- 2524 2525 sub get_menu_item 2526 { 2527 my $setext = shift; 2528 my $line = shift; 2529 2530 2531 while( $$line < scalar( @$setext ) ) 2532 { 2533 $_ = $$setext[ $$line++ ]; 2534 return $_ if s/$menu_element//o; 2535 return "$_, $help_code" if s/$help_element//o; 2536 } 2537 2538 return ""; 2539 } 2540 2541 #------------------------------------------------------------------------------- 2542 2543 sub print_menu 2544 { 2545 my $crnt_menu = shift; 2546 my $indent = shift; 2547 my ( $menuTitle, $mneumonic, $helpName, $hideit, $type ); 2548 2549 foreach $menuItem ( @$crnt_menu ) 2550 { 2551 if ( $menuItem =~ /$menu_record/o ) 2552 { $mneumonic=$1; $menuTitle=$2; $helpName=$3; $hideit=($4) ? $4 : "" } 2553 2554 if( $hideit eq $help_code ) { 2555 $hideit = ""; 2556 $type = "Help" 2557 } 2558 else { 2559 $hideit = ", ($hideit)" if $hideit; 2560 $type = "Menu" 2561 } 2562 2563 print "$type: $indent$mneumonic, $menuTitle [$helpName]$hideit\n"; 2564 2565 if( $menuItem =~ /$subMenuIndicator/o ) 2566 { 2567 ($menu = $menuTitle) =~ s/ /_/og; 2568 print_menu( \@$menu, "$indent " ); 2569 } 2570 } 2571 } 2572 2573 #------------------------------------------------------------------------------- 2574 2575 sub collect_internal_hypertext_references 2576 { 2577 my $setext = shift; 2578 my $line = 0; 2579 my ($source, $destination ); 2580 2581 while( $line < scalar( @$setext ) ) 2582 { 2583 $_ = $$setext[ $line++ ]; 2584 2585 if( /$href_tt/o ) 2586 { 2587 $source = $1; 2588 $destination = $2; 2589 if( $destination =~ /$internal_href/ ) 2590 { 2591 $href{ $1 } = $source; 2592 } 2593 } 2594 } 2595 } 2596 2597 #------------------------------------------------------------------------------- 2598 2599 sub emit_helpText 2600 { 2601 my $stream = shift; 2602 my $crnt_menu = shift; 2603 my $setext = shift; 2604 my $line = 0; 2605 my $index = 1; 2606 2607 $helpNameList = ""; 2608 2609 emit_help_menu_text( $setext, $stream, $crnt_menu, \$line ); 2610 2611 print $stream "static char **HelpText[] = {\n$helpNameList\n};\n\n"; 2612 2613 print $stream "HelpMenu H_M [] =\n{\n"; 2614 emit_help_menu( $stream, $crnt_menu, 0, 1 ); 2615 print $stream "\n};\n"; 2616 2617 #------------------------------------ 2618 # Emit internal hypertext references. 2619 #------------------------------------ 2620 print $stream "\nHref H_R [] =\n{\n"; 2621 $sep = ""; 2622 for ($index = 0; $index < scalar(@href); $index++) 2623 { 2624 $element = $href[$index]; 2625 $nextone = ($index == $#href) ? "NULL, " : "&H_R[%2d],"; 2626 printf $stream "$sep {$nextone$element}", $index+1; 2627 $sep = ",\n" 2628 } 2629 print $stream "\n};\n"; 2630 2631 #----------------------------- 2632 # Emit program version string. 2633 #----------------------------- 2634 $pgmVersion = $variables{ version }; 2635 $pgmVersion .= '\n' . date() if $pgmVersion !~ /$neditDefaultMarker/ and $pgmVersion !~ /XNEdit rev /; 2636 print $stream "\nstatic const char * NEditVersion = \"$pgmVersion\\n\";\n"; 2637 } 2638 2639 #------------------------------------------------------------------------------- 2640 2641 sub emit_help_menu_text 2642 { 2643 my $setext = shift; 2644 my $stream = shift; 2645 my $crnt_menu = shift; 2646 my $line = shift; 2647 2648 my ( $menuTitle, $mneumonic, $helpName, $prevLine ); 2649 2650 #---------------------------------------- 2651 # For every node of the menu tree... 2652 #---------------------------------------- 2653 foreach $menuItem ( @$crnt_menu ) 2654 { 2655 if ( $menuItem =~ /$menu_record/ ) 2656 { $mneumonic=$1; $helpName=$3; ($menuTitle=$2) =~ s/_//; } 2657 2658 #--------------------------------- 2659 # ... recursively expand sub-menus 2660 #--------------------------------- 2661 if( $menuItem =~ /$subMenuIndicator/ ) 2662 { 2663 ($menu = $menuTitle) =~ s/ /_/g; 2664 emit_help_menu_text( $setext, $stream, \@$menu, $line ); 2665 } 2666 2667 elsif( $mneumonic ne $separator ) # ... and not a menu separator 2668 { 2669 locate_menu_text( $setext, $menuTitle, $line ) 2670 or die "Unable to find \"$menuTitle\" text!"; 2671 2672 $remainder = ""; 2673 my @section = (); 2674 my $lineNbr = 0; 2675 $s_e_p = ($helpNameList) ? ",\n" : ""; 2676 $helpNameList .= $s_e_p . " htxt_$helpName"; 2677 $sectionCharacterCnt = 0; 2678 $targetOffset = 0; 2679 2680 #------------------------ 2681 # ... emit help menu text 2682 #------------------------ 2683 while( 1 ) 2684 { 2685 ($_,$remainder) = get_menu_text( $setext, $remainder, $line ); 2686 2687 last if $_ eq ""; 2688 $lineNbr++; 2689 next if /$empty_line/ and $lineNbr == 1; 2690 chomp; 2691 2692 #-------------------------------------------------- 2693 # Save all hypertext targets found in current topic 2694 #-------------------------------------------------- 2695 if( /$target_tt/ and exists $href{ $4 } ) 2696 { 2697 $target = $4; 2698 $href = $href{$target}; 2699 $href =~ s/_/ /go; 2700 $target =~ s/_/ /go; 2701 $topic = "HELP_\U$helpName,"; 2702 $nl1 = $name_length; # for HELP_ and comma 2703 2704 push @href, sprintf("0, %-${nl1}.${nl1}s \"$href\"", $topic); 2705 push @hot_tt_links, $href; # collect for later verification. 2706 } 2707 2708 s/\\/\\\\/go; # escape backslash any where in text 2709 s/"/\\"/go; # escape embedded double quotes 2710 s/^\s*$//; # redefine whitespace as empty line 2711 2712 push @section, $_ ; 2713 } 2714 print $stream "static char * htxt_$helpName [] = {\n"; 2715 $styleChanged = $initialStyle; # This forces initial style out 2716 $crntStyle = $initialStyle; 2717 parse_setext( \@section ); 2718 print $stream "NULL\n};\n\n"; 2719 } 2720 } 2721 } 2722 2723 #------------------------------------------------------------------------------- 2724 2725 sub locate_menu_text 2726 { 2727 my $setext = shift; 2728 my $menuTitle = shift; 2729 my $line = shift; 2730 2731 $menuTitle =~ s/_//go; # removing drop key character markers 2732 $menuTitle =~ s/ /./go; # spaces could be underlines in titles 2733 $menuTitle =~ s/\(/./go; # parens are special in regex searches... 2734 $menuTitle =~ s/\)/./go; # ... here they should be ignored 2735 2736 #----------------------------------------------------- 2737 # When the whence value is set to zero, the search 2738 # for the text that belongs with the given menu title 2739 # is started at the beginning of the file. This allows 2740 # the menu text to be in an order other than that 2741 # specified by the menu itself. This gives freedom 2742 # to the writer; inefficiency to the text processing. 2743 #----------------------------------------------------- 2744 $$line = 0 if ( $whence != 1 ); 2745 2746 while( $$line < scalar( @$setext ) ) 2747 { 2748 if( $$setext[ $$line++ ] =~ /$menuTitle/ ) 2749 { 2750 if ( $$setext[ $$line ] =~ /$subtitle_tt/ or 2751 $$setext[ $$line ] =~ /$title_tt/ ) 2752 { 2753 $$line++; 2754 return 1; # the first line after the setext title marker 2755 } 2756 } 2757 } 2758 2759 return 0; 2760 } 2761 2762 #------------------------------------------------------------------------------- 2763 2764 sub get_menu_text 2765 { 2766 my $setext = shift; 2767 my $crnt_line = shift; 2768 my $line = shift; 2769 2770 #------------------------------------- 2771 # Skip any setext comment lines found. 2772 #------------------------------------- 2773 while( $$setext[ $$line ] =~ /$suppress_tt/ ) { $$line ++ }; 2774 2775 $crnt_line = $$setext[ $$line++ ] if $crnt_line eq ""; 2776 2777 if( $crnt_line =~ /$twobuck_tt/ ) # end of setext document? 2778 { 2779 return ("", ""); 2780 } 2781 else 2782 { 2783 #-------------------------------------------- 2784 # Have to read ahead by one line to catch the 2785 # title of the next section, or the end of 2786 # the setext document.(Eat horizontal rulers) 2787 #-------------------------------------------- 2788 do { $_ = $$setext[ $$line++ ] } until not /^ --/; 2789 2790 #-------------------------------- 2791 # Look ahead again, so that an 2792 # empty last line is not emitted. 2793 #-------------------------------- 2794 if( $crnt_line =~ /^\s*$/ and 2795 ($$setext[ $$line ] =~ /$subtitle_tt/o or 2796 $$setext[ $$line ] =~ /$title_tt/o or 2797 $$setext[ $$line ] =~ /$twobuck_tt/o)) 2798 { 2799 return ("", ""); 2800 } 2801 2802 if( /$subtitle_tt/o or /$twobuck_tt/o ) 2803 { 2804 $$line = $$line - 2; 2805 return ("", ""); 2806 } 2807 } 2808 2809 return ( $crnt_line, $_ ); 2810 } 2811 2812 #------------------------------------------------------------------------------- 2813 2814 sub emit_help_menu 2815 { 2816 my $stream = shift; 2817 my $crnt_menu = shift; 2818 my $level = shift; 2819 my $index = shift; 2820 2821 my ( $menuTitle, $mneumonic, $helpName, $hideIt ); 2822 2823 if( $level == 0 ) 2824 { 2825 $sep = ""; 2826 $end_index = scalar( @$crnt_menu ); 2827 } 2828 2829 $level++; 2830 $nl1 = $name_length+6; # for HELP_ and comma 2831 $nl2 = $name_length+3; # for 2 double quotes and comma 2832 2833 #---------------------------------------- 2834 # For every node of the menu tree... 2835 #---------------------------------------- 2836 foreach $menuItem ( @$crnt_menu ) 2837 { 2838 if ( $menuItem =~ /$menu_record/ ) 2839 { 2840 $mneumonic = $1; 2841 $helpName = $3; 2842 $hideIt = $4; 2843 ($menuTitle=$2) =~ s/_//; 2844 } 2845 2846 #--------------------------------- 2847 # ... recursively expand sub-menus 2848 #--------------------------------- 2849 if( $menuItem =~ /$subMenuIndicator/ ) 2850 { 2851 ($menu = $menuTitle) =~ s/ /_/g; 2852 printf $stream "$sep { &H_M[%2d], $level, %-${nl1}.${nl1}s %-${nl2}.${nl2}s $hideIt, '$mneumonic', \"$menuTitle\" }", 2853 $index, "$illegal_help,", "\"$helpName\","; 2854 $index = emit_help_menu( $stream, \@$menu, $level, $index+1 ); 2855 } 2856 2857 else 2858 { 2859 $topic = ( $mneumonic eq $separator ) ? "$illegal_help," : "HELP_\U$helpName,"; 2860 $helpName = "\"$helpName\","; 2861 $nptr = ( $end_index == 1 && $level == 1 ) ? "NULL" : "&H_M[%2d]"; 2862 2863 #--------------------------- 2864 # are we at end of the menu? 2865 #--------------------------- 2866 if( $end_index == 1 && $level == 1 ) { 2867 print $stream "$sep { NULL, "; 2868 } 2869 else { 2870 printf $stream "$sep { &H_M[%2d], ", $index; 2871 } 2872 printf $stream "$level, %-${nl1}.${nl1}s %-${nl2}.${nl2}s $hideIt, '$mneumonic', NULL }", $topic, $helpName; 2873 $sep = ",\n"; 2874 $index++; 2875 } 2876 2877 $end_index-- if $level == 1; 2878 } 2879 2880 return $index; 2881 } 2882 2883 #------------------------------------------------------------------------------- 2884 2885 sub emit_helpTitles 2886 { 2887 my $stream = shift; 2888 my $crnt_menu = shift; 2889 2890 emit_copyright( $stream, "$hlptxt -- Nirvana Editor help module data" ); 2891 print $stream "char *HelpTitles[] = {\n"; 2892 emit_help_label( $stream, $crnt_menu ); 2893 print $stream " NULL\n};\n\n"; 2894 } 2895 2896 #------------------------------------------------------------------------------- 2897 2898 sub emit_help_label 2899 { 2900 my $stream = shift; 2901 my $crnt_menu = shift; 2902 my ( $menuTitle, $mneumonic, $helpName ); 2903 2904 #----------------------------------------------------------------- 2905 # Emit help title/labels for only the leaf nodes of the menu tree. 2906 #----------------------------------------------------------------- 2907 foreach $menuItem ( @$crnt_menu ) 2908 { 2909 if ( $menuItem =~ /$menu_record/ ) 2910 { 2911 $mneumonic = $1; 2912 $helpName = $3; 2913 ($menuTitle = $2) =~ s/_//go; 2914 } 2915 2916 if( $menuItem =~ /$subMenuIndicator/ ) 2917 { 2918 ($menu = $menuTitle) =~ s/ /_/go; 2919 emit_help_label( $stream, \@$menu ); 2920 } 2921 elsif( $mneumonic ne $separator ) # ... and not a menu separator 2922 { 2923 print $stream " \"$menuTitle\",\n"; 2924 push @hot_tt_links, $menuTitle; # collect for later verification. 2925 } 2926 } 2927 } 2928 2929 #------------------------------------------------------------------------------- 2930 2931 sub emit_help_header # populates NEdit's help_topic.h 2932 { 2933 my $stream = shift; 2934 my $crnt_menu = shift; 2935 2936 emit_copyright( $stream, "$hlphdr -- Nirvana Editor help display" ); 2937 print $stream "#define MAX_HEADING $MAX_HEADER\n"; 2938 print $stream "#define STL_HD $linkIndex+1\n"; 2939 print $stream "#define STL_LINK $linkIndex\n"; 2940 print $stream "#define STL_NM_HEADER '$STYLE_HDR'\n"; 2941 print $stream "#define STL_NM_LINK '$STYLE_LINK'\n"; 2942 print $stream "#define STYLE_MARKER '$styleMark'\n"; 2943 print $stream "#define STYLE_PLAIN '$STYLE_PLAIN'\n"; 2944 print $stream "#define TKN_LIST_SIZE $maxTokens\n"; 2945 print $stream "\n"; 2946 print $stream "enum HelpTopic {\n"; 2947 emit_help_topic( $stream, $crnt_menu ); 2948 print $stream " HELP_LAST_ENTRY,\n"; 2949 print $stream " $illegal_help = 0x7fffffff /* Illegal topic */ \n"; 2950 print $stream "};\n"; 2951 print $stream "\n"; 2952 print $stream "#define NUM_TOPICS HELP_LAST_ENTRY\n"; 2953 print $stream "\n"; 2954 } 2955 2956 #------------------------------------------------------------------------------- 2957 2958 sub emit_help_topic 2959 { 2960 my $stream = shift; 2961 my $crnt_menu = shift; 2962 my ( $menuTitle, $mneumonic, $helpName ); 2963 2964 #----------------------------------------------------------------- 2965 # Emit help topic name for only the leaf nodes of the menu tree. 2966 #----------------------------------------------------------------- 2967 foreach $menuItem ( @$crnt_menu ) 2968 { 2969 if ( $menuItem =~ /$menu_record/ ) 2970 { 2971 $mneumonic = $1; 2972 $helpName = $3; 2973 ($menuTitle = $2) =~ s/_//go; 2974 } 2975 2976 if( $menuItem =~ /$subMenuIndicator/ ) 2977 { 2978 ($menu = $menuTitle) =~ s/ /_/go; 2979 emit_help_topic( $stream, \@$menu ); 2980 } 2981 elsif( $mneumonic ne $separator ) # ... and not a menu separator 2982 { 2983 print $stream " HELP_\U$helpName,\n"; 2984 } 2985 } 2986 } 2987 2988 #------------------------------------------------------------------------------- 2989 2990 sub emit_copyright 2991 { 2992 my $stream = shift; 2993 my $filename = shift; 2994 2995 my $year = date("y"); 2996 my $padlen1 = 76 - length( $filename ); 2997 my $padlen2 = 52 - length( $copy_right_holder ); 2998 my $blanks = " "; 2999 my $pad1 = substr( $blanks, 0, $padlen1 ); 3000 my $pad2 = substr( $blanks, 0, $padlen2 ); 3001 3002 print $stream "/*******************************************************************************\n"; 3003 print $stream "* *\n"; 3004 print $stream "* $filename$pad1 *\n"; 3005 print $stream "* *\n"; 3006 print $stream " Generated on " . date() . " (Do NOT edit!)\n"; 3007 print $stream " Source of content from file $setext_file\n"; 3008 print $stream "* *\n"; 3009 print $stream "* Copyright (c) 1999-$year $copy_right_holder$pad2 *\n"; 3010 print $stream "* *\n"; 3011 print $stream "* This is free software; you can redistribute it and/or modify it under the *\n"; 3012 print $stream "* terms of the GNU General Public License as published by the Free Software *\n"; 3013 print $stream "* Foundation; either version 2 of the License, or (at your option) any later *\n"; 3014 print $stream "* version. *\n"; 3015 print $stream "* *\n"; 3016 print $stream "* This software is distributed in the hope that it will be useful, but WITHOUT *\n"; 3017 print $stream "* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or *\n"; 3018 print $stream "* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *\n"; 3019 print $stream "* for more details. *\n"; 3020 print $stream "* *\n"; 3021 print $stream "* In addition, as a special exception to the GNU GPL, the copyright holders *\n"; 3022 print $stream "* give permission to link the code of this program with the Motif and Open *\n"; 3023 print $stream "* Motif libraries (or with modified versions of these that use the same *\n"; 3024 print $stream "* license), and distribute linked combinations including the two. You must *\n"; 3025 print $stream "* obey the GNU General Public License in all respects for all of the code used *\n"; 3026 print $stream "* other than linking with Motif/Open Motif. If you modify this file, you may *\n"; 3027 print $stream "* extend this exception to your version of the file, but you are not obligated *\n"; 3028 print $stream "* to do so. If you do not wish to do so, delete this exception statement from *\n"; 3029 print $stream "* your version. *\n"; 3030 print $stream "* *\n"; 3031 print $stream "* You should have received a copy of the GNU General Public License along with *\n"; 3032 print $stream "* software; if not, write to the Free Software Foundation, Inc., 59 Temple *\n"; 3033 print $stream "* Place, Suite 330, Boston, MA 02111-1307 USA *\n"; 3034 print $stream "* *\n"; 3035 print $stream "* Nirvana Text Editor *\n"; 3036 print $stream "* September 10, 1991 *\n"; 3037 print $stream "* *\n"; 3038 print $stream "* Written by $copy_right_holder *\n"; 3039 print $stream "* *\n"; 3040 print $stream "*******************************************************************************/\n"; 3041 print $stream "\n"; 3042 3043 } 3044 3045 #------------------------------------------------------------------------------- 3046 3047 3048 __END__ 3049 3050 =head1 NAME 3051 3052 Setext - convert Structured Enhanced TEXT into HTML or plain text. 3053 3054 =head1 SYNOPSIS 3055 3056 Usage: setext [ -dhtTVw ][-D directory][-H [hfile]][-S [htmlExt]] \ 3057 [-c conditional][-v name=value][setext_file [converted_file]] 3058 3059 setext {-mp} [-c conditional][-M menuSuffix][-v name=value] setext_file 3060 3061 The first form of setext is used to convert Structure Enhanced TEXT 3062 documents into HTML or simple text documents. 3063 The second form is specific to generating NEdit help menu code 3064 from a setext document with Menu and Help directives. 3065 3066 -c conditional text definitions, separated by commas. 3067 -d do not automatically make titles hypertext references (HTML only) 3068 -D specify destination directory for separate HTML files. This also sets 3069 the value for the variable HTML_DIR. 3070 -h show this usage clause. 3071 -H convert setext_file to HyperText Markup Language (HTML). 3072 Optional file parameter specifies file containing HTML header 3073 and footer definition overrides. The current defaults are: 3074 $htmlHeader = <HTML> 3075 <TITLE>$HTML_TITLE</TITLE> 3076 <HEAD></HEAD> 3077 <BODY> 3078 $htmlFooter = </BODY> 3079 </HTML> 3080 where $HTML_TITLE is replaced with an appropriate title. 3081 3082 -m generate NEdit help menu code files. 3083 -M name NEdit help code files with this suffix. 3084 -p do option -m and print out NEdit help elements. 3085 -S convert setext_file into separate HTML files. 3086 (the default name extension is 'html', but it can be 3087 changed by specifying it as an argument to this option) 3088 -t convert setext_file to simple text (default). 3089 -T emit setext typotag definitions in use. 3090 -v defines variable name and assigns it the given value. 3091 (more than one occurrence of -v can be made) The variables 3092 are made available for use within the setext document parsing. 3093 -V display the version of this setext script. 3094 -w do not emit warnings about missing variables. 3095 3096 When the converted_file argument is missing, STDOUT is used. 3097 When the setext_file argument is missing, STDIN is used. 3098 3099 To get conditional text within a setext document to be displayed, 3100 supply a definition tag through the -c option. For example, 3101 3102 setext -c NEDITDOC help.etx nedit.doc 3103 3104 would generate a plain text document, nedit.doc, from the source 3105 help.etx, including/excluding text marked with 'NEDITDOC' 3106 conditional text markers, also known as 'maybe' typotags. 3107 3108 =head1 DESCRIPTION 3109 3110 This Structured Enhanced TEXT converter produces either HTML or plain 3111 text files from a given setext source. The HTML files produced can 3112 include hypertext references to within itself, or to external 3113 destinations. The setext converter also has the capability of providing 3114 different content in the resulting output files through a conditional 3115 text mechanism, and variable data definitions. All this allows a 3116 publisher to maintain a single, very readable, source while producing 3117 varying content for different output formats and audiences. 3118 3119 When the converted_file argument is missing, STDOUT is used. 3120 When the setext_file argument is missing, STDIN is used. This gives 3121 setext the capability of being a filter to other programs. 3122 3123 To get conditional text within a setext document to be displayed, 3124 supply a definition tag through the -c option. For example, 3125 3126 setext -c NEDITDOC help.etx nedit.doc 3127 3128 would generate a plain text document, nedit.doc, from the source 3129 help.etx, including/excluding text marked with 'NEDITDOC' 3130 conditional text markers, also known as 'maybe' typotags. 3131 3132 Use the -T option to see the set of typotags supported by this 3133 converter. Further explanations of typotags occurs there. 3134 3135 =head2 HTML Generation Examples 3136 3137 The simplest form of HTML generation is: 3138 3139 setext help.etx nedit.html 3140 setext -H help.etx nedit.html 3141 3142 The results will be stored in the current directory in the nedit.html 3143 file. 3144 3145 When the user wants to break up the resulting html file into multiple 3146 files, with cross references between the files, the -S option should 3147 be used. 3148 3149 setext -S help.etx nedit.html 3150 3151 The resulting files are broken up according to titled sections and 3152 are placed into the current directory, along with the nedit.html file. 3153 3154 To change the destination of the resulting files, two options are 3155 supplied, the -D and -S options. For instance, 3156 3157 setext -S shtml -D help/nedit help.etx nedit.shtml 3158 3159 The -S option allows the name of the file extension to be altered. 3160 The -D option specifies where the resulting files are going to be 3161 stored. Thus, in the example, all the files will be placed in the 3162 help/nedit directory (relative to the current directory) and will 3163 have ".shtml" as the file extension. 3164 3165 A final nuance has been added to help server side HTML capabilities. 3166 The -H option can be used to specify a file which contains the 3167 definitions of $htmlHeader and $htmlFooter. This will be used to 3168 override that which is supplied by the setext script. For example, 3169 3170 setext -S shtml -H NEdit.ssd help.etx nedit.html 3171 3172 tells setext to use the file NEdit.ssd (server side definition) 3173 to override the HTML header and footer generation. An example of 3174 the contents of this file follows. 3175 3176 $htmlHeader = 3177 '<!--#set var="menu" value="documentation" -->' . "\n" . 3178 '<!--#include virtual="/head.shtml"-->' . "\n"; 3179 3180 $htmlFooter = 3181 '<!--#include virtual="/tail.shtml"-->' . "\n"; 3182 3183 =head2 NEdit Help Menu 3184 3185 When generating the NEdit help menu code, two files will be produced, 3186 help_data.h and help_topic.h (when the -M option is not used). 3187 These two files contain all the programmatic 3188 data needed to implement hypertext menus within the NEdit program. 3189 The following is an example of a setext invocation which assumes that 3190 the variable 'version' is being used within the help.etx file. 3191 3192 setext -m -v "version=6.0" help.etx 3193 3194 If the -M option is used, its value is appended to the root portion 3195 of the two generated files. For example, 3196 3197 setext -m -c VMS -M _VMS help.etx 3198 3199 will generate the files help_topic_VMS.h and help_data_VMS.h. The 3200 conditional portion of the help menu specifically designated for VMS 3201 will be extracted from the help.etx source. 3202 3203 Below is what is used to guide the generation of 'C'-Motif menus. 3204 Indentation is SIGNIFICANT in the "Menu" directive lines below. It 3205 is used to determine under which menu element another item will belong. 3206 The number of spaces indented is not significant, but items to be placed 3207 in the same menu panel MUST line up at the same indent level. 3208 ALL nodes of this menu "tree" should have help name qualifiers. 3209 These are used to produce the internal lists used by NEdit help code. 3210 3211 By default, the first character of the menu element will be used as a 3212 menu mneumonic key. To use another character in the menu element for 3213 this purpose, surround the character with underscores (eg. I w_a_nt 'a'). 3214 3215 The menu title MUST match the one found in the actual help text (sans 3216 special mneumonic key character marking). The help text title may include 3217 underlines (for spaces) when it is a hyperlink target. 3218 3219 The Help-name is used to generate various data structure names. For 3220 instance, the 'start' help name will be used to generate the HelpTopic 3221 enumeration value HELP_START and the character array htxt_start which 3222 holds the actual help text used in the menu dialogs. Consequently, these 3223 names need to be unique and contain only the characters that a 'C' 3224 compiler can digest. 3225 3226 Menu separator lines use a dash (-) character for the Menu Title. They 3227 should also have a unique Help-name. 3228 3229 A numerical value following the Help-name (separated from the name by 3230 a comma and/or spaces) is part of a menu element hiding scheme implemented 3231 in buildHelpMenu (found in 'menu.c'). When the number matches the hideIt 3232 value found in the procedure, that element will effectively become invisible. 3233 This mechanism was created for particular menu features that are not 3234 available to all incarnations of NEdit (in this case, the VMS version). 3235 3236 A "Help" directive is used for all other text used as NEdit help, but 3237 does not show up in the Help menu. The following is a sample of 3238 Menu and Help directives. 3239 3240 .. Menu Title # Help-name 3241 .. ------------------------------------------------------------ 3242 .. Menu: Getting Started # start 3243 .. Menu: Basic Operation # basicOp 3244 .. Menu: Selecting Text # select 3245 .. Menu: Finding and Replacing Text # search 3246 .. Menu: Cut and Paste # clipboard 3247 .. Menu: Using the Mouse # mouse 3248 .. Menu: Keyboard Shortcuts # keyboard 3249 .. Menu: S_h_ifting and Filling # fill 3250 .. Menu: F_i_le Format # format 3251 3252 .. Menu: Features for Programming # features 3253 .. Menu: Programming with NEdit # programmer 3254 .. Menu: Tabs/Emulated Tabs # tabs 3255 .. Menu: Auto/Smart Indent # indent 3256 .. Menu: Syntax Highlighting # syntax 3257 .. Menu: Finding Declarations (ctags) # tags 3258 3259 .. Menu: Regular Expressions # regex 3260 .. Menu: Basic Syntax # basicSyntax 3261 .. Menu: Metacharacters # escapeSequences 3262 .. Menu: Parenthetical Constructs # parenConstructs 3263 .. Menu: Advanced Topics # advancedTopics 3264 .. Menu: Examples # examples 3265 3266 .. Menu: Macro/Shell Extensions # extensions 3267 .. Menu: Shell Commands and Filters # shell, 1 3268 .. Menu: Learn/Replay # learn 3269 .. Menu: Macro Language # macro_lang 3270 .. Menu: M_a_cro Subroutines # macro_subrs 3271 .. Menu: Action Routines # actions 3272 3273 .. Menu: Customizing # customizing 3274 .. Menu: Customizing NEdit # customize 3275 .. Menu: Preferences # preferences 3276 .. Menu: X Resources # resources 3277 .. Menu: Key Binding # binding 3278 .. Menu: Highlighting Patterns # patterns 3279 .. Menu: Smart Indent Macros # smart_indent 3280 3281 .. Menu: NEdit Command Line # command_line 3282 .. Menu: Client/Server Mode # server 3283 .. Menu: Cr_a_sh Recovery # recovery 3284 .. Menu: ---------------------------------- # separator1 3285 .. Menu: Version # version 3286 .. Menu: Distribution Policy # distribution 3287 .. Menu: Mailing _L_ists # mailing_list 3288 .. Menu: Problems/Defects # defects 3289 .. ------------------------------------------------------------ 3290 .. Help: Tabs Dialog # tabs_dialog 3291 3292 =cut 3293