contrib/dialog/dialog.pl

   1 # Functions that handle calling dialog(1) -*-perl-*-
   2 # $Id: dialog.pl,v 1.18 2018/06/12 21:01:58 tom Exp $
   3 ################################################################################
   4 #  Copyright 2018       Thomas E. Dickey
   5 #
   6 #  This program is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU Lesser General Public License, version 2.1
   8 #  as published by the Free Software Foundation.
   9 #
  10 #  This program is distributed in the hope that it will be useful, but
  11 #  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 program; if not, write to
  17 #       Free Software Foundation, Inc.
  18 #       51 Franklin St., Fifth Floor
  19 #       Boston, MA 02110, USA.
  20 ################################################################################
  21 # The "rhs_" functions, as well as return_output originally came from Redhat
  22 # 4.0, e.g.,
  23 # http://www.ibiblio.org/pub/historic-linux/distributions/redhat-4.0/i386/live/usr/bin/Xconfigurator.pl
  24 # The other functions were added to make this more useful for demonstrations.
  25
  26 # These comments are from the original file:
  27 #------------------------------------------------------------------------------
  28 # Return values are 1 for success and 0 for failure (or cancel)
  29 # Resultant text (if any) is in dialog_result
  30
  31 # Unfortunately, the gauge requires use of /bin/sh to get going.
  32 # I didn't bother to make the others shell-free, although it
  33 # would be simple to do.
  34
  35 # Note that dialog generally returns 0 for success, so I invert the
  36 # sense of the return code for more readable boolean expressions.
  37 #------------------------------------------------------------------------------
  38
  39 use warnings;
  40 use strict;
  41 use diagnostics;
  42
  43 our $DIALOG = "dialog";
  44 our $GAUGE;
  45 our $gauge_width;
  46 our $scr_lines = 24;
  47 our $scr_cols  = 80;
  48 our @dialog_result;
  49 our $trace = 0;
  50
  51 require "flush.pl";
  52
  53 sub trace {
  54     if ($trace) {
  55         if ( open TRACE, ">>dialog.log" ) {
  56             printf TRACE $_[0], @_[ 1 .. $#_ ];
  57             close TRACE;
  58         }
  59     }
  60 }
  61
  62 sub quoted($) {
  63     my $text = shift;
  64     $text =~ s/[\r\n]+/\n/g;
  65     $text =~ s/[^\n\t -~]/?/g;
  66     $text =~ s/([\\"])/\\$1/g;
  67     return sprintf "\"%s\"", $text;
  68 }
  69
  70 sub screensize() {
  71     my $params = `$DIALOG --stdout --print-maxsize`;
  72     $params =~ s/\s+$//;
  73     $params =~ s/^[^:]*:\s+//;
  74     my @params = split /,\s+/, $params;
  75     if ( $#params == 1 ) {
  76         $scr_lines = $params[0];
  77         $scr_cols  = $params[1];
  78     }
  79     else {
  80         $scr_lines = 24;
  81         $scr_cols  = 80;
  82     }
  83 }
  84
  85 sub height_of($$) {
  86     my $width   = shift;
  87     my $message = shift;
  88     my $command =
  89         "$DIALOG --stdout --print-text-size "
  90       . &quoted($message)
  91       . " $scr_lines $width 2>&1";
  92     my $params = `$command`;
  93     my @params = split( /\s/, $params );
  94     return $params[0];
  95 }
  96
  97 sub rhs_clear {
  98     return system("$DIALOG --clear");
  99 }
 100
 101 sub rhs_textbox {
 102     my ( $title, $file, $width, $height ) = @_;
 103
 104     $width  = int($width);
 105     $height = int($height);
 106     system( "$DIALOG --title "
 107           . &quoted($title)
 108           . " --textbox $file $height $width" );
 109
 110     return 1;
 111 }
 112
 113 sub rhs_msgbox {
 114     my ( $title, $message, $width ) = @_;
 115     my ( $tmp, $height );
 116
 117     $width   = int($width);
 118     $message = &rhs_wordwrap( $message, $width );
 119     $height  = 5 + &height_of( $width, $message );
 120
 121     $tmp =
 122       system( "$DIALOG --title "
 123           . &quoted($title)
 124           . " --msgbox "
 125           . &quoted($message)
 126           . " $height $width" );
 127     if ($tmp) {
 128         return 0;
 129     }
 130     else {
 131         return 1;
 132     }
 133 }
 134
 135 sub rhs_infobox {
 136     my ( $title, $message, $width ) = @_;
 137     my ( $tmp, $height );
 138
 139     $width   = int($width);
 140     $message = &rhs_wordwrap( $message, $width );
 141     $height  = 2 + &height_of( $width, $message );
 142
 143     return
 144       system( "$DIALOG --title "
 145           . &quoted($title)
 146           . " --infobox "
 147           . &quoted($message)
 148           . " $height $width" );
 149 }
 150
 151 sub rhs_yesno {
 152     my ( $title, $message, $width ) = @_;
 153     my ( $tmp, $height );
 154
 155     $width   = int($width);
 156     $message = &rhs_wordwrap( $message, $width );
 157     $height  = 4 + &height_of( $width, $message );
 158
 159     $tmp =
 160       system( "$DIALOG --title "
 161           . &quoted($title)
 162           . " --yesno "
 163           . &quoted($message)
 164           . " $height $width" );
 165
 166     # Dumb: dialog returns 0 for "yes" and 1 for "no"
 167     if ( !$tmp ) {
 168         return 1;
 169     }
 170     else {
 171         return 0;
 172     }
 173 }
 174
 175 sub rhs_gauge {
 176     my ( $title, $message, $width, $percent ) = @_;
 177     my ( $tmp, $height );
 178
 179     $width       = int($width);
 180     $gauge_width = $width;
 181
 182     $message = &rhs_wordwrap( $message, $width );
 183     $height = 5 + &height_of( $width, $message );
 184
 185     open( $GAUGE,
 186             "|$DIALOG --title "
 187           . &quoted($title)
 188           . " --gauge "
 189           . &quoted($message)
 190           . " $height $width $percent" );
 191 }
 192
 193 sub rhs_update_gauge {
 194     my ($percent) = @_;
 195
 196     &printflush( $GAUGE, "$percent\n" );
 197 }
 198
 199 sub rhs_update_gauge_and_message {
 200     my ( $message, $percent ) = @_;
 201
 202     $message = &rhs_wordwrap( $message, $gauge_width );
 203     $message =~ s/\n/\\n/g;
 204     &printflush( $GAUGE, "XXX\n$percent\n$message\nXXX\n" );
 205 }
 206
 207 sub rhs_stop_gauge {
 208     close $GAUGE;
 209 }
 210
 211 sub rhs_inputbox {
 212     my ( $title, $message, $width, $instr ) = @_;
 213     my ( $tmp, $height );
 214
 215     $width   = int($width);
 216     $message = &rhs_wordwrap( $message, $width );
 217     $height  = 7 + &height_of( $width, $message );
 218
 219     return &return_output( 0,
 220             "$DIALOG --title "
 221           . &quoted($title)
 222           . " --inputbox "
 223           . &quoted($message)
 224           . " $height $width "
 225           . &quoted($instr) );
 226 }
 227
 228 sub rhs_menu {
 229     my ( $title, $message, $width, $numitems ) = @_;
 230     my ( $i, $tmp, $ent, $height, $listheight, $menuheight, @list );
 231
 232     $width    = int($width);
 233     $numitems = int($numitems);
 234
 235     shift;
 236     shift;
 237     shift;
 238     shift;
 239
 240     @list = ();
 241     for ( $i = 0 ; $i < $numitems ; $i++ ) {
 242         $ent         = shift;
 243         $list[@list] = &quoted($ent);
 244         $ent         = shift;
 245         $list[@list] = &quoted($ent);
 246     }
 247
 248     $message = &rhs_wordwrap( $message, $width );
 249     $listheight = &height_of( $width, $message );
 250     $height = 6 + $listheight + $numitems;
 251
 252     if ( $height <= $scr_lines ) {
 253         $menuheight = $numitems;
 254     }
 255     else {
 256         $height     = $scr_lines;
 257         $menuheight = $scr_lines - $listheight - 6;
 258     }
 259
 260     return &return_output( 0,
 261             "$DIALOG --title "
 262           . &quoted($title)
 263           . " --menu "
 264           . &quoted($message)
 265           . " $height $width $menuheight @list" );
 266 }
 267
 268 sub rhs_menul {
 269     my ( $title, $message, $width, $numitems ) = @_;
 270     my ( $i, $tmp, $ent, $height, $listheight, $menuheight, @list );
 271
 272     $width    = int($width);
 273     $numitems = int($numitems);
 274
 275     shift;
 276     shift;
 277     shift;
 278     shift;
 279
 280     @list = ();
 281     for ( $i = 0 ; $i < $numitems ; $i++ ) {
 282         $ent         = shift;
 283         $list[@list] = &quoted($ent);
 284         $list[@list] = &quoted("");
 285     }
 286
 287     $message = &rhs_wordwrap( $message, $width );
 288     $listheight = &height_of( $width, $message );
 289     $height = 6 + $listheight + $numitems;
 290
 291     if ( $height <= $scr_lines ) {
 292         $menuheight = $numitems;
 293     }
 294     else {
 295         $height     = $scr_lines;
 296         $menuheight = $scr_lines - $listheight - 6;
 297     }
 298
 299     return &return_output( 0,
 300             "$DIALOG --title "
 301           . &quoted($title)
 302           . " --menu "
 303           . &quoted($message)
 304           . " $height $width $menuheight @list" );
 305 }
 306
 307 sub rhs_menua {
 308     my ( $title, $message, $width, %items ) = @_;
 309     my ( $tmp, $ent, $height, $listheight, $menuheight, @list );
 310
 311     $width = int($width);
 312     @list  = ();
 313     foreach $ent ( sort keys(%items) ) {
 314         $list[@list] = &quoted($ent);
 315         $list[@list] = &quoted( $items{$ent} );
 316     }
 317
 318     my $numitems = keys(%items);
 319     $message = &rhs_wordwrap( $message, $width );
 320     $listheight = &height_of( $width, $message );
 321     $height = 6 + $listheight + $numitems;
 322
 323     if ( $height <= $scr_lines ) {
 324         $menuheight = $numitems;
 325     }
 326     else {
 327         $height     = $scr_lines;
 328         $menuheight = $scr_lines - $listheight - 6;
 329     }
 330
 331     return &return_output( 0,
 332             "$DIALOG --title "
 333           . &quoted($title)
 334           . " --menu "
 335           . &quoted($message)
 336           . " $height $width $menuheight @list" );
 337 }
 338
 339 sub rhs_checklist {
 340     my ( $title, $message, $width, $numitems ) = @_;
 341     my ( $i, $tmp, $ent, $height, $listheight, $menuheight, @list );
 342
 343     $width    = int($width);
 344     $numitems = int($numitems);
 345
 346     shift;
 347     shift;
 348     shift;
 349     shift;
 350
 351     @list = ();
 352     for ( $i = 0 ; $i < $numitems ; $i++ ) {
 353         $ent         = shift;
 354         $list[@list] = &quoted($ent);
 355         $ent         = shift;
 356         $list[@list] = &quoted($ent);
 357         $ent         = shift;
 358         if ($ent) {
 359             $list[@list] = "ON";
 360         }
 361         else {
 362             $list[@list] = "OFF";
 363         }
 364     }
 365
 366     $message = &rhs_wordwrap( $message, $width );
 367     $listheight = &height_of( $width, $message );
 368     $height = 6 + $listheight + $numitems;
 369
 370     if ( $height <= $scr_lines ) {
 371         $menuheight = $numitems;
 372     }
 373     else {
 374         $height     = $scr_lines;
 375         $menuheight = $scr_lines - $listheight - 6;
 376     }
 377
 378     return &return_output( "list",
 379             "$DIALOG --title "
 380           . &quoted($title)
 381           . " --separate-output --checklist "
 382           . &quoted($message)
 383           . " $height $width $menuheight @list" );
 384 }
 385
 386 sub rhs_checklistl {
 387     my ( $title, $message, $width, $numitems ) = @_;
 388     my ( $i, $tmp, $ent, $height, $listheight, $menuheight, @list );
 389
 390     $width    = int($width);
 391     $numitems = int($numitems);
 392
 393     shift;
 394     shift;
 395     shift;
 396     shift;
 397
 398     @list = ();
 399     for ( $i = 0 ; $i < $numitems ; $i++ ) {
 400         $ent         = shift;
 401         $list[@list] = &quoted($ent);
 402         $list[@list] = &quoted("");
 403         $list[@list] = "OFF";
 404     }
 405
 406     $message = &rhs_wordwrap( $message, $width );
 407     $listheight = &height_of( $width, $message );
 408     $height = 6 + $listheight + $numitems;
 409
 410     if ( $height <= $scr_lines ) {
 411         $menuheight = $numitems;
 412     }
 413     else {
 414         $height     = $scr_lines;
 415         $menuheight = $scr_lines - $listheight - 6;
 416     }
 417     return &return_output( "list",
 418             "$DIALOG --title "
 419           . &quoted($title)
 420           . " --separate-output --checklist "
 421           . &quoted($message)
 422           . " $height $width $menuheight @list" );
 423 }
 424
 425 sub rhs_checklista {
 426     my ( $title, $message, $width, %items ) = @_;
 427     my ( $tmp, $ent, $height, $listheight, $menuheight, @list );
 428
 429     shift;
 430     shift;
 431     shift;
 432     shift;
 433
 434     @list = ();
 435     foreach $ent ( sort keys(%items) ) {
 436         $list[@list] = &quoted($ent);
 437         $list[@list] = &quoted( $items{$ent} );
 438         $list[@list] = "OFF";
 439     }
 440
 441     my $numitems = keys(%items);
 442     $message = &rhs_wordwrap( $message, $width );
 443     $listheight = &height_of( $width, $message );
 444     $height = 6 + $listheight + $numitems;
 445
 446     if ( $height <= $scr_lines ) {
 447         $menuheight = $numitems;
 448     }
 449     else {
 450         $height     = $scr_lines;
 451         $menuheight = $scr_lines - $listheight - 6;
 452     }
 453
 454     return &return_output( "list",
 455             "$DIALOG --title "
 456           . &quoted($title)
 457           . " --separate-output --checklist "
 458           . &quoted($message)
 459           . " $height $width $menuheight @list" );
 460 }
 461
 462 sub rhs_radiolist {
 463     my ( $title, $message, $width, $numitems ) = @_;
 464     my ( $i, $tmp, $ent, $height, $listheight, $menuheight, @list );
 465
 466     $width    = int($width);
 467     $numitems = int($numitems);
 468
 469     shift;
 470     shift;
 471     shift;
 472     shift;
 473
 474     @list = ();
 475     for ( $i = 0 ; $i < $numitems ; $i++ ) {
 476         $ent         = shift;
 477         $list[@list] = &quoted($ent);
 478         $ent         = shift;
 479         $list[@list] = &quoted($ent);
 480         $ent         = shift;
 481         if ($ent) {
 482             $list[@list] = "ON";
 483         }
 484         else {
 485             $list[@list] = "OFF";
 486         }
 487     }
 488
 489     $message = &rhs_wordwrap( $message, $width );
 490     $listheight = &height_of( $width, $message );
 491     $height = 6 + $listheight + $numitems;
 492
 493     if ( $height <= $scr_lines ) {
 494         $menuheight = $numitems;
 495     }
 496     else {
 497         $height     = $scr_lines;
 498         $menuheight = $scr_lines - $listheight - 6;
 499     }
 500
 501     return &return_output( 0,
 502             "$DIALOG --title "
 503           . &quoted($title)
 504           . " --radiolist "
 505           . &quoted($message)
 506           . " $height $width $menuheight @list" );
 507 }
 508
 509 sub return_output {
 510     my ( $listp, $command ) = @_;
 511     my ($res) = 1;
 512
 513     pipe( PARENT_READER, CHILD_WRITER );
 514
 515     # We have to fork (as opposed to using "system") so that the parent
 516     # process can read from the pipe to avoid deadlock.
 517     my ($pid) = fork;
 518     if ( $pid == 0 ) {    # child
 519         close(PARENT_READER);
 520         open( STDERR, ">&CHILD_WRITER" );
 521         exec($command);
 522         die("no exec");
 523     }
 524     if ( $pid > 0 ) {     # parent
 525         close(CHILD_WRITER);
 526         if ($listp) {
 527             @dialog_result = ();
 528             while (<PARENT_READER>) {
 529                 chop;
 530                 $dialog_result[@dialog_result] = $_;
 531             }
 532         }
 533         else {
 534             @dialog_result = <PARENT_READER>;
 535         }
 536         close(PARENT_READER);
 537         waitpid( $pid, 0 );
 538         $res = $?;
 539     }
 540
 541     # Again, dialog returns results backwards
 542     if ( !$res ) {
 543         return 1;
 544     }
 545     else {
 546         return 0;
 547     }
 548 }
 549
 550 sub rhs_wordwrap {
 551     my ( $intext, $width ) = @_;
 552     my ( $outtext, $i, $j, @lines, $wrap, @words, $pos, $pad );
 553
 554     &trace( "rhs_wordwrap\n\tintext:%s\n\twidth:%d\n", $intext, $width );
 555     &screensize;
 556     $width   = int($width);
 557     $outtext = "";
 558     $pad     = 3;             # leave 3 spaces around each line
 559     $pos     = $pad;          # current insert position
 560     $wrap    = 0;             # 1 if we have been auto wrapping
 561     my $insert_nl = 0;        # 1 if we just did an absolute
 562                               # and we should preface any new text
 563                               # with a new line
 564     @lines = split( /\n/, $intext );
 565
 566     for ( $i = 0 ; $i <= $#lines ; $i++ ) {
 567
 568         if ( $lines[$i] =~ /^>/ ) {
 569             $outtext .= "\n" if ($insert_nl);
 570             $outtext .= "\n" if ($wrap);
 571             $lines[$i] =~ /^>(.*)$/;
 572             $outtext .= $1;
 573             $insert_nl = 1;
 574             $wrap      = 0;
 575             $pos       = $pad;
 576         }
 577         else {
 578             $wrap = 1;
 579             @words = split( /\s+/, $lines[$i] );
 580             for ( $j = 0 ; $j <= $#words ; $j++ ) {
 581                 if ($insert_nl) {
 582                     $outtext .= "\n";
 583                     $insert_nl = 0;
 584                 }
 585                 if ( ( length( $words[$j] ) + $pos ) > $width - $pad ) {
 586                     $outtext .= "\n";
 587                     $pos = $pad;
 588                 }
 589                 $outtext .= $words[$j] . " ";
 590                 $pos += length( $words[$j] ) + 1;
 591             }
 592         }
 593     }
 594
 595     &trace( "\touttext:%s\n", $outtext );
 596     return $outtext;
 597 }
 598
 599 ############
 600 1;