~ubuntu-branches/ubuntu/trusty/libui-dialog-perl/trusty : revision 1

1

package UI::Dialog::Backend::XDialog;

2

###############################################################################

3

4

#

5

# This library is free software; you can redistribute it and/or

6

# modify it under the terms of the GNU Lesser General Public

7

# License as published by the Free Software Foundation; either

8

# version 2.1 of the License, or (at your option) any later version.

9

#

10

# This library is distributed in the hope that it will be useful,

11

# but WITHOUT ANY WARRANTY; without even the implied warranty of

12

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU

13

# Lesser General Public License for more details.

14

#

15

# You should have received a copy of the GNU Lesser General Public

16

# License along with this library; if not, write to the Free Software

17

# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18

###############################################################################

19

use 5.006;

20

use strict;

21

use FileHandle;

22

use File::Basename;

23

use Carp;

24

use Cwd qw( abs_path );

25

use UI::Dialog::Backend;

26

27

BEGIN {

28

use vars qw( $VERSION @ISA );

29

@ISA = qw( UI::Dialog::Backend );

30

$VERSION = '1.08';

31

}

32

33

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

34

#: Constructor Method

35

#:

36

37

sub new {

38

my $proto = shift();

39

my $class = ref($proto) || $proto;

40

my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});

41

my $self = {};

42

bless($self, $class);

43

$self->{'_state'} = {};

44

$self->{'_opts'} = {};

45

46

#: Dynamic path discovery...

47

my $CFG_PATH = $cfg->{'PATH'};

48

if ($CFG_PATH) {

49

if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }

50

elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }

51

elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }

52

} elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }

53

else { $self->{'PATHS'} = ''; }

54

55

$self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();

56

57

$self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0;

58

59

$self->{'_opts'}->{'XDIALOG_HIGH_DIALOG_COMPAT'} = 1

60

unless not $cfg->{'XDIALOG_HIGH_DIALOG_COMPAT'};

61

62

$self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();

63

# --wmclass <name>

64

$self->{'_opts'}->{'wmclass'} = $cfg->{'wmclass'} || undef();

65

# --rc-file <gtkrc filename>

66

$self->{'_opts'}->{'rcfile'} = $cfg->{'rcfile'} || undef();

67

# --backtitle <backtitle>

68

$self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();

69

# --title <title>

70

$self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();

71

# --allow-close | --no-close

72

$self->{'_opts'}->{'allowclose'} = $cfg->{'allowclose'} || 0;

73

$self->{'_opts'}->{'noclose'} = $cfg->{'noclose'} || 0;

74

# --screen-center | --under-mouse | --auto-placement

75

$self->{'_opts'}->{'screencenter'} = $cfg->{'screencenter'} || 0;

76

$self->{'_opts'}->{'undermouse'} = $cfg->{'undermouse'} || 0;

77

$self->{'_opts'}->{'autoplacement'} = $cfg->{'autoplacement'} || 0;

78

# --center | --right | --left | --fill

79

$self->{'_opts'}->{'center'} = $cfg->{'center'} || 0;

80

$self->{'_opts'}->{'right'} = $cfg->{'right'} || 0;

81

$self->{'_opts'}->{'left'} = $cfg->{'left'} || 0;

82

$self->{'_opts'}->{'fill'} = $cfg->{'fill'} || 0;

83

# --no-wrap | --wrap

84

$self->{'_opts'}->{'nowrap'} = $cfg->{'nowrap'} || 0;

85

$self->{'_opts'}->{'wrap'} = $cfg->{'wrap'} || 0;

86

# --cr-wrap | --no-cr-wrap

87

$self->{'_opts'}->{'crwrap'} = $cfg->{'crwrap'} || 0;

88

$self->{'_opts'}->{'nocrwrap'} = $cfg->{'nocrwrap'} || 0;

89

# --buttons-style default|icon|text

90

$self->{'_opts'}->{'buttonsstyle'} = $cfg->{'buttonsstyle'} || 'default';

91

# --fixed-font (tailbox, textbox, and editbox)

92

$self->{'_opts'}->{'fixedfont'} = $cfg->{'fixedfont'} || 0;

93

# --editable (combobox)

94

$self->{'_opts'}->{'editable'} = $cfg->{'editable'} || 0;

95

# --time-stamp | --date-stamp (logbox)

96

$self->{'_opts'}->{'timestamp'} = $cfg->{'timestamp'} || 0;

97

$self->{'_opts'}->{'datestamp'} = $cfg->{'datestamp'} || 0;

98

# --reverse (logbox)

99

$self->{'_opts'}->{'reverse'} = $cfg->{'reverse'} || 0;

100

# --keep-colors (logbox)

101

$self->{'_opts'}->{'keepcolors'} = $cfg->{'keepcolours'} || $cfg->{'keepcolors'} || 0;

102

# --interval <timeout> (input(s) boxes, combo box, range(s) boxes, spin(s) boxes, list boxes, menu box, treeview, calendar, timebox)

103

$self->{'_opts'}->{'interval'} = $cfg->{'interval'} || 0;

104

# --no-tags (menubox, checklist and radiolist)

105

$self->{'_opts'}->{'notags'} = $cfg->{'notags'} || 0;

106

# --item-help (menubox, checklist, radiolist, buildlist and treeview)

107

$self->{'_opts'}->{'itemhelp'} = $cfg->{'itemhelp'} || 0;

108

# --default-item <tag> (menubox)

109

$self->{'_opts'}->{'defaultitem'} = $cfg->{'defaultitem'} || undef();

110

# --icon <xpm filename> (textbox, editbox, tailbox, logbox, fselect and dselect)

111

$self->{'_opts'}->{'icon'} = $cfg->{'icon'} || undef();

112

# --no-ok (tailbox and logbox)

113

$self->{'_opts'}->{'nook'} = $cfg->{'nook'} || 0;

114

# --no-cancel (infobox, gauge and progress)

115

$self->{'_opts'}->{'nocancel'} = $cfg->{'nocancel'} || 0;

116

# --no-buttons (textbox, tailbox, logbox, infobox fselect and dselect)

117

$self->{'_opts'}->{'nobuttons'} = $cfg->{'nobuttons'} || 0;

118

# --default-no !(wizard)

119

$self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0;

120

# --wizard !(msgbox, infobox, gauge and progress)

121

$self->{'_opts'}->{'wizard'} = $cfg->{'wizard'} || 0;

122

# --help <help> (infobox, gauge and progress)

123

$self->{'_opts'}->{'help'} = $cfg->{'help'} || undef();

124

# --print <printer> (textbox, editbox and tailbox)

125

$self->{'_opts'}->{'print'} = $cfg->{'print'} || undef();

126

# --check <label> !(infobox, gauge and progress)

127

$self->{'_opts'}->{'check'} = $cfg->{'check'} || undef();

128

# --ok-label <label> !(wizard)

129

$self->{'_opts'}->{'oklabel'} = $cfg->{'oklabel'} || undef();

130

# --cancel-label <label> !(wizard)

131

$self->{'_opts'}->{'cancellabel'} = $cfg->{'cancellabel'} || undef();

132

# --beep | --beep-after (all)

133

$self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';

134

$self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;

135

$self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;

136

# --begin <Yorg> <Xorg> (all)

137

$self->{'_opts'}->{'begin'} = $cfg->{'begin'} || undef(); #: 'begin' => [$y,$x]

138

