Gedcom

 view release on metacpan or  search on metacpan

tkged  view on Meta::CPAN

                              -title => "Cancel",
                              -buttons => ["Yes", "No"]) eq "No");
      $cont;
    });
  $progress->unShow if $cont;
  my @individuals = $Ged->{record}->get_children("INDI");
  if (@individuals)
  {
    show_record("", $individuals[0], "full");
  }
  $Top->Unbusy;
}

sub save($)
{
  my ($gedcom_file) = @_;
  $Top->Busy;
  $Top->update;
  $Ged->write($gedcom_file);
  $Top->Unbusy;
}

sub updown($$)
{
  my ($list, $pos) = @_;
  $list->activate($pos =~ /^[+-]\d+$/ ? $list->index("active") + $pos : $pos);
  $list->see("active");
  $list->selectionClear(0, "end");
  $list->selectionSet("active")
}

tkged  view on Meta::CPAN

                        -height => 20);
    $box->bind("<Double-Button-1>" =>
               sub { $box->{selected_button} = $listbox->curselection });
  }
  $Top->{_list}->delete(0, "end");
  for my $i (@records)
  {
    $Top->{_list}->insert("end", $i->summary)
  }
  updown($Top->{_list}, "+0");
  $Top->Unbusy;
  my $i = $Top->{_box}->Show;
  return undef if $i eq "Cancel";
  $i = $Top->{_list}->curselection if $i eq "Ok";
  $records[$i];
}

# TODO - put in Gedcom.pm
sub get_tag($)
{
  my ($tag) = @_;

tkged  view on Meta::CPAN

#   print "Pressed ", $ev->K, "\n";
    $w->afterIdle(sub { record_changed() });
  });

  my $c = $Top->{_canv_frame} =
     $main_fr->Scrolled("Canvas", -scrollbars => "osoe")
             ->pack(-fill => "both", -expand => 1);
  my $canv = $Top->{_canv} = $c->Subwidget("scrolled");


  $Top->Unbusy;
}

sub set_entry($)
{
  my ($entry) = @_;
  # print "entry $entry\n";
  my $t = $Top->{_canv}{_ged}{$entry};
  if (exists $t->{_Entry} && $t->{_Entry}->Exists)
  {
    my $val = $t->{value} || $t->{xref};

tkged  view on Meta::CPAN

            # print "fam_tag is $fam_tag xref $family->{xref}\n";
            $new->get_child($fam_tag)->{value} = $family->{xref};
            # print "new is ", Dumper $new;
          }
        }

      }
      $Ged->collect_xrefs();
    }
  }
  $Top->Unbusy;
}

sub has_entry($)
{
  my ($tag) = @_;
  exists $Top->{_canv}{_ged}{$tag}{_Entry} &&
  $Top->{_canv}{_ged}{$tag}{_Entry}->Exists;
}

sub add_record($$)

tkged  view on Meta::CPAN

{
  my ($ind) = @_;
  $Top->Busy;
  $Top->{_show_menu}->destroy if exists $Top->{_show_menu};
  $Top->{_show_menu} = $Top->{_menu_fr}->Menubutton
    (
      -text      => "Show",
      -underline => 0,
      -menuitems => show_menu_children($ind)
    )->pack(-side => "left");
  $Top->Unbusy;
}

sub add_add_menu(;$)
{
  my ($new) = @_;
  # print "adding menu for $Rec->{tag}\n";
  $Top->Busy;
  if ($new)
  {
    $Top->{_add_menu}{$Rec->{tag}}->destroy;

tkged  view on Meta::CPAN

      )
    )->pack(-side => "left");
  }

  for (values %{$Top->{_add_menu}})
  {
    $_->configure(-state => "disabled");
  }
  $Top->{_add_menu}{$Rec->{tag}}->configure(-state => "normal");

  $Top->Unbusy;
}

sub create_fams($$$)
{
  my ($me, $child, $fam_type) = @_;
  my $fams_id = $Rec->child_value("FAMS");
  unless ($fams_id)
  {
    # TODO - this should be in Gedcom.pm
    my $max = 0;

tkged  view on Meta::CPAN

      {
        delete $record->{"_$_"};
      }
    }
    delete $canv->{_ged};
  }
  if (!$rec ||
        exists $canv->{_ged}{_XREF1}{xref} &&
        $canv->{_ged}{_XREF1}{xref} eq $rec->{xref})
  {
    $Top->Unbusy;
    return;
  }

  my $key = $prefix . "_XREF1";
  $canv->{_ged}{$key} = $rec;

  show_children($prefix, $rec, $full);

  if ($full)
  {

tkged  view on Meta::CPAN

    }

    # print "setting ", join(", ", sort keys %{$canv->{_ged}}), "\n";
    set_entries();

    add_add_menu();
    add_show_menu($rec);

    record_changed();
  }
  $Top->Unbusy;
}

sub show_children($$$)
{
  my ($prefix, $ind, $full) = @_;
  my %counts;
  for my $child (@{$ind->{children}})
  {
    my $key = $prefix . "_" . $child->{tag} . ++$counts{$child->{tag}};
    # print "key $key for ", Dumper $child;