#!/usr/bin/env perl
#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
#
# Common functions for XF86Config file.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Tambet Ingo <tambet@ximian.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.

$SCRIPTSDIR = "/usr/X11R6/share/setup-tool-backends/scripts";
if ($SCRIPTSDIR =~ /^@scriptsdir[@]/)
{
    $SCRIPTSDIR = ".";
    $DOTIN = ".in";
}

require "$SCRIPTSDIR/general.pl$DOTIN";
require "$SCRIPTSDIR/file.pl$DOTIN";
require "$SCRIPTSDIR/xml.pl$DOTIN";

use Text::ParseWords;
use File::Copy;
use IO::File;
use POSIX qw(tmpnam);
use strict;

my $x_version;

# Data type declarations.
# Keys that *must* be present:
# 'parse', 'xml_parse', 'xml_print', 'update' , 'delete' 'add'

my $x_unique_string = {
  'parse'     => \&x_parse_unique_string,
  'xml_parse' => \&x_xml_parse_unique,
  'xml_print' => \&x_xml_print_unique,
  'update'    => \&x_update_unique_string,
  'delete'    => \&x_del_unique_string,
  'add'       => \&x_add_unique_string,
};

my $x_unique_int = {
  'parse'     => \&x_parse_unique_int,
  'xml_parse' => \&x_xml_parse_unique,
  'xml_print' => \&x_xml_print_unique,
  'update'    => \&x_update_unique_int,
  'delete'    => \&x_del_unique_int,
  'add'       => \&x_add_unique_int,
};

my $x_list_string = {
  'parse'     => \&x_parse_list_string,
  'xml_parse' => \&x_xml_parse_list,
  'xml_print' => \&x_xml_print_list,
  'update'    => \&x_update_list_string,
  'delete'    => \&x_del_list_string,
  'add'       => \&x_add_list_string,
};

my $x_list_int = {
  'parse'     => \&x_parse_list_int,
  'xml_parse' => \&x_xml_parse_list,
  'xml_print' => \&x_xml_print_list,
  'update'    => \&x_update_list_int,
  'delete'    => \&x_del_list_int,
  'add'       => \&x_add_list_int,
};

my $x_serverlayout_screen = {
  'parse'     => \&x_parse_serverlayout_screen,
  'xml_parse' => \&x_xml_parse_serverlayout_screen,
  'xml_print' => \&x_xml_print_serverlayout_screen,
  'update'    => \&x_update_serverlayout_screen,
  'delete'    => \&x_del_serverlayout_screen,
  'add'       => \&x_add_serverlayout_screen,
};

my $x_modeline = {
  'parse'     => \&x_parse_modeline,
  'xml_parse' => \&x_xml_parse_modeline,
  'xml_print' => \&x_xml_print_modeline,
  'update'    => \&x_update_modeline,
  'delete'    => \&x_del_modeline,
  'add'       => \&x_add_modeline,
};

my $x_range_hz = {
  'parse'     => \&x_parse_range_hz,
  'xml_parse' => \&x_xml_parse_range_hz,
  'xml_print' => \&x_xml_print_range_hz,
  'update'    => \&x_update_range_hz,
  'delete'    => \&x_del_range_hz,
  'add'       => \&x_add_range_hz,
};

# XFree86 version 4 sections:
# Files
# ServerFlags
# Module
# InputDevice
# Device
# VideoAdaptor
# Monitor
# Modes
# Screen
# ServerLayout
# DRI
# Vendor

my $x4_sections = {
  Monitor => {
    KEY => 'Identifier',
    keywords => {
      Identifier  => $x_unique_string,
      VendorName  => $x_unique_string,
      ModelName   => $x_unique_string,
      HorizSync   => $x_range_hz,
      VertRefresh => $x_range_hz,
      ModeLine    => $x_modeline,
      Gamma       => $x_list_int,
    },
    options => {},
  },
  Device => {
    KEY => 'Identifier',
    keywords => {
      Identifier => $x_unique_string,
      Driver     => $x_unique_string,
    },
    options => {},
  },
  Screen => {
    KEY => 'Identifier',
    keywords => {
      Identifier => $x_unique_string,
      Device     => $x_unique_string,
      Monitor    => $x_unique_string,
      DefaultDepth => $x_unique_int,
    },
    options => {},
    Display => {
      KEY => 'Depth',
      keywords => {
        Depth   => $x_unique_int,
        Modes   => $x_list_string,
        Virtual => $x_list_int,
      }
    }
  },
  ServerLayout => {
    KEY => 'Identifier',
    keywords => {
      Identifier => $x_unique_string,
      Screen     => $x_serverlayout_screen,
    },
    options => {},
  }
};

# XFree86 version 3 sections:
# Files
# Module
# ServerFlags
# Keyboard
# Pointer
# Monitor
# Device
# Screen
# XInput

my $x3_sections = {
  Monitor => {
    KEY => 'Identifier',
    keywords => {
      Identifier  => $x_unique_string,
      VendorName  => $x_unique_string,
      ModelName   => $x_unique_string,
      HorizSync   => $x_range_hz,
      VertRefresh => $x_range_hz,
      ModeLine    => $x_modeline,
    },
    options => {},
  },
  Device => {
    KEY => 'Identifier',
    keywords => {
      Identifier  => $x_unique_string,
    },
    options => {},
  },
  Screen => {
    KEY => 'Driver',
    keywords => {
      Driver            => $x_unique_string,
      Device            => $x_unique_string,
      Monitor           => $x_unique_string,
      DefaultColorDepth => $x_unique_int,
    },
    options => {},
    Display => {
      KEY => 'Depth',
      keywords => {
        Depth   => $x_unique_int,
        Modes   => $x_list_string,
        Virtual => $x_list_int,
      }
    }
  },
};

my @x_colordepths = (8, 15, 16, 24);
my $x_probe_file = "probe.xml";

# Standard modelines (VESA plus couple extras)

