diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/autolatex/pm/AutoLaTeX |
Initial commit
Diffstat (limited to 'support/autolatex/pm/AutoLaTeX')
53 files changed, 15254 insertions, 0 deletions
diff --git a/support/autolatex/pm/AutoLaTeX/Core/Config.pm b/support/autolatex/pm/AutoLaTeX/Core/Config.pm new file mode 100644 index 0000000000..9859ee8dec --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Config.pm @@ -0,0 +1,876 @@ +# autolatex - Config.pm +# Copyright (C) 1998-15 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Config.pm - Configuration Files + +=head1 DESCRIPTION + +Provides a set of utilities for manipulating cofiguration files. + +To use this library, type C<use AutoLaTeX::Core::Config;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Config; + +$VERSION = '36.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getProjectConfigFilename &getUserConfigFilename &getSystemConfigFilename + &getSystemISTFilename &readConfiguration &readConfigFile &getUserConfigDirectory + &cfgBoolean &doConfigurationFileFixing &cfgToBoolean &writeConfigFile + &readOnlySystemConfiguration &readOnlyUserConfiguration &readOnlyProjectConfiguration + &setInclusionFlags &reinitInclusionFlags &cfgIsBoolean &rebuiltConfigValue ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use warnings; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); + +use File::Spec; +use Config::Simple; + +use AutoLaTeX::Core::OS; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; + +# Constant that is representing an empty string in the INI file. +# This constant is mandatory because Config::Simple does not +# support the empty values, such as "KEY =". In place, +# the INI file must contains something like "KEY = <<<<empty>>>>". +use constant EMPTY_INI_VALUE => '<<<<empty>>>>'; + +####################################################### +# Comments for the sections of the configuration file +my %SECTION_COMMENTS = ( + 'viewer' => _T("Configuration of the viewing functions"), + 'generation' => _T("Configuration of the generation functions"), + 'clean' => _T("Configuration of the several cleaning functions"), + 'scm' => _T("Configuration of the SCM functions"), + 'gtk' => _T("GTK interface configuration"), + 'qt' => _T("Qt interface configuration"), + 'windows' => _T("Windows interface configuration"), + 'macos' => _T("MacOS interface configuration"), + 'wxwidget' => _T("wxWidgets interface configuration"), +); + +####################################################### +# Comments for the public configuration entries +my %CONFIGURATION_COMMENTS = ( + # <NO CATEGORY> + # CLEAN + 'clean.files to clean' => _T( "List of additional files to remove when cleaning (shell ". + "wild cards are allowed). This list is used when the ". + "target 'clean' is invoked."), + 'clean.files to desintegrate' => _T( "List of additional files to remove when all cleaning ". + "(shell wild cards are allowed). This list is used when ". + "the target 'cleanall' is invoked."), + # GENERATION + 'generation.biblio' => _T( "Indicates if bibliography tool (bibtex,biber) should be run ('yes' or 'no')."), + 'generation.generate images' => _T( "Does the figures must be automatically generated ('yes' or 'no')?"), + 'generation.image directory' => _T( "Specify the directories inside which AutoLaTeX ". + "will find the pictures which must be processed ". + "by the translators. Each time this option is ". + "put on the command line, a directory is added ". + "inside the list of the directories to explore. ". + "The different paths are separated by the ". + "path-separator character (':' on Unix, ';' on ". + "Windows)"), + 'generation.main file' => _T( "Main filename (this option is only available in project's ". + "configuration files)."), + 'generation.generation type' => _T( "Type of generation.\n pdf : use pdflatex to create a ". + "PDF document."), + 'generation.makeglossaries' => _T( "Indicates if glossary tool (makeglossaries) should be run ('yes' or 'no')."), + 'generation.makeindex style' => _T( "Specify the style that must be used by makeindex.\n". + "Valid values are:\n <filename> if a filename ". + "was specified, AutoLaTeX assumes that it is the .ist ". + "file;\n \@system AutoLaTeX uses the system ". + "default .ist file (in AutoLaTeX distribution);\n". + " \@detect AutoLaTeX will tries to find a .ist ". + "file in the project's directory. If none was found, ". + "AutoLaTeX will not pass a style to makeindex;\n \@none". + " AutoLaTeX assumes that no .ist file must be ". + "passed to makeindex;\n <empty> AutoLaTeX assumes ". + "that no .ist file must be passed to makeindex."), + 'generation.post compilation runs' => _T( "Defines the minimal number of times the LaTeX compilation tools (usually ". + "pdflatex) is run during the last running stage of AutoLaTeX. The default value is 1."), + 'generation.translator include path' => _T( "Defines the paths from which the translators could be ". + "loaded. This is a list of paths separated by the path ". + "separator character used by your operating system: ':' ". + "on Unix platforms or ';' on Windows platforms for example."), + 'generation.synctex' => _T( "Indicates if the PDF document must be produced with the SyncTeX flag on or not. ". + "SyncTeX enables to link a PDF viewer (as evince) and a text editor (as Gedit). ". + "When you click inside one, the other is highlighting the line in its side."), + # SCM + 'scm.scm commit' => _T( "Tool to launch when a SCM commit action is requested. ". + "Basically the SCM tools are CVS, SVN, or GIT."), + 'scm.scm update' => _T( "Tool to launch when a SCM update action is requested. ". + "Basically the SCM tools are CVS, SVN, or GIT."), + # VIEWER + 'viewer.view' => _T( "Indicates if a viewer should be launch after the compilation. ". + "Valid values are 'yes' and 'no'."), + 'viewer.viewer' => _T( "Specify, if not commented,the command line of the viewer."), + 'viewer.asynchronous run' => _T( "Indicates if the viewer is launched in background, or not."), +); + +####################################################### +# Comments for the private configuration entries +# action.create config file +# action.create ist file +# action.fix config file +# config.command line +# input.project directory +# input.latex file +# output.directory +# ouput.ist file +# output.latex basename + + +=pod + +=item B<getProjectConfigFilename(@)> + +Replies the name of a project's configuration file +which is located inside the given directory. + +I<Parameters:> + +=over 8 + +=item * the components of the paths, each parameter is a directory in the path. + +=back + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getProjectConfigFilename(@) { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile(@_,".autolatex_project.cfg")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile(@_,"autolatex_project.cfg")); + } +} + +=pod + +=item B<getUserConfigFilename()> + +Replies the name of a user's configuration file. + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getUserConfigFilename() { + my $confdir = getUserConfigDirectory(); + if (-d "$confdir") { + return File::Spec->catfile("$confdir","autolatex.conf"); + } + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},".autolatex")); + } + elsif ("$operatingsystem" eq 'Win32') { + return File::Spec->rel2abs(File::Spec->catfile("C:","Documents and Settings",$ENV{'USER'},"Local Settings","Application Data","autolatex.conf")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},"autolatex.conf")); + } +} + +=pod + +=item B<getUserConfigDirectory()> + +Replies the name of a user's configuration directory. + +I<Returns:> the configuration directory according to the current operating system rules. + +=cut +sub getUserConfigDirectory() { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},".autolatex")); + } + elsif ("$operatingsystem" eq 'Win32') { + return File::Spec->rel2abs(File::Spec->catfile("C:","Documents and Settings",$ENV{'USER'},"Local Settings","Application Data","autolatex")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},"autolatex")); + } +} + +=pod + +=item B<getSystemConfigFilename()> + +Replies the name of the configuration file for all users. + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getSystemConfigFilename() { + return File::Spec->catfile(getAutoLaTeXDir(),"default.cfg"); +} + +=pod + +=item B<getSystemISTFilename()> + +Replies the name of the MakeIndex style file for all users. + +I<Returns:> the filename according to the current operating system rules. + +=cut +sub getSystemISTFilename() { + return File::Spec->catfile(getAutoLaTeXDir(),"default.ist"); +} + +=pod + +=item B<cfgBoolean($;$)> + +Replies the Perl boolean value that corresponds to the specified +string. If the first parameter is not a valid boolean string, the second +parameter will be replied if it is specified; if not undef will be replied; + +The valid string are (case insensitive): S<true>, S<false>, S<yes>, S<no>. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=item * the data structure to fill + +=back + +I<Returns:> nothing + +=cut +sub cfgBoolean($;$) { + if ($_[0]) { + my $v = lc($_[0]); + return 1 if (($v eq 'yes')||($v eq 'true')); + return 0 if (($v eq 'no')||($v eq 'false')); + } + return $_[1]; +} + +=pod + +=item B<cfgToBoolean($)> + +Replies the configuration's file boolean value that corresponds to the specified +Perl boolean value. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=back + +I<Returns:> nothing + +=cut +sub cfgToBoolean($) { + return ($_[0]) ? 'true' : 'false'; +} + +=pod + +=item B<cfgIsBoolean($)> + +Replies if the specified string is a valid boolean string. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=back + +I<Returns:> nothing + +=cut +sub cfgIsBoolean($) { + if (defined($_[0])) { + my $v = lc($_[0]); + return 1 + if (($v eq 'yes')||($v eq 'no')||($v eq 'true')||($v eq 'false')); + } + return 0; +} + +=pod + +=item B<readConfiguration()> + +Replies the current configuration. The configuration +is extracted from the system configuration file +(from AutoLaTeX distribution) and from the user +configuration file. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readConfiguration() { + my %configuration = (); + my $systemFile = getSystemConfigFilename(); + my $userFile = getUserConfigFilename(); + readConfigFile("$systemFile",\%configuration); + readConfigFile("$userFile",\%configuration); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlySystemConfiguration()> + +Replies the current configuration. The configuration +is extracted from the system configuration file +(from AutoLaTeX distribution) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlySystemConfiguration(;$) { + my %configuration = (); + my $systemFile = getSystemConfigFilename(); + readConfigFile("$systemFile",\%configuration,$_[0]); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlyUserConfiguration(;$)> + +Replies the current configuration. The configuration +is extracted from the user configuration file +($HOME/.autolatex or $HOME/.autolatex/autolatex.conf) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlyUserConfiguration(;$) { + my %configuration = (); + my $userFile = getUserConfigFilename(); + readConfigFile("$userFile",\%configuration,$_[0]); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlyProjectConfiguration(@)> + +Replies the current configuration. The configuration +is extracted from the project configuration file +($PROJECT_PATH/.autolatex_project.cfg) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlyProjectConfiguration(@) { + my %configuration = (); + my $userFile = getProjectConfigFilename(@_); + if (-r "$userFile") { + readConfigFile("$userFile",\%configuration); + $configuration{'__private__'}{'input.project directory'} = File::Spec->catfile(@_); + return \%configuration; + } + return undef; +} + +=pod + +=item B<readConfigFile($\%;$)> + +Fill the configuration data structure from the specified file information. +The structure of the filled hashtable is a set of (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +I<Parameters:> + +=over 8 + +=item * the name of the file to read + +=item * the data structure to fill + +=item * boolean value that indicates if a warning message should be ignored when an old fashion file was detected. + +=back + +I<Returns:> nothing + +=cut +sub readConfigFile($\%;$) { + my $filename = shift; + die('second parameter of readConfigFile() is not a hash') unless(isHash($_[0])); + printDbg(formatText(_T("Opening configuration file {}"),$filename)); + if (-r "$filename") { + my $cfgReader = new Config::Simple("$filename"); + if ($cfgReader) { + my %config = $cfgReader->vars(); + my $warningDisplayed = $_[1]; + while (my ($k,$v) = each (%config)) { + $k = lc("$k"); + if ($k !~ /^__private__/) { + ($k,$v) = ensureAccendentCompatibility("$k",$v,"$filename",$warningDisplayed); + $v = rebuiltConfigValue("$k",$v); + if ($v) { + $_[0]->{"$k"} = $v; + } + } + } + } + printDbg(_T("Succeed on reading")); + } + else { + printDbg(formatText(_T("Failed to read {}: {}"),$filename,$!)); + } + 1; +} + +# Put formatted comments inside an array +sub pushComment(\@$;$) { + my $limit = $_[2] || 60; + $limit = 1 unless ($limit>=1); + my @lines = split(/\n/, $_[1]); + foreach my $line (@lines) { + my @words = split(/\s+/, $line); + my $wline = ''; + if ($line =~ /^(\s+)/) { + $wline .= $1; + } + foreach my $w (@words) { + if ((length($wline)+length($w)+1)>$limit) { + push @{$_[0]}, "#$wline\n"; + if (length($w)>$limit) { + while (length($w)>$limit) { + push @{$_[0]}, "# ".substr($w,0,$limit)."\n"; + $w = substr($w,$limit); + } + } + $wline = " $w"; + } + else { + $wline .= " $w"; + } + } + if ($wline) { + push @{$_[0]}, "#$wline\n"; + } + } +} + +# Reformat the value to be written inside a configuration file. +# $_[0]: value name, +# $_[1]: value to validated. +sub serializeConfigValue($$) { + my $v = $_[1]; + if (isArray($v)) { + $v = ''; + foreach my $ev (@{$_[1]}) { + if ($v) { + $v .= ', '; + } + $v .= &serializeConfigValue($_[0], $ev); + } + } + elsif (isHash($v)) { + $v = ''; + while (my ($key, $value) = each(%{$_[1]})) { + if ($v) { + $v .= ', '; + } + $v .= "$key:{"; + $v .= &serializeConfigValue($_[0], $value); + $v .= "}"; + } + } + return $v; +} + +=pod + +=item B<writeConfigFile($\%;$)> + +Write the specified configuration into a file. + +I<Parameters:> + +=over 8 + +=item * the name of the file to write + +=item * the configuration data structure to write + +=item * (optional) indicates if the comments must be written + +=back + +I<Returns:> nothing + +=cut +sub writeConfigFile($\%;$) { + my $filename = shift; + die('second parameter of writeConfigFile() is not a hash') unless(isHash($_[0])); + + # Write the values + printDbg(formatText(_T("Writing configuration file {}"),$filename)); + printDbgIndent(); + my $cfgWriter = new Config::Simple(syntax=>'ini'); + my $has = 0; + while (my ($attr,$value) = each (%{$_[0]})) { + if ($value && $attr ne '__private__') { + $value = serializeConfigValue($attr, $value); + if ($value) { + $cfgWriter->param("$attr",$value); + $has = 1; + } + } + } + if ($has) { + $cfgWriter->write("$filename") or printErr($cfgWriter->error()); + + if ($_[1]) { + # Updating for comments + printDbg(_T("Adding configuration comments")); + local *CFGFILE; + open (*CFGFILE, "< $filename") or printErr("$filename:","$!"); + my @lines = (); + my $lastsection = undef; + while (my $l = <CFGFILE>) { + if ($l =~ /^\s*\[\s*(.+?)\s*\]\s*$/) { + $lastsection = lc($1); + if ($SECTION_COMMENTS{"$lastsection"}) { + push @lines, "\n"; + pushComment @lines, $SECTION_COMMENTS{"$lastsection"}; + } + else { + push @lines, "\n"; + pushComment @lines, _T("Configuration of the translator")." '$lastsection'"; + } + } + elsif (($l =~ /^\s*(.*?)\s*=/)&&($lastsection)) { + my $attr = lc($1); + if ($CONFIGURATION_COMMENTS{"$lastsection.$attr"}) { + push @lines, "\n"; + pushComment @lines, $CONFIGURATION_COMMENTS{"$lastsection.$attr"}; + } + } + push @lines, $l; + } + close(*CFGFILE); + + printDbg(_T("Saving configuration comments")); + local *CFGFILE; + open (*CFGFILE, "> $filename") or printErr("$filename:","$!"); + print CFGFILE (@lines); + close(*CFGFILE); + } + } + else { + # Create an empty file + open (*CFGFILE, "> $filename") or printErr("$filename:","$!"); + close(*CFGFILE); + } + printDbgUnindent(); + 1; +} + +=pod + +=item B<doConfigurationFileFixing($)> + +Fix the specified configuration file. + +I<Parameters:> + +=over 8 + +=item * the name of the file to fix + +=back + +I<Returns:> nothing + +=cut +sub doConfigurationFileFixing($) { + my $filename = shift; + my %configuration = (); + + readConfigFile("$filename",%configuration,1); + + writeConfigFile("$filename",%configuration); + + 1; +} + +# Try to detect an old fashioned configuration file +# and fix the value +sub ensureAccendentCompatibility($$$$) { + my $k = $_[0]; + my $v = $_[1]; + my $changed = 0; + $v = '' unless (defined($v)); + + if ($k eq 'generation.bibtex') { + $k = 'generation.biblio'; + $changed = 1; + } + + if (!isArray($v)) { + # Remove comments on the same line as values + if ($v =~ /^\s*(.*?)\s*\#.*$/) { + $v = "$1" ; + $changed = 1; + } + + if ($v eq '@detect@system') { + $v = ['detect','system']; + $changed = 1; + } + } + + if (($changed)&&(!$_[3])) { + printWarn(formatText(_T("AutoLaTeX has detecting an old fashion syntax for the configuration file {}\nPlease regenerate this file with the command line option --fixconfig."), $_[2])); + $_[3] = 1; + } + + return ($k,$v); +} + +# Reformat the value from a configuration file to apply several rules +# which could not be directly applied by the configuration readed. +# $_[0]: value name, +# $_[1]: value to validated. +sub rebuiltConfigValue($$) { + my $v = $_[1]; + if (($_[0])&&($v)) { + my $v_str = trim($v); + # If the string "empty value" is detected, delete the value + if ($v_str eq EMPTY_INI_VALUE) { + $v = ''; + } + # Split the include path of translators + elsif ($_[0] eq 'generation.translator include path') { + my $sep = getPathListSeparator(); + if (isHash($v)) { + while (my ($key,$val) = each(%{$v})) { + my @tab = split(/\s*$sep\s*/,"$val"); + if (@tab>1) { + $v->{"$key"} = @tab; + } + else { + $v->{"$key"} = pop @tab; + } + } + } + else { + my @paths = (); + if (isArray($v)) { + foreach my $p (@{$v}) { + push @paths, split(/\s*$sep\s*/,"$p"); + } + } + else { + push @paths, split(/\s*$sep\s*/,"$v"); + } + if (@paths>1) { + $v = \@paths; + } + else { + $v = pop @paths; + } + } + } + } + return $v; +} + +=pod + +=item B<setInclusionFlags(\%\%;\%\%)> + +Set the translator inclusion flags obtained from the configurations. + +This function assumed that the translator list is an hashtable of +(translator_name => { 'included' => { level => boolean } }) pairs. + +I<Parameters:> + +=over 8 + +=item * the translator list. + +=item * the system configuration. + +=item * the user configuration. + +=item * the project configuration. + +=back + +I<Returns:> nothing + +=cut +sub setInclusionFlags(\%\%;\%\%) { + die('first parameter of setInclusionFlags() is not a hash') + unless (isHash($_[0])); + die('second parameter of setInclusionFlags() is not a hash') + unless (isHash($_[1])); + foreach my $trans (keys %{$_[0]}) { + if (!$_[0]->{"$trans"}{'included'}) { + $_[0]->{"$trans"}{'included'} = {}; + } + + if ((exists $_[1]->{"$trans.include module"})&&(cfgIsBoolean($_[1]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'system'} = cfgBoolean($_[1]->{"$trans.include module"}); + } + else { + # On system level, a module which was not specified as not includable must + # be included even if it will cause conflicts + $_[0]->{"$trans"}{'included'}{'system'} = undef; + } + + if (($_[2])&& + (exists $_[2]->{"$trans.include module"})&& + (cfgIsBoolean($_[2]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'user'} = cfgBoolean($_[2]->{"$trans.include module"}); + } + else { + $_[0]->{"$trans"}{'included'}{'user'} = undef; + } + + if (($_[3])&& + (exists $_[3]->{"$trans.include module"})&& + (cfgIsBoolean($_[3]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'project'} = cfgBoolean($_[3]->{"$trans.include module"}); + } + else { + $_[0]->{"$trans"}{'included'}{'project'} = undef; + } + } +} + +=pod + +=item B<reinitInclusionFlags(\%\%;\%\%)> + +Init the translator inclusion flags obtained from the configurations. + +This function assumed that the translator list is an hashtable of +(translator_name => { 'included' => { level => undef } }) pairs. + +I<Parameters:> + +=over 8 + +=item * the translator list. + +=item * the system configuration. + +=item * the user configuration. + +=item * the project configuration. + +=back + +I<Returns:> nothing + +=cut +sub reinitInclusionFlags(\%\%;\%\%) { + die('first parameter of setInclusionFlags() is not a hash') + unless (isHash($_[0])); + die('second parameter of setInclusionFlags() is not a hash') + unless (isHash($_[1])); + foreach my $trans (keys %{$_[0]}) { + if (!$_[0]->{"$trans"}{'included'}) { + $_[0]->{"$trans"}{'included'} = {}; + } + + $_[0]->{"$trans"}{'included'}{'system'} = undef; + + if ($_[2]) { + $_[0]->{"$trans"}{'included'}{'user'} = undef; + } + + if ($_[3]) { + $_[0]->{"$trans"}{'included'}{'project'} = undef; + } + } +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. (in prefered order): a) visit the developer site on GitHub <https://github.com/gallandarakhneorg/autolatex/>, b) visit the AutoLaTeX main page <http://www.arakhne.org/autolatex/>, or c) send email to the main author at galland@arakhne.org. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-2016 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm b/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm new file mode 100644 index 0000000000..7012f26a31 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm @@ -0,0 +1,201 @@ +# autolatex - IntUtils.pm +# Copyright (C) 2007-14 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Locale.pm - Internationalization Utilities + +=head1 DESCRIPTION + +Provides a set of utilities for internationalization. + +To use this library, type C<use AutoLaTeX::Core::IntUtils;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::IntUtils; + +our @ISA = qw( Exporter ); +our @EXPORT = qw( &_T &initTextDomain &getCurrentLocale &getCurrentLanguage &getCurrentCodeset &getActiveTextDomains ); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Carp; +use Locale::gettext; + +our $VERSION = '1.1'; + +my @ACTIVE_DOMAINS = (); + +=pod + +=item B<_T($)> + +Marker for the internationalization. +The parameter of this function is a string that +may be localized. +Replies the localized string that is corresponding +to the given parameter. + +CAUTION: tries to find a translation in all the initialized +text domain (see initTextDomain function). + +=cut +sub _T($) { + my $previous; + foreach my $domain (@ACTIVE_DOMAINS) { + #print "SEARCH FOR '".$_[0]."' in $domain\n"; + my $p = textdomain($domain); + $previous = $p unless $previous; + my $translation = gettext($_[0]); + #print ">$translation<\n"; + if ($translation && $translation ne $_[0]) { + return $translation; + } + } + if ($previous) { + textdomain($previous); + } + return $_[0]; +} + +=pod + +=item B<initTextDomain($$)> + +Initialize the internationalization domain. + +=over 4 + +=item domain: is the name of the text domain to use for internationalization. + +=item directory: is the directory where '.mo' (compiled '.po') could be found for the domain. + +=item codeset: is the code set used to encode the po files. + +=cut +sub initTextDomain($$;$) { + my $domain = shift || confess("initTextDomain must takes a domain as first parameter"); + my $directory = shift || confess("initTextDomain must takes a directory as second parameter"); + my $codeset = shift; + bindtextdomain($domain, $directory); + if ($codeset) { + bind_textdomain_codeset($domain, $codeset); + } + textdomain($domain); + push @ACTIVE_DOMAINS, $domain; +} + +=pod + +=item B<getActiveTextDomains()> + +Replies the active text domains. + +=cut +sub getActiveTextDomains() { + my @copy = @ACTIVE_DOMAINS; + return \@copy; +} + +=pod + +=item B<getCurrentLocale()> + +Replies the current locale. + +=cut +sub getCurrentLocale() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^([a-zA-Z]+_[a-zA-Z]+)/) { + return "$1"; + } + elsif ($lang =~ /^([a-zA-Z]+)/) { + return "$1"; + } + return undef; +} + +=pod + +=item B<getCurrentCodeset()> + +Replies the current codeset. + +=cut +sub getCurrentCodeset() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^[a-zA-Z]+_[a-zA-Z]+\.(.*)$/) { + return "$1"; + } + elsif ($lang =~ /^[a-zA-Z]+\.(.*)$/) { + return "$1"; + } + return undef; +} + +=pod + +=item B<getCurrentLangage()> + +Replies the current language. + +=cut +sub getCurrentLanguage() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^([a-zA-Z]+)_[a-zA-Z]+/) { + return "$1"; + } + elsif ($lang =~ /^([a-zA-Z]+)/) { + return "$1"; + } + return undef; +} + + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2007-14 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Main.pm b/support/autolatex/pm/AutoLaTeX/Core/Main.pm new file mode 100644 index 0000000000..f27e98e1ea --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Main.pm @@ -0,0 +1,542 @@ +# autolatex - Main.pm +# Copyright (C) 1998-16 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Main.pm - Main program + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Main; + +$VERSION = '37.0'; +$COPYRIGHT_YEAR = '2016'; +@ISA = ('Exporter'); +@EXPORT = qw( &analyzeCommandLineOptions &mainProgram &detectMainTeXFile ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $COPYRIGHT_YEAR); + +use Getopt::Long; +use File::Basename; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::OS; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::TeX::DocumentDetector; + +#------------------------------------------------------ +# +# FUNCTION: analyze the command line options and update the configuration accordingly +# +#------------------------------------------------------ +sub analyzeCommandLineOptions(\%) { + printDbg(_T("Reading command line options")); + + my $realcfg = $_[0]; + $_[0]->{'__private__'}{'CLI.warning level'} = 1; + $_[0]->{'__private__'}{'config.command line'} = {}; + my $cfg = \%{$_[0]->{'__private__'}{'config.command line'}}; + my $debugLevel = getDebugLevel(); + + Getopt::Long::Configure ("bundling"); + if (!GetOptions( + + 'auto!' => sub { $cfg->{'generation.generate images'} = ($_[1] ? 'yes' : 'no'); }, + 'asyncview!' => sub { $cfg->{'viewer.asynchronous run'} = ($_[1] ? 'yes' : 'no'); }, + 'imgdirectory=s' => sub { $cfg->{'generation.image directory'} = $_[1]; }, + + 'continuous:i' => sub { + my $duration = int($_[1]); + $duration = 0 if ($duration<0); + $realcfg->{'__private__'}{'action.continuous mode'} = $duration; + $cfg->{'viewer.asynchronous run'} = 'true'; + }, + 'nocontinuous' => sub { + delete $realcfg->{'__private__'}{'action.continuous mode'}; + }, + + 'createconfig:s' => \$realcfg->{'__private__'}{'action.create config file'}, + + 'createist' => \$realcfg->{'__private__'}{'action.create ist file'}, + + 'debug' => \$realcfg->{'__private__'}{'action.create ist file'}, + + 'defaultist' => sub { + $cfg->{'generation.makeindex style'} = '@system'; + }, + + 'directory=s' => sub { + if (!$realcfg->{'__private__'}{'action.input directories'}) { + $realcfg->{'__private__'}{'action.input directories'} = []; + } + push @{$realcfg->{'__private__'}{'action.input directories'}}, $_[1]; + }, + + 'dvi' => sub { + $cfg->{'generation.generation type'} = 'dvi'; + }, + + 'biblio!' => sub { + $cfg->{'generation.biblio'} = ($_[1] ? 'yes' : 'no'); + $realcfg->{'__private__'}{'CLI.biblio'} = ($_[1] ? 'yes' : 'no'); # For makeflat action + }, + + 'exclude=s' => sub { + foreach my $module (split /\s*,\s*/,$_[1]) { + $module =~ s/[^a-zA-Z0-9_+-]+//g; + $cfg->{lc("$module").".include module"} = 'no'; + } + }, + + 'f=s' => \$realcfg->{'__private__'}{'input.latex file'}, + 'file=s' => \$realcfg->{'__private__'}{'input.latex file'}, + + 'file-line-warning' => \$realcfg->{'__private__'}{'CLI.is extended tex warnings'}, + + 'fixconfig:s' => sub { + $realcfg->{'__private__'}{'action.fix config file'} = $_[1]; + $realcfg->{'__private__'}{'action.fix config file'} = File::Spec->rel2abs($realcfg->{'__private__'}{'action.fix config file'}) if ($realcfg->{'__private__'}{'action.fix config file'}); + }, + + 'gloss!' => sub { $cfg->{'generation.makeglossaries'} = ($_[1] ? 'yes' : 'no'); }, + + 'help|?' => sub { showManual(getAutoLaTeXDocDir(),"autolatex.pod"); }, + + 'I=s@' => sub { + if (!$cfg->{'generation.translator include path'}) { + $cfg->{'generation.translator include path'} = []; + } + push @{$cfg->{'generation.translator include path'}}, $_[1]; + }, + + 'include=s' => sub { + my $sep = getPathListSeparator(); + foreach my $module (split /\s*$sep\s*/,$_[1]) { + $module =~ s/[^a-zA-Z0-9_+-]+//g; + $cfg->{lc("$module").".include module"} = 'yes'; + } + }, + + 'index:s' => sub { + if ($_[1]) { + $cfg->{'generation.makeindex style'} = $_[1]; + } + else { + $cfg->{'generation.makeindex style'} = ['@detect','@none']; + } + }, + + 'latex' => sub { + $cfg->{'generation.tex compiler'} = 'latex'; + }, + + + 'lualatex' => sub { + $cfg->{'generation.tex compiler'} = 'lualatex'; + }, + + 'noindex' => sub { + delete $cfg->{'generation.makeindex style'}; + }, + + 'noview' => sub { $cfg->{'viewer.view'} = 'no'; }, + + 'pdf' => sub { $cfg->{'generation.generation type'} = 'pdf'; }, + + 'pdflatex' => sub { + $cfg->{'generation.tex compiler'} = 'pdflatex'; + }, + + 'postcompilationruns=i' => sub { + my $number = int($_[1]); + $number = 1 if ($number<1); + $cfg->{'generation.post compilation runs'} = $number; + }, + + 'progress:s' => sub { + if ($_[1] eq 'n') { + $realcfg->{'__private__'}{'action.show progress'} = 'n'; + } + else { + $realcfg->{'__private__'}{'action.show progress'} = 'r'; + } + }, + + 'ps' => sub { + $cfg->{'generation.generation type'} = 'ps'; + }, + + 'quiet' => sub { $debugLevel = 0; }, + + 'search-project-from=s' => sub { + $realcfg->{'__private__'}{'action.search project from'} = $_[1]; + }, + + 'set=s%' => sub { $cfg->{'generation.set'}{$_[1]} = $_[2]; }, + + 'stdout' => sub { redirectToSTDOUT(); }, + + 'stderr' => sub { redirectToSTDERR(); }, + + 'synctex!' => sub { $cfg->{'generation.synctex'} = ($_[1] ? 'yes' : 'no'); }, + + 'xelatex' => sub { + $cfg->{'generation.tex compiler'} = 'xelatex'; + }, + + 'v+' => \$debugLevel, + + 'version' => sub { if (getAutoLaTeXLaunchingName() ne getAutoLaTeXName()) { + print formatText(_T("{} {} ({}) - {} platform\n(c) 1998-{} Stephane GALLAND <galland\@arakhne.org> (under GPL)\n"), + getAutoLaTeXLaunchingName(), + getAutoLaTeXVersion(), + getAutoLaTeXName(), + getOperatingSystem(), + $COPYRIGHT_YEAR); + } + else { + print formatText(_T("{} {} - {} platform\n(c) 1998-{} Stephane GALLAND <galland\@arakhne.org> (under GPL)\n"), + getAutoLaTeXLaunchingName(), + getAutoLaTeXVersion(), + getOperatingSystem(), + $COPYRIGHT_YEAR); + } + exit(0); }, + + 'view:s' => sub { + $cfg->{'viewer.view'} = 'yes'; + if ($_[1]) { + $cfg->{'viewer.viewer'} = $_[1]; + } + }, + + 'W' => sub { + $realcfg->{'__private__'}{'CLI.warning level'}++; + }, + 'Wall' => sub { + $realcfg->{'__private__'}{'CLI.warning level'} = 2; + }, + 'Wnone' => sub { + $realcfg->{'__private__'}{'CLI.warning level'} = 0; + }, + + )) { + exit(255); + } + + setDebugLevel($debugLevel); +} + +#------------------------------------------------------ +# +# FUNCTION: Seach for a TeX main file in the current directory +# +# Requires $_[0]->{__private__}{output.directory} +# Set $_[0]->{__private__}{input.latex file} +# +#------------------------------------------------------ +sub detectMainTeXFile(\%) { + my $configuration = shift; + local *DIR; + opendir(*DIR,$configuration->{'__private__'}{'output.directory'}) or printErr($configuration->{'__private__'}{'output.directory'}.":","$!"); + my @texfiles = (); + while (my $subfile = readdir(*DIR)) { + if ((!isIgnorableDirectory($subfile)) && $subfile =~ /\.tex$/i && $subfile ne 'autolatex_autogenerated.tex') { + push @texfiles, "$subfile"; + } + } + closedir(*DIR); + if (@texfiles==1) { + my $basename = pop @texfiles; + $configuration->{'__private__'}{'input.latex file'} = + File::Spec->catfile( + $configuration->{'__private__'}{'output.directory'}, + $basename); + printDbg(formatText(_T("Selecting TeX file '{}'"), $basename)); + } + else { + printDbg(formatText(_T("Detecting several TeX files: {}"),join(' ',@texfiles))); + # Issue #9: try to detect the file with the \documentclass + my @documents = (); + foreach my $file (@texfiles) { + if (isLaTeXDocument($file)) { + push @documents, $file; + } + } + if (@documents==1) { + my $basename = pop @documents; + $configuration->{'__private__'}{'input.latex file'} = + File::Spec->catfile( + $configuration->{'__private__'}{'output.directory'}, + $basename); + printDbg(formatText(_T("Selecting TeX file '{}'"), $basename)); + } + } +} + +#------------------------------------------------------ +# +# FUNCTION: Main program +# +#------------------------------------------------------ +sub mainProgram(;$) { + my $exitOnError = shift; + $exitOnError = 1 if (!defined($exitOnError)); + # Get system and user configurations + my %configuration = readConfiguration(); + + # Put the internationalization values in the configuration + $configuration{'__private__'}{'internationalization'}{'locale'} = getCurrentLocale(); + $configuration{'__private__'}{'internationalization'}{'language'} = getCurrentLanguage(); + $configuration{'__private__'}{'internationalization'}{'codeset'} = getCurrentCodeset(); + $configuration{'__private__'}{'internationalization'}{'domains'} = getActiveTextDomains(); + + # Analyze and apply the command line + analyzeCommandLineOptions(%configuration); + + # -- Bug fix: avoid the "No TeX file found" error message to be + # displayed when a non-generation action was requested + # on the command line + if (($exitOnError)&& + (($configuration{'__private__'}{'action.fix config file'})|| + ($configuration{'__private__'}{'action.create config file'})|| + ($configuration{'__private__'}{'action.create ist file'}))) { + $exitOnError = 0; + } + + # Search for the root directory + if ($configuration{'__private__'}{'action.search project from'}) { + my $file = $configuration{'__private__'}{'action.search project from'}; + if (-e "$file" && ! -d "$file") { + $file = dirname($file); + } + $file = File::Spec->rel2abs($file); + my $autolatex_dir = undef; + my $parent = dirname($file); + while (!$autolatex_dir && $parent && $file && $parent ne $file) { + my $cfgFile = getProjectConfigFilename($file); + if (-e "$cfgFile") { + $autolatex_dir = $file; + } + $file = $parent; + $parent = dirname($file); + } + if ($autolatex_dir && -d "$autolatex_dir") { + chdir($autolatex_dir) or printErr("$autolatex_dir: $!"); + } + } + + # detect main TeX file + $configuration{'__private__'}{'output.directory'} = File::Spec->curdir(); + $configuration{'__private__'}{'output.latex basename'} = undef; + + if (!$configuration{'__private__'}{'input.latex file'}) { + detectMainTeXFile(%configuration); + } + + # read project's configuration + { + my $projectConfigFilename = getProjectConfigFilename($configuration{'__private__'}{'output.directory'}); + if ( -f "$projectConfigFilename") { + readConfigFile("$projectConfigFilename",%configuration); + + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + if (!$configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.latex file'} = basename($configuration{'generation.main file'}); + printDbg(formatText(_T("Detecting TeX file from project's configuration: '{}'"),$configuration{'__private__'}{'input.latex file'})); + } + delete $configuration{'generation.main file'}; + } + $configuration{'__private__'}{'input.project directory'} = dirname("$projectConfigFilename"); + } + } + + if (!$configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.latex file'} = 'Main.tex'; + } + + # final project main file management + if ($configuration{'__private__'}{'input.latex file'}) { + # check its value + if (-f $configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'output.directory'} = dirname($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} = basename($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} =~ s/\.tex$//i; + } + elsif (-f $configuration{'__private__'}{'input.latex file'}.".tex") { + $configuration{'__private__'}{'input.latex file'} .= ".tex"; + $configuration{'__private__'}{'output.directory'} = dirname($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} = basename($configuration{'__private__'}{'input.latex file'}); + } + } + + if ($configuration{'__private__'}{'input.latex file'}) { + printDbg(formatText(_T("Using TeX file '{}'"),$configuration{'__private__'}{'input.latex file'})); + } + elsif ($exitOnError) { + printErr(formatText(_T("No LaTeX file found nor specified for the directory '{}'.\n You must specify one on the command line option -f, or set the the variable 'generation.main file' in your configuration file, rename one of your files 'Main.tex'."), $configuration{'__private__'}{'output.directory'})); + } + + # now apply the command line options into the configuration + { + printDbg(_T("Applying command line options")); + if ($configuration{'__private__'}{'config.command line'}) { + while (my ($k,$v) = each(%{$configuration{'__private__'}{'config.command line'}})) { + if (isArray($v)) { + if (!$configuration{"$k"}) { + $configuration{"$k"} = $v; + } + elsif (isHash($configuration{"$k"})) { + for(my $i=0; $i<$#{$v}; $i=$i+2) { + $configuration{"$k"}{$v->[$i]} = $v->[$i+1]; + } + } + elsif (isArray($configuration{"$k"})) { + push @{$configuration{"$k"}}, @{$v}; + } + else { + unshift @{$v}, $configuration{"$k"}; + $configuration{"$k"} = $v; + } + } + elsif (isHash($v)) { + if (!$configuration{"$k"}) { + $configuration{"$k"} = $v; + } + elsif (isArray($configuration{"$k"})) { + push @{$configuration{"$k"}}, @{$v}; + } + elsif (isHash($configuration{"$k"})) { + while (my ($key,$val) = each(%{$v})) { + $configuration{"$k"}{$key} = $val; + } + } + else { + $v->{$configuration{"$k"}} = undef; + $configuration{"$k"} = $v; + } + } + else { + $configuration{"$k"} = $v; + } + } + if ($configuration{'generation.set'}) { + while (my ($k,$v) = each(%{$configuration{'generation.set'}})) { + $configuration{$k} = $v; + } + delete $configuration{'generation.set'} + } + delete $configuration{'__private__'}{'config.command line'}; + } + } + + # check MakeIndex parameters + if ($configuration{'generation.makeindex style'}) { + if (!isArray($configuration{'generation.makeindex style'})) { + $configuration{'generation.makeindex style'} = [$configuration{'generation.makeindex style'}]; + } + foreach my $isttype (@{$configuration{'generation.makeindex style'}}) { + if ($isttype) { + if ($isttype eq '@detect') { + # Seach for a MakeIndex style file in the current directory + local *DIR; + opendir(*DIR,$configuration{'__private__'}{'output.directory'}) or printErr($configuration{'__private__'}{'output.directory'}.":","$!"); + my @istfiles = (); + while (my $subfile = readdir(*DIR)) { + if (!isIgnorableDirectory($subfile) && $subfile =~ /\.ist$/i) { + push @istfiles, File::Spec->catfile( + $configuration{'__private__'}{'output.directory'}, + "$subfile"); + } + } + closedir(*DIR); + if (@istfiles==1) { + $configuration{'__private__'}{'output.ist file'} = File::Spec->rel2abs(pop @istfiles); + printDbg(formatText(_T("Selecting project's style for MakeIndex: {}"), $configuration{'__private__'}{'output.ist file'})); + } + else { + delete $configuration{'__private__'}{'output.ist file'}; + printDbg(formatText(_T("Unable to selected a project's style for MakeIndex: no file or too many .ist files in directory {}"), $configuration{'__private__'}{'output.directory'})); + } + } + elsif ($isttype eq '@system') { + $configuration{'__private__'}{'output.ist file'} = getSystemISTFilename(); + printDbg(formatText(_T("Selecting the system default style for MakeIndex"))); + } + elsif ($isttype eq '@none') { + delete $configuration{'__private__'}{'output.ist file'}; + printDbg(formatText(_T("Unselecting any style for MakeIndex"))); + } + + if (($configuration{'__private__'}{'output.ist file'})&& + (-r $configuration{'__private__'}{'output.ist file'})) { + last; + } + else { + delete $configuration{'__private__'}{'output.ist file'}; + } + } + } + } + + # set the project's directory if never set before + if (!$configuration{'__private__'}{'input.project directory'} && + $configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.project directory'} = File::Spec->rel2abs(dirname($configuration{'__private__'}{'input.latex file'})); + } + + # Set the directory of the pictures to a default value if not defined in + # the configuration nor given on the CLI + if (! defined($configuration{'generation.image directory'})) { + $configuration{'generation.image directory'} = $configuration{'__private__'}{'input.project directory'}; + } + + return %configuration; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-2016 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/OS.pm b/support/autolatex/pm/AutoLaTeX/Core/OS.pm new file mode 100644 index 0000000000..f33dcf69ff --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/OS.pm @@ -0,0 +1,555 @@ +# autolatex - OS.pm +# Copyright (C) 1998-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +OS.pm - Operating System + +=head1 DESCRIPTION + +Identify the current operating system. + +To use this library, type C<use AutoLaTeX::Core::OS;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::OS; + +$VERSION = '5.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getPathListSeparator &getOperatingSystem &getSupportedOperatingSystems &which + &touch &readlink_osindep &parseCLI &parseCLIWithExceptions &lastFileChange ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::stat; +use File::Basename; +use File::Path qw(make_path); + +my %operatingsystem = + (MacOS => 'Mac', + MSWin32 => 'Win32', + os2 => 'OS2', + VMS => 'VMS', + epoc => 'Epoc', + NetWare => 'Win32', + symbian => 'Win32', + dos => 'OS2', + cygwin => 'Cygwin'); + +my $Is_VMS = ($^O eq 'VMS'); +my $Is_MacOS = ($^O eq 'MacOS'); +my $Is_DOSish = (($^O eq 'MSWin32') or + ($^O eq 'dos') or + ($^O eq 'os2')); + +# For Win32 systems, stores the extensions used for +# executable files +# For others, the empty string is used +# because 'perl' . '' eq 'perl' => easier +my @path_ext = (''); +if ($Is_DOSish) { + if ($ENV{PATHEXT} and $Is_DOSish) { # WinNT. PATHEXT might be set on Cygwin, but not used. + push @path_ext, split ';', $ENV{PATHEXT}; + } + else { + push @path_ext, qw(.com .exe .bat); # Win9X or other: doesn't have PATHEXT, so needs hardcoded. + } +} +elsif ($Is_VMS) { + push @path_ext, qw(.exe .com); +} + +=pod + +=item B<getPathListSeparator()> + +Replies the separator of paths inside a path list. + +I<Returns:> the separator. + +=cut +sub getPathListSeparator() { + return $Config{'path_sep'} || ':'; +} + +=pod + +=item B<getOperatingSystem()> + +Replies the name of the current operating system. + +I<Returns:> the name. + +=cut +sub getOperatingSystem() { + return $operatingsystem{$^O} || 'Unix'; +} + +=pod + +=item B<getSupportedOperatingSystems()> + +Replies all the names of the supported operating systems. + +I<Returns:> the list of operating system's names. + +=cut +sub getSupportedOperatingSystems() { + my %list = (); + foreach my $v (values %operatingsystem) { + $list{"$v"} = 1; + } + return keys %list; +} + +sub expandShellCharsOnUnix(@) { + my $t = shift; + if ($t) { + my @parts = File::Spec->splitdir("$t"); + foreach my $e (@parts) { + if ($e eq '~') { + $e = $ENV{'HOME'}; + } + elsif ($e =~ /^~([a-zA-Z_][a-zA-Z_0-9]*)$/) { + my @p = File::Spec->split($ENV{'HOME'}); + pop @p; + $e = File::Spec->catdir(@p); + } + } + $t = File::Spec->catfile(@parts); + $t =~ s/\$([a-zA-Z_][a-zA-Z_0-9]*)/$ENV{$1}/g; + $t =~ s/\$\{([a-zA-Z_][a-zA-Z_0-9]*)\}/$ENV{$1}/g; + $t =~ s/\$\(([a-zA-Z_][a-zA-Z_0-9]*)\)/$ENV{$1}/g; + } + return $t; +} + +sub expandShellCharsOnWindows(@) { + my $t = shift; + if ($t) { + $t =~ s/\%{1,2}([a-zA-Z_][a-zA-Z_0-9]*)/$ENV{$1}/g; + $t =~ s/\%{1,2}\{([a-zA-Z_][a-zA-Z_0-9]*)\}/$ENV{$1}/g; + $t =~ s/\%{1,2}\(([a-zA-Z_][a-zA-Z_0-9]*)\)/$ENV{$1}/g; + } + return $t; +} + +=pod + +=item B<expandShellChars($)> + +Expand the specified value with the Shell metacommands. + +I<Parameters:> + +=over 8 + +=item * the string to expand. + +=back + +I<Returns:> the result of the epxansion. + +=cut +sub expandShellChars($) { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return expandShellCharsOnUnix(@_); + } + else { + return expandShellCharsOnWindows(@_); + } +} + +=pod + +=item B<which(@)> + +Replies the paths to executable programs on systems under which the `which' program wasn't implemented in the shell. + +C<which()> searches the directories of the user's C<PATH> (as returned by +C<File::Spec-E<gt>path()>), looking for executable files having the name specified +as a parameter to C<which()>. Under Win32 systems, which do not have a notion of +directly executable files, but uses special extensions such as C<.exe> and +C<.bat> to identify them, C<which()> takes extra steps to assure that you +will find the correct file (so for example, you might be searching for C<perl>, +it'll try C<perl.exe>, C<perl.bat>, etc.) + +If it finds an executable with the name you specified, C<which()> will return +the absolute path leading to this executable (for example, C</usr/bin/perl> or +C<C:\Perl\Bin\perl.exe>). + +If it does I<not> find the executable, it returns C<undef>. + +If C<which()> is called in list context, it will return I<all> the +matches. + +=over 4 + +=item C<short_exe_name> is the name used in the shell to call the program (for example, C<perl>). + +=back + +=cut +sub which(@) { + my ($exec) = @_; + + return undef unless $exec; + + my $all = wantarray; + my @results = (); + + # check for aliases first + if ($Is_VMS) { + my $symbol = `SHOW SYMBOL $exec`; + chomp($symbol); + if (!$?) { + return $symbol unless $all; + push @results, $symbol; + } + } + if ($Is_MacOS) { + my @aliases = split /\,/, $ENV{Aliases}; + foreach my $alias (@aliases) { + # This has not been tested!! + # PPT which says MPW-Perl cannot resolve `Alias $alias`, + # let's just hope it's fixed + if (lc($alias) eq lc($exec)) { + chomp(my $file = `Alias $alias`); + last unless $file; # if it failed, just go on the normal way + return $file unless $all; + push @results, $file; + # we can stop this loop as if it finds more aliases matching, + # it'll just be the same result anyway + last; + } + } + } + + my @path = File::Spec->path(); + unshift @path, File::Spec->curdir if $Is_DOSish or $Is_VMS or $Is_MacOS; + + for my $base (map { File::Spec->catfile($_, $exec) } @path) { + for my $ext (@path_ext) { + my $file = $base.$ext; + # print STDERR "$file\n"; + + if ((-x $file or # executable, normal case + ($Is_MacOS || # MacOS doesn't mark as executable so we check -e + ($Is_DOSish and grep { $file =~ /$_$/i } @path_ext[1..$#path_ext]) + # DOSish systems don't pass -x on non-exe/bat/com files. + # so we check -e. However, we don't want to pass -e on files + # that aren't in PATHEXT, like README. + and -e _) + ) and !-d _) + { # and finally, we don't want dirs to pass (as they are -x) + + # print STDERR "-x: ", -x $file, " -e: ", -e _, " -d: ", -d _, "\n"; + + return $file unless $all; + push @results, $file; # Make list to return later + } + } + } + + if($all) { + return @results; + } + else { + return undef; + } +} + +=pod + +=item B<touch(@)> + +Change the time associated to the specified files. + +=cut +sub touch(@) { + #my ($atime, $mtime); + #$atime = $mtime = time; + foreach my $f (@_) { + make_path(dirname("$f")); + if (-e "$f") { + utime(undef, undef, "$f"); + } + else { + local *FILE; + open(*FILE, "> $f") or die("$f: $!\n"); + close(*FILE); + } + } +} + +=pod + +=item B<readlink_osindep(@)> + +Try to dereference symbolic links. + +=cut +sub _readlink($) { + my $f = shift; + while ( $f && -l "$f" ) { + $f = readlink("$f"); + } + return $f; +} +sub readlink_osindep(@) { + if (wantarray) { + my @result = (); + foreach my $s (@_) { + push @result, _readlink($s); + } + return @result; + } + else { + if ($_[0]) { + return _readlink($_[0]); + } + return undef; + } +} + +=pod + +=item B<parseCLI(@)> + +Parse the given strings as command lines and extract each component. +The components are separated by space characters. If you want a +space character inside a component, you muse enclose the component +with quotes. To have quotes in components, you must protect them +with the backslash character. +This function expand the environment variables. + +I<Note:> Every paramerter that is an associative array is assumed to be an +environment of variables that should be used prior to C<@ENV> to expand the +environment variables. The elements in the parameter are treated from the +first to the last. Each time an environment was found, it is replacing any +previous additional environment. + +I<Parameters:> + +=over 8 + +=item * c<c> are the strings to parse. + +=back + +I<Returns:> the array of components if one string is given as parameter; or the array of arrays of components, +each sub array corresponds to one of the given parameters. + +=cut +sub parseCLI(@) { + my %e = (); + my @r = (); + my $addenv = undef; + if (@_>1) { + foreach my $s (@_) { + if (_ishash($s)) { + $addenv = $s; + } + else { + my @rr = _parseCLI($s,\%e,$addenv); + push @r, \@rr; + } + } + if (@r==1) { + @r = @{$r[0]}; + } + } + elsif (@_>0 && !_ishash($_[0])) { + @r = _parseCLI($_[0],\%e,$addenv); + } + return @r; +} + +=pod + +=item B<parseCLI(@)> + +Parse the given strings as command lines and extract each component. +The components are separated by space characters. If you want a +space character inside a component, you muse enclose the component +with quotes. To have quotes in components, you must protect them +with the backslash character. +This function expand the environment variables. + +I<Note:> Every paramerter that is an associative array is assumed to be an +environment of variables that should be used prior to C<@ENV> to expand the +environment variables. The elements in the parameter are treated from the +first to the last. Each time an environment was found, it is replacing any +previous additional environment. + +I<Parameters:> + +=over 8 + +=item * c<exceptions> are the names of the environment variables to not expand. + +=item * c<c> are the strings to parse. + +=back + +I<Returns:> the array of components if one string is given as parameter; or the array of arrays of components, +each sub array corresponds to one of the given parameters. + +=cut +sub parseCLIWithExceptions(\@@) { + my $e = shift; + my %ex = (); + my $addenv = undef; + foreach my $e (@{$e}) { + $ex{$e} = undef; + } + my @r = (); + if (@_>1) { + foreach my $s (@_) { + if (_ishash($s)) { + $addenv = $s; + } + else { + my @rr = _parseCLI($s,\%ex,$addenv); + push @r, \@rr; + } + } + if (@r==1) { + @r = @{$r[0]}; + } + } + elsif (@_>0 && !_ishash($_[0])) { + @r = _parseCLI($_[0],\%ex,$addenv); + } + return @r; +} + +sub _parseCLI($$$) { + my $text = shift; + my $exceptions = shift; + my $addenv = shift; + my @r = (); + if ($text) { + $text =~ s/^\s+//gs; + $text =~ s/\s+$//gs; + if ($text) { + my $protect = ''; + my $value = ''; + while ($text && $text =~ /^(.*?)(["']|(?:\s+)|(?:\\.)|(?:\$[a-zA-Z0-9_]+)|(?:\$\{[a-zA-Z0-9_]+\}))(.*)$/s) { + (my $prefix, my $sep, $text) = ($1, $2, $3); + $value .= $prefix; + if ($sep =~ /^\\(.)$/) { + $value .= $1; + } + elsif ($sep =~ /^\$(?:([a-zA-Z0-9_]+))|(?:\{([a-zA-Z0-9_]+)\})$/) { + my $varname = $1 || $2; + if ($protect eq '\'' || exists $exceptions->{"$varname"}) { + $value .= $sep; + } + elsif ($addenv && exists $addenv->{$varname}) { + $value .= ($addenv->{$varname} || ''); + } + else { + $value .= ($ENV{$varname} || ''); + } + } + elsif ($sep eq '"' || $sep eq '\'') { + if (!$protect) { + $protect = $sep; + } + elsif ($protect eq $sep) { + $protect = ''; + } + else { + $value .= $sep; + } + } + elsif ($protect) { + $value .= $sep; + } + elsif ($value) { + push @r, $value; + $value = ''; + } + } + if ($text) { + $value .= $text; + } + if ($value) { + push @r, $value; + } + } + } + return @r; +} + +sub _ishash($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "HASH" ) ; +} + +=pod + +=item B<lastFileChange($)> + +Replies the date of the last change for the specified file. +If the file does not exist, C<undef> is replied. + +=cut +sub lastFileChange($) { + my $file = shift; + return undef unless ($file); + my $stats = stat("$file"); + return undef unless ($stats); + return ($stats->mtime > $stats->ctime) ? $stats->mtime : $stats->ctime; +} + + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-13 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Progress.pm b/support/autolatex/pm/AutoLaTeX/Core/Progress.pm new file mode 100644 index 0000000000..1e7b27ed9e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Progress.pm @@ -0,0 +1,535 @@ +# autolatex - Progress.pm +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Progress.pm - Implementation of a progress indicator + +=head1 DESCRIPTION + +Provides a tool to show the progress of the tasks. + +To use this library, type C<use AutoLaTeX::Core::Progress;>. + +=head1 GETTING STARTED + +=head2 Initialization + +To create a progress tool, say something like this: + + use AutoLaTeX::Core::Progress; + + my $max = 100; + my $progress = AutoLaTeX::Core::Progress->new($max) ; + +...or something similar. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in Progress.pm itself. + +=over + +=cut +package AutoLaTeX::Core::Progress; + +our @ISA = qw( Exporter ); +our @EXPORT = qw( ); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Util qw($INTERNAL_MESSAGE_PREFIX); + +our $VERSION = '4.0'; + +#------------------------------------------------------ +# +# Constructor +# +#------------------------------------------------------ + +sub new(;$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + my $max = $_[0]; + if (!defined($max) || $max<0) { + $max = 100; + } + my $self; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'child' => undef, + 'max' => $max, + 'value' => 0, + 'parent' => undef, + 'bar-width' => 30, + 'comment' => '', + 'comment-to-display' => '', + 'previous-message-size' => 0, + 'carriage-return' => 1, + }; + } + bless( $self, $class ); + + return $self; +} + +sub _newChild($$$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = shift; + my $min = shift; + my $max = shift; + my $self = { + 'child' => undef, + 'value' => 0, + 'parent' => $parent, + 'min-in-parent' => $min, + 'max-in-parent' => $max, + 'max' => 0, + 'comment' => '', + }; + bless( $self, $class ); + return $self; +} + +=pod + +=item * setCarriageReturn($) + +Enable or disable the use of the carraige-return character +C<\r> at the end of the lines. If the carriage-return +character is not used, the new-line character C<\n> is +used. + +=over 4 + +=item B<use_carriage_return> + +=over + +=cut +sub setCarriageReturn($) : method { + my $self = shift; + $self->{'carriage-return'} = shift; +} + +=pod + +=item * getCarriageReturn() + +Replies if the carriage-return character is used at the end +of the output lines. + +=cut +sub getCarriageReturn() : method { + my $self = shift; + return $self->{'carriage-return'}; +} + +=pod + +=item * setBarWidth($) + +Set the number of characters for rendering the progress bar. + +=over 4 + +=item B<width> is the number of characters of the bar. + +=over + +=cut +sub setBarWidth($) : method { + my $self = shift; + my $width = shift; + if ($self->{'parent'}) { + $self->{'parent'}->setBarWidth($width); + } + else { + $self->{'bar-width'} = $width; + } +} + +=pod + +=item * getBarWidth() + +Replies the number of characters for rendering the progress bar. + +=cut +sub getBarWidth() : method { + my $self = shift; + if ($self->{'parent'}) { + return $self->{'parent'}->getBarWidth(); + } + else { + return $self->{'bar-width'}; + } +} + +=pod + +=item * setComment($) + +Set the comment associated to the progress process. + +=over 4 + +=item B<label> is the comment text. + +=over + +=cut +sub setComment($) : method { + my $self = shift; + my $label = shift || ''; + $self->{'comment'} = $label || ''; + my $c = ''; + my $p = $self; + while ($p->{'parent'}) { + if (!$c && $p->{'comment'}) { + $c = $p->{'comment'}; + } + $p = $p->{'parent'}; + } + if ($p && $p->{'comment-to-display'} ne $c) { + $p->{'comment-to-display'} = $c; + $p->_report(); + return 1; + } + return 0; +} + +=pod + +=item * getComment() + +Replies the comment in the progress bar. + +=cut +sub getComment() : method { + my $self = shift; + if ($self->{'parent'}) { + return $self->{'parent'}->getComment(); + } + else { + return $self->{'comment-to-display'}; + } +} + +=pod + +=item * setMax() + +Set the maximal value. It must be greater than the previous +value of max. This function does not output on the console. + +=cut +sub setMax($) : method { + my $self = shift; + my $max = shift; + if ($max>$self->{'max'}) { + $self->{'max'} = $max; + } +} + +=pod + +=item * getMax() + +Replies the maximal value. + +=cut +sub getMax() : method { + my $self = shift; + return $self->{'max'}; +} + +=pod + +=item * getValue() + +Replies the current value. + +=cut +sub getValue() : method { + my $self = shift; + return $self->{'value'}; +} + +=pod + +=item * setValue($) + +Change the progress value and display the progress message. + +=over 4 + +=item B<value> is the current value of the progress indicator. + +=back + +Returns a boolean value that indicates if something was setValueed. + +=cut +sub setValue($;$) : method { + my $self = shift; + my $value = shift; + my $comment = shift; + my $max = $self->getMax(); + my $currentValue = $self->getValue(); + my $reported = undef; + confess('undef $value') unless (defined($value)); + if ($value>$currentValue) { + $self->_set_value($value); + $currentValue = $self->getValue(); + # Close any child progress + if ($self->{'child'}) { + my $mip = $self->{'child'}{'max-in-parent'}; + if ($currentValue>=$mip) { + $reported = $self->_disconnectChildProgress(); + } + } + # Notify parent + if ($self->{'parent'}) { + my $range = $self->{'max-in-parent'} - $self->{'min-in-parent'}; + my $parent_value = ($value * $range) / $max; + $parent_value += $self->{'min-in-parent'}; + if (!defined($comment) && $self->{'comment'}) { + $comment = $self->{'comment'}; + } + my $reported2 = $self->{'parent'}->setValue($parent_value, $comment); + $reported = $reported || $reported2; + } + # Change the comment to be displayed + elsif (defined($comment) && $comment ne $self->{'comment-to-display'}) { + $self->{'comment-to-display'} = $comment; + $reported = undef; + } + # Force reporting + if (!$reported) { + $reported = $self->_report(); + } + } + return $reported ; +} + +sub _set_value($) : method { + my $self = shift; + my $value = shift; + if ($value>=$self->{'max'}) { + $self->{'value'} = $self->{'max'}; + } + else { + $self->{'value'} = $value; + } +} + +sub _report() : method { + my $self = shift; + my $value = $self->getValue(); + my $max = $self->getMax(); + if (!$self->{'parent'}) { + my $message = "[".$self->_formatPercent($value, $max)."] ".$self->_formatBar($value, $max); + if ($self->{'comment-to-display'}) { + $message .= ' '.$self->{'comment-to-display'}; + } + my $l = length($message); + my $tmp_l = $l; + while ($tmp_l<$self->{'previous-message-size'}) { + $message .= ' '; + $tmp_l++; + } + $self->{'previous-message-size'} = $l; + if (!$self->{'carriage-return'} || ($value>=$max)) { + print STDOUT "$message\n"; + } + else { + print STDOUT "$message\r"; + } + $INTERNAL_MESSAGE_PREFIX = "\n"; + return 1; + } + return undef; +} + +sub _formatPercent($$) : method { + my $self = shift; + my $value = shift; + my $max = shift; + my $percent = int(($value * 100) / $max); + while (length($percent)<3) { + $percent = " $percent"; + } + return "$percent\%"; +} + +sub _formatBar($$) : method { + my $self = shift; + my $value = shift; + my $max = shift; + my $bar_width = $self->getBarWidth(); + my $nchars = int(($value * $bar_width) / $max); + my $i = 0; + my $bar = ''; + while ($i<$nchars) { + $bar .= '#'; + $i++; + } + while ($i<$bar_width) { + $bar .= '.'; + $i++; + } + return $bar; +} + +sub _disconnectChildProgress() : method { + my $self = shift; + if ($self->{'child'}) { + my $max_in_parent = $self->{'child'}{'max-in-parent'}; + $self->{'child'} = undef; + return $self->setValue($max_in_parent); + } + return undef; +} + +=pod + +=item * subProgress($$) + +Create a subtask. + +=over 4 + +=item B<size> (optional) is the size of the subtask in this progress. If not given, the rest of the parent task is covered by the sub task. + +=back + +Replies the subtask progress object. + +=cut +sub subProgress(;$) : method { + my $self = shift; + my $size = shift; + + my $parent_max = $self->getMax(); + my $min_in_parent = $self->getValue(); + + if (!defined($size) || $size<0) { + $size = $parent_max - $min_in_parent; + } + + my $max_in_parent = $min_in_parent + $size; + if ($max_in_parent>$parent_max) { + $max_in_parent = $parent_max; + } + + $self->{'child'} = AutoLaTeX::Core::Progress->_newChild( + $self, + $min_in_parent, + $max_in_parent); + + return $self->{'child'}; +} + +=pod + +=item * increment(;$) + +Increment the current value by the given amount, or by 1 if the amount is not given or invalid. + +=cut +sub increment(;$) : method { + my $self = shift; + my $inc = shift; + if (!defined($inc) || $inc<=0) { + $inc = 1; + } + my $value = $self->getValue(); + $self->setValue($value+$inc); +} + +=pod + +=item * stop() + +Stop the progress. + +=cut +sub stop() : method { + my $self = shift; + my $max = $self->getMax(); + $self->setValue($max); +} + +=pod + +=item * debug() + +Output the state of this progress. + +=cut +sub debug(;$) : method { + my $self = shift; + my $level = shift || 0; + printf STDERR ("%s[\%3d] value: 0<=\%f<=\%f\n", $INTERNAL_MESSAGE_PREFIX, $level, $self->{'value'}, $self->{'max'}); + $INTERNAL_MESSAGE_PREFIX = ''; + if ($self->{'parent'}) { + my $parent_value = $self->{'parent'}->getValue(); + printf STDERR ("[\%3d] in-parent: \%f<=%f<=\%f\n", $level, $self->{'min-in-parent'}, $parent_value, $self->{'max-in-parent'}); + } + else { + printf STDERR ("[\%3d] comment: \%s\n", $level, $self->{'comment'}); + } + if ($self->{'child'}) { + $self->{'child'}->debug($level+1); + } +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bug, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Translator.pm b/support/autolatex/pm/AutoLaTeX/Core/Translator.pm new file mode 100644 index 0000000000..2216cc905f --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Translator.pm @@ -0,0 +1,1308 @@ +# autolatex - Translator.pm +# Copyright (C) 2014-2015 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Translator.pm - Translator Utilities + +=head1 DESCRIPTION + +Permits to get translators and to resolve conflicts on them. + +To use this library, type C<use AutoLaTeX::Core::Translator;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Translator; + +$VERSION = '21.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getTranslatorFilesFrom &getLoadableTranslatorList &getTranslatorList + &detectConflicts @ALL_LEVELS + &makeTranslatorHumanReadable &extractTranslatorNameComponents + &readTranslatorFile &runRootTranslator &runTranslator &loadTranslator + &loadTranslatorsFromConfiguration &loadTranslatableImageList ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION @ALL_LEVELS); +use Carp; +use File::Spec; +use File::Basename; +use File::Path qw(make_path remove_tree); +use File::Copy; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::OS; + +# Sorted list of the levels +our @ALL_LEVELS = ('system', 'user', 'project'); + +# Data for the translators +my %ROOT_TRANSLATORS = (); + +=pod + +=item * extractTranslatorNameComponents($) + +Parse a complete translator name to extract the components. +The name must have the syntax: +=over 8 + +=item * C<"I<source>2I<target>"> + +=item * C<"I<source>2I<target>+I<target2>"> + +=item * C<"I<source>2I<target>_I<variante>"> + +=item * C<"I<source>2I<target>+I<target2>_I<variante>"> + +=back + +I<Parameters:> + +=over 8 + +=item * The name to parse (string). + +=back + +I<Returns:> a hashtable containing the components of the name. The keys are: + +=over 8 + +=item * C<name> is the name of the translator. + +=item * C<full-source> is the decoded of the source type. + +=item * C<source> is the source type given in the parameter of the function. + +=item * C<target> is the decoded target. + +=item * C<variante> is the decoded variante. + +=item * C<basename> is the basename of the translator. + +=back + +=cut +sub extractTranslatorNameComponents($) { + my $name = shift; + if ($name =~ /^([a-zA-Z+-]+)2([a-zA-Z0-9-]+)(?:\+([a-zA-Z0-9+-]+))?(?:_(.*))?$/) { + my $source = $1; + my $target = $2; + my $target2 = $3||''; + my $variante = $4||''; + my $osource = "$source"; + my $basename = "${source}2${target}${target2}"; + if ($target2) { + if ($target2 eq 'tex') { + $source = "ltx.$source"; + } + elsif ($target2 eq 'layers') { + $source = "layers.$source"; + } + elsif ($target2 eq 'layers+tex' || $target2 eq 'tex+layers') { + $source = "layers.ltx.$source"; + } + else { + $target .= "+$target2"; + } + } + return { 'name' => $name, 'full-source' => $source, 'source' => $osource, 'target' => $target, 'variante' => $variante, 'basename' => $basename }; + } + return undef; +} + +=pod + +=item * makeTranslatorHumanReadable($) + +Replies a human readable string that corresponds to the specified translator data. + +I<Parameters:> + +=over 8 + +=item * C<description> is the description of the translator (hasharray). The value of the parameter may be obtained with C<extractTranslatorNameComponents()>. + +=back + +I<Returns:> the description of the translator. + +=cut +sub makeTranslatorHumanReadable($) { + my $data = shift; + if ($data->{'variante'}) { + return formatText(_T("Translate {} to {} with {} alternative"), + $data->{'full-source'}, + $data->{'target'}, + $data->{'variante'}); + } + else { + return formatText(_T("Translate {} to {}"), + $data->{'full-source'}, + $data->{'target'}); + } +} + +=pod + +=item * getTranslatorFilesFrom($) + +Replies the descriptions of the translator files installed on the system. + +I<Parameters:> + +=over 8 + +=item * C<configuration> (hashtable) is the current configuration of AutoLaTeX. + +=item * C<directory> (string) is the path to the directory to explore. + +=item * C<fileSet> (hashtable) is the associative array in which the discovered translators will be put. + +=item * C<recursive> (boolean) indicates if the function must recurse in the directories. + +=item * C<warn> (boolean) indicates if the warning may be output or not. + +=item * C<onlyincluded> (boolean) indicates if only the included translated will be considered as discovered. + +=item * C<level> (string) is the level to consider (see C<@ALL_LEVELS>). + +=back + +I<Returns:> nothing. + +=cut +sub getTranslatorFilesFrom(\%$\%$$$;$) { + my $configuration = shift; + my $filename = shift; + my $fileSet = shift; + my $recursive = shift; + my $warn = shift; + my $onlyincluded = shift; + my $level = shift || 'unknown'; + my $ispdfmode = ($configuration->{'generation.generation type'} || 'pdf') eq 'pdf'; + local *DIR; + if (-d "$filename") { + my @dirs = ( "$filename" ); + while (@dirs) { + my $dirname = shift @dirs; + formatText(_T("Get translator list from {}"),$dirname); + if (opendir(*DIR,"$dirname")) { + while (my $file = readdir(*DIR)) { + if ( ! isIgnorableDirectory($file) ) { + my $fullname = File::Spec->catfile("$dirname","$file"); + if (-d "$fullname") { + push @dirs, "$fullname" if ($recursive); + } + elsif ($file =~ /^([a-zA-Z+-]+2[a-zA-Z0-9+-]+(?:_[a-zA-Z0-9_+-]+)?).transdef$/i) { + my $scriptname = "$1"; + if ($onlyincluded) { + $fileSet->{"$scriptname"} = extractTranslatorNameComponents($scriptname); + $fileSet->{"$scriptname"}{'human-readable'} = makeTranslatorHumanReadable($fileSet->{"$scriptname"}); + $fileSet->{"$scriptname"}{'file'} = "$fullname"; + $fileSet->{"$scriptname"}{'level'} = "$level"; + $fileSet->{"$scriptname"}{'ispdfmode'} = $ispdfmode; + } + else { + $fileSet->{"$scriptname"} = "$fullname"; + } + } + } + } + closedir(*DIR); + } + else { + printWarn("$dirname:","$!"); + } + } + } + elsif ($warn) { + printWarn("$filename:","$!"); + } + 1; +} + +=pod + +=item * resolveConflicts($) + +Resolve conflicts between translator inclusions. + +I<Parameter:> + +=over 8 + +=item * C<includedTranslators> (hashtable) is the loaded translators. The keys are the names of the translators, and the values are the filenames of the translators. + +=back + +I<Returns:> nothing. + +=cut +sub resolveConflicts(\%) { + my $includedTranslators = shift; + my %bysources = (); + # The targets with "*+tex" are translated into sources "ltx.*" + # The targets with "*+layers" are translated into sources "layers.*" + while (my ($trans,$transfile) = each (%{$includedTranslators})) { + my $components = extractTranslatorNameComponents($trans); + if ($components) { + if (!$bysources{$components->{'full-source'}}) { + $bysources{$components->{'full-source'}} = []; + } + push @{$bysources{$components->{'full-source'}}}, { + 'source' => $components->{'source'}, + 'target' => $components->{'target'}, + 'variante' => $components->{'variante'}, + 'filename' => "$transfile" }; + } + } + + while (my ($source,$trans) = each(%bysources)) { + if (@{$trans}>1) { + my $msg = ''; + my ($excludemsg,$excludename); + foreach my $t (@{$trans}) { + $msg .= ",\n" if ($msg); + $msg .= makeTranslatorHumanReadable($t); + if (!$excludename) { + $excludename = $t->{'source'}."2".$t->{'target'}; + $excludename .= "_".$t->{'variante'} if ($t->{'variante'}); + } + if (!$excludemsg) { + $excludemsg = "[$excludename]\ninclude module = no\n"; + } + } + printErr(formatText(_T("Several possibilities exist for generating a figure from a {} file:\n{}\n\nYou must specify which to include (resp. exclude) with --include (resp. --exclude).\n\nIt is recommended to update your {} file with the following configuration for each translator to exclude (example on the translator {}):\n\n{}\n"), + $source, + $msg, + getUserConfigFilename(), + $excludename, + $excludemsg)); + } + } + 1; +} + +=pod + +=item B<detectConflicts(\%)> + +Replies the list of the translators that are in conflict. + +I<Parameters:> + +=over 8 + +=item * List of translator pairs (translator name => hashtable) + +=back + +I<Returns:> a hashtable containing (level => hash of translator descriptions) pairs. + +=cut +sub detectConflicts(\%) { + die('first parameter of detectConflicts() is not a hash') + unless (isHash($_[0])); + my %bysources = (); + # Build the list of included translators + while (my ($name,$data) = each(%{$_[0]})) { + # By default a module is included + for(my $i=0; $i<@ALL_LEVELS; $i++) { + my $level = $ALL_LEVELS[$i]; + if ($data->{'included'}{$level}) { + $bysources{$level}{$data->{'full-source'}}{$data->{'name'}} = $data; + # Propagate the inclusion to the following levels + for(my $j=$i+1; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}} = $data; + } + } + elsif (defined($data->{'included'}{$level})) { + # Propagate the non inclusion to the following levels + # This action cancels previous propagation of included translators + for(my $j=$i; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + if ($bysources{$flevel}{$data->{'full-source'}}) { + delete $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}}; + } + } + } + elsif ($i==0) { + # By default a module is included + # Propagate the inclusion to the following levels + $bysources{$level}{$data->{'full-source'}}{$data->{'name'}} = $data; + for(my $j=$i+1; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}} = $data; + } + } + } + } + + # Remove the translators that are not under conflict + foreach my $level (@ALL_LEVELS) { + foreach my $source (keys %{$bysources{$level}}) { + my @keys = keys %{$bysources{$level}{$source}}; + if (@keys<=1) { + delete $bysources{$level}{$source}; + } + } + unless ($bysources{$level}) { + delete $bysources{$level}; + } + } + + return %bysources; +} + +=pod + +=item B<getLoadableTranslatorList(\%)> + +Replies the list of the translators that could be loaded. + +I<Parameters:> + +=over 8 + +=item * hashtable that contains the current configuration, and that will +be updating by this function. + +=back + +I<Returns:> a hashtable containing (translator name => translator file) pairs. + +=cut +sub getLoadableTranslatorList(\%) { + local *DIR; + + my %includes = (); + + # Load distribution modules + my $filename = File::Spec->catfile(getAutoLaTeXDir(),"translators"); + printDbg(formatText(_T("Get loadable translators from {}"),$filename)); + printDbgIndent(); + opendir(*DIR,"$filename") + or printErr("$filename:","$!"); + while (my $file = readdir(*DIR)) { + if ((!isIgnorableDirectory($file))&& + ($file =~ /^(.*)\.transdef$/i)) { + my $fullname = File::Spec->rel2abs(File::Spec->catfile("$filename","$file")); + my $scriptname = "$1"; + if ((!exists $_[0]->{"$scriptname.include module"})|| + (cfgBoolean($_[0]->{"$scriptname.include module"}))) { + $includes{"$scriptname"} = "$fullname"; + } + else { + printDbg(formatText(_T("Translator {} is ignored"),$scriptname)); + } + } + } + closedir(*DIR); + printDbgUnindent(); + + # Load user modules recursively from ~/.autolatex/translators + getTranslatorFilesFrom( + %{$_[0]}, + File::Spec->catfile(getUserConfigDirectory(),"translators"), + %includes, + 1, # recursion + 0, # no warning + 0, # only included translators + 'user' # configuration level + ); + + # Load user modules non-recursively the paths specified inside the configurations + if ($_[0]->{'generation.translator include path'}) { + my @paths = (); + if ((isArray($_[0]->{'generation.translator include path'}))|| + (isHash($_[0]->{'generation.translator include path'}))) { + @paths = @{$_[0]->{'generation.translator include path'}}; + } + else { + push @paths, $_[0]->{'generation.translator include path'}; + } + foreach my $path (@paths) { + getTranslatorFilesFrom( + %{$_[0]}, + "$path", + %includes, + 0, # no recursion + 1, # warning + 0, # only included translators + 'user' # configuration level + ); + } + } + + resolveConflicts(%includes); + + return %includes; +} + +=pod + +=item B<getTranslatorList(\%;$)> + +Replies the list of the translators and their status. + +I<Parameters:> + +=over 8 + +=item * hashtable that contains the configuration. + +=item * recurse on user inclusion directories + +=back + +I<Returns:> a hashtable containing (translator name => { 'file' => translator file, +'level' => installation level, 'ispdfmode' => boolean value indicating that +the pdf mode is one } ) pairs. + +=cut +sub getTranslatorList(\%;$) { + local *DIR; + die('first parameter of getTranslatorList() is not a hash') + unless(isHash($_[0])); + + my $recurse = $_[1]; + $recurse = 1 unless (defined($recurse)); + + my $ispdfmode = ($_[0]->{'generation.generation type'} || 'pdf') eq 'pdf'; + + my %translators = (); + + # Load distribution modules + my $filename = File::Spec->catfile(getAutoLaTeXDir(),"translators"); + printDbg(formatText(_T("Get translators from {}"),$filename)); + printDbgIndent(); + opendir(*DIR,"$filename") or printErr("$filename:","$!"); + while (my $file = readdir(*DIR)) { + if ((!isIgnorableDirectory($file))&& + ($file =~ /^(.*)\.transdef$/i)) { + my $fullname = File::Spec->rel2abs(File::Spec->catfile("$filename","$file")); + my $scriptname = "$1"; + $translators{"$scriptname"} = extractTranslatorNameComponents($scriptname); + $translators{"$scriptname"}{'human-readable'} = makeTranslatorHumanReadable($translators{"$scriptname"}); + $translators{"$scriptname"}{'file'} = "$fullname"; + $translators{"$scriptname"}{'level'} = 'system'; + $translators{"$scriptname"}{'ispdfmode'} = $ispdfmode; + } + } + closedir(*DIR); + printDbgUnindent(); + + if ($recurse) { + # Load user modules recursively from ~/.autolatex/translators + getTranslatorFilesFrom( + %{$_[0]}, + File::Spec->catfile(getUserConfigDirectory(),"translators"), + %translators, + 1, # recursion + 0, # no warning + 1, # all included and not-included translators + 'user' # configuration level + ); + + # Load user modules non-recursively the paths specified inside the configurations + if ($_[0]->{'generation.translator include path'}) { + my @paths = (); + if ((isArray($_[0]->{'generation.translator include path'}))|| + (isHash($_[0]->{'generation.translator include path'}))) { + @paths = @{$_[0]->{'generation.translator include path'}}; + } + else { + push @paths, $_[0]->{'generation.translator include path'}; + } + foreach my $path (@paths) { + getTranslatorFilesFrom( + %{$_[0]}, + "$path", + %translators, + 0, # no recursion + 1, # warning + 1, # all included and not-included translators + 'user' # configuration level + ); + } + } + } # if ($recurse) + + return %translators; +} + +=pod + +=item B<readTranslatorFile($$)> + +Replies the content of a translator definition file. + +I<Parameters:> + +=over 8 + +=item * C<file> is the name of the file to parse. + +=item * C<ispdfmode> indicates of AutoLaTeX is in pdf mode (true) or in eps mode (false). + +=back + +I<Returns:> a hashtable containing the entries of the definition. + +=cut +sub readTranslatorFile($$) { + my $file = shift || confess('you must pass a filename to readTranslatorFile($$)'); + my $ispdfmode = shift; + my %content = (); + local *FILE; + open(*FILE, "< $file") or printErr("$file: $!"); + my $curvar = ''; + my $eol = undef; + my $lineno = 0; + while (my $line = <FILE>) { + $lineno++; + if ($eol) { + if ($line =~ /^\Q$eol\E\s*$/) { + $eol = undef; + $curvar = undef; + } + elsif ($curvar) { + $content{"$curvar"}{'value'} .= $line; + } + } + elsif ($line !~ /^\s*[#;]/) { + if ($line =~ /^\s*([azA-Z0-9_]+)(?:\s+with\s+(.*?))?(?:\s+for\s+((?:pdf)|(?:eps)))?\s*=\<\<([a-zA-Z0-9_]+)\s*(.*?)\s*$/i) { + ($curvar, my $interpreter, my $mode, $eol, my $value) = ($1, $2, $3, $4, $5); + if (!$mode || + ($ispdfmode && lc($mode) eq 'pdf') || + (!$ispdfmode && lc($mode) eq 'eps')) { + $curvar = uc($curvar); + $content{"$curvar"} = { + 'lineno' => $lineno, + 'value' => $value, + 'interpreter' => ($interpreter ? lc($interpreter) : undef), + }; + } + else { + $curvar = ''; + } + } + elsif ($line =~ /^\s*([azA-Z0-9_]+)(?:\s+with\s+(.*?))?(?:\s+for\s+((?:pdf)|(?:eps)))?\s*=\s*(.*?)\s*$/i) { + my ($var, $interpreter, $mode, $value) = ($1, $2, $3, $4); + if (!$mode || + ($ispdfmode && lc($mode) eq 'pdf') || + (!$ispdfmode && lc($mode) eq 'eps')) { + $curvar = undef; + $eol = undef; + $content{uc("$var")} = { + 'lineno' => $lineno, + 'value' => $value, + 'interpreter' => ($interpreter ? lc($interpreter) : undef), + }; + } + } + elsif ($line !~ /^\s*$/) { + printErr(formatText(_T("Line outside a definition ({}:{})."),$lineno, $file)); + } + } + } + close(*FILE); + if ($eol) { + printErr(formatText(_T("The block for the variable '{}' is not closed. Keyword '{}' was not found ({}:{})."), + $curvar, $eol, $file, $lineno)); + } + + + # Translate the values into suitable Perl objects + if (exists $content{'INPUT_EXTENSIONS'}{'value'}) { + my @exts = split(/\s+/, ($content{'INPUT_EXTENSIONS'}{'value'} || '')); + $content{'INPUT_EXTENSIONS'}{'value'} = []; + foreach my $e (@exts) { + if ($e !~ /^\^s*$/) { + if ($e !~ /^[\.+]/) { + $e = ".$e"; + } + push @{$content{'INPUT_EXTENSIONS'}{'value'}}, $e; + } + } + } + + if (exists $content{'OUTPUT_EXTENSIONS'}{'value'}) { + my @exts = split(/\s+/, ($content{'OUTPUT_EXTENSIONS'}{'value'} || '')); + $content{'OUTPUT_EXTENSIONS'}{'value'} = []; + foreach my $e (@exts) { + if ($e !~ /^\^s*$/) { + if ($e !~ /^\./) { + $e = ".$e"; + } + push @{$content{'OUTPUT_EXTENSIONS'}{'value'}}, $e; + } + } + } + + if (exists $content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'}) { + my @exts = split(/\s+/, ($content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} || '')); + $content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} = []; + while (@exts) { + my $e = shift @exts; + if ($exts[0] && + ( ($exts[0] =~ /^\Q'\E.*?\Q'\E$/) || + ($exts[0] =~ /^\Qqw(\E.+?\Q)\E$/) || + ($exts[0] =~ /^\Qqw{\E.+?\Q}\E$/))) { + my $p = shift @exts; + $e .= " $p"; + } + push @{$content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'}}, $e; + } + } + + if (exists $content{'FILES_TO_CLEAN'}{'value'}) { + my @patterns = split(/\s+/, ($content{'FILES_TO_CLEAN'}{'value'} || '')); + $content{'FILES_TO_CLEAN'}{'value'} = []; + foreach my $p (@patterns) { + if ($p !~ /^\^s*$/) { + push @{$content{'FILES_TO_CLEAN'}{'value'}}, $p; + } + } + } + + return \%content; +} + +=pod + +=item B<runRootTranslator(\%$$\%$;$)> + +Run the translator on a file as a root translator. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is AutoLaTeX configuration. + +=item * C<name> is name of the translator. + +=item * C<in> is the name of the input file. + +=item * C<translators> definition of all the translators. + +=item * C<force> indicates if the translation is always run (true) or only if the source file is more recent than the target file. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut + +sub runRootTranslator(\%$$\%$) { + my $configuration = shift || confess("configuration is mandatory"); + my $transname = shift || confess("transname is mandatory"); + my $in = shift || confess("input is mandatory"); + my $translators = shift || confess("translators are mandatory"); + my $force = shift; + + my $out = undef; + my @transexts = sort { + my $la = length($a); + my $lb = length($b); + my $c = $lb <=> $la; + if ($c) { + ($c); + } + else { + ($a cmp $b); + } + } + @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}; + my $i = 0; + while (($i<@transexts) && (!$out)) { + if ($in =~ /^(.+)\Q$transexts[$i]\E$/i) { + $out = "$1"; + } + $i++; + } + $out = "$in" unless ($out); + $out .= $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + + $ROOT_TRANSLATORS{'configuration'} = $configuration; + $ROOT_TRANSLATORS{'translators'} = $translators; + $ROOT_TRANSLATORS{'force'} = $force; + $ROOT_TRANSLATORS{'loglevel'} = 1; + $ROOT_TRANSLATORS{'fail-on-error'} = 1; + + return _runTranslator( + $configuration, + $translators, + $transname, + $in, + $out, + $force, + 1, + 1); +} + +=pod + +=item B<runTranslator($$$)> + +Run the translator on a file. + +I<Parameters:> + +=over 8 + +=item * C<name> is name of the translator. + +=item * C<in> is the name of the input file. + +=item * C<out> is the name of the output file. + +=item * C<failOnError> (optional) indicates if the translator must fail on error or not. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut +sub runTranslator($$$;$) { + my $transname = shift || confess("name is mandatory"); + my $in = shift || confess("input is mandatory"); + my $out = shift || confess("output is mandatory"); + my $failOnError = shift; + if (!$ROOT_TRANSLATORS{'translators'}) { + printErr(_T("You cannot call runTranslator() outside the call stack of runRootTranslator().")); + } + if (!defined($failOnError)) { + $failOnError = $ROOT_TRANSLATORS{'fail-on-error'}; + } + printDbgIndent(); + my $savedFailure = $ROOT_TRANSLATORS{'fail-on-error'}; + $ROOT_TRANSLATORS{'fail-on-error'} = $failOnError; + $ROOT_TRANSLATORS{'loglevel'}++; + my $r = _runTranslator( + $ROOT_TRANSLATORS{'configuration'}, + $ROOT_TRANSLATORS{'translators'}, + $transname, + $in, + $out, + $ROOT_TRANSLATORS{'force'}, + $ROOT_TRANSLATORS{'loglevel'}, + $failOnError); + $ROOT_TRANSLATORS{'loglevel'}--; + $ROOT_TRANSLATORS{'fail-on-error'} = $savedFailure; + printDbgUnindent(); + return $r; +} + +# Private translator function +sub _runTranslator($$$$$$$$) { + my $configuration = shift || confess("configuration is mandatory"); + my $translators = shift || confess("translators are mandatory"); + my $transname = shift || confess("transname is mandatory"); + my $in = shift || confess("input is mandatory"); + my $out = shift || confess("output is mandatory"); + my $force = shift; + my $logLevel = shift; + my $failOnError = shift; + my $ispdfmode = (($configuration->{'generation.generation type'} || 'pdf') eq 'pdf'); + my $isepsmode = !$ispdfmode; + + $in = File::Spec->rel2abs("$in"); + $out = File::Spec->rel2abs("$out"); + + if (! -r "$in") { + my $errmsg = formatText(_T("{}: file not found or not readable."), $in); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + if (!exists $translators->{"$transname"} || + !exists $translators->{"$transname"}{'transdef'} || + !$translators->{"$transname"}{'transdef'}) { + # The requested translator was not enabled by the user. + # We try to enable it on the fly. + loadTranslator($transname, $translators); + } + + # Try to avoid the translation if the source file is no more recent than the target file. + if (!$force) { + my $inChange = lastFileChange("$in"); + my $outChange = lastFileChange("$out"); + if (!defined($outChange)) { + # No out file, try to detect other types of generated files + local *DIR; + my $dirname = dirname("$out"); + if (opendir(*DIR, "$dirname")) { + my $fn; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + my $bn = basename($out, $ext); + while (!defined($outChange) && ($fn = readdir(*DIR))) { + if (!isIgnorableDirectory($fn) + && $fn =~ /^(\Q${bn}_\E.*)\Q$ext\E$/s) { + my $ffn = File::Spec->catfile("$dirname", "$fn"); + my $t = lastFileChange("$ffn"); + if (defined($t) && (!defined($outChange) || $t<$outChange)) { + $outChange = $t; + } + } + } + closedir(*DIR); + } + } + + if (defined($outChange) && $inChange<$outChange) { + # No need to translate again + printDbgFor(2, formatText(_T("{} is up-to-date."), basename($out))); + return 1; + } else { + printDbgFor(3, formatText(_T("in={}; out={}."), $outChange, $inChange)); + } + } + + if ($logLevel) { + printDbgFor($logLevel, formatText(_T("{} -> {}"), basename($in), basename($out))); + } + + if ($translators->{"$transname"}{'transdef'}{'COMMAND_LINE'}{'value'}) { + ################################ + # Run an external command line # + ################################ + my $cli = ($translators->{"$transname"}{'transdef'}{'COMMAND_LINE'}{'value'} || ''); + # Create the environment of variables for the CLI + my %environment = (%{$translators->{"$transname"}{'environment_variables'}}); + while (my ($k,$v) = each(%{$configuration})) { + if (!isArray($v) && !isHash($v)) { + $environment{$k} = $v; + } + } + $environment{'in'} = $in; + $environment{'out'} = $out; + my $inext; + while ((!$inext)&& ((undef,my $e) = each @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}})) { + if ($in =~ /\Q$e\E$/i) { + $inext = $e; + } + } + if (!$inext) { + $inext = $translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}[0]; + } + $environment{'inext'} = $inext; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + $environment{'outbasename'} = basename($out, $ext); + $environment{'outwoext'} = File::Spec->catfile(dirname($out), $environment{'outbasename'}); + # Create the CLI to run + my @cli = parseCLI(\%environment, "$cli"); + + if (getDebugLevel>=4) { + $cli = '$'; + foreach my $elt (@cli) { + $cli .= " ".addSlashes($elt); + } + printDbg("$cli"); + } + + runCommandOrFail(@cli); + } + elsif ($translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'}) { + ######################### + # Run the embedded code # + ######################### + my $lineno = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'lineno'} - 1; + my $interpreter = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'interpreter'}; + + my @inexts = @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}; + my $inext; + while ((!$inext)&& ((undef,my $e) = each @inexts)) { + if ($in =~ /\Q$e\E$/i) { + $inext = $e; + } + } + if (!$inext) { + $inext = $inexts[0]; + } + my $outext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0]; + my @outexts = @{$translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}}; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + my $outbasename = basename($out, $ext); + my $outwoext = File::Spec->catfile(dirname($out), $outbasename); + + if (!$interpreter || $interpreter eq 'perl') { + # + # PERL INTERPRETER + # + my $code; + { + my $perlDeps = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} || []; + $code = "{\n"; + if ($perlDeps) { + foreach my $dep (@{$perlDeps}) { + $code .= "use ".$dep.";\n"; + $lineno++; + } + } + $code .= $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'}; + $code .= "}\n"; + } + + my $c = eval $code; + if (!defined($c) && $@) { + my $msg = "$@"; + $msg =~ s/(\(eval\s+[0-9]+\)\s*line\s+)([0-9]+)/$1.($2 + $lineno)."($2)"/egsi; + $msg = formatText(_T("Error in the TRANSLATOR_FUNCTION of '{}':\n{}"), $transname, $msg); + if ($failOnError) { + printErr($msg); + } + else { + #print STDERR formatErr($msg); + return 0; + } + } + # Return the last value of the translator's script + return $c; + } + else { + # + # OTHER INTERPRETER + # + my $wrapper; + eval "use AutoLaTeX::Interpreter::$interpreter; \$wrapper = AutoLaTeX::Interpreter::$interpreter->new();"; + if (!$wrapper) { + my $errmsg = formatText(_T("Cannot find an interpreter wrapper for {}: {}"), $interpreter, ($@||'')); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + $wrapper->define_global_variable('_in', $in); + $wrapper->define_global_variable('_out', $out); + $wrapper->define_global_variable('_inexts', \@inexts); + $wrapper->define_global_variable('_inext', $inext); + $wrapper->define_global_variable('_outext', $outext); + $wrapper->define_global_variable('_outexts', \@outexts); + $wrapper->define_global_variable('_ext', $ext); + $wrapper->define_global_variable('_outbasename', $outbasename); + $wrapper->define_global_variable('_outwoext', $outwoext); + + my $code = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'} || ''; + $wrapper->run($code); + } + } + else { + my $errmsg = formatText(_T("Unable to find the method of translation for '{}'."), $transname); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + return 1; +} + + +=pod + +=item B<loadTranslator()> + +Load the all the data needed to run a translator. +This function read the translator definition (transdef) +file; it sets the 'environment_variables' entry; and +it make symbolic link from the translator basename to +the translator itself. + +I<Parameters:> + +=over 8 + +=item * C<name> is the name of the translator to load. + +=item * C<translators> is the associative array that contains all the informations +about all the translators. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut +sub loadTranslator($\%) { + my $name = shift || confess('you must pass the name of the translator to load'); + my $translators = shift || confess('you must pass the descriptions of the translators'); + + printDbgFor(4, formatText(_T("Searching translator '{}'."), $name)); + + # Check if the translator name corresponds to an existing translator. + # If not, try to find a variante. + if (!exists $translators->{$name} || + !$translators->{$name} || + !$translators->{$name}{'file'}) { + my $loadedlinkname = undef; + my $linkname = undef; + while ((!$loadedlinkname) && (my ($k,$v) = each (%{$translators}))) { + if (isHash($v) && $v->{'basename'} && $v->{'basename'} eq $name + && $v->{'file'}) { + if (exists $v->{'transdef'}) { + $loadedlinkname = $k; + } + else { + $linkname = $k; + } + } + } + if (!$linkname && !$loadedlinkname) { + printErr(formatText(_T("The translator '{}' cannot be found."), $name)); + } + elsif ($loadedlinkname) { + $linkname = $loadedlinkname; + } + printDbgFor(4, formatText(_T("Linking '{}' to '{}'."), $name, $linkname)); + $translators->{"$name"} = $translators->{"$linkname"}; + $name = $linkname; + } + + # Load the translator if not already loaded + if (exists $translators->{$name}{'transdef'}) { + printDbgFor(4, formatText(_T("'{}' is already loaded."), $name)); + } + else { + printDbgFor(4, formatText(_T("Loading translator '{}'."), $name)); + # Read the translator definition + $translators->{$name}{'transdef'} = readTranslatorFile( + $translators->{$name}{'file'}, + $translators->{$name}{'ispdfmode'}); + # Add environment variables + while ( my ($k,$v) = each(%{$translators->{$name}{'transdef'}})) { + if ($v && $v->{'value'} && !isHash($v->{'value'}) && !isArray($v->{'value'})) { + $translators->{$name}{'environment_variables'}{"$k"} = $v->{'value'}; + } + } + } + +} + + +=pod + +=item B<loadTranslatorsFromConfiguration(%%)> + +Run the algorithm that permits to load the translator +according to a given configuration. +This function is provided to be invoked by the main +program of AutoLaTex, or any other program that is +needing to load the list of translators according +to a configuration. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is the associative array that contains the configuration. + +=item * C<data> is the associative array that IS FILLED with the data of the loaded translators. + +=back + +I<Returns:> Nothing + +=cut +sub loadTranslatorsFromConfiguration(\%\%) { + my $configuration = shift or confess("First parameter is mandatory: the associative array of the configuration"); + my $data = shift or confess("Second parameter is mandatory: the associative array of loaded data"); + if (!$data->{'translators'}) { + %{$data->{'translators'}} = getTranslatorList(%{$configuration}); + } + if (!$data->{'loadableTranslators'}) { + %{$data->{'loadableTranslators'}} = getLoadableTranslatorList(%{$configuration}); + + foreach my $translator (keys %{$data->{'loadableTranslators'}}) { + # Load the translator + loadTranslator($translator, %{$data->{'translators'}}); + + # Extract image extensions + foreach my $input (@{$data->{'translators'}{$translator}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}) { + $data->{'imageDatabase'}{"$input"}{'translator'} = $translator; + } + } + } + return undef; +} + + +=pod + +=item B<loadTranslatableImageList(%%)> + +Run the algorithm that permits to load the list +of the images that should be processed by the translators. +This function is provided to be invoked by the main +program of AutoLaTex, or any other program that is +needing this list. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is the associative array that contains the configuration. + +=item * C<data> is the associative array that IS FILLED with the data of the pictures. + +=item * C<skipManualAssignment> (optional) is a boolean flag that indicates if the manual +assignments with C<"*.files to convert"> from the configuration must be skipped. + +=back + +I<Returns:> Nothing + +=cut +sub loadTranslatableImageList(\%\%;$) { + my $configuration = shift or confess("First parameter is mandatory: the associative array of the configuration"); + my $data = shift or confess("Second parameter is mandatory: the associative array of loaded data"); + my $skipManualAssignment = shift; + if (!$data->{'imageDatabaseReady'} && exists $configuration->{'generation.image directory'}) { + $data->{'numberOfImages'} = 0; + my $separator = getPathListSeparator(); + # Prepare the configuration entries '*.files to convert' + if (!$skipManualAssignment) { + $configuration->{'__private__'}{'files to convert'} = {}; + while (my ($k,$v) = each(%{$configuration})) { + if ($k =~ /^(.+)\.files\s+to\s+convert$/) { + my $trans = $1; + my @t = split(/\s*\Q$separator\E\s*/, $v); + foreach my $t (@t) { + $t = File::Spec->rel2abs($t, $configuration->{'__private__'}{'input.project directory'}); + $configuration->{'__private__'}{'files to convert'}{$t} = $trans; + } + } + } + } + # Detect the image from the file system + local* DIR; + printDbg(formatText(_T("Detecting images inside '{}'"), $configuration->{'generation.image directory'})); + my $rawdirs = $configuration->{'generation.image directory'}; + $rawdirs =~ s/^\s+//s; + $rawdirs =~ s/\s+$//s; + if ($rawdirs) { + my $separators = getPathListSeparator() || ''; + my @dirs = split( /[$separators]/is, $rawdirs); + my @imageExtensions = keys %{$data->{'imageDatabase'}}; + @imageExtensions = sort { + my $la = length($a); + my $lb = length($b); + if ($la==$lb) { + ($a cmp $b); + } + else { + ($lb - $la); + } + } @imageExtensions; + while (@dirs) { + my $dir = shift @dirs; + $dir = File::Spec->rel2abs($dir, $configuration->{'__private__'}{'input.project directory'}); + if (opendir(*DIR, "$dir")) { + while (my $fn = readdir(*DIR)) { + if (!isIgnorableDirectory($fn)) { + my $ffn = File::Spec->catfile("$dir", "$fn"); + if (-d "$ffn") { + push @dirs, "$ffn"; + } + else { + my $selectedExtension = undef; + if (!$skipManualAssignment && + $configuration->{'__private__'}{'files to convert'}{$ffn}) { + my $trans = $configuration->{'__private__'}{'files to convert'}{$ffn}; + $selectedExtension = "$separator$separator$trans$separator$separator"; + $data->{'imageDatabase'}{"$selectedExtension"}{'translator'} = $trans; + loadTranslator($trans, %{$data->{'translators'}}); + } + if (!$selectedExtension) { + for(my $i=0; !$selectedExtension && $i<@imageExtensions; ++$i) { + if ($fn =~ /\Q$imageExtensions[$i]\E$/i) { + $selectedExtension = $imageExtensions[$i]; + } + } + } + if ($selectedExtension) { + if (!$data->{'imageDatabase'}{"$selectedExtension"}{'files'}) { + $data->{'imageDatabase'}{"$selectedExtension"}{'files'} = []; + } + push @{$data->{'imageDatabase'}{"$selectedExtension"}{'files'}}, "$ffn"; + $data->{'activatedImageExtensions'}{"$selectedExtension"} = 1; + $data->{'numberOfImages'}++; + } + } + } + } + closedir(*DIR); + } + } + } + if ($data->{'activatedImageExtensions'}) { + my @keys = keys %{$data->{'activatedImageExtensions'}}; + $data->{'activatedImageExtensions'} = \@keys; + } + $data->{'imageDatabaseReady'} = 1; + } + return undef; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-14 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Util.pm b/support/autolatex/pm/AutoLaTeX/Core/Util.pm new file mode 100644 index 0000000000..79b037da88 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Util.pm @@ -0,0 +1,1467 @@ +# Copyright (C) 1998-15 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Util.pm - Utilities + +=head1 DESCRIPTION + +Provides a set of general purpose utilities. + +To use this library, type C<use AutoLaTeX::Core::Util;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Util; + +our $INTERNAL_MESSAGE_PREFIX = ''; + +our $VERSION = '38.3'; + +@ISA = ('Exporter'); +@EXPORT = qw( &isHash &isArray &removeFromArray &arrayContains &getAutoLaTeXDir + &getAutoLaTeXName &getAutoLaTeXDocDir &getAutoLaTeXLaunchingName &getAutoLaTeXVersion + &setAutoLaTeXInfo &showManual &printDbg &printErr &formatErr &printWarn &setDebugLevel + &getDebugLevel &printDbgFor &dumpDbgFor &arrayIndexOf &printDbgIndent + &printDbgUnindent &runCommandOrFail &runSystemCommand &runCommandOrFailFromInput + ¬ifySystemCommandListeners &exitDbg &addSlashes + &runCommandRedirectToInternalLogs &countLinesIn + &readFileLines &writeFileLines &runCommandOrFailRedirectTo + &runCommandSilently &removePathPrefix &trim &trim_ws &formatText + &makeMessage &makeMessageLong &secure_unlink &str2language + &killSubProcesses &toANSI &toUTF8 &redirectToSTDOUT &redirectToSTDERR + &isIgnorableDirectory ) ; +@EXPORT_OK = qw( $INTERNAL_MESSAGE_PREFIX ); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); + +use File::Spec; +use File::Path qw(remove_tree); +use POSIX ":sys_wait_h"; +use Carp; +use Data::Dumper; + +use AutoLaTeX::Core::IntUtils; + +my $autolatexUseSTDERR = 1; +my $autoLaTeXName = undef; +my $autoLaTeXDirectory = undef; +my $autoLaTeXLaunchingName = undef; +my $autoLaTeXVersion = "$VERSION or higher"; +my $debugLevel = 0; +my $dbgIndent = 0; +my %runningChildren = (); +my $lastListenerCheck = 0; + +# Array of launched subprocesses +my %launchedSubProcesses = (); + + +sub __print(@) { + if ($autolatexUseSTDERR) { + print STDOUT (@_); + } + else { + print STDERR (@_); + } +} + +=pod + +=item B<redirectToSTDOUT()> + +Redirect the verbosing text on the STDOUT in place of STDERR. + +I<Returns:> None. + +=cut +sub redirectToSTDOUT() { + $autolatexUseSTDERR = 0; +} + +=pod + +=item B<redirectToSTDERR()> + +Redirect the verbosing text on the STDERR in place of STDOUT. + +I<Returns:> None. + +=cut +sub redirectToSTDERR() { + $autolatexUseSTDERR = 1; +} + +=pod + +=item B<toANSI(@)> + +Convert the given elements from UTF-8 to ANSI. + +I<Returns:> the array that contains the convertion result. + +=cut +sub toANSI(@) { + my @result = (); + foreach my $e (@_) { + if (utf8::is_utf8($e)) { + my $ne = "$e"; + utf8::downgrade($ne); + push @result, $ne; + } + else { + push @result, $e; + } + } + if (wantarray) { + return @result; + } + return \@result; +} + +=pod + +=item B<toUTF8(@)> + +Convert the given elements from ANSI to UTF8. + +I<Returns:> the array that contains the convertion result. + +=cut +sub toUTF8(@) { + my @result = (); + foreach my $e (@_) { + if (utf8::is_utf8($e)) { + push @result, $e; + } + else { + my $ne = "$e"; + utf8::upgrade($ne); + push @result, $ne; + } + } + if (wantarray) { + return @result; + } + return \@result; +} + +=pod + +=item B<getAutoLaTeXDir()> + +Replies the location of the main AutoLaTeX script. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX main directory. + +=cut +sub getAutoLaTeXDir() { + return $autoLaTeXDirectory; +} + +=pod + +=item B<getAutoLaTeXDocDir()> + +Replies the location of the documentation of AutoLaTeX. + +I<Returns:> the AutoLaTeX documentation directory. + +=cut +sub getAutoLaTeXDocDir() { + return File::Spec->catfile(getAutoLaTeXDir(), "doc"); +} + +=pod + +=item B<getAutoLaTeXName()> + +Replies the base filename of the main AutoLaTeX script. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX main script filename. + +=cut +sub getAutoLaTeXName() { + return $autoLaTeXName; +} + +=pod + +=item B<getAutoLaTeXLaunchingName()> + +Replies the base filename of the command which permits +to launch AutoLaTeX. It could differ from the AutoLaTeX name +due to several links. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX command name. + +=cut +sub getAutoLaTeXLaunchingName() { + return $autoLaTeXLaunchingName; +} + +=pod + +=item B<getAutoLaTeXVersion()> + +Replies the current version of AutoLaTeX. +This number is extracted from the VERSION filename if +it exists. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX version number. + +=cut +sub getAutoLaTeXVersion() { + return $autoLaTeXVersion; +} + +=pod + +=item B<setAutoLaTeXInfo($$$)> + +Set the information about the main AutoLaTeX script. +This function should only be could by the AutoLaTeX main script. + +I<Parameters:> + +=over 8 + +=item * the name of the command typed on the command line. + +=item * the name of the main script. + +=item * the path where the main script is located. + +=back + +=cut +sub setAutoLaTeXInfo($$$) { + $autoLaTeXLaunchingName = "$_[0]"; + $autoLaTeXName = "$_[1]"; + $autoLaTeXDirectory = File::Spec->rel2abs("$_[2]"); + + # Detect the version number + my $versionFile = File::Spec->catfile($autoLaTeXDirectory,'VERSION'); + if (-f "$versionFile") { + if (-r "$versionFile") { + local *VERSIONFILE; + open(*VERSIONFILE, "< $versionFile") or die("$versionFile: $!\n"); + while (my $line = <VERSIONFILE>) { + if ($line =~ /^\s*autolatex\s+(.*?)\s*$/i) { + $autoLaTeXVersion = "$1"; + last; + } + } + close(*VERSIONFILE); + } + else { + __print(formatText(_T("No read access to the VERSION file of AutoLaTeX. AutoLaTeX should not be properly installed. Assuming version: {}\n"),$autoLaTeXVersion)); + } + } + else { + __print(formatText(_T("Unable to find the VERSION file of AutoLaTeX. AutoLaTeX should not be properly installed. Assuming version: {}\n"), $autoLaTeXVersion)); + } +} + +=pod + +=item B<showManual(@)> + +Display the manual page extracted from the specified POD file. + +I<Parameters:> + +=over 8 + +=item * the components of the path to the POD file to use. + +=back + +I<Returns:> NEVER RETURN. + +=cut +sub showManual(@) { + my $pod; + # Try to localize + my $filename = pop @_; + my $ext = ''; + if ($filename =~ /^(.*)(\.pod)$/i) { + $ext = "$2"; + $filename = "$1"; + } + + my $currentLocale = getCurrentLocale(); + my $currentLang = getCurrentLanguage(); + + { + my ($localePod,$localeLang); + local *DIR; + opendir(*DIR,File::Spec->catfile(@_)) + or die(_T("no manual page found\n").File::Spec->catfile(@_).": $!\n"); + while (my $file = readdir(*DIR)) { + if (!isIgnorableDirectory($file)) { + if ($file =~ /^\Q$filename\E[._\-]\Q$currentLocale$ext\E$/) { + $localePod = $file; + } + if ($file =~ /^\Q$filename\E[._\-]\Q$currentLang$ext\E$/) { + $localeLang = $file; + } + if ($file =~ /^\Q$filename$ext\E$/) { + $pod = $file; + } + } + } + closedir(*DIR); + if ($localePod) { + $pod = $localePod; + } + elsif ($localeLang) { + $pod = $localeLang; + } + } + + # Display the POD + if ($pod) { + my $pod = File::Spec->catfile(@_, $pod); + if ( -r "$pod" ) { + use Pod::Perldoc; + @ARGV = ( "$pod" ); + Pod::Perldoc->run(); + exit(0); + } + } + __print(_T("no manual page found\n")); + exit(255); +} + +=pod + +=item B<isHash($)> + +Replies if the given value is a reference to a hashtable. + +I<Parameters:> + +=over 8 + +=item * a variable of scalar type. + +=back + +I<Returns:> C<true> if the parameter is a reference to a hashtable, otherwhise C<false>. + +=cut +sub isHash($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "HASH" ) ; +} + +=pod + +=item B<isArray($)> + +Replies if the given value is a reference to an array. + +I<Parameters:> + +=over 8 + +=item * a variable of scalar type. + +=back + +I<Returns:> C<true> if the parameter is a reference to an array, otherwhise C<false>. + +=cut +sub isArray($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "ARRAY" ) ; +} + +=pod + +=item B<arrayContains(\@$)> + +Replies if an element exists in an array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array in which the search must be done. + +=item * the element to search for. + +=back + +I<Returns:> C<true> if the element is inside the array, otherwhise C<false> + +=cut +sub arrayContains(\@$) { + foreach my $e (@{$_[0]}) { + if ($_[1] eq $e) { + return 1; + } + } + return 0; +} + +=pod + +=item B<arrayIndexOf(\@$)> + +Replies the index of an element in the array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array in which the search must be done. + +=item * the element to search for. + +=back + +I<Returns:> the index or C<-1> if the element was not found. + +=cut +sub arrayIndexOf(\@$) { + for(my $i=0; $i<@{$_[0]}; $i++) { + if ($_[1] eq $_[0]->[$i]) { + return $i; + } + } + return -1; +} + +=pod + +=item B<removeFromArray(\@$)> + +Remove all the occurences of the specified element +from an array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array. + +=item * the element to remove. + +=back + +I<Returns:> the array in which all the elements was removed. + +=cut +sub removeFromArray(\@@) { + my @tab2 = @_; + my $t = shift @tab2; + my @tab = (); + foreach my $e (@{$t}) { + if (!arrayContains(@tab2,$e)) { + push @tab, "$e"; + } + } + @{$_[0]} = @tab; +} + +=pod + +=item B<makeMessageLong(\%@)> + +Cut the given string at the given column. + +I<The supported keys of the first parameter are:> + +=over 8 + +=item * limit: is the maximal number of characters per lines. + +=item * indent: is the number of white spaces to add at the beginning of each line. + +=item * prefix_nosplit: is the text to put at the beginning of a line, before any spliting. + +=item * prefix_split: is the text to put at the beginning of a line, after spliting. + +=item * postfix_split: is the text to put at the end of a line, when spliting. + +=item * indent_char: is the character to use as the indentation unit. + +=back + +I<Returns:> the given strings, restricted to the given limit for each line. + +=cut +sub makeMessageLong(\%@) { + my $params = shift; + my $limit = $params->{'limit'}; + my $indent = $params->{'indent'}; + my $prefix_nosplit = $params->{'prefix_nosplit'} || ''; + my $prefix_split = $params->{'prefix_split'} || ''; + my $postfix_split = $params->{'postfix_split'} || ''; + my $indent_char = $params->{'indent_char'} || ' '; + $limit -= $indent; + my $indentstr = ''; + while (length($indentstr)<$indent) { + $indentstr .= $indent_char; + } + my @text = (); + my @lines = split(/\n/, join(' ',@_)); + foreach my $line (@lines) { + my @words = split(/\s+/, $line); + my $splitted = undef; + my $currentLine = ''; + for(my $i=0; $i<@words; $i++) { + my $word = $words[$i]; + if (!$currentLine) { + $currentLine = $prefix_nosplit.$indentstr.$word; + } + elsif ((length($currentLine)+length($word)+1)>$limit) { + $currentLine .= $postfix_split; + push @text, $currentLine; + $currentLine = $prefix_split.$indentstr.$word; + } + else { + $currentLine .= ' '.$word; + } + } + if ($currentLine) { + push @text, $currentLine; + } + @words = undef; + } + @lines = undef; + return @text; +} + +=pod + +=item B<makeMessage($$@)> + +Cut the given string at the given column. + +I<Parameters:> + +=over 8 + +=item * limit: is the maximal number of characters per lines. + +=item * indent: is the number of white spaces to add at the beginning of each line. + +=item * rest of the parameters: are the strings to output. + +=back + +I<Returns:> the given strings, restricted to the given limit for each line. + +=cut +sub makeMessage($$@) { + my $limit = shift; + my $indent = shift; + my %params = ( 'limit' => $limit, + 'indent' => $indent, + 'prefix_nosplit' => '', + 'prefix_split' => '...', + 'postfix_split' => '...', + 'indent_char' => ' ', + ); + return makeMessageLong(%params, @_); +} + +=pod + +=item B<setDebugLevel($)> + +Set the debug level. This level is used by L<printDbg> +to know is a debug message could be displayed. + +=cut +sub setDebugLevel($) { + $debugLevel = "$_[0]"; +} + +=pod + +=item B<getDebugLevel()> + +Replies the debug level. This level is used by L<printDbg> +to know is a debug message could be displayed. + +=cut +sub getDebugLevel() { + return "$debugLevel"; +} + +=pod + +=item B<printDbg(@)> + +display a DEBUG message. The parameters will be displayed separated by a space character. + +=cut +sub printDbg(@) { + printDbgFor(1,@_); +} + +=pod + +=item B<printDbgIndent()> + +Indent future DEBUG messages. + +=cut +sub printDbgIndent() { + $dbgIndent += 4; + $dbgIndent = 50 if ($dbgIndent>50); +} + +=pod + +=item B<printDbgUnindent()> + +Unindent future DEBUG messages. + +=cut +sub printDbgUnindent() { + $dbgIndent -= 4; + $dbgIndent = 0 if ($dbgIndent<0); +} + +=pod + +=item B<printDbgFor($@)> + +display a DEBUG message. The parameters will be displayed separated by a space character. + +=cut +sub printDbgFor($@) { + my $requestedLevel = shift; + if ($debugLevel>=$requestedLevel) { + my @text = makeMessage(60,$dbgIndent,@_); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), " $p", "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + } + 1; +} + +=pod + +=item B<dumpDbgFor($@)> + +display the internal value of the specified variables. + +=cut +sub dumpDbgFor($@) { + my $requestedLevel = shift; + if ($debugLevel>=$requestedLevel) { + use Data::Dumper; + my @text = makeMessage(60,$dbgIndent,Dumper(@_)); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), " $p", "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + } + 1; +} + +=pod + +=item B<formatErr(@)> + +format an error message. The parameters will be displayed separated by a space character. + +=cut +sub formatErr(@) { + my $errorMessage = ''; + my @text = makeMessage(55,0,@_); + foreach my $p (@text) { + $errorMessage .= $INTERNAL_MESSAGE_PREFIX._T("[AutoLaTeX]").' '.formatText("Error: {}","$p")."\n"; + $INTERNAL_MESSAGE_PREFIX = ''; + } + return $errorMessage; +} + +=pod + +=item B<printErr(@)> + +display an error message and exit. The parameters will be displayed separated by a space character. + +=cut +sub printErr(@) { + __print(formatErr(@_)); + exit(255); + undef; +} + +=pod + +=item B<printWarn(@)> + +display a warning message. The parameters will be displayed separated by a space character. + +=cut +sub printWarn(@) { + my @text = makeMessage(50,0,@_); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), ' ', formatText(_T("Warning: {}"),"$p"), "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + 1; +} + +=pod + +=item B<runCommandOrFailRedirectTo($@)> + +Run a system command, block and stop the program when the +command has failed. The standartd output of the command +is written (in binary mode when possible) into the file +with the name given as first parameter. + +=over 4 + +=item C<file> is the file in which the stdout must be written. + +=item is the command to run. + +=back + +I<Returns:> Always C<0>. + +=cut +sub runCommandOrFailRedirectTo($@) { + my $stdoutfile = shift; + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "$stdoutfile") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandRedirectToInternalLogs(@)> + +Run a system command, block. The standard and error +outputs of the command are written (in binary mode +when possible) into the internal log files. + +=over 4 + +=item is the command to run. + +=back + +I<Returns:> The exit code of the command. + +=cut +sub runCommandRedirectToInternalLogs(@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + return $exitcode; + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 255; + } +} + +=pod + +=item B<runCommandOrFail(@)> + +Run a system command, block and stop the program when the +command has failed. + +=over 4 + +=item is the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandOrFail(@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $wantstdout = wantarray; + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stdout.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stdout.log", $!)); + while (my $line = <LOGFILE>) { + print STDOUT $INTERNAL_MESSAGE_PREFIX.$line; + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + @_ = map { '\''.addSlashes($_).'\''; } @_; + confess("\$ ", join(' ', @_)); + } + elsif ($wantstdout) { + @stdout = readFileLines("autolatex_exec_stdout.log"); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + if ($wantstdout) { + return @stdout; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandOrFailFromInput(@)> + +Run a system command with the given text as the standard +input, block and stop the program when the +command has failed. + +=over 4 + +=item the text to send to the standard input of the command. + +=item is the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandOrFailFromInput($@) { + my $input = shift || ''; + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + local *INFILE; + open(*INFILE, '> autolatex_exec_stdin.data') or printErr(formatText(_T("Can't write {}: {}"), 'autolatex_exec_stdin.data', $!)); + print INFILE $input; + close(*INFILE); + my $wantstdout = wantarray; + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDIN, '<', "autolatex_exec_stdin.data") or printErr(formatText(_T("Can't redirect STDIN: {}"), $!)); + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stdout.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stdout.log", $!)); + while (my $line = <LOGFILE>) { + print STDOUT $INTERNAL_MESSAGE_PREFIX.$line; + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + @_ = map { '\''.addSlashes($_).'\''; } @_; + confess("\$ ", join(' ', @_)); + } + elsif ($wantstdout) { + @stdout = readFileLines("autolatex_exec_stdout.log"); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + unlink("autolatex_exec_stdin.data"); + if ($wantstdout) { + return @stdout; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandSilently(@)> + +Run a system command, block and return the exit code. +The standard outputs are catched and trashed. + + + +Parameters are + +=over 4 + +=item [options] (optional hash ref), if the first parameter is an hash table, it is assumed to be +additional options to pass to this function. + +=over 4 + +=item C<wait> is a boolean flag that is indicating if the caller must wait for the termination of the sub-process. + +=back + +=item rest of the parameters are constituting the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandSilently(@) { + my $opts = {}; + if ($_[0] && isHash($_[0])) { + $opts = shift; + } + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + if ($pid == 0) { + # Child process + if ($opts->{'stdin'}) { + open(STDIN, '<', $opts->{'stdin'}) or printErr(formatText(_T("Can't redirect STDIN: {}"), $!)); + select STDIN; $| = 1; # make unbuffered + } + open(STDOUT, '>', File::Spec->devnull()) or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', File::Spec->devnull()) or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + if (!defined($opts->{'wait'}) || $opts->{'wait'}) { + waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + return $?; + } + else { + # Do not wait for the child. + return 0; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 1; + } +} + +=pod + +=item B<runSystemCommand($@)> + +Run a system command and notify a listener about the terminaison. +This subroutine does not block the caller. + +=over 4 + +=item is the listener which will be notified with a call to C<$self-E<gt>onSystemCommandTerminaison(\@$)> + +=back + +=cut +sub runSystemCommand($@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $listener = shift; + my $pid = fork(); + if ($pid == 0) { + # Child process + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + $runningChildren{"$pid"} = { 'listener' => $listener, + 'command' => \@_, + }; + return 0; + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 1; + } +} + +=pod + +=item B<notifySystemCommandListeners()> + +Notifies the listeners on system commands. + +=cut +sub notifySystemCommandListeners() { + if (%runningChildren) { + my $currenttime = time; + if ($currenttime>=$lastListenerCheck+1) { + $lastListenerCheck = $currenttime; + while (my ($pid,$data) = each(%runningChildren)) { + my $kid = waitpid($pid, WNOHANG); + if ($kid>0) { + delete $runningChildren{"$pid"}; + if (($data->{'listener'})&&($data->{'listener'}->can('onSystemCommandTerminaison'))) { + $data->{'listener'}->onSystemCommandTerminaison($data->{'commmand'},$kid); + } + } + } + } + } +} + +=pod + +=item B<waitForSystemCommandTerminaison()> + +Wait for the termination of asynchronous commands. + +=cut +sub waitForSystemCommandTerminaison() { + if (%runningChildren) { + printDbg(_T("Waiting for system command sub-processes")); + printDbgIndent(); + while (my ($pid,$data) = each(%runningChildren)) { + if ($runningChildren{"$pid"}{'command'}) { + printDbg(@{$runningChildren{"$pid"}{'command'}}); + } + my $kid = waitpid($pid, 0); + delete $runningChildren{"$pid"}; + delete $launchedSubProcesses{$pid}; + } + printDbgUnindent(); + } + 1; +} + +=pod + +=item B<exitDbg(@)> + +Print the content of the parameters and exit. + +=cut +sub exitDbg(@) { + confess(Dumper(@_)); +} + + +=pod + +=item B<addSlashes($)> + +Protect the special characters \\, ' and " with backslashes. + +=cut +sub addSlashes($) { + my $text = shift; + my $term = "$text"; + $term =~ s/([\\\'\"])/\\$1/gi; + return $term; +} + +=pod + +=item B<str2language($)> + +Protect the characters with backslashes in the string to obtain a string that may be put in a source code. + +=cut +sub str2language($) { + my $text = shift; + my $term = "$text"; + $term =~ s/([\\\'\"\0-\31])/\\$1/gi; + return $term; +} + +=pod + +=item B<readFileLines($)> + +Read a file and replies the array of the lines (if called in array context), +or all the lines inside a single string (if called in scalar context). + +=cut +sub readFileLines($) { + local *FILE; + if (wantarray) { + my @lines = (); + open(*FILE, "<".$_[0]) or printErr("$_[0]: $!"); + while (my $line = <FILE>) { + push @lines, $line; + } + close(*FILE); + return @lines; + } + else { + my $lines = ''; + open(*FILE, "<".$_[0]) or printErr("$_[0]: $!"); + while (my $line = <FILE>) { + $lines .= $line; + } + close(*FILE); + return $lines; + } +} + +=pod + +=item B<writeFileLines($@)> + +Write the lines in the array inside the specified file. + +=over 4 + +=item I<file> is the name of the file to write. + +=item the rest of the parameters are the lines to write. + +=back + +=cut +sub writeFileLines($@) { + my $file = shift; + local *FILE; + open(*FILE, ">$file") or printErr("$file: $!"); + foreach my $l (@_) { + confess('undefined value') unless (defined($l)); + print FILE $l; + } + close(*FILE); +} + +=pod + +=item B<removePathPrefix($$)> + +Remove the given prefix from a path. + +=over 4 + +=item I<prefix> is the path to remove. + +=item I<path> is the path from which the prefix should be removed. + +=back + +=cut +sub removePathPrefix($$) { + my $prefix = shift; + my $path = shift; + my @dir1 = File::Spec->splitdir($prefix); + my @dir2 = File::Spec->splitdir($path); + while (@dir1 && @dir2 && $dir1[0] eq $dir2[0]) { + shift @dir1; + shift @dir2; + } + return File::Spec->catdir(@dir2); +} + +=pod + +=item B<trim($)> + +Remove the trailing spaces (including white spaces, tabulations, carriage-returns, new-lines...). + +=over 4 + +=item I<str> the string to parse. + +=back + +=cut +sub trim($) { + my $str = $_[0] || ''; + my $s = "$str"; + $s =~ s/^\s+//s; + $s =~ s/\s+$//s; + return $s; +} + +=pod + +=item B<trim_ws($)> + +Remove the trailing white spaces (and only the white spaces). + +=over 4 + +=item I<str> the string to parse. + +=back + +=cut +sub trim_ws($) { + my $str = $_[0] || ''; + my $s = "$str"; + $s =~ s/^ //s; + $s =~ s/ $//s; + return $s; +} + +=pod + +=item B<formatText($@)> + +Replies the string after substitutions. + +The substrings C<$0>, C<$1>, C<$2>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<${0}>, C<${1}>, C<${2}>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<#0>, C<#1>, C<#2>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<#{0}>, C<#{1}>, C<#{2}>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<{}> will be replaced by the value passed in parameters +that corresponds to the C<{}>, e.g. the first C<{}> will be replaced by the +first value, the second C<{}> by the second value... + +=over 4 + +=item the id of the string + +=item the list of substitution values. + +=back + +I<Returns:> the localized string. + +=cut +sub formatText($@) { + my $msg = shift; + if (@_) { + for(my $i=0; $i<@_; $i++) { + $msg =~ s/[\$\#]\Q{$i}\E/$_[$i]/g; + $msg =~ s/[\$\#]\Q$i\E/$_[$i]/g; + } + my $i=0; + $msg =~ s/\Q{}\E/my $v;if ($i<@_) {$v=$_[$i]||'';$i++;} else {$v="{}";}"$v";/eg; + } + return $msg; +} + +=pod + +=item B<secure_unlink(@)> + +Remove the specifiec files or the directories. +This function invokes remove_tree or unlink according +to the type of the file to remove. + +=cut +sub secure_unlink(@) { + foreach my $file (@_) { + if (-d "$file") { + remove_tree("$file"); + } + else { + unlink("$file"); + } + } +} + +=pod + +=item B<countLinesIn($)> + +Count the lines in the given text. + +=cut +sub countLinesIn($) { + my $c = 1; + if ($_[0]) { + while ($_[0] =~ /[\n\r]/sg) { + $c++; + } + } + return $c; +} + + +=pod + +=item B<killSubProcesses()> + +Kill all the subprocesses launched by one of the running functions above. + +=cut +sub killSubProcesses() { + my @pids = keys %launchedSubProcesses; + %launchedSubProcesses = (); + kill 9, @pids; +} + +=pod + +=item B<isIgnorableDirectory($)> + +Replies if the given directory name is for directories to ignore. + +=cut +sub isIgnorableDirectory($) { + my $file = shift || return 1; + return $file eq File::Spec->curdir() || $file eq File::Spec->updir() + || $file eq ".git" || $file eq ".svn" || $file eq ".cvs"; +} + + + +END { + waitForSystemCommandTerminaison(); +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-15 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/AbstractGUI.pm b/support/autolatex/pm/AutoLaTeX/GUI/AbstractGUI.pm new file mode 100644 index 0000000000..3df5bc0a08 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/AbstractGUI.pm @@ -0,0 +1,175 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::AbstractGUI - An abstract user interface + +=head1 DESCRIPTION + +AutoLaTeX::GUI::AbstractGUI is a Perl module, which permits to +display an user interface for AutoLaTeX. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in AbstractGUI.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::AbstractGUI; + +@ISA = ('Exporter'); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use AutoLaTeX::Core::IntUtils; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "6.0" ; + +=pod + +=item * setCommandLine($@) + +Specify the command line parameters. + +Parameters are: + +=over 4 + +=item the name of the command + +=item the list of command line parameters + +=back + +=cut +sub setCommandLine($@) : method { + my $self = shift; + my $command = shift || printErr(_T("Command name not specified")); + $self->{'ARGV'} = [ @_ ]; + unshift @{$self->{'ARGV'}}, "$command"; + $self->{'ARGV'}; +} + +=pod + +=item * getArgv($) + +Replies the i-th command line parameter. + +=cut +sub getArgv($) : method { + my $self = shift; + my $ith = shift; + return undef + unless( + ($ith>=0)&& + (exists $self->{'ARGV'})&& + (isArray($self->{'ARGV'}))&& + ($ith<@{$self->{'ARGV'}})); + return $self->{'ARGV'}["$ith"]; +} + +=pod + +=item * showDialog() + +Show the dialog. + +=cut +sub showDialog() : method { + my $self = shift; + $self->initializeDialogContent(); + $self->doLoop(); + $self->destroyDialogContent(); +} + +=pod + +=item * initializeDialogContent() + +Initializing the dialog content before displaying. + +This method read the list of the translators and +fill the attribute C<{'DATA'}{'translators'}>. + +=cut +sub initializeDialogContent() : method { + my $self = shift; +} + +=pod + +=item * doLoop() + +Do the GUI interaction loop. It means that the dialog +must be displayed now and ready for interaction. + +=cut +sub doLoop() : method { + die("You must override AbstractGUI::doLoop()\n"); +} + +=pod + +=item * destroyDialogContent() + +Destroying the dialog content after the application was quitted. + +=cut +sub destroyDialogContent() : method { +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/AbstractGeneralPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/AbstractGeneralPanel.pm new file mode 100644 index 0000000000..f601a154b7 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/AbstractGeneralPanel.pm @@ -0,0 +1,142 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::AbstractGeneralPanel - An abstract user interface + +=head1 DESCRIPTION + +AutoLaTeX::GUI::AbstractGeneralPanel is a Perl module, which permits to +display a panel that manages AutoLaTeX general options. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in AbstractGeneralPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::AbstractGeneralPanel; + +@ISA = qw( AutoLaTeX::GUI::WidgetUtil ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Config; +use AutoLaTeX::GUI::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "6.0" ; + + +=pod + +=item * initializeTranslatorPanel() + +Initializing the panel content before displaying. + +=cut +sub initializeGeneralPanel() : method { + my $self = shift; +} + +=pod + +=item * savePanelContent() + +Save the content of this panel. + +=cut +sub savePanelContent() { + my $self = shift; + + my $configFilename; + eval("\$configFilename = ".$self->attr('configuration-filename')."();"); + printDbg(formatText(_T("Saving configuration information into {}"), $configFilename)); + printDbgIndent(); + + my %configuration = (); + readConfigFile($configFilename,%configuration,1); + + my %updatedConfiguration = %{$self->attr('configuration')}; + my $changed = 0; + while (my ($k,$v) = each(%updatedConfiguration)) { + my $oldv = (exists $configuration{$k}) ? $configuration{$k} : undef; + if ((($v)&&(!$oldv))|| + ((!$v)&&($oldv))|| + (($v)&&($oldv)&& + ("$v" ne "$oldv"))) { + if (!$v) { + delete $configuration{$k}; + } + else { + $configuration{$k} = $v; + } + $changed = 1; + } + } + + if ($changed) { + writeConfigFile($configFilename,%configuration); + } + else { + printDbg(_T("No change detected")); + } + printDbgUnindent(); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/AbstractToolPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/AbstractToolPanel.pm new file mode 100644 index 0000000000..61d8eae961 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/AbstractToolPanel.pm @@ -0,0 +1,135 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::AbstractToolPanel - An abstract user interface + +=head1 DESCRIPTION + +AutoLaTeX::GUI::AbstractToolPanel is a Perl module, which permits to +display a panel that launchs AutoLaTeX tools. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in AbstractToolPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::AbstractToolPanel; + +@ISA = qw( AutoLaTeX::GUI::WidgetUtil ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Config; +use AutoLaTeX::GUI::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "8.0" ; + + +=pod + +=item * initializeToolPanel() + +Initializing the panel content before displaying. + +=cut +sub initializeToolPanel() : method { + my $self = shift; +} + +=pod + +=item * savePanelContent() + +Save the content of this panel. +DO NOT OVERRIDE THIS FUNCTION. See +saveGUIConfiguration() instead. + +=cut +sub savePanelContent() { + my $self = shift; + + printDbg(_T("Saving tool configuration")); + printDbgIndent (); + + my %configuration = readOnlyUserConfiguration(); + $self->saveGUIConfiguration(\%configuration); + writeConfigFile(getUserConfigFilename(), %configuration); + + printDbgUnindent (); +} + +=pod + +=item * saveGUIConfiguration(\%) + +Save the GUI configuration inside the specified configuration. + +=over 4 + +=item is the configuration to fill + +=back + +=cut +sub saveGUIConfiguration() { + my $self = shift; +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/AbstractTranslatorPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/AbstractTranslatorPanel.pm new file mode 100644 index 0000000000..ba4fa88713 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/AbstractTranslatorPanel.pm @@ -0,0 +1,202 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::AbstractTranslatorPanel - An abstract user interface + +=head1 DESCRIPTION + +AutoLaTeX::GUI::AbstractTranslatorPanel is a Perl module, which permits to +display a panel that manages AutoLaTeX translators. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in AbstractTranslatorPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::AbstractTranslatorPanel; + +@ISA = qw( AutoLaTeX::GUI::WidgetUtil ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use AutoLaTeX::GUI::WidgetUtil; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Translator; +use AutoLaTeX::Core::Config; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "7.0" ; + +=pod + +=item * initializeTranslatorPanel() + +Initializing the panel content before displaying. + +This method read the list of the translators and +fill the attribute C<{'DATA'}{'translators'}>. + +=cut +sub initializeTranslatorPanel() : method { + my $self = shift; + + my %translators = $self->readTranslatorList(); + $self->attr('TRANSLATORS') = \%translators; +} + +=pod + +=item * readTranslatorList() + +Replies the hastable that describes the translators + +=cut +sub readTranslatorList() : method { + my $self = shift; + + my $systemConfig = $self->attr('CONFIGURATIONS','SYSTEM') || {}; + my $userConfig = $self->attr('CONFIGURATIONS','USER') || {}; + my $projectConfig = $self->attr('CONFIGURATIONS','PROJECT') || {}; + my $config = $self->attr('CONFIGURATIONS','FULL') || {}; + + my %translators = getTranslatorList(%{$config}); + + setInclusionFlags(%translators, + %{$systemConfig}, + %{$userConfig}, + %{$projectConfig}); + + return %translators; +} + + +=pod + +=item * applyInclusionsInConfiguration(\%$) + +Put the translator inclusion flags into the specified configuration. +Replies if a changed was applied in the configuration + +=over 4 + +=item the configuration data structure + +=item the configuration level + +=back + +=cut +sub applyInclusionsInConfiguration(\%$) { + my $self = shift; + my $hasChanged = 0; + my $allTrans = $self->attr('TRANSLATORS'); + while (my ($transName,$data) = each(%{$allTrans})) { + if (defined($data->{'included'}{$_[1]})) { + my $val = cfgToBoolean($data->{'included'}{$_[1]}); + $hasChanged = ($hasChanged)||(!$_[0]->{"$transName.include module"})||($_[0]->{"$transName.include module"} ne $val); + $_[0]->{"$transName.include module"} = $val; + } + } + printDbg(_T("No change detected")) unless ($hasChanged); + return $hasChanged; +} + +=pod + +=item * savePanelContent() + +Save the content of this panel. + +=cut +sub savePanelContent() : method { + my $self = shift; + my %configuration; + + # System level + if ($self->isAdminUser()) { + printDbg(_T("Saving system configuration about translators")); + printDbgIndent(); + %configuration = readOnlySystemConfiguration(1); + if ($self->applyInclusionsInConfiguration(\%configuration,'system')) { + writeConfigFile(getSystemConfigFilename(), %configuration); + } + printDbgUnindent(); + } + + # User level + printDbg(_T("Saving user configuration about translators")); + printDbgIndent(); + %configuration = readOnlyUserConfiguration(1); + if ($self->applyInclusionsInConfiguration(\%configuration,'user')) { + writeConfigFile(getUserConfigFilename(), %configuration); + } + printDbgUnindent(); + + # Project level + if ($self->hasProject()) { + printDbg(_T("Saving project configuration about translators")); + printDbgIndent(); + %configuration = %{readOnlyProjectConfiguration($self->attr('CONFIGURATIONS','PROJECT','__private__','input.project directory'))}; + if ($self->applyInclusionsInConfiguration(\%configuration,'project')) { + writeConfigFile(getProjectConfigFilename(), %configuration); + } + printDbgUnindent(); + } +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/Gtk/GeneralPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/GeneralPanel.pm new file mode 100644 index 0000000000..3a706c1c2a --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/GeneralPanel.pm @@ -0,0 +1,544 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::Gtk::GeneralPanel - A GTK panel for general management + +=head1 DESCRIPTION + +AutoLaTeX::GUI::Gtk::GeneralPanel is a Perl module, which permits to +display a Gtk panel that manages AutoLaTeX options. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in GtkGeneralPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::Gtk::GeneralPanel; + +@ISA = qw( Gtk2::Table AutoLaTeX::GUI::Gtk::WidgetUtil AutoLaTeX::GUI::AbstractGeneralPanel ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Glib qw(TRUE FALSE); +use Gtk2; +use Gtk2::SimpleList; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::GUI::AbstractGeneralPanel; +use AutoLaTeX::GUI::Gtk::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "9.0" ; + +my %GENERATION_TYPES = (); + +my %MAKEINDEX_STYLE_TYPES = (); + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * new(\%$) + +Contructor. + +Parameters are: + +=over 4 + +=item the configuration extracted from the configuration files. + +=item is the name of the subroutine that permits to get the configuration filename + +=back + +=cut +sub new(\%$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = bless( $class->SUPER::new( + 4, #rows + 1, #columns + FALSE), #non uniform + $class ) ; + + die("The first parameter of AutoLaTeX::GUI::Gtk::GeneralPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[0]))||(isHash($_[0]))); + $self->attr('configuration') = {}; + %{$self->attr('configuration')} = %{$_[0]}; + + $self->attr('configuration-filename') = $_[1]; + + # Initialization + $self->initializeGeneralPanel(); + + return $self; +} + +=pod + +=item * initControls() + +Initializing the controls. + +=cut +sub initControls() : method { + my $self = shift; + + # GENERATION part + { + my $generationFrame = Gtk2::Frame->new(_T("Generation")); + $self->attach ($generationFrame, + 0,1,0,1, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 5,2); # horizontal and vertical paddings + my $subtable = Gtk2::Table->new ( + 5, #rows + 2, #columns + FALSE); #non uniform + $generationFrame->add ($subtable); + + my $label1 = Gtk2::Label->new (_T("Main TeX file (optional):")); + $subtable->attach ($label1, + 0,1,0,1, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit1 = Gtk2::Entry->new (); + $self->connectSignal($edit1,'changed','onMainTeXFileChanged'); + $subtable->attach ($edit1, + 1,2,0,1, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','MAIN_TEX_FILE') = $edit1; + + my $label2b = Gtk2::CheckButton->new (_T("Run bibliography tool")); + $self->connectSignal($label2b,'toggled','onRunBiblioToggled'); + $subtable->attach ($label2b, + 0,2,1,2, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','ENABLE_BIBLIO') = $label2b; + + my $label2 = Gtk2::CheckButton->new (_T("Automatic generation of pictures")); + $self->connectSignal($label2,'toggled','onGenerateImageToggled'); + $subtable->attach ($label2, + 0,2,2,3, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','AUTO_PICTURE_GENERATION') = $label2; + + + my $label3 = Gtk2::Label->new (_T("Image search directory:")); + $subtable->attach ($label3, + 0,1,3,4, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit2 = Gtk2::Entry->new (); + $self->connectSignal($edit2,'changed','onImageSearchDirectoryChanged'); + $subtable->attach ($edit2, + 1,2,3,4, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','AUTO_GENERATE_IMAGE_DIRECTORY') = $edit2; + + my $label4 = Gtk2::Label->new (_T("Type of generation:")); + $subtable->attach ($label4, + 0,1,4,5, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit3 = Gtk2::ComboBox->new_text (); + $self->fillComboBox('generationType',$edit3,\%GENERATION_TYPES); + $self->connectSignal($edit3,'changed','onGenerationTypeChanged'); + $subtable->attach ($edit3, + 1,2,4,5, # left, right, top and bottom columns + ['expand','fill'],'shrink', # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','GENERATION_TYPE') = $edit3; + + my $label5 = Gtk2::Label->new (_T("Type of MakeIndex style research:")); + $subtable->attach ($label5, + 0,1,5,6, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit4 = Gtk2::ComboBox->new_text (); + $self->fillComboBox('makeindexStyleType',$edit4,\%MAKEINDEX_STYLE_TYPES); + $self->connectSignal($edit4,'changed','onMakeIndexStyleChanged'); + $subtable->attach ($edit4, + 1,2,5,6, # left, right, top and bottom columns + ['expand','fill'],'shrink', # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','MAKEINDEX_STYLE') = $edit4; + } + + # VIEWER part + { + my $viewerFrame = Gtk2::Frame->new(_T("Viewer")); + $self->attach ($viewerFrame, + 0,1,1,2, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 5,2); # horizontal and vertical paddings + my $subtable = Gtk2::Table->new ( + 2, #rows + 2, #columns + FALSE); #non uniform + $viewerFrame->add ($subtable); + + my $label1 = Gtk2::CheckButton->new (_T("Launch a viewer after compilation")); + $self->connectSignal($label1,'toggled','onLaunchViewerToggled'); + $subtable->attach ($label1, + 0,2,0,1, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','LAUNCH_VIEWER') = $label1; + + my $label2 = Gtk2::Label->new (_T("Command of the viewer (optional):")); + $subtable->attach ($label2, + 0,1,1,2, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('LABELS','VIEWER_PATH') = $label2; + + my $edit1 = Gtk2::Entry->new (); + $self->connectSignal($edit1,'changed','onPDFViewerChanged'); + $subtable->attach ($edit1, + 1,2,1,2, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','VIEWER_PATH') = $edit1; + } + + # CLEAN part + { + my $cleaningFrame = Gtk2::Frame->new(_T("Cleaning")); + $self->attach ($cleaningFrame, + 0,1,2,3, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 5,2); # horizontal and vertical paddings + my $subtable = Gtk2::Table->new ( + 2, #rows + 2, #columns + FALSE); #non uniform + $cleaningFrame->add ($subtable); + + my $label1 = Gtk2::Label->new (_T("Files to clean:")); + $subtable->attach ($label1, + 0,1,0,1, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit1 = Gtk2::Entry->new (); + $self->connectSignal($edit1,'changed','onFilesToCleanChanged'); + $subtable->attach ($edit1, + 1,2,0,1, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','FILES_TO_CLEAN') = $edit1; + + my $label2 = Gtk2::Label->new (_T("Files to desintegrate:")); + $subtable->attach ($label2, + 0,1,1,2, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit2 = Gtk2::Entry->new (); + $self->connectSignal($edit2,'changed','onFilesToDesintegrateChanged'); + $subtable->attach ($edit2, + 1,2,1,2, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','FILES_TO_DESINTEGRATE') = $edit2; + } + + # SCM part + { + my $scmFrame = Gtk2::Frame->new(_T("SCM support")); + $self->attach ($scmFrame, + 0,1,3,4, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 5,2); # horizontal and vertical paddings + my $subtable = Gtk2::Table->new ( + 2, #rows + 2, #columns + FALSE); #non uniform + $scmFrame->add ($subtable); + + my $label1 = Gtk2::Label->new (_T("Update command line:")); + $subtable->attach ($label1, + 0,1,0,1, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit1 = Gtk2::Entry->new (); + $self->connectSignal($edit1,'changed','onSCMUpdateChanged'); + $subtable->attach ($edit1, + 1,2,0,1, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','SCM_UPDATE') = $edit1; + + my $label2 = Gtk2::Label->new (_T("Commit command line:")); + $subtable->attach ($label2, + 0,1,1,2, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 2,2); # horizontal and vertical paddings + + my $edit2 = Gtk2::Entry->new (); + $self->connectSignal($edit2,'changed','onSCMCommitChanged'); + $subtable->attach ($edit2, + 1,2,1,2, # left, right, top and bottom columns + ['expand','fill'],['expand','fill'], # x and y options + 2,2); # horizontal and vertical paddings + $self->attr('EDITORS','SCM_COMMIT') = $edit2; + } +} + +=pod + +=item * initializeGeneralPanel() + +Initializing the panel content before displaying. + +=cut +sub initializeGeneralPanel() : method { + my $self = shift; + $self->SUPER::initializeGeneralPanel(); + + unless (%GENERATION_TYPES) { + $GENERATION_TYPES{'01_'._T('Generate PDF document')} = 'pdf'; + $GENERATION_TYPES{'02_'._T('Generate DVI document')} = 'dvi'; + $GENERATION_TYPES{'03_'._T('Generate Postscript document')} = 'ps'; + $GENERATION_TYPES{'04_'._T('Generate PDF document via Postscript')} = 'pspdf'; + } + + unless (%MAKEINDEX_STYLE_TYPES) { + $MAKEINDEX_STYLE_TYPES{'01_'._T('Use current configuration file value')} = ''; + $MAKEINDEX_STYLE_TYPES{'02_'._T('Auto-detect the style inside the project directory')} = '@detect'; + $MAKEINDEX_STYLE_TYPES{'03_'._T('Use only the default AutoLaTeX style')} = '@system'; + $MAKEINDEX_STYLE_TYPES{'04_'._T('No style is passed to MakeIndex')} = '@none'; + } + + $self->initControls(); + + # Fill fields + $self->attr('EDITORS','MAIN_TEX_FILE')->set_text ($self->attr('configuration','generation.main file')) + if ($self->hasattr('configuration','generation.main file')); + if ($self->hasattr('configuration','generation.generate images')) { + $self->attr('EDITORS','AUTO_PICTURE_GENERATION')->set_active ($self->cfgGtkBoolean($self->attr('configuration','generation.generate images'))); + } + else { + $self->attr('EDITORS','AUTO_PICTURE_GENERATION')->set_active (TRUE); + } + if ($self->hasattr('configuration','generation.biblio')) { + $self->attr('EDITORS','ENABLE_BIBLIO')->set_active ($self->cfgGtkBoolean($self->attr('configuration','generation.biblio'))); + } + else { + $self->attr('EDITORS','ENABLE_BIBLIO')->set_active (TRUE); + } + if ($self->hasattr('configuration','generation.image directory')) { + $self->attr('EDITORS','AUTO_GENERATE_IMAGE_DIRECTORY')->set_text ($self->attr('configuration','generation.image directory')); + } + else { + $self->attr('EDITORS','AUTO_GENERATE_IMAGE_DIRECTORY')->set_text ('.'); + } + if ($self->hasattr('configuration','generation.generation type')) { + my $val = $self->attr('configuration','generation.generation type') || ''; + if ($val eq 'pspdf') { + $self->attr('EDITORS','GENERATION_TYPE')->set_active (3); + } + elsif ($val eq 'ps') { + $self->attr('EDITORS','GENERATION_TYPE')->set_active (2); + } + elsif ($val eq 'dvi') { + $self->attr('EDITORS','GENERATION_TYPE')->set_active (1); + } + else { + $self->attr('EDITORS','GENERATION_TYPE')->set_active (0); + } + } + else { + $self->attr('EDITORS','GENERATION_TYPE')->set_active (0); + } + if ($self->hasattr('configuration','generation.makeindex style')) { + my $val = $self->attr('configuration','generation.makeindex style') || ''; + if (isArray($val)) { + if (@{$val} == 1) { + $val = $val->[0]; + } + else { + $val = ''; + } + } + if ($val eq '@none') { + $self->attr('EDITORS','MAKEINDEX_STYLE')->set_active (3); + } + elsif ($val eq '@system') { + $self->attr('EDITORS','MAKEINDEX_STYLE')->set_active (2); + } + elsif ($val eq '@detect') { + $self->attr('EDITORS','MAKEINDEX_STYLE')->set_active (1); + } + else { + $self->attr('EDITORS','MAKEINDEX_STYLE')->set_active (0); + } + } + else { + $self->attr('EDITORS','MAKEINDEX_STYLE')->set_active (0); + } + if ($self->hasattr('configuration','viewer.view')) { + $self->attr('EDITORS','LAUNCH_VIEWER')->set_active ($self->cfgGtkBoolean($self->attr('configuration','viewer.view'))); + } + else { + $self->attr('EDITORS','LAUNCH_VIEWER')->set_active (TRUE); + } + $self->attr('EDITORS','VIEWER_PATH')->set_text ($self->attr('configuration','viewer.viewer')) + if ($self->hasattr('configuration','viewer.viewer')); + $self->attr('EDITORS','FILES_TO_CLEAN')->set_text ($self->attr('configuration','clean.files to clean')) + if ($self->hasattr('configuration','clean.files to clean')); + $self->attr('EDITORS','FILES_TO_DESINTEGRATE')->set_text ($self->attr('configuration','clean.files to desintegrate')) + if ($self->hasattr('configuration','clean.files to desintegrate')); + $self->attr('EDITORS','SCM_UPDATE')->set_text ($self->attr('configuration','scm.scm update')) + if ($self->hasattr('configuration','scm.scm update')); + $self->attr('EDITORS','SCM_COMMIT')->set_text ($self->attr('configuration','scm.scm commit')) + if ($self->hasattr('configuration','scm.scm commit')); +} + +# +#------------------------------------- SIGNALS +# + +sub onLaunchViewerToggled(@) { + my $self = shift; + + $self->attr('configuration','viewer.view') = $self->cfgToGtkBoolean($_[0]->get_active ()); + + $self->attr('LABELS','VIEWER_PATH')->set_sensitive ($_[0]->get_active ()); + $self->attr('EDITORS','VIEWER_PATH')->set_sensitive ($_[0]->get_active ()); +} + +sub onGenerateImageToggled(@) { + my $self = shift; + $self->attr('configuration','generation.generate images') = $self->cfgToGtkBoolean($_[0]->get_active ()); +} + +sub onRunBiblioToggled(@) { + my $self = shift; + $self->attr('configuration','generation.biblio') = $self->cfgToGtkBoolean($_[0]->get_active ()); +} + +sub onMainTeXFileChanged(@) { + my $self = shift; + $self->attr('configuration','generation.main file') = $_[0]->get_text (); +} + +sub onImageSearchDirectoryChanged(@) { + my $self = shift; + $self->attr('configuration','generation.image directory') = $_[0]->get_text (); +} + +sub onPDFViewerChanged(@) { + my $self = shift; + $self->attr('configuration','viewer.viewer') = $_[0]->get_text (); +} + +sub onFilesToCleanChanged(@) { + my $self = shift; + $self->attr('configuration','clean.files to clean') = $_[0]->get_text (); +} + +sub onFilesToDesintegrateChanged(@) { + my $self = shift; + $self->attr('configuration','clean.files to desintegrate') = $_[0]->get_text (); +} + +sub onSCMUpdateChanged(@) { + my $self = shift; + $self->attr('configuration','scm.scm update') = $_[0]->get_text (); +} + +sub onSCMCommitChanged(@) { + my $self = shift; + $self->attr('configuration','scm.scm commit') = $_[0]->get_text (); +} + +sub onGenerationTypeChanged(@) { + my $self = shift; + my $value = $self->getComboBoxValue($_[0]); + $self->attr('configuration','generation.generation type') = $value || 'pdf'; +} + +sub onMakeIndexStyleChanged(@) { + my $self = shift; + my $value = $self->getComboBoxValue($_[0]); + if ($value) { + $self->attr('configuration','generation.makeindex style') = $value; + } + else { + $self->deleteattr('configuration','generation.makeindex style'); + } +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/Gtk/ToolPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/ToolPanel.pm new file mode 100644 index 0000000000..72221ec55c --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/ToolPanel.pm @@ -0,0 +1,393 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::Gtk::ToolPanel - A GTK panel for tools + +=head1 DESCRIPTION + +AutoLaTeX::GUI::Gtk::ToolPanel is a Perl module, which permits to +display a Gtk panel that launchs AutoLaTeX tools. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in ToolPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::Gtk::ToolPanel; + +@ISA = qw( Gtk2::Table AutoLaTeX::GUI::Gtk::WidgetUtil AutoLaTeX::GUI::AbstractToolPanel ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Glib qw(TRUE FALSE); +use Gtk2; + +use File::Basename; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::Main; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::GUI::AbstractToolPanel; +use AutoLaTeX::GUI::Gtk::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "7.0" ; + +# Available commands +my @LAUNCH_COMMAND_ORDER = ( 'gnome', 'kde', 'stdout' ); +my %LAUNCH_COMMANDS = ( + 'gnome' => [ 'gnome-terminal', '-x', 'autolatex' ], + 'kde' => [ 'konsole', '-e', 'autolatex' ], + 'stdout' => [ 'autolatex' ], + ); +my %LAUNCH_COMMAND_LIST = (); + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * new(\%) + +Contructor. + +=over 4 + +=item general configuration + +=back + +=cut +sub new(\%) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = bless( $class->SUPER::new( + 3, #rows + 2, #columns + FALSE), #non uniform + $class ) ; + + die("The first parameter of AutoLaTeX::GUI::Gtk::GeneralPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[0]))||(isHash($_[0]))); + $self->attr('CONFIGURATION') = $_[0]; + + # Initialization + $self->initializeToolPanel(); + + return $self; +} + +=pod + +=item * initControls() + +Initializing the controls. + +=cut +sub initControls() : method { + my $self = shift; + + # Build components + my $filenameLabel = Gtk2::Label->new (_T("Main TeX file:")); + $self->attach ($filenameLabel, + 0,1,0,1, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 20,20); # horizontal and vertical paddings + my $filenameLabel2 = Gtk2::Label->new (''); + $self->attr('CONTROLS','FILENAME') = $filenameLabel2; + $self->attach ($filenameLabel2, + 1,2,0,1, # left, right, top and bottom columns + ['fill','expand'],'shrink', # x and y options + 20,20); # horizontal and vertical paddings + + my $preferedUILabel = Gtk2::Label->new (_T("Prefered Launcher:")); + $self->attach ($preferedUILabel, + 0,1,1,2, # left, right, top and bottom columns + 'shrink','shrink', # x and y options + 20,20); # horizontal and vertical paddings + + my $preferedUI = Gtk2::ComboBox->new_text (); + $self->fillComboBox('preferedUI',$preferedUI,\%LAUNCH_COMMAND_LIST); + $self->attr('CONTROLS','PREFERED_UI_COMBO') = $preferedUI; + $self->connectSignal($preferedUI,'changed','onPreferedUIChanged'); + $self->attach ($preferedUI, + 1,2,1,2, # left, right, top and bottom columns + ['fill','expand'],'shrink', # x and y options + 20,20); # horizontal and vertical paddings + + my $buttonList = Gtk2::HButtonBox->new (); + $buttonList->set_layout ('spread'); + $buttonList->set_spacing (5); + $self->attach ($buttonList, + 0,2,2,3, # left, right, top and bottom columns + ['fill','expand'],['fill','expand'], # x and y options + 20,20); # horizontal and vertical paddings + + my $compileButton = Gtk2::Button->new_from_stock ('gtk-execute'); + $self->attr('CONTROLS','COMPILE_BUTTON') = $compileButton; + $self->connectSignal($compileButton,'clicked','onCompileButtonClicked'); + $buttonList->add ($compileButton); + + my $cleanCompileButton = Gtk2::Button->new_with_label (_T("Clean and Execute")); + $cleanCompileButton->set_image (Gtk2::Image->new_from_stock ('gtk-execute', 'button')); + $self->attr('CONTROLS','CLEAN_COMPILE_BUTTON') = $cleanCompileButton; + $self->connectSignal($cleanCompileButton,'clicked','onCleanCompileButtonClicked'); + $buttonList->add ($cleanCompileButton); + + my $cleanButton = Gtk2::Button->new_with_label (_T("Clean")); + $cleanButton->set_image (Gtk2::Image->new_from_file ($self->getIconPath('clean.png'))); + $self->attr('CONTROLS','CLEAN_BUTTON') = $cleanButton; + $self->connectSignal($cleanButton,'clicked','onCleanButtonClicked'); + $buttonList->add ($cleanButton); + + my $cleanallButton = Gtk2::Button->new_with_label (_T("Clean all")); + $cleanallButton->set_image (Gtk2::Image->new_from_file ($self->getIconPath('cleanall.png'))); + $self->attr('CONTROLS','CLEANALL_BUTTON') = $cleanallButton; + $self->connectSignal($cleanallButton,'clicked','onCleanallButtonClicked'); + $buttonList->add ($cleanallButton); + + my $refreshButton = Gtk2::Button->new_from_stock ('gtk-refresh'); + $self->connectSignal($refreshButton,'clicked','onRefreshButtonClicked'); + $buttonList->add ($refreshButton); +} + +=pod + +=item * initializeToolPanel() + +Initializing the panel content before displaying. + +=cut +sub initializeToolPanel() : method { + my $self = shift; + $self->SUPER::initializeToolPanel(); + + unless (%LAUNCH_COMMAND_LIST) { + $LAUNCH_COMMAND_LIST{'01_'._T('No prefered launcher, use first available')} = 'none'; + $LAUNCH_COMMAND_LIST{'02_'._T('Gnome terminal')} = 'gnome'; + $LAUNCH_COMMAND_LIST{'03_'._T('KDE console')} = 'kde'; + $LAUNCH_COMMAND_LIST{'04_'._T('No graphical terminal')} = 'stdout'; + } + + $self->initControls(); + + my $preferedUI = $self->attr('CONFIGURATION','gtk.preferred launcher'); + if (($preferedUI)&&(exists $LAUNCH_COMMANDS{"$preferedUI"})) { + my $combo = $self->attr('CONTROLS','PREFERED_UI_COMBO'); + my $index = $self->getComboBoxValueIndex ($combo, "$preferedUI"); + $index = 0 if ($index<0); + $self->attr('CONTROLS','PREFERED_UI_COMBO')->set_active ($index); + } + else { + $self->attr('CONTROLS','PREFERED_UI_COMBO')->set_active (0); + } + + $self->refresh(); +} + +=pod + +=item * saveGUIConfiguration(\%) + +Save the GUI configuration inside the specified configuration. + +=over 4 + +=item is the configuration to fill + +=back + +=cut +sub saveGUIConfiguration(\%) { + my $self = shift; + my $preferedUI = $self->attr('CONFIGURATION','gtk.preferred launcher'); + printDbgFor(4,formatText(_T("Preferred launcher: {}"), $preferedUI)); + $_[0]->{'gtk.preferred launcher'} = $preferedUI; +} + +=pod + +=item * refresh() + +Refreshing the panel. + +=cut +sub refresh() : method { + my $self = shift; + my $currentConfig = $self->attr('CONFIGURATION'); + + my %configuration = (); + $configuration{'__private__'}{'output.directory'} = $currentConfig->{'__private__'}{'output.directory'}; + detectMainTeXFile(%configuration); + + my $active = FALSE; + if ($configuration{'__private__'}{'input.latex file'}) { + $self->attr('CONTROLS','FILENAME')->set_text (basename($configuration{'__private__'}{'input.latex file'})); + $active = TRUE; + } + else { + $self->attr('CONTROLS','FILENAME')->set_text ('???'); + } + $self->attr('CONTROLS','COMPILE_BUTTON')->set_sensitive ($active); + $self->attr('CONTROLS','CLEAN_COMPILE_BUTTON')->set_sensitive ($active); + $self->attr('CONTROLS','CLEAN_BUTTON')->set_sensitive ($active); + $self->attr('CONTROLS','CLEANALL_BUTTON')->set_sensitive ($active); +} + +=pod + +=item * launchAutoLaTeX(@) + +Launching AutoLaTeX inside a child process. + +=over 4 + +=item the list of parameters to pass to AutoLaTeX + +=back + +=cut +sub launchAutoLaTeX(@) : method { + my $self = shift; + + printDbg(formatText(_T("Launching AutoLaTeX with parameters: {}"),join(' ',@_))); + printDbgIndent(); + + $self->attr('CONTROLS','COMPILE_BUTTON')->set_sensitive (FALSE); + $self->attr('CONTROLS','CLEAN_COMPILE_BUTTON')->set_sensitive (FALSE); + $self->attr('CONTROLS','CLEAN_BUTTON')->set_sensitive (FALSE); + $self->attr('CONTROLS','CLEANALL_BUTTON')->set_sensitive (FALSE); + + my $succeed = 0; + my %LAUNCHERS = %LAUNCH_COMMANDS; + + my $preferedUI = $self->attr('CONFIGURATION','gtk.preferred launcher'); + if (($preferedUI)&&(exists $LAUNCHERS{"$preferedUI"})) { + printDbg(formatText(_T("trying prefered launcher: {}"), $preferedUI)); + my $command = $LAUNCHERS{"$preferedUI"}; + if (runSystemCommand($self,@{$command}, @_) == 0) { + printDbg(_T("launch succeeded")); + $succeed = 1; + } + delete $LAUNCHERS{"$preferedUI"}; + } + + unless ($succeed) { + foreach my $cmdlabel (@LAUNCH_COMMAND_ORDER) { + if (exists $LAUNCHERS{"$cmdlabel"}) { + printDbg(formatText(_T("trying {}"),$cmdlabel)); + my $command = $LAUNCHERS{"$cmdlabel"}; + if (runSystemCommand($self,@{$command}, @_) == 0) { + printDbg(_T("launch succeeded")); + $succeed = 1; + last; + } + } + } + } + + printDbgUnindent(); +} + +# +#------------------------------------- SIGNALS +# + +sub onSystemCommandTerminaison(\@$) { + my $self = shift; + $self->attr('CONTROLS','COMPILE_BUTTON')->set_sensitive (TRUE); + $self->attr('CONTROLS','CLEAN_COMPILE_BUTTON')->set_sensitive (TRUE); + $self->attr('CONTROLS','CLEAN_BUTTON')->set_sensitive (TRUE); + $self->attr('CONTROLS','CLEANALL_BUTTON')->set_sensitive (TRUE); +} + +sub onPreferedUIChanged(@) { + my $self = shift; + my $value = $self->getComboBoxValue($self->attr('CONTROLS','PREFERED_UI_COMBO')); + $self->attr('CONFIGURATION','gtk.preferred launcher') = $value; +} + +sub onCompileButtonClicked(@) { + my $self = shift; + $self->launchAutoLaTeX ('all'); +} + +sub onCleanCompileButtonClicked(@) { + my $self = shift; + $self->launchAutoLaTeX ('clean', 'all'); +} + +sub onCleanButtonClicked(@) { + my $self = shift; + $self->launchAutoLaTeX ('clean'); +} + +sub onCleanallButtonClicked(@) { + my $self = shift; + $self->launchAutoLaTeX ('cleanall'); +} + +sub onRefreshButtonClicked(@) { + my $self = shift; + $self->refresh (); +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/Gtk/TranslatorPanel.pm b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/TranslatorPanel.pm new file mode 100644 index 0000000000..9548fd10d8 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/TranslatorPanel.pm @@ -0,0 +1,572 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::Gtk::TranslatorPanel - A GTK panel for translator management + +=head1 DESCRIPTION + +AutoLaTeX::GUI::Gtk::TranslatorPanel is a Perl module, which permits to +display a Gtk panel that manages AutoLaTeX translators. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in GtkTranslatorPanel.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::Gtk::TranslatorPanel; + +@ISA = qw( Gtk2::Table AutoLaTeX::GUI::Gtk::WidgetUtil AutoLaTeX::GUI::AbstractTranslatorPanel ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Glib qw(TRUE FALSE); +use Gtk2; +use Gtk2::SimpleList; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::Translator; +use AutoLaTeX::GUI::AbstractTranslatorPanel; +use AutoLaTeX::GUI::Gtk::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "7.0" ; + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * new(\%\%\%\%;$) + +Contructor. + +Parameters are: + +=over 4 + +=item the current configuration extracted from the configuration files. + +=item the system configuration extracted from the configuration file. + +=item the user configuration extracted from the configuration file. + +=item the project configuration extracted from the configuration file. + +=item an object on which the subroutine C<onTranslatorPanelStateChanged()> is available. + +=back + +=cut +sub new(\%\%\%\%;$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = bless( $class->SUPER::new( + 2, #rows + 2, #columns + FALSE), #non uniform + $class ) ; + + die("The first parameter of AutoLaTeX::GUI::Gtk::TranslatorPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[0]))||(isHash($_[0]))); + $self->attr('CONFIGURATIONS','FULL') = $_[0]; + + die("The second parameter of AutoLaTeX::GUI::Gtk::TranslatorPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[1]))||(isHash($_[1]))); + $self->attr('CONFIGURATIONS','SYSTEM') = $_[1]; + + die("The third parameter of AutoLaTeX::GUI::Gtk::TranslatorPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[2]))||(isHash($_[2]))); + $self->attr('CONFIGURATIONS','USER') = $_[2]; + + die("The forth parameter of AutoLaTeX::GUI::Gtk::TranslatorPanel::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[3]))||(isHash($_[3]))); + $self->attr('CONFIGURATIONS','PROJECT') = $_[3]; + + $self->attr('PANEL_LISTENERS') = [ $_[4] ] if ($_[4]); + + + # Initialization + $self->initializeTranslatorPanel(); + + return $self; +} + +=pod + +=item * initControls() + +Initializing the controls. + +=cut +sub initControls() : method { + my $self = shift; + + # Label + my $label = Gtk2::Label->new(_T("List of available translators:\n(click on the three left columns to change the loading state of the translators)")); + $self->attach ($label, + 0,1,0,1, # left, right, top and bottom columns + 'expand','shrink', # x and y options + 0,0); # horizontal and vertical paddings + + # Translator list and associated text + my $translatorList = Gtk2::SimpleList->new ( + 'system', 'pixbuf', + 'user', 'pixbuf', + 'project', 'pixbuf', + 'name', 'text', + 'description', 'text'); + $translatorList->set_headers_clickable (FALSE); + $translatorList->set_headers_visible (FALSE); + $self->attr('TRANSLATOR_LIST') = $translatorList; + + my $translatorListScroll = Gtk2::ScrolledWindow-> new(); + $translatorListScroll->add ($translatorList); + $translatorListScroll->set_size_request (500,400); + $translatorListScroll->set_policy ('automatic','automatic'); + $translatorListScroll->set_shadow_type ('in'); + + $self->attach ($translatorListScroll, + 0,1,1,2, # left, right, top and bottom columns + ['fill','expand'],['fill','expand'], # x and y options + 5,5); # horizontal and vertical paddings + + # Management buttons + my $buttonAlignment = Gtk2::VButtonBox->new (); + $buttonAlignment->set_layout_default('start'); + $self->attach ($buttonAlignment, + 1,2,0,2, # left, right, top and bottom columns + 'shrink',['fill','expand'], # x and y options + 5,5); # horizontal and vertical paddings + + my $addButton = Gtk2::Button->new_from_stock ('gtk-add'); + $self->connectSignal($addButton,'clicked','onTranslatorAdded'); + $addButton->set_sensitive( FALSE ) ; + $self->attr('BUTTONS','addTranslator') = $addButton; + $buttonAlignment->add ($addButton); + + my $editButton = Gtk2::Button->new_from_stock ('gtk-edit'); + $self->connectSignal($editButton,'clicked','onTranslatorEdited'); + $editButton->set_sensitive( FALSE ) ; + $self->attr('BUTTONS','editTranslator') = $editButton; + $buttonAlignment->add ($editButton); + + my $deleteButton = Gtk2::Button->new_from_stock ('gtk-delete'); + $self->connectSignal($deleteButton,'clicked','onTranslatorDeleted'); + $deleteButton->set_sensitive( FALSE ) ; + $self->attr('BUTTONS','deleteTranslator') = $deleteButton; + $buttonAlignment->add ($deleteButton); + + # Help + $buttonAlignment->add (Gtk2::HSeparator->new ()); + $buttonAlignment->add ($self->makeLegend($self->getLevelIcon('system'), _T('All users'))); + $buttonAlignment->add ($self->makeLegend($self->getLevelIcon('user'), _T('Current usr'))); + $buttonAlignment->add ($self->makeLegend($self->getLevelIcon('project'), _T('Current project'))); + $buttonAlignment->add (Gtk2::HSeparator->new ()); + $buttonAlignment->add ($self->makeLegend($self->getLevelIcon('system'), _T('Loaded, no conflict'))); + $buttonAlignment->add ($self->makeLegend($self->getConflictLevelIcon('system'), _T('Loaded, conflict'))); + $buttonAlignment->add ($self->makeLegend($self->getRedLevelIcon('system'), _T('Not loaded'))); + $buttonAlignment->add ($self->makeLegend($self->getGrayedLevelIcon('system'), _T('Unspecified, no conflict'))); + $buttonAlignment->add ($self->makeLegend($self->getGrayedConflictLevelIcon('system'), _T('Unspecified, conflict'))); +} + +sub makeLegend($$;$) { + my $self = shift; + my $icon = shift; + my $textlabel = shift; + my $topPadding = shift || 0; + + my $legendAlignment = Gtk2::Table->new (5,2); + + my $iconLabel = Gtk2::Image->new_from_pixbuf($icon); + $legendAlignment->attach ($iconLabel, 0, 1, 0, 1, 'fill', 'fill', 0, $topPadding); + + my $text = Gtk2::Label->new ($textlabel); + $legendAlignment->attach ($text, 1, 2, 0, 1, 'fill', 'fill', 5, $topPadding); + + return $legendAlignment; +} + +=pod + +=item * initializeTranslatorPanel() + +Initializing the panel content before displaying. + +This method read the list of the translators and +fill the attribute C<{'DATA'}{'translators'}>. + +=cut +sub initializeTranslatorPanel() : method { + my $self = shift; + $self->SUPER::initializeTranslatorPanel(); + $self->initControls(); + $self->detectTranslatorConflicts(); + $self->fillTranslatorList(); + $self->notifyListeners(); + $self->connectGtkSignals(); +} + +=pod + +=item * getInclusionStateIcon($$) + +Replies the icon that corresponds to the inclusion state of a translator at the specified level. + +=over 4 + +=item level + +=item translator name + +=cut +sub getInclusionStateIcon($$) : method { + my $self = shift; + my $level = shift; + my $name = shift; + + # Does the translator has a conflict? + my $conflict = $self->hasTranslatorConflict($level,$name); + + if ($self->hasattr('TRANSLATORS',"$name",'included',"$level")) { + my $val = $self->attr('TRANSLATORS',"$name",'included',"$level"); + if (defined($val)) { + if ($val) { + return $self->getConflictLevelIcon($level) if ($conflict); + return $self->getLevelIcon($level); + } + else { + return $self->getIcon("warning.png") if ($conflict); + return $self->getRedLevelIcon($level); + } + } + } + return $self->getGrayedConflictLevelIcon($level) if ($conflict); + return $self->getGrayedLevelIcon($level); +} + +=pod + +=item * detectTranslatorConflicts() + +Detect translator conflicts. + +=cut +sub detectTranslatorConflicts() : method { + my $self = shift; + my %conflicts = detectConflicts(%{$self->attr('TRANSLATORS')}); + # Parse conflict data structure to extract the names of the + # translators under conflict + foreach my $k (keys %conflicts) { + my %trs = (); + foreach my $source (keys %{$conflicts{$k}}) { + foreach my $t (keys %{$conflicts{$k}{$source}}) { + $trs{$t} = 1; + } + } + my @trs = keys %trs; + $conflicts{$k} = \@trs; + } + if (!$self->hasProject()) { + delete $conflicts{'project'}; + } + $self->attr('TRANSLATOR_CONFLICTS') = \%conflicts; +} + +=pod + +=item * hasTranslatorConflict() + +Replies if a conflict exists for the specified translator and level. + +=over 4 + +=item level + +=item translator name + +=back + +=cut +sub hasTranslatorConflict($$) : method { + my $self = shift; + my $level = shift; + my $name = shift; + if (($self->hasattr('TRANSLATOR_CONFLICTS',"$level"))&& + (isArray($self->attr('TRANSLATOR_CONFLICTS',"$level")))) { + return arrayContains(@{$self->attr('TRANSLATOR_CONFLICTS',"$level")},$name); + } + return 0; +} + +=pod + +=item * isUnderConflict() + +Replies if a conflict exists. + +=cut +sub isUnderConflict() : method { + my $self = shift; + if ($self->hasattr('TRANSLATOR_CONFLICTS')) { + my $conflicts = $self->attr('TRANSLATOR_CONFLICTS'); + my $lastlevel = $self->hasProject() ? $ALL_LEVELS[$#ALL_LEVELS] : $ALL_LEVELS[$#ALL_LEVELS-1]; + return 1 if ((isArray($conflicts->{"$lastlevel"}))&& + (@{$conflicts->{"$lastlevel"}})); + + } + return 0; +} + +=pod + +=item * fillTranslatorList() + +Fill the list of translators. + +=cut +sub fillTranslatorList() : method { + my $self = shift; + + my @keys = sort keys %{$self->attr('TRANSLATORS')}; + + @{$self->attr('TRANSLATOR_LIST')->{'data'}} = (); + + my ($systemIcon, $userIcon, $projectIcon); + + foreach my $trans (@keys) { + $systemIcon = $self->getInclusionStateIcon('system',$trans); + $userIcon = $self->getInclusionStateIcon('user',$trans); + $projectIcon = $self->hasProject() ? $self->getInclusionStateIcon('project',$trans) : undef; + + push @{$self->attr('TRANSLATOR_LIST')->{'data'}}, + [ + $systemIcon, + $userIcon, + $projectIcon, + $trans, + $self->attr('TRANSLATORS',"$trans",'human-readable'), + ]; + } +} + +=pod + +=item * connectGtkSignals() + +Differed connection of GTK signals to widgets. + +=cut +sub connectGtkSignals() : method { + my $self = shift; + $self->connectSignal($self->attr('TRANSLATOR_LIST'),'row-activated','onTranslatorEdit'); + $self->connectSignal($self->attr('TRANSLATOR_LIST'),'button-press-event','onTranslatorClick'); + $self->connectSignal($self->attr('TRANSLATOR_LIST'),'cursor-changed','onTranslatorSelected'); +} + +=pod + +=item * getTranslatorDataAt($) + +Replies the data associated to the translator at the specified index + +=cut +sub getTranslatorDataAt($) : method { + my $self = shift; + my $row = $self->attr('TRANSLATOR_LIST')->{'data'}[$_[0]]; + $self->attr('TRANSLATORS',$row->[3]); +} + +=pod + +=item * updateIcons($$) + +Update the icons for the translator that support the given source +extension from the specified level. + +=over 4 + +=item the level for which the update must be done. + +=item the source extension that is the source of this update. + +=back + +=cut +sub updateIcons($$) : method { + my $self = shift; + my $level = shift; + my $source = shift; + + my $levelIndex = arrayIndexOf(@ALL_LEVELS,$level); + + for(my $column=$levelIndex; $column<@ALL_LEVELS; $column++) { + my $clevel = $ALL_LEVELS[$column]; + if (($clevel ne 'project')||($self->hasProject())) { + for(my $idxTrans=0; $idxTrans<@{$self->attr('TRANSLATOR_LIST')->{'data'}}; $idxTrans++) { + my $transData = $self->getTranslatorDataAt($idxTrans); + if ($source eq $transData->{'full-source'}) { + my $icon = $self->getInclusionStateIcon($clevel,$transData->{'name'}); + $self->attr('TRANSLATOR_LIST')->{'data'}[$idxTrans][$column] = $icon; + } + } + } + } +} + +=pod + +=item * notifyListeners() + +Notify listeners about a change of the stateof this panel. + +=cut +sub notifyListeners() : method { + my $self = shift; + my $conflict = $self->isUnderConflict(); + if (($self->hasattr('PANEL_LISTENERS'))&&(isArray($self->attr('PANEL_LISTENERS')))) { + foreach my $listener (@{$self->attr('PANEL_LISTENERS')}) { + if ($listener->can('onTranslatorPanelStateChanged')) { + $listener->onTranslatorPanelStateChanged($self,$conflict); + } + } + } +} + +# +#------------------------------------- SIGNALS +# + +sub onTranslatorSelected(@) : method { + my $self = shift; + my $canWrite = 0; + #my @sel = $self->attr('TRANSLATOR_LIST')->get_selected_indices (); + #if (@sel) { + # my $sel = pop @sel; + # if ($sel>=0) { + # my $data = $self->getTranslatorDataAt($sel); + # if ($data) { + # $canWrite = ((($data->{'level'} eq 'system')&&($self->isAdminUser()))|| + # ($data->{'level'} eq 'user')|| + # (($data->{'level'} eq 'project')&&($self->hasProject()))); + # } + # } + #} + $self->attr('BUTTONS','editTranslator')->set_sensitive ($canWrite); + $self->attr('BUTTONS','deleteTranslator')->set_sensitive ($canWrite); +} + +sub onTranslatorClick(@) : method { + my $self = shift; + my $event = $_[1]; #Gtk2::Gdk::Event + my ($x,$y) = $event->get_coords (); + my ($path,$column,$cell_x,$cell_y) = $_[0]->get_path_at_pos ($x,$y); + if ($path) { + my @indices = $path->get_indices (); + my $title = $column->get_title (); + if ((($title eq 'system')&&($self->isAdminUser()))|| + ($title eq 'user')|| + (($title eq 'project')&&($self->hasProject()))) { + my $index = pop @indices; + my $data = $self->getTranslatorDataAt($index); + if (!defined($data->{'included'}{"$title"})) { + $data->{'included'}{"$title"} = 1; + } + elsif ($data->{'included'}{"$title"}) { + $data->{'included'}{"$title"} = 0; + } + else { + $data->{'included'}{"$title"} = undef; + } + + $self->detectTranslatorConflicts(); + + # Update the icons + $self->updateIcons($title,$data->{'full-source'}); + + # Notify listeners + $self->notifyListeners(); + } + } +} + +sub onTranslatorAdded(@) : method { + my $self = shift; +} + +sub onTranslatorDeleted(@) : method { + my $self = shift; + # + #my @sel = $self->attr('TRANSLATOR_LIST')->get_selected_indices (); + #if (@sel) { + # foreach my $sel (@sel) { + # my $data = $self->getTranslatorDataAt($sel); + # if ($data) { + # my $canWrite = ((($data->{'level'} eq 'system')&&($self->isAdminUser()))|| + # ($data->{'level'} eq 'user')|| + # (($data->{'level'} eq 'project')&&($self->hasProject()))); + # } + # } + #} +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/Gtk/WidgetUtil.pm b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/WidgetUtil.pm new file mode 100644 index 0000000000..f7e10a4870 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/WidgetUtil.pm @@ -0,0 +1,544 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::Gtk::WidgetUtil - A GTK widget utility class + +=head1 DESCRIPTION + +AutoLaTeX::GUI::Gtk::WidgetUtil is a Perl module, which provides +utility methods for GtkWidgets. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in WidgetUtil.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::Gtk::WidgetUtil; + +@ISA = qw( AutoLaTeX::GUI::WidgetUtil ); +@EXPORT = qw( &resetQuitGtkFlag &quitGtk &mustQuitGtk ); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Glib qw(TRUE FALSE); +use Gtk2 qw/-init -threads-init/; + +use File::Basename; +use File::Spec; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Config; +use AutoLaTeX::GUI::WidgetUtil; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "7.0" ; + +# Does the GTK Main loop must be quitted +my $QUITGTK = TRUE; + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * getLevelIcon($) + +Replies the icon for the specified configuration level. + +=cut +sub getLevelIcon($) { + my $self = shift; + my $level = shift || ''; + my $iconName; + if ($level eq 'project') { + $iconName = 'projectLevel.png'; + } + elsif ($level eq 'user') { + $iconName = 'userLevel.png'; + } + else { + $iconName = 'systemLevel.png'; + } + return $self->getIcon($iconName); +} + +=pod + +=item * getGrayedLevelIcon($) + +Replies the grayed icon for the specified configuration level. + +=cut +sub getGrayedLevelIcon($) { + my $self = shift; + my $level = shift || ''; + my $iconName; + if ($level eq 'project') { + $iconName = 'projectLevel_u.png'; + } + elsif ($level eq 'user') { + $iconName = 'userLevel_u.png'; + } + else { + $iconName = 'systemLevel_u.png'; + } + return $self->getIcon($iconName); +} + +=pod + +=item * getRedLevelIcon($) + +Replies the red-crossed icon for the specified configuration level. + +=cut +sub getRedLevelIcon($) { + my $self = shift; + my $level = shift || ''; + my $iconName; + if ($level eq 'project') { + $iconName = 'projectLevel_ko.png'; + } + elsif ($level eq 'user') { + $iconName = 'userLevel_ko.png'; + } + else { + $iconName = 'systemLevel_ko.png'; + } + return $self->getIcon($iconName); +} + +=pod + +=item * getConflictLevelIcon($) + +Replies the conflict icon for the specified configuration level. + +=cut +sub getConflictLevelIcon($) { + my $self = shift; + my $level = shift || ''; + my $iconName; + if ($level eq 'project') { + $iconName = 'projectLevel_c.png'; + } + elsif ($level eq 'user') { + $iconName = 'userLevel_c.png'; + } + else { + $iconName = 'systemLevel_c.png'; + } + return $self->getIcon($iconName); +} + +=pod + +=item * getGrayedConflictLevelIcon($) + +Replies the grayed conflict icon for the specified configuration level. + +=cut +sub getGrayedConflictLevelIcon($) { + my $self = shift; + my $level = shift || ''; + my $iconName; + if ($level eq 'project') { + $iconName = 'projectLevel_uc.png'; + } + elsif ($level eq 'user') { + $iconName = 'userLevel_uc.png'; + } + else { + $iconName = 'systemLevel_uc.png'; + } + return $self->getIcon($iconName); +} + +=pod + +=item * getIconPath($) + +Replies the complete path to the specified icon. + +=cut +sub getIconPath($) : method { + my $self = shift; + my $iconname = shift; + + my $filename = File::Spec->catfile(dirname(__FILE__),"$iconname"); + + return $filename if (-e "$filename"); + return $self->SUPER::getIconPath($iconname); +} + +=pod + +=item * getIcon($) + +Replies a pixbuf that contains the given icon. + +=cut +sub getIcon($) { + my $self = shift; + my $iconName = shift; + + if ($self->hasattr('BUFFERS','icons',"$iconName")) { + return $self->attr('BUFFERS','icons',"$iconName"); + } + + my $iconPath = $self->getIconPath($iconName); + printErr(formatText(_T("icon not found: {}"), $iconName)) unless ($iconPath); + + my $icon = Gtk2::Gdk::Pixbuf->new_from_file ($iconPath); + + $self->attr('BUFFERS','icons',"$iconName") = $icon; + + return $icon; +} + +=pod + +=item * connectSignal($$$) + +Initializing the dialog content before displaying. + +=over 4 + +=item the Gtk object to connect to the signal + +=item the name of the signal to connect + +=item the name of the subroutine to call when the signal was triggered. + +=back + +=cut + +sub connectSignal($$$) : method { + my $self = shift; + my $obj = shift; + my $signame = shift; + my $procname = shift; + + my $proc = sub { + my $refself = $self; + my $refprocname = $procname; + my $refobj = $obj; + if ($refself->isAllowedSignal($refprocname,$refobj)) { + printDbg(formatText(_T("{}: on Gtk signal '{}', calling {}(\$)"),scalar(localtime),$signame,$procname)); + eval("\$refself->$procname(\@_);"); + if ($@) { + printDbg(formatText(_T("{}(\$):"),$procname),$@); + } + } + else { + printDbg(formatText(_T("Ignoring Gtk signal '{}'"),$signame)); + } + }; + + $obj->signal_connect ( $signame => $proc ); + return 1; +} + +=pod + +=item * ignoreSignal($@) + +Ignore the given signal. + +=over 4 + +=item the name of the signal handler subroutine. + +=item a list of source objects from which the signal must be ignore. If not specified, all source objects match. + +=back + +=cut + +sub ignoreSignal($@) : method { + my $self = shift; + my $signame = shift; + my @sources = (@_); + $self->{'AUTOLATEX_IGNORED_SIGNALS'}{"$signame"} = \@sources; + return 1; +} + +=pod + +=item * allowSignal($) + +Allow the given signal. + +=over 4 + +=item the name of the signal handler subroutine. + +=back + +=cut + +sub allowSignal($) : method { + my $self = shift; + my $signame = shift; + delete $self->{'AUTOLATEX_IGNORED_SIGNALS'}{"$signame"}; + return 1; +} + +=pod + +=item * isAllowedSignal($$) + +Replies if the given signal for the specified source must be ignored. + +=over 4 + +=item the name of the signal handler subroutine. + +=item the signal source. + +=back + +=cut + +sub isAllowedSignal($$) : method { + my $self = shift; + my $signame = shift; + my $source = shift; + if (exists $self->{'AUTOLATEX_IGNORED_SIGNALS'}{"$signame"}) { + return FALSE unless (@{$self->{'AUTOLATEX_IGNORED_SIGNALS'}{"$signame"}}); + foreach my $src (@{$self->{'AUTOLATEX_IGNORED_SIGNALS'}{"$signame"}}) { + return FALSE if ($src == $source); + } + } + return TRUE; +} + +=pod + +=item * cfgGtkBoolean($;$) + +Replies the GTK value that corresponds to the specified boolean attribute field. + +=over 4 + +=item the name of the configuration field. + +=item the data structure to fill. + +=back + +=cut +sub cfgGtkBoolean($;$) : method { + my $self = shift; + return (cfgBoolean($_[0],$_[1])) ? TRUE : FALSE; +} + +=pod + +=item * cfgToGtkBoolean($) + +Replies the configuration value that corresponds to the specified boolean GTK boolean. + +=over 4 + +=item the GTK boolean. + +=back + +=cut +sub cfgToGtkBoolean($) : method { + my $self = shift; + return cfgToBoolean($_[0]); +} + +=pod + +=item * fillComboBox($$\%) + +Fill the combo box with the specified set of values. + +The value labels must be prefixed by the order index + +=over 4 + +=item is the identifier of the combo. + +=item the GTKComboBox. + +=item the hashtable containing the labels and the associated values. + +=back + +=cut +sub fillComboBox($$\%) : method { + my $self = shift; + my $id = shift; + my $combobox = shift; + my $values = shift; + my @humanValues = sort keys %{$values}; + $self->attr('CONSTANTS','COMBOBOXES',"$id") = []; + $combobox->set_name ($id); + foreach my $k (@humanValues) { + if ($k =~ /^([0-9]+)_(.*)$/) { + my ($level,$label) = ("$1","$2"); + $combobox->append_text ($label); + $self->attr('CONSTANTS','COMBOBOXES',"$id")->[$level-1] = $values->{"$k"}; + } + } + return 1; +} + +=pod + +=item * getComboBoxValue($) + +Replies the values selected by the specified combo box. + +=over 4 + +=item the GTKComboBox. + +=back + +=cut +sub getComboBoxValue($) : method { + my $self = shift; + my $combobox = shift; + my $id = $combobox->get_name (); + if ($self->hasattr('CONSTANTS','COMBOBOXES',"$id")) { + my $values = $self->attr('CONSTANTS','COMBOBOXES',"$id"); + my $index = $combobox->get_active (); + if (($index>=0)&&($index<@{$values})) { + return $values->[$index]; + } + } + return undef; +} + +=pod + +=item * getComboBoxValueIndex($$) + +Replies the index of the specified value in a combo box, or -1 on error. + +=over 4 + +=item the GTKComboBox. + +=item the desired value. + +=back + +=cut +sub getComboBoxValueIndex($$) : method { + my $self = shift; + my $combobox = shift; + my $desiredValue = shift; + my $id = $combobox->get_name (); + if ($self->hasattr('CONSTANTS','COMBOBOXES',"$id")) { + my $values = $self->attr('CONSTANTS','COMBOBOXES',"$id"); + return arrayIndexOf (@{$values}, "$desiredValue"); + } + return -1; +} + +=pod + +=item * quitGtk() + +Quit the Gtk main loop. + +=cut +sub quitGtk() { + $QUITGTK = TRUE; +} + +=pod + +=item * mustQuitGtk() + +Indicates of Quit the Gtk main loop. + +=cut +sub mustQuitGtk() { + return $QUITGTK; +} + +=pod + +=item * resetQuitGtkFlag() + +Reset the flag that indicates if the Gtk main loop must be quitted. + +=cut +sub resetQuitGtkFlag() { + $QUITGTK = FALSE; +} + + +# +#------------------------------------- SIGNALS +# + +sub onQuit(@) : method { + quitGtk(); +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/Gtk/Window.pm b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/Window.pm new file mode 100644 index 0000000000..3199fd692b --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/Gtk/Window.pm @@ -0,0 +1,426 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::Gtk::Window - A GTK user interface + +=head1 DESCRIPTION + +AutoLaTeX::GUI::Gtk::Window is a Perl module, which permits to +display a Gtk user interface for AutoLaTeX. + +=head1 SYNOPSYS + +AutoLaTeX::GUI::Gtk->new() ; + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in Gtk.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::Gtk::Window; + +our @ISA = qw( AutoLaTeX::GUI::Gtk::WidgetUtil AutoLaTeX::GUI::AbstractGUI Gtk2::Window ); +our @EXPORT = qw(); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Glib qw(TRUE FALSE); +use Gtk2 qw/-init -threads-init/; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::GUI::AbstractGUI; +use AutoLaTeX::GUI::Gtk::WidgetUtil; +use AutoLaTeX::GUI::Gtk::ToolPanel; +use AutoLaTeX::GUI::Gtk::GeneralPanel; +use AutoLaTeX::GUI::Gtk::TranslatorPanel; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "7.0" ; + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * new(\%\%\%\%) + +Contructor. + +Parameters are: + +=over 4 + +=item the current configuration extracted from the configuration files. + +=item the system configuration extracted from the configuration file. + +=item the user configuration extracted from the configuration file. + +=item the project configuration extracted from the configuration file. + +=back + +=cut +sub new(\%\%\%\%) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self = bless($class->SUPER::new('toplevel'), $class) ; + + die("The first parameter of AutoLaTeX::GUI::Gtk::Window::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[0]))||(isHash($_[0]))); + $self->attr('CONFIGURATIONS','FULL') = $_[0]; + + die("The second parameter of AutoLaTeX::GUI::Gtk::Window::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[1]))||(isHash($_[1]))); + $self->attr('CONFIGURATIONS','SYSTEM') = $_[1]; + + die("The third parameter of AutoLaTeX::GUI::Gtk::Window::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[2]))||(isHash($_[2]))); + $self->attr('CONFIGURATIONS','USER') = $_[2]; + + die("The forth parameter of AutoLaTeX::GUI::Gtk::Window::new() should be a hastable\nIf you pass a %v variable, please use the \%v syntax instead.\n") + unless ((!defined($_[3]))||(isHash($_[3]))); + $self->attr('CONFIGURATIONS','PROJECT') = $_[3]; + + # Set the windows attributes + $self->set_title (formatText(_T("AutoLaTeX {}"),getAutoLaTeXVersion())); + $self->connectSignal($self,'delete-event','onQuit'); + + return $self; +} + +=pod + +=item * setAdminUser($) + +Set if the current user is an administrator. + +=cut +sub setAdminUser($) : method { + my $self = shift; + $self->SUPER::setAdminUser($_[0]); + my $title = $self->get_title (); + if ($title =~ /^(.*?)\s*\*ADMINISTRATOR\*\s*$/) { + $title = "$1"; + } + if ($_[0]) { + $title .= " "._T("*ADMINISTRATOR*"); + } + $self->set_title ("$title"); +} + +=pod + +=item * makeNotebookTab($$) + +Replies the GTK component that could be used a a label inside notebook tabs. + +=over 4 + +=item the label of the tab + +=item the icon of the tab + +=back + +=cut +sub makeNotebookTab($$) : method { + my $self = shift; + my $tabname = shift; + + my $hbox = Gtk2::HBox->new (FALSE,2); + + my $iconwgt; + + if (@_>1) { + my $icon = $self->getIcon (shift); + my $animation = Gtk2::Gdk::PixbufSimpleAnim->new ( + $icon->get_width (), + $icon->get_height (), + 1); # Rate in fps + $animation->add_frame ($icon); + foreach my $iconName (@_) { + $icon = $self->getIcon ($iconName); + $animation->add_frame ($icon); + } + $iconwgt = Gtk2::Image->new_from_animation ($animation); + } + else { + $iconwgt = Gtk2::Image->new_from_pixbuf ($self->getIcon ($_[0])); + } + + $hbox->add ($iconwgt); + + my $labelwgt = Gtk2::Label->new ($tabname); + $hbox->add ($labelwgt); + $hbox->show_all (); + + return $hbox; +} + +=pod + +=item * savePanelContents() + +Save the content of the panels. + +=cut +sub savePanelContents() : method { + my $self = shift; + my $tab; + my @panels = ( + 'translatorConfiguration', + 'systemConfiguration', + 'userConfiguration', + 'projectConfiguration', + 'toolPanel', + ); + foreach my $k (@panels) { + $tab = $self->attr('NOTEBOOK_PANEL',"$k"); + if (($tab)&&($tab->can('savePanelContent'))) { + $tab->savePanelContent() + } + } +} + +=pod + +=item * initializeDialogContent() + +Initializing the dialog content before displaying. + +=cut +sub initializeDialogContent() : method { + my $self = shift; + + $self->SUPER::initializeDialogContent(); + + # Main layout + my $mainLayout = Gtk2::Table->new ( + 2, #rows + 1, #columns + FALSE); #non uniform + $self->add ($mainLayout); + + # Initialize the panel notebook + my $notebook = Gtk2::Notebook->new (); + $self->attr('NOTEBOOK') = $notebook; + $mainLayout->attach ($notebook, + 0,1,0,1, # left, right, top and bottom columns + ['fill','expand'],['fill','expand'], # x and y options + 5,5); # horizontal and vertical paddings + $self->connectSignal($notebook,'switch-page','onNotebookPageChanged'); + + # Close button + my $buttonAlignment = Gtk2::HButtonBox->new (); + $buttonAlignment->set_layout('end'); + + my $closeButton = Gtk2::Button->new_from_stock ('gtk-close'); + $self->connectSignal($closeButton,'clicked','onQuit'); + $buttonAlignment->add ($closeButton); + + $mainLayout->attach ($buttonAlignment, + 0,1,1,2, # left, right, top and bottom columns + ['fill','expand'],'shrink', # x and y options + 5,5); # horizontal and vertical paddings + + # Open the tool panel + my $toolTab = AutoLaTeX::GUI::Gtk::ToolPanel->new ($self->attr('CONFIGURATIONS','FULL')); + $toolTab->setAdminUser( $self->isAdminUser() ); + $self->attr('NOTEBOOK_PANEL','toolPanel') = $toolTab; + $notebook->append_page($toolTab, $self->makeNotebookTab( + _T("Tools"), "tools.png")); + + # Open the project configuration + if ($self->hasProject ()) { + my $projectConfTab = AutoLaTeX::GUI::Gtk::GeneralPanel->new ( + $self->attr('CONFIGURATIONS','PROJECT'), + 'getProjectConfigFilename'); + $projectConfTab->setAdminUser( $self->isAdminUser() ); + $self->attr('NOTEBOOK_PANEL','projectConfiguration') = $projectConfTab; + $notebook->append_page($projectConfTab, $self->makeNotebookTab( + _T("Project Configuration"), "projectLevel.png")); + } + + # Create the user configuration panel + my $userConfTab = AutoLaTeX::GUI::Gtk::GeneralPanel->new ( + $self->attr('CONFIGURATIONS','USER'), + 'getUserConfigFilename'); + $userConfTab->setAdminUser( $self->isAdminUser() ); + $self->attr('NOTEBOOK_PANEL','userConfiguration') = $userConfTab; + $notebook->append_page($userConfTab, $self->makeNotebookTab( + _T("User Configuration"), "userLevel.png")); + + # Open the system configuration only if root + if ($self->isAdminUser ()) { + my $systemConfTab = AutoLaTeX::GUI::Gtk::GeneralPanel->new ( + $self->attr('CONFIGURATIONS','SYSTEM'), + 'getSystemConfigFilename'); + $systemConfTab->setAdminUser( $self->isAdminUser() ); + $self->attr('NOTEBOOK_PANEL','systemConfiguration') = $systemConfTab; + $notebook->append_page($systemConfTab, $self->makeNotebookTab( + _T("System Configuration"), "systemLevel.png")); + } + + # Create the translator panel + my $translatorTab = AutoLaTeX::GUI::Gtk::TranslatorPanel->new ( + $self->attr('CONFIGURATIONS','FULL'), + $self->attr('CONFIGURATIONS','SYSTEM'), + $self->attr('CONFIGURATIONS','USER'), + $self->attr('CONFIGURATIONS','PROJECT'), + $self); + $translatorTab->setAdminUser( $self->isAdminUser() ); + $self->attr('NOTEBOOK_PANEL','translatorConfiguration') = $translatorTab; + +} + +=pod + +=item * doLoop() + +Do the GUI interaction loop. It means that the dialog +must be displayed now and ready for interaction. + +=cut +sub doLoop() : method { + my $self = shift; + $self->show_all; + my $quit = FALSE; + my $lastmsg = ''; + resetQuitGtkFlag(); + while (!mustQuitGtk()) { + while (Gtk2->events_pending()) { + Gtk2->main_iteration(); + } + notifySystemCommandListeners(); + } + +} + +=pod + +=item * destroyDialogContent() + +Destroying the dialog content after the application was quitted. + +=cut +sub destroyDialogContent() : method { + my $self = shift; + + $self->savePanelContents(); + + $self->SUPER::destroyDialogContent(); +} + +=pod + +=item * onTranslatorPanelStateChanged($$) + +Invoked when the translator panel has its state changed. + +=cut +sub onTranslatorPanelStateChanged($$) { + my $self = shift; + my $panel = shift; + my $conflict = shift; + + my $tabTitle; + if ($conflict) { + $tabTitle = $self->makeNotebookTab(_T("Translators"), "translators_err.png", "translators.png", "translators_err.png", "translators.png", "translators_err.png", "translators.png", "translators_err.png"); + } + else { + $tabTitle = $self->makeNotebookTab(_T("Translators"), "translators.png"); + } + + if ($self->hasattr('NOTEBOOK_PANEL','translatorConfiguration')) { + $self->attr('NOTEBOOK')->set_tab_label ( + $panel, + $tabTitle); + } + else { + $self->attr('NOTEBOOK')->append_page( + $panel, + $tabTitle); + } +} + +=pod + +=item * onTranslatorPanelStateChanged($$) + +Invoked when the translator panel has its state changed. + +=cut +sub onNotebookPageChanged($$) { + my $self = shift; + my $notebook = $_[0]; + my $newpagenum = $_[2]|| 0; + my $oldpagenum = $notebook->get_current_page (); + if ($oldpagenum>=0) { + my $pageObj = $notebook->get_nth_page ($oldpagenum); + if ($pageObj->can('savePanelContent')) { + printDbgFor(3,_T("Saving hidden notebook panel")); + $pageObj->savePanelContent (); + } + } +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/WidgetUtil.pm b/support/autolatex/pm/AutoLaTeX/GUI/WidgetUtil.pm new file mode 100644 index 0000000000..60ef63a1ee --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/WidgetUtil.pm @@ -0,0 +1,227 @@ +# Copyright (C) 2007-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::GUI::WidgetUtil - A generic widget utility class + +=head1 DESCRIPTION + +AutoLaTeX::GUI::WidgetUtil is a Perl module, which provides +utility methods for widgets. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in WidgetUtil.pm itself. + +=over + +=cut + +package AutoLaTeX::GUI::WidgetUtil; + +@ISA = ('Exporter'); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use File::Basename; +use File::Spec; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "6.0" ; + +#------------------------------------------------------ +# +# Functions +# +#------------------------------------------------------ + +=pod + +=item * setAdminUser($) + +Set if the current user is an administrator. + +=cut +sub setAdminUser($) : method { + my $self = shift; + $self->attr('isAdmin') = $_[0]; +} + +=pod + +=item * isAdminUser() + +Replies if the current user is an administrator. + +=cut +sub isAdminUser() : method { + my $self = shift; + return ($self->attr('isAdmin')); +} + +=pod + +=item * hasProject() + +Replies if this panel contains the configuration of a project or not. + +=cut +sub hasProject() : method { + my $self = shift; + return (($self->hasattr('CONFIGURATIONS','PROJECT'))&& + (defined($self->attr('CONFIGURATIONS','PROJECT')))); +} + +=pod + +=item * attr(@) + +Replies the given attribute. + +=over 4 + +=item the name of the attribute. + +=back + +=cut +sub attr(@) : lvalue method { + my $self = shift; + die("you must specified a name for the attribute\n") unless (@_); + $self->{'AUTOLATEX_ATTR'} = {} unless (exists $self->{'AUTOLATEX_ATTR'}); + $a = $self->{'AUTOLATEX_ATTR'}; + my $lastname = pop @_; + foreach my $name (@_) { + $a->{"$name"} = {} unless ((exists $a->{"$name"})&&(isHash($a->{"$name"}))); + $a = $a->{"$name"}; + } + $a->{"$lastname"}; +} + +=pod + +=item * hasattr(@) + +Replies if the given attribute exists. + +=over 4 + +=item the name of the attribute. + +=back + +=cut +sub hasattr(@) : method { + my $self = shift; + die("you must specified a name for the attribute\n") unless (@_); + return undef unless (exists $self->{'AUTOLATEX_ATTR'}); + $a = $self->{'AUTOLATEX_ATTR'}; + my $lastname = pop @_; + foreach my $name (@_) { + return undef unless ((exists $a->{"$name"})&&(isHash($a->{"$name"}))); + $a = $a->{"$name"}; + } + return exists $a->{"$lastname"}; +} + +=pod + +=item * deleteattr(@) + +Delete the given attribute if it exists. + +=over 4 + +=item the name of the attribute. + +=back + +=cut +sub deleteattr(@) : method { + my $self = shift; + die("you must specified a name for the attribute\n") unless (@_); + my $oldvalue = undef; + return $oldvalue unless (exists $self->{'AUTOLATEX_ATTR'}); + $a = $self->{'AUTOLATEX_ATTR'}; + my $lastname = pop @_; + foreach my $name (@_) { + return $oldvalue unless ((exists $a->{"$name"})&&(isHash($a->{"$name"}))); + $a = $a->{"$name"}; + } + if (exists $a->{"$lastname"}) { + $oldvalue = $a->{"$lastname"}; + delete $a->{"$lastname"}; + } + return $oldvalue; +} + +=pod + +=item * getIconPath($) + +Replies the complete path to the specified icon. + +=cut +sub getIconPath($) : method { + my $self = shift; + my $iconname = shift; + + my $filename = File::Spec->catfile(dirname(__FILE__),"$iconname"); + + return $filename if (-e "$filename"); + return undef; +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2007-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/GUI/clean.png b/support/autolatex/pm/AutoLaTeX/GUI/clean.png Binary files differnew file mode 100644 index 0000000000..3965d58d2d --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/clean.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/cleanall.png b/support/autolatex/pm/AutoLaTeX/GUI/cleanall.png Binary files differnew file mode 100644 index 0000000000..184f762851 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/cleanall.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/projectLevel.png b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel.png Binary files differnew file mode 100644 index 0000000000..77a10dd0a5 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_c.png b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_c.png Binary files differnew file mode 100644 index 0000000000..7808de8dee --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_c.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_ko.png b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_ko.png Binary files differnew file mode 100644 index 0000000000..36315670fa --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_ko.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_u.png b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_u.png Binary files differnew file mode 100644 index 0000000000..a19e7e9404 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_u.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_uc.png b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_uc.png Binary files differnew file mode 100644 index 0000000000..4b77b13c2e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/projectLevel_uc.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/systemLevel.png b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel.png Binary files differnew file mode 100644 index 0000000000..2705adbba0 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_c.png b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_c.png Binary files differnew file mode 100644 index 0000000000..b9d98d497e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_c.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_ko.png b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_ko.png Binary files differnew file mode 100644 index 0000000000..b3c318bc37 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_ko.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_u.png b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_u.png Binary files differnew file mode 100644 index 0000000000..4e48429dfa --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_u.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_uc.png b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_uc.png Binary files differnew file mode 100644 index 0000000000..f16abe18f3 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/systemLevel_uc.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/tools.png b/support/autolatex/pm/AutoLaTeX/GUI/tools.png Binary files differnew file mode 100644 index 0000000000..d7b5c2b304 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/tools.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/translators.png b/support/autolatex/pm/AutoLaTeX/GUI/translators.png Binary files differnew file mode 100644 index 0000000000..17bd49786e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/translators.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/translators_err.png b/support/autolatex/pm/AutoLaTeX/GUI/translators_err.png Binary files differnew file mode 100644 index 0000000000..f98096cf3e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/translators_err.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/userLevel.png b/support/autolatex/pm/AutoLaTeX/GUI/userLevel.png Binary files differnew file mode 100644 index 0000000000..4754c06cf1 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/userLevel.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/userLevel_c.png b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_c.png Binary files differnew file mode 100644 index 0000000000..01a160f8f1 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_c.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/userLevel_ko.png b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_ko.png Binary files differnew file mode 100644 index 0000000000..1da58e2901 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_ko.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/userLevel_u.png b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_u.png Binary files differnew file mode 100644 index 0000000000..10885a4ac9 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_u.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/userLevel_uc.png b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_uc.png Binary files differnew file mode 100644 index 0000000000..2ac1c081ef --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/userLevel_uc.png diff --git a/support/autolatex/pm/AutoLaTeX/GUI/warning.png b/support/autolatex/pm/AutoLaTeX/GUI/warning.png Binary files differnew file mode 100644 index 0000000000..06148e8a95 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/GUI/warning.png diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/AbstractInterpreter.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/AbstractInterpreter.pm new file mode 100644 index 0000000000..fa1cabbb56 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/AbstractInterpreter.pm @@ -0,0 +1,130 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::AbstractInterpreter - An abstract script interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::AbstractInterpreter is a Perl module, which permits to +create script interpreters + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in AbstractInterpreter.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::AbstractInterpreter; + +@ISA = qw( Exporter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { 'global' => {} }; + } + bless( $self, $class ); + return $self; +} + +=pod + +=item * define_global_variable($$) + +Define the value of a global variable. + +=cut +sub define_global_variable($$) : method { + my $self = shift; + my $name = shift || confess("no variable name"); + my $value = shift; + $self->{'global'}{"$name"} = $value; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + confess("You must implement the method run()."); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/batch.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/batch.pm new file mode 100644 index 0000000000..d88448f32d --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/batch.pm @@ -0,0 +1,145 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::batch - A DOS-Batch interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::batch is a Perl module, which permits to +run DOS-Batch scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in batch.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::batch; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_batch($$) { + my $name = shift; + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + my $i=0; + foreach my $v (@{$value}) { + $array .= "set $name"."[$i]=\"".str2language("$v").'"'; + $i++; + } + return $array; + } + elsif (isHash($value)) { + die("Associative arrays are not yet supported by the Shell wrapper\n"); + } + elsif (looks_like_number($value)) { + return "set $name=$value"; + } + else { + return "set $name=\"".str2language("$value").'"'; + } + } + return "unset $name"; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = ""; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= _to_batch($name,$value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'bash'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/js.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/js.pm new file mode 100644 index 0000000000..8bb30eb657 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/js.pm @@ -0,0 +1,145 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::js - A Javascript interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::js is a Perl module, which permits to +run Javascript scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in js.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::js; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_javascript($) { + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + foreach my $v (@{$value}) { + if ($array) { + $array .= ', '; + } + $array .= &_to_javascript($v); + } + return "[ $array ]"; + } + elsif (isHash($value)) { + die("Associative arrays are not yet supported by the Javascript wrapper\n"); + } + elsif (looks_like_number($value)) { + return "$value"; + } + else { + return '"'.str2language("$value").'"'; + } + } + return 'null'; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = ""; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= "var $name = "._to_javascript($value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'js'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/python.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/python.pm new file mode 100644 index 0000000000..ebfec1fc34 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/python.pm @@ -0,0 +1,153 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::python - A Python interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::python is a Perl module, which permits to +run Python scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in python.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::python; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_python($) { + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + foreach my $v (@{$value}) { + if ($array) { + $array .= ', '; + } + $array .= &_to_python($v); + } + return "[ $array ]"; + } + elsif (isHash($value)) { + my $array = ''; + while (my ($k,$v) = each(%{$value})) { + if ($array) { + $array .= ', '; + } + $array .= '"'.str2language("$k").'": '; + $array .= &_to_python($v); + } + return "{ $array }"; + } + elsif (looks_like_number($value)) { + return "$value"; + } + else { + return '"'.str2language("$value").'"'; + } + } + return 'None'; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = "# coding=utf8\n"; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= "$name = "._to_python($value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'python'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/ruby.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/ruby.pm new file mode 100644 index 0000000000..e19c4e12f5 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/ruby.pm @@ -0,0 +1,153 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::ruby - A Ruby interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::ruby is a Perl module, which permits to +run Ruby scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in ruby.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::ruby; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_ruby($) { + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + foreach my $v (@{$value}) { + if ($array) { + $array .= ', '; + } + $array .= &_to_ruby($v); + } + return "[ $array ]"; + } + elsif (isHash($value)) { + my $array = ''; + while (my ($k,$v) = each(%{$value})) { + if ($array) { + $array .= ', '; + } + $array .= '"'.str2language("$k").'"=>'; + $array .= &_to_ruby($v); + } + return "{ $array }"; + } + elsif (looks_like_number($value)) { + return "$value"; + } + else { + return '"'.str2language("$value").'"'; + } + } + return 'nil'; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = ""; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= "$name = "._to_ruby($value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'ruby'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/sh.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/sh.pm new file mode 100644 index 0000000000..4ab8bb3c38 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/sh.pm @@ -0,0 +1,145 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::sh - A Shell interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::sh is a Perl module, which permits to +run Shell scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in sh.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::sh; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_shell($$) { + my $name = shift; + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + my $i=0; + foreach my $v (@{$value}) { + $array .= "$name"."[$i]=\"".str2language("$v").'"'; + $i++; + } + return $array; + } + elsif (isHash($value)) { + die("Associative arrays are not yet supported by the Shell wrapper\n"); + } + elsif (looks_like_number($value)) { + return "$name=$value"; + } + else { + return "$name=\"".str2language("$value").'"'; + } + } + return "unset $name"; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = ""; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= _to_shell($name,$value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'bash'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Interpreter/wincmd.pm b/support/autolatex/pm/AutoLaTeX/Interpreter/wincmd.pm new file mode 100644 index 0000000000..b3d01607cd --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Interpreter/wincmd.pm @@ -0,0 +1,145 @@ +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::Interpreter::batch - A DOS-Batch interpreter + +=head1 DESCRIPTION + +AutoLaTeX::Interpreter::batch is a Perl module, which permits to +run DOS-Batch scripts. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in batch.pm itself. + +=over + +=cut + +package AutoLaTeX::Interpreter::batch; + +@ISA = qw( AutoLaTeX::Interpreter::AbstractInterpreter ); +@EXPORT = qw(); +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use Scalar::Util qw(looks_like_number); + +use AutoLaTeX::Interpreter::AbstractInterpreter; +use AutoLaTeX::Core::Util; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number +my $VERSION = "1.0" ; + + +=pod + +=item * new() + +Constructor + +=cut +sub new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless( $class->SUPER::new(), $class); + return $self; +} + + +sub _to_batch($$) { + my $name = shift; + my $value = shift; + if (defined($value)) { + if (isArray($value)) { + my $array = ''; + my $i=0; + foreach my $v (@{$value}) { + $array .= "set $name"."[$i]=\"".str2language("$v").'"'; + $i++; + } + return $array; + } + elsif (isHash($value)) { + die("Associative arrays are not yet supported by the Shell wrapper\n"); + } + elsif (looks_like_number($value)) { + return "set $name=$value"; + } + else { + return "set $name=\"".str2language("$value").'"'; + } + } + return "unset $name"; +} + +=pod + +=item * run($) + +Run the given code. + +=cut +sub run($) : method { + my $self = shift; + my $code = shift || confess("no code"); + my $fullcode = ""; + while (my ($name,$value) = each(%{$self->{'global'}})) { + $fullcode .= _to_batch($name,$value)."\n"; + } + $fullcode .= "\n\n\n$code"; + runCommandOrFailFromInput($fullcode, 'cmd'); +} + + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 2013 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + +=head1 SEE ALSO + +L<autolatex> diff --git a/support/autolatex/pm/AutoLaTeX/Make/Make.pm b/support/autolatex/pm/AutoLaTeX/Make/Make.pm new file mode 100644 index 0000000000..4ba69db19d --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Make/Make.pm @@ -0,0 +1,1935 @@ +# autolatex - Make.pm +# Copyright (C) 2013-2016 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Make.pm - Make-like Tools + +=head1 DESCRIPTION + +Provides tools that are close to the Make tool. + +To use this library, type C<use AutoLaTeX::Make::Make;>. + +=head1 GETTING STARTED + +=head2 Initialization + +To create a Make tool, say something like this: + + use AutoLaTeX::Make::Make; + + my $make = AutoLaTeX::Make::Make->new($configuration) ; + +...or something similar. Acceptable parameters to the constructor are: + +=over + +=item * C<configuration> is an associative array that contains all the configuration of AutoLaTeX. + +=back + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in TeXParser.pm itself. + +=over + +=cut +package AutoLaTeX::Make::Make; + +our @ISA = qw( Exporter ); +our @EXPORT = qw( ); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Class::Struct; +use File::Basename; +use File::Spec; +use Carp; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::OS; +use AutoLaTeX::Core::Progress; +use AutoLaTeX::TeX::BibCitationAnalyzer; +use AutoLaTeX::TeX::TeXDependencyAnalyzer; +use AutoLaTeX::TeX::IndexAnalyzer; +use AutoLaTeX::TeX::GlossaryAnalyzer; + +our $VERSION = '34.0'; + +my $EXTENDED_WARNING_CODE = <<'ENDOFTEX'; + %************************************************************* + % CODE ADDED BY AUTOLATEX TO CHANGE THE OUPUT OF THE WARNINGS + %************************************************************* + \makeatletter + \newcount\autolatex@@@lineno + \newcount\autolatex@@@lineno@delta + \xdef\autolatex@@@mainfile@real{::::REALFILENAME::::} + \def\autolatex@@@mainfile{autolatex_autogenerated.tex} + \xdef\autolatex@@@filename@stack{{\autolatex@@@mainfile}{\autolatex@@@mainfile}} + \global\let\autolatex@@@currentfile\autolatex@@@mainfile + \def\autolatex@@@filename@stack@push#1{% + \xdef\autolatex@@@filename@stack{{#1}\autolatex@@@filename@stack}% + } + \def\autolatex@@@filename@stack@pop@split#1#2\@nil{% + \gdef\autolatex@@@currentfile{#1}% + \gdef\autolatex@@@filename@stack{#2}% + } + \def\autolatex@@@filename@stack@pop{% + \expandafter\autolatex@@@filename@stack@pop@split\autolatex@@@filename@stack\@nil} + \def\autolatex@@@update@filename{% + \ifx\autolatex@@@mainfile\autolatex@@@currentfile% + \edef\autolatex@@@warning@filename{\autolatex@@@mainfile@real}% + \global\autolatex@@@lineno@delta=::::AUTOLATEXHEADERSIZE::::\relax% + \else% + \edef\autolatex@@@warning@filename{\autolatex@@@currentfile}% + \global\autolatex@@@lineno@delta=0\relax% + \fi% + {\filename@parse{\autolatex@@@warning@filename}\global\let\autolatex@@@filename@ext\filename@ext}% + \xdef\autolatex@@@generic@warning@beginmessage{!!!![BeginWarning]\autolatex@@@warning@filename:\ifx\autolatex@@@filename@ext\relax.tex\fi:}% + \xdef\autolatex@@@generic@warning@endmessage{!!!![EndWarning]\autolatex@@@warning@filename}% + } + \def\autolatex@@@openfile#1{% + \expandafter\autolatex@@@filename@stack@push{\autolatex@@@currentfile}% + \xdef\autolatex@@@currentfile{#1}% + \autolatex@@@update@filename% + } + \def\autolatex@@@closefile{% + \autolatex@@@filename@stack@pop% + \autolatex@@@update@filename% + } + \let\autolatex@@@InputIfFileExists\InputIfFileExists + \long\def\InputIfFileExists#1#2#3{% + \autolatex@@@openfile{#1}% + \autolatex@@@InputIfFileExists{#1}{#2}{#3}% + \autolatex@@@closefile% + } + \let\autolatex@@@input\@input + \long\def\@input#1{% + \autolatex@@@openfile{#1}% + \autolatex@@@input{#1}% + \autolatex@@@closefile% + } + \global\DeclareRobustCommand{\GenericWarning}[2]{% + \global\autolatex@@@lineno\inputlineno\relax% + \global\advance\autolatex@@@lineno\autolatex@@@lineno@delta\relax% + \begingroup + \def\MessageBreak{^^J#1}% + \set@display@protect + \immediate\write\@unused{^^J\autolatex@@@generic@warning@beginmessage\the\autolatex@@@lineno: #2\on@line.^^J\autolatex@@@generic@warning@endmessage^^J}% + \endgroup + } + \autolatex@@@update@filename + \makeatother + %************************************************************* +ENDOFTEX + +my %COMMAND_DEFINITIONS = ( + 'pdflatex' => { + 'cmd' => 'pdflatex', + 'flags' => ['-halt-on-error', '-interaction', 'batchmode', '-file-line-error'], + 'to_dvi' => ['-output-format=dvi'], + 'to_ps' => undef, + 'to_pdf' => ['-output-format=pdf'], + 'synctex' => '-synctex=1', + 'jobname' => '-jobname', + 'ewarnings' => $EXTENDED_WARNING_CODE, + }, + 'latex' => { + 'cmd' => 'latex', + 'flags' => ['-halt-on-error', '-interaction', 'batchmode', '-file-line-error'], + 'to_dvi' => ['-output-format=dvi'], + 'to_ps' => undef, + 'to_pdf' => ['-output-format=pdf'], + 'synctex' => '-synctex=1', + 'jobname' => '-jobname', + 'ewarnings' => $EXTENDED_WARNING_CODE, + }, + 'xelatex' => { + 'cmd' => 'xelatex', + 'flags' => ['-halt-on-error', '-interaction', 'batchmode', '-file-line-error'], + 'to_dvi' => ['-no-pdf'], + 'to_ps' => undef, + 'to_pdf' => [], + 'synctex' => '-synctex=1', + 'jobname' => '-jobname', + 'ewarnings' => $EXTENDED_WARNING_CODE, + }, + 'lualatex' => { + 'cmd' => 'lualatex', + 'flags' => ['-halt-on-error', '-interaction', 'batchmode', '-file-line-error'], + 'to_dvi' => ['-output-format=dvi'], + 'to_ps' => undef, + 'to_pdf' => ['-output-format=pdf'], + 'synctex' => '-synctex=1', + 'jobname' => '-jobname', + 'ewarnings' => $EXTENDED_WARNING_CODE, + }, + 'bibtex' => { + 'cmd' => 'bibtex', + 'flags' => [], + }, + 'biber' => { + 'cmd' => 'biber', + 'flags' => [], + }, + 'makeindex' => { + 'cmd' => 'makeindex', + 'flags' => [], + }, + 'makeglossaries' => { + 'cmd' => 'makeglossaries', + 'flags' => [], + }, + 'dvi2ps' => { + 'cmd' => 'dvips', + 'flags' => [], + }, +); + +struct( Entry => [ + 'file' => '$', + 'go_up' => '$', + 'rebuild' => '$', + 'parent' => '$', +] ); + +sub newEntry($$) { + my $e = Entry->new; + @$e = ($_[0],0,0,$_[1]); + return $e; +} + +#------------------------------------------------------ +# +# Constructor +# +#------------------------------------------------------ + +sub new(\%) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'configuration' => $_[0], + 'files' => {}, + 'rootFiles' => [], + 'is_extended_warning_enable' => 0, + 'is_biblio_enable' => 1, + 'is_makeindex_enable' => 1, + 'is_makeglossaries_enable' => 1, + 'warning_level' => 1, + 'generation_type' => 'pdf', + 'latex_cmd' => [], + 'bibtex_cmd' => [], + 'biber_cmd' => [], + 'makeindex_cmd' => [], + 'makeglossaries_cmd' => [], + 'dvi2ps_cmd' => [], + }; + } + bless( $self, $class ); + + # + # Build the different commands according to the current configuration + # + $self->{'type'} = $_[0]->{'generation.generation type'} || 'pdf'; + my $compiler = $_[0]->{'generation.tex compiler'} || 'pdflatex'; + $self->{'compiler_definition'} = $COMMAND_DEFINITIONS{"$compiler"}; + my $def = $self->{'compiler_definition'}; + confess("No command definition for '$compiler'") unless ($def); + + # LaTeX + if ($_[0]->{'generation.latex_cmd'}) { + push @{$self->{'latex_cmd'}}, $_[0]->{'generation.latex_cmd'}; + } + else { + push @{$self->{'latex_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + confess("No command definition for '$compiler/".$self->{'type'}."'") unless (exists $def->{'to_'.$self->{'type'}}); + + # Support of SyncTeX + if (cfgBoolean($_[0]->{'generation.synctex'}) && $def->{'synctex'}) { + push @{$self->{'latex_cmd'}}, $def->{'synctex'}; + } + + my $target = $def->{'to_'.$self->{'type'}}; + if (defined($target)) { + push @{$self->{'latex_cmd'}}, @{$target}; + } + elsif ($self->{'type'} eq 'ps') { + push @{$self->{'latex_cmd'}}, @{$def->{'to_dvi'}}; + } + else { + confess('invalided Maker state: cannot find the command line to compile TeX files.'); + } + } + + if ($_[0]->{'generation.latex_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.latex_flags'})); + push @{$self->{'latex_cmd'}}, @params; + } + + # Change the warning level + if (defined($_[0]->{'__private__'}{'CLI.warning level'})) { + $self->{'warning_level'} = int($_[0]->{'__private__'}{'CLI.warning level'}); + } + + # Support of extended warnings + if (($_[0]->{'__private__'}{'CLI.is extended tex warnings'} || ($self->{'warning_level'}>1)) + && $def->{'ewarnings'}) { + my $code = $def->{'ewarnings'} || ''; + $code =~ s/^\s+//gm; + $code =~ s/\s+$//gm; + my $s = - countLinesIn($code); + $code =~ s/\Q::::AUTOLATEXHEADERSIZE::::\E/$s/sg; + $self->{'latex_warning_code'} = $code; + $self->{'is_extended_warning_enable'} = 1; + } + + # BibTeX + if ($_[0]->{'generation.bibtex_cmd'}) { + push @{$self->{'bibtex_cmd'}}, $_[0]->{'generation.bibtex_cmd'}; + } + else { + $def = $COMMAND_DEFINITIONS{'bibtex'}; + confess("No command definition for 'bibtex'") unless ($def); + push @{$self->{'bibtex_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + } + + if ($_[0]->{'generation.bibtex_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.bibtex_flags'})); + push @{$self->{'bibtex_cmd'}}, @params; + } + + # Biber + if ($_[0]->{'generation.biber_cmd'}) { + push @{$self->{'biber_cmd'}}, $_[0]->{'generation.biber_cmd'}; + } + else { + $def = $COMMAND_DEFINITIONS{'biber'}; + confess("No command definition for 'biber'") unless ($def); + push @{$self->{'biber_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + } + + if ($_[0]->{'generation.biber_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.biber_flags'})); + push @{$self->{'biber_cmd'}}, @params; + } + + # MakeIndex + if ($_[0]->{'generation.makeindex_cmd'}) { + push @{$self->{'makeindex_cmd'}}, $_[0]->{'generation.makeindex_cmd'}; + } + else { + $def = $COMMAND_DEFINITIONS{'makeindex'}; + confess("No command definition for 'makeindex'") unless ($def); + push @{$self->{'makeindex_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + } + + if ($_[0]->{'generation.makeindex_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.makeindex_flags'})); + push @{$self->{'makeindex_cmd'}}, @params; + } + + # MakeGlossaries + if ($_[0]->{'generation.makeglossaries_cmd'}) { + push @{$self->{'makeglossaries_cmd'}}, $_[0]->{'generation.makeglossaries_cmd'}; + } + else { + $def = $COMMAND_DEFINITIONS{'makeglossaries'}; + confess("No command definition for 'makeglossaries'") unless ($def); + push @{$self->{'makeglossaries_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + } + + if ($_[0]->{'generation.makeglossaries_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.makeglossaries_flags'})); + push @{$self->{'makeglossaries_cmd'}}, @params; + } + + # dvi2ps + if ($_[0]->{'generation.dvi2ps_cmd'}) { + push @{$self->{'dvi2ps_cmd'}}, $_[0]->{'generation.dvi2ps_cmd'}; + } + else { + $def = $COMMAND_DEFINITIONS{'dvi2ps'}; + confess("No command definition for 'dvi2ps'") unless ($def); + push @{$self->{'dvi2ps_cmd'}}, $def->{'cmd'}, @{$def->{'flags'}}; + } + + if ($_[0]->{'generation.dvi2ps_flags'}) { + my @params = split(/\s+/, ($_[0]->{'generation.dvi2ps_flags'})); + push @{$self->{'dvi2ps_cmd'}}, @params; + } + + return $self; +} + +=pod + +=item * makeRelativePath($) + +Make the path relative to the current directory. + +=cut +sub makeRelativePath($) : method { + my $self = shift; + my $relativePath = File::Spec->abs2rel($_[0]); + return $relativePath; +} + + +=pod + +=item * reset() + +Reset this make tool. + +=cut +sub reset() : method { + my $self = shift; + $self->{'files'} = {}; + $self->{'rootFiles'} = []; + return undef; +} + +=pod + +=item * addTeXFile($) + +Add the given TeX file into the building process. +Takes 1 arg: + +=over + +=item * file (string) + +is the name of the TeX file to read. + +=back + +=cut +sub addTeXFile($) : method { + my $self = shift; + my $rootfile = shift; + $rootfile = File::Spec->rel2abs($rootfile); + my $rootbasename = basename($rootfile, '.tex'); + my $roottemplate = File::Spec->catfile(dirname($rootfile), "$rootbasename"); + + my $pdfFile = "$roottemplate.pdf"; + $self->{'files'}{$pdfFile} = { + 'type' => 'pdf', + 'dependencies' => { $rootfile => undef }, + 'change' => lastFileChange($pdfFile), + 'mainFile' => $rootfile, + }; + push @{$self->{'rootFiles'}}, "$pdfFile"; + + return undef; +} + +sub _computeDependenciesForRootFile($) : method { + my $self = shift; + my $pdfFile = shift; + my $rootfile = $self->{'files'}{$pdfFile}{'mainFile'}; + my $rootdir = dirname($rootfile); + my $rootbasename = basename($rootfile, '.tex'); + my $roottemplate = File::Spec->catfile(dirname($rootfile), "$rootbasename"); + + my @files = ( $rootfile ); + while (@files) { + my $file = shift @files; + printDbgFor(2, formatText(_T("Parsing '{}'"), $file)); + if (-f "$file" ) { + printDbgIndent(); + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$file))); + $self->{'files'}{$file} = { + 'type' => 'tex', + 'dependencies' => {}, + 'change' => lastFileChange($file), + }; + my %deps = getDependenciesOfTeX($file,$rootdir); + if (%deps) { + my $dir = dirname($file); + + # + # INCLUDED FILES + # + foreach my $cat ('tex', 'sty', 'cls') { + if ($deps{$cat}) { + foreach my $dpath (@{$deps{$cat}}) { + if (!File::Spec->file_name_is_absolute($dpath)) { + $dpath = File::Spec->catfile($dir, $dpath); + } + if ($dpath !~ /\.$cat/) { + $dpath .= ".$cat"; + } + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$dpath))); + $self->{'files'}{$dpath} = { + 'type' => $cat, + 'dependencies' => {}, + 'change' => lastFileChange($dpath), + }; + $self->{'files'}{$pdfFile}{'dependencies'}{$dpath} = undef; + if ($cat eq 'tex') { + push @files, $dpath; + } + } + } + } + + # + # BIBLIOGRAPHY CALLED FROM THE TEX + # + if ($deps{'biblio'}) { + while (my ($bibdb,$bibdt) = each(%{$deps{'biblio'}})) { + my $dir = dirname($file); + if ($rootdir ne $dir) { + $bibdb = $rootbasename; + } + my $bblfile = File::Spec->catfile("$rootdir", "$bibdb.bbl"); + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$bblfile))); + $self->{'files'}{"$bblfile"} = { + 'type' => 'bbl', + 'dependencies' => {}, + 'change' => lastFileChange("$bblfile"), + 'use_biber' => $deps{'biber'}, + }; + $self->{'files'}{$pdfFile}{'dependencies'}{$bblfile} = undef; + foreach my $cat ('bib', 'bst', 'bbc', 'cbx') { + if ($bibdt->{$cat}) { + foreach my $dpath (@{$bibdt->{$cat}}) { + if (!File::Spec->file_name_is_absolute($dpath)) { + $dpath = File::Spec->catfile("$rootdir", $dpath); + } + if ($dpath !~ /\.$cat/) { + $dpath .= ".$cat"; + } + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$dpath))); + $self->{'files'}{$dpath} = { + 'type' => $cat, + 'dependencies' => {}, + 'change' => lastFileChange($dpath), + }; + $self->{'files'}{"$bblfile"}{'dependencies'}{$dpath} = undef; + } + } + } + } + } + + # + # INDEX + # + if ($deps{'idx'}) { + for my $idxdep (@{$deps{'idx'}}) { + my $idxbasefilename; + if ($idxdep) { + $idxbasefilename = "$idxdep"; + } else { + $idxbasefilename = "$roottemplate"; + } + my $idxfile = "$idxbasefilename.idx"; + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$idxfile))); + $self->{'files'}{"$idxfile"} = { + 'type' => 'idx', + 'dependencies' => {}, + 'change' => lastFileChange("$idxfile"), + }; + my $indfile = "$idxbasefilename.ind"; + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$indfile))); + $self->{'files'}{"$indfile"} = { + 'type' => 'ind', + 'dependencies' => { $idxfile => undef }, + 'change' => lastFileChange("$indfile"), + }; + $self->{'files'}{$pdfFile}{'dependencies'}{$indfile} = undef; + } + } + + # + # GLOSSARIES + # + if ($deps{'glo'}) { + my $glofile = "$roottemplate.glo"; + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$glofile))); + $self->{'files'}{"$glofile"} = { + 'type' => 'glo', + 'dependencies' => {}, + 'change' => lastFileChange("$glofile"), + }; + my $glsfile = "$roottemplate.gls"; + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$glsfile))); + $self->{'files'}{"$glsfile"} = { + 'type' => 'gls', + 'dependencies' => { $glofile => undef }, + 'change' => lastFileChange("$glsfile"), + }; + $self->{'files'}{$pdfFile}{'dependencies'}{$glsfile} = undef; + } + } + printDbgUnindent(); + } + } + + printDbgFor(2, formatText(_T("Parsing auxiliary files"))); + printDbgIndent(); + + # + # BIBLIOGRAPHY FROM INSIDE AUXILIARY FILES (MULTIBIB...) + # + local *DIR; + opendir(*DIR, "$rootdir") or printErr("$rootdir: $!"); + while (my $dir = readdir(*DIR)) { + if ((!isIgnorableDirectory($dir)) && $dir =~ /^(.+?)\.aux$/) { + my $bibdb = "$1"; + if ($bibdb ne "$rootbasename") { + my $auxfile = File::Spec->catfile("$rootdir", "$dir"); + my %data = getAuxBibliographyData("$auxfile"); + if ($data{'databases'} || $data{'styles'}) { + my $bblfile = File::Spec->catfile("$rootdir", "$bibdb.bbl"); + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$bblfile))); + $self->{'files'}{"$bblfile"} = { + 'type' => 'bbl', + 'dependencies' => {}, + 'change' => lastFileChange("$bblfile"), + }; + $self->{'files'}{$pdfFile}{'dependencies'}{$bblfile} = undef; + if ($data{'styles'}) { + foreach my $style (@{$data{'styles'}}) { + my $bstfile = File::Spec->catfile("$rootdir", "$style.bst"); + if (-r "$bstfile") { + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$bstfile))); + $self->{'files'}{"$bstfile"} = { + 'type' => 'bst', + 'dependencies' => {}, + 'change' => lastFileChange("$bstfile"), + }; + $self->{'files'}{$bblfile}{'dependencies'}{$bstfile} = undef; + } + } + } + if ($data{'databases'}) { + foreach my $db (@{$data{'databases'}}) { + my $bibfile = File::Spec->catfile("$rootdir", "$db.bib"); + if (-r "$bibfile") { + printDbgFor(3, formatText(_T("Adding file '{}'"), removePathPrefix($rootdir,$bibfile))); + $self->{'files'}{"$bibfile"} = { + 'type' => 'bib', + 'dependencies' => {}, + 'change' => lastFileChange("$bibfile"), + }; + $self->{'files'}{$bblfile}{'dependencies'}{$bibfile} = undef; + } + } + } + } + } + } + } + closedir(*DIR); + + printDbgUnindent(); + + return undef; +} + +=pod + +=item * runLaTeX() + +Launch pdfLaTeX once time. + +=over 4 + +=item * C<file> is the name of the PDF or the TeX file to compile. + +=item * C<enableLoop> (optional boolean) indicates if this function may loop on the LaTeX compilation when it is requested by the LaTeX tool. + +=item * C<buffering_warnings> (optional boolean) indicates if the warnings are buffered or not. + +=back + +=cut +sub runLaTeX($;$$) : method { + my $self = shift; + my $file = shift; + my $linenumber = 0; + my $enableLoop = shift; + my $buffering_warnings = shift; + if ($self->{'files'}{$file}{'mainFile'}) { + $file = $self->{'files'}{$file}{'mainFile'}; + } + my $logFile = File::Spec->catfile(dirname($file), basename($file, '.tex').'.log'); + my $minNumberOfLaunchs = $self->{'configuration'}{'generation.post compilation runs'} || 1; + my $numberOfRuns = 0; + my $continueToCompile; + do { + printDbg(formatText(_T('{}: {}'), 'PDFLATEX', basename($file))); + $continueToCompile = 0; + $self->{'buffered_warnings'} = []; + $self->{'warnings'} = {}; + unlink($logFile); + my $exitcode; + if ($self->{'is_extended_warning_enable'}) { + local *OUTFILE; + open(*OUTFILE, ">autolatex_autogenerated.tex") or printErr("autolatex_ewarnings.tex: $!"); + my $code = $self->{'latex_warning_code'}; + $code =~ s/\Q::::REALFILENAME::::\E/$file/sg; + print OUTFILE $code."\n"; + print OUTFILE readFileLines($file); + close(*OUTFILE); + $exitcode = runCommandSilently( + @{$self->{'latex_cmd'}}, + $self->{'compiler_definition'}{'jobname'}, + basename($file, '.tex'), + 'autolatex_autogenerated.tex'); + unlink('autolatex_autogenerated.tex') if ($exitcode==0); + } + else { + $exitcode = runCommandSilently(@{$self->{'latex_cmd'}}, + $self->makeRelativePath($file)); + } + + local *LOGFILE; + + if ($exitcode!=0) { + printDbg(formatText(_T("{}: Error when processing {}"), 'PDFLATEX', basename($file))); + + # Parse the log to extract the blocks of messages + my $line; + my $fatal_error = undef; + my @log_blocks = (); + my $current_log_block = ''; + my $re_fatal_error = "\Q==>\E\\s*f\\s*a\\s*t\\s*a\\s*l\\s+e\\s*r\\s*r\\s*o\\s*r"; + open(*LOGFILE, "< $logFile") or printErr("$logFile: $!"); + while (*LOGFILE && ($line = <LOGFILE>) && !$fatal_error) { + my $is_empty_line = (!$line || $line =~/^\s*$/); + if ($is_empty_line) { + # Empty line => break the block + if ($current_log_block) { + if ($current_log_block =~ /^(.+):([0-9]+):/m) { + if ($current_log_block =~ /^\!\s*$re_fatal_error/si) { + $fatal_error = "\Q!\E[^!]"; + } + elsif ($current_log_block =~ /^(.+:[0-9]+:)\s*$re_fatal_error/si) { + $fatal_error = $1; + } + else { + push @log_blocks, $current_log_block; + } + } + elsif ($current_log_block =~ /^\!/m) { + push @log_blocks, $current_log_block; + } + } + $current_log_block = ''; + } + else { + $current_log_block .= $line; + } + } + close(*LOGFILE); + if ($current_log_block) { + if ($current_log_block =~ /^.+:[0-9]+:/m) { + if ($current_log_block =~ /^\!\s*$re_fatal_error/si) { + $fatal_error = "\Q!\E[^!]"; + } + elsif ($current_log_block =~ /^(.+:[0-9]+:)\s*$re_fatal_error/si) { + $fatal_error = $1; + } + else { + push @log_blocks, $current_log_block; + } + } + elsif ($current_log_block =~ /^\!/m) { + if ($current_log_block =~ /^\!\s*$re_fatal_error/si) { + $fatal_error = "\Q!\E[^!]"; + } + else { + push @log_blocks, $current_log_block; + } + } + } + # Search the fatal error inside the blocks + my $extracted_message = ''; + if ($fatal_error) { + # Parse the fatal error block to extract the filename + # where the error occured + if ($fatal_error =~ /^(.+?)\:([0-9]+)\:$/s) { + my ($candidate, $post) = ($1,$2); + my @candidates = split(/[\n\r]+/, $candidate); + $candidate = pop @candidates; + my $candidate_pattern = "\Q$candidate\E"; + while ($candidate && @candidates && ! -f "$candidate") { + my $l = pop @candidates; + $candidate_pattern = "\Q$l\E[\n\r]+$candidate_pattern"; + $candidate = $l.$candidate; + } + if ($candidate && -e "$candidate") { + $linenumber = int($post); + # Search the error message in the log. + $candidate_pattern .= "\Q:$post:\E"; + # Filtering the 'autogenerated' file + if ($self->{'is_extended_warning_enable'} && + basename($candidate) eq 'autolatex_autogenerated.tex') { + my $code = $self->{'latex_warning_code'}; + $candidate = $file; + $linenumber -= countLinesIn($code); + } + my $i = 0; + while (!$extracted_message && $i<@log_blocks) { + my $block = $log_blocks[$i]; + if ($block =~ /$candidate_pattern(.*)$/s) { + my $message_text = $1 || ''; + $extracted_message = trim($candidate.':'.$linenumber.':'.$message_text); + } + $i++; + } + if ($extracted_message) { + if (int($post)!=$linenumber) { + $extracted_message =~ s/^\Ql.$post\E/l.$linenumber/gm; + } + # Do not cut the words with carriage returns + $extracted_message =~ s/([a-z])[\n\r\f]([a-z])/$1$2/sgi; + $extracted_message =~ s/([a-z]) [\n\r\f]([a-z])/$1 $2/sgi; + $extracted_message =~ s/([a-z])[\n\r\f] ([a-z])/$1 $2/sgi; + } + } + } + else { + # Search the error message in the log. + my $candidate_pattern .= "$fatal_error"; + my $i = 0; + while (!$extracted_message && $i<@log_blocks) { + my $block = $log_blocks[$i]; + if ($block =~ /(?:^|\n|\r)$candidate_pattern\s*(.*)$/s) { + my $message = $1; + $linenumber = 0; + if ($message =~ /line\s+([0-9]+)/i) { + $linenumber = int($1); + } + $extracted_message = trim("$file:$linenumber: $message"); + } + $i++; + } + } + } + + # Display the message + if ($extracted_message) { + + # Test if the message is an emergency stop + if ($extracted_message =~ /^.*?:[0-9]+:\s*emergency\s+stop\./i) { + foreach my $block (@log_blocks) { + if ($block =~ /^\s*!\s*(.*?)\s*$/s) { + my $errmsg = "$1"; + $extracted_message .= "\n$errmsg"; + } + } + } + + printDbg(formatText(_T("{}: The first error found in the log file is:"), 'PDFLATEX')); + print STDERR "$extracted_message\n"; + printDbg(formatText(_T("{}: End of error log."), 'PDFLATEX')); + } + else { + print STDERR (formatText(_T("{}: Unable to extract the error from the log. Please read the log file."), 'PDFLATEX'))."\n"; + } + + exit(255); + } + elsif ($enableLoop) { + $numberOfRuns ++; + if ($numberOfRuns < $minNumberOfLaunchs) { + # Force a new run of the LaTeX tool. + printDbg(formatText(_T('{}: Forcing a new launch to reach {} on {}'), 'PDFLATEX', ($numberOfRuns + 1), $minNumberOfLaunchs)); + $continueToCompile = 1; + } + else { + ($continueToCompile,$enableLoop) = $self->_testLaTeXWarningInFile( + $logFile,$continueToCompile,$enableLoop); + } + } + } + while ($continueToCompile); + + if (!$buffering_warnings && $self->{'buffered_warnings'}) { + foreach my $w (@{$self->{'buffered_warnings'}}) { + print STDERR "$w"; + } + $self->{'buffered_warnings'} = []; + } + + return 0; +} + +sub _printWarning($$$$) : method { + my $self = shift; + my $filename = shift; + my $extension = shift; + my $line = shift; + my $message = shift; + if ($message =~ /^\s*latex\s+warning\s*\:\s*(.*)$/i) { + $message = "$1"; + } + if (!$self->{'buffered_warnings'}) { + $self->{'buffered_warnings'} = []; + } + push @{$self->{'buffered_warnings'}}, + "$filename:$line:warning: $message\n"; +} + +sub _testLaTeXWarningInFile($$$) : method { + my $self = shift; + my $logFile = shift; + my $continueToCompile = shift; + my $enableLoop = shift; + my $line; + my $warning = 0; + open(*LOGFILE, "< $logFile") or printErr("$logFile: $!"); + my $lastline = ''; + my $current_log_block = ''; + while (!$continueToCompile && ($line = <LOGFILE>)) { + $lastline .= $line; + if ($lastline =~ /\.\s*$/) { + if ($self->_testLaTeXWarningOn($lastline)) { + $continueToCompile = $enableLoop; + } + $lastline = ''; + } + # Parse and output the detailled warning messages + if ($self->{'warning_level'}>1) { + if ($warning) { + if ($line =~ /^\Q!!!![EndWarning]\E/) { + if ($current_log_block =~ /^(.*?):([^:]*):([0-9]+):\s*(.*?)\s*$/) { + my ($filename, $extension, $line, $message) = ($1, $2, $3, $4); + $self->_printWarning($filename, $extension, $line, $message); + } + $warning = 0; + $current_log_block = ''; + } + else { + my $l = $line; + if ($l !~ /\.\n+$/) { + $l =~ s/\s+//; + } + $current_log_block .= $l; + } + } + elsif ($line =~ /^\Q!!!![BeginWarning]\E(.*)$/) { + my $l = "$1"; + if ($l !~ /\.\n+$/) { + $l =~ s/\s+//; + } + $current_log_block = $l; + $warning = 1; + } + } + } + if ($lastline =~ /\.\s*$/ && $self->_testLaTeXWarningOn($lastline)) { + $continueToCompile = $enableLoop; + } + close(*LOGFILE); + # Output the detailled wanring message that was not already output + if ($warning && $current_log_block) { + if ($current_log_block =~ /^(.*?):([^:]*):([0-9]+):\s*(.*?)\s*$/) { + my ($filename, $extension, $line, $message) = ($1, $2, $3, $4); + $self->_printWarning($filename, $extension, $line, $message); + } + } + $self->{'warnings'}{'done'} = 1; + return ($continueToCompile,$enableLoop); +} + +sub _testLaTeXWarningOn($) : method { + my $self = shift; + my $line = shift; + my $oline = "$line"; + $line =~ s/[\n\r\t \f]+//g; + if ($line =~ /Warning.*re\-?run\s/i) { + return 1; + } + elsif ($line =~ /Warning:Therewereundefinedreferences/i) { + $self->{'warnings'}{'undefined_reference'} = 1; + } + elsif ($line =~ /Warning:Citation.+undefined/i) { + $self->{'warnings'}{'undefined_citation'} = 1; + } + elsif ($line =~ /Warning:Thereweremultiply\-definedlabels/i) { + $self->{'warnings'}{'multiple_definition'} = 1; + } + elsif ($line =~ /(?:\s|^)Warning/im) { + $self->{'warnings'}{'other_warning'} = 1; + } + return 0; +} + +=pod + +=item * build($) + +Build all the root files. + +=over 4 + +=item B<progress> (optional) is the progress indicator to use. + +=back + +=cut +sub build(;$) : method { + my $self = shift; + my $progress = shift; + + my $progValue; + if ($progress) { + my $numberOfRootFiles = @{$self->{'rootFiles'}}; + $progress->setMax($numberOfRootFiles*100); + $progValue = 0; + } + + foreach my $rootFile (@{$self->{'rootFiles'}}) { + + my $sprogress = undef; + if ($progress) { + $progress->setComment(formatText(_T("Generating {}"), basename($rootFile))); + $sprogress = $progress->subProgress(100); + $sprogress->setMax(1000); + } + + # Read building stamps + $self->_readBuildStamps($rootFile); + + $sprogress->setValue(10) if ($sprogress); + + # Launch at least one LaTeX compilation + $self->runLaTeX($rootFile,0,1); + + $sprogress->setValue(210) if ($sprogress); + + # Compute the dependencies of the file + $self->_computeDependenciesForRootFile($rootFile); + + $sprogress->setValue(260) if ($sprogress); + + # Construct the build list and launch the required builds + my @builds = $self->_buildExecutionList("$rootFile"); + + $sprogress->setValue(310) if ($sprogress); + + # Build the files + if (@builds) { + my $sprogStep = 600 / @builds; + foreach my $file (@builds) { + if ($sprogress) { + $sprogress->setComment(formatText(_T("Compiling {}"), basename($file))); + } + $self->_build($rootFile, $file); + $sprogress->increment($sprogStep) if ($sprogress); + } + } + + # Output the warnings from the last TeX builds + if ($self->{'buffered_warnings'}) { + foreach my $w (@{$self->{'buffered_warnings'}}) { + print STDERR "$w"; + } + $self->{'buffered_warnings'} = []; + } + + $sprogress->setValue(910) if ($sprogress); + + # Write building stamps + $self->_writeBuildStamps($rootFile); + + # Generate the Postscript file when requested + if (($self->{'configuration'}{'generation.generation type'}||'pdf') eq 'ps') { + my $dirname = dirname($rootFile); + my $basename = basename($rootFile, '.pdf', '.ps', '.dvi', '.xdv'); + my $dviFile = File::Spec->catfile($dirname, $basename.'.dvi'); + my $dviDate = lastFileChange("$dviFile"); + if (defined($dviDate)) { + my $psFile = File::Spec->catfile($dirname, $basename.'.ps'); + my $psDate = lastFileChange("$psFile"); + if (!$psDate || ($dviDate>=$psDate)) { + if ($sprogress) { + $sprogress->setComment(formatText(_T("Generating {}"), basename($psFile))); + } + printDbg(formatText(_T('{}: {}'), 'DVI2PS', basename($dviFile))); + runCommandOrFail(@{$self->{'dvi2ps_cmd'}}, + $self->makeRelativePath($dviFile)); + } + } + } + + if ($sprogress) { + $sprogress->setComment(formatText(_T("Analyzing logs for {}"), basename($rootFile))); + } + + # Compute the log filename + my $texFile = $self->{'files'}{$rootFile}{'mainFile'}; + my $logFile = File::Spec->catfile(dirname($texFile), basename($texFile, '.tex').'.log'); + + # Detect warnings if not already done + if (!%{$self->{'warnings'}}) { + $self->_testLaTeXWarningInFile($logFile, 0, 0); + } + + # Output the last LaTeX warning indicators. + if ($self->{'warning_level'}>0) { + if ($self->{'warnings'}{'multiple_definition'}) { + my $s = _T("LaTeX Warning: There were multiply-defined labels.\n"); + if ($self->{'is_extended_warning_enable'}) { + print STDERR "!!$logFile:W1: $s"; + } + else { + print STDERR "$s"; + } + } + if ($self->{'warnings'}{'undefined_reference'}) { + my $s = _T("LaTeX Warning: There were undefined references.\n"); + if ($self->{'is_extended_warning_enable'}) { + print STDERR "!!$logFile:W2: $s"; + } + else { + print STDERR "$s"; + } + } + if ($self->{'warnings'}{'undefined_citation'}) { + my $s = _T("LaTeX Warning: There were undefined citations.\n"); + if ($self->{'is_extended_warning_enable'}) { + print STDERR "!!$logFile:W3: $s"; + } + else { + print STDERR "$s"; + } + } + if ($self->{'warnings'}{'other_warning'}) { + my $texFile = $rootFile; + if ($self->{'files'}{$rootFile}{'mainFile'}) { + $texFile = $self->{'files'}{$rootFile}{'mainFile'}; + } + print STDERR formatText(_T("LaTeX Warning: Please look inside {} for the other the warning messages.\n"), + basename($logFile)); + } + } + + if ($progress) { + $progValue += 100; + $progress->setValue($progValue); + } + } + + $progress->stop() if ($progress); + + return undef; +} + +=pod + +=item * buildBiblio($) + +Launch the Biblio only. + +=over 4 + +=item B<progress> (optional) is the progress indicator to use. + +=back + +=cut +sub buildBiblio(;$) : method { + my $self = shift; + my $progress = shift; + + my $progValue; + if ($progress) { + my $numberOfRootFiles = @{$self->{'rootFiles'}}; + $progress->setMax($numberOfRootFiles*100); + $progValue = 0; + } + + foreach my $rootFile (@{$self->{'rootFiles'}}) { + + my $sprogress = undef; + if ($progress) { + $sprogress = $progress->subProgress(100); + $sprogress->setMax(1000); + } + + # Read building stamps + $self->_readBuildStamps($rootFile); + + $sprogress->setValue(10) if ($sprogress); + + # Compute the dependencies of the file + $self->_computeDependenciesForRootFile($rootFile); + + $sprogress->setValue(60) if ($sprogress); + + # Construct the build list and launch the required builds + my @builds = $self->_buildExecutionList("$rootFile",1); + + $sprogress->setValue(110) if ($sprogress); + + if (@builds) { + foreach my $file (@builds) { + if (exists $self->{'files'}{$file}) { + my $type = $self->{'files'}{$file}{'type'}; + if ($type eq 'bbl') { + my $func = $self->can('__build_'.lc($type)); + if ($func) { + $func->($self, $rootFile, $file, $self->{'files'}{$file}); + } + } + } + } + } + else { + printDbgFor(2, formatText(_T('{} is up-to-date.'), basename($rootFile))); + } + + $sprogress->setValue(990) if ($sprogress); + + # Write building stamps + $self->_writeBuildStamps($rootFile); + + if ($progress) { + $progValue += 100; + $progress->setValue($progValue); + } + } + + $progress->stop() if ($progress); + + return undef; +} + +=pod + +=item * buildMakeGlossaries($) + +Launch the MakeGlossaries only. + +=over 4 + +=item B<progress> (optional) is the progress indicator to use. + +=back + +=cut +sub buildMakeGlossaries(;$) : method { + my $self = shift; + my $progress = shift; + + my $progValue; + if ($progress) { + my $numberOfRootFiles = @{$self->{'rootFiles'}}; + $progress->setMax($numberOfRootFiles*100); + $progValue = 0; + } + + foreach my $rootFile (@{$self->{'rootFiles'}}) { + + my $sprogress = undef; + if ($progress) { + $sprogress = $progress->subProgress(100); + $sprogress->setMax(1000); + } + + # Read building stamps + $self->_readBuildStamps($rootFile); + + $sprogress->setValue(10) if ($sprogress); + + # Compute the dependencies of the file + $self->_computeDependenciesForRootFile($rootFile); + + $sprogress->setValue(60) if ($sprogress); + + # Construct the build list and launch the required builds + my @builds = $self->_buildExecutionList("$rootFile",1); + + $sprogress->setValue(110) if ($sprogress); + + if (@builds) { + foreach my $file (@builds) { + if (exists $self->{'files'}{$file}) { + my $type = $self->{'files'}{$file}{'type'}; + if ($type eq 'gls') { + my $func = $self->can('__build_'.lc($type)); + if ($func) { + $func->($self, $rootFile, $file, $self->{'files'}{$file}); + return undef; + } + } + } + } + } + else { + printDbgFor(2, formatText(_T('{} is up-to-date.'), basename($rootFile))); + } + + $sprogress->setValue(990) if ($sprogress); + + # Write building stamps + $self->_writeBuildStamps($rootFile); + + if ($progress) { + $progValue += 100; + $progress->setValue($progValue); + } + } + + $progress->stop() if ($progress); + + return undef; +} + +=pod + +=item * buildMakeIndex($) + +Launch the MakeIndex only. + +=over 4 + +=item B<progress> (optional) is the progress indicator to use. + +=back + +=cut +sub buildMakeIndex(;$) : method { + my $self = shift; + my $progress = shift; + + my $progValue; + if ($progress) { + my $numberOfRootFiles = @{$self->{'rootFiles'}}; + $progress->setMax($numberOfRootFiles*100); + $progValue = 0; + } + + foreach my $rootFile (@{$self->{'rootFiles'}}) { + + my $sprogress = undef; + if ($progress) { + $sprogress = $progress->subProgress(100); + $sprogress->setMax(1000); + } + + # Read building stamps + $self->_readBuildStamps($rootFile); + + $sprogress->setValue(10) if ($sprogress); + + # Compute the dependencies of the file + $self->_computeDependenciesForRootFile($rootFile); + + $sprogress->setValue(60) if ($sprogress); + + # Construct the build list and launch the required builds + my @builds = $self->_buildExecutionList("$rootFile",1); + + $sprogress->setValue(110) if ($sprogress); + + if (@builds) { + foreach my $file (@builds) { + if (exists $self->{'files'}{$file}) { + my $type = $self->{'files'}{$file}{'type'}; + if ($type eq 'ind') { + my $func = $self->can('__build_'.lc($type)); + if ($func) { + $func->($self, $rootFile, $file, $self->{'files'}{$file}); + return undef; + } + } + } + } + } + else { + printDbgFor(2, formatText(_T('{} is up-to-date.'), basename($rootFile))); + } + + $sprogress->setValue(990) if ($sprogress); + + # Write building stamps + $self->_writeBuildStamps($rootFile); + + if ($progress) { + $progValue += 100; + $progress->setValue($progValue); + } + } + + $progress->stop() if ($progress); + + return undef; +} + +# Read the building stamps. +# This function puts the stamps in $self->{'stamps'}. +# Parameter: +# $_[0] = path to the root TeX file. +# Result: nothing +sub _readBuildStamps($) : method { + my $self = shift; + my $rootFile = shift; + my $stampFile = File::Spec->catfile(dirname($rootFile), '.autolatex_stamp'); + if (exists $self->{'stamps'}) { + delete $self->{'stamps'}; + } + if (-r "$stampFile") { + local *FILE; + open(*FILE, "< $stampFile") or printErr("$stampFile: $!"); + while (my $line = <FILE>) { + if ($line =~ /^BIB\(([^)]+?)\)\:(.+)$/) { + my ($k,$n) = ($1,$2); + $self->{'stamps'}{'bib'}{$n} = $k; + } + if ($line =~ /^IDX\(([^)]+?)\)\:(.+)$/) { + my ($k,$n) = ($1,$2); + $self->{'stamps'}{'idx'}{$n} = $k; + } + if ($line =~ /^GLS\(([^)]+?)\)\:(.+)$/) { + my ($k,$n) = ($1,$2); + $self->{'stamps'}{'gls'}{$n} = $k; + } + } + close(*FILE); + } +} + +# Write the building stamps. +# This function gets the stamps from $self->{'stamps'}. +# Parameter: +# $_[0] = path to the root TeX file. +# Result: nothing +sub _writeBuildStamps($) : method { + my $self = shift; + my $rootFile = shift; + my $stampFile = File::Spec->catfile(dirname($rootFile), '.autolatex_stamp'); + local *FILE; + open(*FILE, "> $stampFile") or printErr("$stampFile: $!"); + if ($self->{'stamps'}{'bib'}) { + while (my ($k,$v) = each(%{$self->{'stamps'}{'bib'}})) { + print FILE "BIB($v):$k\n"; + } + } + if ($self->{'stamps'}{'idx'}) { + while (my ($k,$v) = each(%{$self->{'stamps'}{'idx'}})) { + print FILE "IDX($v):$k\n"; + } + } + if ($self->{'stamps'}{'gls'}) { + while (my ($k,$v) = each(%{$self->{'stamps'}{'gls'}})) { + print FILE "GLS($v):$k\n"; + } + } + close(*FILE); +} + +# Static function that is testing if the timestamp a is +# more recent than the timestamp b. +# Parameters: +# $_[0] = a. +# $_[1] = b. +# Result: true if a is more recent than b, or not defined; +# false otherwise. +sub _a_more_recent_than_b($$) { + my $a = shift; + my $b = shift; + return (!defined($a) || (defined($b) && $a>$b)); +} + +# Test if the specified file is needing to be rebuild. +# Parameters: +# $_[0] = timestamp of the root file. +# $_[1] = filename of the file to test. +# $_[2] = parent element of the file, of type Entry. +# $_[3] = is the description of the file to test. +# Result: true if the file is needing to be rebuild, +# false if the file is up-to-date. +sub _need_rebuild($$$$) : method { + my $self = shift; + my $rootchange = shift; + my $filename = shift; + my $parent = shift; + my $file = shift; + if (!defined($file->{'change'}) || (!-f "$filename")) { + return 1; + } + + if ($filename =~ /(\.[^.]+)$/) { + my $ext = $1; + if ($ext eq '.bbl') { + if ($file->{'use_biber'}) { + # Parse the BCF file to detect the citations + my $bcfFile = File::Spec->catfile(dirname($filename), basename($filename, '.bbl').'.bcf'); + my $currentMd5 = makeBcfBibliographyCitationMd5($bcfFile) || ''; + my $oldMd5 = $self->{'stamps'}{'bib'}{$bcfFile} || ''; + if ($currentMd5 ne $oldMd5) { + $self->{'stamps'}{'bib'}{$bcfFile} = $currentMd5; + return 1; + } + } + else { + # Parse the AUX file to detect the citations + my $auxFile = File::Spec->catfile(dirname($filename), basename($filename, '.bbl').'.aux'); + my $currentMd5 = makeAuxBibliographyCitationMd5($auxFile) || ''; + my $oldMd5 = $self->{'stamps'}{'bib'}{$auxFile} || ''; + if ($currentMd5 ne $oldMd5) { + $self->{'stamps'}{'bib'}{$auxFile} = $currentMd5; + return 1; + } + } + return 0; + } + elsif ($ext eq '.ind') { + # Parse the IDX file to detect the index definitions + my $idxFile = File::Spec->catfile(dirname($filename), basename($filename, '.ind').'.idx'); + my $currentMd5 = makeIdxIndexDefinitionMd5($idxFile) || ''; + my $oldMd5 = $self->{'stamps'}{'idx'}{$idxFile} || ''; + if ($currentMd5 ne $oldMd5) { + $self->{'stamps'}{'idx'}{$idxFile} = $currentMd5; + return 1; + } + return 0; + } + elsif ($ext eq '.gls') { + # Parse the GLS file to detect the index definitions + my $glsFile = File::Spec->catfile(dirname($filename), basename($filename, '.pdf').'.gls'); + my $currentMd5 = makeGlsIndexDefinitionMd5($glsFile) || ''; + my $oldMd5 = $self->{'stamps'}{'gls'}{$glsFile} || ''; + if ($currentMd5 ne $oldMd5) { + $self->{'stamps'}{'gls'}{$glsFile} = $currentMd5; + return 1; + } + return 0; + } + } + + return _a_more_recent_than_b( $file->{'change'}, $rootchange ); +} + +# Build the list of the files to be build. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = boolean value that permits to force to consider all the files has changed. +# Result: the build list. +sub _buildExecutionList($;$) : method { + my $self = shift; + my $rootfile = shift; + my $forceChange = shift; + my @builds = (); + + # Go through the dependency tree with en iterative algorithm + + my $rootchange = $self->{'files'}{$rootfile}{'change'}; + my $element = newEntry($rootfile,undef) ; + my $child; + my @iterator = ( $element ); + while (@iterator) { + $element = pop @iterator; + my $deps = $self->{'files'}{$element->file}{'dependencies'}; + if ($element->go_up || !%$deps) { + if ( $forceChange || + $element->rebuild || + $self->_need_rebuild( + $rootchange, + $element->file, + $element->parent, + $self->{'files'}{$element->file})) { + + if ($element->parent) { + $element->parent->rebuild(1); + } + + if ($self->can('__build_'.lc($self->{'files'}{$element->file}{'type'}))) { + push @builds, $element->file; + } + + } + } + else { + push @iterator, $element; + foreach my $dep (keys %$deps) { + $child = newEntry($dep,$element); + push @iterator, $child; + } + $element->go_up(1); + } + } + return @builds; +} + +# Run the building process. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = name of the file to build (the root file or one of its dependencies). +# Result: nothing. +sub _build($$) : method { + my $self = shift; + my $rootFile = shift; + my $file = shift; + + if (exists $self->{'files'}{$file}) { + my $type = $self->{'files'}{$file}{'type'}; + if ($type) { + my $func = $self->can('__build_'.lc($type)); + if ($func) { + $func->($self, $rootFile, $file, $self->{'files'}{$file}); + return undef; + } + } + } + + # Default building behavior: do nothing + return undef; +} + +sub __find_file_with_basename($) { + my $self = shift; + my $basename = shift; + if (%{$self->{'files'}}) { + foreach my $k (keys %{$self->{'files'}}) { + my $bn = basename($k); + if ($bn eq $basename) { + return File::Spec->abs2rel($k, + $self->{'configuration'}{'__private__'}{'input.project directory'}); + } + } + } + return $basename; +} + +# Callback to build a BBL file. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = name of the file to build (the root file or one of its dependencies). +# $_[2] = description of the file to build. +# Result: nothing. +sub __build_bbl($$$) : method { + my $self = shift; + my $rootFile = shift; + my $file = shift; + my $filedesc = shift; + if ($self->{'is_biblio_enable'}) { + my $basename = basename($file,'.bbl'); + if ($filedesc->{'use_biber'}) { + #################################### + # BIBER + #################################### + printDbg(formatText(_T('{}: {}'), 'BIBER', basename($basename))); + my $retcode = runCommandRedirectToInternalLogs( + @{$self->{'biber_cmd'}}, "$basename"); + # Output the log from the bibliography tool + if ($retcode!=0) { + printDbg(formatText(_T("{}: Error when processing {}"), 'BIBER', $basename)); + local *INFILE; + open(*INFILE, "<autolatex_exec_stdout.log") or printErr("autolatex_exec_stdout.log: $!"); + while (my $line = <INFILE>) { + if ($line =~ /^\s*ERROR\s*\-\s*.*subsystem:\s*(.+?),\s*line\s+([0-9]+),\s*(.*?)\s*$/i) { + my ($filename, $linenumber, $message) = ($1, $2, $3); + if ($filename =~ /^(.+)_[0-9]+\.[a-zA-Z0-9_-]+$/) { + $filename = $1; + } + $filename = $self->__find_file_with_basename(basename($filename)); + print STDERR "$filename:$linenumber: $message\n"; + } + elsif ($line =~ /^\s*ERROR\s*\-\s*(.+?)\s*$/i) { + my $message = $1; + print STDERR "$message\n"; + } + } + close(*INFILE); + exit(255); + } + else { + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + } + } + else { + #################################### + # BIBTEX + #################################### + my $auxFile = File::Spec->catfile(dirname($file),"$basename.aux"); + printDbg(formatText(_T('{}: {}'), 'BIBTEX', basename($auxFile))); + my $retcode = runCommandRedirectToInternalLogs( + @{$self->{'bibtex_cmd'}}, + $self->makeRelativePath("$auxFile")); + + # Output the log from the bibliography tool + if ($retcode!=0) { + + printDbg(formatText(_T("{}: Error when processing {}"), 'BIBTEX', basename($auxFile))); + local *INFILE; + open(*INFILE, "<autolatex_exec_stdout.log") or printErr("autolatex_exec_stdout.log: $!"); + my %currentError = (); + my $previousline = ''; + while (my $line = <INFILE>) { + if (%currentError) { + if ($line =~ /^\s*:\s*(.*?)\s*$/) { + $currentError{'message'} .= " $1"; + } + else { + print STDERR $currentError{'filename'}.':'.$currentError{'lineno'}.': '.$currentError{'message'}."\n"; + %currentError = (); + } + } + elsif ($line =~ /^\s*(.*?)\s*\-\-\-line\s+([0-9]+)\s+of\s+file\s+(.*?)\s*$/i) { + my ($message, $linenumber, $filename) = ($1, $2, $3); + if (!$message) { + $message = $previousline; + $message =~ s/^\s+//s; + $message =~ s/\s+$//s; + } + %currentError = ( + 'filename' => $filename, + 'lineno' => $linenumber, + 'message' => $message, + ); + $previousline = ''; + } + else { + $previousline = $line; + %currentError = (); + } + } + close(*INFILE); + if (%currentError) { + print STDERR $currentError{'filename'}.':'. + $currentError{'lineno'}.': '.$currentError{'message'}."\n"; + } + exit(255); + } + else { + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + } + } + } +} + +# Callback to build a IND file. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = name of the file to build (the root file or one of its dependencies). +# $_[2] = description of the file to build. +# Result: nothing. +sub __build_ind($$$) : method { + my $self = shift; + my $rootFile = shift; + my $file = shift; + my $filedesc = shift; + if ($self->{'is_makeindex_enable'}) { + my $basename = basename($file,'.ind'); + my $idxFile = File::Spec->catfile(dirname($file),"$basename.idx"); + if (-f "$idxFile") { + printDbg(formatText(_T('{}: {}'), 'MAKEINDEX', basename($idxFile))); + my @styleArgs = (); + my $istFile = $self->{'configuration'}{'__private__'}{'output.ist file'}; + if ($istFile && -f "$istFile") { + printDbgFor(2, formatText(_T('Style file: {}'), $istFile)); + push @styleArgs, '-s', "$istFile"; + } + runCommandOrFail(@{$self->{'makeindex_cmd'}}, @styleArgs, + $self->makeRelativePath("$idxFile")); + } + } +} + +# Callback to build a GLS file. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = name of the file to build (the root file or one of its dependencies). +# $_[2] = description of the file to build. +# Result: nothing. +sub __build_gls($$$) : method { + my $self = shift; + my $rootFile = shift; + my $file = shift; + my $filedesc = shift; + if ($self->{'is_makeglossaries_enable'}) { + my $filename = File::Spec->catfile(dirname($rootFile), basename($rootFile,'.pdf')); + $filename = $self->makeRelativePath("$filename"); + printDbg(formatText(_T('{}: {}'), 'MAKEGLOSSARIES', basename($rootFile))); + runCommandOrFail(@{$self->{'makeglossaries_cmd'}}, "$filename"); + } +} + +# Callback to build a PDF file. +# Parameters: +# $_[0] = name of the root file that should be build. +# $_[1] = name of the file to build (the root file or one of its dependencies). +# $_[2] = description of the file to build. +# Result: nothing. +sub __build_pdf($$$) : method { + my $self = shift; + my $rootFile = shift; + my $file = shift; + my $filedesc = shift; + my $runs = 2; + my $majorFailure = 0; + do { + $runs--; + $self->runLaTeX($file,1,1); + $majorFailure = (exists $self->{'warnings'}{'multiple_definition'}) || + (exists $self->{'warnings'}{'undefined_reference'}) || + (exists $self->{'warnings'}{'undefined_citation'}); + } + while ($majorFailure && $runs>0); +} + +=pod + +=item * enableBiblio + +Enable or disable the call to bibtex/biber. +If this function has a parameter, the flag is changed. + +=over + +=item * isEnable (optional boolean) + +=back + +I<Returns:> the value of the enabling flag. + +=cut +sub enableBiblio : method { + my $self = shift; + if (@_) { + $self->{'is_biblio_enable'} = $_[0]; + } + return $self->{'is_biblio_enable'}; +} + +=pod + +=item * enableMakeIndex + +Enable or disable the call to makeindex. +If this function has a parameter, the flag is changed. + +=over + +=item * isEnable (optional boolean) + +=back + +I<Returns:> the vlaue of the enabling flag. + +=cut +sub enableMakeIndex : method { + my $self = shift; + if (@_) { + $self->{'is_makeindex_enable'} = $_[0]; + } + return $self->{'is_makeindex_enable'}; +} + +=pod + +=item * enableMakeGlossaries + +Enable or disable the call to makeglossaries. +If this function has a parameter, the flag is changed. + +=over + +=item * isEnable (optional boolean) + +=back + +I<Returns:> the vlaue of the enabling flag. + +=cut +sub enableMakeGlossaries : method { + my $self = shift; + if (@_) { + $self->{'is_makeglossaries_enable'} = $_[0]; + } + return $self->{'is_makeglossaries_enable'}; +} + +=pod + +=item * generationType + +Get or change the type of generation. +If this function has a parameter, the type is changed. + +=over + +=item * type (optional string) + +C<"pdf"> to use pdflatex, C<"dvi"> to use latex, C<"ps"> to use latex and dvips, C<"pspdf"> to use latex, dvips and ps2pdf. + +=back + +I<Returns:> the generation type. + +=cut +sub generationType : method { + my $self = shift; + if (@_) { + my $type = $_[0] || 'pdf'; + if ($type ne 'dvi' && $type ne 'ps' && $type ne 'pdf') { + $type = 'pdf'; + } + $self->{'generation_type'} = $type; + } + return $self->{'generation_type'}; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bug, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013-2016 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/BibCitationAnalyzer.pm b/support/autolatex/pm/AutoLaTeX/TeX/BibCitationAnalyzer.pm new file mode 100644 index 0000000000..bae9cfe2c4 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/BibCitationAnalyzer.pm @@ -0,0 +1,307 @@ +# autolatex - BibCitationAnalyzer.pm +# Copyright (C) 2013-14 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +BibCitationAnalyzer.pm - Extract bibliography citation from a AUX file. + +=head1 DESCRIPTION + +Tool that is extracting the bibliography citations from a AUX file. + +To use this library, type C<use AutoLaTeX::TeX::BibCitationAnalyzer;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::BibCitationAnalyzer; + +$VERSION = '4.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getAuxBibliographyData &getAuxBibliographyCitations &makeAuxBibliographyCitationMd5 + &getBcfBibliographyCitations &makeBcfBibliographyCitationMd5 ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::Spec; +use File::Basename; +use Digest::MD5 qw(md5_base64); + +use AutoLaTeX::Core::Util; +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'citation' => '[]!{}', + 'bibcite' => '[]!{}', + 'bibdata' => '[]!{}', + 'bibstyle' => '[]!{}', + ); + +=pod + +=item B<getAuxBibliographyData($)> + +Parse an aux file and extract the bibliography data. + +=over 4 + +=item * C<auxfile> is the name of the AUX file to parse. + +=back + +I<Returns:> an associative array with the keys 'citations', 'databases', and 'styles'. + +=cut +sub getAuxBibliographyData($) { + my $input = shift; + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::BibCitationAnalyzer->_new($input); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + my @citations = keys %{$listener->{'citations'}}; + @citations = sort @citations; + my @databases = keys %{$listener->{'databases'}}; + my @styles = keys %{$listener->{'styles'}}; + my %data = ( + 'citations' => \@citations, + 'databases' => \@databases, + 'styles' => \@styles, + ); + + return %data; +} + +=pod + +=item B<getAuxBibliographyCitations($)> + +Parse an aux file and extract the bibliography citations. + +=over 4 + +=item * C<auxfile> is the name of the AUX file to parse. + +=back + +I<Returns:> the included files from the TeX file into an associative array. + +=cut +sub getAuxBibliographyCitations($) { + my $input = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::BibCitationAnalyzer->_new($input); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + my @citations = keys %{$listener->{'citations'}}; + @citations = sort @citations; + + return @citations; +} + +=pod + +=item B<getBcfBibliographyCitations($)> + +Parse a BCF (biblatex) file and extract the bibliography citations. + +=over 4 + +=item * C<bcffile> is the name of the BCF file to parse. + +=back + +I<Returns:> the included files from the TeX file into an associative array. + +=cut +sub getBcfBibliographyCitations($) { + my $input = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my @citations = (); + + while ($content =~ /\Q<bcf:citekey>\E(.+?)\Q<\/bcf:citekey>\E/gs) { + push @citations, "$1"; + } + + @citations = sort @citations; + + return @citations; +} + +=pod + +=item B<makeAuxBibliographyCitationMd5($)> + +Parse an aux file, extract the bibliography citations, and build a MD5. + +=over 4 + +=item * C<auxfile> is the name of the AUX file to parse. + +=back + +I<Returns:> the MD5 of the citations. + +=cut +sub makeAuxBibliographyCitationMd5($) { + my @citations = getAuxBibliographyCitations($_[0]); + return md5_base64(@citations); +} + +=pod + +=item B<makeBsfBibliographyCitationMd5($)> + +Parse an BCF (biblatex) file, extract the bibliography citations, and build a MD5. + +=over 4 + +=item * C<bcffile> is the name of the BCF file to parse. + +=back + +I<Returns:> the MD5 of the citations. + +=cut +sub makeBcfBibliographyCitationMd5($) { + my @citations = getBcfBibliographyCitations($_[0]); + return md5_base64(@citations); +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + if ($macro eq '\\bibdata') { + if ($_[1]->{'text'}) { + foreach my $bibdb (split(/\s*,\s*/, $_[1]->{'text'})) { + if ($bibdb) { + $self->{'databases'}{$bibdb} = 1; + } + } + } + } + elsif ($macro eq '\\bibstyle') { + if ($_[1]->{'text'}) { + foreach my $bibdb (split(/\s*,\s*/, $_[1]->{'text'})) { + if ($bibdb) { + $self->{'styles'}{$bibdb} = 1; + } + } + } + } + elsif ($_[1]->{'text'}) { + foreach my $bibdb (split(/\s*,\s*/, $_[1]->{'text'})) { + if ($bibdb) { + $self->{'citations'}{$bibdb} = 1; + } + } + } + return ''; +} + +sub _new($) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'basename' => basename($_[0],'.tex'), + 'file' => $_[0], + 'expandMacro' => \&_expandMacro, + 'citations' => {}, + 'databases' => {}, + 'styles' => {}, + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/DocumentDetector.pm b/support/autolatex/pm/AutoLaTeX/TeX/DocumentDetector.pm new file mode 100644 index 0000000000..03e125a245 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/DocumentDetector.pm @@ -0,0 +1,145 @@ +# autolatex - DocumentDetector.pm +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +DocumentDetector.pm - Detect if a TeX file contains a LaTeX document. + +=head1 DESCRIPTION + +Tool that is parsing a TeX file and detect if \documentclass is inside. + +To use this library, type C<use AutoLaTeX::TeX::DocumentDetector;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::DocumentDetector; + +$VERSION = '1.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &isLaTeXDocument ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'documentclass' => '![]!{}', + ); + +=pod + +=item B<isLaTeXDocument($)> + +Replies if the given file is a LaTeX document, ie. +a text file that contains \documentclass. + +=over 4 + +=item * C<file> is the name of the file to parse. + +=back + +I<Returns:> true if the file is a LaTeX document; +false otherwise. + +=cut +sub isLaTeXDocument($) { + my $input = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::DocumentDetector->_new(); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + return $listener->{'isLaTeXDocument'}; +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + if ($macro eq '\\documentclass' ) { + $self->{'isLaTeXDocument'} = 1; + $parser->stop(); + } + return ''; +} + +sub _new() : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'expandMacro' => \&_expandMacro, + 'isLaTeXDocument' => 0, + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/Flattener.pm b/support/autolatex/pm/AutoLaTeX/TeX/Flattener.pm new file mode 100644 index 0000000000..b78b16e3f2 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/Flattener.pm @@ -0,0 +1,594 @@ +# autolatex - Flattener.pm +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Flattener.pm - Make a TeX document flatten + +=head1 DESCRIPTION + +This tool creates a flattened version of a TeX document. +A flattened document contains a single TeX file, and all the +other related files are put inside the same directory of +the TeX file. + +To use this library, type C<use AutoLaTeX::TeX::Flattener;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::Flattener; + +$VERSION = '7.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &flattenTeX ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration + +use File::Spec; +use File::Basename; +use File::Copy; +use File::Path qw(make_path remove_tree); + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'input' => '!{}', + 'include' => '!{}', + 'usepackage' => '![]!{}', + 'RequirePackage' => '![]!{}', + 'documentclass' => '![]!{}', + 'includeanimatedfigure' => '![]!{}', + 'includeanimatedfigurewtex' => '![]!{}', + 'includefigurewtex' => '![]!{}', + 'includegraphics' => '![]!{}', + 'includegraphicswtex' => '![]!{}', + 'graphicspath' => '![]!{}', + 'mfigure' => '![]!{}!{}!{}!{}', + 'mfigure*' => '![]!{}!{}!{}!{}', + 'msubfigure' => '![]!{}!{}!{}', + 'msubfigure*' => '![]!{}!{}!{}', + 'mfiguretex' => '![]!{}!{}!{}!{}', + 'mfiguretex*' => '![]!{}!{}!{}!{}', + 'addbibresource' => '![]!{}', + ); + +=pod + +=item B<flattenTeX($$\@$)> + +This functions creates a flattened version of a TeX document. +A flattened document contains a single TeX file, and all the +other related files are put inside the same directory of +the TeX file. + +=over 4 + +=item * C<rootTex> is the name of the TeX file to parse. + +=item * C<outputDir> is the name of the output directory. + +=item * C<images> is the array that lists the images of the document. + +=item * C<usebiblio> indicates if the flattener should use Bibliography instead of inline bibliography. + +=back + +=cut +sub flattenTeX($$\@$) { + my $input = shift; + my $output = shift; + my $imageDb = shift; + my $usebiblio = shift; + return '' unless ($output); + + if (-d "$output") { + remove_tree("$output"); + } + + make_path("$output") or printErr(formatText(_T("{}: {}"), $output, $!)); + + printDbg(formatText(_T('Analysing {}'), basename($input))); + my $content = readFileLines("$input"); + + my $listener = AutoLaTeX::TeX::Flattener->_new($input, $output, $imageDb, $usebiblio); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + # Replace PREAMBLE content + if ($listener->{'data'}{'expandedContent'}) { + my $preamble = ''; + foreach my $entry (values %{$listener->{'preamble'}}) { + if ($preamble) { + $preamble .= "\n"; + } + $preamble .= $entry; + } + $listener->{'data'}{'expandedContent'} =~ s/\Q%%%%% AUTOLATEX PREAMBLE\E/$preamble/; + } + + # Create the main TeX file + my $outputFile = File::Spec->catfile($output, basename($input)); + printDbg(formatText(_T('Writing {}'), basename($outputFile))); + writeFileLines($outputFile, $listener->{'data'}{'expandedContent'}); + + # Make the copy of the resources + foreach my $cat ('bib', 'cls', 'bst', 'sty', 'figures') { + while (my ($source, $target) = each(%{$listener->{'data'}{$cat}})) { + $target = File::Spec->catfile("$output", "$target"); + printDbg(formatText(_T('Copying resource {} to {}'), basename($source), basename($target))); + copy("$source", "$target") or printErr(formatText(_T("{} -> {}: {}"), $source, $target, $!)); + } + } +} + +sub _makeFilename($$;@) { + my $self = shift; + my $fn = shift || ''; + my $ext = shift || ''; + my $changed; + do { + $changed = 0; + foreach my $e (@_) { + if ($fn =~ /^(.+)\Q$e\E$/i) { + $fn = $1; + $changed = 1; + } + } + } + while ($changed); + if ($ext && $fn !~ /\Q$ext\E$/i) { + $fn .= $ext; + } + if (!File::Spec->file_name_is_absolute($fn)) { + return File::Spec->catfile($self->{'dirname'}, $fn); + } + return $fn; +} + +sub _isDocumentFile($) { + my $self = shift; + my $filename = shift; + if (-f "$filename") { + my $root = $self->{'dirname'}; + return "$filename" =~ /^\Q$root\E/s; + } + return 0; +} + +sub _isDocumentPicture($) { + my $self = shift; + my $filename = shift; + return 0; +} + +sub _uniq($$) { + my $self = shift; + my $filename = shift; + my $ext = shift; + my $bn = basename($filename, $ext); + my $name = $bn; + my $i = 0; + while (exists $self->{'data'}{'uniq'}{"$name$ext"}) { + $name = "${bn}_$i"; + $i++; + } + $self->{'data'}{'uniq'}{"$name$ext"} = $filename; + return $name; +} + +sub _findPicture($) { + my $self = shift; + my $texname = shift; + my $prefix = ''; + my $filename = $self->_makeFilename($texname,''); + my @texexts = ('.pdftex_t','.pstex_t','.pdf_tex','.ps_tex','.tex'); + if (!-f $filename) { + my @figexts = ( '.pdf', '.eps', '.ps', + '.png', '.jpeg', '.jpg', '.gif', '.bmp'); + my @exts = (@figexts,@texexts); + my $ofilename = $filename; + + # Search if the registered images + my $template = basename($filename, @exts); + my %filenames = (); + if ($self->{'images'}) { + my $ext; + for(my $k=0; $k<@{$self->{'includepaths'}}; $k++) { + my $path = $self->{'includepaths'}[$k]; + for(my $j=0; $j<@{$self->{'images'}}; $j++) { + my $img = $self->{'images'}[$j]; + for(my $i=0; $i<@figexts; $i++) { + $ext = $figexts[$i]; + my $fullname = File::Spec->catfile($path,"$template$ext"); + $fullname = $self->_makeFilename($fullname,''); + if (-f $fullname) { + $filenames{$fullname} = 0; + } + } + for(my $i=0; $i<@texexts; $i++) { + $ext = $texexts[$i]; + my $fullname = File::Spec->catfile($path,"$template$ext"); + $fullname = $self->_makeFilename($fullname,''); + if (-f $fullname) { + $filenames{$fullname} = 1; + } + } + } + } + } + + if (!%filenames) { + # Search in the folder, from the document directory. + $template = File::Spec->catfile(dirname($ofilename), basename($ofilename, @exts)); + my $ext; + for(my $i=0; $i<@figexts; $i++) { + $ext = $figexts[$i]; + my $fn = "$template$ext"; + if (-f $fn) { + $filenames{$fn} = 0; + } + } + for(my $i=0; $i<@texexts; $i++) { + $ext = $texexts[$i]; + my $fn = "$template$ext"; + if (-f $fn) { + $filenames{$fn} = 1; + } + } + } + + if (!%filenames) { + printErr(formatText(_T('Picture not found: {}'), $texname)); + } + else { + my $ext; + my @selectedName1 = (); + my $selectedName2 = undef; + foreach $filename (keys %filenames) { + $filename =~ /(\.[^.]+)$/s; + $ext = $1 || ''; + $texname = $self->_uniq($filename, $ext).$ext; + if ($filenames{$filename}) { + if (!@selectedName1) { + @selectedName1 = ($texname,$filename); + } + } + else { + $self->{'data'}{'figures'}{$filename} = $texname; + $selectedName2 = $texname; + } + } + if (@selectedName1) { + ($texname, $filename) = @selectedName1; + printDbg(formatText(_T('Embedding {}'), $filename)); + my $filecontent = readFileLines("$filename"); + # Replacing the filename in the TeX file + while (my ($localFile, $texfile) = each(%{$self->{'data'}{'figures'}})) { + $filecontent =~ s/\Q$localFile\E/$texfile/g; + } + $prefix .="%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% BEGIN FILE: ".basename($texname)."\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "\\begin{filecontents*}{".basename($texname)."}\n". + $filecontent. + "\\end{filecontents*}\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n\n\n"; + $self->{'preamble'}{'filecontents'} = "\\usepackage{filecontents}"; + } + elsif ($selectedName2) { + $texname = $selectedName2; + } + } + } + else { + $texname =~ /(\.[^.]+)$/s; + my $ext = $1 || ''; + $texname = $self->_uniq($filename, $ext).$ext; + if (!arrayContains(@texexts, $ext)) { + $self->{'data'}{'figures'}{$filename} = $texname; + } + } + + return ($texname,$prefix); +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + + if ( $macro eq '\\usepackage' || $macro eq '\\RequirePackage') { + my $texname = $_[1]->{'text'}; + my $filename = $self->_makeFilename("$texname", '.sty'); + + my $ret = ''; + + if ($texname eq 'biblatex') { + if (!$self->{'usebiblio'}) { + my $filename = $self->_makeFilename($self->{'basename'}, '.bbl', '.tex'); + if (-f "$filename") { + printDbg(formatText(_T('Embedding {}'), $filename)); + $self->{'preamble'}{'filecontents'} = "\\usepackage{filecontents}"; + $ret .="%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% BEGIN FILE: ".basename($filename)."\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "\\begin{filecontents*}{".basename($filename)."}\n". + readFileLines("$filename"). + "\\end{filecontents*}\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n\n\n"; + } + else { + printErr(formatText(_T('File not found: {}'), $filename)); + } + } + } + elsif ($self->_isDocumentFile($filename)) { + printDbg(formatText(_T('Embedding {}'), $filename)); + $self->{'preamble'}{'filecontents'} = "\\usepackage{filecontents}"; + $ret .="%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% BEGIN FILE: ".basename($filename)."\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "\\begin{filecontents*}{".basename($filename)."}\n". + readFileLines("$filename"). + "\\end{filecontents*}\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n\n\n"; + } + $ret .= $macro; + $ret .= '['.$_[0]->{'text'}.']' if ($_[0]->{'text'}); + $ret .= '{'.$texname.'}'; + return $ret; + } + elsif ( $macro eq '\\documentclass') { + my $texname = $_[1]->{'text'}; + my $filename = $self->_makeFilename("$texname", '.cls'); + if ($self->_isDocumentFile($filename)) { + $texname = $self->_uniq($filename,'.cls'); + $self->{'data'}{'cls'}{$filename} = "$texname.cls"; + } + my $ret = $macro; + $ret .= '['.$_[0]->{'text'}.']' if ($_[0]->{'text'}); + $ret .= '{'.$texname.'}'; + $ret .= "\n\n%%%%% AUTOLATEX PREAMBLE\n\n"; + return $ret; + } + elsif ( ($macro eq '\\includegraphics') + || ($macro eq '\\includeanimatedfigure') + || ($macro eq '\\includeanimatedfigurewtex') + || ($macro eq '\\includefigurewtex') + || ($macro eq '\\includegraphicswtex')) { + my ($texname,$prefix) = $self->_findPicture($_[1]->{'text'}); + my $ret = $prefix.$macro; + $ret .= '['.$_[0]->{'text'}.']' if ($_[0]->{'text'}); + $ret .= '{'.$texname.'}'; + return $ret; + } + elsif ( $macro eq '\\graphicspath') { + my @paths = (); + my $t = $_[1]->{'text'}; + while ($t && $t =~ /^\s*(?:(?:\{([^\}]+)\})|([^,]+))\s*[,;]?\s*(.*)$/g) { + my $prev = "$t"; + (my $path, $t) = (($1||$2), $3); + push @paths, "$path"; + } + unshift @{$self->{'includepaths'}}, @paths; + return '\\graphicspath{{.}}'; + } + elsif ( $macro eq '\\mfigure' || $macro eq '\\mfigure*' || + $macro eq '\\mfiguretex' || $macro eq '\\mfiguretex*') { + my ($texname,$prefix) = $self->_findPicture($_[2]->{'text'}); + my $ret = $prefix.$macro; + $ret .= '['.$_[0]->{'text'}.']' if ($_[0]->{'text'}); + $ret .= '{'.$_[1]->{'text'}.'}'; + $ret .= '{'.$texname.'}'; + $ret .= '{'.$_[3]->{'text'}.'}'; + $ret .= '{'.$_[4]->{'text'}.'}'; + return $ret; + } + elsif ( $macro eq '\\msubfigure' || $macro eq '\\msubfigure*') { + my ($texname,$prefix) = $self->_findPicture($_[2]->{'text'}); + my $ret = $prefix.$macro; + $ret .= '['.$_[0]->{'text'}.']' if ($_[0]->{'text'}); + $ret .= '{'.$_[1]->{'text'}.'}'; + $ret .= '{'.$texname.'}'; + $ret .= '{'.$_[3]->{'text'}.'}'; + return $ret; + } + elsif ( $macro eq '\\include' || $macro eq '\\input') { + my $filename = $self->_makeFilename($_[0]->{'text'},'.tex'); + my $subcontent = readFileLines($filename); + $subcontent .= "\n%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% END FILE: $filename\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n\n"; + + $parser->putBack($subcontent); + return "\n\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% BEGIN FILE: $filename\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; + } + elsif ($macro =~ /^\\bibliographystyle(.*)$/s ) { + if ($self->{'usebiblio'}) { + my $bibdb = $1; + $bibdb = $self->{'basename'} unless ($bibdb); + my $texname = $_[0]->{'text'}; + my $filename = $self->_makeFilename("$texname", '.bst'); + if ($self->_isDocumentFile($filename)) { + $texname = $self->_uniq($filename,'.bst'); + $self->{'data'}{'bst'}{$filename} = "$texname.bst"; + } + my $ret = $macro; + $ret .= '{'.$texname.'}'; + return $ret; + } + return ''; + } + elsif ($macro =~ /^\\bibliography(.*)$/s ) { + my $bibdb = $1; + $bibdb = $self->{'basename'} unless ($bibdb); + if ($self->{'usebiblio'}) { + my $texname = $_[0]->{'text'}; + my $filename = $self->_makeFilename("$texname",'.bib'); + if ($self->_isDocumentFile($filename)) { + $texname = $self->_uniq($filename,'.bib'); + $self->{'data'}{'bib'}{$filename} = "$texname.bib"; + } + my $ret = $macro; + $ret .= '{'.$texname.'}'; + return $ret; + } + else { + my $bblFile = "$bibdb.bbl"; + if (!File::Spec->file_name_is_absolute($bblFile)) { + $bblFile = File::Spec->catfile($self->{'dirname'}, "$bblFile"); + } + if (-f "$bblFile") { + my $ret = "\n\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n". + "%%% BEGIN FILE: ".basename($bblFile)."\n". + "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; + $ret .= readFileLines("$bblFile"); + $ret .= "\n%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; + return $ret; + } + else { + printErr(formatText(_T('File not found: {}'), $bblFile)); + } + } + } + elsif ( $macro eq '\\addbibresource') { + if ($self->{'usebiblio'}) { + my $texname = $_[1]->{'text'}; + my $filename = $self->_makeFilename("$texname", '.bib'); + if ($self->_isDocumentFile($filename)) { + $texname = $self->_uniq($filename,'.bib'); + $self->{'data'}{'bib'}{$filename} = "$texname.bib"; + } + my $ret = $macro; + $ret .= '{'.$texname.'}'; + return $ret; + } + else { + return ''; + } + } + + return $macro; +} + +sub _outputString($$@) : method { + my $self = shift; + my $parser = shift; + my $text = shift; + if (defined($text)) { + $self->{'data'}{'expandedContent'} .= $text; + } +} + +sub _discoverMacroDefinition($$$$) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + my $special = shift; + if (!$special) { + if ($macro =~ /^bibliographystyle/s ) { + return '!{}'; + } + elsif ($macro =~ /^bibliography/s ) { + return '!{}'; + } + } + return undef; +} + +sub _new($$$$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'basename' => basename($_[0],'.tex'), + 'dirname' => File::Spec->rel2abs(dirname($_[0])), + 'file' => $_[0], + 'output' => $_[1], + 'images' => $_[2], + 'includepaths' => [ File::Spec->curdir() ], + 'usebiblio' => $_[3], + 'outputString' => \&_outputString, + 'expandMacro' => \&_expandMacro, + 'discoverMacroDefinition' => \&_discoverMacroDefinition, + 'preamble' => {}, + 'data' => { + 'figures' => {}, + 'cls' => {}, + 'sty' => {}, + 'bib' => {}, + 'bst' => {}, + 'expandedContent' => '', + 'uniq' => {}, + } + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/GlossaryAnalyzer.pm b/support/autolatex/pm/AutoLaTeX/TeX/GlossaryAnalyzer.pm new file mode 100644 index 0000000000..1ed36b742a --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/GlossaryAnalyzer.pm @@ -0,0 +1,174 @@ +# autolatex - GlossaryAnalyzer.pm +# Copyright (C) 2016 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +GlossaryAnalyzer.pm - Extract glossary definitions from a GLS file. + +=head1 DESCRIPTION + +Tool that is extracting the definitions of glossary from a GLS file. + +To use this library, type C<use AutoLaTeX::TeX::GlossaryAnalyzer;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::GlossaryAnalyzer; + +$VERSION = '1.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getGlsIndexDefinitions &makeGlsIndexDefinitionMd5 ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::Spec; +use File::Basename; +use Digest::MD5 qw(md5_base64); + +use AutoLaTeX::Core::Util; +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'glossentry' => '[]!{}!{}', + ); + +=pod + +=item B<getGlsIndexDefinitions($)> + +Parse a gls file and extract the glossary definitions. + +=over 4 + +=item * C<glsfile> is the name of the GLS file to parse. + +=back + +I<Returns:> the glossary entries + +=cut +sub getGlsIndexDefinitions($) { + my $input = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::GlossaryAnalyzer->_new($input); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + my @glossaryEntries = keys %{$listener->{'glossaryEntries'}}; + @glossaryEntries = sort @glossaryEntries; + + return @glossaryEntries; +} + +=pod + +=item B<makeGlsIndexDefinitionMd5($)> + +Parse a gls file, extract the glossary definitions, and build a MD5. + +=over 4 + +=item * C<glsfile> is the name of the GLS file to parse. + +=back + +I<Returns:> the MD5 of the glossary entries. + +=cut +sub makeGlsIndexDefinitionMd5($) { + my @glossaryEntries = getGlsIndexDefinitions($_[0]); + return md5_base64(@glossaryEntries); +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + if ($_[1]->{'text'} || $_[2]->{'text'}) { + my $key = ($_[2]->{'text'} || '') . '|' . ($_[1]->{'text'} || ''); + $self->{'glossaryEntries'}{$key} = 1; + } + return ''; +} + +sub _new($) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'basename' => basename($_[0],'.tex'), + 'file' => $_[0], + 'expandMacro' => \&_expandMacro, + 'glossaryEntries' => {}, + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/IndexAnalyzer.pm b/support/autolatex/pm/AutoLaTeX/TeX/IndexAnalyzer.pm new file mode 100644 index 0000000000..e06d2547ca --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/IndexAnalyzer.pm @@ -0,0 +1,174 @@ +# autolatex - IndexAnalyzer.pm +# Copyright (C) 2013-2016 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +IndexAnalyzer.pm - Extract index definitions from an IDX file. + +=head1 DESCRIPTION + +Tool that is extracting the definitions of indexes from an IDX file. + +To use this library, type C<use AutoLaTeX::TeX::IndexAnalyzer;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::IndexAnalyzer; + +$VERSION = '1.1'; +@ISA = ('Exporter'); +@EXPORT = qw( &getIdxIndexDefinitions &makeIdxIndexDefinitionMd5 ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::Spec; +use File::Basename; +use Digest::MD5 qw(md5_base64); + +use AutoLaTeX::Core::Util; +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'indexentry' => '[]!{}!{}', + ); + +=pod + +=item B<getIdxIndexDefinitions($)> + +Parse an idx file and extract the index definitions. + +=over 4 + +=item * C<idxfile> is the name of the IDX file to parse. + +=back + +I<Returns:> the indexes + +=cut +sub getIdxIndexDefinitions($) { + my $input = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::IndexAnalyzer->_new($input); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + my @indexes = keys %{$listener->{'indexes'}}; + @indexes = sort @indexes; + + return @indexes; +} + +=pod + +=item B<makeIdxIndexDefinitionMd5($)> + +Parse an idx file, extract the index definitions, and build a MD5. + +=over 4 + +=item * C<idxfile> is the name of the IDX file to parse. + +=back + +I<Returns:> the MD5 of the indexes. + +=cut +sub makeIdxIndexDefinitionMd5($) { + my @indexes = getIdxIndexDefinitions($_[0]); + return md5_base64(@indexes); +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + if ($_[1]->{'text'} || $_[2]->{'text'}) { + my $key = ($_[2]->{'text'} || '') . '|' . ($_[1]->{'text'} || ''); + $self->{'indexes'}{$key} = 1; + } + return ''; +} + +sub _new($) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'basename' => basename($_[0],'.tex'), + 'file' => $_[0], + 'expandMacro' => \&_expandMacro, + 'indexes' => {}, + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/TeXDependencyAnalyzer.pm b/support/autolatex/pm/AutoLaTeX/TeX/TeXDependencyAnalyzer.pm new file mode 100644 index 0000000000..253ac844af --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/TeXDependencyAnalyzer.pm @@ -0,0 +1,393 @@ +# autolatex - TeXDependencyAnalyzer.pm +# Copyright (C) 2013-17 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +TeXDependencyAnalyzer.pm - Detect dependencies of a TeX file. + +=head1 DESCRIPTION + +Tool that is extracting the dependencies of the TeX file. + +To use this library, type C<use AutoLaTeX::TeX::TeXDependencyAnalyzer;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::TeX::TeXDependencyAnalyzer; + +$VERSION = '7.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getDependenciesOfTeX ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::Spec; +use File::Basename; +use AutoLaTeX::Core::Util; +use AutoLaTeX::TeX::TeXParser; + +my %MACROS = ( + 'input' => '!{}', + 'include' => '!{}', + 'makeindex' => '[]', + 'printindex' => '[]', + 'makeglossaries' => '', + 'printglossaries' => '', + 'printglossary' => '![]', + 'usepackage' => '![]!{}', + 'RequirePackage' => '![]!{}', + 'documentclass' => '![]!{}', + 'addbibresource' => '![]!{}', + ); + +=pod + +=item B<getDependenciesOfTeX($)> + +Parse a TeX file and detect the included files. + +=over 4 + +=item * C<file> is the name of the TeX file to parse. + +=item * C<dir> is the reference directory for the relative path. + +=back + +I<Returns:> the included files from the TeX file into an associative array. + +=cut +sub getDependenciesOfTeX($$) { + my $input = shift; + my $rootdir = shift; + + local *FILE; + open(*FILE, "< $input") or printErr("$input: $!"); + my $content = ''; + while (my $line = <FILE>) { + $content .= $line; + } + close(*FILE); + + my $listener = AutoLaTeX::TeX::TeXDependencyAnalyzer->_new($input,$rootdir); + + my $parser = AutoLaTeX::TeX::TeXParser->new("$input", $listener); + + while (my ($k,$v) = each(%MACROS)) { + $parser->addTextModeMacro($k,$v); + $parser->addMathModeMacro($k,$v); + } + + $parser->parse( $content ); + + my %analysis = ( %{$listener->{'dependencies'}} ); + + foreach my $cat ('sty', 'tex') { + if ($analysis{$cat}) { + my @t = keys %{$analysis{$cat}}; + $analysis{$cat} = \@t; + } + } + + while (my ($bibdb,$bibdt) = each(%{$analysis{'biblio'}})) { + foreach my $cat ('bib', 'bst', 'bbx', 'cbx') { + if ($bibdt->{$cat}) { + my @t = keys %{$bibdt->{$cat}}; + $bibdt->{$cat} = \@t; + } + } + } + + $analysis{'biber'} = $listener->{'is_biber'}; + + return %analysis; +} + +sub _expandMacro($$@) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + + if ( $macro eq '\\include' || $macro eq '\\input' ) { + foreach my $param (@_) { + my $value = $param->{'text'}; + if ($value) { + my $texFile = "$value.tex"; + if (!File::Spec->file_name_is_absolute($texFile)) { + $texFile = File::Spec->catfile($self->{'dirname'}, "$texFile"); + } + if (-f "$texFile") { + $self->{'dependencies'}{'tex'}{$texFile} = 1; + } + } + } + } + elsif ( $macro eq '\\makeindex' || $macro eq '\\printindex' ) { + $self->_addidxreference(@_); + } + elsif ( $macro eq '\\makeglossaries' || $macro eq '\\printglossaries' || $macro eq '\\printglossary' ) { + $self->{'dependencies'}{'glo'} = 1; + } + elsif ( $macro eq '\\usepackage' || $macro eq '\\RequirePackage' ) { + my $sty = $_[1]{'text'}; + my $styFile = "$sty"; + if ($styFile !~ /\.sty$/i) { + $styFile .= ".sty"; + } + if ($styFile eq 'multibib.sty') { + $self->{'is_multibib'} = 1; + } + if ($styFile eq 'biblatex.sty') { + $self->{'is_biblatex'} = 1; + # Parse the biblatex parameters + if ($_[0] && $_[0]->{'text'}) { + my @params = split(/\s*\,\s*/, trim($_[0]->{'text'} || '')); + foreach my $p (@params) { + my ($k, $v); + if ($p =~ /^([^=]+)\s*=\s*(.*?)\s*$/) { + $k = $1; + $v = $2 || ''; + } + else { + $k = $p; + $v = ''; + } + if ($k eq 'backend') { + $self->{'is_biber'} = ($v eq 'biber'); + } + elsif ($k eq 'style') { + my $bbxFile = "$v"; + if ($bbxFile !~ /\.bbx$/i) { + $bbxFile .= ".bbx"; + } + if (!File::Spec->file_name_is_absolute($bbxFile)) { + $bbxFile = File::Spec->catfile($self->{'dirname'}, "$bbxFile"); + } + if (-f "$bbxFile") { + $self->{'dependencies'}{'biblio'}{''}{'bbx'}{$bbxFile} = 1; + } + my $cbxFile = "$v"; + if ($cbxFile !~ /\.cbx$/i) { + $cbxFile .= ".cbx"; + } + if (!File::Spec->file_name_is_absolute($cbxFile)) { + $cbxFile = File::Spec->catfile($self->{'dirname'}, "$cbxFile"); + } + if (-f "$cbxFile") { + $self->{'dependencies'}{'biblio'}{''}{'cbx'}{$cbxFile} = 1; + } + } + elsif ($k eq 'bibstyle') { + my $bbxFile = "$v"; + if ($bbxFile !~ /\.bbx$/i) { + $bbxFile .= ".bbx"; + } + if (!File::Spec->file_name_is_absolute($bbxFile)) { + $bbxFile = File::Spec->catfile($self->{'dirname'}, "$bbxFile"); + } + if (-f "$bbxFile") { + $self->{'dependencies'}{'biblio'}{''}{'bbx'}{$bbxFile} = 1; + } + } + elsif ($k eq 'citestyle') { + my $cbxFile = "$v"; + if ($cbxFile !~ /\.cbx$/i) { + $cbxFile .= ".cbx"; + } + if (!File::Spec->file_name_is_absolute($cbxFile)) { + $cbxFile = File::Spec->catfile($self->{'dirname'}, "$cbxFile"); + } + if (-f "$cbxFile") { + $self->{'dependencies'}{'biblio'}{''}{'cbx'}{$cbxFile} = 1; + } + } + } + } + } + if (!File::Spec->file_name_is_absolute($styFile)) { + $styFile = File::Spec->catfile($self->{'dirname'}, "$styFile"); + } + if (-f "$styFile") { + $self->{'dependencies'}{'sty'}{"$styFile"} = 1; + } + } + elsif ($macro eq '\\documentclass' ) { + my $cls = $_[1]{'text'}; + my $clsFile = "$cls"; + if ($clsFile !~ /\.cls$/i) { + $clsFile .= ".cls"; + } + if (!File::Spec->file_name_is_absolute($clsFile)) { + $clsFile = File::Spec->catfile($self->{'dirname'}, "$clsFile"); + } + if (-f "$clsFile") { + $self->{'dependencies'}{'cls'} = [ "$clsFile" ]; + } + } + elsif ($macro =~ /^\\bibliographystyle(.*)$/s ) { + my $bibdb = $1; + $bibdb = $self->{'basename'} unless ($bibdb && $self->{'is_multibib'}); + foreach my $param (@_) { + my $value = $param->{'text'}; + if ($value) { + foreach my $svalue (split(/\s*,\s*/,trim($value))) { + if ($svalue) { + my $bstFile = "$svalue"; + if ($bstFile !~ /\.bst$/i) { + $bstFile .= ".bst"; + } + if (!File::Spec->file_name_is_absolute($bstFile)) { + $bstFile = File::Spec->catfile($self->{'dirname'}, "$bstFile"); + } + if (-f "$bstFile") { + $self->{'dependencies'}{'biblio'}{$bibdb}{'bst'}{$bstFile} = 1; + } + } + } + } + } + } + elsif ($macro =~ /^\\bibliography(.*)$/s) { + my $bibdb = $1; + $bibdb = $self->{'basename'} unless ($bibdb && $self->{'is_multibib'}); + $self->_addbibreference($bibdb,@_); + } + elsif ($macro eq '\\addbibresource') { + my $bibdb = $self->{'basename'}; + $self->_addbibreference($bibdb,@_); + } + return ''; +} + +sub _addidxreference($@) { + my $self = shift; + for my $param (@_) { + my $text = $param->{'text'} || ''; + if ($text =~ /name=([^,]+)/) { + my $name = "$1"; + if (!$self->{'dependencies'}{'idx'}) { + $self->{'dependencies'}{'idx'} = []; + } + push @{$self->{'dependencies'}{'idx'}}, $name; + } + } + if (!$self->{'dependencies'}{'idx'}) { + $self->{'dependencies'}{'idx'} = []; + } + push @{$self->{'dependencies'}{'idx'}}, ""; +} + +sub _addbibreference($@) { + my $self = shift; + my $bibdb = shift || ''; + foreach my $param (@_) { + my $value = $param->{'text'}; + if ($value) { + foreach my $svalue (split(/\s*,\s*/, $value)) { + if ($svalue) { + my $bibFile = "$svalue"; + if ($bibFile !~ /\.bib$/i) { + $bibFile .= ".bib"; + } + if (!File::Spec->file_name_is_absolute($bibFile)) { + $bibFile = File::Spec->catfile($self->{'dirname'}, "$bibFile"); + } + if (-f "$bibFile") { + $self->{'dependencies'}{'biblio'}{$bibdb}{'bib'}{$bibFile} = 1; + } + } + } + } + } +} + +sub _discoverMacroDefinition($$$$) : method { + my $self = shift; + my $parser = shift; + my $macro = shift; + my $special = shift; + if (!$special) { + if ($macro =~ /^bibliographystyle/s ) { + return '!{}'; + } + elsif ($macro =~ /^bibliography/s ) { + return '!{}'; + } + } + return undef; +} + +sub _new($$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'basename' => basename($_[0],'.tex'), + 'file' => $_[0], + 'dirname' => File::Spec->rel2abs($_[1]), + 'expandMacro' => \&_expandMacro, + 'discoverMacroDefinition' => \&_discoverMacroDefinition, + 'dependencies' => { + 'biblio' => {}, + 'tex' => {}, + 'sty' => {}, + 'cls' => [], + 'idx' => [], + }, + }; + } + bless( $self, $class ); + return $self; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/TeX/TeXParser.pm b/support/autolatex/pm/AutoLaTeX/TeX/TeXParser.pm new file mode 100644 index 0000000000..d01f6b0a27 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/TeX/TeXParser.pm @@ -0,0 +1,1672 @@ +# autolatex - TeXParser.pm +# Copyright (C) 1998-13 Stephane Galland <galland@arakhne.org> +# +# 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 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 General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +AutoLaTeX::TeX::TeXParser - A parser from TeX. + +=head1 SYNOPSYS + +use AutoLaTeX::TeX::TeXParser ; + +my $gen = AutoLaTeX::TeX::TeXParser->new( filename ) ; + +=head1 DESCRIPTION + +AutoLaTeX::TeX::TeXParser is a Perl module, which parse a +TeX file. + +=head1 GETTING STARTED + +=head2 Initialization + +To create a parser, say something like this: + + use AutoLaTeX::TeX::TeXParser; + + my $listener = { ... }; + my $parser = AutoLaTeX::TeX::TeXParser->new( 'toto.tex', $listener ) ; + +...or something similar. Acceptable parameters to the constructor are: + +=over + +=item * filename (string) + +is the filename under parsing. + +=item * listener (optional associative array) + +is the listener, which will be invoked each time a statement in the TeX file is detected. +A listener is an associative array in which values are subs to run. The supported +keys are: + +=over + +=item * 'outputString': is invoked when characters must be filtered. I<Parameters>: reference to the listener, reference to the parser, and the text to filter. I<Returns>: nothing. + +=item * 'filterComments': is invoked when comments must be filtered. I<Parameters>: reference to the listener, reference to the parser, and the text to filter. I<Returns>: the filtered comments. + +=item * 'openBlock': is invoked when a block was opened. I<Parameters>: reference to the listener, and the reference to the parser. I<Returns>: nothing. + +=item * 'closeBlock': is invoked when a block was closed. I<Parameters>: reference to the listener, and the reference to the parser. I<Returns>: nothing. + +=item * 'inlineMathStart': the inline math mode is starting. I<Parameters>: reference to the listener, reference to the parser. I<Returns> the result of the expand of the symbol. + +=item * 'multilineMathStart': the multiline math mode is starting. I<Parameters>: reference to the listener, reference to the parser. I<Returns>: the result of the expand of the symbol. + +=item * 'inlineMathStop': the inline math mode is finished. I<Parameters>: reference to the listener, reference to the parser. I<Returns>: the result of the expand of the symbol. + +=item * 'multilineMathStop': the multiline math mode is finished. I<Parameters>: reference to the listener, reference to the parser. I<Returns>: the result of the expand of the symbol. + +=item * 'discoverMacroDefinition': is invoked each time a macro definition is not found in the parser data. I<Parameters>: reference to the listener, reference to the parser, the name of the macro to search for, a boolean value that is indicating if the macro is a special macro or not, a boolean flag indicating if the math mode is active. I<Returns>: the definition of the macro prototype. + +=item * 'expandMacro': a macro is expandable. I<Parameters>: reference to the listener, reference to the parser, the name of the macro to expand, and the rest of the parameters are the descriptions of the values passed to the TeX macro. Each of the descriptions is an associative array with the keys 'eval' and 'text'. The 'eval' key indicates if the value of the parameter must be expanded in turn (if true), or used verbatim (if false). The 'text' is the value of the parameter. I<Returns>: the result of the expand of the macro, or undef to not replace the macro by something (the macro is used as-is). + +=back + +THe invoked subs may reply a text to build the text replied by the parser. + +=back + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in TeXParser.pm itself. + +=over + +=cut + +package AutoLaTeX::TeX::TeXParser; + +@ISA = ('Exporter'); +@EXPORT = qw(); +@EXPORT_OK = qw( ); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp ; + +use AutoLaTeX::Core::Util ; +use AutoLaTeX::Core::IntUtils ; + +#------------------------------------------------------ +# +# Global vars +# +#------------------------------------------------------ + +# Version number of the parser +my $VERSION = "5.1" ; + +# Definition of the default text-mode macros +my %TEX_DEFAULT_TEXT_MODE_MACROS = ( + ' ' => '', + '_' => '', + '-' => '', + '$' => '', + ',' => '', + ';' => '', + '%' => '', + '}' => '', + '{' => '', + '&' => '', + '\\' => '', + '&' => '', + '#' => '', + '\'' => '{}', + '`' => '{}', + '~' => '{}', + '"' => '{}', + '^' => '{}', + '=' => '{}', + 'AA' => '', + 'aa' => '', + 'AE' => '', + 'ae' => '', + 'begin' => '!{}', + 'backslash' => '', + 'beginblock' => '', + 'bibliographystyle' => '!{}', + 'bibliography' => '!{}', + 'bf' => '-', + 'bfseries' => '-', + 'BibTeX' => '', + 'c' => '{}', + 'caption' => '{}', + 'centering' => '-', + 'cdot' => '', + 'cite' => '[]{}', + 'def' => '\\{}', + 'degree' => '', + 'dg' => '', + 'DH' => '', + 'div' => '', + 'edef' => '\\{}', + 'Emph' => '{}', + 'em' => '-', + 'emph' => '{}', + 'end' => '!{}', + 'enditemize' => '', + 'ensuremath' => '{}', + 'euro' => '', + 'footnotesize' => '-', + 'gdef' => '\\{}', + 'global' => '', + 'guillemotleft' => '', + 'guillemotright' => '', + 'Huge' => '-', + 'html' => '!{}', + 'huge' => '-', + 'i' => '', + 'include' => '!{}', + 'includegraphics' => '[]!{}', + 'indexentry' => '{}', + 'input' => '!{}', + 'it' => '-', + 'item' => '[]', + 'itshape' => '-', + 'L' => '', + 'label' => '{}', + 'LARGE' => '-', + 'Large' => '-', + 'LaTeX' => '', + 'large' => '-', + 'lnot' => '', + 'mdseries' => '-', + 'newcommand' => '{}[][]{}', + 'newif' => '\\', + 'normalfont' => '-', + 'normalsize' => '-', + 'O' => '', + 'o' => '', + 'OE' => '', + 'oe' => '', + 'P' => '', + 'pm' => '', + 'pounds' => '', + 'providecommand' => '{}[][]{}', + 'ref' => '{}', + 'renewcommand' => '{}[][]{}', + 'rm' => '-', + 'rmfamily' => '-', + 'S' => '', + 'sc' => '-', + 'scriptsize' => '-', + 'scshape' => '-', + 'sf' => '-', + 'sffamily' => '-', + 'sl' => '-', + 'slshape' => '-', + 'small' => '-', + 'smash' => '{}', + 'ss' => '', + 'startblock' => '', + 'startitemize' => '', + 'string' => '{}', + 'TeX' => '', + 'text' => '{}', + 'textasciicircum' => '', + 'textasciitilde' => '', + 'textbackslash' => '', + 'textbf' => '{}', + 'textbrokenbar' => '', + 'textcent' => '', + 'textcopyright' => '', + 'textcurrency' => '', + 'textexcladown' => '', + 'textit' => '{}', + 'textmd' => '{}', + 'textnormal' => '{}', + 'textonehalf' => '', + 'textonequarter' => '', + 'textordfeminine' => '', + 'textordmasculine' => '', + 'textquestiondown' => '', + 'textregistered' => '', + 'textrm' => '{}', + 'textsc' => '{}', + 'textsf' => '{}', + 'textsl' => '{}', + 'textthreequarters' => '', + 'texttt' => '{}', + 'textup' => '{}', + 'textyen' => '', + 'times' => '', + 'tiny' => '-', + 'TH' => '', + 'th' => '', + 'tt' => '-', + 'ttfamily' => '-', + 'u' => '{}', + 'underline' => '{}', + 'uline' => '{}', + 'upshape' => '{}', + 'url' => '[]{}', + 'v' => '{}', + 'xdef' => '\\{}', + 'xspace' => '', +); + +# Definition of the default math-mode macros +my %TEX_DEFAULT_MATH_MODE_MACROS = ( + '}' => '', + '{' => '', + '&' => '', + '_' => '', + 'mathmicro' => '', + 'maththreesuperior' => '', + 'mathtwosuperior' => '', + 'alpha' => "", + 'angle' => "", + 'approx' => "", + 'ast' => "", + 'beta' => "", + 'bot' => "", + 'bullet' => "", + 'cap' => "", + 'cdots' => "", + 'chi' => "", + 'clubsuit' => "", + 'cong' => "", + 'cup' => "", + 'dagger' => "", + 'ddagger' => "", + 'delta' => "", + 'Delta' => "", + 'dfrac' => "{}{}", + 'diamondsuit' => "", + 'div' => "", + 'downarrow' => "", + 'Downarrow' => "", + 'emptyset' => "", + 'epsilon' => "", + 'Epsilon' => "", + 'equiv' => "", + 'eta' => "", + 'exists' => "", + 'forall' => "", + 'frac' => "{}{}", + 'gamma' => "", + 'Gamma' => "",, + 'ge' => "",, + 'heartsuit' => "",, + 'Im' => "", + 'in' => "", + 'indexentry' => '{}', + 'infty' => "", + 'infinity' => "", + 'int' => "", + 'iota' => "", + 'kappa' => "", + 'lambda' => "", + 'Lambda' => "", + 'langle' => "", + 'lceil' => "", + 'ldots' => "", + 'leftarrow' => "", + 'Leftarrow' => "", + 'leftrightarrow' => "", + 'Leftrightarrow' => "", + 'le' => "", + 'lfloor' => "", + 'mathbb' => '{}', + 'mathbf' => '{}', + 'mathit' => '{}', + 'mathrm' => '{}', + 'mathsf' => '{}', + 'mathtt' => '{}', + 'mathnormal' => '{}', + 'mu' => "", + 'nabla' => "", + 'ne' => "", + 'neq' => "", + 'ni' => "", + 'not' => "!{}", + 'nu' => "", + 'omega' => "", + 'Omega' => "", + 'ominus' => "", + 'oplus' => "", + 'oslash' => "", + 'Oslash' => "", + 'otimes' => "", + 'partial' => "", + 'phi' => "", + 'Phi' => "", + 'pi' => "", + 'Pi' => "", + 'pm' => "", + 'prime' => "", + 'prod' => "", + 'propto' => "", + 'psi' => "", + 'Psi' => "", + 'rangle' => "", + 'rceil' => "", + 'Re' => "", + 'rfloor' => "", + 'rho' => "", + 'rightarrow' => "", + 'Rightarrow' => "", + 'sfrac' => "{}{}", + 'sigma' => "", + 'Sigma' => "", + 'sim' => "", + 'spadesuit' => "", + 'sqrt' => "", + 'subseteq' => "", + 'subset' => "", + 'sum' => "", + 'supseteq' => "", + 'supset' => "", + 'surd' => "", + 'tau' => "", + 'theta' => "", + 'Theta' => "", + 'times' => "", + 'to' => "", + 'uparrow' => "", + 'Uparrow' => "", + 'upsilon' => "", + 'Upsilon' => "", + 'varpi' => "", + 'vee' => "", + 'wedge' => "", + 'wp' => "", + 'xi' => "", + 'Xi' => "", + 'xspace' => "", + 'zeta' => "", +); + +# Definition of the default text-mode active characters +my %TEX_DEFAULT_TEXT_MODE_ACTIVE_CHARACTERS = ( +); + +# Definition of the default math-mode active characters +my %TEX_DEFAULT_MATH_MODE_ACTIVE_CHARACTERS = ( + '_' => "{}", + '^' => "{}", +); + +# Definition of the default characters for comments +my @TEX_DEFAULT_COMMENT_CHARACTERS = ( + '%', +); + +#------------------------------------------------------ +# +# Inner methods +# +#------------------------------------------------------ + +# Print a warning. +sub warning($$) : method { + my $self = shift; + my $msg = shift; + my $lineno = shift; + if ($lineno>0) { + printWarn($msg.' ('.$self->{'FILENAME'}.':'.$lineno.')'); + } + else { + printWarn($msg.' ('.$self->{'FILENAME'}.')'); + } +} + +# Test is the first parameter is not defined or an empty string. +sub __isset($) { + my $v = shift; + return 0 unless defined($v); + return "$v" ne ''; +} + +# Notifies the listener +# $_[0]: name of the listener to call +# $_[1]: default value to reply when no listener to invoke, or the listener replied undef. +# @_: parameters to pass to the listener, when it was found. +# $_: depends on the semantic of the callback. +sub callListener($$@) : method { + my $self = shift; + my $callback = shift; + my $defaultValue = shift; + my $func = $self->{'PARSER_LISTENER'}{"$callback"}; + my $ret = undef; + if ($func) { + $ret = $func->($self->{'PARSER_LISTENER'}, $self, @_); + } + if (!defined($ret)) { + $ret = $defaultValue; + } + return $ret; +} + +#------------------------------------------------------ +# +# Constructor +# +#------------------------------------------------------ + +sub new($$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + + my $self ; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + my %cmt = map { $_ => 1 } @TEX_DEFAULT_COMMENT_CHARACTERS; + $self = { + 'FILENAME' => $_[0] || '', + 'MATH_MODE' => 0, + 'PARSER_LISTENER' => $_[1] || {}, + 'TEXT_MODE_MACROS' => { }, + 'MATH_MODE_MACROS' => { }, + 'TEXT_MODE_ACTIVE_CHARACTERS' => { }, + 'MATH_MODE_ACTIVE_CHARACTERS' => { }, + 'COMMENT_CHARACTERS' => \%cmt, + 'SEPARATORS' => '', + }; + } + bless( $self, $class ); + return $self; +} + +#------------------------------------------------------ +# +# Parsing API +# +#------------------------------------------------------ + +=pod + +=item * parse() + +Parse the specified string. +Takes 3 args: + +=over + +=item * text (string) + +is the text to parse + +=item * lineno (optional integer) + +is the line number where the text can be found + +=back + +I<Returns:> Nothing. + +=cut +sub parse($;$) : method { + my $self = shift ; + my $text = shift || ''; + my $lineno = shift || 0 ; + + $lineno = 1 if ($lineno<1); + + # Search the first separator + my ($eaten,$sep,$tex,$crcount) = $self->eat_to_separator($text) ; + + $self->{'stopParsing'} = 0; + $self->{'MATH_MODE'} = 0; + + while ($sep) { + + # Stop parsing + if ($self->{'stopParsing'}) { + return undef; + } + + $lineno += $crcount; + + # Parse the already eaten string + if (__isset($eaten)) { + $self->callListener( 'outputString', undef, $eaten ) ; + } + + if ($sep eq '{' ) { + my $c = $self->callListener( 'openBlock', '{' ) ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + elsif ($sep eq '}' ) { + my $c = $self->callListener( 'closeBlock', '}' ) ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + elsif ( $sep eq '\\' ) { + (my $c, $tex) = $self->parse_cmd($tex, $lineno, '\\') ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + elsif ( $sep eq '$' ) { + # Math mode + my $c = ''; + if ( ! $self->is_math_mode() ) { + $c = $self->start_math_mode(1) ; + } + elsif ( $self->is_inline_math_mode() ) { + $c = $self->stop_math_mode(1) ; + } + else { + $self->warning( + _T("you try to close with a '\$' a mathematical mode opened with '\\['"), + $lineno) ; + } + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + elsif (exists $self->{'COMMENT_CHARACTERS'}{$sep}) { + # Comment + $tex =~ s/^(.*?[\n\r])//s; + my $commentText = $1 || ''; + my $c = $self->callListener( 'filterComments', "%".$commentText, $commentText ) ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + else { + my $isText = (exists $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{$sep}); + my $isMath = (exists $self->{'MATH_MODE_ACTIVE_CHARACTERS'}{$sep}); + if ($isText || $isMath) { + if ($self->is_math_mode()) { + if (!$isMath) { + $self->warning( + formatText(_T("you cannot use in text mode the active character '{}', which is defined in math mode"), $sep), + $lineno) ; + if (__isset($sep)) { + $self->callListener( 'outputString', undef, $sep ) ; + } + } + else { + (my $c,$tex) = $self->parse_active_char( $sep.$tex, $lineno ) ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + } + else { + if (!$isText) { + $self->warning( + formatText(_T("you cannot use in math mode the active character '{}', which is defined in text mode"), $sep), + $lineno) ; + if (__isset($sep)) { + $self->callListener( 'outputString', undef, $sep ) ; + } + } + else { + (my $c,$tex) = $self->parse_active_char( $sep.$tex, $lineno ) ; + if (__isset($c)) { + $self->callListener( 'outputString', undef, $c ) ; + } + } + } + } + else { # Unknow separator, treat as text + if (__isset($sep)) { + $self->callListener( 'outputString', undef, $sep ) ; + } + } + } + + # Search the next separator + ($eaten,$sep,$tex,$crcount) = $self->eat_to_separator($tex) ; + } + + if (__isset($tex)) { + $self->callListener( 'outputString', undef, $tex ) ; + } + + return undef ; +} + +=pod + +=item * putBack($) + +Reinject a piece of text inside the parsed text in a way that it will +be the next text to be parsed by this object. + +=cut +sub putBack($) : method { + my $self = shift; + my $text = shift; + if ($text) { + $self->{'put_back_text'} = $text; + } +} + +=pod + +=item * stop() + +Stop the parsing. The function parse() will stop its current loop. + +=cut +sub stop() : method { + my $self = shift; + $self->{'stopParsing'} = 1; +} + +=pod + +=item * eat_to_separator() + +Eats the specified text until the first separator. +Takes 2 args: + +=over + +=item * text (string) + +is the text to eat + +=item * seps (optional string) + +is the list of additional separators + +=back + +=cut +sub eat_to_separator($;$) : method { + my $self = shift ; + my $text = $_[0] || '' ; + my $separators = $_[1] || '' ; + my ($sep,$after) ; + my $crcount = 0; + + if ($self->{'put_back_text'}) { + $text = $self->{'put_back_text'}.$text; + delete $self->{'put_back_text'}; + } + + my $stdSeparators = $self->{'SEPARATORS'}; + if (!$stdSeparators) { + $stdSeparators = $self->build_separators(); + } + $separators .= $stdSeparators; + + my $ret1 = ''; + + while ( $text =~ /^(.*?)([\n$separators])(.*)$/s ) { + (my $before,$sep,$text) = ($1,$2,$3) ; + $ret1 .= "$before"; + if ($sep ne "\n") { + return ($ret1,$sep,$text,$crcount) ; + } + $ret1 .= "\n"; + $crcount++; + } + + if ($text) { + $ret1 .= $text ; + $sep = $after = '' ; + } + return ($ret1,$sep,$after,$crcount) ; +} + +sub build_separators() { + my $self = shift; + my %seps = (); + foreach my $k (keys %{$self->{'COMMENT_CHARACTERS'}}) { + $seps{$k} = 1; + } + foreach my $k (keys %{$self->{'TEXT_MODE_ACTIVE_CHARACTERS'}}) { + $seps{$k} = 1; + } + foreach my $k (keys %{$self->{'MATH_MODE_ACTIVE_CHARACTERS'}}) { + $seps{$k} = 1; + } + $seps{'{'} = 1; + $seps{'}'} = 1; + $seps{'\\$'} = 1; + $seps{'\\\\'} = 1; + my $seps .= join('', keys %seps); + $self->{'SEPARATORS'} = $seps; + return $seps; +} + +=pod + +=item * parse_cmd() + +Parse a TeX command. +Takes 3 args: + +=over + +=item * text (string) + +is the text, which follows the backslash, to scan + +=item * lineno (integer) + +=item * prefix (optional string) + +is a prefix merged to the command name. Use carefully. + +=back + +I<Returns:> (the result of the expand of the macro, the rest of the tex text, after the macro). + +=cut +sub parse_cmd($$;$) : method { + my $self = shift ; + my ($tex,$lineno) = ($_[0] || '', $_[1] || 0 ) ; + my $cmd_prefix = $_[2] || '' ; + my $expandTo = ''; + + if ( $tex =~ /^\[(.*)/s ) { # Starts multi-line math mode + $tex = $1 ; + $expandTo = $self->start_math_mode(2) ; + } + elsif ( $tex =~ /^\](.*)/s ) { # Stop multi-line math mode + $tex = $1 ; + $expandTo = $self->stop_math_mode(2) ; + } + elsif ( $tex =~ /^((?:[a-zA-Z]+\*?)|.)(.*)/s ) { # default LaTeX command + (my $cmdname,$tex) = ($1,$2) ; + my $trans = $self->search_cmd_trans( $cmdname, $lineno, ($cmd_prefix ne "\\") ) ; + if ( ! defined( $trans ) || !$trans ) { + $trans = ''; + } + ($expandTo,$tex) = $self->run_cmd( $cmd_prefix.$cmdname, $trans, $tex, $lineno ) ; + } + else { + $self->warning( formatText(_T("invalid syntax for the TeX command: {}"),$cmd_prefix.$_[0]), + $lineno ) ; + } + + return ($expandTo,$tex) ; +} + +=pod + +=item * parse_active_char() + +Parse a TeX active character. +Takes 3 args: + +=over + +=item * text (string) + +is the text, with the active char, to scan + +=item * lineno (integer) + +=back + +I<Returns:> the rest of the tex text, after the active character. + +=cut +sub parse_active_char($$) : method { + my $self = shift ; + my ($tex,$lineno) = ($_[0] || '', + $_[1] || 0 ) ; + my $expandTo = ''; + + if ( $tex =~ /^(.)(.*)/s ) { # default LaTeX command + (my $activeChar,$tex) = ($1,$2) ; + my $trans = $self->search_cmd_trans( $activeChar, $lineno, 1 ) ; + if ( ! defined( $trans ) || !$trans ) { + $trans = ''; + } + ($expandTo,$tex) = $self->run_cmd( $activeChar, $trans, $tex, $lineno ) ; + } + else { + $self->warning( formatText(_T("invalid syntax for the TeX active character: {}"), $_[0]), + $lineno ) ; + $expandTo = substr($tex,0,1) || '' ; + $tex = substr($tex,1) || '' ; + } + + return ($expandTo,$tex) ; +} + +=pod + +=item * search_cmd_trans() + +Replies the macro definition that corresponds to +the specified TeX command. +Takes 3 args: + +=over + +=item * name (string) + +is the name of the TeX command to search. + +=item * lineno (integer) + +=item * special (optional boolean) + +indicates if the searched command has a special purpose +(example: _ in math mode) + +=back + +=cut +sub search_cmd_trans($$;$) : method { + my $self = shift ; + my $lineno = $_[1] || 0 ; + my $special = $_[2] ; + my ($found_math, $found_text) = (0,0); + my ($math, $text) = (undef,undef); + + if ($_[0]) { + + if ($special) { + if (exists $self->{'MATH_MODE_ACTIVE_CHARACTERS'}{$_[0]}) { + $found_math = 1; + $math = $self->{'MATH_MODE_ACTIVE_CHARACTERS'}{$_[0]}; + } + if (exists $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{$_[0]}) { + $found_text = 1; + $text = $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{$_[0]}; + } + } + else { + if (exists $self->{'MATH_MODE_MACROS'}{$_[0]}) { + $found_math = 1; + $math = $self->{'MATH_MODE_MACROS'}{$_[0]}; + } + if (exists $self->{'TEXT_MODE_MACROS'}{$_[0]}) { + $found_text = 1; + $text = $self->{'TEXT_MODE_MACROS'}{$_[0]}; + } + } + + if (!$found_text && !$found_math) { + my $def = $self->callListener( + 'discoverMacroDefinition', + undef, + $_[0], + $special, + $self->is_math_mode()); + if (defined($def)) { + if ($self->is_math_mode()) { + $found_math = 1; + $math = $def; + } + else { + $found_text = 1; + $text = $def; + } + } + } + } + + printDbgFor(5, formatText(_T('Found parameter definition for \'{}\': math={}; text={}'), $_[0], + (defined($math) ? $math : '<undef>'), (defined($text) ? $text : '<undef>'))); + + if ( $found_math || $found_text ) { + if ( $self->is_math_mode() ) { + if ( ! $found_math ) { + $self->warning( formatText(_T("the command {}{} was not defined for math-mode, assumes to use the text-mode version instead"), ( $special ? '' : '\\' ), $_[0]), + $lineno ) ; + return $text ; + } + else { + return $math ; + } + } + elsif ( ! $found_text ) { + $self->warning( formatText(_T("the command {}{} was not defined for text-mode, assumes to use the math-mode version instead"), ( $special ? '' : '\\' ), $_[0]), + $lineno ) ; + return $math ; + } + else { + return $text ; + } + } + return undef ; +} + +=pod + +=item * run_cmd() + +Execute the specified macro on the specified tex string. +Takes 4 args: + +=over + +=item * name (string) + +is the name of the TeX macro. + +=item * trans (string) + +is the definition for the macro. + +=item * text (string) + +is the text from which some data must be extracted to +treat the macro. + +=item * lineno (integer) + +is le line number where the text starts + +=back + +I<Returns:> nothing. + +=cut +sub run_cmd($$$$) : method { + my $self = shift ; + my ($cmdname,$tex,$lineno) = ( + $_[0] || confess( 'you must supply the TeX command name'), + $_[2] || '', + $_[3] || 0 ) ; + my $expandTo; + + if ( $_[1] ) { + # This macro has params + printDbgFor(5, formatText(_T('Expanding \'{}\''), $cmdname)); + ($tex,my $params, my $rawparams) = $self->eat_cmd_parameters( $_[1], $tex, $cmdname, $lineno ) ; + # Apply the macro + $expandTo = $self->callListener('expandMacro', + $cmdname.$rawparams, + $cmdname, @$params); + } + else { + # No param, put the HTML string inside the output stream + printDbgFor(5, formatText(_T('Expanding \'{}\''), $cmdname)); + $expandTo = $self->callListener('expandMacro', + $cmdname, + $cmdname); + } + return ($expandTo,$tex) ; +} + +=pod + +=item * eat_cmd_parameters() + +Eat the parameters for a macro. +Takes 3 args: + +=over + +=item * params (string) + +is the description of the parameters to eat. + +=item * text (string) + +is the text from which some data must be extracted. + +=item * macro (string) is the name of the macro for which parameters must be extracted. + +=item * lineno (integer) + +=back + +I<Returns>: (the rest of the tex, the array of parameters, the raw representation of the parameters) + +=cut +sub eat_cmd_parameters($$$$) : method { + my $self = shift ; + my $p_params = $_[0] || '' ; + my $tex = $_[1] || '' ; + my $macro = $_[2] || ''; + my $lineno = $_[3] || 0 ; + my @params = () ; + my $rawparams = ''; + printDbgFor(5, formatText(_T('Macro prototype of \'{}\': {}'), $macro, $p_params)); + while ( $p_params =~ /((?:\!?\{\})|(?:\!?\[[^\]]*\])|-|\\)/sg ) { + my $p = $1 ; + # Eats no significant white spaces + #$tex =~ s/^ +//s ; + if ( $p =~ /^(\!?)\{\}/s ) { # Eates a mandatory parameter + my $optional = $1 || '' ; + my $prem = substr($tex,0,1) ; + $tex = substr($tex,1) ; + if ( $prem eq '{' ) { + (my $context,$tex) = $self->eat_context( $tex, '\\}' ) ; + push @params, { 'eval' => ($optional ne '!'), + 'text' => $context, + } ; + $rawparams .= "{$context}"; + } + elsif ( $prem eq '\\' ) { + if ($optional ne '!') { + # The following macro is expandable + (my $c, $tex) = $self->parse_cmd($tex, $lineno, '\\') ; + push @params, { 'eval' => 1, + 'text' => $c, + } ; + $rawparams .= "{$c}"; + } + else { + # The following macro is not expandable + $tex =~ /^((?:[a-zA-Z]+\*?)|.)(.*)$/s; + (my $c, $tex) = ($1,$2); + push @params, { 'eval' => 0, + 'text' => $c, + } ; + $rawparams .= "\\$c"; + } + } + else { + push @params, { 'eval' => ($optional ne '!'), + 'text' => $prem, + } ; + $rawparams .= "$prem"; + } + } + elsif( $p =~ /^(\!?)\[([^\]]*)\]/s ) { # Eates an optional parameter + my ($optional,$default_val) = ( $1 || '', $2 || '' ) ; + my $prem = substr($tex,0,1) ; + if ( $prem eq '[' ) { + (my $context,$tex) = $self->eat_context( substr($tex,1), '\\]' ) ; + push @params, { 'eval' => ($optional ne '!'), + 'text' => $context, + } ; + $rawparams .= "[$context]"; + } + else { + push @params, { 'eval' => ($optional ne '!'), + 'text' => $default_val, + } ; + } + } + elsif( $p eq '\\' ) { # Eates a TeX command name + if ( $tex =~ /^\\((?:[a-zA-Z]+\*?)|.)(.*)$/s ) { + my $n = $1; + $tex = $2 ; + push @params, { 'eval' => 1, + 'text' => $n, + } ; + $rawparams .= "\\$n"; + } + else { + my $msg = substr($tex, 0, 50); + $msg =~ s/[\n\r]/\\n/sg; + $msg =~ s/\t/\\t/sg; + $msg = formatText(_T("expected a TeX macro for expanding the macro {}, here: '{}'"), $macro, $msg); + $self->printWarn($msg, $lineno ) ; + push @params, { 'eval' => 1, + 'text' => '', + } ; + $rawparams .= "\\"; + } + } + elsif ( $p eq '-' ) { # Eates until the end of the current context + (my $context,$tex) = $self->eat_context( $tex, '\\}' ) ; + push @params, { 'eval' => 1, + 'text' => $context, + } ; + $rawparams .= "$context"; + } + else { + confess( formatText(_T("unable to recognize the following argument specification: {}"), $p) ) ; + } + } + return ($tex,\@params,$rawparams) ; +} + +=pod + +=item * eat_context() + +Eaten the current context. +Takes 2 args: + +=over + +=item * text (string) + +is the text from which some data must be extracted. + +=item * end (string) + +is the ending separator + +=back + +=cut +sub eat_context($$) : method { + my $self = shift ; + my $text = $_[0] || '' ; + my $enddelim = $_[1] || confess( 'you must supply the closing delimiter' ) ; + my $context = '' ; + my $contextlevel = 0 ; + + # Search the first separator + my ($eaten,$sep,$tex) = $self->eat_to_separator($text,$enddelim) ; + + while ($sep) { + + if ( $sep eq '{' ) { # open a context + $contextlevel ++ ; + $eaten .= $sep ; + } + elsif ( $sep eq '}' ) { # close a context + if ( $contextlevel <= 0 ) { + return ($context.$eaten,$tex) ; + } + $eaten .= $sep ; + $contextlevel -- ; + } + elsif ( $sep eq '\\' ) { + $tex =~ /^([a-zA-Z]+\*?|.)(.*)$/s ; + $eaten .= "\\$1"; + $tex = $2 ; + } + elsif ( ( $contextlevel <= 0 ) && + ( $sep =~ /$enddelim/s ) ) { # The closing delemiter was found + return ($context.$eaten,$tex) ; + } + else { # Unknow separator, treat as text + $eaten .= $sep ; + } + + # Translate the text before the separator + $context .= $eaten ; + + # Search the next separator + ($eaten,$sep,$tex) = $self->eat_to_separator($tex,$enddelim) ; + } + + return ($context.$eaten,$tex) ; +} + +#------------------------------------------------------ +# +# Math mode +# +#------------------------------------------------------ + +=pod + +=item * start_math_mode($) + +Starts the mathematical mode. +Takes 1 arg: + +=over + +=item * mode (integer) + +is the math mode to start (1: inline, 2: multi-line) + +=back + +I<Returns:> the result of the expansion of the math starting symbol. + +=cut +sub start_math_mode($) { + my $self = shift ; + my $mode = ( $_[0] % 3 ); + my $default = ($mode == 2 ) ? '\\[' : '$'; + if (!$self->is_math_mode() ) { + $self->{'MATH_MODE'} = $mode ; + if ( $self->{'MATH_MODE'} == 2 ) { + return $self->callListener('multilineMathStart', $default); + } + return $self->callListener('inlineMathStart', $default); + } + return $default; +} + +=pod + +=item * stop_math_mode($) + +Stops the mathematical mode. + +Takes 1 arg: + +=over + +=item * mode (integer) + +is the math mode to stop (1: inline, 2: multi-line) + +=back + +I<Returns:> the result of the expansion of the math starting symbol. + +=cut +sub stop_math_mode($) { + my $self = shift ; + my $mode = ( $_[0] % 3 ); + my $default = ($mode == 2 ) ? '\\]' : '$'; + if ( $self->is_math_mode() ) { + my $m = $self->{'MATH_MODE'}; + $self->{'MATH_MODE'} = 0 ; + if ( $m == 2 ) { + return $self->callListener('multilineMathStop', $default); + } + return $self->callListener('inlineMathStop', $default); + } + return $default; +} + +=pod + +=item * is_math_mode() + +Replies if inside a mathematical mode. + +=cut +sub is_math_mode() { + my $self = shift ; + return ( $self->{'MATH_MODE'} != 0 ) ; +} + +=pod + +=item * is_inline_math_mode() + +Replies if inside a inlined mathematical mode. + +=cut +sub is_inline_math_mode() { + my $self = shift ; + return ( $self->{'MATH_MODE'} == 1 ) ; +} + +=pod + +=item * is_multiline_math_mode() + +Replies if inside a multi-lined mathematical mode. + +=cut +sub is_multiline_math_mode() { + my $self = shift ; + return ( $self->{'MATH_MODE'} == 2 ) ; +} + +#------------------------------------------------------ +# +# Comment characters +# +#------------------------------------------------------ + +=pod + +=item * addCommentChar() + +Add a comment character. +Takes 1 args: + +=over + +=item * char (string) + +is the character to add + +=back + +=cut +sub addCommentChar($$) : method { + my $self = shift; + confess( 'you must supply the comment character' ) unless $_[0] ; + $self->{'COMMENT_CHARACTERS'}{"$_[0]"} = 1; +} + +=pod + +=item * removeCommentChar() + +Remove a comment char. +Takes 1 arg: + +=over + +=item * char (string) + +is the character to remove + +=back + +=cut +sub removeCommentChar($) : method { + my $self = shift; + confess( 'you must supply the comment character' ) unless $_[0] ; + delete $self->{'COMMENT_CHARACTERS'}{$_[0]}; +} + +=pod + +=item * getCommentChars() + +Replies the comment chars. + +=cut +sub getCommentChars() : method { + my $self = shift; + return keys %{$self->{'COMMENT_CHARACTERS'}} ; +} + +#------------------------------------------------------ +# +# Text mode macros +# +#------------------------------------------------------ + +=pod + +=item * addTextModeMacro($$;$) + +Add a macro in text mode. +Takes 2 args: + +=over + +=item * name (string) + +is the name of the macro. + +=item * params (string) + +is the specification of the parameters of the macro. +The parameter prototype of the LaTeX command. If not empty, it must contains one (or more) of: + +=over + +=item * C<{}>: for a mandatory parameter + +=item * C<[d]>: for an optional parameter. C<d> is the default value given to this parameter if it was not provided inside the LaTeX code + +=item * C<\>: for a LaTeX command name + +=item * C<!>: indicates that the following sign (C<{}> or C<[]>) must not be interpreted by the LaTeX parser. It must be used for verbatim output + +=item * C<->: to read the text until the end of the current LaTeX context + +=back + +=item * isSpecial (boolean) + +indicates if the command is a special character, ie. a macro that is not needing to be +prefixed by '\'. + +=back + +=cut +sub addTextModeMacro($$;$) : method { + my $self = shift; + confess( 'you must supply the name of the macro' ) unless $_[0] ; + if ($_[2]) { + $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{"$_[0]"} = ( $_[1] || '' ); + $self->{'SEPARATORS'} = ''; + } + else { + $self->{'TEXT_MODE_MACROS'}{"$_[0]"} = ( $_[1] || '' ); + } +} + +=pod + +=item * removeTextModeMacro() + +Remove a text mode macro. +Takes 1 arg: + +=over + +=item * name (string) + +is the name of the macro. + +=item * isSpecial (boolean) + +indicates if the command is a special character, ie. a macro that is not needing to be +prefixed by '\'. + +=back + +=cut +sub removeTextModeMacro($;$) : method { + my $self = shift; + confess( 'you must supply the name of the macro' ) unless $_[0] ; + if ($_[1]) { + if ($self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{"$_[0]"}) { + delete $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{"$_[0]"}; + } + $self->{'SEPARATORS'} = ''; + } + else { + if ($self->{'TEXT_MODE_MACROS'}{"$_[0]"}) { + delete $self->{'TEXT_MODE_MACROS'}{"$_[0]"}; + } + } +} + +=pod + +=item * getTextModeMacros() + +Replies the text mode macros. + +=cut +sub getTextModeMacros() : method { + my $self = shift; + my %macros = ( + 'macros' => $self->{'TEXT_MODE_MACROS'}, + 'special' => $self->{'TEXT_MODE_ACTIVE_MACROS'}, + ); + return %macros; +} + +=pod + +=item * clearTextModeMacros() + +Remove all the text mode macros. + +=cut +sub clearTextModeMacros() : method { + my $self = shift; + $self->{'TEXT_MODE_MACROS'} = {}; + $self->{'TEXT_MODE_ACTIVE_MACROS'} = {}; +} + +#------------------------------------------------------ +# +# Math mode macros +# +#------------------------------------------------------ + +=pod + +=item * addMathModeMacro($$;$) + +Add a macro in math mode. +Takes 2 args: + +=over + +=item * name (string) + +is the name of the macro. + +=item * params (string) + +is the specification of the parameters of the macro. +The parameter prototype of the LaTeX command. If not empty, it must contains one (or more) of: + +=over + +=item * C<{}>: for a mandatory parameter + +=item * C<[d]>: for an optional parameter. C<d> is the default value given to this parameter if it was not provided inside the LaTeX code + +=item * C<\>: for a LaTeX command name + +=item * C<!>: indicates that the following sign (C<{}> or C<[]>) must not be interpreted by the LaTeX parser. It must be used for verbatim output + +=item * C<->: to read the text until the end of the current LaTeX context + +=back + +=item * isSpecial (boolean) + +indicates if the command is a special character, ie. a macro that is not needing to be +prefixed by '\'. + +=back + +=cut +sub addMathModeMacro($$;$) : method { + my $self = shift; + confess( 'you must supply the name of the macro' ) unless $_[0] ; + if ($_[2]) { + $self->{'MATH_MODE_ACTIVE_CHARACTERS'}{"$_[0]"} = ( $_[1] || '' ); + $self->{'SEPARATORS'} = ''; + } + else { + $self->{'MATH_MODE_MACROS'}{"$_[0]"} = ( $_[1] || '' ); + } +} + +=pod + +=item * removeMathModeMacro() + +Remove a math mode macro. +Takes 1 arg: + +=over + +=item * name (string) + +is the name of the macro. + +=item * isSpecial (boolean) + +indicates if the command is a special character, ie. a macro that is not needing to be +prefixed by '\'. + +=back + +=cut +sub removeMathModeMacro($;$) : method { + my $self = shift; + confess( 'you must supply the name of the macro' ) unless $_[0] ; + if ($_[1]) { + if ($self->{'MATH_MODE_ACTIVE_CHARACTERS'}{"$_[0]"}) { + delete $self->{'MATH_MODE_MACROS'}{"$_[0]"}; + } + $self->{'SEPARATORS'} = ''; + } + else { + if ($self->{'MATH_MODE_MACROS'}{"$_[0]"}) { + delete $self->{'MATH_MODE_MACROS'}{"$_[0]"}; + } + } +} + +=pod + +=item * getMathModeMacros() + +Replies the math mode macros. + +=cut +sub getMathModeMacros() : method { + my $self = shift; + my %macros = ( + 'macros' => $self->{'MATH_MODE_MACROS'}, + 'special' => $self->{'MATH_MODE_ACTIVE_MACROS'}, + ); + return %macros; +} + +=pod + +=item * clearMathModeMacros() + +Remove all the math mode macros. + +=cut +sub clearMathModeMacros() : method { + my $self = shift; + $self->{'MATH_MODE_MACROS'} = {}; + $self->{'MATH_MODE_ACTIVE_MACROS'} = {}; +} + +#------------------------------------------------------ +# +# Macros +# +#------------------------------------------------------ + +=pod + +=item * addStandardMacros() + +Add the standard LaTeX macros into the parser definitions. + +=cut +sub addStandardMacros() : method { + my $self = shift; + while (my ($k,$v) = each(%TEX_DEFAULT_TEXT_MODE_MACROS)) { + $self->{'TEXT_MODE_MACROS'}{$k} = $v; + } + while (my ($k,$v) = each(%TEX_DEFAULT_MATH_MODE_MACROS)) { + $self->{'MATH_MODE_MACROS'}{$k} = $v; + } + while (my ($k,$v) = each(%TEX_DEFAULT_TEXT_MODE_ACTIVE_CHARACTERS)) { + $self->{'TEXT_MODE_ACTIVE_CHARACTERS'}{$k} = $v; + } + while (my ($k,$v) = each(%TEX_DEFAULT_MATH_MODE_ACTIVE_CHARACTERS)) { + $self->{'MATH_MODE_ACTIVE_CHARACTERS'}{$k} = $v; + } +} + +1; +__END__ + +=back + +=head1 COPYRIGHT + +(c) Copyright 1998-13 Stephane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. + +=head1 AUTHORS + +=over + +=item * + +Conceived and initially developed by Stephane Galland E<lt>galland@arakhne.orgE<gt>. + +=back + |