SourceForge.net Logo
March 3, 2009
© GPL
 
ProWikiCenter
Code /
Part6

 
sub StrColorRetSpan {
  my($s, $color)=@_;
  return "<span style='background-color: $color;'>$s</span>";
}

$CdmlHash{Marker}=\&CdmlMarker;
$CdmlHash{mark}=\&CdmlMarker;
$CdmlHash{highlight}=\&CdmlMarker;

$CdmlHash{Rot}=\&CdmlRed;
$CdmlHash{red}=\&CdmlRed;
$CdmlHash{rouge}=\&CdmlRed;

$CdmlHash{"Grün"}=\&CdmlGreen;
$CdmlHash{Unicode("Grün")}=\&CdmlGreen;
$CdmlHash{green}=\&CdmlGreen;
$CdmlHash{vert}=\&CdmlGreen;

$CdmlHash{Blau}=\&CdmlBlue;
$CdmlHash{blue}=\&CdmlBlue;
$CdmlHash{bleu}=\&CdmlBlue;

$CdmlHash{Gelb}=\&CdmlYellow;
$CdmlHash{yellow}=\&CdmlYellow;
$CdmlHash{jaune}=\&CdmlYellow;

$CdmlHash{Orange}=\&CdmlOrange;
$CdmlHash{orange}=\&CdmlOrange;

$CdmlHash{Pink}=\&CdmlPink;
$CdmlHash{pink}=\&CdmlPink;
$CdmlHash{rose}=\&CdmlPink;

$CdmlHash{Streichung}=\&CdmlStrike;
$CdmlHash{strike}=\&CdmlStrike;
$CdmlHash{"barré"}=\&CdmlStrike;
$CdmlHash{Unicode("barré")}=\&CdmlStrike;