my $standard_modes = q (
                        
# 640x350 @ 85Hz (VESA) hsync: 37.9kHz
ModeLine "640x350@85"    31.5  640  672  736  832    350  382  385  445 +hsync -vsync

# 640x400 @ 85Hz (VESA) hsync: 37.9kHz
ModeLine "640x400@85"    31.5  640  672  736  832    400  401  404  445 -hsync +vsync

# 720x400 @ 85Hz (VESA) hsync: 37.9kHz
ModeLine "720x400@85"    35.5  720  756  828  936    400  401  404  446 -hsync +vsync

# 640x480 @ 60Hz (Industry standard) hsync: 31.5kHz
ModeLine "640x480@60"    25.2  640  656  752  800    480  490  492  525 -hsync -vsync

# 640x480 @ 72Hz (VESA) hsync: 37.9kHz
ModeLine "640x480@72"    31.5  640  664  704  832    480  489  491  520 -hsync -vsync

# 640x480 @ 75Hz (VESA) hsync: 37.5kHz
ModeLine "640x480@75"    31.5  640  656  720  840    480  481  484  500 -hsync -vsync

# 640x480 @ 85Hz (VESA) hsync: 43.3kHz
ModeLine "640x480@85"    36.0  640  696  752  832    480  481  484  509 -hsync -vsync

# 800x600 @ 56Hz (VESA) hsync: 35.2kHz
ModeLine "800x600@56"    36.0  800  824  896 1024    600  601  603  625 +hsync +vsync

# 800x600 @ 60Hz (VESA) hsync: 37.9kHz
ModeLine "800x600@60"    40.0  800  840  968 1056    600  601  605  628 +hsync +vsync

# 800x600 @ 72Hz (VESA) hsync: 48.1kHz
ModeLine "800x600@72"    50.0  800  856  976 1040    600  637  643  666 +hsync +vsync

# 800x600 @ 75Hz (VESA) hsync: 46.9kHz
ModeLine "800x600@75"    49.5  800  816  896 1056    600  601  604  625 +hsync +vsync

# 800x600 @ 85Hz (VESA) hsync: 53.7kHz
ModeLine "800x600@85"    56.3  800  832  896 1048    600  601  604  631 +hsync +vsync

# 1024x768i @ 43Hz (industry standard) hsync: 35.5kHz
ModeLine "1024x768@43"   44.9 1024 1032 1208 1264    768  768  776  817 +hsync +vsync Interlace

# 1024x768 @ 60Hz (VESA) hsync: 48.4kHz
ModeLine "1024x768@60"   65.0 1024 1048 1184 1344    768  771  777  806 -hsync -vsync

# 1024x768 @ 70Hz (VESA) hsync: 56.5kHz
ModeLine "1024x768@70"   75.0 1024 1048 1184 1328    768  771  777  806 -hsync -vsync

# 1024x768 @ 75Hz (VESA) hsync: 60.0kHz
ModeLine "1024x768@75"   78.8 1024 1040 1136 1312    768  769  772  800 +hsync +vsync

# 1024x768 @ 85Hz (VESA) hsync: 68.7kHz
ModeLine "1024x768@85"   94.5 1024 1072 1168 1376    768  769  772  808 +hsync +vsync

# 1152x864 @ 75Hz (VESA) hsync: 67.5kHz
ModeLine "1152x864@75"  108.0 1152 1216 1344 1600    864  865  868  900 +hsync +vsync

# 1280x960 @ 60Hz (VESA) hsync: 60.0kHz
ModeLine "1280x960@60"  108.0 1280 1376 1488 1800    960  961  964 1000 +hsync +vsync

# 1280x960 @ 85Hz (VESA) hsync: 85.9kHz
ModeLine "1280x960@85"  148.5 1280 1344 1504 1728    960  961  964 1011 +hsync +vsync

# 1280x1024 @ 60Hz (VESA) hsync: 64.0kHz
ModeLine "1280x1024@60" 108.0 1280 1328 1440 1688   1024 1025 1028 1066 +hsync +vsync

# 1280x1024 @ 75Hz (VESA) hsync: 80.0kHz
ModeLine "1280x1024@75" 135.0 1280 1296 1440 1688   1024 1025 1028 1066 +hsync +vsync

# 1280x1024 @ 85Hz (VESA) hsync: 91.1kHz
ModeLine "1280x1024@85" 157.5 1280 1344 1504 1728   1024 1025 1028 1072 +hsync +vsync

# 1400x1050 @ 60Hz (VESA GFT) hsync: 65.5kHz
ModeLine "1400x1050@60" 122.0 1400 1488 1640 1880   1050 1052 1064 1082 +hsync +vsync

# 1400x1050 @ 75Hz (VESA GFT) hsync: 82.2kHz
ModeLine "1400x1050@75" 155.8 1400 1464 1784 1912   1050 1052 1064 1090 +hsync +vsync

# 1600x1200 @ 60Hz (VESA) hsync: 75.0kHz
ModeLine "1600x1200@60" 162.0 1600 1664 1856 2160   1200 1201 1204 1250 +hsync +vsync

# 1600x1200 @ 65Hz (VESA) hsync: 81.3kHz
ModeLine "1600x1200@65" 175.5 1600 1664 1856 2160   1200 1201 1204 1250 +hsync +vsync

# 1600x1200 @ 70Hz (VESA) hsync: 87.5kHz
ModeLine "1600x1200@70" 189.0 1600 1664 1856 2160   1200 1201 1204 1250 +hsync +vsync

# 1600x1200 @ 75Hz (VESA) hsync: 93.8kHz
ModeLine "1600x1200@75" 202.5 1600 1664 1856 2160   1200 1201 1204 1250 +hsync +vsync

# 1600x1200 @ 85Hz (VESA) hsync: 106.3kHz
ModeLine "1600x1200@85" 229.5 1600 1664 1856 2160   1200 1201 1204 1250 +hsync +vsync

# 1792x1344 @ 60Hz (VESA) hsync: 83.6kHz
ModeLine "1792x1344@60" 204.8 1792 1920 2120 2448   1344 1345 1348 1394 -hsync +vsync

# 1792x1344 @ 75Hz (VESA) hsync: 106.3kHz
ModeLine "1792x1344@75" 261.0 1792 1888 2104 2456   1344 1345 1348 1417 -hsync +vsync

# 1856x1392 @ 60Hz (VESA) hsync: 86.3kHz
ModeLine "1856x1392@60" 218.3 1856 1952 2176 2528   1392 1393 1396 1439 -hsync +vsync

# 1856x1392 @ 75Hz (VESA) hsync: 112.5kHz
ModeLine "1856x1392@75" 288.0 1856 1984 2208 2560   1392 1393 1396 1500 -hsync +vsync

# 1920x1440 @ 60Hz (VESA) hsync: 90.0kHz
ModeLine "1920x1440@60" 234.0 1920 2048 2256 2600   1440 1441 1444 1500 -hsync +vsync

# 1920x1440 @ 75Hz (VESA) hsync: 112.5kHz
ModeLine "1920x1440@75" 297.0 1920 2064 2288 2640   1440 1441 1444 1500 -hsync +vsync

                        );
BEGIN {
  &gst_report_table ({
    'x_version'      => ['info',  _('Detected X version [%s].')],
    'x_parse'        => ['info',  _('Configuration file [%s] successfully parsed.')],
    'x_parse_error'  => ['error', _('Error parsing keyword [%s].')],
    'x_probe_needed' => ['info',  _('Going to probe your X server, hold on.')],
    'x_probe_error'  => ['error', _('Error occured on X server probe on colordepth [%s].')],
    'x_general_warn' => ['warn',  _('Internal error: [%s].')],
  }
                     );
}

sub x_version
{
  return $x_version if $x_version; # Cache

  my ($command, $number, $driver);
  my @paths = qw (/etc/X11/X /usr/X11R6/bin/XFree86 /usr/X11R6/bin/X);

  foreach my $tmp (@paths) {
    if (-x $tmp) {
      $command = $tmp;
      last;
    }
  }

  unless ($command) {
    # TODO: add report;
    &gst_debug_print_line ("Couldn't find X binary.");
    return;
  }

  open (FD, "$command -version 2>&1 |");
  while (<FD>) {
    if (/^XFree86 Version (\d+)\.(\d+)\.(\d+)/) {
      $number = $1 . $2 . $3;
    }
    elsif ($number > 0 && $number < 400 && /^[ \t]*(\w+): (accelerated)?[ ]*server/) {
      $driver = $1;
      $driver = 'Accel' if $2;
      last;
    }
  }
  close (FD);

  &gst_report ('x_version', $number);

  $x_version->{'command'} = $command;
  $x_version->{'sections'} = ($number >= 400) ? $x4_sections : $x3_sections;
  $x_version->{'number'} = $number;
  $x_version->{'driver'} = $driver if $driver;

  return $x_version;
}

# Difference from gst_item_is_in_list is that XF86Config keywords are
# case-insensitive and "_" characters are ignored.
# Returns found value from list or 0.
sub x_keyword_in_list
{
  my $keyword = shift @_;

  $keyword =~ s/\_//g; # We don't care about underscores (_)
  
  foreach my $item (@_) {
    my $pattern = $item;
    $pattern =~ s/(\W)/\\$1/g;
    return $item if ($keyword =~ /^$pattern$/i);
  }

  return;
}

sub x_option_in_list
{
  my $keyword = shift @_;

  $keyword =~ s/\"//g; # We don't care about quotes (")
  $keyword =~ s/^No//i; # and it could start with optional "No"
  
  foreach my $item (@_) {
    my $pattern = $item;
    $pattern =~ s/(\W)/\\$1/g;
    return 1 if ($keyword =~ /^$pattern$/i);
  }

  return;
}

