Setting Resources / Tk::CmdLine 
Author Message
 Setting Resources / Tk::CmdLine

Hi Nick,

I read your message last night.

Regarding the issue of allowing the user to specify resources,
I have always been a strong advocate of letting users customize
as much as possible.

From my experience, I favor using application resource files
(ones specified via $XUSERFILESEARCHPATH,$XAPPLRESDIR) over using
$HOME/.Xdefaults. In my opinion, it is a cleaner approach. One only
loads the required resources on a as-needed basis. If there is a
need to use different resource files in different environments, that
is just a matter of setting $XUSERFILESEARCHPATH or $XAPPLRESDIR to
point to the right places.

My schema for using non-standard priorities when loading the files
was an attempt to get around the problem pointed out by Theo Peterson
in a previous message (i.e. handling of 'checkResources.Font' vs
'*Font').

Rather than try to respond to all the other items, I decided to put
together the following writeup. Hopefully after reading it you will
better understand what it is I am trying to do/change and why.

My proposal entails redoing Tk::CmdLine since it involves no changes to
other modules (after the changes, Tk::Initialize seems more appropriate?).

You know a heck of a lot more about Perl/Tk than I ever will.
Any other approach that allows the same capabilities is ok with me.

WRITEUP:

There have been all these messages going back and forth

as well as, the definition of application-specific and
user-specific resource files. I would like to clarify what
added capabilities I am requesting.

CURRENT ARGUMENT PROCESSING:


the MainWindow is created. This is done by Tk::CmdLine which
defines functions

   CreateArgs()
   Tk::MainWindow::apply_command_line()

which are invoked by Tk::MainWindow.


This has the effect of loading various package global variables.
Since these variables are not reinitialized with every process()
invocation, everything works when Tk::MainWindow ends up using process().

CURRENT RESOURCE PROCESSING:

Resources may be specified individually using

  $widget->optionAdd(<parameters>)
  $widget->optionReadfile(<parameters>)

An application may contain code to load application-specific as well
as user-specific resource files. However, since the optionAdd() and
optionReadfile() methods require that a MainWindow already exist,
these resources will not affect the MainWindow itself. For example,
the following will not set the background color.

use Tk

MAIN:
{
    $mw = MainWindow->new();

    $mw->optionAdd('*background', 'yellow', 'startupFile');

    MainLoop();

Quote:
}

Similarly, if one has an application named ptktest with a user-specific
resource file (e.g. $XAPPLRESDIR/Ptktest), a resource in this file of the
form 'ptktest*background: yellow' will not do anything to the MainWindow
itself.

However, specifying the command

  ptktest -xrm 'ptktest*background: yellow'

will work because resources specified via -xrm are added in
Tk::MainWindow::apply_command_line() (with an 'interactive' priority).

PROPOSED ARGUMENT PROCESSING:


format (e.g. -geometry 100x100 | --geometry 100x100 | --geometry=100x100).
Allow the X options to be interspersed with other options/arguments.
Recognize the meaning of '--'.


PROPOSED RESOURCE PROCESSING:

Implement a mechanism for specifying resources with given priorities
before MainWindow creation. The resources may be individual resources or
resources loaded in from specified files.

Provide a simple way of loading the standard X application-specific and
user-specific resource files using the standard priorities.

IMPLEMENTATION:

I have coded a new version of Tk::CmdLine that implements all of the above
proposals. It is intended to be a plug-in replacement for the existing
Tk::CmdLine, with no changes required to other modules (i.e. Tk::MainWindow).

By default, it is intended to function the same way as the current version.

Processing of X options is done via



Processing of individual resources is done via


A single resource may be specified using a string of the form
'<pattern>: <value>'. Multiple resources may be specified by passing
an array reference whose elements are either strings of the above
form, and/or anonymous arrays of the form [ <pattern>, <value> ].

Processing of resource files is done via

  Tk::CmdLine::LoadResources(
      [ -file     => <FileSpec>   ]
      [ -symbol   => <Symbol>     ]
      [ -priority => <Priority>   ]
      [ -echo     => <FileHandle> ] )

where

  -file may be used to specify a resource file.

  -symbol may be used to specify the name of an environment variable
  that defines a colon-separated list of directories which may
  contain the resource file. The directories may be specified as a
  pattern containing the standard X substitution symbols (e.g. %L, %T, %N).

  -priority defaults to 'userDefault'.

  -echo may be used to specify that a line should be printed
  to the corresponding FileHandle (default: \*STDOUT) everytime
  a file is loaded.

