~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to Tk/FBox.pm

• browse files at revision 3
• compare with another revision
• download diff
• download tarball
• view history from revision 3

Show diffs side-by-side

added

removed

Tk/FBox.pm

39

39

use strict;

40

40

use vars qw($VERSION $updirImage $folderImage $fileImage);

41

41

 

42

 

$VERSION = '3.020'; # $Id: //depot/Tk8/Tk/FBox.pm#20 $

 

42

$VERSION = '3.023'; # $Id: //depot/Tk8/Tk/FBox.pm#23 $

43

43

 

44

44

use base qw(Tk::Toplevel);

45

45

 

46

46

Construct Tk::Widget 'FBox';

47

47

 

48

 

my $selectFilePath;

49

 

my $selectFile;

50

 

my $selectPath;

51

 

 

52

48

sub import {

53

49

    if (defined $_[1] and $_[1] eq 'as_default') {

54

50

        local $^W = 0;

58

54

    }

59

55

}

60

56

 

 

57

# Note that -sortcmd is experimental and the interface is likely to change.

 

58

# Using -sortcmd is really strange :-(

 

59

# $top->getOpenFile(-sortcmd => sub { package Tk::FBox; uc $b cmp uc $a});

 

60

# or, un-perlish, but useable (now activated in code):

 

61

# $top->getOpenFile(-sortcmd => sub { uc $_[1] cmp uc $_[0]});

 

62

 

61

63

sub Populate {

62

64

    my($w, $args) = @_;

63

65

 

75

77

                      -textvariable => \$w->{'selectPath'},

76

78

                      -command => ['SetPath', $w]);

77

79

    my $upBtn = $f1->Button;

78

 

    if (!defined $updirImage) {

79

 

        $updirImage = $w->Bitmap(-data => "#define updir_width 28\n" .

80

 

                                          "#define updir_height 16\n" .

81

 

                                          <<EOF);

 

80

    if (!defined $updirImage->{$w->MainWindow}) {

 

81

        $updirImage->{$w->MainWindow} = $w->Bitmap(-data => <<EOF);

 

82

#define updir_width 28

 

83

#define updir_height 16

82

84

static char updir_bits[] = {

83

85

   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,

84

86

   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,

88

90

   0xf0, 0xff, 0xff, 0x01};

89

91

EOF

90

92

    }

91

 

    $upBtn->configure(-image => $updirImage);

 

93

    $upBtn->configure(-image => $updirImage->{$w->MainWindow});

92

94

    $dirMenu->configure(-takefocus => 1, -highlightthickness => 2);

93

95

    $upBtn->pack(-side => 'right', -padx => 4, -fill => 'both');

94

96

    $lab->pack(-side => 'left', -padx => 4, -fill => 'both');

128

130

       -relief => $f2_lab->cget(-relief),

129

131

       -padx => $f2_lab->cget(-padx),

130

132

       -pady => $f2_lab->cget(-pady),

 

133

       -takefocus => 0,

131

134

      );

132

135

    $typeMenuLab->bindtags([$typeMenuLab, 'Label',

133

136

                            $typeMenuLab->toplevel, 'all']);

198

201

    $w->SetPath(_cwd());

199

202

 

200

203

    $w->ConfigSpecs(-defaultextension => ['PASSIVE', undef, undef, undef],

201

 

                    -filetypes        => ['PASSIVE', undef, undef, undef],

202

 

                    -initialdir       => ['PASSIVE', undef, undef, undef],

203

 

                    -initialfile      => ['PASSIVE', undef, undef, undef],

204

 

                    -title            => ['PASSIVE', undef, undef, undef],

205

 

                    -type             => ['PASSIVE', undef, undef, 'open'],

206

 

                    -filter           => ['PASSIVE', undef, undef, '*'],

207

 

                    -force            => ['PASSIVE', undef, undef, 0],

208

 

                    'DEFAULT'         => [$icons],

209

 

                   );

 

204

                    -filetypes        => ['PASSIVE', undef, undef, undef],

 

205

                    -initialdir       => ['PASSIVE', undef, undef, undef],

 

206

                    -initialfile      => ['PASSIVE', undef, undef, undef],

 

207

#                   -sortcmd          => ['PASSIVE', undef, undef, sub { lc($a) cmp lc($b) }],

 

208

                    -sortcmd          => ['PASSIVE', undef, undef, sub { lc($_[0]) cmp lc($_[1]) }],

 