# parse_option
# Parses "Option" line form XF86Config.
# Arguments:
#  $line - ref to array containing the actual line split by \s. 
# Returns hash with one key (Option) containing hash with option
# name as key and option value as val.
sub parse_option_old
{
  my $line = shift;
  my ($name, $value);
  my ($val, $bool);

  shift @$line; # Remove "Option"

  $name = shift @$line;
  $value = shift @$line;

  $name =~ s/\"//g;
  $value =~ s/\"//g;

  if ($value =~ /^(1|on|true|yes)$/i) {
    $val = 1;
    $bool = 1;
  } elsif ($value =~ /^(0|off|false|no)$/i) {
    $val = 0;
    $bool = 1;
  } else {
    $val = $value;
  }

  if ($bool) {
    $val = !$val if ($name =~ s/^No//i);

    $val = 'true' if $val;
    $val = 'false' if not $val;
  }

  bless [ $name, $val ], "GstXOption";
}

# ------------------------------------------------------
# Data type functions
# ------------------------------------------------------

# Unique string data type.
sub x_parse_unique_string
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;

  # Format example: 'Identifier   "name"'
  
  my $val = &x_get_token ($buf);
  goto ERROR unless defined ($val);
  goto ERROR unless $val =~ /^\".*\"$/;

  $val =~ s/\"//g;
  &gst_debug_print_line ("x_parse_unique_string: warning: '$kw' is unique but" .
                         "already has value '$config->{$kw}'.")
      if exists ($config->{$kw});

  $config->{$kw} = $val;
  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_unique_string: error parsing $kw");
}

sub x_xml_parse_unique
{
  my $hash = shift;
  my $kw = shift;

  $hash->{$kw} = &gst_xml_get_text (shift @_);
}

sub x_xml_print_unique
{
  my ($key, $val) = @_;
  &gst_xml_print_pcdata ($key, $val);
}

sub x_update_unique_string
{
  my ($buf, $ptr, $old_val, $new_val) = @_;
  my $token = &x_update_get_token ($buf, $ptr);
  return if ($old_val eq $new_val);

  $old_val = "\"" . $old_val . "\"" if $old_val;
  $new_val = "\"" . $new_val . "\"" if $new_val;

  &x_update_token ($buf, $ptr, $old_val, $new_val);
}

sub x_del_unique_string
{
  my ($buf, $ptr, $kw, $old_val) = @_;
  &x_update_token ($buf, $ptr, $kw);
  &x_update_unique_string ($buf, $ptr, $old_val);
}

sub x_add_unique_string
{
  my ($buf, $ptr, $kw, $new_val) = @_;

  $new_val = "" unless defined ($new_val);
  &x_update_add_token ($buf, $ptr, $kw) if $kw;
  $new_val = "\"" . $new_val . "\"";
  &x_update_add_token ($buf, $ptr, $new_val, 1);
}

# Unique int data type.
sub x_parse_unique_int
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;

  # Format example: 'Depth  depth'

  my $val = &x_get_token ($buf);
  goto ERROR unless defined ($val);
  goto ERROR unless $val =~ /^[0-9]+$/;

  &gst_debug_print_line ("x_parse_unique_string: warning: '$kw' is unique but" .
                         "already has value '$config->{$kw}'.")
      if exists ($config->{$kw});

  $config->{$kw} = $val;
  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_unique_int: error parsing $kw");
}

sub x_update_unique_int
{
  my ($buf, $ptr, $old_val, $new_val) = @_;
  my $token = &x_update_get_token ($buf, $ptr);

  if ($old_val != $new_val) {
    &x_update_token ($buf, $ptr, $old_val, $new_val);
  }
}

sub x_del_unique_int
{
  my ($buf, $ptr, $kw, $old_val) = @_;
  &x_update_token ($buf, $ptr, $kw);
  &x_update_unique_int ($buf, $ptr, $old_val);
}

sub x_add_unique_int
{
  my ($buf, $ptr, $kw, $new_val) = @_;

  &x_update_add_token ($buf, $ptr, $kw) if $kw;
  &x_update_add_token ($buf, $ptr, $new_val, 1);
}

# String list data type.
sub x_parse_list_string
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;

  # Format example: 'Modes  "mode-name" ...'  

  my @list;
  while (my $token = &x_peek_token ($buf)) {
    if ($token =~ /^\".*\"$/) {
      $token = &x_get_token ($buf);
      goto ERROR unless defined ($token);
      $token =~ s/\"//g;
      push @list, $token;
    } else {
      last;
    }
  }

  goto ERROR if (scalar @list < 1);

  foreach (@list) {
    push @{$config->{$kw}}, $_;
  }

  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_list_string: error parsing $kw");
}

sub x_xml_parse_list
{
  my $hash = shift;
  my $kw = shift;
  my $values = shift;
  my $i = 1;
  while (defined (my $tmp = &gst_xml_get_attribute ($values, 'arg' . $i))) {
    push @{$hash->{$kw}}, $tmp;
    $i++;
  }
}

sub x_xml_print_list
{
  my $key = shift;
  my $array = shift;

  my $str = $key;
  my $i = 1;
  foreach (@$array) {
    $str .= ' arg' . $i . "=\"$_\"";
    $i++;
  }
  &gst_xml_print_line ("<$str/>");
}

sub x_update_list_string
{
  my ($buf, $ptr, $old_val, $new_val) = @_;

  while (@$old_val) {
    &x_update_unique_string ($buf, $ptr, $$old_val[0], $$new_val[0]);
    shift @$old_val;
    shift @$new_val;
  }

  while (@$new_val) {    
    $$new_val[0] = "\"" . $$new_val[0] . "\"";
    &x_update_add_token ($buf, $ptr, $$new_val[0], 1);
    shift @$new_val;
  }
}

sub x_del_list_string
{
  my ($buf, $ptr, $kw, $old_val) = @_;
  &x_update_token ($buf, $ptr, $kw);

  if ($old_val) {
    while (@$old_val) {
      &x_update_unique_string ($buf, $ptr, $old_val);
      shift @$old_val;
    }
  }
}

sub x_add_list_string
{
  my ($buf, $ptr, $kw, $new_val) = @_;

  &x_update_add_token ($buf, $ptr, $kw);
  &x_update_list_string ($buf, $ptr, [], $new_val);
}

# Int list data type.
sub x_parse_list_int
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;

  # Format example: 'Virtual  xdim ydim'

  my @list;
  while (my $token = &x_peek_token ($buf)) {
    if ($token =~ /^[0-9\.]+$/) {
      $token = &x_get_token ($buf);
      goto ERROR unless defined ($token);
      push @list, $token;
    } else {
      last;
    }
  }

  goto ERROR if (scalar @list < 1);

  foreach (@list) {
    push @{$config->{$kw}}, $_;
  }

  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_list_int: error parsing $kw");
}

sub x_update_list_int
{
  my ($buf, $ptr, $old_val, $new_val) = @_;

  if ($old_val) {
    while (@$old_val) {
      &x_update_unique_int ($buf, $ptr, $$old_val[0], $$new_val[0]);
      shift @$old_val;
      shift @$new_val;
    }
  }

  while (@$new_val) {
    &x_update_add_token ($buf, $ptr, $$new_val[0], 1);
    shift @$new_val;
  }
}

sub x_del_list_int
{
  my ($buf, $ptr, $kw, $old_val) = @_;
  &x_update_token ($buf, $ptr, $kw);

  if ($old_val) {
    while (@$old_val) {
      &x_update_unique_int ($buf, $ptr, shift @$old_val);
    }
  }
}