If no -file or -symbol options are specified, the function processes
the $XFILESEARCHPATH and ($XUSERFILESEARCHPATH,$XAPPLRESDIR)
environment variables. For $XFILESEARCHPATH the priority used is
'startupFile'. For ($XUSERFILESEARCHPATH,$XAPPLRESDIR), the priority
used is 'userDefault'.

When a symbol is specified, the processing entails

a) Determining if the environment variable exists.
   XUSERFILESEARCHPATH is a special case. If the environment variable
   does not exist, XAPPLRESDIR is checked instead.

b) Split the value into its component directories.
   For each directory, apply any required substitutions.

    %L is changed to the value of ($ENV{LANG} || 'C').
    %T is changed to 'app-defaults'
    %N is changed to the application class name.
    other %[A-Z] patterns are currently set to ''

   If no substitutions are made, append "/<ClassName>" to the directory.

c) Load only the first file that is found.

For example, in my environment the following symbols are defined:

  XFILESEARCHPATH
    /usr/openwin/lib/locale/%L/%T/%N%S:/usr/openwin/lib/%T/%N%S
  XAPPLRESDIR
    <HOME>/.app-defaults

Invoking Tk::CmdLine::LoadResources() in application ptktest will
result in searching for the first readable file among

  /usr/openwin/lib/locale/C/app-defaults/Ptktest
  /usr/openwin/lib/app-defaults/Ptktest

If found, it is loaded in with a priority of 'startupFile'

File <HOME>/.app-defaults/Ptktest is then examined.
If found, it is loaded in with a priority of 'userDefault'.

The Tk::CmdLine module that I have written uses an OO definition.
When I refer to the loading of resources, I mean that the resources
are stored in the object. The resources are actually not loaded
into the resource database until Tk::MainWindow::apply_command_line()
is invoked.

SAMPLE PROGRAMS:

#
# EXAMPLE 1:
#
# Behaves just like the current version.

use Tk;