# --ignore-eof (infobox and gauge)

139

$self->{'_opts'}->{'ignoreeof'} = $cfg->{'ignoreeof'} || 0;

140

# --smooth (tailbox and logbox)

141

$self->{'_opts'}->{'smooth'} = $cfg->{'smooth'} || 0;

142

143

#: \/we handle these internally\/

144

# --stderr | --stdout

145

# --separator <character> | --separate-output

146

#: ^^we handle these internally^^

147

148

$self->{'_opts'}->{'bin'} ||= $self->_find_bin('Xdialog');

149

unless (-x $self->{'_opts'}->{'bin'}) {

150

croak("the Xdialog binary could not be found.");

151

}

152

153

#: to determin upper limits use:

154

# --print-maxsize

155

#: STDOUT| MaxSize: \d+(width), \d+(height)

156

$self->{'_opts'}->{'width'} = $cfg->{'width'} || 0;

157

$self->{'_opts'}->{'height'} = $cfg->{'height'} || 0;

158

$self->{'_opts'}->{'listheight'} = $cfg->{'listheight'} || $cfg->{'menuheight'} || 5;

159

$self->{'_opts'}->{'percentage'} = $cfg->{'percentage'} || 1;

160

161

$self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;

162

$self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;

163

$self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;

164

$self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;

165

$self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;

166

167

return($self);

168

}

169

170

171

172

173

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

174

#: Private Methods

175

#:

176

my $SIG_CODE = {'PROGRESS'=>{},'GAUGE'=>{}};

177

sub _del_progress {

178

my $CODE = $SIG_CODE->{'PROGRESS'}->{$$};

179

unless (not ref($CODE)) {

180

delete($CODE->{'_PROGRESS'});

181

$CODE->rv('1');

182

$CODE->rs('null');

183

$CODE->ra('null');

184

$SIG_CODE->{$$} = "";

185

}

186

}

187

sub _del_gauge {

188

my $CODE = $SIG_CODE->{'GAUGE'}->{$$};

189

unless (not ref($CODE)) {

190

delete($CODE->{'_GAUGE'});

191

$CODE->rv('1');

192

$CODE->rs('null');

193

$CODE->ra('null');

194

$SIG_CODE->{$$} = "";

195

}

196

}

197

sub _mk_cmnd {

198

my $self = shift();

199

my $final = shift();

200

my $cmnd = $self->{'_opts'}->{'bin'};

201

my $args = $self->_merge_attrs(@_);

202

203

$cmnd = 'XDIALOG_HIGH_DIALOG_COMPAT="1" ' . $cmnd

204

unless not $args->{'XDIALOG_HIGH_DIALOG_COMPAT'};

205

206

# --wmclass <name>

207

$cmnd .= ' --wmclass "' . $args->{'wmclass'} . '"' unless not $args->{'wmclass'};

208

# --rc-file <gtkrc filename>

209

$cmnd .= ' --rc-file "' . $args->{'rcfile'} . '"' unless not $args->{'rcfile'} or not -r $args->{'rcfile'};

210

# --begin <Yorg> <Xorg> (all)

211

$cmnd .= ' --begin "' . $args->{'begin'}->[0] . '" "' . $args->{'begin'}->[1] . '"'

212

unless not $args->{'begin'} or not ref($args->{'begin'}) or ref($args->{'begin'}) ne "ARRAY";

213

# --editable (combobox)

214

$cmnd .= ' --editable' unless not $args->{'editable'};

215

# --title <title>

216

$cmnd .= ' --title "' . $args->{'title'} . '"' unless not $args->{'title'};

217

# --backtitle <backtitle>

218

$cmnd .= ' --backtitle "' . $args->{'backtitle'} . '"' unless not $args->{'backtitle'};

219

# --allow-close | --no-close

220

$cmnd .= ' --allow-close' unless not $args->{'allow-close'} and not $args->{'allowclose'};

221

$cmnd .= ' --no-close' unless not $args->{'no-close'} and not $args->{'noclose'};

222

# --screen-center | --under-mouse | --auto-placement

223

$cmnd .= ' --screen-center' unless not $args->{'screen-center'} and not $args->{'screencenter'};

224

$cmnd .= ' --under-mouse' unless not $args->{'under-mouse'} and not $args->{'undermouse'};

225

$cmnd .= ' --auto-placement' unless not $args->{'auto-placement'} and not $args->{'autoplacement'};

226

# --center | --right | --left | --fill

227

$cmnd .= ' --center' unless not $args->{'center'};

228

$cmnd .= ' --right' unless not $args->{'right'};

229

$cmnd .= ' --left' unless not $args->{'left'};

230

$cmnd .= ' --fill' unless not $args->{'fill'};

231

# --no-wrap | --wrap

232

$cmnd .= ' --no-wrap' unless not $args->{'no-wrap'} and not $args->{'nowrap'};

233

$cmnd .= ' --wrap' unless not $args->{'wrap'};

234

# --cr-wrap | --no-cr-wrap

235

$cmnd .= ' --crwrap' unless not $args->{'crwrap'};

236

$cmnd .= ' --nocrwrap' unless not $args->{'nocrwrap'};

237

# --buttons-style default|icon|text

238

$cmnd .= ' --buttons-style "' . ($args->{'buttonsstyle'}||$args->{'buttons-style'}) . '"' unless not $args->{'buttons-style'} and not $args->{'buttonsstyle'};

239

# --fixed-font (tailbox, textbox, and editbox)

240

$cmnd .= ' --fixed-font' unless not $args->{'fixed-font'} and not $args->{'fixedfont'};

241

# --time-stamp | --date-stamp (logbox)

242

$cmnd .= ' --time-stamp' unless not $args->{'time-stamp'} and not $args->{'timestamp'};

243

$cmnd .= ' --date-stamp' unless not $args->{'date-stamp'} and not $args->{'datestamp'};

244

# --reverse (logbox)

245

$cmnd .= ' --reverse' unless not $args->{'reverse'};

246

# --keep-colors (logbox)

247

$cmnd .= ' --keep-colors' unless not $args->{'keep-colors'} and not $args->{'keep-colours'} and not $args->{'keepcolors'} and not $args->{'keepcolours'};

248

# --interval <timeout> (input(s) boxes, combo box, range(s) boxes, spin(s) boxes, list boxes, menu box, treeview, calendar, timebox)

249

$cmnd .= ' --interval "' . $args->{'interval'} . '"' unless not $args->{'interval'};

250

# --no-tags (menubox, checklist and radiolist)

251

$cmnd .= ' --no-tags' unless not $args->{'no-tags'} and not $args->{'notags'};

252

# --item-help (menubox, checklist, radiolist, buildlist and treeview)

253

$cmnd .= ' --item-help' unless not $args->{'item-help'} and not $args->{'itemhelp'};

254

# --default-item <tag> (menubox)

255

$cmnd .= ' --default-item "' . ($args->{'defaultitem'}||$args->{'default-item'}) . '"' unless not $args->{'default-item'} and not $args->{'defaultitem'};

256

# --icon <xpm filename> (textbox, editbox, tailbox, logbox, fselect and dselect)

257

$cmnd .= ' --icon "' . $args->{'icon'} . '"' unless not $args->{'icon'};

258

# --no-ok (tailbox and logbox)

259

$cmnd .= ' --no-ok' unless not $args->{'no-ok'} and not $args->{'nook'};

260

# --no-cancel (infobox, gauge and progress)

261

$cmnd .= ' --no-cancel' unless not $args->{'no-cancel'} and not $args->{'nocancel'};

262

# --no-buttons (textbox, tailbox, logbox, infobox fselect and dselect)

263

$cmnd .= ' --no-buttons' unless not $args->{'no-buttons'} and not $args->{'nobuttons'};

264

# --default-no !(wizard)

265

$cmnd .= ' --default-no' unless not $args->{'default-no'} and not $args->{'defaultno'};

266

# --wizard !(msgbox, infobox, gauge and progress)

267

$cmnd .= ' --wizard' unless not $args->{'wizard'};

268

# --help <help> (infobox, gauge and progress)

269

$cmnd .= ' --help "' . $args->{'help'} . '"' unless not $args->{'help'};

270

# --print <printer> (textbox, editbox and tailbox)

271

$cmnd .= ' --print "' . $args->{'print'} . '"' unless not $args->{'print'};

272

# --check <label> !(infobox, gauge and progress)

273

$cmnd .= ' --check "' . $args->{'check'}||$self->{'_opts'}->{'check'} . '"' unless not $args->{'check'};

274

# --ok-label <label> !(wizard)

275

$cmnd .= ' --ok-label "' . ($args->{'oklabel'}||$args->{'ok-label'}) . '"' unless not $args->{'ok-label'} and not $args->{'oklabel'};

276

# --cancel-label <label> !(wizard)

277

$cmnd .= ' --cancel-label "' . ($args->{'cancellabel'}||$args->{'cancel-label'}) . '"' unless not $args->{'cancel-label'} and not $args->{'cancellabel'};

278

# --beep | --beep-after (all)

279

# $cmnd .= ' --beep' unless not $args->{'beep'};

280

# --ignore-eof (infobox and gauge)

281

$cmnd .= ' --ignore-eof' unless not $args->{'ignore-eof'} and not $args->{'ignoreeof'};

282

# --smooth (tailbox and logbox)

283

$cmnd .= ' --smooth' unless not $args->{'smooth'};

284

285

$cmnd .= " " . $final;

286

return($cmnd);

287

}

