Recipe 15.19. Program: tkshufflepod
Author: Tom Christiansen & Nathan Torkington
Date: 1999-07-02T01:43:33Z

#

| Chapter 15 User Interfaces |

## 15.19. Program: tkshufflepod

This short program uses Tk to list the `=head1` sections in the file using the Listbox widget, and it lets you drag the sections around to reorder them. When you're done, press `"s"` or `"q"` to save or quit. You can even double-click on a section to view it with the Pod widget. It writes the section text to a temporary file in /tmp and removes the file when the Pod widget is destroyed.

Call it with the name of the Pod file to view:

    % tkshufflepod chap15.pod

We used this a lot when we wrote this book.

The program text is shown in Example 15.10.

#### Example 15.10: tkshufflepod

    #!/usr/bin/perl -w
    # tkshufflepod - reorder =head1 sections in a pod file

    use Tk;
    use strict;

    # declare variables

    my $podfile;     # name of the file to open
    my $m;           # main window
    my $l;           # listbox
    my ($up, $down);   # positions to move
    my @sections;      # list of pod sections
    my $all_pod;       # text of pod file (used when reading)

    # read the pod file into memory, and split it into sections.

    $podfile = shift || "-";

    undef $/;
    open(F, "< $podfile")
      or die "Can't open $podfile : $!\n";
    $all_pod = <F>;
    close(F);
    @sections = split(/(?==head1)/, $all_pod);

    # turn @sections into an array of anonymous arrays.  The first element
    # in each of these arrays is the original text of the message, while
    # the second element is the text following =head1 (the section title).

    foreach (@sections) {
        /(.*)/;
        $_ = [ $_, $1 ];
    }

    # fire up Tk and display the list of sections.

    $m = MainWindow->new();
    $l = $m->Listbox('-width' => 60)->pack('-expand' => 1, '-fill' => 'both');

    foreach my $section (@sections) {
        $l->insert("end", $section->[1]);
    }

    # permit dragging by binding to the Listbox widget.
    $l->bind( '<Any-Button>'     => \&down );
    $l->bind( '<Any-ButtonRelease>' => \&up );

    # permit viewing by binding double-click
    $l->bind( '<Double-Button>'     => \&view );

    # 'q' quits and 's' saves
    $m->bind( '<q>'     => sub { exit } );
    $m->bind( '<s>'     => \&save );

    MainLoop;

    # down(widget): called when the user clicks on an item in the Listbox.

    sub down {
        my $self = shift;
        $down = $self->curselection;;
    }

    # up(widget): called when the user releases the mouse button in the
    # Listbox.

    sub up {
        my $self = shift;
        my $elt;

        $up = $self->curselection;;

        return if $down == $up;

        # change selection list
        $elt = $sections[$down];
        splice(@sections, $down, 1);
        splice(@sections, $up, 0, $elt);

        $self->delete($down);
        $self->insert($up, $sections[$up]->[1]);
    }

    # save(widget): called to save the list of sections.

    sub save {
        my $self = shift;

        open(F, "> $podfile")
          or die "Can't open $podfile for writing: $!";
        print F map { $_->[0] } @sections;
        close F;

        exit;
    }

    # view(widget): called to display the widget.  Uses the Pod widget.

    sub view {
        my $self = shift;
        my $temporary = "/tmp/$$-section.pod";
        my $popup;

        open(F, "> $temporary")
          or warn ("Can't open $temporary : $!\n"), return;
        print F $sections[$down]->[0];
        close(F);
        $popup = $m->Pod('-file' => $temporary);

        $popup->bind('<Destroy>' => sub { unlink $temporary } );
    }

15.18. Program: Small termcap program |  | 16. Process Management and Communication