MAIN:
{

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 2:
#


# is equal to (-opt1 a b c) after the BEGIN block.

use Tk;

BEGIN
{
    Tk::CmdLine::SetArguments(); # Tk::CmdLine->SetArguments() works too

Quote:
}

MAIN:
{

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 3:
#
# Just like 2) except that default arguments are loaded first.

use Tk;

BEGIN
{
    Tk::CmdLine::SetArguments(qw(-name test -iconic));
    Tk::CmdLine::SetArguments();

Quote:
}

MAIN:
{

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 4:
#

# Standard resource files are loaded in before MainWindow creation.

use Tk;

BEGIN
{
    Tk::CmdLine::SetArguments();

Quote:
}

MAIN:
{

#   Tk::CmdLine::LoadResources(-echo => \*STDOUT); # -echo prints "Loading <file>"

    Tk::CmdLine::LoadResources();

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 5:
#

# Standard resource files are loaded in before MainWindow creation
# using non-default priorities.

use Tk;

BEGIN
{
    Tk::CmdLine::SetArguments();

Quote:
}

MAIN:
{

    Tk::CmdLine::LoadResources(-echo => \*STDOUT,
        -priority => 65, -symbol => 'XFILESEARCHPATH' );
    Tk::CmdLine::LoadResources(-echo => \*STDOUT,
        -priority => 75, -symbol => 'XUSERFILESEARCHPATH' );

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 6:
#

# Standard resource files are loaded in before MainWindow creation.
# Individual resources are also loaded in before MainWindow creation.

use Tk;

BEGIN
{
    Tk::CmdLine::SetArguments();

Quote:
}

MAIN:
{

    Tk::CmdLine::LoadResources();

    Tk::CmdLine::SetResources( # set a single resource
        '*Button*background: red',
        'widgetDefault' );

    Tk::CmdLine::SetResources( # set multiple resources
        [ '*Button*background: red', '*Button*foreground: blue' ],
        'widgetDefault' );

    my $mw = MainWindow->new();

    MainLoop();

Quote:
}

#
# EXAMPLE 7:
#
# This is a small test program called TestResources01.pl
# It declares its name/class to be CheckResources.
# It loads resource file $HOME/.app-defaults/CheckResources

use Tk;

use UTLDump; # one of my library modules

BEGIN
{
    Tk::CmdLine::SetArguments(qw(-name CheckResources)); # sets the class
    Tk::CmdLine::SetArguments();

Quote:
}

MAIN:
{
    Tk::CmdLine::LoadResources(-echo => \*STDOUT);

    UTLDump::DumpObject(Tk::CmdLine::SetResources()); # returns the object

    my $mw = MainWindow->new();

    $mw->Button(-text => 'Hello World')->pack(-padx => 10, -pady => 10);

    MainLoop();

Quote:
}

The resource file is as follows:

checkResources.background:              yellow
checkResources.Button.foreground:       green
checkResources.Button.background:       blue
checkResources.Button.activeForeground: blue
checkResources.Button.activeBackground: green

When run with argument '--geometry=200x100' the output is as follows:

Loading /home1/uq608161/.app-defaults/CheckResources
   1 Tk::CmdLine=HASH(0x2f1ddc)
   2 {command}      ARRAY(0x2f1dac)
   3                [0]            '-name'
   4                [1]            'CheckResources'
   5                [2]            '-geometry'
   6                [3]            '200x100'
   7 {config}       HASH(0x2f1d58)
   8                {-class}       'CheckResources'
   9                {-name}        'CheckResources'
  10 {iconic}       '0'
  11 {methods}      HASH(0x2f1d94)
  12                {geometry}     '200x100'
  13 {name}         'TestResources01'
  14 {offset}       '0'
  15 {options}      HASH(0x2f1d7c) (NULL)
  16 {resources}    HASH(0x2f1dc4)
  17                {userDefault}  ARRAY(0x2f1fa4)
  18                               [0]            ARRAY(0xe30b0)
  19                                              [0]
'checkResources.background'
  20                                              [1]            'yellow'
  21                               [1]            ARRAY(0xe30ec)
  22                                              [0]
'checkResources.Button.foreground'
  23                                              [1]            'green'
  24                               [2]            ARRAY(0xe311c)
  25                                              [0]
'checkResources.Button.background'
  26                                              [1]            'blue'
  27                               [3]            ARRAY(0xe314c)
  28                                              [0]
'checkResources.Button.activeForeground'
  29                                              [1]            'blue'
  30                               [4]            ARRAY(0xe317c)
  31                                              [0]
'checkResources.Button.activeBackground'
  32                                              [1]            'green'
  33 {synchronous}  '0'
  34 {translation}  HASH(0x2f1eb4)
  35                {%L}           'C'
  36                {%N}           'CheckResources'
  37                {%T}           'app-defaults'

CODE:

This is my implementation of Tk::CmdLine. I would expect that it
may require additional changes. (Last night, I mailed an earlier
version to Nick which treated $XFILESEARCHPATH and $XUSERFILESEARCHPATH
as simple directories. I added the pattern substitution code this morning.)

Obviously, the documentation still needs to be added.

I did not keep a process() function, so it will break any code that
uses this function. (If necessary, it would be simple to add it.)

package Tk::CmdLine; # -*-Perl-*-

require 5.004;

use strict;

use Tk;
use FileHandle;

BEGIN
{
    use vars qw($rcsid $VERSION $ThisModule);
    $rcsid = '$Id$ ';
    $VERSION = '1999.020'; # Julian date of the last update
    $ThisModule = ref bless []; # the name of this package

Quote:
}

my $Object = undef; # the current object

#/----------------------------------------------------------------------------//
#/ Constructor
#/   Returns the object reference.
#/----------------------------------------------------------------------------//

sub new # Tk::CmdLine::new()
{

    my $class = ref($this) || $this;

    my $name = 'pTk';
    $name = $1 if (($0 =~ m/(?:^|[\/\\])([\w-]+)(?:\.\w+)?$/) && ($1 ne '-e'));

    my $self = {
        name        => $name,
        config      => { -name => $name },
        options     => {},
        methods     => {},
        command     => [],
        synchronous => 0,
        iconic      => 0,
        resources   => {} };

    bless($self, $class);

    return $self;

Quote:
}

#/----------------------------------------------------------------------------//

#/   Returns the object reference.
#/----------------------------------------------------------------------------//

sub Argument_ # Tk::CmdLine::Argument_($flag) # private method
{



    {
        die 'Usage: ', $self->{name}, ' ... ', $flag, " <argument> ...\n";
    }

Quote:
}

sub Config_ # Tk::CmdLine::Config_($flag, $name) # private method
{


    my $val = $self->Argument_($flag);

    $self->{config}->{"-$name"} = $val;

Quote:
}

sub Flag_ # Tk::CmdLine::Flag_($flag, $name) # private method
{



    $self->{$name} = 1;

Quote:
}

sub Option_ # Tk::CmdLine::Option_($flag, $name) # private method
{


    my $val = $self->Argument_($flag);

    $self->{options}->{"*$name"} = $val;

Quote:
}

sub Method_ # Tk::CmdLine::Method_($flag, $name) # private method
{


    my $val = $self->Argument_($flag);

    $self->{methods}->{$name} = $val;

Quote:
}

sub Resource_ # Tk::CmdLine::Resource_($flag, $name) # private method
{


    my $val = $self->Argument_($flag);
    if ($val =~ /^([^!:\s]+)*\s*:\s*(.*)$/)
    {

        $self->{options}->{$1} = $2;
    }

Quote:
}

my %Method = (
    synchronous  => 'Flag_',
    screen       => 'Config_',
    borderwidth  => 'Config_',
    class        => 'Config_',
    geometry     => 'Method_',
    iconposition => 'Method_',
    name         => 'Config_',
    motif        => 'Flag_',
    background   => 'Option_',
    foreground   => 'Option_',
    font         => 'Option_',
    title        => 'Config_',
    iconic       => 'Flag_',
    'reverse'    => 'Flag_',
    xrm          => 'Resource_',
    bg           => 'background',
    bw           => 'borderwidth',
    fg           => 'foreground',
    fn           => 'font',
    rv           => 'reverse',
    display      => 'screen'
);


{

        ? ((ref($_[0]) eq $ThisModule)


$ThisModule->new()))
        : ($Object ||= $ThisModule->new()));
    $Object = $self; # update the current object

    $self->{offset} = 0;



    {
        last if ($self->{argv}->[$self->{offset}] eq '--');
        unless (

$1)) ||

($1, $2))))
        {
            ++$self->{offset};
            next;
        }

        next if (!exists($Method{$option[0]}) && ++$self->{offset});

        $option[0] = $Method{$option[0]} if exists($Method{$Method{$option[0]}});

        my $method = $Method{$option[0]};


        {
            $self->{argv}->[$self->{offset}] = $option[1];
        }
        else # remove the argument
        {

        }

        $self->$method(('-' . $option[0]), $option[0]);
    }

    $self->{config}->{-class} ||= ucfirst($self->{config}->{-name});

    delete($self->{argv}); # no longer needed

    return $self;