288

289

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

290

#: State Methods (override inherited)

291

#:

292

293

#: report on the state of the last widget.

294

sub state {

295

my $self = shift();

296

my $rv = $self->rv() || 0;

297

$self->_debug((join(" | ",(caller())))." > state() > is: ".($rv||'NULL'),2);

298

if ($rv == 1 or $rv == 129) {

299

return("CANCEL");

300

} elsif ($rv == 2) {

301

return("HELP");

302

} elsif ($rv == 3) {

303

return("PREVIOUS");

304

} elsif ($rv == 254) {

305

return("ERROR");

306

} elsif ($rv == 255) {

307

return("ESC");

308

} elsif (not $rv or $rv =~ /^null$/i) {

309

return("OK");

310

} else {

311

return("UNKNOWN(".$rv.")");

312

}

313

}

314

315

316

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

317

#: Public Methods

318

#:

319

320

# --combobox <text> <height> <width> <item1> ... <itemN>

321

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

322

#: display a dropdown list that's editable

323

sub combobox {

324

my $self = shift();

325

my $caller = (caller(1))[3] || 'main';

326

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

327

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

328

my $args = $self->_pre($caller,@_);

329

330

my $command = $self->_mk_cmnd(" --separate-output --combobox",@_);

331

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

332

$command .= ' "' . ($args->{'height'}||'20') . '"';

333

$command .= ' "' . ($args->{'width'}||'65') . '"';

334

335

if ($args->{'list'}) {

336

$args->{'list'} = [ $args->{'list'} ] unless ref($args->{'list'}) eq "ARRAY";

337

foreach my $item (@{$args->{'list'}}) {

338

$command .= ' "' . $item . '"';

339

}

340

} else {

341

$args->{'items'} = [ $args->{'items'} ] unless ref($args->{'items'}) eq "ARRAY";

342

foreach my $item (@{$args->{'items'}}) {

343

$command .= ' "' . $item . '"';

344

}

345

}

346

347

my ($rv,$selected) = $self->command_string($command);

348

349

$self->rv($rv||'null');

350

$self->ra('null');

351

$self->rs('null');

352

my $this_rv;

353

if ($rv && $rv >= 1) {

354

$this_rv = 0;

355

} else {

356

$self->ra($selected);

357

$self->rs($selected);

358

$this_rv = $selected;

359

}

360

$self->_post($args);

361

return($this_rv);

362

}

363

364

365

# --rangebox <text> <height> <width> <min value> <max value> [<default value>]

366

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

367

#: display a slider bar with a preset range.

368

sub rangebox {

369

my $self = shift();

370

my $caller = (caller(1))[3] || 'main';

371

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

372

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

373

my $args = $self->_pre($caller,@_);

374

375

my $command = $self->_mk_cmnd(" --rangebox",@_);

376

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

377

$command .= ' "' . ($args->{'height'}||'20') . '"';

378

$command .= ' "' . ($args->{'width'}||'65') . '"';

379

$command .= ' "' . ($args->{'min'}||'0') . '"';

380

$command .= ' "' . ($args->{'max'}||'100') . '"';

381

$command .= ' "' . ($args->{'def'}||'0') . '"';

382

383

my ($rv,$selected) = $self->command_string($command);

384

385

$self->rv($rv||'null');

386

$self->ra('null');

387

$self->rs('null');

388

my $this_rv;

389

if ($rv && $rv >= 1) {

390

$this_rv = 0;

391

} else {

392

$self->ra($selected);

393

$self->rs($selected);

394

$this_rv = $selected;

395

}

396

$self->_post($args);

397

return($this_rv);

398

}

399

400

# --2rangesbox <text> <height> <width> <label1> <min1> <max1> <def1> <label2> <min2> <max2> <def2>

401

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

402

#: display two slider bars with preset ranges and labels

403

sub rangesbox2 {

404

my $self = shift();

405

my $caller = (caller(1))[3] || 'main';

406

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

407

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

408

my $args = $self->_pre($caller,@_);

409

410

my $command = $self->_mk_cmnd(" --separate-output --2rangesbox",@_);

411

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

412

$command .= ' "' . ($args->{'height'}||'20') . '"';

413

$command .= ' "' . ($args->{'width'}||'65') . '"';

414

$command .= ' "' . ($args->{'label1'}||' ') . '"';

415

$command .= ' "' . ($args->{'min1'}||'0') . '"';

416

$command .= ' "' . ($args->{'max1'}||'100') . '"';

417

$command .= ' "' . ($args->{'def1'}||'0') . '"';

418

$command .= ' "' . ($args->{'label2'}||' ') . '"';

419

$command .= ' "' . ($args->{'min2'}||'0') . '"';

420

$command .= ' "' . ($args->{'max2'}||'100') . '"';

421

$command .= ' "' . ($args->{'def2'}||'0') . '"';

422

423

my ($rv,$selected) = $self->command_array($command);

424

425

$self->rv($rv||'null');

426

$self->rs('null');

427

$self->ra('null');

428

my $this_rv;

429

if ($rv && $rv >= 1) {

430

$this_rv = 0;

431

} else {

432

$self->ra(@$selected);

433

$self->rs(join("\n",@$selected));

434

$this_rv = $selected;

435

}

436

$self->_post($args);

437

return($this_rv) unless ref($this_rv) eq "ARRAY";

438

return(@{$this_rv});

439

}

