path: root/Master/texmf-dist/scripts/context/perl/texshow.pl

eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' && eval 'exec perl -w -S $0 $argv:q'
        if 0;

#D \module
#D   [       file=texshow.pl,
#D        version=2005.01.06,
#D          title=TeXShow,
#D       subtitle=showing \CONTEXT\ commands,
#D         author=Taco Hoekwater,
#D           date=\currentdate,
#D      copyright={Taco Hoekwater}]

#D Early 1999 \TEXSHOW\ showed up in the \CONTEXT\ distribution. At that time
#D the user interface was described in files named \type {setup*.tex}. The
#D program used a stripped down version of these definition files, generated
#D by \CONTEXT\ itself. \TEXSHOW\ shows you the commands, their (optional)
#D arguments, as well as the parameters and their values. For some five years
#D there was no need to change \TEXSHOW. However, when a few years ago we
#D started providing an \XML\ variant of the user interface definitions, Taco
#D came up with \TEXSHOW||\XML. Because Patricks \CONTEXT\ garden and tools
#D like \CTXTOOLS\ also use the \XML\ definitions, it's time to drop the old
#D \TEX\ based definitions and move forward. From now on Taco's version is the
#D one to be used.
#D
#D Hans Hagen - Januari 2005

use strict;
use Getopt::Long ;
use XML::Parser;
use Data::Dumper;
use Tk;
use Tk::ROText ;
use Config;
use Time::HiRes;

$Getopt::Long::passthrough = 1 ; # no error message
$Getopt::Long::autoabbrev  = 1 ; # partial switch accepted

my $ShowHelp  = 0;
my $Debug     = 0;
my $Editmode  = 0;
my $Interface = 'cont-en';
my $current_command;
my $current_interface;
my $current_part;
my @setup_files;

my %setups;
my %commes;
my %descrs;
my %examps;
my %trees;
my %positions;
my %locations;
my %crosslinks;


&GetOptions
  (      "help" => \$ShowHelp ,
  "interface=s" => \$Interface ,
        "debug" => \$Debug,
         "edit" => \$Editmode) ;

print "\n";

show('TeXShow-XML 0.2 beta','Taco Hoekwater 2004',"/");

print "\n";

if ($ShowHelp) {
  show('--help','print this help');
  show('--interface=lg','primary interface');
  show('--debug','print debugging info');
  show('string','show info about command \'string\'');
  show('string lg','show info about \'string\' in language \'lg\'');
  print "\n";
  exit 0;
}

my $command = $ARGV[0] || '';
my $interface = $ARGV[1] || '';
if ($interface =~ /^[a-z][a-z]$/i) {
  $Interface = 'cont-' . lc($interface);
} elsif ($interface && $command =~ /^[a-z][a-z]$/i) {
  show('debug',"switching '$interface' and '$command'");
  $Interface = 'cont-' . lc($command);
  $command = $interface;
}

if ($command =~ s/^\\//) {
  show('debug','removed initial command backslash');
}

show('interface', $Interface);
if ($command){
  show ('command', "\\$command") ;
}

print "\n";

show('status','searching for setup files');

my $setup_path;
my ($mainwindow,$interfaceframe,$partframe,$leftframe,$rightframe,$buttonframe);
my ($request,$listbox,$textwindow,%interfacebuttons,%partbuttons);

my ($textfont,$userfont,$buttonfont);

my $Part;

if (setups_found($Interface)) {
  $current_interface = '';
  $current_command = '';
  $current_part = 'Command';
  show('status','loading setups') ;
  load_setups($Interface) ;
  show ('status','initializing display') ;
  initialize_display();
  change_setup();
  show_command ($command);
  $mainwindow->deiconify();
  show ('status','entering main loop') ;
  MainLoop () ;
  show ('status','closing down') ;
} else {
  show ('error','no setup files found') ;
}
print "\n";