Quote:
}

#/----------------------------------------------------------------------------//
#/ Get the value of a configuration option.
#/   Returns the option value.
#/----------------------------------------------------------------------------//

sub cget # Tk::CmdLine::cget([$option])
{

        ? ((ref($_[0]) eq $ThisModule)


$ThisModule->new()))
        : ($Object ||= $ThisModule->new()));
    $Object = $self; # update the current object

    $self->SetArguments() unless exists($self->{offset}); # set arguments if not
yet done

    return (exists($self->{config}->{$option}) ? $self->{config}->{$option} :
undef);

Quote:
}

#/----------------------------------------------------------------------------//
#/ Set the initial resources.
#/   Returns the object reference.
#/----------------------------------------------------------------------------//


$priority])
{

        ? ((ref($_[0]) eq $ThisModule)


$ThisModule->new()))
        : ($Object ||= $ThisModule->new()));
    $Object = $self; # update the current object

    $self->SetArguments() unless exists($self->{offset}); # set arguments if not
yet done




    $self->{resources}->{$priority} = [] unless
exists($self->{resources}->{$priority});


    {
        if (ref($resource) eq 'ARRAY') # resources in [ <pattern>, <value> ]
format
        {


        }
        else # resources in resource file format
        {

                if ($resource =~ /^([^!:\s]+)*\s*:\s*(.*)$/);
        }
    }

    return $self;

Quote:
}

#/----------------------------------------------------------------------------//
#/ Load initial resources from one or more files.
#/   Returns the object reference.
#/----------------------------------------------------------------------------//

sub LoadResources # Tk::CmdLine::LoadResources(%options)
{

        ? ((ref($_[0]) eq $ThisModule)


$ThisModule->new()))
        : ($Object ||= $ThisModule->new()));
    $Object = $self; # update the current object

    $self->SetArguments() unless exists($self->{offset}); # set arguments if not