440

441

# --3rangesbox <text> <height> <width> <label1> <min1> <max1> <def1> <label2> <min2> <max2> <def2> <label3> <min3> <max3> <def3>

442

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

443

#: display three slider bars with preset ranges and labels

444

sub rangesbox3 {

445

my $self = shift();

446

my $caller = (caller(1))[3] || 'main';

447

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

448

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

449

my $args = $self->_pre($caller,@_);

450

451

my $command = $self->_mk_cmnd(" --separate-output --3rangesbox",@_);

452

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

453

$command .= ' "' . ($args->{'height'}||'20') . '"';

454

$command .= ' "' . ($args->{'width'}||'65') . '"';

455

$command .= ' "' . ($args->{'label1'}||' ') . '"';

456

$command .= ' "' . ($args->{'min1'}||'0') . '"';

457

$command .= ' "' . ($args->{'max1'}||'100') . '"';

458

$command .= ' "' . ($args->{'def1'}||'0') . '"';

459

$command .= ' "' . ($args->{'label2'}||' ') . '"';

460

$command .= ' "' . ($args->{'min2'}||'0') . '"';

461

$command .= ' "' . ($args->{'max2'}||'100') . '"';

462

$command .= ' "' . ($args->{'def2'}||'0') . '"';

463

$command .= ' "' . ($args->{'label3'}||' ') . '"';

464

$command .= ' "' . ($args->{'min3'}||'0') . '"';

465

$command .= ' "' . ($args->{'max3'}||'100') . '"';

466

$command .= ' "' . ($args->{'def3'}||'0') . '"';

467

468

my ($rv,$selected) = $self->command_array($command);

469

470

$self->rv($rv||'null');

471

$self->ra('null');

472

$self->rs('null');

473

my $this_rv;

474

if ($rv && $rv >= 1) {

475

$this_rv = 0;

476

} else {

477

$self->ra(@$selected);

478

$self->rs(join("\n",@$selected));

479

$this_rv = $selected;

480

}

481

$self->_post($args);

482

return($this_rv) unless ref($this_rv) eq "ARRAY";

483

return(@{$this_rv});

484

}

485

486

# --spinbox <text> <height> <width> <min> <max> <def> <label>

487

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

488

#: display a spin box (a number with up/down buttons) with preset ranges

489

sub spinbox {

490

my $self = shift();

491

my $caller = (caller(1))[3] || 'main';

492

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

493

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

494

my $args = $self->_pre($caller,@_);

495

496

my $command = $self->_mk_cmnd(" --separate-output --spinbox",@_);

497

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

498

$command .= ' "' . ($args->{'height'}||'20') . '"';

499

$command .= ' "' . ($args->{'width'}||'65') . '"';

500

$command .= ' "' . ($args->{'min1'}||'0') . '"';

501

$command .= ' "' . ($args->{'max1'}||'100') . '"';

502

$command .= ' "' . ($args->{'def1'}||'') . '"';

503

$command .= ' "' . ($args->{'label1'}||'') . '"';

504

505

my ($rv,$selected) = $self->command_string($command);

506

507

$self->rv($rv||'null');

508

$self->ra('null');

509

$self->rs('null');

510

my $this_rv;

511

if ($rv && $rv >= 1) {

512

$this_rv = 0;

513

} else {

514

$self->ra($selected);

515

$self->rs($selected);

516

$this_rv = $selected;

517

}

518

$self->_post($args);

519

return($this_rv);

520

}

521

522

# --2spinsbox <text> <height> <width> <min1> <max1> <def1> <label1> <min2> <max2> <def2> <label2>

523

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

524

#: display two spin boxes with preset ranges and labels

525

sub spinsbox2 {

526

my $self = shift();

527

my $caller = (caller(1))[3] || 'main';

528

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

529

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

530

my $args = $self->_pre($caller,@_);

531

532

my $command = $self->_mk_cmnd(" --separate-output --2spinsbox",@_);

533

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

534

$command .= ' "' . ($args->{'height'}||'20') . '"';

535

$command .= ' "' . ($args->{'width'}||'65') . '"';

536

$command .= ' "' . ($args->{'min1'}||'0') . '"';

537

$command .= ' "' . ($args->{'max1'}||'100') . '"';

538

$command .= ' "' . ($args->{'def1'}||'') . '"';

539

$command .= ' "' . ($args->{'label1'}||' ') . '"';

540

$command .= ' "' . ($args->{'min2'}||'0') . '"';

541

$command .= ' "' . ($args->{'max2'}||'100') . '"';

542

$command .= ' "' . ($args->{'def2'}||' ') . '"';

543

$command .= ' "' . ($args->{'label2'}||' ') . '"';

544

545

my ($rv,$selected) = $self->command_array($command);

546

547

$self->rv($rv||'null');

548

$self->ra('null');

549

$self->rs('null');

550

my $this_rv;

551

if ($rv && $rv >= 1) {

552

$this_rv = 0;

553

} else {

554

$self->ra(@$selected);

555

$self->rs(join("\n",@$selected));

556

$this_rv = $selected;

557

}

558

$self->_post($args);

559

return($this_rv) unless ref($this_rv) eq "ARRAY";

560

return(@{$this_rv});

561

}

562

563

# --3spinsbox <text> <height> <width> <text> <height> <width> <min1> <max1> <def1> <label1> <min2> <max2> <def2> <label2> <min3> <max3> <def3> <label3>

564

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

565

#: display three spin boxes with preset ranges and labels

566

sub spinsbox3 {

567

my $self = shift();

568

my $caller = (caller(1))[3] || 'main';

569

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

570

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

571

my $args = $self->_pre($caller,@_);

572

573

my $command = $self->_mk_cmnd(" --separate-output --3spinsbox",@_);

574

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

575

$command .= ' "' . ($args->{'height'}||'20') . '"';

576

$command .= ' "' . ($args->{'width'}||'65') . '"';

577

$command .= ' "' . ($args->{'min1'}||'0') . '"';

578

$command .= ' "' . ($args->{'max1'}||'100') . '"';

579

$command .= ' "' . ($args->{'def1'}||'') . '"';

580

$command .= ' "' . ($args->{'label1'}||' ') . '"';

581

$command .= ' "' . ($args->{'min2'}||'0') . '"';

582

$command .= ' "' . ($args->{'max2'}||'100') . '"';

583

$command .= ' "' . ($args->{'def2'}||' ') . '"';

584

$command .= ' "' . ($args->{'label2'}||' ') . '"';

585

$command .= ' "' . ($args->{'min3'}||'0') . '"';

586

$command .= ' "' . ($args->{'max3'}||'100') . '"';

587

$command .= ' "' . ($args->{'def3'}||' ') . '"';

588

$command .= ' "' . ($args->{'label3'}||' ') . '"';

589

590

my ($rv,$selected) = $self->command_array($command);

591

592

$self->rv($rv||'null');

593

$self->rs('null');

594

$self->ra('null');

595

my $this_rv;

596

if ($rv && $rv >= 1) {

597

$this_rv = 0;

598

} else {

599

$self->ra(@$selected);

600

$self->rs(join("\n",@$selected));

601

$this_rv = $selected;

602

}

603

$self->_post($args);

604

return($this_rv) unless ref($this_rv) eq "ARRAY";

605

return(@{$this_rv});

606

}

607

608

# --buildlist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}...

609

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

610

#: display a two paned box by which the user can organize a list of items