sub initialize_display  {
  my $dosish       = ($Config{'osname'} =~ /dos|win/i) ;
  my $default_size = $dosish ? 9 : 12 ;
  my $s_vertical   = 30 ;
  my $s_horizontal = 72 ;
  my $c_horizontal = 24 ;
  if (!$dosish) {
    $textfont   = "-adobe-courier-bold-r-normal--$default_size-120-75-75-m-70-iso8859-1" ;
    $userfont   = "-adobe-courier-bold-o-normal--$default_size-120-75-75-m-70-iso8859-1" ;
    $buttonfont = "-adobe-helvetica-bold-r-normal--$default_size-120-75-75-p-69-iso8859-1";
  } else {
    $textfont     = "Courier   $default_size       " ;
    $userfont     = "Courier   $default_size italic" ;
    $buttonfont   = "Helvetica $default_size bold  " ;
  }
  $mainwindow = MainWindow -> new ( -title => 'ConTeXt commands' ) ;
  $buttonframe   = $mainwindow -> Frame () ; # buttons
  $leftframe     = $mainwindow -> Frame () ; # leftside
  $rightframe    = $mainwindow -> Frame();
  $request  = $rightframe -> Entry (-font => $textfont,
			    -background => 'ivory1',
			    -width => $c_horizontal);
  $listbox  = $rightframe -> Scrolled ('Listbox',
			  -scrollbars => 'e',
			  -font => $textfont,
			  -width => $c_horizontal,
			  -selectbackground => 'gray',
			  -background => 'ivory1',
			  -selectmode => 'browse') ;
  $textwindow = $leftframe -> Scrolled ('ROText',
			 -scrollbars => 'se',
			 -height => $s_vertical,
			 -width => $s_horizontal,
			 -wrap => 'none',
			 -background => 'ivory1',
			 -font => $textfont);
  $interfaceframe = $leftframe -> Frame();
  $mainwindow -> withdraw() ;
  $mainwindow -> resizable ('y', 'y') ;
  foreach (@setup_files) {
    $interfacebuttons{$_} = $buttonframe -> Radiobutton (-text => $_,
				  -value => $_,
				  -font => $buttonfont,
				  -selectcolor => 'ivory1',
				  -indicatoron => 0,
				  -command => \&change_setup,
				  -variable => \$Interface );

    $interfacebuttons{$_} -> pack (-padx => '2p',-pady => '2p','-side' => 'left' );
  }
  foreach (qw(Command Description Comments Examples)) {
    $partbuttons{$_} = $interfaceframe -> Radiobutton (-text => $_,
				  -value => $_,
				  -font => $buttonfont,
				  -selectcolor => 'ivory1',
				  -indicatoron => 0,
				  -command => \&change_part,
				  -variable => \$Part );
    $partbuttons{$_} -> pack (-padx => '2p',-pady => '2p','-side' => 'left' );
  }
  # global top
  $buttonframe     -> pack ( -side => 'top'   , -fill => 'x' ,    -expand => 0 ) ;
  # top in left
  $interfaceframe  -> pack ( -side => 'top'   , -fill => 'x' ,    -expand => 0 ) ;
  $textwindow      -> pack ( -side => 'top'  , -fill => 'both' , -expand => 1 ) ;
  $leftframe       -> pack ( -side => 'left' , -fill => 'both' ,    -expand => 1 ) ;
  # right
  $request          -> pack ( -side => 'top'    , -fill => 'x' ) ;
  $listbox          -> pack ( -side => 'bottom' , -fill => 'both' , -expand => 1 ) ;
  $rightframe      -> pack ( -side => 'right' , -fill => 'both' ,    -expand => 1 ) ;
  $listbox -> bind ('<B1-Motion>', \&show_command ) ;
  $listbox -> bind ('<1>'        , \&show_command ) ;
  $listbox -> bind ('<Key>'      , \&show_command ) ;
  $textwindow -> tag ('configure', 'user'     ,       -font => $userfont ) ;
  $textwindow -> tag ('configure', 'optional' ,       -font => $userfont ) ;
  $textwindow -> tag ('configure', 'command'  , -foreground => 'green3'  ) ;
  $textwindow -> tag ('configure', 'variable' ,       -font => $userfont ) ;
  $textwindow -> tag ('configure', 'default'  ,  -underline => 1         ) ;
  $textwindow -> tag ('configure', 'symbol'   , -foreground => 'blue3'   ) ;
  $textwindow -> tag ('configure', 'or'       , -foreground => 'yellow3' ) ;
  $textwindow -> tag ('configure', 'argument' , -foreground => 'red3'    ) ;
  $textwindow -> tag ('configure', 'par'      ,   -lmargin1 => '4m'      ,
	                                     -wrap  => 'word'    ,
	                                  -lmargin2 => '6m'      ) ;
  foreach my $chr ('a'..'z','A'..'Z') {
    $mainwindow -> bind ( "<KeyPress-$chr>", sub { insert_request(shift, $chr) } );
  }
  $request -> bind ('<Return>', sub { handle_request() } ) ;
  $mainwindow -> bind ( "<backslash>", sub { insert_request(shift, "\\") } ) ;
  $mainwindow -> bind ( "<space>", sub { new_request() } ) ;
  $mainwindow -> bind ( "<BackSpace>", sub { delete_request() } ) ;
  $mainwindow -> bind ( "<Prior>", sub { prev_command() } ) ;
  $mainwindow -> bind ( "<Next>", sub { next_command() } ) ;
}