sub x_add_list_int
{
  my ($buf, $ptr, $kw, $new_val) = @_;

  &x_update_add_token ($buf, $ptr, $kw);
#  push @$new_val, "\n";
  &x_update_list_int ($buf, $ptr, undef, $new_val);
}

# Screen keyword from ServerLayout Section.
sub x_parse_serverlayout_screen
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;
  my ($hash, $token, $tmp);

  # Format example: 'Screen  screen-num "screen-id" position-information'

  my $screens = 0;
  $screens = scalar (keys %{$config->{'Screen'}}) if exists $config->{'Screen'};

  # Screen number
  $token = &x_peek_token ($buf);
  goto ERROR unless defined ($token);
  if ($token =~ /^\d+$/) {
    $hash->{'num'} = &x_get_token ($buf);
  } else {
    $hash->{'num'} = $screens;
  }

  # Screen id
  $token = &x_peek_token ($buf);
  goto ERROR unless defined ($token);
  $hash->{'id'} = &x_get_token ($buf) if ($token =~ /^\".+\"$/);
  $hash->{'id'} =~ s/\"//g;

  # Position
  my $pos = {};
  my @known_pos_xy = qw (Absolute Relative);
  my @known_pos_id = qw (RightOf LeftOf Above Below);

  $token = &x_peek_token ($buf);
  goto ERROR unless defined ($token);

  if ($tmp = &x_keyword_in_list ($token, @known_pos_xy)) {
    &x_get_token ($buf);
    $pos->{'name'} = $tmp;

    foreach my $i (1, 2) {
      $token = &x_peek_token ($buf);
      goto ERROR unless (defined ($token) || $token =~ /^\d+$/);

      $pos->{"val$i"} = &x_get_token ($buf);
    }
    $hash->{'pos'} = $pos;
  }

  elsif ($tmp = &x_keyword_in_list ($token, @known_pos_id)) {
    &x_get_token ($buf);
    $pos->{'name'} = $tmp;

    $token = &x_peek_token ($buf);
    goto ERROR unless (defined ($token) || $token =~ /^\".+\"$/);

    $pos->{'val1'} = &x_get_token ($buf);
    $pos->{'val1'} =~ s/\"//g;
    $hash->{'pos'} = $pos;
  }

  elsif ($token =~ /^\d+$/) {
    $pos->{'name'} = 'Absolute';

    foreach my $i (1, 2) {
      $token = &x_peek_token ($buf);
      goto ERROR unless (defined ($token) || $token =~ /^\d+$/);

      $pos->{"val$i"} = &x_get_token ($buf);
    }
    $hash->{'pos'} = $pos;
  }

  $config->{'Screen'}->{$hash->{'num'}} =
  {
    'Identifier' => $hash->{'id'}
  };
  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_serverlayout_screen: error parsing $kw");
}

sub x_xml_parse_serverlayout_screen
{
  my $hash = shift;
  my $kw = shift;
  my $tag = shift;

  $hash->{$kw} = {} unless exists $hash->{$kw};

  my $number = &gst_xml_get_attribute ($tag, "number");
  my $screen = { 'Identifier' => &gst_xml_get_attribute ($tag, "name") };
  $hash->{$kw}->{$number} = $screen;
}

sub x_xml_print_serverlayout_screen
{
  my ($key, $val) = @_;

  foreach my $screen (keys %$val) {
    my $name = $val->{$screen}->{'Identifier'};
    &gst_xml_print_line ("<$key number=\"$screen\" name=\"$name\"/>");
  }
}

sub x_update_serverlayout_screen
{
  my ($buf, $ptr, $old_val, $new_val) = @_;

  # Just get enough tokens from con file.
  # FIXME: Make it actually WORK.

  # Screen number
  my $token = &x_update_get_token ($buf, $ptr);
  unless ($token =~ /^\d+$/) {
    &x_update_unget_token ($buf, $ptr);
  }

  # Screen id
  $token = &x_update_get_token ($buf, $ptr);

  # Position
  my @known_pos_xy = qw (Absolute Relative);
  my @known_pos_id = qw (RightOf LeftOf Above Below);
  my $tmp;

  $token = &x_update_get_token ($buf, $ptr);
  if ($tmp = &x_keyword_in_list ($token, @known_pos_xy)) {
    $token = &x_update_get_token ($buf, $ptr);
    $token = &x_update_get_token ($buf, $ptr);
  }
  elsif ($tmp = &x_keyword_in_list ($token, @known_pos_id)) {
    $token = &x_update_get_token ($buf, $ptr);
  }
  elsif ($token =~ /^\d+$/) {
    $token = &x_update_get_token ($buf, $ptr);
  }
  else {
    $token = &x_update_unget_token ($buf, $ptr);
  }
}

sub x_del_serverlayout_screen
{
  my ($buf, $ptr, $kw, $old_val) = @_;

  #FIXME: Doesn't do anything.
#  &x_update_token ($buf, $ptr, $kw);

  &x_update_serverlayout_screen ($buf, $ptr, $old_val);
}

sub x_add_serverlayout_screen
{
  my ($buf, $ptr, $kw, $new_val) = @_;

  &x_update_add_token ($buf, $ptr, $kw);
  &x_update_add_token ($buf, $ptr, 0, 1);  

  &x_add_unique_string ($buf, $ptr, undef, $new_val);

  &x_update_add_token ($buf, $ptr, 0, 1);
  &x_update_add_token ($buf, $ptr, 0, 1);
}

# ModeLines.

sub x_parse_modeline
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;
  my @keys = qw (dotclock hdisp hsyncstart hsyncend htotal
                 vdisp vsyncstart vsyncend vtotal);
  my @flags = qw (Interlace DoubleScan +HSync -HSync +VSync -VSync
                  Composite +CSync -CSync);

  my $modeline = {};
  my $token = &x_get_token ($buf);
  goto ERROR unless defined ($token);
  $token =~ s/\"//g;
  $modeline->{'name'} = $token;

  foreach my $tmp (@keys) {
    my $token = &x_get_token ($buf);
    goto ERROR unless defined ($token);
    goto ERROR unless $token =~ /^[\d\.]+$/; #digit or '.'

    $modeline->{$tmp} = $token;
  }

  # Get flags
  while (my $token = &x_peek_token ($buf)) {
    if (my $tmp = &x_keyword_in_list ($token, @flags)) {
      &x_get_token ($buf);
      push @{$modeline->{'flags'}}, $tmp;
    } else {
      last;
    }
  }

  push @{$config->{$kw}}, $modeline;
  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_modeline: error parsing $kw");
}

sub x_xml_parse_modeline
{
  my $hash = shift;
  my $kw = shift;
  my $list = shift;

  shift @$list;

  while (@$list) {
    my $mode = {};
    shift @$list;
    my $modeline = shift @$list;

    shift @$modeline;
    while (@$modeline) {      
      my $field = shift @$modeline;
      if ($field ne 'flag') {
        $mode->{$field} = &gst_xml_get_text (shift @$modeline);
      } else {
        push @{$mode->{$field}}, &gst_xml_get_text (shift @$modeline);
      }
    }
    push @{$hash->{$kw}}, $mode;
  }
}

sub x_xml_print_modeline
{
  my ($key, $list) = @_;

  &gst_xml_container_enter ("ModeLine");

  foreach (@$list) {
    my $modeline = $_;
    &gst_xml_container_enter ("Mode");
    foreach my $field (keys %$modeline) {
      my $type = ref ($modeline->{$field});

      if (!$type) { &gst_xml_print_pcdata ($field, $modeline->{$field}); }
      elsif ($type eq 'ARRAY') {
        foreach my $flag (@{$modeline->{$field}}) {
          &gst_xml_print_pcdata ('flag', $flag);
        }
      }
      else {
        my $msg = "unknown data type $type";
        &gst_report ('x_general_warn', $msg);
        &gst_debug_print_line ("x_xml_print_modeline: $msg");
      }
    }
    &gst_xml_container_leave ();
  }
  &gst_xml_container_leave ();
}