611

sub buildlist {

612

my $self = shift();

613

my $caller = (caller(1))[3] || 'main';

614

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

615

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

616

my $args = $self->_pre($caller,@_);

617

618

$self->{'buildlist'} ||= 'buildlist';

619

620

my $command = $self->_mk_cmnd(" --separate-output --".$self->{'buildlist'},@_);

621

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

622

$command .= ' "' . ($args->{'height'}||'20') . '"';

623

$command .= ' "' . ($args->{'width'}||'65') . '"';

624

$command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

625

626

if ($args->{'list'}) {

627

$args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";

628

my ($item,$info);

629

while (@{$args->{'list'}}) {

630

$item = shift(@{$args->{'list'}});

631

$info = shift(@{$args->{'list'}});

632

$command .= ' "'.$item.'" "'.$info->[0].'" "'.(($info->[1]) ? 'on' : 'off').'"';

633

$command .= ' "'.($info->[2]||' ').'"' unless not $args->{'itemhelp'};

634

}

635

} else {

636

$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";

637

foreach my $item (@{$args->{'items'}}) {

638

$command .= ' "' . $item . '"';

639

}

640

}

641

my ($rv,$selected) = $self->command_array($command);

642

643

$self->rv($rv||'null');

644

$self->rs('null');

645

$self->ra('null');

646

my $this_rv;

647

if ($rv && $rv >= 1) {

648

$this_rv = 0;

649

} else {

650

$self->ra(@$selected);

651

$self->rs(join("\n",@$selected));

652

$this_rv = $selected;

653

}

654

$self->_post($args);

655

return($this_rv) unless ref($this_rv) eq "ARRAY";

656

return(@{$this_rv});

657

}

658

659

# --treeview <text> <height> <width> <list height> <tag1> <item1> <status1> <item_depth1> {<help1>}...

660

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

661

#: display a tree view of items

662

sub treeview {

663

my $self = shift();

664

my $caller = (caller(1))[3] || 'main';

665

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

666

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

667

my $args = $self->_pre($caller,@_);

668

669

$self->{'treeview'} ||= 'treeview';

670

671

my $command = $self->_mk_cmnd(" --separate-output --".$self->{'treeview'},@_);

672

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

673

$command .= ' "' . ($args->{'height'}||'20') . '"';

674

$command .= ' "' . ($args->{'width'}||'65') . '"';

675

$command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

676

677

if ($args->{'list'}) {

678

$args->{'list'} = [ ' ', [' ', 1, 1 ] ] unless ref($args->{'list'}) eq "ARRAY";

679

my ($item,$info);

680

while (@{$args->{'list'}}) {

681

$item = shift(@{$args->{'list'}});

682

$info = shift(@{$args->{'list'}});

683

$command .= ' "'.$item.'" "'.$info->[0].'" "'.(($info->[1]) ? 'on' : 'off').'" "'.($info->[2]||1).'"';

684

$command .= ' "'.($info->[3]||' ').'"' unless not $args->{'itemhelp'};

685

}

686

} else {

687

$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";

688

foreach my $item (@{$args->{'items'}}) {

689

$command .= ' "' . $item . '"';

690

}

691

}

692

my ($rv,$selected) = $self->command_string($command);

693

694

$self->rv($rv||'null');

695

$self->ra('null');

696

$self->rs('null');

697

my $this_rv;

698

if ($rv && $rv >= 1) {

699

$this_rv = 0;

700

} else {

701

$self->ra($selected);

702

$self->rs($selected);

703

$this_rv = $selected;

704

}

705

$self->_post($args);

706

return($this_rv);

707

}

708

709

# --calendar <text> <height> <width> <day> <month> <year>

710

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

711

#: display a calendar with a preset date

712

sub calendar {

713

my $self = shift();

714

my $caller = (caller(1))[3] || 'main';

715

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

716

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

717

my $args = $self->_pre($caller,@_);

718

719

my $command = $self->_mk_cmnd(" --separate-output --calendar",@_);

720

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

721

$command .= ' "' . ($args->{'height'}||'14') . '"';

722

$command .= ' "' . ($args->{'width'}||'65') . '"';

723

$command .= ' "' . ($args->{'day'}||'1') . '"';

724

$command .= ' "' . ($args->{'month'}||'1') . '"';

725

$command .= ' "' . ($args->{'year'}||'1970') . '"';

726

727

my ($rv,$selected) = $self->command_string($command);

728

$self->rv($rv||'null');

729

$self->ra('null');

730

$self->rs('null');

731

my $this_rv;

732

if ($rv && $rv >= 1) {

733

$this_rv = 0;

734

} else {

735

chomp($selected);

736

$self->ra(split(/\//,$selected));

737

$self->rs($selected);

738

$this_rv = $selected;

739

}

740

$self->_post($args);

741

return($this_rv);

742

}

743

744

# --timebox <text> <height> <width>

745

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

746

#: display a time box

747

sub timebox {

748

my $self = shift();

749

my $caller = (caller(1))[3] || 'main';

750

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

751

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

752

my $args = $self->_pre($caller,@_);

753

754

my $command = $self->_mk_cmnd(" --separate-output --timebox",@_);

755

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

756

$command .= ' "' . ($args->{'height'}||'14') . '"';

757

$command .= ' "' . ($args->{'width'}||'65') . '"';

758

759

my ($rv,$selected) = $self->command_string($command);

760

761

$self->rv($rv||'null');

762

$self->ra('null');

763

$self->rs('null');

764

my $this_rv;

765

if ($rv && $rv >= 1) {

766

$this_rv = 0;

767

} else {

768

$self->ra(split(/\:/,$selected));

769

$self->rs($selected);

770

$this_rv = $selected;

771

}

772

$self->_post($args);

773

return($this_rv);

774

}

775

776

# --yesno <text> <height> <width>

777

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

778

#: Ask a binary question (Yes/No)

779

sub yesno {

780

my $self = shift();

781

my $caller = (caller(1))[3] || 'main';

782

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

783

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

784

my $args = $self->_pre($caller,@_);

785

786

my $command = $self->_mk_cmnd(' --yesno',@_);

787

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

788

$command .= ' "' . ($args->{'height'}||'20') . '"';

789

$command .= ' "' . ($args->{'width'}||'65') . '"';

790

my $rv = $self->command_state($command);

791

792

$self->rv($rv||'null');

793

my $this_rv;

794

if ($rv && $rv >= 1) {

795

$self->ra("NO");

796

$self->rs("NO");

797

$this_rv = 0;

798

} else {

799

$self->ra("YES");

800

$self->rs("YES");

801

$this_rv = 1;

802

}

803

$self->_post($args);

804

return($this_rv);

805

}

806

807

# --inputbox <text> <height> <width> [<init>]

808

# --2inputsbox <text> <height> <width> <label1> <init1> <label2> <init2>

809

# --3inputsbox <text> <height> <width> <label1> <init1> <label2> <init2> <label3> <init3>

810

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

811

#: Text entry

812

sub inputbox {

813

my $self = shift();

814

my $caller = (caller(1))[3] || 'main';

815

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

816

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

817

my $args = $self->_pre($caller,@_);

818

819

my $val = $args->{'inputs'} || $args->{'password'} || 1;

820

821

my $cmnd_prefix;

822

if ($args->{'password'}) {

823

if ($val == 3) {

824

$cmnd_prefix = ' --separate-output --password --password --password --3inputsbox';

825

} elsif ($val == 2) {

826

$cmnd_prefix = ' --separate-output --password --password --2inputsbox';

827

} else {

828

$cmnd_prefix = ' --password --inputbox';

829

}

830

} else {

831

if ($val == 3) {

832

$cmnd_prefix = ' --separate-output --3inputsbox';

833

} elsif ($val == 2) {

834

$cmnd_prefix = ' --separate-output --2inputsbox';

835

} else {

836

$cmnd_prefix = ' --inputbox';

837

}

838

}

839

840

my $command = $self->_mk_cmnd($cmnd_prefix,@_);

841

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

842

$command .= ' "' . ($args->{'height'}||'20') . '"';

843

$command .= ' "' . ($args->{'width'}||'65') . '"';

844

845

$command .= ' "' . ($args->{'entry'}||$args->{'init'}||'') . '"' if $val == 1;

846

847

$command .= ' "' . ($args->{'label1'}||' ') . '"' if $val > 1;

848

$command .= ' "' . ($args->{'input1'}||'') . '"' if $val > 1;

849

$command .= ' "' . ($args->{'label2'}||' ') . '"' if $val >= 2;

850

$command .= ' "' . ($args->{'input2'}||'') . '"' if $val >= 2;

851

$command .= ' "' . ($args->{'label3'}||' ') . '"' if $val >= 3;

852

$command .= ' "' . ($args->{'input3'}||'') . '"' if $val >= 3;

853

854

my ($rv,$text);

855

if ($val == 1) {

856

($rv,$text) = $self->command_string($command);

857

} else {

858

($rv,$text) = $self->command_array($command);

859

}

860

861

$self->rv($rv||'null');

862

$self->ra('null');

863

$self->rs('null');

864

my $this_rv;

865

if ($rv && $rv >= 1) {

866

$this_rv = 0;

867

} else {

868

if ($val == 1) {

869

$self->ra($text);

870

$self->rs($text);

871

} else {

872

$self->ra(@$text);

873

$self->rs(join("\n",@$text));

874

}

875

$this_rv = $text;

876

}

877

$self->_post($args);

878

return($this_rv) unless ref($this_rv) eq "ARRAY";

879

return(@{$this_rv});

880

}

881

sub inputsbox2 {

882

my $self = shift();

883

return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'inputs',2));

884

}