sub show {
  my ($pre,$post,$sep) = @_;
  unless ($pre eq 'debug' && !$Debug) {
    $sep = ':' unless defined $sep;
    print sprintf("%22s $sep %+s\n",$pre,$post);
  }
}

sub change_setup {
  # switches to another setup file
  if ($current_interface ne $Interface ) {
    my $loc = 0;
    if ($current_command) {
      $loc = $positions{$Interface}{$current_command} || 0;
    }
    my @list = sort {lc $a cmp lc $b} keys %{$setups{$Interface}} ;
    my $num = 0;
    map { $locations{$Interface}{$_} = $num++; } @list;
    $listbox -> delete ('0.0', 'end') ;
    $listbox -> insert ('end', @list) ;
    # try to switch to other command as well, here.
    if ($current_command ne '') {
      show_command($crosslinks{$Interface}[$loc] || '');
    } else {
      $listbox -> selectionSet ('0.0', '0.0') ;
      $listbox -> activate ('0.0') ;
    }
  }
  $current_interface = $Interface;
  $mainwindow -> focus ;
}

sub change_part {
  if ($Part ne $current_part) {
    if($Part eq 'Command') {
      show_command();
    } elsif ($Part eq 'Description') {
      show_description();
    } elsif ($Part eq 'Comments') {
      show_comments();
    } elsif ($Part eq 'Examples') {
      show_examples();
    }
  }
  $current_part = $Part;
}


sub setups_found {
  # find the setup files
  my ($primary) = @_;
  $setup_path = `kpsewhich --progname=context cont-en.xml` ;
  chomp $setup_path;
  show ('debug', "path = '$setup_path'");
  if ($setup_path) {
    $setup_path =~ s/cont-en\.xml.*// ;
    @setup_files = glob ("${setup_path}cont\-??.xml") ; # HH: pattern patched, too greedy
    show ('debug', "globbed path into '@setup_files'");
    if (@setup_files) {
      my $found = 0;
      foreach (@setup_files) {
	s/\.xml.*$//;
	s/^.*?cont-/cont-/;
	if ($_ eq $primary) {
	  $found = 1;
	  show ('debug', "found primary setup '$primary'");
	} else {
	  show ('debug', "found non-primary setup '$_'");
	}
      }
      if ($found) {
	return 1;
      } else {
	show('error',"setup file for '$primary' not found, using 'cont-en'");
	$Interface = 'cont-en';
	return 1;
      }
    } else {
      show('error',"setup file glob failed");
    }
  } elsif ($!) {
    show('error','kpsewhich not found');
  } else {
    show('error','setup files not found');
  }
  return 0;
}

