xref: /freebsd/contrib/dialog/dialog.pl (revision 4c8945a0) 
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
39use warnings;
40use strict;
41use diagnostics;
42
43our $DIALOG = "dialog";
44our $GAUGE;
45our $gauge_width;
46our $scr_lines = 24;
47our $scr_cols  = 80;
48our @dialog_result;
49our $trace = 0;
50
51require "flush.pl";
52
53sub trace {
54    if ($trace) {
55        if ( open TRACE, ">>dialog.log" ) {
56            printf TRACE $_[0], @_[ 1 .. $#_ ];
57            close TRACE;
58        }
59    }
60}
61
62sub 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
70sub 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
85sub 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
97sub rhs_clear {
98    return system("$DIALOG --clear");
99}
100
101sub 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
113sub 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
135sub 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
151sub 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
175sub 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
193sub rhs_update_gauge {
194    my ($percent) = @_;
195
196    &printflush( $GAUGE, "$percent\n" );
197}
198
199sub 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
207sub rhs_stop_gauge {
208    close $GAUGE;
209}
210
211sub 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
228sub 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
268sub 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
307sub 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
339sub 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
386sub 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
425sub 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
462sub 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
509sub 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
550sub 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############
6001;
601