885

sub inputsbox3 {

886

my $self = shift();

887

return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'inputs',3));

888

}

889

sub password {

890

my $self = shift();

891

return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1,'inputs',1));

892

}

893

sub passwords2 {

894

my $self = shift();

895

return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1,'inputs',2));

896

}

897

sub passwords3 {

898

my $self = shift();

899

return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1,'inputs',3));

900

}

901

902

# --msgbox <text> <height> <width>

903

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

904

#: Text box

905

sub msgbox {

906

my $self = shift();

907

my $caller = (caller(1))[3] || 'main';

908

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

909

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

910

my $args = $self->_pre($caller,@_);

911

912

$args->{'msgbox'} ||= 'msgbox';

913

914

my $command = $self->_mk_cmnd(' --'.$args->{'msgbox'},@_);

915

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

916

$command .= ' "' . ($args->{'height'}||'20') . '"';

917

$command .= ' "' . ($args->{'width'}||'65') . '"';

918

$command .= ' "' . (($args->{'wait'}) ? $args->{'wait'} * 1000 : ($args->{'timeout'}||'5000')) . '"'

919

unless $args->{'msgbox'} ne 'infobox';

920

921

my $rv = $self->command_state($command);

922

923

$self->rv($rv||'null');

924

$self->ra('null');

925

$self->rs('null');

926

my $this_rv;

927

if ($rv && $rv >= 1) {

928

$this_rv = 0;

929

} else {

930

$this_rv = 1;

931

}

932

$self->_post($args);

933

return($this_rv);

934

}

935

936

# --infobox <text> <height> <width> [<timeout>]

937

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

938

#: same as msgbox but destroy's itself with timeout...

939

sub infobox {

940

my $self = shift();

941

return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'msgbox','infobox'));

942

}

943

944

# --editbox <file> <height> <width>

945

# --tailbox <file> <height> <width>

946

# --logbox <file> <height> <width>

947

# --textbox <file> <height> <width>

948

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

949

#: File box

950

sub textbox {

951

my $self = shift();

952

my $caller = (caller(1))[3] || 'main';

953

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

954

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

955

my $args = $self->_pre($caller,@_);

956

957

$args->{'textbox'} ||= 'textbox';

958

959

my $command = $self->_mk_cmnd(" --".$args->{'textbox'},@_);

960

$command .= ' "' . ($args->{'filename'}||$args->{'path'}||'.') . '"';

961

$command .= ' "' . ($args->{'height'}||'20') . '"';

962

$command .= ' "' . ($args->{'width'}||'65') . '"';

963

964

my ($rv,$text) = $self->command_string($command);

965

966

$self->rv($rv||'null');

967

$self->ra('null');

968

$self->rs('null');

969

my $this_rv;

970

if ($rv && $rv >= 1) {

971

$this_rv = 0;

972

} else {

973

$self->ra(($text) ? [ $text ] : 'null');

974

$self->rs($text||'null');

975

$this_rv = $text || 1;

976

}

977

$self->_post($args);

978

return($this_rv);

979

}

980

sub editbox {

981

my $self = shift();

982

return($self->textbox('caller',((caller(1))[3]||'main'),@_,'textbox','editbox'));

983

}

984

sub logbox {

985

my $self = shift();

986

return($self->textbox('caller',((caller(1))[3]||'main'),@_,'textbox','logbox'));

987

}

988

sub tailbox {

989

my $self = shift();

990

return($self->textbox('caller',((caller(1))[3]||'main'),@_,'textbox','tailbox'));

991

}

992

993

# --menubox <text> <height> <width> <menu height> <tag1> <item1> {<help1>}...

994

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

995

#: Lists

996

sub menu {

997

my $self = shift();

998

my $caller = (caller(1))[3] || 'main';

999

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1000

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1001

my $args = $self->_pre($caller,@_);

1002

1003

my $command = $self->_mk_cmnd(" --separate-output --menu",@_);

1004

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

1005

$command .= ' "' . ($args->{'height'}||'20') . '"';

1006

$command .= ' "' . ($args->{'width'}||'65') . '"';

1007

$command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

1008

1009

if ($args->{'list'}) {

1010

$args->{'list'} = [ ' ', ' ' ] unless ref($args->{'list'}) eq "ARRAY";

1011

foreach my $item (@{$args->{'list'}}) {

1012

$command .= ' "' . $item . '"';

1013

}

1014

} else {

1015

$args->{'items'} = [ ' ', ' ' ] unless ref($args->{'items'}) eq "ARRAY";

1016

foreach my $item (@{$args->{'items'}}) {

1017

$command .= ' "' . $item . '"';

1018

}

1019

}

1020

1021

my ($rv,$selected) = $self->command_string($command);

1022

1023

$self->rv($rv||'null');

1024

$self->ra('null');

1025

$self->rs('null');

1026

my $this_rv;

1027

if ($rv && $rv >= 1) {

1028

$this_rv = 0;

1029

} else {

1030

$self->ra($selected);

1031

$self->rs($selected);

1032

$this_rv = $selected;

1033

}

1034

$self->_post($args);

1035

return($this_rv);

1036

}

