# x11.type1 -- X11 type1 hooks for the DTM system
#
# Copyright (C) 1997-1998 Federico Di Gregorio.
#
# This program is part of the Definitive Type Manager package.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, 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 MERCHANTIBILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.

#### configuration options ####
#
my $verbose = 0;
#
# the outlines path for the user and the system fonts can
# be specified with the following variables. these are
# reasonable defaults used by the DTM system, change them at
# your own risk...
my $sys_outlines = '/usr/share/fonts/type1/outlines';
my $user_outlines = "$ENV{HOME}/fonts/type1/outlines";
#
# there are no other configuration options because X11 wants the
# fonts.* files in the directory containing the fonts themselves.
# just remember to add your type1 directory to the fontpath with
# something like:
#
#     xset +fp $HOME/fonts/type1/outlines
#
# read the INSTALL file for more information about setting up
# your X server.
#
#### end of configuration ####


use strict;

# gets outlines path right
my $outlines = ($> == 0 ? $sys_outlines : $user_outlines);


# install a new font by creating the right fonts.scale
# entry and then by running mkfontdir
my $x11_install_font = sub {
    my $catalog = shift;
    my $snip = shift;
    
    my $id = $snip->get_attr('ID');
    my $x11name = $snip->get_attr('Name', 'x11specific') or do {
	dtm_warning("font with ID $id misses X11 specific " .
		    "information; skipping");
	return;
    };

    # it's an alias: writes the entry to the fonts.alias file
    # in the aliased font directory
    if (my $alias_id = $snip->get_attr('Alias')) {
	my $alias = $catalog->find($alias_id);
	my $file = $alias->get_attr('FontPath');

	# warns if the path is not the right one, but goes on
	if ($file ne $outlines) {
	#   dtm_warning("the FontPath attribute doesn't " .
	#    "match with the default " .
	#	    "outlines path;");
	#    dtm_warning("the X11 system may have some problems finding " .
	#	    "the fonts"); 
	#    dtm_warning("  $file <-> $outlines");
	}

	my $aliasx11name = $alias->get_attr('Name', 'x11specific') or do {
	    dtm_warning("missing X11 specific information; skipping");
	    return;
	};

	$file .= '/fonts.alias';
	safe_system("cp $file $file.old") 
	    if -r $file;
	open(FONTS, ">>$file") or do {
	    dtm_warning("can't open `$file' for appending");
	    return;
	};

	print "x11: creating alias: $x11name -> $aliasx11name\n"
	    if $verbose;

	print FONTS "$x11name $aliasx11name \n";
	close FONTS;

	safe_system("mkfontdir " . $alias->get_attr('FontPath'));
    }

    # this is a real font, writes the entries to the fonts.scale file
    else
    {
	my $file = $snip->get_attr('FontPath');

	# warns if the path is not the right one, but goes on
	if ($outlines ne $file) {
	#   dtm_warning("the FontPath attribute doesn't " .
	#    "match with the default " .
	#	    "outlines path;");
	#    dtm_warning("the X11 system may have some problems finding " .
	#	    "the fonts"); 
	#    dtm_warning("  $file <-> $outlines");
	}

	$file .= '/fonts.scale';
	if (-r $file) {
	    safe_system("cp $file $file.old"); 
	}
	else {
	    dtm_warning("the `$file' file doesn't exist; " .
			"can't add the font with ID $id");
	    return;
	}

	open(OLD, "$file.old") or do {
	    dtm_warning("can't open `$file.old' for reading");
	    return;
	};
	open(SCALE, ">$file") or do { 
	    dtm_warning("can't open `$file' for writing");
	    return;
	};

	# reads in number of fonts
	my $num = <OLD> + 1;

	print "x11: installing `" . $snip->get_attr('FontFile') .
	    "' as `$x11name'\n"
		if $verbose;
 
	print SCALE "$num\n";
	print SCALE $snip->get_attr('FontFile') . " $x11name\n";

	while (<OLD>) {
	    print SCALE $_;
	}
	close OLD; close SCALE;

	safe_system("mkfontdir " . $snip->get_attr('FontPath'));
    }
};

# removes the given font
my $x11_remove_font = sub {
    my $catalog = shift;
    my $snip = shift;

    my $id = $snip->get_attr('ID');
    my $x11name = $snip->get_attr('Name', 'x11specific') or do {
	dtm_warning("font with ID $id misses X11 specific " .
		    "information; skipping");
	return;
    };

    if (my $alias_id = $snip->get_attr('Alias')) {
	my $alias = $catalog->find($alias_id);
	my $file = $alias->get_attr('FontPath');

	$file .= '/fonts.alias';
	if (-r $file) {
	    safe_system("cp $file $file.old"); 
	}
	else {
	    dtm_warning("the `$file' file doesn't exist; " .
			"can't add the font with ID $id");
	    return;
	}

	open(OLD, "$file.old") or do {
	    dtm_warning("can't open `$file.old' for reading");
	    return;
	};
	open(ALIAS, ">$file") or do { 
	    dtm_warning("can't open `$file' for writing");
	    return;
	};

	print "x11: purging entry `$x11name'\n"
	    if $verbose;

	while (<OLD>) {
	    next if /^$x11name/;  # skips removed one
	    print ALIAS $_;
	}

	close OLD; close ALIAS;

	safe_system("mkfontdir " . $alias->get_attr('FontPath'));
    }

    # it isn't an alias, I proceed exactly the same way but I
    # need to decrease the numer of fonts by one	
    else {
	my $file = $snip->get_attr('FontPath');
	my $fontfile = $snip->get_attr('FontFile');

	$file .= '/fonts.scale';
	if (-r $file) {
	    safe_system("cp $file $file.old"); 
	}
	else {
	    dtm_warning("the `$file' file doesn't exist; " .
			"can't add the font with ID $id");
	    return;
	}

	open(OLD, "$file.old") or do {
	    dtm_warning("can't open `$file.old' for reading");
	    return;
	};
	open(SCALE, ">$file") or do { 
	    dtm_warning("can't open `$file' for writing");
	    return;
	};
	
	print "x11: purging entry `$x11name'\n"
	    if $verbose;

	# read number of fonts and writes new one
	my $num = <OLD> - 1;
	print SCALE "$num\n";
	
	while (<OLD>) {
	    next if /^$fontfile\s$x11name/;  # skips removed one
	    print SCALE $_;
	}

	close OLD; close SCALE;

	safe_system("mkfontdir " . $snip->get_attr('FontPath'));
    }
};

# we need an empty catalog with 0 fonts, so I create it
# when the directory is first accessed
my $x11_add_path = sub {
    my $catalog = shift;
    my $snip = shift;
    my $path = shift;

    open(FONTS, ">$path/fonts.scale") or do { 
	dtm_warning("can't open `$path/fonts.scale' for writing");
	return;
    };

    print "x11: installing empty fonts.scale in `$path'\n"
	if $verbose;

    print FONTS "0\n";
    close FONTS;
};

# simply removes old fonts in the path
my $x11_delete_path = sub {
    my $catalog = shift;
    my $snip = shift;    
    my $path = shift;

    print "x11: removing fonts.* files from `$path'\n"
	if $verbose;

    safe_system("rm -f $path/fonts.scale $path/fonts.scale.old");
    safe_system("rm -f $path/fonts.alias $path/fonts.alias.old");
    safe_system("rm -f $path/fonts.dir $path/fonts.dir.old");
};

# install the hooks
add_hooks(0,
	  InstallingFont => $x11_install_font,
	  RemovingFont => $x11_remove_font,
	  AddingPath => $x11_add_path,
	  DeletingPath => $x11_delete_path);

1;