1# $Id$ 2$VERSION{''.__FILE__} = '$Revision$'; 3# 4# >>Title:: SDF Macros Library 5# 6# >>Copyright:: 7# Copyright (c) 1992-1996, Ian Clatworthy (ianc@mincom.com). 8# You may distribute under the terms specified in the LICENSE file. 9# 10# >>History:: 11# ----------------------------------------------------------------------- 12# Date Who Change 13# 24-Oct-98 ianc added jump macro, variables parameter for classes 14# 29-Feb-96 ianc SDF 2.000 15# ----------------------------------------------------------------------- 16# 17# >>Purpose:: 18# This library provides the built-in macros (implemented in [[Perl]]) for 19# [[SDF]] files. 20# 21# >>Description:: 22# For default values within argument tables: 23# 24# * the empty string means there is no default 25# * the symbol _NULL_ means the default is the empty string. 26# 27# >>Limitations:: 28# 29# >>Implementation:: 30# The block macros (i.e. block/endblock, macro/endmacro) work as follows: 31# 32# ^ the starting macro sets the following global variables: 33# - {{$sdf_block_start}} to the current line number 34# - {{$sdf_block_type}} to {{block}} or {{macro}} 35# - {{@sdf_block_text}} to empty 36# - {{%sdf_block_args}} to the arguments 37# + the main parser then builds {{@sdf_block_text}} by searching 38# until it finds the end of the structure (i.e. the end-style macro 39# at the same nesting level) 40# + the ending macro then: 41# - clears {{$sdf_block_type}} 42# - processes {{@sdf_block_text}} using {{%sdf_block_args}} 43# 44# This strategy minimises the work these macros have to do. 45# 46# The conditional text macros (i.e. if, elsif, etc.) work by changing 47# the following global stacks: 48# 49# * {{@sdf_if_start}} - the starting line number (needed for errors) 50# * {{@sdf_if_now}} - is the current text section to be included? 51# * {{@sdf_if_yet}} - has a section been included yet? 52# * {{@sdf_if_else}} - has the else directive been found yet? 53# 54 55 56# Switch to the user package 57package SDF_USER; 58 59##### Constants ##### 60 61@_CLASS_PARAMS = ( 62 'Name Type Rule', 63 'data boolean', 64 'cited boolean', 65 'root string', 66 'columns string', 67 'style string', 68 'compact boolean', 69 'wide boolean', 70 'headings boolean', 71 'where string', 72 'sort string', 73 'select string', 74 'delete string', 75 'colaligns string', 76 'colvaligns string', 77 'wrap integer', 78 'variables boolean', 79); 80 81##### Variables ##### 82 83# Loaded modules 84%_loaded = (); 85 86# User variables, macros, export lookup table 87%var = (); 88%macro = (); 89%export = (); 90 91# Header/footer parts 92%page_hf = (); 93 94# Class definitions 95%_class = (); 96 97# Object properties 98%obj_name = (); 99%obj_long = (); 100 101# Stack of file-related information 102@_file_info = (); 103 104# Subsection prefixes 105%subsection_prefix = (); 106 107# Event data - paragraphs 108@evcode_paragraph = (); 109@evmask_paragraph = (); 110@evid_paragraph = (); 111 112# Event data - phrases 113@evcode_phrase = (); 114@evmask_phrase = (); 115@evid_phrase = (); 116 117# Event data - variables 118@evcode_variable = (); 119@evmask_variable = (); 120@evid_variable = (); 121 122# Event data - macros 123@evcode_macro = (); 124@evmask_macro = (); 125@evid_macro = (); 126 127# Event data - filters 128@evcode_filter = (); 129@evmask_filter = (); 130@evid_filter = (); 131 132# Event data - tables 133@evcode_table = (); 134@evmask_table = (); 135@evid_table = (); 136 137# Lookup table of readonly & restricted variable families 138%restricted = (); 139%readonly = (); 140 141##### Initialisation ##### 142 143# 144# >>Description:: 145# {{Y:InitMacros}} initialises the global variables in this module. 146# 147sub InitMacros { 148# local() = @_; 149# local(); 150 local($name); 151 152 %_loaded = (); 153 %var = (); 154 %macro = (); 155 %export = (); 156 %page_hf = (); 157 %_class = (); 158 %obj_name = (); 159 %obj_long = (); 160 @_file_info = (); 161 %subsection_prefix = (); 162 163 @evcode_paragraph = (); 164 @evmask_paragraph = (); 165 @evid_paragraph = (); 166 @evcode_phrase = (); 167 @evmask_phrase = (); 168 @evid_phrase = (); 169 @evcode_variable = (); 170 @evmask_variable = (); 171 @evid_variable = (); 172 @evcode_macro = (); 173 @evmask_macro = (); 174 @evid_macro = (); 175 @evcode_filter = (); 176 @evmask_filter = (); 177 @evid_filter = (); 178 @evcode_table = (); 179 @evmask_table = (); 180 @evid_table = (); 181 182 %readonly = (); 183 %restricted = (); 184 for $name (keys %'sdf_target) { 185 $name =~ tr/a-z/A-Z/; 186 $restricted{$name} = 1; 187 } 188} 189 190##### Support Routines ##### 191 192# 193# >>_Description:: 194# {{Y:_PageHF}} builds headers or footers. 195# {{type}} is 'HEADER' or 'FOOTER'. 196# If {{overwrite}} is true, the existing header/footer macros are cleared. 197# Otherwise the existing macros are edited. 198# {{pages}} is a comma separated list of page names (i.e. First,Right,Left). 199# {{component}} is the manual component, if any. 200# {{%parts}} is the assocative array of parts within the macro. 201sub _PageHF { 202 local($type, $overwrite, $component, *pages, *parts) = @_; 203 local(@result); 204 local($page, $comp_page); 205 local($mac_name, $mac_value, %mac_parts); 206 local($line, $first, $last); 207 local($posn, @posns); 208 local($sep, $part, $varname); 209 210 # Build the pages 211 for $page (@pages) { 212 $comp_page = $component ne '' ? "\U${component}_$page" : "\U$page"; 213 $mac_name = "PAGE_${comp_page}_$type"; 214 215 # Get and save the parts within this macro 216 if ($overwrite) { 217 %mac_parts = %parts; 218 } 219 else { 220 %mac_parts = &'SdfAttrSplit($page_hf{$comp_page}); 221 @mac_parts{keys %parts} = values %parts; 222 } 223 $page_hf{$comp_page} = &'SdfAttrJoin(*mac_parts); 224 225 # Get the part ordering information 226 $first = 1; 227 $last = $var{'OPT_HEADINGS'}; 228 if ($type eq 'HEADER') { 229 $last = 2 if $last > 2; 230 } 231 elsif ($last > 3) { 232 $first--; 233 $last--; 234 } 235 @posns = "\U$page" eq 'LEFT' ? 236 ('outer', 'center', 'inner') : 237 ('inner', 'center', 'outer'); 238 239 # Build the macro value 240 $mac_value = $last >= 3 ? "${type}[size='7pt']" : "$type:"; 241 $sep = ''; 242 for $line ($first .. $last) { 243 for $posn (@posns) { 244 $part = $posn . $line; 245 $varname = $mac_name . "_\U$part"; 246 $var{$varname} = $mac_parts{$part}; 247 $var{$varname} = '' unless defined $var{$varname}; 248 $mac_value .= $sep . '[[' . $varname . ']]'; 249 $sep = '[[tab]]'; 250 } 251 $sep = '[[nl]]'; 252 } 253 254 # Add this macro to the result 255#print STDERR "$mac_name macro is:\n$mac_value\n"; 256 push(@result, "!macro $mac_name", $mac_value, "!endmacro"); 257 } 258 259 # Return result 260 return @result; 261} 262 263# 264# >>_Description:: 265# {{Y:_EventFind}} finds a name in a list of event names. 266# The index of the event is returned, or -1 if the event is 267# not found. 268# 269sub _EventFind { 270 local(*stack, $name) = @_; 271 local($index); 272 273 # Search through the stack of names 274 for ($index = $#stack; $index >= 0; $index--) { 275 return $index if $stack[$index] eq $name; 276 } 277 278 # If we reach here, no luck 279 return -1; 280} 281 282# 283# >>_Description:: 284# {{Y:_ClassHandler}} is the implementation for class filters. 285# 286sub _ClassHandler { 287 local($class, *rules, *text, %param) = @_; 288 local(@tbl, @flds, $rec, %values); 289 local($name_style, $name_fld, $long_fld); 290 local($process); 291 local(@out_fields, @out_styles, $out_values); 292 local($field, $style, $value); 293 local($root); 294 local($name, $long, $jump); 295 local($params); 296 local($tbl_style); 297 local($view); 298 local($make_vars, $var_name); 299 300 @tbl = &'TableParse(@text); 301 @text = (); 302 &'TableValidate(*tbl, *rules); 303 304 # Get the class details 305 $name_style = $_class{$class,'name_style'}; 306 $name_fld = $_class{$class,'name_fld'}; 307 $long_fld = $_class{$class,'long_fld'}; 308 309 # Get the processing action 310 if ($param{'data'}) { 311 $process = 'data'; 312 } 313 elsif ($param{'cited'}) { 314 $process = 'cited'; 315 } 316 else { 317 $process = 'display'; 318 } 319 320 # Get the 'make variables' flag 321 $make_vars = $param{'variables'}; 322 $var_name = ''; 323 324 # For display tables, get the fields to be output 325 @out_fields = (); 326 @out_styles = (); 327 if ($process eq 'display') { 328 if ($param{'columns'}) { 329 for $field (split(/,/, $param{'columns'})) { 330 if ($field =~ /^(\w+):(.+)$/) { 331 push(@out_fields, $2); 332 push(@out_styles, $1); 333 } 334 else { 335 push(@out_fields, $field); 336 push(@out_styles, ''); 337 } 338 } 339 } 340 else { 341 @out_fields = ($name_fld, $long_fld); 342 @out_styles = ($name_style, ''); 343 } 344 } 345 346 # Process the data 347 (@flds) = &'TableFields(shift @tbl); 348 $root = $param{'root'}; 349 for $rec (@tbl) { 350 if ($rec =~ /^!/) { 351 push(@text, $rec); 352 next; 353 } 354 %values = &'TableRecSplit(*flds, $rec); 355 356 # Get the fields of interest 357 $name = $values{$name_fld}; 358 $long = $values{$long_fld}; 359 $long = $obj_name{$class,$name,$long_fld} if $long eq ''; 360 $jump = $values{'Jump'}; 361 $jump = $root . $jump if $jump ne ''; 362 $jump = $obj_name{$class,$name,'Jump'} if $jump eq ''; 363 364 # Convert the name to a legal variable name, if necessary 365 if ($make_vars) { 366 $var_name = $name; 367 $var_name =~ s/\W/_/g; 368 } 369 370 # Store the data - we call an internal macro to do this (rather 371 # than doing it directly) as this approach ensures that macros 372 # embedded in the original data table (e.g. !if) have the 373 # expected effect. 374 $values{'Jump'} = $jump; 375 push(@text, "!_store_ " . join("\000", $class, $process ne 'data', 376 $name_fld, $name, $long_fld, $long, %values)); 377 push(@text, "!define $var_name '{{$name_style:$name}}'") if $var_name ne ''; 378 379 # For display tables, build the output 380 if ($process eq 'display') { 381 if ($long_fld && $long eq '' && $jump eq '') { 382 &'AppMsg("warning", "unknown object '$name' in class '$class'"); 383 } 384 @out_values = (); 385 for ($i = 0; $i <= $#out_fields; $i++) { 386 $field = $out_fields[$i]; 387 $style = $out_styles[$i]; 388 389 # Get the view, if any. 390 if ($field =~ /^(\w+)\&/) { 391 $field = $1; 392 $view = $'; 393 } 394 else { 395 $view = ''; 396 } 397 398 # Note: The logic below was originally put there for 399 # speed reasons, I think? However, the introduction of 400 # views means that Value should now always be called. 401 # However, doing that breaks some tests at the moment? 402 403 # Get the value 404 if ($field eq $name_fld) { 405 $value = $name; 406 } 407 elsif ($field eq $long_fld) { 408 $value = $long; 409 } 410 elsif (defined($values{$field})) { 411 $value = $values{$field}; 412 } 413 else { 414 my $ok_class = $class; $ok_class =~ s/['\\]/\\$&/g; 415 my $ok_name = $name; $ok_name =~ s/['\\]/\\$&/g; 416 my $ok_field = $field; $ok_field =~ s/['\\]/\\$&/g; 417 my $ok_view = $view; $ok_view =~ s/['\\]/\\$&/g; 418 $value = "[[&Value('$ok_class', '$ok_name', '$ok_field', '$ok_view')]]"; 419 } 420 421 # Apply the format or style 422 if ($style ne '') { 423 if (defined($var{"FORMAT_$style"})) { 424 if (substr($value, 0, 2) eq '[[') { 425 $value = "[[$style:" . substr($value, 2); 426 } 427 else { 428 $value = "[[$style:$value]]"; 429 } 430 } 431 else { 432 $params = $view ? "[view='$view']" : ":"; 433 $value = "{{$style$params$value}}"; 434 } 435 } 436 437 push(@out_values, $value); 438 } 439 push(@text, join("~", @out_values)); 440 } 441 } 442 443 # Build the field parsing line. 444 # We replace the & with a _ within the field name so that 445 # column name parsing doesn't screw up if views are specified. 446 my $fields_heading = join("~", @out_fields); 447 $fields_heading =~ tr/&/_/; 448 449 # For display tables, finish generating the table 450 if ($process eq 'display') { 451 $tbl_style = $param{'style'} ? $param{'style'} : 'plain'; 452 $params = "style='$tbl_style'"; 453 $params .= "; cellpadding=0; cellspacing=0" if $param{'compact'}; 454 $params .= "; wide" if $param{'wide'}; 455 $params .= "; noheadings" unless $param{'headings'}; 456 $params .= "; where='$param{'where'}'" if $param{'where'} ne ''; 457 $params .= "; sort='$param{'sort'}'" if $param{'sort'} ne ''; 458 $params .= "; select='$param{'select'}'" if $param{'select'} ne ''; 459 $params .= "; delete='$param{'delete'}'" if $param{'delete'} ne ''; 460 $params .= "; colaligns='$param{'colaligns'}'" if $param{'colaligns'} ne ''; 461 $params .= "; colvaligns='$param{'colvaligns'}'" if $param{'colvaligns'} ne ''; 462 $params .= "; wrap='$param{'wrap'}'" if $param{'wrap'} ne ''; 463 unshift(@text, 464 "!block table; $params", 465 $fields_heading); 466 push(@text, "!endblock"); 467 } 468#printf STDERR "%s<\n", join("<\n", @text); 469} 470 471# 472# >>_Description:: 473# {{Y:_ObjectNameEP}} is the event processing for objects in a class. 474# 475sub _ObjectNameEP { 476 local($class, $long_style, $long_fld) = @_; 477 478 # Validate the object 479 if (! $obj_name{$class,$text}) { 480 &'AppMsg("warning", "unknown object '$text' in class '$class' (name EP)"); 481 } 482 483 # Generate the hypertext, if any 484 if ($attr{'jump'} eq '' && defined $obj_name{$class,$text,'Jump'}) { 485 $attr{'jump'} = $obj_name{$class,$text,'Jump'}; 486 } 487 488 # Expand the object name, if requested 489 if ($attr{'expand'}) { 490 delete $attr{'expand'}; 491 if ($long_fld && $obj_name{$class,$text,$long_fld} ne '') { 492 $style = $long_style if $long_style ne ''; 493 $text = $obj_name{$class,$text,$long_fld}; 494 } 495 else { 496 &'AppMsg("warning", "unable to expand object '$text' in class '$class'"); 497 } 498 } 499 500 # Cite the object number, if requested 501 elsif ($attr{'cite'}) { 502 delete $attr{'cite'}; 503 $style = 'N'; 504 $text = &Value($class, $text, 'Cite', $attr{'view'}); 505 } 506} 507 508# 509# >>_Description:: 510# {{Y:_ObjectLongEP}} is the event processing for object long names in a class. 511# 512sub _ObjectLongEP { 513 local($class, $name_style, $name_fld) = @_; 514 515 # Validate the object 516 if (! $obj_long{$class,$text}) { 517 &'AppMsg("warning", "unknown object '$text' in class '$class' (long EP)"); 518 } 519 520 # Generate the hypertext, if any 521 if ($attr{'jump'} eq '' && defined $obj_long{$class,$text,'Jump'}) { 522 $attr{'jump'} = $obj_long{$class,$text,'Jump'}; 523 } 524 525 # Shrink the object name, if requested 526 if ($attr{'shrink'}) { 527 delete $attr{'shrink'}; 528 if ($obj_long{$class,$text,$name_fld} ne '') { 529 $style = $name_style; 530 $text = $obj_long{$class,$text,$name_fld}; 531 } 532 else { 533 &'AppMsg("warning", "unable to shrink object '$text' in class '$class'"); 534 } 535 } 536 537 # Cite the object number, if requested 538 elsif ($attr{'cite'}) { 539 delete $attr{'cite'}; 540 $style = 'N'; 541 $text = &Value($class, $text, 'Cite', $attr{'view'}); 542 } 543} 544 545##### General Macros ##### 546 547# block - begin a block of text 548@_block_MacroArgs = ( 549 'Name Type Default Rule', 550 'filter filter', 551 'params rest _NULL_', 552); 553sub block_Macro { 554 local(%arg) = @_; 555 local(@text); 556#print STDERR "sb1 file: $'ARGV, lineno: $'app_lineno<\n"; 557 558 # Update the parser state 559 $'sdf_block_start = $'app_lineno; 560 $'sdf_block_type = 'block'; 561 @'sdf_block_text = (); 562 %'sdf_block_arg = %arg; 563 564 # Return result 565 return (); 566} 567 568# endblock - end a block of text 569@_endblock_MacroArgs = (); 570sub endblock_Macro { 571 local(%arg) = @_; 572 local(@text); 573 574 # Check the state 575 if ($'sdf_block_type ne 'block') { 576 &'AppMsg("error", "endblock macro not expected"); 577 return (); 578 } 579 580 # Update the parser state 581 $'sdf_block_type = ''; 582 583 # Filter the text 584 &ExecFilter($'sdf_block_arg{'filter'}, *'sdf_block_text, 585 $'sdf_block_arg{'params'}, $'sdf_block_start, $'ARGV, 'filter on '); 586 587 # Mark the text as a section, if necessary 588 if (@'sdf_block_text) { 589 unshift(@'sdf_block_text, 590 "!_bos_ $'sdf_block_start;block on "); 591 push(@'sdf_block_text, "!_eos_ $'app_lineno;$'app_context"); 592 } 593 594 # Return result 595 return @'sdf_block_text; 596} 597 598# include - include another file 599@_include_MacroArgs = ( 600 'Name Type Default Rule', 601 'filename string', 602 'filter filter _NULL_', 603 'params rest _NULL_', 604); 605sub include_Macro { 606 local(%arg) = @_; 607 local(@text); 608 local($filename, $fullname); 609 local($outfile); 610 611 # Get the file location 612 $filename = $arg{'filename'}; 613 $fullname = &FindFile($filename); 614 if ($fullname eq '') { 615 &'AppMsg("warning", "unable to find '$filename'"); 616 return (); 617 } 618 619 # Get the text 620 unless (&FileFetch(*text, $fullname)) { 621 &'AppMsg("warning", "unable to read '$fullname'"); 622 return (); 623 } 624 625 # Filter the text 626 &ExecFilter($arg{'filter'}, *text, $arg{'params'}); 627 628 # Return result 629 return ("!_bof_ '$fullname'", @text, "!_eof_"); 630} 631 632# use - load a library module 633@_use_MacroArgs = ( 634 'Name Type Default Rule', 635 'filename string', 636 'filter filter sdf', 637 'params rest _NULL_', 638); 639sub use_Macro { 640 local(%arg) = @_; 641 local(@text); 642 local($filename, $fullname); 643 644 # Add the sdm extension, if there is none 645 $filename = $arg{'filename'}; 646 $filename .= ".sdm" unless $filename =~ /\.\w+$/; 647 648 # Get the file location 649 $fullname = &FindModule($filename); 650 if ($fullname eq '') { 651 &'AppMsg("warning", "unable to find '$filename'"); 652 return (); 653 } 654 655 # If already loaded, do nothing 656 return () if $_loaded{$fullname}; 657 658 # Get the text 659 unless (&FileFetch(*text, $fullname)) { 660 &'AppMsg("warning", "unable to read '$fullname'"); 661 return (); 662 } 663 664 # Mark the library as loaded 665 $_loaded{$fullname} = 1; 666 667 # Filter the text 668 &ExecFilter($arg{'filter'}, *text, $arg{'params'}); 669 670 # Return result 671 return ("!_bof_ '$fullname'", @text, "!_eof_"); 672} 673 674# inherit - load a library 675@_inherit_MacroArgs = ( 676 'Name Type Default Rule', 677 'library string', 678); 679sub inherit_Macro { 680 local(%arg) = @_; 681 local(@text); 682 local($library, $dos_library); 683 local($module); 684 685 # Add the library to the include and module paths 686 $library = $arg{'library'}; 687 $dos_library = $library; 688 $dos_library =~ s#/#\\#g; 689 $module = (&'NameSplit($library))[1]; 690 if (-f "$module.sdm") { 691 # Module is in the current directory 692 $library = '.'; 693 } 694 elsif (&'NameIsAbsolute($library)) { 695 push(@include_path, $library); 696 push(@module_path, $library); 697 $var{'HLP_OPTIONS_ROOT'} .= ", $dos_library"; 698 } 699 else { 700 my $lib_dir = &FindLibrary($library); 701 if ($lib_dir ne '') { 702 push(@include_path, $lib_dir); 703 push(@module_path, $lib_dir); 704 $var{'HLP_OPTIONS_ROOT'} .= ", $var{'SDF_DOSHOME'}\\$dos_library"; 705 } 706 else { 707 &'AppMsg("warning", "unable to find library '$library'"); 708 return (); 709 } 710 } 711 712 # Load the matching module 713 @text = ("!use '$library/$module'"); 714 715 # Return result 716 return @text; 717} 718 719# execute - include output from a command 720@_execute_MacroArgs = ( 721 'Name Type Default Rule', 722 'cmd string', 723 'filter filter sdf', 724 'params rest _NULL_', 725); 726sub execute_Macro { 727 local(%arg) = @_; 728 local(@text); 729 local($cmd); 730 731 # Get the text 732 $cmd = $arg{'cmd'}; 733 unless (&FileFetch(*text, "$cmd|")) { 734 &'AppMsg("error", "failed to execute '$cmd'"); 735 return (); 736 } 737 738 # Filter the text 739 #&ExecFilter($arg{'filter'}, *text, $arg{'params'}, 0, "'$cmd'", 'line '); 740 &ExecFilter($arg{'filter'}, *text, $arg{'params'}); 741 742 # Return result 743 return ("!_bof_ '$cmd'", @text, "!_eof_"); 744} 745 746# import - import an object (e.g. figure) from another package 747@_import_MacroArgs = ( 748 'Name Type Default Rule', 749 'filename string', 750 'params rest _NULL_', 751); 752sub import_Macro { 753 local(%arg) = @_; 754# local(@text); 755 local($filename); 756 local(%params); 757 758 # Process the filename and attributes 759 $filename = $arg{'filename'}; 760 %params = &'SdfAttrSplit($arg{'params'}); 761 &ProcessImageAttrs(*filename, *params); 762 763 # Return result 764 return (&'SdfJoin('__import', $filename, %params)); 765} 766 767# jumps - create jump lines 768@_jumps_MacroArgs = ( 769 'Name Type Default Rule', 770 'labels string', 771 'layout string Center <Left|Center|Right|left|center|right>', 772); 773sub jumps_Macro { 774 local(%arg) = @_; 775 local(@text); 776 local(@subs, $sub, $jump); 777 local($sep); 778 local($layout); 779 780 # Build the jumps 781 @subs = split(/,/, $arg{'labels'}); 782 $sep = ''; 783 for $sub (@subs) { 784 if ($sub eq '') { 785 $sub = "{{CHAR:nl}}"; 786 $sep = ''; 787 } 788 else { 789 $jump = &TextToId($sub); 790 $sub = $sep . "{{[jump='#$jump']$sub}}"; 791 $sep = ' | '; 792 } 793 } 794 795 # Build the output 796 @text = (); 797 $layout = $arg{'layout'}; 798 substr($layout, 0, 1) =~ tr/a-z/A-Z/; 799 @text = ("[align='$layout']" . join("", @subs)); 800 801 # Return result 802 return @text; 803} 804 805# subsections - list topic subsections (and create a jump line for HTML) 806@_subsections_MacroArgs = ( 807 'Name Type Default Rule', 808 'labels string', 809 'prefix string Topic <Topic|Noprefix|noprefix>', 810 'layout string Left <Left|Center|Right|None|left|center|right|none>', 811); 812sub subsections_Macro { 813 local(%arg) = @_; 814 local(@text); 815 local(@subs, $sub, $jump); 816 local($prefix); 817 local($sep); 818 local($layout); 819 820 # Get the list of subsections 821 @subs = split(/,/, $arg{'labels'}); 822 823 # Get the prefix, if any 824 $prefix = ''; 825 if ($arg{'prefix'} eq 'Topic') { 826 $prefix = $topic ne '' ? "$topic - " : ''; 827 } 828 829 # Save the sub-section data and build the jumps 830 $sep = ''; 831 for $sub (@subs) { 832 if ($sub eq '') { 833 $sub = "{{CHAR:nl}}"; 834 $sep = ''; 835 } 836 else { 837 $subsection_prefix{$sub} = $prefix; 838 $jump = &TextToId($prefix . $sub); 839 $sub = $sep . "{{[jump='#$jump']$sub}}"; 840 $sep = ' | '; 841 } 842 } 843 844 # Build the output (HTML only for now) 845 @text = (); 846 if ($var{'OPT_TARGET'} eq 'html') { 847 $layout = $arg{'layout'}; 848 substr($layout, 0, 1) =~ tr/a-z/A-Z/; 849 if ($layout ne 'None') { 850 @text = ("[align='$layout']" . join("", @subs)); 851 } 852 } 853 854 # Return result 855 return @text; 856} 857 858# continued - continue a heading onto another page 859@_continued_MacroArgs = ( 860 'Name Type Default Rule', 861 'style string', 862 'suffix string , {{N:Continued}}', 863); 864sub continued_Macro { 865 local(%arg) = @_; 866 local(@text); 867 local($target); 868 local($style, $suffix); 869 870 # Build result 871 $target = $var{'OPT_TARGET'}; 872 if ($target eq 'html' || $target eq 'hlp') { 873 @text = (); 874 } 875 else { 876 $style = $arg{'style'}; 877 $suffix = $arg{'suffix'}; 878 @text = $style . "[notoc;noid;continued][[&Previous($style)]]$suffix"; 879 } 880 881 # Return result 882 return @text; 883} 884 885# clear - insert a BR CLEAR for HTML 886@_clear_MacroArgs = ( 887 'Name Type Default Rule', 888 'type string All <Left|Right|All>', 889); 890sub clear_Macro { 891 local(%arg) = @_; 892 local(@text); 893 894 # Build the result 895 if ($var{'OPT_TARGET'} eq 'html') { 896 @text = ( 897 "!block inline", 898 "<BR CLEAR=\"" . $arg{'type'} . '">', 899 "!endblock"); 900 } 901 else { 902 @text = (); 903 } 904 905 # Return result 906 return @text; 907} 908 909# catalog - build a catalog of the objects already loaded for a class 910@_catalog_MacroArgs = ( 911 'Name Type Default Rule', 912 'class symbol', 913 'mask string', 914 'params rest _NULL_', 915); 916sub catalog_Macro { 917 local(%arg) = @_; 918 local(@text); 919 local($class, $name_fld); 920 local($object, $mask); 921 922 # Get the class and its name field 923 $class = $arg{'class'}; 924 $name_fld = $_class{$class,'name_fld'}; 925 926 # Build the output header 927 @text = ("!block $class; $arg{'params'}", $name_fld); 928 929 # Build the result 930 $mask = $arg{'mask'}; 931 if ($mask eq 'cited') { 932 for $object (split("\n", $_class{$class,'cited'})) { 933 push(@text, $object); 934 } 935 } 936 elsif ($mask =~ /^(\w+):/) { 937 my $attr = $1; 938 $mask = $'; 939 my $value; 940 for $object (split("\n", $_class{$class,'catalog'})) { 941 $value = &Value($class, $object, $attr); 942 next if $mask ne '' && $value !~ /^$mask$/; 943 push(@text, $object); 944 } 945 } 946 else { 947 for $object (split("\n", $_class{$class,'catalog'})) { 948 next if $mask ne '' && $object !~ /^$mask$/; 949 push(@text, $object); 950 } 951 } 952 push(@text, "!endblock"); 953 954 # Return result 955 return @text; 956} 957 958# namevalues - insert a set of object attributes using a namevalues filter 959@_namevalues_MacroArgs = ( 960 'Name Type Default Rule', 961 'class string', 962 'object string', 963 'attributes string', 964 'params rest _NULL_', 965); 966sub namevalues_Macro { 967 local(%arg) = @_; 968 local(@text); 969 local($class, $object, @attrs, $attr); 970 971 # Get the details 972 $class = $arg{'class'}; 973 $object = $arg{'object'}; 974 @attrs = sort split(/,/, $arg{'attributes'}); 975 976 # Build result 977 @text = ("!block namevalues; $arg{'params'}", "Name|Value"); 978 for $attr (@attrs) { 979 push(@text, "$attr:|" . &Value($class, $object, $attr)); 980 } 981 push(@text, "!endblock"); 982 983 # Return result 984 return @text; 985} 986 987##### Variables Macros ##### 988 989# define - define a variable 990@_define_MacroArgs = ( 991 'Name Type Default Rule', 992 'name symbol', 993 'value string 1', 994); 995sub define_Macro { 996 local(%arg) = @_; 997 local(@text); 998 local($name, $value); 999 local($type, $rule); 1000 1001 # Get the name and value 1002 $name = $arg{'name'}; 1003 $value = $arg{'value'}; 1004 1005 ## If the variable looks like an enum, output an error 1006 #if ($name =~ /^[A-Z][a-z]+$/) { 1007 # &'AppMsg("error", "'variable '$name' looks like an enumerated value"); 1008 # return (); 1009 #} 1010 1011 # If the variable is in a family, check it has been declared 1012 if ($name =~ /^([A-Z]+)_/ && $restricted{$1} && 1013 !$variables_name{$name}) { 1014 $status = (defined($var{$name}) || $readonly{$1}) ? 'read-only' : 'unknown'; 1015 &'AppMsg("warning", "'$1' variable '$name' is $status - ignoring definition"); 1016 return (); 1017 } 1018 1019 # If the variable has been declared, validate it 1020 if ($variables_name{$name}) { 1021 $type = $variables_type{$name}; 1022 $rule = $variables_rule{$name}; 1023 unless (&'MiscCheckRule($value, $rule, $type)) { 1024 &'AppMsg("warning", "bad value '$value' for variable '$name'"); 1025 } 1026 } 1027 1028 # Save the definition 1029 $var{$name} = $value; 1030 1031 # Export the variable, if necessary 1032 if ($export{$name}) { 1033 @text = (&'SdfJoin('__object', 'Variable', 1034 'Name', $name, 1035 'value', $value)); 1036 } 1037 1038 # Return result 1039 return (@text); 1040} 1041 1042# default - define a variable (if not already set) 1043@_default_MacroArgs = ( 1044 'Name Type Default Rule', 1045 'name symbol', 1046 'value string 1', 1047); 1048sub default_Macro { 1049 local(%arg) = @_; 1050 local(@text); 1051 local($name); 1052 1053 $name = $arg{'name'}; 1054 1055 # Save the definition, if necessary 1056 &define_Macro(%arg) unless defined($var{$name}); 1057 1058 # Return result 1059 return (); 1060} 1061 1062# undef - undefine a variable 1063@_undef_MacroArgs = ( 1064 'Name Type Default Rule', 1065 'name symbol', 1066); 1067sub undef_Macro { 1068 local(%arg) = @_; 1069 local(@text); 1070 1071 # Clear the definition 1072 delete $var{$arg{'name'}}; 1073 1074 # Return result 1075 return (); 1076} 1077 1078# init - initialise a set of variables 1079@_init_MacroArgs = ( 1080 'Name Type Default Rule', 1081 'vars rest _NULL_', 1082); 1083sub init_Macro { 1084 local(%arg) = @_; 1085 local(@text); 1086 local(%vars, $name, $value); 1087 1088 # Convert the name-value pairs to define macros 1089 %vars = &'SdfAttrSplit($arg{'vars'}); 1090 for $name (sort keys %vars) { 1091 $value = $vars{$name}; 1092 $value =~ s/'/\\'/g; 1093 push(@text, "!default $name '$value'"); 1094 } 1095 1096 # Return result 1097 return @text; 1098} 1099 1100# export - mark a variable for export 1101@_export_MacroArgs = ( 1102 'Name Type Default Rule', 1103 'name symbol', 1104); 1105sub export_Macro { 1106 local(%arg) = @_; 1107 local(@text); 1108 local($name); 1109 1110 # Mark for export 1111 $name = $arg{'name'}; 1112 $export{$name} = 1; 1113 1114 # If already defined, export it immediately 1115 if (defined $var{$name}) { 1116 @text = (&'SdfJoin('__object', 'Variable', 1117 'Name', $name, 1118 'value', $var{$name})); 1119 } 1120 1121 # Return result 1122 return @text; 1123} 1124 1125##### Configuration Macros ##### 1126 1127# macro - begin a macro definition 1128@_macro_MacroArgs = ( 1129 'Name Type Default Rule', 1130 'name symbol', 1131); 1132sub macro_Macro { 1133 local(%arg) = @_; 1134 local(@text); 1135 1136 # Update the parser state 1137 $'sdf_block_start = $'app_lineno; 1138 $'sdf_block_type = 'macro'; 1139 @'sdf_block_text = (); 1140 %'sdf_block_arg = %arg; 1141 1142 # Return result 1143 return (); 1144} 1145 1146# endmacro - end a macro definition 1147@_endmacro_MacroArgs = (); 1148sub endmacro_Macro { 1149 local(%arg) = @_; 1150 local(@text); 1151 1152 # Check the state 1153 if ($'sdf_block_type ne 'macro') { 1154 &'AppMsg("error", "endmacro macro not expected"); 1155 return (); 1156 } 1157 1158 # Update the parser state 1159 $'sdf_block_type = ''; 1160 1161 # Save the definition 1162 $macro{$'sdf_block_arg{'name'}} = join("\n", @'sdf_block_text); 1163 1164 # Return result 1165 return (); 1166} 1167 1168# class - declare a class of objects 1169@_class_MacroArgs = ( 1170 'Name Type Default Rule', 1171 'name symbol', 1172 'styles string', 1173 'ids string Name,Long', 1174 'properties string Jump', 1175); 1176sub class_Macro { 1177 local(%arg) = @_; 1178 local(@text); 1179 local($name); 1180 local($name_style, $long_style); 1181 local($name_fld, $long_fld); 1182 local($fld, @rest, @rules); 1183 local($code); 1184 1185 # Store the class details 1186 $name = $arg{'name'}; 1187 ($name_style, $long_style) = split(/,/, $arg{'styles'}); 1188 ($name_fld, $long_fld) = split(/,/, $arg{'ids'}); 1189 $_class{$name} = 1; 1190 $_class{$name,'name_style'} = $name_style; 1191 $_class{$name,'long_style'} = $long_style; 1192 $_class{$name,'name_fld'} = $name_fld; 1193 $_class{$name,'long_fld'} = $long_fld; 1194 $_class{$name,'properties'} = $arg{'properties'}; 1195 1196 # Build the rules table 1197 ($fld, @rest) = split(/,/, $arg{'ids'}); 1198 push(@rest, split(/,/, $arg{'properties'})); 1199 @rules = ('Field:Category:Rule', "$fld:mandatory"); 1200 push(@rules, "$fld:optional") while ($fld = shift(@rest)); 1201 1202 # Build the filter 1203 $code = <<end_of_code; 1204 \@_${name}_FilterParams = \@_CLASS_PARAMS; 1205 \@_${name}_FilterModel = &'TableParse(\@rules); 1206 sub ${name}_Filter { 1207 local(*text, %param) = \@_; 1208 1209 &_ClassHandler('$name', *_${name}_FilterModel, *text, %param); 1210 } 1211end_of_code 1212 1213 # Create the filter 1214 eval $code; 1215 if ($@) { 1216 &'AppMsg("error", "filter creation failed: $@"); 1217 } 1218 1219 # Declare the object styles 1220 @text = ("!block phrasestyles", "Name", $name_style); 1221 push(@text, $long_style) if $long_style ne ''; 1222 push(@text, "!endblock"); 1223 1224 # Declare the event processing 1225 push(@text, "!on phrase '$name_style';;" . 1226 "&_ObjectNameEP('$name', '$long_style', '$long_fld')"); 1227 push(@text, "!on phrase '$long_style';;" . 1228 "&_ObjectLongEP('$name', '$name_style', '$name_fld')") if $long_style; 1229 1230 # Return result 1231 return @text; 1232} 1233 1234# restrict - declare a restricted variable family 1235@_restrict_MacroArgs = ( 1236 'Name Type Default Rule', 1237 'name string', 1238); 1239sub restrict_Macro { 1240 local(%arg) = @_; 1241 local(@text); 1242 1243 $restricted{$arg{'name'}} = 1; 1244 return (); 1245} 1246 1247# readonly - declare a readonly variable family 1248@_readonly_MacroArgs = ( 1249 'Name Type Default Rule', 1250 'name string', 1251); 1252sub readonly_Macro { 1253 local(%arg) = @_; 1254 local(@text); 1255 1256 $readonly{$arg{'name'}} = 1; 1257 return (); 1258} 1259 1260# path_prepend - prepend a directory to the search path 1261@_path_prepend_MacroArgs = ( 1262 'Name Type Default Rule', 1263 'dir string', 1264); 1265sub path_prepend_Macro { 1266 local(%arg) = @_; 1267 local(@text); 1268 local($dir); 1269 1270 $dir = $arg{'dir'}; 1271 unshift(@include_path, $dir) unless $include_path[0] eq $dir; 1272 return (); 1273} 1274 1275# path_append - append a directory to the search path 1276@_path_append_MacroArgs = ( 1277 'Name Type Default Rule', 1278 'dir string', 1279); 1280sub path_append_Macro { 1281 local(%arg) = @_; 1282 local(@text); 1283 local($dir); 1284 1285 $dir = $arg{'dir'}; 1286 push(@include_path, $dir) unless $include_path[$#include_path] eq $dir; 1287 return (); 1288} 1289 1290# script - execute a Perl script 1291@_script_MacroArgs = ( 1292 'Name Type Default Rule', 1293 'code rest', 1294); 1295sub script_Macro { 1296 local(%arg) = @_; 1297 local(@text); 1298 1299 # execute the code 1300 eval $arg{'code'}; 1301 if ($@) { 1302 &'AppMsg("error", "script failed: $@"); 1303 } 1304 1305 # Return result 1306 return (); 1307} 1308 1309# targetobject - define a target object 1310@_targetobject_MacroArgs = ( 1311 'Name Type Default Rule', 1312 'type string', 1313 'name string', 1314 'parent string _NULL_', 1315 'attributes rest _NULL_', 1316); 1317sub targetobject_Macro { 1318 local(%arg) = @_; 1319 local(@text); 1320 local($type, $name, $parent, $attrs); 1321 1322 # Get the defails 1323 $type = $arg{'type'}; 1324 $name = $arg{'name'}; 1325 $parent = $arg{'parent'}; 1326 $attrs = $arg{'attributes'}; 1327 1328 # Return result (efficiently) 1329 return ("__object[Name='$name';Parent='$parent';$attrs]$type"); 1330} 1331 1332# div - begin a division 1333@_div_MacroArgs = ( 1334 'Name Type Default Rule', 1335 'name symbol', 1336); 1337sub div_Macro { 1338 local(%arg) = @_; 1339 local(@text); 1340 1341 # Update the parser state 1342 # to do ... 1343 1344 # Return result 1345 return (&'SdfJoin("__div", $arg{'name'}, ())); 1346} 1347 1348# enddiv - end a macro definition 1349@_enddiv_MacroArgs = (); 1350sub enddiv_Macro { 1351 local(%arg) = @_; 1352 local(@text); 1353 1354 ## Check the state 1355 #if ($'sdf_block_type ne 'macro') { 1356 # &'AppMsg("warning", "enddiv macro not expected"); 1357 # return (); 1358 #} 1359 1360 # Return result 1361 return (&'SdfJoin("__enddiv", "", ())); 1362} 1363 1364 1365##### Conditional Text Macros ##### 1366 1367# if - begin conditional text 1368@_if_MacroArgs = ( 1369 'Name Type Default Rule', 1370 'value condition', 1371); 1372sub if_Macro { 1373 local(%arg) = @_; 1374 local(@text); 1375 local($expr_value); 1376 1377 # If we are nested inside a section of an if macro which is not 1378 # to be included, we exclude all sections of this macro. 1379 push(@'sdf_if_start, $'app_lineno); 1380 if (@'sdf_if_now && ! $'sdf_if_now[$#main'sdf_if_now]) { 1381 push(@'sdf_if_now, 0); 1382 push(@'sdf_if_yet, 1); 1383 push(@'sdf_if_else, 0); 1384 } 1385 1386 # Otherwise, evaluate the expression and process accordingly. 1387 else { 1388 $expr_value = $arg{'value'}; 1389 push(@'sdf_if_now, $expr_value); 1390 push(@'sdf_if_yet, $expr_value); 1391 push(@'sdf_if_else, 0); 1392 } 1393 1394 # Return result 1395 return (); 1396} 1397 1398# elsif - begin a conditional section within conditional text 1399@_elsif_MacroArgs = ( 1400 'Name Type Default Rule', 1401 'value condition', 1402); 1403sub elsif_Macro { 1404 local(%arg) = @_; 1405 local(@text); 1406 local($level); 1407 local($expr_value); 1408 1409 # elsif not permitted outside an if macro 1410 unless (@'sdf_if_now) { 1411 &'AppMsg("error", "!elsif not expected"); 1412 return (); 1413 } 1414 1415 # Get the current nesting level 1416 $level = $#main'sdf_if_yet; 1417 1418 # elsif after an else is not permitted 1419 if ($'sdf_if_else[$level]) { 1420 &'AppMsg("error", "!elsif found after else macro"); 1421 return (); 1422 } 1423 1424 # Only evaluate the expression if we haven't included a section yet 1425 if (! $'sdf_if_yet[$level]) { 1426 $expr_value = $arg{'value'}; 1427 $'sdf_if_now[$level] = $expr_value; 1428 $'sdf_if_yet[$level] = $expr_value; 1429 } 1430 else { 1431 $'sdf_if_now[$level] = 0; 1432 } 1433 1434 # Return result 1435 return (); 1436} 1437 1438# elseif - begin a conditional section within conditional text 1439@_elseif_MacroArgs = @_elsif_MacroArgs; 1440sub elseif_Macro { 1441 local(%arg) = @_; 1442 local(@text); 1443 1444 return &elsif_Macro(%arg); 1445} 1446 1447# else - begin an else section within conditional text 1448@_else_MacroArgs = (); 1449sub else_Macro { 1450 local(%arg) = @_; 1451 local(@text); 1452 local($level); 1453 1454 # else not permitted outside an if macro 1455 unless (@'sdf_if_now) { 1456 &'AppMsg("error", "!else not expected"); 1457 return (); 1458 } 1459 1460 # Get the current nesting level 1461 $level = $#main'sdf_if_yet; 1462 1463 # record that we have encountered the else 1464 # (this is needed for checking that an elsif does not follow it) 1465 $'sdf_if_else[$level] = 1; 1466 1467 # Only include this section if we haven't included a section yet 1468 if (! $'sdf_if_yet[$level]) { 1469 $'sdf_if_now[$level] = 1; 1470 $'sdf_if_yet[$level] = 1; 1471 } 1472 else { 1473 $'sdf_if_now[$level] = 0; 1474 } 1475 1476 # Return result 1477 return (); 1478} 1479 1480# endif - end conditional text 1481@_endif_MacroArgs = (); 1482sub endif_Macro { 1483 local(%arg) = @_; 1484 local(@text); 1485 1486 # endif not permitted outside an if macro 1487 unless (@'sdf_if_now) { 1488 &'AppMsg("error", "!endif not expected"); 1489 return (); 1490 } 1491 1492 pop(@'sdf_if_start); 1493 pop(@'sdf_if_now); 1494 pop(@'sdf_if_yet); 1495 pop(@'sdf_if_else); 1496 1497 # Return result 1498 return (); 1499} 1500 1501##### Looping Macros ##### 1502 1503# for - begin a loop 1504@_for_MacroArgs = ( 1505 'Name Type Default Rule', 1506 'name symbol', 1507 'values rest', 1508); 1509sub for_Macro { 1510 local(%arg) = @_; 1511 local(@text); 1512 1513 # Return result 1514 return (); 1515} 1516 1517# endfor - end loop 1518@_endfor_MacroArgs = (); 1519sub endfor_Macro { 1520 local(%arg) = @_; 1521 local(@text); 1522 1523 # Return result 1524 @text = (); 1525 return @text; 1526} 1527 1528##### Table Macros ##### 1529 1530# table - begin a table 1531@_table_MacroArgs = ( 1532 'Name Type Default Rule', 1533 'columns integer', 1534 'params rest _NULL_', 1535); 1536sub table_Macro { 1537 local(%arg) = @_; 1538 local(@text); 1539 local(@format, $format); 1540 local($lower, $sep, $upper); 1541 local(%param); 1542 local($col, $unspecified); 1543 1544 # Update the state 1545 push(@'sdf_tbl_state, 1); 1546 push(@'sdf_tbl_start, $'app_lineno); 1547 1548 # Validate and clean the parameters 1549 %param = &SdfTableParams('table', $arg{'params'}, *tableparams_name, 1550 *tableparams_type, *tableparams_rule); 1551 1552 # Use the default style, if necessary 1553 $param{'style'} = &Var('DEFAULT_TABLE_STYLE') if $param{'style'} eq ''; 1554 1555 # Expand the format attribute to make processing within the driver 1556 # routines easier: 1557 # * % is appended for percentages 1558 # * '*' is expanded to '1*' 1559 # * '-' is expanded to '0%-100%' (likewise for =) 1560 # * '-d' is expanded to '0%-d' (likewise for =) 1561 # * 'd-' is expanded to 'd-100%' (likewise for =) 1562 # * defaults are applied for unspecified widths: 1563 # - the last unspecified width is 1* (or 0%-100% for narrow tables) 1564 # - other unspecified widths are 0%-100%. 1565 @format = (); 1566 if ($param{'format'} =~ /^\d+$/) { 1567 for $format (split(//, $param{'format'})) { 1568 push(@format, $format * 10 . "%"); 1569 } 1570 } 1571 else { 1572 for $format (split(/\s*,\s*/, $param{'format'})) { 1573 if ($format =~ /^\d+$/) { 1574 $format .= '%'; 1575 } 1576 elsif ($format eq '*') { 1577 $format = "1*"; 1578 } 1579 elsif ($format =~ /([-=])/) { 1580 $lower = $` eq '' ? '0%' : $`; 1581 $sep = $1; 1582 $upper = $' eq '' ? '100%' : $'; 1583 $lower .= '%' if $lower =~ /^\d+$/; 1584 $upper .= '%' if $upper =~ /^\d+$/; 1585 $format = "$lower$sep$upper"; 1586 } 1587 push(@format, $format); 1588 } 1589 } 1590 $unspecified = $param{'narrow'} ? '0%-100%' : '1*'; 1591 for ($col = $arg{'columns'} - 1; $col >= 0; $col--) { 1592 if ($format[$col] eq '') { 1593 $format[$col] = $unspecified; 1594 $unspecified = '0%-100%'; 1595 } 1596 } 1597 $param{'format'} = join(",", @format); 1598 delete $param{'narrow'}; 1599 1600 # Build the result 1601 @text = (&'SdfJoin("__table", $arg{'columns'}, %param)); 1602 1603 # Return result 1604 return @text; 1605} 1606 1607# row - begin a table row 1608@_row_MacroArgs = ( 1609 'Name Type Default Rule', 1610 'type string Body <Body|Heading|Footing|Group>', 1611 'params rest _NULL_', 1612); 1613sub row_Macro { 1614 local(%arg) = @_; 1615 local(@text); 1616 local(%param); 1617 1618 # Check the state 1619 unless (@'sdf_tbl_state) { 1620 &'AppMsg("error", "!row not expected"); 1621 return (); 1622 } 1623 1624 # For performance, handle the empty parameters case first 1625 return ('__row[]Body') unless $arg{'type'}.$arg{'params'}; 1626 1627 # Validate and clean the parameters 1628 %param = &SdfTableParams('row', $arg{'params'}, *rowparams_name, 1629 *rowparams_type, *rowparams_rule); 1630 1631 # Build the result 1632 @text = (&'SdfJoin("__row", $arg{'type'}, %param)); 1633 1634 # Return result 1635 return @text; 1636} 1637 1638# cell - begin a table cell 1639@_cell_MacroArgs = ( 1640 'Name Type Default Rule', 1641 'params rest _NULL_', 1642); 1643sub cell_Macro { 1644 local(%arg) = @_; 1645 local(@text); 1646 local(%param); 1647 1648 # Check the state 1649 unless (@'sdf_tbl_state) { 1650 &'AppMsg("error", "!cell not expected"); 1651 return (); 1652 } 1653 1654 # For performance, handle the empty parameters case first 1655 return ('__cell[]') if $arg{'params'} eq ''; 1656 1657 # Validate and clean the parameters 1658 %param = &SdfTableParams('cell', $arg{'params'}, *cellparams_name, 1659 *cellparams_type, *cellparams_rule); 1660 1661 # Build the result 1662 @text = (&'SdfJoin("__cell", '', %param)); 1663 1664 # Return result 1665 return @text; 1666} 1667 1668# endtable - end a table 1669@_endtable_MacroArgs = (); 1670sub endtable_Macro { 1671 local(%arg) = @_; 1672 local(@text); 1673 1674 # Check the state 1675 unless (@'sdf_tbl_state) { 1676 &'AppMsg("error", "!endtable not expected"); 1677 return (); 1678 } 1679 1680 # Update the state 1681 pop(@'sdf_tbl_state); 1682 pop(@'sdf_tbl_start); 1683 1684 # Build the result 1685 @text = (&'SdfJoin("__endtable", '')); 1686 1687 # Return result 1688 return @text; 1689} 1690 1691##### Header/footer Macros ##### 1692 1693# build_header - build a header macro 1694@_build_header_MacroArgs = ( 1695 'Name Type Default Rule', 1696 'pages string', 1697 'component string _NULL_', 1698 'parts rest _NULL_', 1699); 1700sub build_header_Macro { 1701 local(%arg) = @_; 1702# local(@text); 1703 local(@pages, %parts); 1704 1705 # Get the arguments 1706 @pages = split(/,/, $arg{'pages'}); 1707 %parts = &'SdfAttrSplit($arg{'parts'}); 1708 1709 # Return result 1710 return &_PageHF('HEADER', 1, $arg{'component'}, *pages, *parts); 1711} 1712 1713# build_footer - build a footer macro 1714@_build_footer_MacroArgs = ( 1715 'Name Type Default Rule', 1716 'pages string', 1717 'component string _NULL_', 1718 'parts rest _NULL_', 1719); 1720sub build_footer_Macro { 1721 local(%arg) = @_; 1722# local(@text); 1723 local(@pages, %parts); 1724 1725 # Get the arguments 1726 @pages = split(/,/, $arg{'pages'}); 1727 %parts = &'SdfAttrSplit($arg{'parts'}); 1728 1729 # Return result 1730 return &_PageHF('FOOTER', 1, $arg{'component'}, *pages, *parts); 1731} 1732 1733# edit_header - edit a header macro 1734@_edit_header_MacroArgs = ( 1735 'Name Type Default Rule', 1736 'pages string', 1737 'component string _NULL_', 1738 'parts rest _NULL_', 1739); 1740sub edit_header_Macro { 1741 local(%arg) = @_; 1742# local(@text); 1743 local(@pages, %parts); 1744 1745 # Get the arguments 1746 @pages = split(/,/, $arg{'pages'}); 1747 %parts = &'SdfAttrSplit($arg{'parts'}); 1748 1749 # Return result 1750 return &_PageHF('HEADER', 0, $arg{'component'}, *pages, *parts); 1751} 1752 1753# edit_footer - edit a footer macro 1754@_edit_footer_MacroArgs = ( 1755 'Name Type Default Rule', 1756 'pages string', 1757 'component string _NULL_', 1758 'parts rest _NULL_', 1759); 1760sub edit_footer_Macro { 1761 local(%arg) = @_; 1762# local(@text); 1763 local(@pages, %parts); 1764 1765 # Get the arguments 1766 @pages = split(/,/, $arg{'pages'}); 1767 %parts = &'SdfAttrSplit($arg{'parts'}); 1768 1769 # Return result 1770 return &_PageHF('FOOTER', 0, $arg{'component'}, *pages, *parts); 1771} 1772 1773 1774##### Extraction Macros ##### 1775 1776# getdoc - get (SDF) documentation from a file 1777@_getdoc_MacroArgs = @_include_MacroArgs; 1778sub getdoc_Macro { 1779 local(%arg) = @_; 1780 local(@text); 1781 1782 # Return result 1783 return &CommandMacro("sdfget -r -g", %arg); 1784} 1785 1786# getcode - get source code (i.e. non-documentation) from a file 1787@_getcode_MacroArgs = @_include_MacroArgs; 1788sub getcode_Macro { 1789 local(%arg) = @_; 1790 local(@text); 1791 1792 # Return result 1793 return &CommandMacro("sdfget -i -g", %arg); 1794} 1795 1796# getusage - get the Command Line Interface for a script 1797@_getusage_MacroArgs = ( 1798 'Name Type Default Rule', 1799 'command string', 1800 'filter filter _NULL_', 1801 'params rest _NULL_', 1802); 1803sub getusage_Macro { 1804 local(%arg) = @_; 1805 local(@text); 1806 1807 # Execute the command 1808 my $command = $arg{'command'}; 1809 unless (&FileFetch(*text, "sdfcli $command|")) { 1810 &'AppMsg("warning", "unable to execute sdfcli on '$command'"); 1811 return (); 1812 } 1813 1814 # Filter the text 1815 &ExecFilter($arg{'filter'}, *text, $arg{'params'}); 1816 1817 # Return result 1818 return ("!_bof_ 'sdfcli $command'", @text, "!_eof_"); 1819} 1820 1821# perlapi - get the Application Programming Interface for a Perl library 1822@_perlapi_MacroArgs = @_include_MacroArgs; 1823sub perlapi_Macro { 1824 local(%arg) = @_; 1825 local(@text); 1826 1827 # Return result 1828 return &CommandMacro('sdfapi -j', %arg); 1829} 1830 1831##### Event Processing Macros ##### 1832 1833# on - specify processing for an event 1834@_on_MacroArgs = ( 1835 'Name Type Default Rule', 1836 'type symbol <paragraph|phrase|macro|filter|table>', 1837 'mask string', 1838 'id eventid _NULL_ <\w+>', 1839 'code rest', 1840); 1841sub on_Macro { 1842 local(%arg) = @_; 1843 local(@text); 1844 local($type); 1845 1846 # Store the event 1847 $type = $arg{'type'}; 1848 if ($type eq 'paragraph') { 1849 push(@evcode_paragraph, $arg{'code'}); 1850 push(@evmask_paragraph, $arg{'mask'}); 1851 push(@evid_paragraph, $arg{'id'}); 1852 } 1853 elsif ($type eq 'phrase') { 1854 push(@evcode_phrase, $arg{'code'}); 1855 push(@evmask_phrase, $arg{'mask'}); 1856 push(@evid_phrase, $arg{'id'}); 1857 } 1858 elsif ($type eq 'macro') { 1859 push(@evcode_macro, $arg{'code'}); 1860 push(@evmask_macro, $arg{'mask'}); 1861 push(@evid_macro, $arg{'id'}); 1862 } 1863 elsif ($type eq 'filter') { 1864 push(@evcode_filter, $arg{'code'}); 1865 push(@evmask_filter, $arg{'mask'}); 1866 push(@evid_filter, $arg{'id'}); 1867 } 1868 elsif ($type eq 'table') { 1869 push(@evcode_table, $arg{'code'}); 1870 push(@evmask_table, $arg{'mask'}); 1871 push(@evid_table, $arg{'id'}); 1872 } 1873 1874 # Return result 1875 return (); 1876} 1877 1878# off - begin conditional text 1879@_off_MacroArgs = ( 1880 'Name Type Default Rule', 1881 'type symbol <paragraph|phrase|macro|filter|table>', 1882 'id eventid <\w+>', 1883); 1884sub off_Macro { 1885 local(%arg) = @_; 1886 local(@text); 1887 local($type, $id, $num); 1888 1889 # Find & delete the event, if any 1890 $type = $arg{'type'}; 1891 $id = $arg{'id'}; 1892 if ($type eq 'paragraph') { 1893 $num = &_EventFind(*evid_paragraph, $id); 1894 if ($num != -1) { 1895 $evcode_paragraph[$num] = ''; 1896 $evid_paragraph[$num] = ''; 1897 } 1898 } 1899 elsif ($type eq 'phrase') { 1900 $num = &_EventFind(*evid_phrase, $id); 1901 if ($num != -1) { 1902 $evcode_phrase[$num] = ''; 1903 $evid_phrase[$num] = ''; 1904 } 1905 } 1906 elsif ($type eq 'macro') { 1907 $num = &_EventFind(*evid_macro, $id); 1908 if ($num != -1) { 1909 $evcode_macro[$num] = ''; 1910 $evid_macro[$num] = ''; 1911 } 1912 } 1913 elsif ($type eq 'filter') { 1914 $num = &_EventFind(*evid_filter, $id); 1915 if ($num != -1) { 1916 $evcode_filter[$num] = ''; 1917 $evid_filter[$num] = ''; 1918 } 1919 } 1920 elsif ($type eq 'table') { 1921 $num = &_EventFind(*evid_table, $id); 1922 if ($num != -1) { 1923 $evcode_table[$num] = ''; 1924 $evid_table[$num] = ''; 1925 } 1926 } 1927 1928 # Check the event exists 1929 if ($num == -1) { 1930 &'AppMsg("warning", "unknown event '$id'"); 1931 } 1932 1933 # Return result 1934 return (); 1935} 1936 1937##### Miscellaneous Macros ##### 1938 1939# insert - insert the output from a macro 1940@_insert_MacroArgs = ( 1941 'Name Type Default Rule', 1942 'macro string', 1943 'missing string ok <ok|error|warning>', 1944); 1945sub insert_Macro { 1946 local(%arg) = @_; 1947 local(@text); 1948 local($name, $args); 1949 1950 # Return result 1951 ($name, $args) = split(/\s+/, $arg{'macro'}, 2); 1952 return &ExecMacro($name, $args, $arg{'missing'}); 1953} 1954 1955# output - change the output file 1956@_output_MacroArgs = ( 1957 'Name Type Default Rule', 1958 'outfile string', 1959); 1960sub output_Macro { 1961 local(%arg) = @_; 1962 local(@text); 1963 1964 # Return result 1965 return ("__output[]" . $arg{'outfile'}); 1966} 1967 1968# message - output a message during execution 1969@_message_MacroArgs = ( 1970 'Name Type Default Rule', 1971 'text string', 1972 'type string Object <Object|Warning|Error|warning|error>', 1973); 1974sub message_Macro { 1975 local(%arg) = @_; 1976 local(@text); 1977 local($type); 1978 1979 # Output the message 1980 $type = "\L$arg{'type'}"; 1981 &'AppMsg($type, $arg{'text'}); 1982 1983 # Return result 1984 return (); 1985} 1986 1987# line - change message parameters 1988@_line_MacroArgs = ( 1989 'Name Type Default Rule', 1990 'lineno integer', 1991 'filename string _NULL_', 1992 'context string line', 1993); 1994sub line_Macro { 1995 local(%arg) = @_; 1996 local(@text); 1997 1998 # Update the message variables 1999 $'app_lineno = $arg{'lineno'}; 2000 $'app_context = $arg{'context'}; 2001 $'app_context .= " " unless $'app_context =~ / $/; 2002 if ($arg{'filename'} ne '') { 2003 $'ARGV = $arg{'filename'}; 2004 $var{'FILE_PATH'} = &'NameAbsolute($'ARGV); 2005 @var{'FILE_DIR', 'FILE_BASE', 'FILE_EXT', 'FILE_SHORT'} = 2006 &'NameSplit($var{'FILE_PATH'}); 2007 2008 # Update the file and document modified times. Note that 2009 # we use a constant (1e9 = 09-Sep-2001) during regression 2010 # testing to minimise file differences. 2011 $var{'FILE_MODIFIED'} = $var{'SDF_TEST'} ? 1e9 : (stat($'ARGV))[9]; 2012 $var{'DOC_MODIFIED'} = $var{'FILE_MODIFIED'} if 2013 $var{'DOC_MODIFIED'} < $var{'FILE_MODIFIED'}; 2014 2015 # For the first file, set the document wide values 2016 if (!defined $var{'DOC_BASE'}) { 2017 $var{'DOC_PATH'} = $var{'FILE_PATH'}; 2018 $var{'DOC_DIR'} = $var{'FILE_DIR'}; 2019 $var{'DOC_BASE'} = $var{'FILE_BASE'}; 2020 $var{'DOC_EXT'} = $var{'FILE_EXT'}; 2021 $var{'DOC_SHORT'} = $var{'FILE_SHORT'}; 2022 } 2023 } 2024 2025 # Return result 2026 return (); 2027} 2028 2029# macro_interface - build the interface section for an SDF macro 2030@_macro_interface_MacroArgs = ( 2031 'Name Type Default Rule', 2032 'name string', 2033 'sep_reqd string _NULL_', 2034); 2035sub macro_interface_Macro { 2036 local(%arg) = @_; 2037 local(@text); 2038 local($name, @arg_list); 2039 local($format, @rules); 2040 local(@flds, $rec, %values); 2041 local($sep_reqd, $sep, $arg, $type); 2042 2043 # Build usage 2044 $name = $arg{'name'}; 2045 @text = ("The general syntax is:", 2046 "E: !{{2:$name}}"); 2047 2048 # Add the arguments, if any 2049 @arg_list = eval "\@_${name}_MacroArgs"; 2050 if (@arg_list) { 2051 push(@text, 2052 "", 2053 "The arguments are:", 2054 "", 2055 "!block table; format='16,16,20,48'", 2056 @arg_list, 2057 "!endblock" 2058 ); 2059 2060 # Update the usage 2061 ($format, @rules) = &'TableParse(@arg_list); 2062 @flds = &'TableFields($format); 2063 $sep = ''; 2064 $sep_reqd = $arg{'sep_reqd'}; 2065 for $rec (@rules) { 2066 %values = &'TableRecSplit(*flds, $rec); 2067 $arg = $values{'Name'}; 2068 if ($sep_reqd eq $arg) { 2069 $arg = "$sep [$arg]"; 2070 } 2071 else { 2072 $arg = "$sep $arg" if $sep; 2073 $arg = "[$arg]" if $values{'Default'} ne ''; 2074 } 2075 $text[1] .= " $arg"; 2076 2077 # Get the separator for the NEXT argument 2078 $type = $values{'Type'}; 2079 $sep = ($type =~ /^symbol$|^rest$/) ? '' : ';'; 2080 } 2081 } 2082 2083 # Add the help text, if any 2084 unshift(@text, "!insert 'MACRO_INTERFACE_BEGIN'"); 2085 push(@text, "!insert 'MACRO_INTERFACE_END'"); 2086 2087 # Return result 2088 return @text; 2089} 2090 2091# filter_interface - build the interface section for an SDF filter 2092@_filter_interface_MacroArgs = ( 2093 'Name Type Default Rule', 2094 'name string', 2095); 2096sub filter_interface_Macro { 2097 local(%arg) = @_; 2098 local(@text); 2099 local($name, @params, @fields); 2100 2101 # Build usage 2102 $name = $arg{'name'}; 2103 @text = ( 2104 "The general syntax is:", 2105 "E: !block {{2:$name}}", 2106 "E: ...", 2107 "E: !endblock"); 2108 2109 # Add the parameters, if any 2110 @params = eval "\@_${name}_FilterParams"; 2111 if (@params) { 2112 $text[1] .= "[; parameters]"; 2113 if ($params[0] ne 'ANY') { 2114 push(@text, 2115 "", 2116 "The parameters are:", 2117 "", 2118 "!block table", 2119 @params, 2120 "!endblock" 2121 ); 2122 } 2123 } 2124 2125 # Add the fields, if any 2126 @fields = eval "\@_${name}_FilterModel"; 2127 if (@fields) { 2128 $text[2] =~ s/\.\.\./{{table}}/; 2129 push(@text, 2130 "", 2131 "The table fields are:", 2132 "", 2133 "!block table", 2134 @fields, 2135 "!endblock" 2136 ); 2137 } 2138 2139 # Add the help text, if any 2140 unshift(@text, "!insert 'FILTER_INTERFACE_BEGIN'"); 2141 push(@text, "!insert 'FILTER_INTERFACE_END'"); 2142 2143 # Return result 2144 return @text; 2145} 2146 2147# class - build the interface section for an SDF class 2148@_class_interface_MacroArgs = ( 2149 'Name Type Default Rule', 2150 'name string', 2151); 2152sub class_interface_Macro { 2153 local(%arg) = @_; 2154 local(@text); 2155 local($name, @fields); 2156 2157 # Build usage 2158 $name = $arg{'name'}; 2159 @text = ( 2160 "The general syntax is:", 2161 "E: !block {{2:$name}}[; parameters]", 2162 "E: table of objects", 2163 "E: !endblock"); 2164 2165 # Add the fields, if any 2166 @fields = eval "\@_${name}_FilterModel"; 2167 if (@fields) { 2168 push(@text, 2169 "", 2170 "The object attributes are:", 2171 "", 2172 "!block table", 2173 &'TableFormat(*fields), 2174 "!endblock" 2175 ); 2176 } 2177 2178 # Add the help text, if any 2179 unshift(@text, "!insert 'CLASS_INTERFACE_BEGIN'"); 2180 push(@text, "!insert 'CLASS_INTERFACE_END'"); 2181 2182 # Return result 2183 return @text; 2184} 2185 2186##### Internal Macros ##### 2187 2188# _bof_ - beginning of file processing 2189@__bof__MacroArgs = ( 2190 'Name Type Default Rule', 2191 'filename string _NULL_', 2192); 2193sub _bof__Macro { 2194 local(%arg) = @_; 2195 local(@text); 2196 local($new_file); 2197 2198 # Push the state stack 2199 push(@_file_info, join("\000", $'ARGV, $'app_lineno, $'app_context, 2200 scalar(@'sdf_if_now), scalar(@'sdf_tbl_state))); 2201 2202 # Update the message state 2203 $new_file = $arg{'filename'}; 2204 if ($new_file ne '') { 2205 @text = ("!line 0; '$new_file'"); 2206 } 2207 2208 # Return result 2209 return (@text); 2210} 2211 2212# _eof_ - end of file processing 2213@__eof__MacroArgs = (); 2214sub _eof__Macro { 2215 local(%arg) = @_; 2216 local(@text); 2217 local($old_file, $old_line, $if_level, $tbl_level); 2218 local($start); 2219 local($missing, $last_index); 2220 2221 # Pop the state stack 2222 ($old_file, $old_line, $old_context, $if_level, $tbl_level) = 2223 split(/\000/, pop(@_file_info)); 2224 2225 # Adjust the line number & set the context for messages 2226 $'app_lineno--; 2227 $'app_context = "EOF at "; 2228 2229 # Check not in a block or macro 2230 if ($'sdf_block_type ne '') { 2231 $start = $'sdf_block_start; 2232 &'AppMsg("error", "!end$'sdf_block_type missing for !$'sdf_block_type on line $start"); 2233 2234 # restore the state to something safe 2235 $'sdf_block_type = ''; 2236 } 2237 2238 # Check if nesting level is ok 2239 $missing = scalar(@'sdf_if_now) - $if_level; 2240 if ($missing != 0) { 2241 $start = $'sdf_if_start[$#main'sdf_if_start]; 2242 &'AppMsg("error", "!endif missing for !if on line $start"); 2243 2244 # pop unexpected ones so that things resync 2245 $last_index = $if_level - 1; 2246 $#main'sdf_if_start = $last_index; 2247 $#main'sdf_if_now = $last_index; 2248 $#main'sdf_if_yet = $last_index; 2249 $#main'sdf_if_else = $last_index; 2250 } 2251 2252 # Check table nesting level is ok 2253 $missing = scalar(@'sdf_tbl_state) - $tbl_level; 2254 if ($missing != 0) { 2255 $start = $'sdf_tbl_start[$#main'sdf_tbl_start]; 2256 &'AppMsg("error", "!endtable missing for !table on line $start"); 2257 2258 # pop unexpected ones so that things resync 2259 $last_index = $tbl_level - 1; 2260 $#main'sdf_tbl_start = $last_index; 2261 $#main'sdf_tbl_state = $last_index; 2262 } 2263 2264 # Restore the message state 2265 @text = ("!line $old_line; '$old_file'; '$old_context'"); 2266 2267 # Return result 2268 return (@text); 2269} 2270 2271# _bos_ - begin a section 2272# The performance of this routine is critical so it handles its own arguments 2273sub _bos__Macro { 2274 local($args) = @_; 2275 2276 # Update the line number and context 2277 ($'app_lineno, $'app_context) = split(/\;/, $args, 2); 2278 2279 # Update the section counter 2280 $'sdf_sections++; 2281} 2282 2283# _eos_ - end of section 2284# The performance of this routine is critical so it handles its own arguments 2285sub _eos__Macro { 2286 local($args) = @_; 2287 2288 # Update the line number and context 2289 ($'app_lineno, $'app_context) = split(/\;/, $args, 2); 2290 2291 # Update the section counter 2292 $'sdf_sections--; 2293} 2294 2295# _bor_ - beginning of report processing 2296@__bor__MacroArgs = ( 2297 'Name Type Default Rule', 2298 'name symbol', 2299 'params rest _NULL_', 2300); 2301sub _bor__Macro { 2302 local(%arg) = @_; 2303# local(); 2304 local($name); 2305 local($rpt_file); 2306 local($begin_fn); 2307 2308 # Update the state 2309 $name = $arg{'name'}; 2310 push(@'sdf_report_names, $name); 2311 2312 # Load the report 2313 $rpt_file = &FindModule(&'NameJoin('', $name, 'sdr')); 2314 if ($rpt_file) { 2315 unless (require $rpt_file) { 2316 &'AppMsg("error", "unable to load report '$rpt_file'"); 2317 return (); 2318 } 2319 } 2320 else { 2321 &'AppMsg("error", "unable to find report '$name'"); 2322 return (); 2323 } 2324 2325 # Begin the report 2326 $begin_fn = $name . "_ReportBegin"; 2327 if (defined &$begin_fn) { 2328 &$begin_fn(&SdfFilterParams($name, $params)); 2329 } 2330 2331 # Return result 2332 return (); 2333} 2334 2335# _eor_ - end of report processing 2336@__eor__MacroArgs = (); 2337sub _eor__Macro { 2338 local(%arg) = @_; 2339 local(@text); 2340 local($name); 2341 local($end_fn); 2342 2343 # Update the state 2344 $name = pop(@'sdf_report_names); 2345 2346 # End the report 2347 $end_fn = $name . "_ReportEnd"; 2348 if (defined &$end_fn) { 2349 @text = &$end_fn(); 2350 } 2351 else { 2352 &'AppMsg("warning", "unable to find report end routine '$end_fn'"); 2353 } 2354 2355 # Return result 2356 return @text; 2357} 2358 2359# _store_ - store an object 2360@__store__MacroArgs = ( 2361 'Name Type Default Rule', 2362 'object rest', 2363); 2364sub _store__Macro { 2365 local(%arg) = @_; 2366# local(); 2367 local($args); 2368 local($class, $cited, $name_fld, $name, $long_fld, $long, %values); 2369 local($cite); 2370 local($prop, @properties); 2371 2372 # Get the arguments. Note that Perl 5.004 explicitly warns about 2373 # an odd number of elements in a hash list, so we need to explicitly 2374 # check for this and work around it. :-( 2375 $args = $arg{'object'}; 2376 ($class, $cited, $name_fld, $name, $long_fld, $long, %values) = 2377 $args =~ /\000$/ ? 2378 (split(/\000/, $args), '') : 2379 split(/\000/, $args); 2380 2381 # Add the name to the catalog for the class, if not already done 2382 $_class{$class,'catalog'} .= "$name\n" unless $obj_name{$class,$name}; 2383 2384 # Mark the object as cited, if requested 2385 if ($cited && ! $obj_name{$class, $name, 'Cite'}) { 2386 $_class{$class,'cited'} .= "$name\n"; 2387 $cite = ++$_class{$class,'cite_count'}; 2388 $values{'Cite'} = "[$cite]"; 2389 } 2390 2391 # Store the name(s) 2392 $obj_name{$class,$name} = 1; 2393 $obj_name{$class,$name,$long_fld} = $long; 2394 $obj_long{$class,$long} = 1; 2395 $obj_long{$class,$long,$name_fld} = $name; 2396 2397 # Store the properties, if any 2398 @properties = split(/,/, $_class{$class,'properties'}); 2399 push(@properties, 'Cite') if $cited; 2400 for $prop (@properties) { 2401 if ($values{$prop} ne '') { 2402 $obj_name{$class,$name,$prop} = $values{$prop}; 2403#printf STDERR "%s=%s<\n", "$class.$name.$prop", $values{$prop}; 2404 $obj_long{$class,$long,$prop} = $values{$prop}; 2405 } 2406 } 2407} 2408 2409# _load_look_ - load the look library 2410@__load_look__MacroArgs = (); 2411sub _load_look__Macro { 2412 local(%arg) = @_; 2413 local(@text); 2414 local($look); 2415 local($style); 2416 2417 # Get the look and style 2418 $look = $var{'OPT_LOOK'}; 2419 $style = $var{'OPT_STYLE'}; 2420 2421 # Support old style names to improve backwards compatibility 2422 if ($look eq 'plain') { 2423 $look = 'simple'; 2424 $var{'OPT_LOOK'} = $look; 2425 } 2426 if ($style eq 'newsletter') { 2427 $style = 'newslttr'; 2428 $var{'OPT_STYLE'} = $style; 2429 } 2430 2431 # If paged output is being generated: 2432 # * Init the page size, 2433 # * load the look library, 2434 # * load the style module, and 2435 # * calculate the layout variables. 2436 @text = (); 2437 if ($var{'DOC_PAGED'}) { 2438 push(@text, 2439 "!_init_page_size_", 2440 "!inherit 'look/$look'", 2441 "!use '$style.sds'", 2442 "!_calc_layout_vars_"); 2443 } 2444 2445 # Return result 2446 return @text; 2447} 2448 2449# _init_page_size - initialise the page width and height 2450@_init_page_size__MacroArgs = (); 2451sub _init_page_size__Macro { 2452# local(%arg) = @_; 2453# local(@text); 2454 local($page_size, $page_width, $page_height); 2455 2456 $page_size = $'sdf_pagesize{$var{'OPT_PAGE_SIZE'}}; 2457 if ($page_size ne '') { 2458 ($page_width, $page_height) = split(/\000/, $page_size, 2); 2459 } 2460 else { 2461 # Custom size 2462 ($page_width, $page_height) = split(/x/, $var{'OPT_PAGE_SIZE'}, 2); 2463 } 2464 $page_width = &'SdfPoints($page_width); 2465 $page_height = &'SdfPoints($page_height); 2466 $var{'DOC_PAGE_WIDTH'} = $page_width; 2467 $var{'DOC_PAGE_HEIGHT'} = $page_height; 2468 2469 # Return result 2470 return (); 2471} 2472 2473# _calc_layout_vars_ - calculate the layout information variables 2474@__calc_layout_vars__MacroArgs = (); 2475sub _calc_layout_vars__Macro { 2476# local(%arg) = @_; 2477# local(@text); 2478 local($h_top, $h_height, $f_height, $f_top, $m_top, $m_height); 2479 local($full_width, $text_width, $columns, $col_width); 2480 2481 # Calculate the height information 2482 $h_top = &'SdfVarPoints("OPT_MARGIN_TOP"); 2483 $h_height = &'SdfPageInfo("RIGHT", "HEADER_HEIGHT", "pt"); 2484 $f_height = &'SdfPageInfo("RIGHT", "FOOTER_HEIGHT", "pt"); 2485 $f_top = $var{'DOC_PAGE_HEIGHT'} - $f_height - 2486 &'SdfVarPoints("OPT_MARGIN_BOTTOM"); 2487 $m_top = $h_top + $h_height + 2488 &'SdfPageInfo("RIGHT", "HEADER_GAP", "pt"); 2489 $m_height = $f_top - $m_top - 2490 &'SdfPageInfo("RIGHT", "FOOTER_GAP", "pt"); 2491 2492 # Initialise the number of columns 2493 $var{'OPT_COLUMNS'} = 1 if $var{'OPT_COLUMNS'} < 1; 2494 $columns = $var{'OPT_COLUMNS'}; 2495 2496 # Calculate the width information 2497 $full_width = $var{'DOC_PAGE_WIDTH'} - &'SdfVarPoints("OPT_MARGIN_OUTER") - 2498 &'SdfVarPoints("OPT_MARGIN_INNER"); 2499 $text_width = $full_width - &'SdfVarPoints("OPT_SIDEHEAD_WIDTH") - 2500 &'SdfVarPoints("OPT_SIDEHEAD_GAP"); 2501 $col_width = ($text_width - ($columns - 1) * $var{"OPT_COLUMN_GAP"}) / 2502 $columns; 2503 2504 # Set the variables 2505 $var{'DOC_TEXT_HEIGHT'} = $m_height; 2506 $var{'DOC_FULL_WIDTH'} = $full_width; 2507 $var{'DOC_TEXT_WIDTH'} = $text_width; 2508 $var{'DOC_COLUMN_WIDTH'} = $col_width; 2509 2510 # Return result 2511 return (); 2512} 2513 2514# _load_tuning - load the tuning for a document 2515@_load_tuning__MacroArgs = (); 2516sub _load_tuning__Macro { 2517 local(%arg) = @_; 2518 local(@text); 2519 local($name); 2520 local($target_module); 2521 2522 # Tell the output driver when we start 2523 $name = $var{'OPT_TUNING'}; 2524 @text = (&'SdfJoin("__tuning", $name)); 2525 2526 # Add the driver-specific stuff, if any 2527 $target_module = &FindModule(&'NameJoin('', $var{'OPT_DRIVER'}, 'sdn')); 2528 if ($target_module) { 2529 push(@text, "!include '$target_module'"); 2530 } 2531 2532 # Tell the output driver when we reach the end 2533 push(@text, "__endtuning[]"); 2534 2535 # Return the result 2536 return @text; 2537} 2538 2539# _load_config_ - load the configuration library 2540@_load_config__MacroArgs = (); 2541sub _load_config__Macro { 2542# local(%arg) = @_; 2543# local(@text); 2544 local($config); 2545 2546 $config = $var{'OPT_CONFIG'}; 2547 return ($config ne '') ? ("!inherit '$config'") : (); 2548} 2549 2550# package return value 25511; 2552