1037

1038

# --checklist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}...

1039

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1040

#: multiple selection list via checkbox widgets

1041

sub checklist {

1042

my $self = shift();

1043

my $caller = (caller(1))[3] || 'main';

1044

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1045

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1046

my $args = $self->_pre($caller,@_);

1047

1048

$self->{'checklist'} ||= 'checklist';

1049

1050

my $command = $self->_mk_cmnd(" --separate-output --".$self->{'checklist'},@_);

1051

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

1052

$command .= ' "' . ($args->{'height'}||'20') . '"';

1053

$command .= ' "' . ($args->{'width'}||'65') . '"';

1054

$command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

1055

1056

if ($args->{'list'}) {

1057

$args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";

1058

my ($item,$info);

1059

while (@{$args->{'list'}}) {

1060

$item = shift(@{$args->{'list'}});

1061

$info = shift(@{$args->{'list'}});

1062

$command .= ' "'.$item.'" "'.$info->[0].'" "'.(($info->[1]) ? 'on' : 'off').'"';

1063

$command .= ' "'.($info->[2]||' ').'"' unless not $args->{'itemhelp'};

1064

}

1065

} else {

1066

$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";

1067

foreach my $item (@{$args->{'items'}}) {

1068

$command .= ' "' . $item . '"';

1069

}

1070

}

1071

my ($rv,$selected) = $self->command_array($command);

1072

1073

$self->rv($rv||'null');

1074

$self->rs('null');

1075

$self->ra('null');

1076

my $this_rv;

1077

if ($rv && $rv >= 1) {

1078

$this_rv = 0;

1079

} else {

1080

$self->ra(@$selected);

1081

$self->rs(join("\n",@$selected));

1082

$this_rv = $selected;

1083

}

1084

$self->_post($args);

1085

return($this_rv) unless ref($this_rv) eq "ARRAY";

1086

return(@{$this_rv});

1087

}

1088

1089

# --radiolist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}...

1090

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1091

#: display a list via the radiolist widget

1092

sub radiolist {

1093

my $self = shift();

1094

my $caller = (caller(1))[3] || 'main';

1095

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1096

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1097

my $args = $self->_pre($caller,@_);

1098

1099

$self->{'radiolist'} ||= 'radiolist';

1100

1101

my $command = $self->_mk_cmnd(" --separate-output --".$self->{'radiolist'},@_);

1102

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

1103

$command .= ' "' . ($args->{'height'}||'20') . '"';

1104

$command .= ' "' . ($args->{'width'}||'65') . '"';

1105

$command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

1106

1107

if ($args->{'list'}) {

1108

$args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";

1109

my ($item,$info);

1110

while (@{$args->{'list'}}) {

1111

$item = shift(@{$args->{'list'}});

1112

$info = shift(@{$args->{'list'}});

1113

$command .= ' "'.$item.'" "'.$info->[0].'" "'.(($info->[1]) ? 'on' : 'off').'"';

1114

$command .= ' "'.($info->[2]||' ').'"' unless not $args->{'itemhelp'};

1115

}

1116

} else {

1117

$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";

1118

foreach my $item (@{$args->{'items'}}) {

1119

$command .= ' "' . $item . '"';

1120

}

1121

}

1122

1123

my ($rv,$selected) = $self->command_string($command);

1124

1125

$self->rv($rv||'null');

1126

$self->ra('null');

1127

$self->rs('null');

1128

my $this_rv;

1129

if ($rv && $rv >= 1) {

1130

$this_rv = 0;

1131

} else {

1132

$self->ra($selected);

1133

$self->rs($selected);

1134

$this_rv = $selected;

1135

}

1136

$self->_post($args);

1137

return($this_rv);

1138

}

1139

1140

# --fselect <file> <height> <width>

1141

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1142

#: file select

1143

sub fselect {

1144

my $self = shift();

1145

my $caller = (caller(1))[3] || 'main';

1146

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1147

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1148

my $args = $self->_pre($caller,@_);

1149

1150

my $command = $self->_mk_cmnd(" --fselect",@_);

1151

my $path = $args->{'path'} || abs_path();

1152

$command .= ' "' . ((-d $path) ? $path . '/' : $path) . '"';

1153

$command .= ' "' . ($args->{'height'}||'20') . '"';

1154

$command .= ' "' . ($args->{'width'}||'65') . '"';

1155

1156

my ($rv,$file) = $self->command_string($command);

1157

1158

$self->rv($rv||'null');

1159

$self->ra('null');

1160

$self->rs('null');

1161

my $this_rv;

1162

if ($rv && $rv >= 1) {

1163

$this_rv = 0;

1164

} else {

1165

$self->ra($file);

1166

$self->rs($file);

1167

$this_rv = $file;

1168

}

1169

$self->_post($args);

1170

return($this_rv);

1171

}

1172

1173

# --dselect <directory> <height> <width>

1174

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1175

#: directory selector

1176

sub dselect {

1177

my $self = shift();

1178

my $caller = (caller(1))[3] || 'main';

1179

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1180

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1181

my $args = $self->_pre($caller,@_);

1182

1183

my $command = $self->_mk_cmnd(" --dselect",@_);

1184

my $path = $args->{'path'} || abs_path();

1185

$command .= ' "' . ((-d $path) ? $path . '/' : $path) . '"';

1186

$command .= ' "' . ($args->{'height'}||'20') . '"';

1187

$command .= ' "' . ($args->{'width'}||'65') . '"';

1188

1189

my ($rv,$file) = $self->command_string($command);

1190

1191

$self->rv($rv||'null');

1192

$self->ra('null');

1193

$self->rs('null');

1194

my $this_rv;

1195

if ($rv && $rv >= 1) {

1196

$this_rv = 0;

1197

} else {

1198

$self->ra($file);

1199

$self->rs($file);

1200

$this_rv = $file;

1201

}

1202

$self->_post($args);

1203

return($this_rv);

1204

}

1205

1206

# --gauge <text> <height> <width> [<percent>]

1207

# --progress <text> <height> <width> [<maxdots> [[-]<msglen>]]

1208

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1209

#: progress meter

1210

sub progress_start {

1211

my $self = shift();

1212

my $caller = (caller(1))[3] || 'main';

1213

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1214

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1215

my $args = $self->_pre($caller,@_);

1216

1217

$self->{'_PROGRESS'} ||= {};

1218

$self->{'_PROGRESS'}->{'ARGS'} = $args;

1219

1220

if (defined $self->{'_PROGRESS'}->{'FH'}) {

1221

$self->rv(129);

1222

$self->_post($args);

1223

return(0);

1224

}

1225

1226

my $command = $self->_mk_cmnd(" --progress",@_);

1227

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

1228

$command .= ' "' . ($args->{'height'}||'20') . '"';

1229

$command .= ' "' . ($args->{'width'}||'65') . '"';

1230

$command .= ' "' . ($args->{'maxdots'}||'') . '"' unless not $args->{'maxdots'} and not $args->{'msglen'};

1231

$command .= ' "' . ($args->{'msglen'}||'') . '"' unless not $args->{'msglen'};

1232

$self->_debug("command: ".$command,2);

1233

1234

$self->{'_PROGRESS'}->{'FH'} = new FileHandle;

1235

$self->{'_PROGRESS'}->{'FH'}->open("| $command");

1236

my $rv = $? >> 8;

1237

$self->{'_PROGRESS'}->{'FH'}->autoflush(1);

1238

$self->rv($rv||'null');

1239

$self->ra('null');

1240

$self->rs('null');

1241

my $this_rv;

1242

if ($rv && $rv >= 1) { $this_rv = 0; }

1243

else { $this_rv = 1; }

1244

return($this_rv);

1245

}