yet done



    my $echo = (exists($options{-echo})
        ? (defined($options{-echo}) ? $options{-echo} : \*STDOUT) : undef);

    unless (%options && (exists($options{-file}) || exists($options{-symbol})))
    {

            { -symbol => 'XFILESEARCHPATH',     -priority => 'startupFile' },
            { -symbol => 'XUSERFILESEARCHPATH', -priority => 'userDefault' } );
    }
    else
    {

    }


    {
        my $fileSpec = $file->{-spec} = undef;
        if (exists($file->{-symbol}))
        {
            my $xpath = undef;
            if ($file->{-symbol} eq 'XUSERFILESEARCHPATH')
            {
                $file->{-priority} ||= 'userDefault';
                foreach my $symbol (qw(XUSERFILESEARCHPATH XAPPLRESDIR))
                {
                    last if (exists($ENV{$symbol}) && ($xpath = $ENV{$symbol}));
                }
                next unless defined($xpath);
            }
            else
            {
                $file->{-priority} ||= (($file->{-symbol} eq 'XFILESEARCHPATH')
                    ? 'startupFile' : 'userDefault');
                next unless (
                    exists($ENV{$file->{-symbol}}) && ($xpath =
$ENV{$file->{-symbol}}));
            }

            unless (exists($self->{translation}))
            {
                $self->{translation} = {
                    '%L' => ($ENV{LANG} || 'C'),      # language
                    '%T' => 'app-defaults',           # type
                    '%N' => $self->{config}->{-class} # filename
                };
            }

            foreach $fileSpec (split(':', $xpath))
            {
                unless ($fileSpec =~ s/(%[A-Z])/$self->{translation}->{$1}/g)
                {
                    $fileSpec .= '/' . $self->{config}->{-class};
                }
                next unless ((-f $fileSpec) && (-r _) && (-s _));
                $file->{-spec} = $fileSpec;
                last;
            }
        }
        elsif (exists($file->{-file}) && ($fileSpec = $file->{-file}))
        {
            next unless ((-f $fileSpec) && (-r _) && (-s _));
            $file->{-spec} = $fileSpec;
        }
    }


    {
        next unless defined($file->{-spec});
        print $echo 'Loading ', $file->{-spec}, "\n" if defined($echo);
        defined(my $stream = FileHandle->new($file->{-spec})) || next;
        my $resource = undef;

        my $continuation = 0;
        while (defined(my $line = <$stream>))
        {
            chomp($line);
            next if ($line =~ /^\s*$/); # skip blank lines
            next if ($line =~ /^\s*!/); # skip comments
            $continuation = ($line =~ s/\s*\\$/ /); # search for trailing
backslash
            unless (defined($resource)) # it is the first line
            {
                $resource = $line;
            }
            else # it is a continuation line
            {
                $line =~ s/^\s*//; # remove leading whitespace
                $resource .= $line;
            }
            next if $continuation;

/^([^:\s]+)*\s*:\s*(.*)$/);
            $resource = undef;
        }
        undef($stream);

    }

    return $self;

Quote:
}

#/----------------------------------------------------------------------------//

sub CreateArgs # Tk::CmdLine::CreateArgs()
{

        ? ((ref($_[0]) eq $ThisModule)


$ThisModule->new()))
        : ($Object ||= $ThisModule->new()));
    $Object = $self; # update the current object

    $self->SetArguments() unless exists($self->{offset}); # set arguments if not
yet done

    return $self->{config};

Quote:
}

#/----------------------------------------------------------------------------//

sub Tk::MainWindow::apply_command_line
{

    my $self = ($Object ||= $ThisModule->new());

    $self->SetArguments() unless exists($self->{offset}); # set arguments if not
yet done

    foreach my $priority (keys(%{$self->{resources}}))
    {

        {

        }
    }

    foreach my $key (keys(%{$self->{options}}))
    {
        $mw->optionAdd($key => $self->{options}->{$key}, 'interactive');
    }

    foreach my $key (keys(%{$self->{methods}}))
    {
        $mw->$key($self->{methods}->{$key});
    }

    if (delete($self->{methods}->{geometry}))
    {
        $mw->positionfrom('user');
        $mw->sizefrom('user');
    }

    $mw->Synchronize() if $self->{synchronous};

    if ($self->{iconic})
    {
        $mw->iconify();
        $self->{iconic} = 0;
    }

    # Both these are needed to reliably save state
    # but 'hostname' is tricky to do portably.
    # $mw->client(hostname());
    # $mw->protocol('WM_SAVE_YOURSELF' => ['WMSaveYourself',$mw]);


Quote:
}

#/----------------------------------------------------------------------------//

1;

--
__END__

------------------------------------------------------------------------

------------------------------------------------------------------------

Benny says "Do it right, do it once!"

==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Mon, 09 Jul 2001 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Setting Resources / Tk::CmdLine

2. [Fwd: Setting Resources / Tk::CmdLine]

3. [Fwd: Setting Resources / Tk::CmdLine]

4. tainting Tk::CmdLine <-> Getopt::Long

5. Changes to Tk::CmdLine

6. Changes to Tk::CmdLine

7. Changes to Tk::CmdLine

8. Tk::CmdLine

9. Tk::CmdLine POD / Relevant Command Line Options

10. Updated Tk::CmdLine module

11. Setting X resources from Perl 5

12. How to query/set resources ?

 

 
Powered by phpBB® Forum Software