Ignore:
Timestamp:
Jul 21, 2024, 1:47:00 PM (17 months ago)
Author:
abarral
Message:

Fix r5093: ship new fcm source

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/tools/fcm/bin/fcm_gui

    r1578 r5094  
    1 #!/usr/bin/perl
    2 # ------------------------------------------------------------------------------
    3 # NAME
    4 #   fcm_gui
     1#!/usr/bin/env perl
     2#-------------------------------------------------------------------------------
     3# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
    54#
    6 # SYNOPSIS
    7 #   fcm_gui [DIR]
     5# This file is part of FCM, tools for managing and building source code.
    86#
    9 # DESCRIPTION
    10 #   The fcm_gui command is a simple graphical user interface for some of the
    11 #   commands of the FCM system. The optional argument DIR modifies the initial
    12 #   working directory.
     7# FCM is free software: you can redistribute it and/or modify
     8# it under the terms of the GNU General Public License as published by
     9# the Free Software Foundation, either version 3 of the License, or
     10# (at your option) any later version.
    1311#
    14 # COPYRIGHT
    15 #   (C) Crown copyright Met Office. All rights reserved.
    16 #   For further details please refer to the file COPYRIGHT.txt
    17 #   which you should have received as part of this distribution.
    18 # ------------------------------------------------------------------------------
    19 
    20 # Standard pragmas
     12# FCM is distributed in the hope that it will be useful,
     13# but WITHOUT ANY WARRANTY; without even the implied warranty of
     14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15# GNU General Public License for more details.
     16#
     17# You should have received a copy of the GNU General Public License
     18# along with FCM. If not, see <http://www.gnu.org/licenses/>.
     19#-------------------------------------------------------------------------------
     20
     21use strict;
    2122use warnings;
    22 use strict;
    23 
    24 # Standard modules
    25 use File::Basename;
    26 use File::Spec::Functions;
    27 use Cwd;
     23
     24use FindBin;
     25use lib "$FindBin::Bin/../lib";
     26use Cwd qw{cwd};
     27use FCM::Context::Event;
     28use FCM::Util;
     29use FCM1::Config;
     30use FCM1::Keyword;
     31use FCM1::Timer qw{timestamp_command};
     32use FCM1::Util qw{get_url_of_wc get_wct is_wc};
     33use File::Basename qw{basename};
     34use File::Spec::Functions qw{catfile rel2abs};
    2835use Tk;
    2936use Tk::ROText;
    30 
    31 # FCM component modules:
    32 use lib catfile (dirname (dirname ($0)), 'lib');
    33 use Fcm::Config;
    34 use Fcm::Util;
    35 use Fcm::Timer;
    3637
    3738# ------------------------------------------------------------------------------
    … …  
    4344}
    4445
     46FCM1::Keyword::set_util(FCM::Util->new());
     47
    4548# Get configuration settings
    46 my $config = Fcm::Config->new ();
     49my $config = FCM1::Config->new ();
    4750$config->get_config ();
    4851
    … …  
    9194  DELETE    => 'remove files and directories from version control.',
    9295  MERGE     => 'merge changes into your working copy.',
    93   CONFLICTS => 'use "xxdiff" to resolve any conflicts within your working copy.',
     96  CONFLICTS => 'use a graphical tool to resolve conflicts in your working copy.',
    9497  COMMIT    => 'send changes from your working copy to the repository.',
    9598  UPDATE    => 'bring changes from the repository into your working copy.',
    … …  
    130133    TYPE    => 'DEV',
    131134    REVFLAG => 'NORMAL',
    132     REV     => '',
    133135    TICKET  => '',
    134136    SRCTYPE => 'trunk',
    … …  
    156158  DIFF      => {
    157159    USEWCT  => 0,
    158     GRAPHIC => 1,
     160    TOOL    => 'graphical',
    159161    BRANCH  => 0,
    160162    URL     => '',
    … …  
    265267  S_OTH   => 'Show other',
    266268  VERBOSE => 'Print extra information',
     269);
     270
     271# List of diff display options
     272my %diff_display_opt = (
     273  default   => 'Default mode',
     274  graphical => 'Graphical tool',
     275  trac      => 'Trac (only for diff relative to the base of the branch)',
    267276);
    268277
    … …  
    485494    $subcmd_f{$name}->Entry (
    486495      '-textvariable' => \($subcmdvar{$name}{NAME}),
    487     )->grid (
    488       '-row'    => $row{$name}++,
    489       '-column' => 1,
    490       '-sticky' => 'ew',
    491     );
    492 
    493     # Label and entry box for specifying create branch source revision
    494     $subcmd_f{$name}->Label (
    495       '-text' => 'Source revision (create/list only): ',
    496     )->grid (
    497       '-row'    => $row{$name},
    498       '-column' => 0,
    499       '-sticky' => 'w',
    500     );
    501     $subcmd_f{$name}->Entry (
    502       '-textvariable' => \($subcmdvar{$name}{REV}),
    503496    )->grid (
    504497      '-row'    => $row{$name}++,
    … …  
    720713    my $name = 'DIFF';
    721714
    722     # Checkbuttons for various options
    723     $subcmd_f{$name}->Checkbutton (
    724       '-text'     => 'Use xxdiff to display differences',
    725       '-variable' => \($subcmdvar{$name}{GRAPHIC}),
    726     )->grid (
    727       '-row'        => $row{$name}++,
    728       '-column'     => 0,
    729       '-columnspan' => 2,
    730       '-sticky'     => 'w',
    731     );
    732 
    733715    my $entry;
    734716    $subcmd_f{$name}->Checkbutton (
    … …  
    746728      '-sticky'     => 'w',
    747729    );
     730
     731    # Label and radio buttons box for specifying tool
     732    $subcmd_f{$name}->Label (
     733      '-text' => 'Display diff in: ',
     734    )->grid (
     735      '-row'    => $row{$name},
     736      '-column' => 0,
     737      '-sticky' => 'w',
     738    );
     739
     740    {
     741      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
     742        '-row'    => $row{$name}++,
     743        '-column' => 1,
     744        '-sticky' => 'w',
     745      );
     746
     747      my $col = 0;
     748      for my $key (qw/default graphical trac/) {
     749        my $txt = $diff_display_opt{$key};
     750        my $opt = $key;
     751
     752        $branch_opt{$key} = $opt_f->Radiobutton (
     753          '-text'     => $txt,
     754          '-value'    => $opt,
     755          '-variable' => \($subcmdvar{$name}{TOOL}),
     756          '-state'    => 'normal',
     757        )->grid (
     758          '-row'      => 0,
     759          '-column'   => $col++,
     760          '-sticky'   => 'w',
     761        );
     762      }
     763    }
    748764
    749765    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
    … …  
    980996# ------------------------------------------------------------------------------
    981997# SYNOPSIS
    982 #   $cfg = &main::cfg ();
    983 #
    984 # DESCRIPTION
    985 #   Return the $config variable.
    986 # ------------------------------------------------------------------------------
    987 
    988 sub cfg {
    989   return $config;
    990 }
    991 
    992 # ------------------------------------------------------------------------------
    993 # SYNOPSIS
    994998#   &change_cwd ($dir);
    995999#
    … …  
    11131117#
    11141118# DESCRIPTION
    1115 #   Setup the the system command for the sub-command $name.
     1119#   Setup the system command for the sub-command $name.
    11161120# ------------------------------------------------------------------------------
    11171121
    … …  
    11211125
    11221126  if ($name eq 'BRANCH') {
    1123     $cmd .= lc ($name);
    11241127    if ($subcmdvar{$name}{OPT} eq 'create') {
    1125       $cmd .= ' -c --svn-non-interactive';
    1126       $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
     1128      $cmd .= 'branch-create';
     1129      $cmd .= ' --svn-non-interactive';
    11271130      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
    11281131      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
    1129       $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
    11301132      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
    11311133      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
     1134      $cmd .= ' ' . $subcmdvar{$name}{NAME};
    11321135
    11331136    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
     1137      $cmd .= 'branch-delete';
    11341138      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
    1135       $cmd .= ' -d --svn-non-interactive';
     1139      $cmd .= ' --svn-non-interactive';
    11361140
    11371141    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
    1138       $cmd .= ' -l';
    1139       $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
     1142      $cmd .= 'branch-list';
    11401143
    11411144    } else {
    1142       $cmd .= ' -i';
     1145      $cmd .= 'branch-info';
    11431146      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
    11441147      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
    … …  
    11631166
    11641167  } elsif ($name eq 'DIFF') {
    1165     $cmd .= lc ($name);
    1166     $cmd .= ' -g' if $subcmdvar{$name}{GRAPHIC};
    1167 
    11681168    if ($subcmdvar{$name}{BRANCH}) {
    1169       $cmd .= ' -b';
     1169      $cmd .= 'branch-diff';
     1170      $cmd .= ' -t' if $subcmdvar{$name}{TOOL} eq 'trac';
    11701171      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
    11711172    }
    1172 
     1173    else {
     1174      $cmd .= 'diff';
     1175    }
     1176
     1177    $cmd .= ' -g' if $subcmdvar{$name}{TOOL} eq 'graphical';
    11731178    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
    11741179
    … …  
    12321237  $cmd         = (index ($cmd, 'help ') == 0)
    12331238                 ? $disp_cmd
    1234                  : ('fcm_gui_internal ' . &get_wm_pos () . ' ' . $cmd);
     1239                 : ('fcm gui-internal ' . &get_wm_pos () . ' ' . $cmd);
    12351240
    12361241  # Change directory to working copy top if necessary
    … …  
    12891294
    12901295        # If the command is "checkout", change directory to working copy
    1291         if (lc ($selsubcmd) eq 'checkout') {
    1292           my $url = expand_url_keyword (URL => $subcmdvar{CHECKOUT}{URL});
     1296        if (lc ($selsubcmd) eq 'checkout' && $subcmdvar{CHECKOUT}{URL}) {
     1297          my $url = FCM1::Keyword::expand($subcmdvar{CHECKOUT}{URL});
    12931298          my $dir = $subcmdvar{CHECKOUT}{PATH}
    12941299                  ? $subcmdvar{CHECKOUT}{PATH}
    1295                   : basename $url;
    1296           $dir    = File::Spec->rel2abs ($dir);
     1300                  : basename($url);
     1301          $dir    = rel2abs($dir);
    12971302          &change_cwd ($dir);
    12981303
    … …  
    13201325
    13211326__END__
     1327
     1328=head1 NAME
     1329
     1330fcm_gui
     1331
     1332=head1 SYNOPSIS
     1333
     1334fcm_gui [DIR]
     1335
     1336=head1 DESCRIPTION
     1337
     1338The fcm_gui command is a simple graphical user interface for some of the
     1339commands of the FCM system. The optional argument DIR modifies the initial
     1340working directory.
     1341
     1342=head1 COPYRIGHT
     1343
     1344Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
     1345
     1346=cut
Note: See TracChangeset for help on using the changeset viewer.