[[code]

sub CreateMarkerBasic {

  my ($body,$h pars,$color,$plus strike)=@_;
  my ($ret,$rind,$tind);
  my $strike=HvnRetVal($h pars,'','Streichung','strike');
  my $tcol= HvnRetColor($h pars,'','Textfarbe','textcolor');

$body=TextCdmlRetText($body); LineMarkupImageLinksBasic($body,0,1,1);

if($RtfMode) { $rind=RtfColorTabRetInd($color); if($tcol ne '') { $tind=RtfColorTabRetInd($tcol); $tcol="\\cf$tind"; } $ret="{${tcol}\\chcbpat$rind $body}"; } else { if($tcol ne '') { $tcol=" color: $tcol;"; } if($color ne '') { $color=" background-color: $color;"; } $ret="<span style='$tcol$color'>$body</span>"; } if($strike || $plus strike) { if($RtfMode) { $ret="{\\strike $ret}"; } else { $ret="<strike>$ret</strike>"; } }

return $ret;

}

sub CdmlMarker {

  my($body,$h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.mark.defaults');
  my $color= HvnRetColor($h pars,'#aaccff','Farbe','color');
  return CreateMarkerBasic($body,$h pars,$color);
}

sub CdmlRed {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#ffaabb');
}

sub CdmlGreen {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#99ffcc');
}

sub CdmlBlue {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#aaccff');
}

sub CdmlYellow {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#ffffaa');
}

sub CdmlOrange {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#ffddbb');
}

sub CdmlPink {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#ffbbff');
}

sub CdmlStrike {

  my($body,$h pars)=@_;
  return CreateMarkerBasic($body,$h pars,'#e7e7e7',1);
}

sub TableCvtLineColorWidth {

  # my($table,$lcolor,$width)=@_;
  my $lcolor=$_[1];
  my $width=$_[2];
  my $twid=Cover($width," width=");
  my $lih=" bgcolor='$lcolor'";
  $_[0]="<table border='0' cellpadding='0' cellspacing='0' $lih$twid><tr><td>$_[0]</td></tr></table>";
}

$CdmlHash{'Tabelle'} = \&CdmlTable; $CdmlHash{'table'} = \&CdmlTable; sub CdmlTable {

  my ($body, $h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.table.defaults');
  my ($table,$line,@lines,@parts,$oldcell,$cell,@cells,$ncells,$n,$bg,$al,$c,$cal,$sw,@swar,$colspan);
  my ($test,$fmt,$fmtcol,$twid,@mar,$ufont);
  my $lsep= HvnRetVal($h pars,"\n",'Zeilentrennzeichen','lineseparator');
  my $width= HvnWidth($h pars,'');
  my $scale= HvnRetVal($h pars,1,'Skalierungsfaktor','scalefactor');
  my $ausrichtung=HvnRetVal($h pars,'llllllllllllllllllll','Ausrichtung','alignment','align');
  my $swid=HvnRetVal($h pars,'','Spaltenbreite','columnwidth');
  my $colfmtlist=HvnRetVal($h pars,'','Spaltenformat','columnformat');
  my $vbc=HvnRetVal($h pars,'','Formatzeichen','formatseparator');
  my $lwidth=HvnRetVal($h pars,2,'Linienbreite','linewidth');
  my $abstand=HvnRetVal($h pars,$TableDistance,'Abstand','distance');
  my $markups=HvnRetVal($h pars,'','Markups','markups');
  my $markup=HvnRetVal($h pars,1,'Markup','markup');
  my $linienfarbe= HvnRetColor($h pars,'#cccccc','Linienfarbe','linecolor');
  my $titelhintergrund=HvnRetColor($h pars,$TableTitlebackground,'Titelhintergrund','titlebackground');
  my $texthintergrund=HvnRetColor($h pars,$TableTextbackground,'Texthintergrund','textbackground');
  my $texthintergrund2=HvnRetColor($h pars,$texthintergrund,'Texthintergrund2','textbackground2');
  my $footerbg=HvnRetColor($h pars,'',"Fußhintergrund",Unicode("Fußhintergrund"),'footerbackground');
  my $art=HvnRetVal($h pars,'','Art','type');
  my $luft=HvnRetVal($h pars,3,'Luft','padding');
  my $sep=HvnRetVal($h pars,'','Trennzeichen','separator'); # later default=','
  my $tfont= HvnRetVal($h pars,'','Titelschriftart','titlefont');
  my $xfont= HvnRetVal($h pars,'','Textschriftart','textfont');
  my $ffont= HvnRetVal($h pars,'',"Fußschriftart",Unicode("Fußschriftart"),'footerfont');
  my $cnames=HvnRetVal($h pars,'','Spaltennamen','columnnames');
  my (@ctab,%cind,%cval,@cells0,$key,$val,$ind,$rows,$cells,$bcol,$bcol0,@colfmt);

my $doPara=1; my $doList=0; my $suppress; # connect/suppress cells

# StrCoverWildcards(\$vbc); $vbc =~ s/([?+*|^\\\/])/\\$1/g;

$twid=Cover($width," width=");

if($body =~ m#\[\[# ) { $body=TextCdmlRetText($body); }

$body =~ s/\r//sg; # damn shit... StrStripChrBoth($body,"\n");

if($abstand eq '-') { $abstand=''; }

if($lsep eq "\n") { $doPara=0; } else { $doList=1; } if($markups ne '') { $markup=''; } if($markup) { TextMarkupImagesLinksParasLists($body,1,1,$doPara,$doList); } if($colfmtlist ne '') { @colfmt=ListSplit($colfmtlist); }

my $tih=" bgcolor='$titelhintergrund'"; my $teh=" bgcolor='$texthintergrund'"; my $teh2=" bgcolor='$texthintergrund2'"; my $fh=" bgcolor='$footerbg'";

if(($art =~ m/unsichtbar/) || ($art =~ m/invisible/)) { $tih=; $teh=; $teh2=; $linienfarbe=; $fh=''; }

if($sep eq '') { $sep=$TableSeparator; } elsif($sep eq '\n') { $sep="/@#/"; $lsep="/@@/"; $body =~ s#\n\s*\n#$lsep#g; $body =~ s#\n#$sep#g; } else { $sep =~ s/([?+*|^\\\/\[\]])/\\$1/g; }

@lines=split($lsep,$body); @swar=split(";",$swid); @mar=split(";",$markups);

my $ccount; # FIXME: performance my $cmax=1;

if($cnames ne '') { @ctab=ListSplit($cnames); for($c=0; $c<=$#ctab; $c++) { $key=$ctab[$c]; $cind{$key}=$c; } $cmax=int(@ctab); } else { foreach $line (@lines) { $ccount=1+StrFindStrRetCount($line,$sep); if($ccount>$cmax) { $cmax=$ccount; } } }

my $twid1; if($twid ne '') { $twid1=" width=100%"; }

LINE:
  foreach $line (@lines) {
    if($line =~ m/^\s*$/) {
      next LINE;
    }
    if($n==0) {
      $bg=$tih; $ufont=$tfont; $bcol0=$titelhintergrund;
    } elsif($n & 1) {
      $bg=$teh;  $ufont=$xfont; $bcol0=$texthintergrund;
    } else {
      $bg=$teh2; $ufont=$xfont; $bcol0=$texthintergrund2;
    }
    if(($n==$#lines) && ($footerbg ne '')) {
      if($#lines!=0) {
        $bg=$fh; $ufont=$ffont;
      }
    }
    if($cnames ne '') {
      @cells=();
      foreach $cell (split($sep,$line)) {
        if( ($key,$val) = ( $cell =~ m/^\s*([^\s:=]+)\s*[:=](.*)$/s ) ) {
          if(defined $cind{$key}) {
            $cells[$cind{$key}]=$val;
          }
        }
      }
    } else {
       @cells=split($sep,$line);
    }

$c=0; $oldcell=; $suppress=0; $cells=; foreach $cell (@cells) { if($suppress>0) { $suppress--; $c++; next; } StrStripBoth($cell); $cal=substr($ausrichtung,$c,1);

$colspan=''; $fmtcol=''; if($vbc ne '') { ($test,$fmt) = ($cell =~ m/($vbc)(.*)$/); if($test eq '') { if($colfmt[$c]) { $test=$vbc; $fmt=$colfmt[$c]; $cell.=$vbc.$colfmt[$c]; } } if($test ne '') { $cell =~ s/($vbc)(.*)$//; if($fmt =~ m/^(.*)#(.*)$/ ) { $fmt=$1; $fmtcol=ColorRetCode($2); if($fmtcol eq '') { $fmtcol="#$2"; } } if($fmt =~ m/([lrzc])/) { $cal=$1; } if($fmt =~ m/(\d+)/) { $colspan=$1; $suppress=$colspan-1; } } } if(($cal eq 'z') || ($cal eq 'c')) { $al=" align='center'"; } elsif($cal eq 'r') { $al=" align='right'"; } elsif($cal eq 'b') { if($n > 0 || $teh eq $tih) { if(StrEmpty($cell)) { $cell=$oldcell; } $cell=ImageRetHtmlBar('/pixel/p1rot.gif',1+int($scale*$cell),12) ; } $al=" align='left'"; } else { $al=" align='left'"; } if(StrEmpty($cell)) { $cell=$n1; } if($n==0) { $sw=''; $sw=$swar[$c]; $sw=Cover($sw," width="); $al.=$sw; } if($colspan>0) { $colspan=" colspan=$colspan"; } $bcol=$fmtcol; if($fmtcol ne '') { $fmtcol=" bgcolor='$fmtcol'"; } if($mar[$c]>0) { TextMarkupImagesLinksParasLists($cell,0,1,$doPara,0); } if($RtfMode) { if($bcol eq '') { $bcol=$bcol0; } $cells .= RtfCell("{$cell}","#000000",$abstand+($c+1)*100,$bcol,$lwidth,$linienfarbe); } else { if($ufont ne '') { $cell=TextFontRetHtml($cell,$ufont); } $cells .= "<td$al$colspan$fmtcol>" . $cell . "</td>"; } $oldcell=$cell; $c++; } $c+=$suppress; while($c++<$cmax) { if($RtfMode) { $cells .= RtfCell("{ }","#000000",$abstand+($c+1)*100,$texthintergrund,$lwidth,$linienfarbe); } else { $cells .= "<td> </td>"; } } if($RtfMode) { $rows.=RtfCellsRetRow($cells,$abstand,$luft); } else { $rows.="<tr$bg>" . $cells . "</tr>\n"; } $n++; }

  1. my $cells=RtfCell($body,$fcol,$width,$bcol,$lwidth,$lcol);
  if($RtfMode) {
    $table=RtfRowsRetTable($rows);
  } else {
    my $marker='@@@314@@@';
    $table="<table border='0' cellspacing='$lwidth' cellpadding='$luft' $twid1>$marker</table>";
    TableCvtLineColorWidth($table,$linienfarbe,$width);
    TableCvtAbstandWidth($table,$abstand,$width);
    $table =~ s/$marker/$rows/;  # hack saving memory
  }

return $table;

}

sub FieldVarRetVal {

  my ($var)=@_;
  my $ret;

if($ret eq '') { $ret=RetParam($var); } if($ret eq '') { $ret=$$var; } return $ret;

}

sub FieldDefaultRetStr {

  my ($deflist)=@_;
  my $ret=$deflist;
  my @ar;
  my $def;

if(StrHasBrackets($deflist)>0) { goto do ret; } if($deflist =~ m/^;/) { @ar=split(/;/,$deflist) } else { @ar=($deflist); } foreach $def (@ar) { $ret=$def; if($def =~ s/^[\$]//) { $ret=''; $def=FieldVarRetVal($def); if($def ne '') { $ret=$def; goto do ret; } } else { goto do ret; } }

do ret:
  return $ret;
}

$CdmlHash{Eingabefeld} = \&CdmlInputfield; $CdmlHash{input} = \&CdmlInputfield; $CdmlHash{inputfield} = \&CdmlInputfield; sub CdmlInputfield {

  my ($body, $h pars)=@_;
  my $var=HvnRetVal($h pars,'test','Variable','variable');
  my $object=HvnRetVal($h pars,'','Vorgabe','Default','default');
  my $size=HvnSize($h pars,20);
  my $rows=HvnRetVal($h pars,1,'Zeilen','rows');
  my $cols=HvnRetVal($h pars,$size,'Spalten','columns');
  my $wrap=HvnRetVal($h pars,0,'Umbruch','wrap');
  my $hidden=HvnRetVal($h pars,'','Unsichtbar','hidden');

$object=FieldDefaultRetStr($object); if($rows>1) { $object =~ s/ *\\n */\n/; return FormTextArea($var,$object,$rows,$cols,$wrap); } return FormText($var,$object,$cols,$hidden);

}

]

[[code]

sub CommandProcess {

  my ($s)=@_;
  my $app;
  if($s =~ m/\$/) {
    $s =~ s/\{\$REFERER\}/{WikiRetRefererPage();}/ge;
    $s =~ s/\{\$PAGECUR.name\}/{$PageCur;}/ge;
  }
  return $s.$app;
}

$CdmlHash{"Schaltfläche"} = \&CdmlButton; $CdmlHash{Unicode("Schaltfläche")} = \&CdmlButton; $CdmlHash{button} = \&CdmlButton; sub CdmlButton {

  my ($body, $h pars)=@_;
  my $exec=HvnRetVal($h pars,'','Befehl','command');
  my $label=HvnRetVal($h pars,'','Beschriftung','label');
  if($label eq '') {
    $label=$body;
  }
  if($label eq '') {
    $label=Lu("Execute|Ausführen|Execute|Ejecutar");
  }
  $exec = CommandProcess($exec);
  $exec =~ s/&/&/g;  # Unquote common URL HTML
  if($exec ne '') {
    $exec='exec '.$exec;
  }
  return FormButton($exec,$label);
}

$CdmlHash{"Kontrollkästchen"} = \&CdmlCheckbox; $CdmlHash{Unicode("Kontrollkästchen")} = \&CdmlCheckbox; $CdmlHash{check} = \&CdmlCheckbox; $CdmlHash{checkbox} = \&CdmlCheckbox; sub CdmlCheckbox {

  my ($body, $h pars)=@_;
  my $var=HvnRetVal($h pars,'test','Variable','variable');
  my $label=HvnRetVal($h pars,Su("Ausführen"),'Beschriftung','label');
  my $object=HvnRetVal($h pars,'','Default','default');
  return FormCheck($var,$object,$label);
}

$CdmlHash{"Optionsschaltfläche"} = \&CdmlRadiobutton; $CdmlHash{Unicode("Optionsschaltfläche")} = \&CdmlRadiobutton; $CdmlHash{radio} = \&CdmlRadiobutton; $CdmlHash{radiobutton} = \&CdmlRadiobutton; sub CdmlRadiobutton {

  my ($body, $h pars)=@_;
  my $var=HvnRetVal($h pars,'test','Variable','variable');
  my $label=HvnRetVal($h pars,'','Beschriftung','label');
  my $value=HvnRetVal($h pars,'','Wert','value');
  my $object=HvnRetVal($h pars,'','Default','default');
  return FormRadio($var,$value,$object,$label);
}

$CdmlHash{Formular} = \&CdmlForm; $CdmlHash{form} = \&CdmlForm;

sub CdmlForm {

  my ($body, $h pars)=@_;
  my ($ret,%pars,$key,$fstart);
  my $type=HvnRetVal($h pars,'Suchen','Typ','type');
  my $url=HvnRetVal($h pars,'','Url','url');

if(StrEquList($type,'Suchen','search')) { $ret=WikiRetFormSearch($h pars); } else { $body=~ s/^\n+//; $body=TextCdmlRetText($body); TextMarkupImagesLinksParasLists($body,0,1,0,0); %pars=( 'distance' => 0,'titlebackground' =>'hellgrün','titlefont' =>'@#black', 'markup'=>0,'separator'=>'//','formatseparator'=>'@' ); HashAddHash(\%pars,$h pars); if($url ne '') { $fstart=FormStartUrl($url); } else { $fstart=FormStart("form input",''); } return $fstart . CdmlTable($body,\%pars) . FormEnd(); } return $ret;

}

sub LangRetColor {

  my ($lang)=@_;
  my $ret=$Context{"language.$lang.color"};
  if($ret eq '') {
    if ($lang eq 'de') {
      $ret='#ffffcc';
    } elsif ($lang eq 'en') {
      $ret='#cceeff';
    } elsif ($lang eq 'fr') {
      $ret='#ddffdd';
    } elsif ($lang eq 'ru') {
      $ret='#ffdddd';
    } else {
      $ret='#eeeeee';
    }
  }
  return $ret;
}

$CdmlHash{Mehrsprachig} = \&CdmlMultilingual; $CdmlHash{multilingual} = \&CdmlMultilingual;

sub CdmlMultilingual {

  my ($body, $h pars)=@_;
  my (%pars,$key,$nlang,$proc,%lang,$line,$cell,@lang,$cnames,$cn,$cw,$cf);
  my ($i,@par,@far,$width);
  my $sep=">>";
  my $lsep=">>>>";

foreach $line (split($lsep,$body)) { foreach $cell (split($sep,$line)) { if( $cell =~ m/\s*([a-z0-9][a-z0-9])\s*[:=\n]/s ) { if($lang{$1} < 1) { $lang{$1}++; push(@lang,$1); $nlang++; } } } } if($nlang<1) { $nlang=1; } $width=int(100/$nlang); for($i=0; $i<$nlang; $i++) { $par[$i]="$width\%"; $far[$i]="l".LangRetColor($lang[$i]); } $cn=join(",",@lang); $cw=join(";",@par); $cf=join(";",@far);

$body =~ s/($sep\s*(?:[a-z0-9][a-z0-9])\s*)(\n)/$1=$2/gs;

%pars=( 'width' => '100%', 'titlebackground' =>'white', 'textbackground' => 'white', 'linecolor' => 'darkgray', 'linewidth' => 1, 'formatseparator'=>'@', 'columnnames' => $cn, 'columnwidth' => $cw, 'columnformat' => $cf, 'markup' => 1 ); foreach $key (%$h pars) { $pars{$key}=$$h pars{$key}; } $pars{'lineseparator'} = $lsep; $pars{'separator'} = $sep;

return CdmlTable($body,\%pars);

}

sub TocBuild {

  my ($lines,$size,$name,$entry,$line,$head,$key,$ret);
  my $cnt=Lu('Table of contents of this page|Inhaltsverzeichnis dieser Seite|Table Des Matières|Tabla de materias');
  my $th=HvnRetColor(\%TocParsHash,'#dddddd','Titelhintergrund','titlebackground');
  my $ch=HvnRetColor(\%TocParsHash,'#eeeeee','Texthintergrund','textbackground');
  my $lwidth=HvnRetVal(\%TocParsHash,4,'Linienbreite','linewidth');
  my $abstand=HvnRetVal(\%TocParsHash,$TocAbstandDef,'Abstand','distance');
  my $lcolor=HvnRetColor(\%TocParsHash,'#cccccc','Linienfarbe','linecolor');
  my $title=HvnRetVal(\%TocParsHash,'','body','body');
  my $luft=HvnRetVal(\%TocParsHash,3,'Luft','padding');
  my $zluft=HvnRetVal(\%TocParsHash,2,'Zeilenluft','linepadding');
  my $ein=HvnRetVal(\%TocParsHash,5,'Einrückung',Unicode('Einrückung'),'indentation');
  my $tiefe=HvnRetVal(\%TocParsHash,20,'Tiefe','depth');
  my $width=HvnWidth(\%TocParsHash,'');
  my @parts;
  my $maxsize;
  my $indent;

if(StrEmpty($title)==0) { $cnt=$title; }

foreach $key (sort keys %TocHash) { $head=$TocHash{$key}; @parts=split(/\|/,$head); if($parts[0]>$maxsize) { $maxsize=$parts[0]; } } $lines.="<table border='0' cellspacing=0 cellpadding=$zluft>"; foreach $key (sort keys %TocHash) { $head=$TocHash{$key}; @parts=split(/\|/,$head); $size=$parts[0]; $name=$parts[1]; $entry=$parts[2]; $indent=$ein+$tiefe*($maxsize-$size); $lines.= "<tr><td>" . HtmlLuft($indent,1) . "<a href='#$name' name='toc_$name'>$entry</a>$n3</td></tr>\n"; } $lines.="</table>";

$ret = "<table border='0' cellspacing='$lwidth' cellpadding='$luft' width='$width'>"; if(!StrEquList($cnt,'-','none')) { $ret .= "<tr bgcolor='$th'><td>$cnt</td></tr>"; } $ret .= "<tr bgcolor='$ch'><td>$lines</td></tr></table>";

TableCvtLineColorWidth($ret,$lcolor,$width); TableCvtAbstandWidth($ret,$abstand,$width); return "<a name='toc'></a>".$ret;

}

$CdmlHash{Inhaltsverzeichnis} = \&CdmlToc; $CdmlHash{toc} = \&CdmlToc;

sub CdmlToc {

  my($body, $h pars)=@_;
  $TocTopFlag=HvnRetVal($h pars,1,'Link','link');
  $$h pars{body}=$body;
  HashAddContextDefaultsMissing($h pars,'cdml.toc.defaults',$CdmlTocDefaults);
  %TocParsHash=%$h pars;
  $TocFlag=1;
  return $TocMagic;
}

$CdmlHash{"Überschrift"} = \&CdmlTitle; $CdmlHash{Unicode("Überschrift")} = \&CdmlTitle; $CdmlHash{title} = \&CdmlTitle;

sub CdmlTitle {

  my($body, $h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.title.defaults');
  my $name=HvnRetVal($h pars,'','Name','name');
  my $luft=HvnRetVal($h pars,$TitlePadding,'Luft','padding');
  my $size=HvnSize($h pars,'');
  my $bcol=HvnRetColor($h pars,$TitleColor,'Farbe','color');
  my $fcol=HvnRetColor($h pars,$TitleFontColor,'Schriftfarbe','textcolor');
  my $pos=HvnRetVal($h pars,0,'Position','pos');

if($name eq '') { $name=$body; } LineMarkupImageLinksBasic($body,0,1,1); if($size eq '') { $size=HvnRetVal($h pars,5,"Schriftgröße",Unicode("Schriftgröße"),'fontsize'); } return CreateTitle($name,$body,$size,$luft,$bcol,$fcol,$pos,0);

}

  '()'=>'lr', '(x)'=>'lxr', '(q)'=>'lqr', '(?)'=>'lqr',
  '(v)'=>'lvr', '.()'=>'plr', '(.)'=>'lpr', 'p()'=>'plr', '(n)'=>'lnr', '(())'=>'llrr',
  '[]'=>'oc', '[x]'=>'oxc',
  ''=>'smile', ''=>'wink', ''=>'frown', 'link' => 'link ext'
);

$CdmlHash{Symbol} = \&CdmlSymbol; $CdmlHash{symbol} = \&CdmlSymbol;

sub CdmlSymbol {

  my($body, $h pars)=@_;
  my ($name,$ret);

StrStripBoth($body); if($body eq '') { goto do ret; } if($body =~ m/_/) { $name=$body; goto do icon; } $name=$SymbolNames{$body}; if($name eq '') { $name=ContextVarRetDefault("symbol.$body",'lr') } if($name eq '') { $name='lr'; } if($name =~ m#http://# ) { return ImageUrlRetHtml($name); } if(!($name =~ m/_/)) { $name="symbol_$name"; }

do icon:
  $ret=NameStyleRetImageGif($name,$LinkTypeIconStyle);
do ret:
  return $ret;
}

$CdmlHash{Gnuplot} = \&CdmlGnuplot; $CdmlHash{gnuplot} = \&CdmlGnuplot; sub CdmlGnuplot {

  my ($body,$h pars)=@_;
  my ($cmd,$out);
  my $rdir="graf/$PageCur";
  my $dir="$ConfigDir/$rdir";

StrStripChrBoth($body,"\n"); my $code=StrRetHashCodeQuick($body); my $bnam="gnuplot_$code"; my $fnam="$bnam.".$GnuplotExt; my $infile="$dir/$bnam"."_in.txt"; my $grfile="$dir/$fnam";

if(-f "$dir/$fnam") { goto do return; } if(!(-d $dir)) { DirCreateRecur($dir,0770); }

$GrafletDir=$dir; # flag for deleting unnecessary files

FileSetStr($infile,"set term $GnuplotExt\n" . "set output \"$grfile\"\n" . $body); $cmd="gnuplot $infile"; $out .= CmdRetText($cmd);

FileDel($infile); if(FileRetSize($grfile) == 0) { FileDel($grfile); }

do return:
  $GrafletFiles{$grfile}++;
  return ImageUrlRetHtml("$rdir/$fnam");
}

$CdmlHash{Tex} = \&CdmlTex; $CdmlHash{TeX} = \&CdmlTex; $CdmlHash{tex} = \&CdmlTex; sub CdmlTex {

  my ($body,$h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.tex.defaults');
  my ($cmd,$out);
  my $width=HvnWidth($h pars,$TexWidth);
  my $height=HvnHeight($h pars,$TexHeight);
  my $scale=HvnRetVal($h pars,$TexScale,'Skalierung','scale');
  my $rdir="graf/$PageCur";
  my $dir="$ConfigDir/$rdir";

StrStripChrBoth($body,"\n"); my $code=StrRetHashCodeQuick($body.$width.$height.$scale); my $bnam="tex_$code"; my $infilepar="$dir/$bnam"; my $infile="$dir/$bnam.tex"; my $fnam="$bnam.$TexExt"; my $grfile="$dir/$fnam";

if(-f "$grfile") { goto do return; } if(!(-d $dir)) { DirCreateRecur($dir,0770); }

$GrafletDir=$dir; # flag for deleting unnecessary files

my $s="\\nopagenumbers\n" . "\\hsize = ${width}in\n" . "\\vsize = ${height}in\n" ."\$\$\n" . "$body\n" . "\$\$\n" . "\\end\n";

FileSetStr($infile,$s); $cmd="tex2gif $bnam $dir $scale"; $out .= CmdRetText($cmd);

if(FileRetSize($grfile) == 0) { FileDel($grfile); }

do return:
  $GrafletFiles{$infile}++;
  $GrafletFiles{$grfile}++;
  $GrafletFiles{'missfont.log'}++;
  return ImageUrlRetHtml("$rdir/$fnam");
}

sub IsColor {

  my ($s)=@_;
  if(substr($s,0,1) eq '#') {
    return $s;
  }
  return ColorDefaultRetCode($s);
}

sub IsInteger {

  my ($s)=@_;
  my $ret;
  if($s =~ m#^\d+$#) {
    $ret=$s;
  }
  return $ret;
}

sub IsFontsize {

  my ($s)=@_;
  my $ret;
  if($s =~ m#^(\d+)pt$#) {
    $ret=$1;
    if($ret<2) {
      $ret=2;
    }
    if($ret>256) {
      $ret=256;
    }
  }
  return $ret;
}

sub IsLabel {

  my ($s)=@_;
  my ($ret);
  my $c=substr($s,0,1);

if(($c eq "\'") || ($c eq "\"")) { if($c eq substr($s,-1,1)) { $ret=substr($s,1,length($s)-2); } } return $ret;

}

sub IsUrl {

  my ($s)=@_;
  my ($ret);
  if(NameIsUrl($s)) {
    $ret=$s;
  }
  return $ret;
}

sub IsAt {

  my ($s,$x,$y)=@_;
  my ($ret,$ix,$iy);
  if($s =~ m#^@([+-]?)(\d*),*([+-]?)(\d*)$#) {
    $ret=$s;
    if($1 eq '+') {
      $ix=$x+$2;
    } elsif($1 eq '-') {
      $ix=$x-$2;
    } else {
      $ix=$2;
    }
    if($3 eq '+') {
      $iy=$y+$4;
    } elsif($3 eq '-') {
      $iy=$y-$4;
    } else {
      $iy=$4;
    }
  }
  return ($ret,$ix,$iy);
}

sub IsSize {

  my ($s)=@_;
  my ($ret,$iw,$ih);
  if($s =~ m#^(\d*)[xX](\d*)$#) {
    $ret=$s; $iw=$1; $ih=$2;
  }
  return ($ret,$iw,$ih);
}

sub IsPage {

  my ($s)=@_;
  my ($ret,$name,$url);

if($s =~ m/:/) { $url=InterWikiPageRetUrl($s); if($url ne '' && (substr($url,0,1) ne '[')) { $name=$s; } } elsif($s =~ m/^($WikiPattern|$WordPattern)$/) { $name=$s; $url=ScriptActionRetUrl("$DomainUrl$ScriptUrlPath/$ScriptName",$s); } $ret=$name; return ($ret,$name,$url);

}

sub ColorRetGray {

  my ($s)=@_;
  my $ret=255;
  if($s =~ m/(([0-9A-Fa-f]{2}))(([0-9A-Fa-f]{2}))(([0-9A-Fa-f]{2}))/) {
    $ret=HexRetInt($1)+HexRetInt($2)+HexRetInt($3);
  }
  return $ret;
}

sub LabelFontsizeRetWidth {

  my ($label,$fontsize)=@_;
  my ($ret,$u,$l,$s,$c);

$u=length($label); $label =~ s/[\.\,\:]/{$s++;}/ge; $label =~ s/[abcdefghknopqrsuvxyz]/{$l++;}/ge; $label =~ s/[ijlt]/{$s++;}/ge; $u-=$s; $u-=$l;

$ret= $u + 0.80*$l + 0.55*$s;

$ret *= 0.75 * $fontsize; return int($ret);

}

sub HashSetXminXmaxYminYmax {

  my($h s,$xmin,$xmax,$ymin,$ymax)=@_;

if(($$h s{xmin} eq '') || ($xmin<$$h s{xmin})) { $$h s{xmin}=$xmin; } if(($$h s{xmax} eq '') || ($xmax>$$h s{xmax})) { $$h s{xmax}=$xmax; } if(($$h s{ymin} eq '') || ($ymin<$$h s{ymin})) { $$h s{ymin}=$ymin; } if(($$h s{ymax} eq '') || ($ymax>$$h s{ymax})) { $$h s{ymax}=$ymax; }

}

sub PointPointRetDistFast {

  my ($x1,$y1,$x2,$y2)=@_;
  my $dx=$x2-$x1;
  my $dy=$y2-$y1;
  my $dist=$dx*$dx+$dy*$dy;
  return $dist;
}

sub ObjectFindNearest {

  my ($h o,$x1,$y1,$x2,$y2)=@_;
  my $xmin=$$h o{xmin};
  my $ymin=$$h o{ymin};
  my $xmax=$$h o{xmax};
  my $ymax=$$h o{ymax};
  my $rmin=PointPointRetDistFast($x1,$y1,$x2,$y2);
  my $r;

$r=PointPointRetDistFast($xmin,$y1,$x2,$y2); if($r<$rmin) { $rmin=$r; $x1=$xmin; } $r=PointPointRetDistFast($xmax,$y1,$x2,$y2); if($r<$rmin) { $rmin=$r; $x1=$xmax; } $r=PointPointRetDistFast($x1,$ymin,$x2,$y2); if($r<$rmin) { $rmin=$r; $y1=$ymin; } $r=PointPointRetDistFast($x1,$ymax,$x2,$y2); if($r<$rmin) { $rmin=$r; $y1=$ymax; }

return ($x1,$y1);

}

sub SvgRenderVertex {

  my ($h s,$h v,$xoff,$yoff)=@_;
  my ($ret,$id1,$id2,$x1,$x2,$y1,$y2,$h o1,$h o2);
  my ($mh,$mt,$mhflag,$mtflag);
  my $type=$$h v{type};

$id1=$$h v{from}; $id2=$$h v{to};

$h o1=$$h s{$id1}; $x1=$$h o1{drawx}; $y1=$$h o1{drawy};

$h o2=$$h s{$id2}; $x2=$$h o2{drawx}; $y2=$$h o2{drawy};

if($$h o1{count}<1 || $$h o2{count}<1) { goto do exit; }

($x1,$y1)=ObjectFindNearest($h o1,$x1,$y1,$x2,$y2); ($x2,$y2)=ObjectFindNearest($h o2,$x2,$y2,$x1,$y1);

$x1+=$xoff; $x2+=$xoff; $y1+=$yoff; $y2+=$yoff;

if($type =~ m/>/) { $mhflag++; } if($type =~ m/</) { $mtflag++; } if($mtflag) { $mt=" marker-start='url(#ArrowTail);' "; } if($mhflag) { $mh=" marker-end='url(#ArrowHead);' "; } $ret="<path d='M $x1,$y1 L $x2,$y2' stroke='gray' stroke-width='2'$mh$mt />\n";

do exit:
  return $ret;
}

sub SvgRenderObject {

  my ($h s,$h o,$xoff,$yoff)=@_;
  my ($ret,$off,$textcolor,$starget,$cx,$cy,$xtext,$ytext,$hsize,$sx,$sy);
  my $type=First($$h o{type},$$h s{type});
  my $x=First($$h o{x},$$h s{x});
  my $y=First($$h o{y},$$h s{y});
  my $w=First($$h o{w},$$h s{w});
  my $h=First($$h o{h},$$h s{h});
  my $fontsize=First($$h o{fontsize},$$h s{fontsize},14);
  my $color=First($$h o{color},$$h s{color});
  my $symbol=$$h o{symbol};
  my $label=First($$h o{label},$$h o{page},$$h o{url},$$h o{name},$$h o{emptylabel});  $label=~ s/_/ /g;
  my $labelheight=$fontsize;
  my $labelwidth=LabelFontsizeRetWidth($label,$fontsize);
  my $url=First($$h o{url});
  my $padding=First($$h o{padding},$$h s{padding},2);
  my $target=RetParam('target');

if(($type eq 'circle') || ($type eq 'ellipse')) { my $r=First($$h o{r},$$h o{integer},$$h s{r}); my $ry; $r=First($$h o{r},$$h o{w}); if($r eq '') { $w=0.5*($labelwidth); $h=0.5*($fontsize); $r=int(sqrt($w*$w+$h*$h)); $r+=$padding; } $ry=$r; if($type eq 'ellipse') { $ry=First($$h o{h},int($r/3)); } $$h o{drawx}=$cx=$x; $$h o{drawy}=$cy=$y; $$h o{xmin}=$cx-$r; $$h o{ymin}=$cy-$ry; $$h o{xmax}=$cx+$r; $$h o{ymax}=$cy+$ry;

$cx+=$xoff; $cy+=$yoff; $ret="<ellipse cx='$cx' cy='$cy' rx='$r' ry='$ry' fill='$color' stroke='black' stroke-width='1' /> \n"; # opacity="0.6" HashSetXminXmaxYminYmax($h s,$cx-$r,$cx+$r,$cy-$ry,$cy+$ry); } else { if($$h o{h} eq '') { $hsize=$fontsize; if($symbol ne '') { if($hsize<32) { $hsize=32; } } $h=$hsize+2*$padding; } if($$h o{w} eq '') { $hsize=int($labelwidth); if($symbol ne '') { $hsize+=32+$padding; } $w=$hsize+2*$padding; } $$h o{drawx}=$x; $$h o{drawy}=$y; $$h o{xmin}=$cx=int($x-$w/2); $$h o{ymin}=$cy=int($y-$h/2); $$h o{xmax}=$cx+$w; $$h o{ymax}=$cy+$h;

$cx+=$xoff; $cy+=$yoff; $ret="<rect x='$cx' y='$cy' width='$w' height='$h' fill='$color' stroke='black' stroke-width='1' /> \n"; HashSetXminXmaxYminYmax($h s,$cx,$cx+$w,$cy,$cy+$h); } if($label ne '') { $xtext=$x; $off=int( ($fontsize*1.0)*0.35 ); $ytext=$y+$off; $textcolor=(ColorRetGray($color)<128) ? '#ffffff' : '#000000'; $xtext+=$xoff; $ytext+=$yoff; if($symbol ne '') { $xtext+=int((32+$padding)/2); } $ret.="<text x='$xtext' y='$ytext' text-anchor='middle' font-size='$fontsize' fill='$textcolor'>$label</text>\n"; my $w2=int($labelwidth/2); HashSetXminXmaxYminYmax($h s,$xtext-$w2,$xtext+$w2,$ytext,$ytext+$labelheight); if($symbol ne '') { $sx=$cx+$padding; $sy=$cy+$padding; $ret.="<image x='$sx' y='$sy' width='31' height='31' xlink:href=' http://www.prowiki2.org/image/$symbol.gif'/&gt;"; } }

if($url ne '') { my $starget;

  1. if($target ne '') {
  2. $starget=" target='$target'";
  3. }
    $starget=" target='pane'";
    $ret="<a xlink:href='$url'$starget>\n$ret</a>\n";
  }

return $ret;

}

sub ObjectsSetObjectDefaultSystem {

  my ($a objects,$h object,$h default,$h system,$dir)=@_;
  my ($ref,$defx,$defy);
  if($$h object{x} eq '') {
    $$h object{x}=$$h system{x};
  } else {
    $$h system{x}=$$h object{x};
  }
  if($$h object{y} eq '') {
    $$h object{y}=$$h system{y};
  } else {
    $$h system{y}=$$h object{y};
  }
  if($dir eq ',') {
    $defx=200; $defy=0;
  } else {
    $defx=0; $defy=40;
  }

$$h system{x}+=First($$h system{dx},$defx); $$h system{y}+=First($$h system{dy},$defy); $ref={ %$h object }; push(@$a objects,$ref); $$h system{$$h object{id}}=$ref; $$h default{id}++; %$h object=%$h default;

}

sub ObjectsFindNameRetObject {

  my ($a objects,$word)=@_;
  my ($ret,$id,$h o);
  foreach(@$a objects) {
    $h o=$_;
    $id=$$h o{id};
    if($$h o{page} eq $word) {
      goto do ret;
    }
    if($$h o{id} eq $word) {
      goto do ret;
    }
    if($$h o{name} eq $word) {
      goto do ret;
    }
    if($$h o{label} eq $word) {
      goto do ret;
    }
  }
  return '';

do ret:
  return $h o;
}

sub SvgRetFrame {

  return
  "<g font-family='Verdana, Arial, sans serif' font-size='16'>\n" .
  "<defs>\n" .
  "  <marker id='ArrowHead' viewBox='0 0 25 30' refX='25' refY='15' fill='gray'\n" .
  "    markerWidth='4' markerHeight='4' orient='auto' >\n" .
  "    <path d='M 0,0 L 25,15 L 0,30 z' />\n" .
  "  </marker>\n" .
  "  <marker id='ArrowTail' viewBox='0 0 25 30' refX='0' refY='15' fill='gray'\n" .
  "    markerWidth='4' markerHeight='4' orient='auto' >\n" .
  "    <path d='M 0,15 L 25,0 L 25,30 z' />\n" .
  "  </marker>\n" .
  "</defs>\n" .
  "{SvgBody}" .
  "</g>\n";
}

sub SvgUnderstand {

  my ($body,$width,$height,$fontsize)=@_;
  my ($ret,$word,%system,@objects,$expect,$default,@vertices);
  my ($iscolor,$isinteger,$islabel,$isurl,$isat,$ix,$iy,$iw,$ih,$ispage,$pagename,$pageurl,$isfontsize);
  my (%default,%object,$issize,$color,$id,$id1,$id2,$fromid,$frame);
  my ($x,$y,$w,$h,$xmin,$xmax,$ymin,$ymax,$xmin2,$ymin2,$xoff,$yoff,$h o);
  my $mx=$width/2;
  my $my=$height/2;
  my %expect=('color'=>1, 'fontsize'=>1, 'from'=>1, 'label'=>1, 'padding'=>1, 'radius'=>1, 'symbol'=>1);
  my %type=('circle'=>1, 'ellipse'=>1, 'rect'=>1);
  my %arrows=( '->'=>1, '<->'=>1, '<-'=>1, '-'=>1  );
  my %translate=('Kreis'=>'circle', 'r'=>'radius', 'to'=>'->', 'connect'=>'-', 'fromto'=>'<->',  'back'=>'<-' );
  my $center=0;   # autosize too

%system=(); $system{width}=$width; $system{height}=$height; $system{x}=0; $system{y}=0;

  1. $system{dx}=0;
  2. $system{dy}=40;
  $system{w}=$width;
  $system{h}=$height;
  $system{r}=$height*0.3;
  $system{color}='skyblue';
  $system{type}='rect';
  $system{fontsize}='12';
  $system{padding}=5;

%default=( 'id'=> 1, 'emptylabel' => 'empty', 'type' => 'rect' ); %object=%default;

# understand foreach (split(/\s+/,$body)) { $word=$_; while($translate{$word} ne '') { $word=$translate{$word}; } $iscolor=IsColor($word); $isinteger=IsInteger($word); $islabel=IsLabel($word); $isurl=IsUrl($word); $isfontsize=IsFontsize($word); ($isat,$ix,$iy)=IsAt($word,$x,$y); ($issize,$iw,$ih)=IsSize($word); ($ispage,$pagename,$pageurl)=IsPage($word);

if($word eq '.') { $expect=''; $default=0; if($object{count}) { ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system); } $fromid=0; } elsif($word eq ',') { $expect=''; if($object{count}) { ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system,$word); } } else { if($expect eq 'color') { $color=ColorDefaultRetCode($word,$word); $expect=''; $object{color}=$color; if($default) { $default{color}=$color; } } elsif($expect eq 'from') { $h o=ObjectsFindNameRetObject(\@objects,$word); if($h o ne '') { $fromid=$$h o{id}; $system{x}=$$h o{x}+$system{dx}; $system{y}=$$h o{y}+$system{dy}; } $expect=''; } elsif($expect eq 'symbol') { $object{symbol}=$word; $expect=''; } elsif($word eq '(+)') { $object{symbol}='symbol plus'; } elsif($word eq '(-)') { $object{symbol}='symbol minus'; } elsif($word eq '(?)') { $object{symbol}='symbol qmark'; } elsif($word eq '(!)') { $object{symbol}='symbol note'; } elsif($expect eq 'label') { $object{label}=$word; $expect=''; } elsif($expect eq 'padding') { $object{padding}=$word; $expect=''; } elsif($expect eq 'radius') { $object{r}=$word; $expect=''; } elsif($expect eq 'fontsize') { $object{fontsize}=$word; $expect=''; if($default) { $default{fontsize}=$word; } } elsif($iscolor ne '') { $object{color}=$iscolor; $object{count}++; if($default) { $default{color}=$iscolor; } } elsif($islabel ne '') {

do label:
        if($object{label} ne '') {
          ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
        }
        $object{label}=$islabel; $object{count}++;
      } elsif($isat ne '') {
        $object{x}=$ix; $object{y}=$iy; $object{count}++;
      } elsif($isfontsize ne '') {
        $object{fontsize}=$isfontsize; $object{count}++;
        if($default) {
          $default{fontsize}=$isfontsize;
        }
      } elsif($isurl ne '') {
        if(($object{url} ne ) || ($object{page} ne )) {
          ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
        }
        $object{url}=$isurl; $object{count}++;
      } elsif($ispage ne '') {
        if(($object{url} ne ) || ($object{page} ne )) {
          ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
        }
        $object{page}=$pagename; $object{count}++;
        $object{url}=$pageurl;
      } elsif($issize ne '') {
        $object{w}=$iw; $object{h}=$ih; $object{count}++;
      } elsif($isinteger ne '') {
        $object{integer}=$isinteger; $object{count}++;
      } elsif($word eq 'center') {
        $center=1;
      } elsif($word eq 'default') {
        $default=1;
      } elsif($arrows{$word}) {
        $id1=$object{id};
        if($object{count}) {
          ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
        }
        $id2=$id1+1;
        if($fromid ne '') {
          $id1=$fromid;
        }
  1. MsgPrint("vertex from=$id1 to=$id2");
        push(@vertices,{ 'from'=>$id1, 'to'=>$id2, 'type'=>$word });
      } elsif($type{$word}) {
        $object{type}=$word; $object{count}++;
      } elsif($expect{$word}) {
        $expect=$word;
      } else {
        $islabel=$word;
        goto do label;
      }
    }
  }
  if($object{count}) {
    ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
  }

# process foreach (@objects) { SvgRenderObject(\%system,$_,0,0); } $xmin=$system{xmin}; $xmax=$system{xmax}; $ymin=$system{ymin}; $ymax=$system{ymax}; if($center) { $xoff=int($mx-0.5*($xmin+$xmax)); $yoff=int($my-0.5*($ymin+$ymax)); $xmin2=$xmin+$xoff; if($xmin2<0) { $xoff-=$xmin2; } $ymin2=$ymin+$yoff; if($ymin2<0) { $yoff-=$ymin2; } } else { my $border=5; $xoff=-($xmin-$border); $yoff=-($ymin-$border); $width=$xmax+$xoff+$border; $height=$ymax+$yoff+$border; }

if($system{background} ne '') { $ret.="<rect x='0' y='0' width='$width' height='$height' fill='$system{background}' /> \n"; } # render foreach (@objects) { $ret.=SvgRenderObject(\%system,$_,$xoff,$yoff); }

foreach (@vertices) { $ret.=SvgRenderVertex(\%system,$_,$xoff,$yoff); }

$frame=SvgRetFrame(); $frame=~ s/{SvgBody}/$ret/;

$ret=$frame;

return (QuoteHtml($ret),$width,$height);

}

sub CreateSvgType {

  my ($body,$h pars,$svgtype)=@_;
  my $width=HvnWidth($h pars,320);
  my $height=HvnHeight($h pars,240);
  my $show=HvnRetVal($h pars,0,'showcode');
  my $rdir="graf/$PageCur";
  my $dir="$ConfigDir/$rdir";
  my ($ret,$out,$code,$bnam,$fnam,$grfile,$body1,$body2);
  my $body0=$body;

my $libpage=HvnRetVal($h pars,'-','libpage'); my $lib=SourceRetStr($libpage); $lib=~ s#>#>#g; $lib=~ s#<#<#g;

if($svgtype) { $body=~ s#>#>#g; $body=~ s#<#<#g; ($body,$width,$height)=SvgUnderstand($body,$width,$height,14); $body=~ s#>#>#g; $body=~ s#<#<#g; $body1=$body; }

if($svgtype==0) { if($lib ne '') { if($lib =~ s/{SvgBody}/$body/) { $body=$lib; } else { $body=$lib."\n".$body; } $body2=$body; } }

StrStripChrBoth($body,"\n"); $body=~ s#>#>#g; $body=~ s#<#<#g;

$out= '<?xml version="1.0" encoding="'.$WikiCharset.'" standalone="no"?>' . "\n" . '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" " http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">' . "\n" . '<svg xmlns=" http://www.w3.org/2000/svg" xmlns:xlink=" http://www.w3.org/1999/xlink" width="' . $width . 'px" height="' . $height . 'px" viewBox="-1 -1 '.($width-1). ' '.($height-1). '">' . "\n" . $body . "\n" . '</svg>';

$code=StrRetHashCodeQuick($out); $bnam="graph_$code"; $fnam="$bnam.svg"; $grfile="$dir/$bnam.svg";

if(-f $grfile) { goto do return; } if(!(-d $dir)) { DirCreateRecur($dir,0770); }

$GrafletDir=$dir; # flag for deleting unnecessary files

FileSetStr($grfile,$out);

if(FileRetSize($grfile)==0) { FileDel($grfile); }

do return:
  $GrafletFiles{$grfile}++;
  $ret="<object data=\"$rdir/$fnam\" type=\"image/svg+xml\" width=\"$width\" height=\"$height\" >".LiSvgMissing()."</object>";

if(RetParam('section') ne '') { $show=0; } if($show) { if($show==2) { $ret="<tr><td>$ret</td><td bgcolor='yellow' valign='top'>

$body0
</td></tr>"; } else { $ret="<tr><td>$ret</td></tr><tr><td bgcolor='yellow' valign='top'>
$body0
</td></tr>"; if($body1 ne '') { $ret.="<td bgcolor='#ffff99' valign='top'>
$body1
</td></tr>"; } if($body2 ne '') { $ret.="<td bgcolor='#ffffcc' valign='top'>
$body2
</td></tr>"; } } $ret="<table style='border:dotted green 2px;'>$ret</table>"; } return $ret;
}

$CdmlHash{map}=\&CdmlMap; $CdmlHash{Map}=\&CdmlMap; sub CdmlMap {

  my ($body,$h pars)=@_;
  my $name=HvnRetVal($h pars,'','name');
  my $section=RetParam('section');
  my ($ret,$action,$title,$target,$icon);

HashAddContextDefaultsMissing($h pars,'cdml.svg.defaults'); HashAddContextDefaultsMissing($h pars,'cdml.map.defaults'); if($name eq 'map') { if($section eq '') { $action="action=browse&id=$PageCur&section=cdml.Map.map&menu=right&menusize=300&paneid=$PageCur"; $title='map'; $target='_parent'; $icon='icon map.gif'; } else { $action=$PageCur; $title='original page display'; $target='_parent'; $icon='icon map off.gif'; } $ret.=ActionLabelClassIdTargetTitleRetLink($action,Symbol($icon,16),"body",$PageCur,$target,$title); $ret.=$br; } $ret.=CreateSvgType($body,$h pars,1); return $ret;

}

$CdmlHash{SVG} = \&CdmlSvg; sub CdmlSvg {

  my ($body,$h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.svg.defaults');
  return CreateSvgType($body,$h pars,0);
}

$CdmlHash{Video} = \&CdmlVideo; $CdmlHash{video} = \&CdmlVideo; sub CdmlVideo {

  my ($body,$h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.video.defaults');
  my $server=HvnRetVal($h pars,'youtube','Server','server');
  my $astart=HvnRetVal($h pars,'0','autostart');
  my $starttime=HvnRetVal($h pars,'','starttime');
  my $movie=HvnRetVal($h pars,'fJ3juM6vHwg','Film','movie');
  my $width=HvnWidth($h pars,425);
  my $height=HvnHeight($h pars,350);
  my ($ret,$ascode,$stcode,$sec);

if($server eq 'youtube') { $ret="<embed allowScriptAccess='never' src=' http://www.youtube.com/v/$movie' type='application/x-shockwave-flash' width='$width' height='$height'></embed>" } elsif($server eq 'mediaplayer+url') { $ret="<object id='MediaPlayer' width='$width' height='$height' classid='CLSID:22D6f312-B0F6-11D0-94AB-0080C74C7E95' " . " standby='Loading Windows Media Player components...' type='application/x-oleobject' " . " codebase=' http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,4,7,1112'&gt;" . "<PARAM NAME='AutoStart' Value='0'>" . # oder True "<param name='filename' value='$movie'>" . "<embed TYPE='application/x-mplayer2' name='MediaPlayer' src='$movie' autostart='$astart' width='$width' height='$height' ></embed>" . "</object>"; } elsif($server eq 'video.google') { if($astart) { $ascode="&autoPlay=true"; } if($starttime) { if($starttime =~ m/[.,:]/) { $starttime= 60 * $` + $'; } $stcode="&initialTime=$starttime"; } $ret="<embed style='width:${width}px; height:${height}px;' id='VideoPlayback' align='middle' type='application/x-shockwave-flash' " . "src=' http://video.google.com/googleplayer.swf?$movie' quality='best' " . "bgcolor='#ffffff' scale='noScale' salign='TL' FlashVars='playerMode=embedded$ascode$stcode'> </embed> " ; } else { $ret="<div style='background:#ffffaa; width:$width; height:$height; padding:10 10 10 10;'>unknown video specification</div>"; } return $ret;

}

$CdmlHash{Graph} = \&CdmlGraph; $CdmlHash{graph} = \&CdmlGraph; sub CdmlGraph {

  my ($body,$h pars)=@_;
  HashAddContextDefaultsMissing($h pars,'cdml.graph.defaults');
  my ($cmd,$out);
  my $width=HvnWidth($h pars,400);
  my $height=HvnHeight($h pars,300);
  my $rdir="graf/$PageCur";
  my $dir="$ConfigDir/$rdir";

$body=~ s#>#>#g;

StrStripChrBoth($body,"\n"); if(!($body=~ m#\s*(di)?graph\s*# )) { if($body=~ m#--#) { $body="graph G { $body }"; } else { $body="digraph G { $body }"; } }

my $code=StrRetHashCodeQuick($body.$width.$height); my $bnam="graph_$code"; my $infile="$dir/$bnam.dot"; my $fnam="$bnam.svg"; my $grfile="$dir/$bnam.svg";

if(-f $grfile) { goto do return; } if(!(-d $dir)) { DirCreateRecur($dir,0770); }

$GrafletDir=$dir; # flag for deleting unnecessary files

my $s="$body\n";

FileSetStr($infile,$s); $cmd="dot -Tsvg $infile -o $grfile"; $out=CmdRetText($cmd);

if(FileRetSize($grfile)==0) { FileDel($grfile); }

do return:
  $GrafletFiles{$infile}++;
  $GrafletFiles{$grfile}++;
  return "<object data=\"$rdir/$fnam\" type=\"image/svg+xml\" width='$width' height='$height' >".LiSvgMissing()."</object>";
}

sub TextCmdParsBodyRetRaw {

  my ($ctext,$cmd,$h pars,$body)=@_;
  my (%pars,$raw,$f proc);

%pars=%$h pars; $f proc=$CdmlHash{$cmd}; if($f proc) { $pars{cmd}=$cmd; $raw = &$f proc($body,\%pars); } else { $raw = $ctext; } return StoreRaw($raw);

}

sub GetSaveUrl {

  my ($nr)=@_;
  my $ret=$SaveUrl{$nr};
  if($ret eq $TocMagic) {
    $ret=TocBuild();
  }
  return $ret;
}

sub TextCdmlRetText {

  my ($text)=@_;
  my ($ctext,$cmd,%pars,$body,$cstart,$pstart,$posequ,$possep);
  my ($clen,$bstart,$bend,$pnam,$pval,$c,$n,$i,$slen,$part);

FRAME:
  while( $text =~ /\[\[/g ) {
    $n=2; $slen=length($text); $cstart=pos($text)-2;
    $ctext=""; $cmd=""; $body=""; $bstart=$cstart+1; $pstart=$cstart+2; $posequ=0; $possep=0;
    %pars=();
    $pars{'pos'} = $cstart;
    for($i=$pstart; $i<$slen; $i++) {
      $c=substr($text,$i,1);
      if($c eq ']') {
        $n--;
        if($n==0) {
          $bend=$i;
          if($bend>$bstart) {
            $body .= substr($text,$bstart,$bend-$bstart);
          }
          $clen=$i+1-$cstart;
          substr($text,$cstart,$clen)=TextCmdParsBodyRetRaw(substr($text,$cstart,$clen),$cmd,\%pars,$body);
  1. MsgPrint("CDMLparser body=$body\n\n");
          next FRAME;
        } elsif($n==1) {
          $bend=$pstart-1;
          if($bend>$bstart) {
            $part=substr($text,$bstart,$bend-$bstart);
            $body.=$part;
  1. MsgPrint("CDMLparser bodypart=$part\n");
          }
          $bstart=$i+1;
          if($posequ>$pstart && $possep==0) {
            $pnam=substr($text,$pstart,$posequ-$pstart);
            $pval=substr($text,$posequ+1,$i-($posequ+1));
            $pars{$pnam}=$pval;
          } elsif($cmd eq '') {
            $cmd=substr($text,$pstart,$i-$pstart);
          } else {
            $body.=substr($text,$pstart-1,$i-$pstart+2);
          }
        }
      } elsif($c eq '[') {
        $n++;
        if($n==2) {
          $pstart=$i+1;
          $posequ=0; $possep=0;
        }
      } elsif($n==2) {
        if($posequ==0) {
          if($c eq '=') {
            $posequ=$i;
          } elsif(ord($c)<48 || $c eq ':') {
            $possep=$i;
          }
        }
      }
    }
  }

return $text;

}

sub TextWikiRetHtmlBasic {

  my ($text,$forcelinks)=@_;
  my ($html,$slen);
  my $showlinks=1;

$TrailPage='';

if($forcelinks==0) { if(StrEquExist($PageLeaf,$ContextPageName)) { $showlinks=0; } }

$text=TextCdmlRetText($text);

TextMarkupImagesLinks($text,$showlinks,$showlinks);

ListStackInit(); foreach (split(/\n/,$text,-1)) { # Process lines $_ .= "\n"; $slen=length($_); $html.=LineMarkupLists($_,1); $MatchPos+=$slen; } $html.=ListStackExit();

return $html;

}

sub TextWikiRetHtml {

  my ($text,$forcelinks)=@_;
  my ($rlink,$fntext);

$MatchPos=0; # used for toc header ordering $TocFlag=0; # indicates toc $HeaderCount=0;

LinesCvtLogical($text); if($RawHtml) { $text =~ s/<html>((.|\n)*?)<\/html>/&StoreRaw($1)/ige; } $text = QuoteHtml($text); $text =~ s/\<n\>((.|\n)*?)\<\/n\>/&StoreRaw($1)/ige; # .. $text =~ s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; $text =~ s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1)/ige; $text =~ s/\\ *\r?\n/ /g; # Join lines separated by \ $text=TextWikiRetHtmlBasic($text,$forcelinks);

if($FootnoteCount) { $FootnoteCount=0; $fntext="$br$br$br".NameStyleRetImageGif('footnote').$br; foreach(@FootnoteTab) { $FootnoteCount++; $rlink="".LabelNameHrefRetLink("[$FootnoteCount]","fn_$FootnoteCount","#fa_$FootnoteCount").""; $fntext .= ":".StoreRaw($rlink)." $_\n\n"; } $FootnoteCount=0; @FootnoteTab=(); $text.=TextWikiRetHtmlBasic($fntext,$forcelinks); }

while($text =~ m/$FS\d+$FS/) { $text =~ s/$FS(\d+)$FS/&GetSaveUrl($1)/ge; }

  1. while($text =~ s#</p>\n?<p></p>#</p>#g) {
  2. # again
  3. }
  4. $text =~ s#(\S)</p>\n?<p>#$1#g;
  5. $text =~ s#<p><hr>\n?</p>#<hr>#g;
  return $text;
}

sub StoreRaw {

  my ($html)=@_;

$SaveUrl{$SaveUrlIndex} = $html; return $FS . $SaveUrlIndex++ . $FS;

}

sub StorePre {

  my ($html)=@_;

return StoreRaw("

" . $html . "
");
}

sub StoreHref {

  my ($anchor, $text)=@_;

return "<a" . StoreRaw($anchor) . ">$text</a>";

}

sub UrlpRetLinkPunct {

  my ($rawname,$showImage,$style)=@_;
  my ($url,$label,$punct,$link);

($url, $punct) = SplitUrlPunct($rawname); if($showImage && ($url =~ m/\.$ImageExtensions$/i)) { $url =~ s/\.(DECLARE)?IMAGE$//; return (ImageUrlRetHtml($url,$style), $punct); } $label=$url; if($NonEnglish) { $url=StrRetNecEsc($url); } $label=QuoteHtml($label); $link=UrlLabelTargetTypeRetLink($url,$label); return ($link,$punct);

}

sub UrlLabelTargetTypeRetLink {

  my ($url,$label,$target,$type)=@_;
  my ($dom,$base,$icon,$proto,$blockspam);

if($NonEnglish) { $url= StrRetNecEsc($url); } if($target eq '') { if($AutoExtLinkEmptyTarget) { if($url =~ m/^$UrlProtocolsUsingTarget/) { $dom=UrlRetDomain($url); if(!ServerHasDomain($dom)) { $target="_blank"; } } } } $proto=PathRetProtocol($url); if($proto eq 'mailto') { if($MailtoMangle) { if($UserPref eq '') { $label=~s/ MAIL /MAIL /;

  1. $label=~s/\./ NOSPAMDOT /g;
        $label=~s/\@/ (AT) /g;
        $blockspam=1;
      }
    }
  }
  if($LinkTypeIcons) {
    if($type eq '-') {
      goto do ret;
    }
    if($type eq '') {
      $h=$Context{"link.type.icon.$proto"};
      if($h ne '') {
        $icon=$h;
        goto do check;
      } else {
        $type=PathRetExtPure($url);
      }
    }
    $icon=$Context{"link.type.icon.$type"};
do check:
    if($icon eq '-') {
      goto do ret;
    }
    if($icon eq '') {
      $icon=$LinkTypeIconDefault;
    }
    $icon=ImageUrlRetHtmlPlus($icon,0,undef,undef,undef,undef,$LinkTypeIconStyle);
    if($LinkTypeFront) {
      $label="$icon $label";
    } else {
      $label.=" $icon";
    }
  }
  if($blockspam) {
    return $label;
  }
do ret:
  StrHexCvtTextSave($label);
  if($PagenameReduction) {
    $dom=UrlRetDomain($url);
    $base=$Context{"pagename.reduction.$dom"};
    if($base ne '') {
      $url =~ s#\?$base/#?#;
    }
  }
  return UrlLabelClassTitleTargetRetLink($url,$label,'body','',$target);
}

sub UrlLabelTypeRetLink {

  my ($url,$label,$type)=@_;
  return UrlLabelTargetTypeRetLink($url,$label,'',$type);
}

sub StoreUrl {

  my ($name,$showImage)=@_;
  my ($link,$punct)=UrlpRetLinkPunct($name,$showImage);
  if($link ne "") { # no empty links are stored
    $link = StoreRaw($link)
  }
  return $link.$punct;
}

sub StoreUploadLink {

  my ($fnam)=@_;
  my $url= "$UploadUrl/$fnam";
  if(NameIsImage($fnam)) {
    StoreRaw(ImageUrlRetHtml($url));
  } else {
    StoreRaw(UrlLabelTypeRetLink($url," Upload:$fnam"));
  }
}

sub StoreRFC {

  my ($num)=@_;
  my $link=UrlLabelTypeRetLink(" http://www.faqs.org/rfcs/rfc${num}.html","RFC $num");
  return StoreRaw($link);
}

sub ISBNLink {

  my ($rawnum)=@_;
  my ($rawprint,$html,$num,$first,$h,$land);

$num = $rawnum; $rawprint = $rawnum; $rawprint =~ s/ +$//; $num =~ s/[- ]//g; if(length($num) != 10) { return "ISBN $rawnum"; }

$h=$IsbnLink1; if($h eq '') { $land = ($num =~ m/^3.*/ ) ? 'de' : 'com'; $h=" http://www.amazon.$land/exec/obidos/ISBN=@"; $h =~ s/@/$num/g; }

$h=UrlLabelTargetTypeRetLink($h,"ISBN $rawprint",$IsbnTarget,'book'); $html=$h; if($IsbnLink2 ne || $IsbnLink3 ne ) { $html .= " ("; if($IsbnLink2 ne '') { $h = $IsbnLink2; $h =~ s/@/$num/g; $html .= UrlLabelTargetTypeRetLink($h,$IsbnLabel2,$IsbnTarget); } if($IsbnLink3 ne '') { $h = $IsbnLink3; $h =~ s/@/$num/g; $html .= ' ' . UrlLabelTargetTypeRetLink($h,$IsbnLabel3,$IsbnTarget); } $html .= ")"; } $html .= " " if($rawnum =~ / $/); # Add space if old ISBN had space. return $html;

}

sub StoreISBN {

  my ($num)=@_;
  return StoreRaw(ISBNLink($num));
}

sub RequestLock {

  my $n = 0;
  while(mkdir($LockDir, 0555) == 0) {
    # EEXIST == 17 is OK, try later.
    $! ==  17 || die("can't make $LockDir: $!\n");
    $n++ < 10 || die("timed out waiting for $LockDir\n");
    sleep(3);
  }
}

sub ReleaseLock {

  rmdir($LockDir);
}

]