sub x_update_modeline
{
  my ($buf, $ptr, $old_val, $new_val) = @_;
  my $token = &x_update_get_token ($buf, $ptr);
}

sub x_del_modeline
{
}

sub x_add_modeline
{
  my ($buf, $ptr, $kw, $new_val) = @_;
  my @keys = qw (dotclock hdisp hsyncstart hsyncend htotal
                 vdisp vsyncstart vsyncend vtotal);

  foreach my $modeline (@$new_val) {
    &x_update_add_token ($buf, $ptr, $kw);
    &x_add_unique_string ($buf, $ptr, undef, $modeline->{'name'});

    foreach my $key (@keys) {
      &x_update_add_token ($buf, $ptr, $modeline->{$key}, 1);
    }

    foreach my $key (@{$modeline->{'flags'}}) {
      &x_update_add_token ($buf, $ptr, $key, 1);
    }

    &x_update_add_token ($buf, $ptr, "\n");
  }
}

# Hertz range datatype
sub x_parse_range_hz
{
  my $config = shift;
  my $buf = shift;
  my $kw = shift;

  my @list;
  while (defined (my $token = &x_peek_token ($buf))) {
    my ($min, $max);
    for ($token) {

      /^([\d.]+)\-([\d\.]+)$/ and do {
        $min = $1;
        $max = $2;
        &x_get_token ($buf);
        last;
      };

      /^[\d\.]+$/ and do {
        $min = &x_get_token ($buf);
        $token = &x_peek_token ($buf);
        if ($token eq '-') {
          &x_get_token ($buf);
          $max = &x_get_token ($buf);
        } else {
          $max = $min;
        }
        
        last;

      };

      # Default
      last;
    }

    if ($min && $max) {
      push @list, [ $min, $max ];
    } else { last; }
  }

  goto ERROR if (scalar @list < 1);

  foreach (@list) {
    push @{$config->{$kw}}, $_;
  }

  return;

 ERROR:
  &gst_report ('x_parse_error', $kw);
  &gst_debug_print_line ("x_parse_range_hz: error parsing $kw");
}

sub x_xml_parse_range_hz
{
  my $hash, shift;
  my $kw = shift;

  push @{$hash->{$kw}}, &gst_xml_get_text (shift @_);
}

sub x_xml_print_range_hz
{
  my $key = shift;
  my $array = shift;

  foreach my $tmp (@$array) {
    my $val = $$tmp[0];
    $val .= '-' . $$tmp[1] if $$tmp[0] != $$tmp[1];

    &gst_xml_print_pcdata ($key, $val);
  }
}

sub x_update_range_hz
{
  # TODO:
  my ($buf, $ptr, $old_val, $new_val) = @_;
}

sub x_del_range_hz
{
  # TODO:
  my ($buf, $ptr, $kw, $old_val) = @_;
}

sub x_add_range_hz
{
  my ($buf, $ptr, $kw, $new_val) = @_;
  
  foreach my $tmp (@$new_val) {
    my $val = $$tmp[0];
    $val .= '-' . $$tmp[1] if $$tmp[0] != $$tmp[1];
    &x_update_add_token ($buf, $ptr, $kw);
    &x_update_add_token ($buf, $ptr, $val, 1);
  }
}


  
# -------------------------------------------------------
# Parser
# -------------------------------------------------------

sub x_get_token
{
  my $buf = shift;
  my $dest_buf = shift;
  my $token;

  while (@$buf) {
    my $line = $$buf[0];

    if (&gst_ignore_line ($line)) {
      push @$dest_buf, $line if defined ($dest_buf);
      shift @$buf;
      next;
    }

    $line =~ s/^(\s+)//;
    push @$dest_buf, $1 if defined ($1);
    my @list = &quotewords ('[ \t]+', 1, $line);
    $token = $list[0];
    chomp $token;
    my $pattern = $token;
    $pattern =~ s/(\W)/\\$1/g;
    $$buf[0] =~ s/$pattern//;
    last;
  }

  return $token;
}

sub x_peek_token
{
  my $buf = shift;
  my $token;

  foreach (@$buf) {
    my $line = $_;

    if (&gst_ignore_line ($line)) {
      next;
    }

    $line =~ s/^\s+//;
    my @list = &quotewords ('[ \t]+', 1, $line);    
    $token = $list[0];
    chomp $token;
    last;
  }

  return $token;
}

sub x_parse_section_start
{
  my $buf = shift;
  my $sections = shift;
  my $new_buf = shift;

  my $token = &x_get_token ($buf, $new_buf);
  $token =~ s/\"//g;

  return &x_keyword_in_list ($token, keys %$sections);
}