209

                    -title            => ['PASSIVE', undef, undef, undef],

 

210

                    -type             => ['PASSIVE', undef, undef, 'open'],

 

211

                    -filter           => ['PASSIVE', undef, undef, '*'],

 

212

                    -force            => ['PASSIVE', undef, undef, 0],

 

213

                    'DEFAULT'         => [$icons],

 

214

                   );

210

215

    # So-far-failed attempt to break reference loops ...

211

216

    $w->_OnDestroy(qw(dirMenu icons typeMenuLab typeMenuBtn okBtn ent updateId));

212

217

    $w;

213

218

}

214

219

 

215

 

 

 

220

# -initialdir fix with ResolveFile

216

221

sub Show {

217

222

    my $w = shift;

218

223

 

225

230

    {

226

231

        my $initialdir = $w->cget(-initialdir);

227

232

        if (defined $initialdir) {

228

 

            if (-d $initialdir) {

229

 

                $w->{'selectPath'} = $initialdir;

 

233

            my ($flag, $path, $file) = ResolveFile($initialdir, 'junk');

 

234

            if ($flag eq 'OK' or $flag eq 'FILE') {

 

235

                $w->{'selectPath'} = $path;

230

236

            } else {

231

237

                $w->Error("\"$initialdir\" is not a valid directory");

232

238

            }

253

259

        $typeMenuBtn->configure(-state => 'normal');

254

260

        $typeMenuLab->configure(-state => 'normal');

255

261

    } else {

256

 

        $w->configure(-filter => '*');

 

262

#XXX    $w->configure(-filter => '*');

257

263

        $typeMenuBtn->configure(-state => 'disabled',

258

264

                                -takefocus => 0);

259

265

        $typeMenuLab->configure(-state => 'disabled');

286

292

    my $ent = $w->{'ent'};

287

293

    $ent->focus;

288

294

    $ent->delete(0, 'end');

289

 

    $ent->insert(0, $w->{'selectFile'});

290

 

    $ent->selectionFrom(0);

291

 

    $ent->selectionTo('end');

292

 

    $ent->icursor('end');

 

295

    if (defined $w->{'selectFile'} && $w->{'selectFile'} ne '') {

 

296

        $ent->insert(0, $w->{'selectFile'});

 

297

        $ent->selectionFrom(0);

 

298

        $ent->selectionTo('end');

 

299

        $ent->icursor('end');

 

300

    }

293

301

 

294

302

    # 8. Wait for the user to respond, then restore the focus and

295

303

    # return the index of the selected button.  Restore the focus

296

304

    # before deleting the window, since otherwise the window manager

297

305

    # may take the focus away so we can't redirect it.  Finally,

298

306

    # restore any grab that was in effect.

299

 

    $w->waitVariable(\$selectFilePath);

 

307

    $w->waitVariable(\$w->{'selectFilePath'});

300

308

    eval {

301

309

        $oldFocus->focus if $oldFocus;

302

310

    };

304

312

        $w->grabRelease;

305

313

        $w->withdraw;

306

314

    }

307

 

    if ($oldGrab) {

 

315

    if (Tk::Exists($oldGrab) && $oldGrab->viewable) {

308

316

        if ($grabStatus eq 'global') {

309

317

            $oldGrab->grabGlobal;

310

318

        } else {

311

319

            $oldGrab->grab;

312

320

        }

313

321

    }

314

 

    return $selectFilePath;

 

322

    return $w->{'selectFilePath'};

315

323

}

316

324

 

317

325

# tkFDialog_UpdateWhenIdle --

347

355

    } else {

348

356

        delete $w->{'updateId'};

349

357

    }

350

 

    unless (defined $folderImage) {

 

358

    unless (defined $folderImage->{$w->MainWindow}) {

351

359

        require Tk::Pixmap;

352

 

        $folderImage = $w->Pixmap(-file => Tk->findINC('folder.xpm'));

353

 

        $fileImage   = $w->Pixmap(-file => Tk->findINC('file.xpm'));

 

360

        $folderImage->{$w->MainWindow} = $w->Pixmap(-file => Tk->findINC('folder.xpm'));

 

361

        $fileImage->{$w->MainWindow}   = $w->Pixmap(-file => Tk->findINC('file.xpm'));

354

362

    }

355

 

    my $folder = $folderImage;

356

 

    my $file   = $fileImage;

 

363

    my $folder = $folderImage->{$w->MainWindow};

 

364

    my $file   = $fileImage->{$w->MainWindow};

357

365

    my $appPWD = _cwd();

358

366

    if (!ext_chdir($w->{'selectPath'})) {

359

367

        # We cannot change directory to $data(selectPath). $data(selectPath)

381

389

    $icons->DeleteAll;

382

390

 

383

391

    # Make the dir & file list

384

 

    my $flt = join('|', split(' ', $w->cget(-filter)) );

385

 

    $flt =~ s!([\.\+])!\\$1!g;

386

 

    $flt =~ s!\*!.*!g;

 

392

    my $cwd = _cwd();

387

393

    local *FDIR;

388

 

    if( opendir( FDIR,  _cwd() )) {

389

 

      my @files;

390

 

        foreach my $f (sort { lc($a) cmp lc($b) } readdir FDIR) {

391

 

          next if $f eq '.' or $f eq '..';

392

 

          if (-d $f) { $icons->Add($folder, $f); }

393

 

          elsif( $f =~ m!$flt$! ) { push( @files, $f ); }

394

 

        }

395

 

      closedir( FDIR );

396

 

      foreach my $f ( @files ) { $icons->Add($file, $f); }

 

394

    if (opendir(FDIR, $cwd)) {

 

395

        my @files;

 

396

#       my $sortcmd = $w->cget(-sortcmd);

 

397

        my $sortcmd = sub { $w->cget(-sortcmd)->($a,$b) };

 

398

        my $flt = $w->cget(-filter);

 

399

        my $fltcb;

 

400

        if (ref $flt eq 'CODE') {

 

401

            $fltcb = $flt;

 

402

        } else {

 

403

            $flt = _rx_to_glob($flt);

 

404

        }

 

405

        foreach my $f (sort $sortcmd readdir(FDIR)) {

 

406

            next if $f eq '.' or $f eq '..';

 

407

            if ($fltcb) {

 

408

                next if !$fltcb->($w, $f, $cwd);

 

409

            } else {

 

410

                next if -f $f && $f !~ m!$flt!;

 

411

            }

 

412

            if (-d $f) {

 

413

                $icons->Add($folder, $f);

 

414

            } else {

 

415

                push @files, $f;

 

416

            }

 

417

        }

 

418

        closedir(FDIR);

 

419

        foreach my $f (@files) {

 

420

            $icons->Add($file, $f);

 

421

        }

397

422

    }

398

423

 

399

424

    $icons->Arrange;

709

734

# Gets called when user presses the "Cancel" button

710

735

#

711

736

sub CancelCmd {

712

 

    undef $selectFilePath;

 

737

    my $w = shift;

 

738

    undef $w->{'selectFilePath'};

713

739

}

714

740

 

715

741

# Gets called when user browses the IconList widget (dragging mouse, arrow

752

778

            $w->SetPath($file);

753

779

        }

754

780

    } else {

755

 

        $w->{'selectFile'} = $file;

756

 

        $w->Done;

 

781

        my($flag, $path, $file) = ResolveFile($w->{'selectPath'}, $text);

 

782

        if ($flag ne 'OK') {

 

783

            $w->messageBox(-type => 'OK',

 

784

                           -message => "Cannot resolve $w->{'selectPath'}/$text.",

 

785

                           -icon => 'error');

 

786

        } else {

 

787

            $path = JoinFile($path, $file);

 

788

            $w->Done($path);

 

789

        }

757

790

    }

758

791

}

759

792

 

780

813

            return unless (lc($reply) eq 'yes');

781

814

        }

782

815

    }

783

 

    $selectFilePath = ($_selectFilePath ne '' ? $_selectFilePath : undef);

 

816

    $w->{'selectFilePath'} = ($_selectFilePath ne '' ? $_selectFilePath : undef);

784

817

}

785

818

 

786

819

sub FDialog {

887

920

    $1;

888

921

}

889

922

 

 

923

sub _rx_to_glob {

 

924

    my $arg = shift;

 

925

    $arg = join('|', split(' ', $arg));

 

926

    $arg =~ s!([\.\+])!\\$1!g;

 

927

    $arg =~ s!\*!.*!g;

 

928

    $arg = "^" . $arg . "\$";

 

929

    if ($] >= 5.005) {

 

930

        $arg = qr($arg);

 

931

    }

 

932

    $arg;

 

933

}

 

934

 

890

935

1;

891

936

 

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1