sub load_setup {
  my ($path,$filename) = @_;
  unless (keys %{$setups{$filename}}) {
    if (open(IN,"<${path}$filename.xml")) {
      my $position = 0 ;
      local $/ = '</cd:command>';
      while (my $data= <IN>) {
	if ($data =~ /\<\/cd:interface/) {
	  next;
	}
	if ($data =~ /\<cd:interface/) {
	  $data =~ s/^(.*?)\<cd:command/\<cd:command/sm;
	  my $meta = $1;
	}
	#
	$data =~ s/\s*\n\s*//g;
	$data =~ /\<cd:command(.*?)\>/;
	my $info = $1;
	my ($name,$environment) = ('','');
	while ($info =~ s/^\s*(.*?)\s*=\s*(["'])(.*?)\2\s*//) {
	  my $a = $1; my $b = $3;
	  if ($a eq 'name') {
	    $name = $b;
	  } elsif ($a eq 'type') {
	    $environment = $b;
	  }
	}
	my $cmd = $name;
	if ($environment) {
	  $cmd = "start" . $name;
	}
	$setups    {$filename}{$cmd}   = $data ;
	$trees     {$filename}{$cmd}   = undef;
	$positions {$filename}{$cmd}   = ++$position ;
	$crosslinks{$filename}[$position] = $cmd ;
      }
      close IN;
	  # now get explanations as well ...
	  my $explname = $filename;
	  $explname =~ s/cont-/expl-/;
	  my $extras = 0 ;
	  if (open(IN,"<${path}$explname.xml")) {
		local $/ = '</cd:explanation>';
		while (my $data= <IN>) {
		  if ($data =~ /\<\/cd:explanations/) {
			next;
		  }
		  if ($data =~ /\<cd:explanations/) {
			$data =~ s/^(.*?)\<cd:explanation /\<cd:explanation /sm;
			my $meta = $1;
		  }
		  #
		  $extras++;
		  $data =~ /\<cd:explanation(.*?)\>/;
		  my $info = $1;
		  my ($name,$environment) = ('','');
		  while ($info =~ s/^\s*(.*?)\s*=\s*(["'])(.*?)\2\s*//) {
			my $a = $1; my $b = $3;
			if ($a eq 'name') {
			  $name = $b;
			} elsif ($a eq 'type') {
			  $environment = $b;
			}
		  }
		  my $cmd = $name;
		  if ($environment) {
			$cmd = "start" . $name;
		  }
		  my $comment = '';
		  my $description = '';
		  my @examples = ();
		  $data =~ /\<cd:description\>(.*)\<\/cd:description\>/s and $description = $1;
		  $data =~ /\<cd:comment\>(.*)\<\/cd:comment\>/s and $comment = $1;
		  while ($data =~ s/\<cd:example\>(.*?)\<\/cd:example\>//s) {
			push @examples, $1;
		  }
		  if (length($comment) && $comment =~ /\S/) {
			$commes    {$filename}{$cmd}   = $comment;
		  }
		  if (length($description) && $description =~ /\S/) {
			$descrs    {$filename}{$cmd}   = $description;
		  }
		  my $testex = "@examples";
		  if (length($testex) && $testex =~ /\S/) {
			$examps    {$filename}{$cmd}   = [@examples];
		  }
		}
	  }
	  if ($extras) {
		show('debug',"interface '$filename', $position\&$extras commands");
	  } else {
		show('debug',"interface '$filename', $position commands");
	  }
    }  else {
      show ('debug',"open() of ${path}$filename.xml failed");
    }
  }
  $Interface = $filename ;
}

sub load_setups {
  my ($primary) = @_;
  # load all setup files, but default to $primary
  my $t0 = [Time::HiRes::gettimeofday()];
  foreach my $setup (@setup_files) {
    if ($setup ne $primary) {
      load_setup ($setup_path,$setup);
      show('status',"loading '$setup' took " .Time::HiRes::tv_interval($t0) . " seconds");
      $t0 = [Time::HiRes::gettimeofday()];
    };
  };
  load_setup ($setup_path,$primary);
  show('status',"loading '$primary' took " .Time::HiRes::tv_interval($t0) . " seconds");
}

my @history = ();
my $current_history = 0;

sub show_command {
  my ($command,$nofix) = @_;
  if (keys %{$setups{$Interface}}) {
    my $key = '';
    if (defined $command && $command &&
	(defined $setups{$Interface}{$command} ||
	 defined $setups{$Interface}{"start" . $command})) {
      $key = $command;
      my $whence =$locations{$Interface}{$command};
      $listbox -> selectionClear ('0.0','end') ;
      $listbox -> selectionSet($whence,$whence);
      $listbox -> activate($whence);
      $listbox -> see($whence);
    } else {
      $listbox -> selectionSet('0.0','0.0') unless $listbox->curselection();
      $key = $listbox -> get($listbox->curselection()) ;
    }
    show('debug',"current command: $current_command");
    show('debug',"    new command: $key");
    $current_command = $key ;
    $textwindow -> delete ('1.0', 'end' ) ;
	$partbuttons{"Command"}->select();
	$partbuttons{"Command"}->configure('-state' => 'normal');
	$partbuttons{"Description"}->configure('-state' => 'disabled');
	$partbuttons{"Comments"}->configure('-state' => 'disabled');
	$partbuttons{"Examples"}->configure('-state' => 'disabled');
	if (defined $commes{$Interface}{$key}) {
	  $partbuttons{"Comments"}->configure('-state' => 'normal');
	}
	if (defined $descrs{$Interface}{$key}) {
	  $partbuttons{"Description"}->configure('-state' => 'normal');
	}
	if (defined $examps{$Interface}{$key}) {
	  $partbuttons{"Examples"}->configure('-state' => 'normal');
	}
	unless (defined $nofix && $nofix) {
	  push @history, $key;
	  $current_history = $#history;
	}
    do_update_command ($key) ;
    $mainwindow -> update();
    $mainwindow -> focus() ;
  }
}

sub prev_command {
  if ($current_history > 0) {
	$current_history--;
	show_command($history[$current_history],1);
  }
}

sub next_command {
  unless ($current_history == $#history) {
	$current_history++;
	show_command($history[$current_history],1);
  }
}

sub show_description {
  $textwindow -> delete ('1.0', 'end' ) ;
  if (defined $descrs{$current_interface}{$current_command}) {
	$textwindow-> insert ('end',$descrs{$current_interface}{$current_command});
  }
  $mainwindow -> update();
  $mainwindow -> focus() ;
}

sub show_comments {
  $textwindow -> delete ('1.0', 'end' ) ;
  if (defined $commes{$current_interface}{$current_command}) {
	$textwindow-> insert ('end',$commes{$current_interface}{$current_command});
  }
  $mainwindow -> update();
  $mainwindow -> focus() ;
}


sub show_examples {
  $textwindow -> delete ('1.0', 'end' ) ;
  if (defined $examps{$current_interface}{$current_command}) {
	$textwindow-> insert ('end',join("\n\n",@{$examps{$current_interface}{$current_command}}));
  }
  $mainwindow -> update();
  $mainwindow -> focus() ;
}




sub has_attr {
  my ($elem,$att,$val) = @_;
  return 1 if (attribute($elem,$att) eq $val);
  return 0;
}


sub view_post {
  my ($stuff,$extra) = @_;
  $extra = '' unless defined $extra;
  $stuff =~ /^(.)(.*?)(.)$/;
  my ($l,$c,$r) = ($1,$2,$3);
  if ($l eq '[' || $l eq '(') {
    return ($l,['symbol','par',$extra],$c,['par',$extra],$r,['symbol','par',$extra],"\n",'par');
  } else {
    return ($l,['argument','par',$extra],$c,['par',$extra],$r,['argument','par',$extra],"\n",'par');
  }
}

sub view_pre {
  my ($stuff) = @_;
  $stuff =~ /^(.)(.*?)(.)$/;
  my ($l,$c,$r) = ($1,$2,$3);
  if ($l eq '[' || $l eq '(') {
    return ($l,['symbol'],$c,'',$r,['symbol']);
  } else {
    return ($l,['argument'],$c,'',$r,['argument']);
  }
}

sub create_setup_arguments {
  my $argx = shift;
  my @predisp = ();
  my @postdisp = ();
  foreach my $arg (children($argx)) {
  if (name($arg) eq 'cd:keywords') {
    # children are Constant* & Inherit?  &  Variable*
    my @children = children($arg);
    my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
    if (@children){
      push @predisp,'[', ['symbol',$optional];
      if (has_attr($arg,'list', 'yes')) {
	if (has_attr($arg,'interactive', 'exclusive')) {
	  push @predisp, '...', '';
	} else {
	  push @predisp, '..,...,..', '';
	}
      } else {
	push @predisp,'...', '';
      }
      push @predisp,']', ['symbol',$optional];
    }
    push @postdisp,'[', ['symbol','par',$optional];
    my $firsttrue = 1;
    foreach my $kwd (@children) {
      if ($firsttrue) {
	$firsttrue = 0;
      } else {
	push @postdisp,', ', ['symbol','par'];
      }
      if      (name($kwd) eq 'cd:constant' ||
               name($kwd) eq 'cd:variable') {
	my $v = attribute($kwd,'type');
	my $def = '';
	my $var = '';
	$var = 'variable' if (name($kwd) eq 'cd:variable') ;
	$def = 'default'  if (has_attr($kwd,'default', 'yes'));
	if ($v =~ /^cd:/) {
	  $v =~ s/^cd://;
	  $v .= "s" if (has_attr($arg,'list', 'yes'));
	  push @postdisp, $v, ['user',$def,'par',$var];
	} else {
	  push @postdisp, $v, [$def,'par',$var];
	}
      } elsif (name($kwd) eq 'cd:inherit') {
	my $v = attribute($kwd,'name');
	$textwindow -> tag ('configure', $v , -foreground => 'blue3',-underline => 1 ) ;
	$textwindow -> tagBind($v,'<ButtonPress>',sub {show_command($v)} );
	push @postdisp,"see ","par", "$v", [$v,'par'];
      }
    }
    push @postdisp,']', ['symbol','par',$optional];
    push @postdisp,"\n", 'par';
  } elsif (name($arg) eq 'cd:assignments') {
    # children are Parameter* & Inherit?
    my @children = children($arg);
    my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
    if (@children) {
      push @predisp,'[', ['symbol',$optional];
      if (has_attr($arg,'list', 'yes')) {
	push @predisp, '..,..=..,..', '';
      } else {
	push @predisp,'..=..', '';
      }
      push @predisp,']', ['symbol',$optional];
      push @postdisp,'[', ['symbol','par',$optional];
      my $isfirst = 1;
      foreach my $assn (@children) {
	if ($isfirst) {
	  $isfirst = 0;
	} else  {
	  push @postdisp,",\n ", ['symbol','par'];
	}
	if (name($assn) eq 'cd:parameter') {
	  push @postdisp,attribute($assn,'name'), 'par';
	  push @postdisp,'=', ['symbol','par'];
	  my $firstxtrue = 1;
	  foreach my $par (children($assn)) {
	    if ($firstxtrue) {
	      $firstxtrue = 0;
	    } else {
	      push @postdisp,'|', ['or','par'];
	    }
	    if (name($par) eq 'cd:constant' || name($par) eq 'cd:variable') {
	      my $var = '';
	      $var = 'variable' if name($par) eq 'cd:variable';
	      my $v = attribute($par,'type');
	      if ($v =~ /^cd:/) {
		$v =~ s/^cd://;
		push @postdisp,$v, ['user','par',$var];
	      } else {
		push @postdisp,$v, ['par',$var];
	      }
	    }
	  }
	} elsif (name($assn) eq 'cd:inherit') {
	  my $v = attribute($assn,'name');
	  $textwindow -> tag ('configure', $v , -foreground => 'blue3',-underline => 1 ) ;
	  $textwindow -> tagBind($v,'<ButtonPress>',sub {show_command($v)} );
	  push @postdisp,"see ","par", "$v", [$v,'par'];
	}
      }
      push @postdisp,"]", ['symbol','par',$optional], "\n", '';
    }
  } elsif (name($arg) eq 'cd:content') {
      push @predisp,  view_pre('{...}');
      push @postdisp, view_post('{...}');
  } elsif (name($arg) eq 'cd:triplet') {
    if (has_attr($arg,'list','yes')) {
      push @predisp, view_pre('[x:y:z=,..]');
      push @postdisp,view_post('[x:y:z=,..]');
    } else {
      push @predisp, view_pre('[x:y:z=]');
      push @postdisp,view_post('[x:y:z=]');
    }
  } elsif (name($arg) eq 'cd:reference') {
    my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
    if (has_attr($arg,'list','yes')) {
      push @postdisp, view_post('[ref,..]',$optional);
      push @predisp, view_pre('[ref,..]');
    } else {
      push @postdisp, view_post('[ref]',$optional);
      push @predisp,  view_pre('[ref]');;
    }
  } elsif (name($arg) eq 'cd:word') {
    if (has_attr($arg,'list','yes')) {
      push @predisp, view_pre ('{...,...}');
      push @postdisp,view_post('{...,...}');
    } else {
      push @predisp,  view_pre('{...}');
      push @postdisp, view_post('{...}');
    }
  } elsif (name($arg) eq 'cd:nothing') {
    my $sep = attribute($arg,'separator');
    if ($sep) {
      if($sep eq 'backslash') {
#	push @postdisp,'\\\\','par';
	push @predisp,'\\\\','';
      } else {
#	push @postdisp,$sep,'par';
	push @predisp,$sep,'';
      }
    }
    push @predisp,'...','';
    push @postdisp,'text',['variable','par'],"\n",'par';
  } elsif (name($arg) eq 'cd:file') {
    push @predisp,'...',['default'];
    push @postdisp,'...',['default','par'],"\n",'par';
  } elsif (name($arg) eq 'cd:csname') {
    push @predisp,'\command',['command'];
    push @postdisp,'\command',['command','par'],"\n",'par';
  } elsif (name($arg) eq 'cd:index') {
    if (has_attr($arg,'list','yes')) {
      push @predisp,view_pre('{..+...+..}');
      push @postdisp,view_post('{..+...+..}');
    } else {
      push @predisp, view_pre('{...}');
      push @postdisp,view_post('{...}');
    }
  } elsif (name($arg) eq 'cd:position') {
    if (has_attr($arg,'list','yes')) {
      push @predisp,view_pre('(...,...)');
      push @postdisp,view_post('(...,...)');
    } else {
      push @predisp,view_pre('(...)');
      push @postdisp,view_post('(...)');
    }
  } elsif (name($arg) eq 'cd:displaymath') {
    push @predisp,  ('$$',['argument'],'...','','$$',['argument']);
    push @postdisp, ('$$',['argument','par'],'...',['par'],'$$',['argument','par']);
  } elsif (name($arg) eq 'cd:tex') {
    my $sep = attribute($arg,'separator');
    if ($sep) {
      if($sep eq 'backslash') {
#	push @postdisp,'\\\\','par';
	push @predisp,'\\\\','';
      } else {
#	push @postdisp,$sep,'par';
	push @predisp,$sep,'';
      }
    }
    my $cmd = "\\" . attribute($arg,'command');
    push @predisp,$cmd,'';
#    push @postdisp,$cmd,['command','par'],"\n",'par';
  }
  }
  return (\@predisp,\@postdisp);
}


#  <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
#
#       would be:
#
#                    Tag   Content
#         ==================================================================
#         [foo, [{}, head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]],
#                     bar, [         {}, 0, "Howdy",  ref, [{}]],
#                       0, "do"
#               ]
#         ]

sub attribute {
  my ($elem,$att) = @_;
  if (defined $elem->[1] && defined $elem->[1]->[0] && defined $elem->[1]->[0]->{$att}) {
    my $ret = $elem->[1]->[0]->{$att};
    show ('debug',"returning attribute $att=$ret");
    return $elem->[1]->[0]->{$att};
  } else {
    return '';
  }
}

sub name {
  my ($elem) = @_;
  if (defined $elem->[0] ) {
    return $elem->[0];
  } else {
    return '';
  }
}

# return all children at a certain level
sub children {
  my ($elem) = @_;
  if (defined $elem->[1] && defined $elem->[1]->[1]) {
    my @items = @{$elem->[1]};
    shift @items ; # deletes the attribute.
    my @ret = ();
    while (@items) {
      push @ret, [shift @items, shift @items];
    }
    return @ret;
  } else {
    return ();
  }
}

# return the first child with the right name
sub find {
  my ($elem,$name) = @_;
  if ($elem->[0] eq $name) {
    return $elem;
  }
  if (ref($elem->[1]) eq 'ARRAY') {
    my @contents = @{$elem->[1]};
    shift @contents;
    while (my $ename = shift @contents) {
      my $con = shift @contents;
      if ($ename eq $name) {
	return [$ename,$con];
      }
    }
  }
  return [];
}

sub do_update_command                # type: 0=display, 1=compute only
  { my ($command, $type) = @_ ;
    $type = 0 unless defined $type;
    my $setup;
    if (!defined $trees{$Interface}{$command}) {
      my $parser = XML::Parser->new('Style' => 'Tree');
      $trees{$Interface}{$command} = $parser->parse($setups{$Interface}{$command});
    }
    $setup = $trees{$Interface}{$command} ;
    my $predisp = undef;
    my $postdisp = undef;
    my @cmddisp = ();
    my @cmddispafter = ();
    my $pradisp = undef;
    my $altdisp = undef;
    if (attribute($setup,'file')) {
      my $filename = attribute($setup,'file');
      my $fileline = attribute($setup,'line') || 0;
      $textwindow->insert ('end',"$filename:${fileline}::\n\n", '' );
    }
    # start with backslash
    push @cmddisp, "\\", 'command' ;
    my $env = 0;
    if (has_attr($setup,'type','environment')) {
      $env = 1;
    }
    if ($env) { push @cmddisp, "start", 'command' ; }
    if ($env) { push @cmddispafter, " ... ", '', "\\stop", 'command' ; }
    my $seq = find($setup,'cd:sequence');
    # display rest of command name
    foreach my $seqpart (children($seq)) {
      my $text = attribute($seqpart,'value');
      if (name($seqpart) eq 'cd:variable') {
	push @cmddisp, $text, ['command','user'];
	if ($env) { push @cmddispafter, $text, ['command','user']; }
      } elsif (name($seqpart) eq 'cd:string') {
	push @cmddisp, $text, 'command';
	if ($env) { push @cmddispafter, $text, 'command'; }
      }
    }
    #
    my $args = find($setup,'cd:arguments');
    # display commands
    if ($args) {
      my $curarg = 0;
      foreach my $arg (children($args)) {
	if (name($arg) eq 'cd:choice') {
	  my ($a,$b) = children($arg);
	  ($predisp,$postdisp) = create_setup_arguments(['cd:arguments',[{}, @$a]]);
	  ($pradisp,$altdisp)  = create_setup_arguments(['cd:arguments',[{}, @$b]]);
	} else {
	  ($predisp,$postdisp) = create_setup_arguments($args);
	}
	$curarg++;
      }
    }
    return if $type;
    if(defined $postdisp) {
      if(defined $altdisp) {
	$textwindow->insert('end',@cmddisp,@$predisp,@cmddispafter,  "\n",'',
                          @cmddisp,@$pradisp,@cmddispafter, "\n\n",'',
		          @cmddisp, "\n",'',
		          @$postdisp, "\n",'',
                          @cmddisp, "\n",'',
		          @$altdisp);
      } else {
	$textwindow->insert('end',@cmddisp,@$predisp, @cmddispafter ,"\n\n",'',
		          @cmddisp,"\n",'',
		          @$postdisp);
      }
    } else {
      $textwindow->insert('end',@cmddisp);
    }
}


#D The next feature is dedicated to Tobias, who suggested
#D it, and Taco, who saw it as yet another proof of the
#D speed of \PERL. It's also dedicated to Ton, who needs it
#D for translating the big manual.

sub handle_request  {
  my $index = $listbox -> index('end') ;
  return unless $index;
  my $req = $request -> get ;
  return unless $req;
  $req =~ s/\\//o ;
  $req =~ s/\s//go ;
  $request -> delete('0','end') ;
  $request -> insert('0',$req) ;
  return unless $req;
  my ($l,$c) = split (/\./,$index) ;
  for (my $i=0;$i<=$l;$i++) {
    $index = "$i.0" ;
    my $str = $listbox -> get ($index, $index) ;
	if (defined $str && ref($str) eq 'ARRAY')  {
	  $str = "@{$str}";
	}
    if (defined $str && $str =~ /^$req/) {
      show_command($str) ;
      return ;
    }
  }
}

sub insert_request {
  my ($self, $chr) = @_ ;
  # don't echo duplicate if $chr was keyed in in the (focussed) entrybox
  $request -> insert ('end', $chr) unless $self eq $request;
  handle_request();
}

sub delete_request {
  my $self = shift ;
  # delete last character, carefully
  if ($self ne $request) {
    my $to = $request -> index ('end') ;
    my $from = $to - 1 ;
    if ($from<0) { $from = 0 }
    $request -> delete ($from,$to);
  }
  handle_request();
}

sub new_request {
  $request -> delete (0,'end') ;
  handle_request();
}