sub x_parse
{
  my $fname = shift;
  my ($tmp);  

  $x_version = &x_version () unless $x_version;

  my $buf = &gst_file_buffer_load ($fname);
  return unless $buf;
  
  # Init section stack
  my $section_ptr;
  my @section_stack = ();
  $section_ptr = $x_version->{'sections'};
  unshift @section_stack, $section_ptr;

  # Init config stack
  my $config = {};
  my $config_ptr = $config;
  my @config_stack = ();
  unshift @config_stack, $config_ptr;

  while (defined (my $token = &x_get_token ($buf))) {
    for ($token) {

      /^(Sub)?Section/i and do {
        if ($tmp = &x_parse_section_start ($buf, $section_ptr)) {
          $section_ptr = $section_ptr->{$tmp};
          unshift @section_stack, $section_ptr;

          push @{$config_ptr->{$tmp}}, {};
          $config_ptr = $config_ptr->{$tmp}[$#{$config_ptr->{$tmp}}];
          unshift @config_stack, $config_ptr;
        }
        last;
      };
      
      /^(End(Sub)?Section)/i and do {
        if (scalar @section_stack > 1) {
          shift @section_stack;
          $section_ptr = $section_stack[0];

          shift @config_stack;
          $config_ptr = $config_stack[0];
        }
        last;
      };

      (scalar @section_stack <= 1) and do {
        # Inside unknown section
        last;
      };

      ($tmp = &x_keyword_in_list ($token, keys %{$section_ptr->{'keywords'}})) and do {
        my $func = $section_ptr->{'keywords'}{$tmp}{'parse'};
        &$func ($config_ptr, $buf, $tmp);
        last;
      };

      # Default
      1;
    }
  }

  &gst_report ('x_parse', $fname);
  return $config;
}

# ------------------------------------------------
# XML Printing.
# ------------------------------------------------

sub x_xml_print_section
{
  my $hash = shift;
  my $section = shift;
  my $section_list = shift;
  my $section_ptr = shift;
  my ($key);

  return if (!&x_keyword_in_list ($section, @$section_list));

  $section_ptr = $x4_sections unless $section_ptr; # Always print using X4_sections.

  return unless (exists ($section_ptr->{$section}));
  &gst_xml_container_enter ("$section");

  $section_ptr = $section_ptr->{$section};
  foreach $key (keys %$hash) {
    if (exists $section_ptr->{'keywords'}{$key}) {
      my $func = $section_ptr->{'keywords'}{$key}{'xml_print'};
      &$func ($key, $hash->{$key});
    }

    elsif (exists $section_ptr->{$key}) {
      foreach my $tmp (@{$hash->{$key}}) {
        &x_xml_print_section ($tmp, $key, $section_list, $section_ptr);
      }
    }

    else {
      my $msg = "unknown keyword $key in section $section";
      &gst_report ('x_general_warn', $msg);
      &gst_debug_print_line ("x_xml_print_section: $msg");
    }
  }

  &gst_xml_container_leave ();
}

# --------------------------------------------------------------------
# XML parser
# --------------------------------------------------------------------

# Internal
sub x_xml_parse_section
{
  my ($config, $tree, $section_desc, $section_name) = @_;
  my ($keywords) = $section_desc->{'keywords'};
  my ($options) = $section_desc->{'options'};

  my $hash = {};
  shift @$tree;

  while (@$tree) {
    my $func;
    
    if (exists $keywords->{$$tree[0]}) {
      $func = $keywords->{$$tree[0]}{'xml_parse'};
      if ($func eq "") {
        
        # TODO:
        # print STDERR "$tree->[0]\n";
        1;
      } else {
        &$func ($hash, $$tree[0], $$tree[1]);
      }
    }

    elsif (exists $options->{$$tree[0]}) {
      # TODO: implement 'Option' xml parser.
#      $func = $options->{$$tree[0]}[1];
      1;
    }

    elsif (exists $section_desc->{$$tree[0]}) {
      &x_xml_parse_section ($hash, $$tree[1], $section_desc->{$$tree[0]}, $$tree[0]);
    }

    shift @$tree;
    shift @$tree;
  }

  unshift @{$config->{$section_name}}, $hash;
}

sub x_xml_parse
{  
  my $tree = shift;
  my $sections = $x4_sections; # XML uses always X4 format.

  shift @$tree;  # Skip attributes.

  my $config = {};

  while (@$tree) {
    my ($section);

    if ($section = &x_keyword_in_list ($$tree[0], keys %$sections)) {
      &x_xml_parse_section ($config, $$tree[1], $sections->{$section}, $section);
    }

    else {
      my $msg = "received unknown xml tag $$tree[0]";
      &gst_report ('xml_unexp_tag', $$tree[0]);
      &gst_debug_print_line ("x_xml_parse: $msg");
    }

    shift @$tree;
    shift @$tree;
  }

  return $config;
}

# ----------------------------------------------
# Update
# ----------------------------------------------

sub x_update_get_token
{
  my $buf = shift;
  my $ptr = shift;

  for ($ptr->{'line'}; $ptr->{'line'} < @$buf; $ptr->{'line'}++, $ptr->{'col'} = 0) {
    my $line = substr ($$buf[$ptr->{'line'}], $ptr->{'col'});

    next if &gst_ignore_line ($line);

    $line =~ s/^(\s+)//;
    $ptr->{'col'} += length ($1) if defined ($1);

    my @list = &quotewords ('[ \t]+', 1, $line);    
    my $token = $list[0];
    $ptr->{'col'} += length ($token);
    $ptr->{'col'} -= chomp $token;
    return $token;
  }

  return;
}

sub x_update_unget_token
{
  my $buf = shift;
  my $ptr = shift;

  my $line = substr ($$buf[$ptr->{'line'}], 0, $ptr->{'col'});
  my @list = &quotewords ('[ \t]+', 1, $line);
  my $token = $list[$#list];

  if (scalar @list == 2 && length ($list[0]) == 0 ||
      scalar @list <= 1) {
    --$ptr->{'line'};
    $ptr->{'col'} = length $$buf[$ptr->{'line'}];
  } else {
    $ptr->{'col'} -= length ($token);
  }
}

sub x_update_token
{
  my $buf = shift;
  my $ptr = shift;
  my $old_val = shift;
  my $new_val = shift;

  my $pattern = $old_val;
  $pattern =~ s/(\W)/\\$1/g;
  substr ($$buf[$ptr->{'line'}], 0, $ptr->{'col'}) =~ s/$pattern$/$new_val/;

  if ($$buf[$ptr->{'line'}] =~ /^\s*$/) {
    $$buf[$ptr->{'line'}] = '';
    $ptr->{'col'} = 0;
  } else {
    my $diff = length ($old_val) - length ($new_val);
    $ptr->{'col'} -= $diff;
  }
}

sub x_update_add_token
{
  my $buf = shift;
  my $ptr = shift;
  my $val = shift;
  my $same_line = shift;
#  my $new_val = $same_line ? " " : "\n";
  my $new_val = $same_line ? ' ' : '';
  $new_val .= $val;

  my $head = substr ($$buf[$ptr->{'line'}], 0, $ptr->{'col'});
  my $tail = substr ($$buf[$ptr->{'line'}], $ptr->{'col'});

  $$buf[$ptr->{'line'}] = $head . $new_val . $tail;
  $ptr->{'col'} += length ($new_val);
}

sub x_update_skip_section
{
  my ($buf, $ptr) = @_;
  my $depth = 1;

  while (defined (my $token = &x_update_get_token ($buf, $ptr))) {    
    if ($token =~ /End(Sub)?Section/i) {
      $depth--;
      last if $depth == 0;
    }

    $depth++ if $token =~ /(Sub)?Section/i;
  }
}

sub x_update_del_section
{
  my ($buf, $ptr) = @_;

  my $first = $ptr->{'line'};
  &x_update_skip_section ($buf, $ptr);
  my $last = $ptr->{'line'};

  for ($first .. $last) { $$buf[$_] = ''; }
}

sub x_update_add_section
{
  my ($buf, $ptr, $section, $section_name, $section_list, $sub_section) = @_;
  my $section_str = $sub_section ? "Subsection" : "Section";

  &x_update_add_token ($buf, $ptr, "\n$section_str \"$section_name\"\n");

  foreach my $key (keys %$section) {
    if (exists ($section_list->{$section_name}{'keywords'}{$key})) {
      my $func = $section_list->{$section_name}{'keywords'}{$key}{'add'};
      if ($func) {
        &$func ($buf, $ptr, $key, $section->{$key});
        &x_update_add_token ($buf, $ptr, "\n");
      }
    }

    elsif (exists ($section_list->{$section_name}{$key})) {
      foreach my $tmp (@{$section->{$key}}) {
        &x_update_add_section ($buf, $ptr, $tmp, $key, $section_list->{$section_name}, 1) if $tmp;
      }
    }

    else {
      my $msg = "unknown keyword $key in section $section";
      &gst_report ('x_general_warn', $msg);
      &gst_debug_print_line ("x_update_add_section: $msg");
    }
  }

  &x_update_add_token ($buf, $ptr, "End$section_str\n");
}

sub x_update_section
{
  my $buf = shift;
  my $ptr = shift;
  my $config = shift;
  my $xml_config = shift;
  my $section_list = shift;
  my $new_section;

  # Read section name
  my $section_name = &x_update_get_token ($buf, $ptr);
  $section_name =~ s/\"//g;
  $section_name = &x_keyword_in_list ($section_name, keys %$section_list);

  unless ($section_name) {
    &x_update_skip_section ($buf, $ptr);
    return;
  }

  $section_list = $section_list->{$section_name};
  my $section = shift @{$config->{$section_name}};
  my $ident_str = $section_list->{KEY};

  # Find section from xml config
  for (my $i = 0; $i <= scalar @{$xml_config->{$section_name}}; $i++) {
    next unless exists $xml_config->{$section_name}[$i];
    if ($xml_config->{$section_name}[$i]->{$ident_str} eq $section->{$ident_str}) {
      $new_section = $xml_config->{$section_name}[$i];
      delete $xml_config->{$section_name}[$i];
      last;
    }
  }

  unless ($new_section) {
    &x_update_del_section ($buf, $ptr);
    return;
  }

  while (defined (my $token = &x_update_get_token ($buf, $ptr))) {
    if ($token =~ /End(Sub)?Section/i) {
      last;
    }

    if (my $kw = &x_keyword_in_list ($token, keys %{$section_list->{'keywords'}})) {
      if (exists $new_section->{$kw}) {
        my $func = $section_list->{'keywords'}{$kw}{'update'};
        &$func ($buf, $ptr, $section->{$kw}, $new_section->{$kw}) if $func;
        delete $new_section->{$kw};
      } else {
        my $func = $section_list->{'keywords'}{$kw}{'delete'};
        &$func ($buf, $ptr, $kw, $section->{$kw}) if $func;
      }

      next;
    }

    if ($token =~ /(Sub)?Section/i) {
      &x_update_section ($buf, $ptr, $section, $new_section, $section_list);
      next;
    }
  }

  # Add new values
  
  my $first_time = 1;
  foreach my $kw (keys %$new_section) {
    &x_update_unget_token ($buf, $ptr) if $first_time;

    if (exists $section_list->{'keywords'}{$kw}) {      
      my $func = $section_list->{'keywords'}{$kw}{'add'};
      &$func ($buf, $ptr, $kw, $new_section->{$kw});
      &x_update_add_token ($buf, $ptr, "\n");
    }

    elsif (exists $section_list->{$kw}) {
      foreach my $tmp (@{$new_section->{$kw}}) {
        &x_update_add_section ($buf, $ptr, $tmp, $kw, $section_list, 1) if $tmp;
      }
    }

    else {
      my $msg = "unknown keyword $kw in section $section_name";
      &gst_report ('x_general_warn', $msg);
      &gst_debug_print_line ("x_update_section: $msg");
    }

    undef $first_time if $first_time;
  }

  &x_update_get_token ($buf, $ptr) unless $first_time;

  # Remove empty old data structs
  if (scalar @{$xml_config->{$section_name}} < 1) {
    delete $xml_config->{$section_name};
  }
}

sub x_config_set
{
  my $fname = shift;
  my $config = shift;
  my $xml_config = shift;

  return unless $fname;
  return unless $config;
  return unless $xml_config;

  my $section_list = $x_version->{'sections'};  
  my $buf = &gst_file_buffer_load ($fname);
  return unless $buf;

  my $ptr = {};
  while (defined (my $token = &x_update_get_token ($buf, $ptr))) {
    for ($token) {
      /^(Sub)?Section/i and do { &x_update_section ($buf, $ptr, $config, $xml_config, $section_list) };

      # Default:
    }
  }

  # Add new sections
  foreach my $key (keys %$xml_config) {
    if (exists ($section_list->{$key})) {
      foreach my $tmp (@{$xml_config->{$key}}) {
        &x_update_add_section ($buf, $ptr, $tmp, $key, $section_list) if $tmp;
      }
    }
  }

  &gst_file_buffer_save ($buf, $fname);
}





# ------------------------------------------------------
# Compat layer
# ------------------------------------------------------

# internal.
sub x_get_active_screen
{
  my $config = shift;
  return unless $config;

  # Make sure there is at least one screen
  unless (exists ($config->{'Screen'}) || scalar @{$config->{'Screen'}} > 0) {
    # TODO: No 'Screen's found. give error or add one.
    return;
  }

  # First try to get it from ServerLayout.
  if (exists ($config->{'ServerLayout'}) &&
      scalar @{$config->{'ServerLayout'}} > 0) {
    my $active_screen = $config->{'ServerLayout'}[0]{'Screen'};
    $active_screen = $active_screen->{0}->{'Identifier'};
    foreach my $screen (@{$config->{'Screen'}}) {
      if ($screen->{'Identifier'} eq $active_screen) {
        return $screen;
      }
    }
    # TODO: give error that Screen found at ServerLayout doesn;t exist.
  }

  # Get active Screen:

  my $section = $config->{'Screen'};
  if ($x_version->{'number'} < 400) {
    foreach my $screen (@$section) {
      # Find screen with right 'Identifier'.
      return $screen if ($screen->{'Identifier'} =~ /$x_version->{'driver'}/i);
    }
  }
  else {
    return $$section[0];
  }

  # Didn't find screen.
  # TODO: give error or add a screen

  return;
}

# ServerLayout is optional, compose one if none present
sub x_check_get_serverlayout
{
  my $config = shift;
  return unless $config;

  # No need to 'fix' anything.
  return if ($config->{'ServerLayout'});

  my $section = "ServerLayout";
  my $hash = {};

  # Add 'Identifier'
  $hash->{'Identifier'} = 'Gst Configured';

  # Add 'Screen'
  my $ref = &x_get_active_screen ($config, $x_version);
  if ($ref) {
    $hash->{'Screen'} = { 0 =>
                          {
                            'Identifier' => $ref->{'Identifier'}
                          }
                        };
  }

  push @{$config->{$section}}, $hash;
}

# X3 doesn't have ServerLayout keyword
sub x_check_set_serverlayout
{
  my $config = shift;
  return unless $config;

  if ($x_version->{'number'} < 400) {
    delete $config->{'GstXServerLayout'} if (exists ($config->{'GstXServerLayout'}));
  }
}

# internal. X verisions earlier than 4.0 didn't have 'Identifier' in 'Screen' section but
# 'Driver' was used as one.
sub x3_fix_screen
{
  my $config = shift;
  my $get = shift;

  return unless $config;

  unless (exists ($config->{'Screen'})) {
    # TODO: No 'Screen's found. give error or add one.
    return;
  }

  my $section = $config->{'Screen'};
  foreach my $screen (@$section) {
    if ($get) {
      # Driver -> Identifier
      $screen->{'Identifier'} = $screen->{'Driver'};
      delete $screen->{'Driver'};
    } else {
      # Identifier -> Driver
      $screen->{'Driver'} = $screen->{'Identifier'};
      delete $screen->{'Identifier'};
    }

    # Color depth
    if ($get) {
      # GET
      if (exists $screen->{'DefaultColorDepth'}) {
        # DefaultColorDepth -> DefaultDepth
        $screen->{'DefaultDepth'} = $screen->{'DefaultColorDepth'};
        delete $screen->{'DefaultColorDepth'};
      } else {
        # Add default depth
        $screen->{'DefaultDepth'} = 8;
      }
    } else {
      # SET
      # DefaultDepth -> DefaultColorDepth
      $screen->{'DefaultColorDepth'} = $screen->{'DefaultDepth'};
      delete $screen->{'DefaultDepth'};
    }
  }
}

# Internal.
sub x_get_active_serverlayout
{
  my $config = shift;
  return unless $config;

  if (! $config->{'ServerLayout'} ||
          scalar @{$config->{'ServerLayout'}} < 1) {
    return;
  }

  # Active == first
  my $active = $config->{'ServerLayout'}[0];
  unless ($active->{'Identifier'} || $active->{'Screen'}) {
    &gst_debug_print_line ("x_get_active_serverlayout: Incomplete active layout.");
    return;
  }

  return $active;
}

# Internal
sub x_get_active_display
{
  my $config = shift;
  return unless $config;

  my $screen = &x_get_active_screen ($config);
  return unless $screen;

  if (scalar @{$screen->{'Display'}} < 1) {
    &gst_debug_print_line ("x_get_active_display: No 'Display' subsections found.");
    return;
  }

  foreach my $disp (@{$screen->{'Display'}}) {
    return $disp if $screen->{'DefaultDepth'} == $disp->{'Depth'};
  }

  &gst_debug_print_line ("x_get_active_display: No 'Display' subsection found.");
  return;
}

# Internal
sub x_check_display
{
  my $config = shift;
  return unless $config;

  my $display = &x_get_active_display ($config);
  return unless $display;

  my $modes = $display->{'Modes'};
  if (scalar @$modes < 1) {
    &gst_debug_print_line ("x_check_display: No 'Modes' found.");
    return;
  }

  my ($maxx, $maxy) = (0, 0);
  foreach my $mode (@$modes) {
    my ($x, $y) = ($1, $2) if $mode =~ /^(\d+)x(\d+)$/i;
    $maxx = $x if $x > $maxx;
    $maxy = $y if $y > $maxy;
  }

  my $active_mode = $$modes[0];
  my ($x, $y) = ($1, $2) if $active_mode =~ /^(\d+)x(\d+)$/i;
  if ($x < $maxx || $y < $maxy) {
    $display->{'Virtual'} = [ $x, $y ];
  } else {
    delete $display->{'Virtual'};
  }
}

sub x_config_fix
{
  my $config = shift;
  my $get = shift;
  return unless $config;

  $x_version = &x_version () unless $x_version;

  if ($x_version->{'number'} < 400) {
    &x3_fix_screen ($config, $get);    
  }

  if ($get) {
    &x_check_get_serverlayout ($config);
  } else {
    &x_check_set_serverlayout ($config);
  }

  &x_check_display ($config);
}


# -----------------------------------------------------------
# Probe functions
# -----------------------------------------------------------

# Internal
sub x_probe_get_modelines
{
  my $config = shift;
  my $std_modelines = {};

  return unless $config;

  my @buf = split ('\n', $standard_modes);
  while (defined (my $token = &x_get_token (\@buf))) {
    &x_parse_modeline ($std_modelines, \@buf, $token);
  }

  return $std_modelines;
}

# Internal
sub x_probe_get_monitor
{
  my $config = shift;
  my $screen = shift;
  my $monitor;

  return unless $config;
  return unless $screen;

  my $active_monitor = $screen->{'Monitor'};
  foreach $monitor (@{$config->{'Monitor'}}) {
    if ($monitor->{'Identifier'} eq $active_monitor) {
      return $monitor;
    }
  }

  return;
}

# Internal
sub x_probe_add_monitor
{
  my $config = shift;
  my $monitor = shift;
  my $modes = shift;

  return unless $config;
  return unless $monitor;

  my $new;
  $new->{'Identifier'} = 'GstTestMonitor';
  $new->{'HorizSync'} = $monitor->{'HorizSync'};
  $new->{'VertRefresh'} = $monitor->{'VertRefresh'};
  $new->{'ModeLine'} = ();

  $new->{'ModeLine'} = $modes->{'ModeLine'};
  push @{$config->{'Monitor'}}, $new;

  return $new;
}

# Internal
sub x_probe_add_screen
{
  my $config = shift;
  my $screen = shift;
  my $monitor = shift;

  return unless $config;
  return unless $screen;
  return unless $monitor;

  my $new;
  $new->{'Identifier'} = 'GstTestScreen';
  $new->{'Device'} = $screen->{'Device'};
  $new->{'Monitor'} = 'GstTestMonitor';

  foreach my $depth (@x_colordepths) {
    my $display;    
    
    $display->{'Depth'} = $depth;
    foreach my $mode (@{$monitor->{'ModeLine'}}) {
      push @{$display->{'Modes'}}, $mode->{'name'};
    }
    push @{$new->{'Display'}}, $display;
  }

  push @{$config->{'Screen'}}, $new;
}

# Internal
sub x_probe_save
{
  my $orig_file = shift;
  my $config = shift;

  return unless $orig_file;
  return unless $config;

  my $cfg_fname;
  do { $cfg_fname = tmpnam () }
  until my $fh = IO::File->new ($cfg_fname, O_RDWR|O_CREAT|O_EXCL);

  copy ($orig_file, $cfg_fname);
  my $orig_cfg = &x_parse ($cfg_fname);

  &x_config_set ($cfg_fname, $orig_cfg, $config);

  return $cfg_fname;
}

# Internal
sub x_probe_scan
{
  my $cfg_file = shift;
  my $depth = shift;
  my $depth_cmd = ($x_version->{'number'} >= 400) ? "-depth " : "-bpp ";
  $depth_cmd .= $depth;

  my $command = $x_version->{'command'};
  &gst_debug_print_line ("$command :9 -xf86config $cfg_file -probeonly $depth_cmd -screen GstTestScreen 2>&1 |");
  open (FD, "$command :9 -xf86config $cfg_file -probeonly $depth_cmd -screen GstTestScreen 2>&1 |");
  if (FD) {
    my @content = (<FD>);
    close (FD);
    my @list = grep (/^\(\*\*\) \w+\(0\): Mode \"/, @content);
    return \@list if scalar @list;
  }

  return;
}

# Internal
sub x_probe_collect
{
  my $data = shift;
  my $modes = shift;
  my $depth = shift;  

  if (scalar @$data) {
    my $mode;
    my $list = [];

    foreach $mode (@{$modes->{'ModeLine'}}) {
      foreach (@$data) {
        my $modename = $1 if /\"(.+)\"/;
        if ($modename eq $mode->{'name'}) {
          push @$list, $mode;
          last;
        }
      }
    }
    return $list;
  }

  &gst_report ('x_probe_error', $depth);
  &gst_debug_print_line ("x_probe_collect: error reading XFree's output at depth $depth.");
  return;
}

# Internal
sub x_probe_run
{
  my $cfg_file = shift;
  my $modes = shift;

  return unless $cfg_file;

  my $hash;
  foreach my $depth (@x_colordepths) {
    my $proc = &gst_process_fork (\&x_probe_scan, $cfg_file, $depth);
    &gst_process_list_check_ready (15, $proc);
    my $list = &gst_process_result_collect ($proc, \&x_probe_collect, $modes, $depth);
    if ($list && scalar @$list) {
      $hash->{$depth} = $list;
    } else {
      last;
    }
  }

  unless ($hash) {
    &gst_report ('x_probe_error', "Error running XFree server");
    return;
  }

  return $hash;
}

# Internal
sub x_probe_print_xml
{
  my $list = shift;

  return unless $list;    

  &gst_xml_print_begin ();
  &gst_xml_print_vspace ();

  foreach my $depth (keys %$list) {
    &gst_xml_print_line ("<Depth value=\"$depth\">");
    &gst_xml_enter ();
    &x_xml_print_modeline (0, $list->{$depth});
    &gst_xml_leave ();
    &gst_xml_print_line (q(</Depth>));
  }

  &gst_xml_print_end ();
}

# Internal
sub x_probe_store
{
  my $config = shift;
  my $list = shift;

  return unless $config;
  # TODO: Write monitor and card information also.

  my $file = &gst_file_get_data_path () . "/" . $main::tool->{'name'} . "/" . $x_probe_file;

  my $fh = &gst_file_open_write_from_names ($file);
  if ($fh) {
    local *STDOUT = $fh;
    &x_probe_print_xml ($list);
    close ($fh);
  }
}

# Internal
sub x_probe_load
{
  my $config = shift;

  return unless $config;
  # TODO: Check if monitor || card is changed

  my $file = &gst_file_get_data_path () . "/" . $main::tool->{'name'} . "/" . $x_probe_file;
  my $fh = &gst_file_open_read_from_names ($file);

  if ($fh) {
    my @content = <$fh>;
    close ($fh);

    return @content if (scalar @content > 0);
  }

  return;
}

sub x_probe
{
  my $orig_file = shift;
  my $config = shift;
  my $direct = shift;

  return unless $orig_file;
  return unless $config;  

  unless ($direct) {
    my @content = &x_probe_load ($config);
    &gst_report ('x_probe_needed') unless @content;
    &gst_report_end ();
    print @content;
    return;
  }

  my $modes = &x_probe_get_modelines ($config);
  my $screen = &x_get_active_screen ($config);
  my $monitor = &x_probe_get_monitor ($config, $screen);

  $monitor = &x_probe_add_monitor ($config, $monitor, $modes);
  &x_probe_add_screen ($config, $screen, $monitor);

  my $cfg_file = &x_probe_save ($orig_file, $config);
  my $list = &x_probe_run ($cfg_file, $modes);
  unlink ($cfg_file);

  if ($list) {
    &x_probe_store ($config, $list);
    &gst_report_end ();
    &x_probe_print_xml ($list);
    return;
  }

  &gst_report_end ();
}


1;