1246

sub gauge_start {

1247

my $self = shift();

1248

my $caller = (caller(1))[3] || 'main';

1249

$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;

1250

if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }

1251

my $args = $self->_pre($caller,@_);

1252

1253

$self->{'_GAUGE'} ||= {};

1254

$self->{'_GAUGE'}->{'ARGS'} = $args;

1255

1256

if (defined $self->{'_GAUGE'}->{'FH'}) {

1257

$self->rv(129);

1258

$self->_post($args);

1259

return(0);

1260

}

1261

1262

my $command = $self->_mk_cmnd(" --gauge",@_);

1263

$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'},$args->{'width'}))||' ') . '"';

1264

$command .= ' "' . ($args->{'height'}||'20') . '"';

1265

$command .= ' "' . ($args->{'width'}||'65') . '"';

1266

$command .= ' "' . ($args->{'percentage'}||'0') . '"';

1267

$self->_debug("command: ".$command,2);

1268

1269

$self->{'_GAUGE'}->{'FH'} = new FileHandle;

1270

$self->{'_GAUGE'}->{'FH'}->open("| $command");

1271

my $rv = $? >> 8;

1272

$self->{'_GAUGE'}->{'FH'}->autoflush(1);

1273

$self->rv($rv||'null');

1274

$self->ra('null');

1275

$self->rs('null');

1276

my $this_rv;

1277

if ($rv && $rv >= 1) { $this_rv = 0; }

1278

else { $this_rv = 1; }

1279

return($this_rv);

1280

}

1281

sub progress_inc {

1282

my $self = $_[0];

1283

my $incr = $_[1] || 1;

1284

1285

return(0) unless defined $self->{'_PROGRESS'}->{'FH'};

1286

1287

my $fh = $self->{'_PROGRESS'}->{'FH'};

1288

$self->{'_PROGRESS'}->{'PERCENT'} += $incr;

1289

$SIG_CODE->{'PROGRESS'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_progress;

1290

print $fh $self->{'_PROGRESS'}->{'PERCENT'}."\n";

1291

return(((defined $self->{'_PROGRESS'}->{'FH'}) ? 1 : 0));

1292

}

1293

sub gauge_inc {

1294

my $self = $_[0];

1295

my $incr = $_[1] || 1;

1296

1297

return(0) unless defined $self->{'_GAUGE'}->{'FH'};

1298

1299

my $fh = $self->{'_GAUGE'}->{'FH'};

1300

$self->{'_GAUGE'}->{'PERCENT'} += $incr;

1301

$SIG_CODE->{'GAUGE'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;

1302

print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";

1303

return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));

1304

}

1305

sub progress_dec {

1306

my $self = $_[0];

1307

my $decr = $_[1] || 1;

1308

1309

return(0) unless defined $self->{'_PROGRESS'}->{'FH'};

1310

1311

my $fh = $self->{'_PROGRESS'}->{'FH'};

1312

$self->{'_PROGRESS'}->{'PERCENT'} -= $decr;

1313

$SIG_CODE->{'PROGRESS'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_progress;

1314

print $fh $self->{'_PROGRESS'}->{'PERCENT'}."\n";

1315

return(((defined $self->{'_PROGRESS'}->{'FH'}) ? 1 : 0));

1316

}

1317

sub gauge_dec {

1318

my $self = $_[0];

1319

my $decr = $_[1] || 1;

1320

1321

return(0) unless defined $self->{'_GAUGE'}->{'FH'};

1322

1323

my $fh = $self->{'_GAUGE'}->{'FH'};

1324

$self->{'_GAUGE'}->{'PERCENT'} -= $decr;

1325

$SIG_CODE->{'GAUGE'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;

1326

print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";

1327

return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));

1328

}

1329

sub progress_set {

1330

my $self = $_[0];

1331

my $perc = $_[1] || $self->{'_PROGRESS'}->{'PERCENT'} || 1;

1332

1333

return(0) unless defined $self->{'_PROGRESS'}->{'FH'};

1334

1335

my $fh = $self->{'_PROGRESS'}->{'FH'};

1336

$self->{'_PROGRESS'}->{'PERCENT'} = $perc;

1337

$SIG_CODE->{'PROGRESS'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_progress;

1338

print $fh $self->{'_PROGRESS'}->{'PERCENT'}."\n";

1339

return(((defined $self->{'_PROGRESS'}->{'FH'}) ? 1 : 0));

1340

}

1341

sub gauge_set {

1342

my $self = $_[0];

1343

my $perc = $_[1] || $self->{'_GAUGE'}->{'PERCENT'} || 1;

1344

1345

return(0) unless defined $self->{'_GAUGE'}->{'FH'};

1346

1347

my $fh = $self->{'_GAUGE'}->{'FH'};

1348

$self->{'_GAUGE'}->{'PERCENT'} = $perc;

1349

$SIG_CODE->{'GAUGE'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;

1350

print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";

1351

return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));

1352

}

1353

sub gauge_text {

1354

my $self = $_[0];

1355

my $mesg = $_[1] || return(0);

1356

1357

return(0) unless defined $self->{'_GAUGE'}->{'FH'};

1358

1359

my $fh = $self->{'_GAUGE'}->{'FH'};

1360

$SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;

1361

print $fh "\nXXX\n\n".$mesg."\n\nXXX\n\n".$self->{'_GAUGE'}->{'PERCENT'}."\n";

1362

return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));

1363

}

1364

sub progress_stop {

1365

my $self = $_[0];

1366

1367

return(0) unless defined $self->{'_PROGRESS'}->{'FH'};

1368

1369

my $args = $self->{'_PROGRESS'}->{'ARGS'};

1370

my $fh = $self->{'_PROGRESS'}->{'FH'};

1371

$SIG_CODE->{'PROGRESS'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_progress;

1372

$self->{'_PROGRESS'}->{'FH'}->close();

1373

delete($self->{'_PROGRESS'}->{'FH'});

1374

delete($self->{'_PROGRESS'}->{'PERCENT'});

1375

delete($self->{'_PROGRESS'}->{'ARGS'});

1376

delete($self->{'_PROGRESS'});

1377

$self->rv('null');

1378

$self->rs('null');

1379

$self->ra('null');

1380

$self->_post($args);

1381

return(1);

1382

}

1383

sub gauge_stop {

1384

my $self = $_[0];

1385

1386

return(0) unless defined $self->{'_GAUGE'}->{'FH'};

1387

1388

my $args = $self->{'_GAUGE'}->{'ARGS'};

1389

my $fh = $self->{'_GAUGE'}->{'FH'};

1390

$SIG_CODE->{'GAUGE'}->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;

1391

$self->{'_GAUGE'}->{'FH'}->close();

1392

delete($self->{'_GAUGE'}->{'FH'});

1393

delete($self->{'_GAUGE'}->{'PERCENT'});

1394

delete($self->{'_GAUGE'}->{'ARGS'});

1395

delete($self->{'_GAUGE'});

1396

$self->rv('null');

1397

$self->rs('null');

1398

$self->ra('null');

1399

$self->_post($args);

1400

return(1);

1401

}

1402

1403

1404

1;