#!/usr/bin/perl -w BEGIN { push(@INC,$ENV{HOME}."/perl"); } my $runAs="".$0; #print STDERR "'$0'\n'".join("'\nARG='",@ARGV)."'\n"; #exit 0; #This script lets you pop up simple windows prompting the user to select #something from a list, select a file, type in something, or click a button. # #author: Chris Sincock #last modified: 11/Feb/2005 #version: 1.9 #Changelog: #v1.9: #fixed 'filebox' to work with Gtk2 (window->position(-mouse) doesnt work # any more) #v1.8: #made Gtk2 version - some small bits still aren't working #v1.7: #added the tail option #improved the short usage (printed if the program is run with no args) #improved the parsing of parameters so now any boolean parameter can be #set or unset in multiple ways, eg NOTCENTERED CENTERED=n etc #moved most of the descriptions of parameters out of the usage string #for easier maintenance #v1.6: #made it so that hitting escape does the cancel action (if one was specified) #and hitting return does the ok action (if editing only a single line of text ) #also added option OKPREFIX to make the OK buttons also precede #the output with the button name #v1.5: #Added the MONOSPACED and FONT options #v1.4: #Added the ability to put separators among the buttons using '%' #Fixed bug when list is is empty and LISTSELECTION is browse #definitions of true and false my $true=1; my $false=0; my $programName="pgprompt"; my $programVersion="1.9"; my $defaultFontCharset="iso8859-1"; if(defined($ENV{GTK2_CHARSET}) || defined($ENV{LESSCHARSET})) { my $cs=$ENV{GTK2_CHARSET} || $ENV{LESSCHARSET}; $cs =~ s/utf-8/iso10646-1/i; $defaultFontCharset=$cs; } #the name this program was called with my $thisProgramName=$0; $thisProgramName =~ s#^.*?([^/]+)$#$1#; $0=~s|.*/||g;$0=join(" ",$0,@ARGV); my $test_timing=$false; sub bool() { my ($str)=@_; my $val=0; if(!$str) { return $false; } if($str =~ /^(0|n|no|f|false|off)/i) { return $false; } return $str;#otherwise, return the exact value, so the information is not lost. # if($str =~ /^(1|y|yes|t|true|on)/i) # { # return $true; # } # return $false; } my @paramDescriptions=( 'MESSAGE' => 'if set, specifies a label that will be shown with that message. Supports interpolation.', 'BUTTONS' => "specifies the names (text) of buttons to be shown. Supports interpolation. If any button is just '%', a separator will be used instead - use '%%' if you actually want a button with '%' on it.", 'BUTTONNUM' => '[Boolean] if set, if the user selects a button other than the cancel button, its number is returned instead of its name.', 'LISTNUM' => '[Boolean] if set, when the user selects a list, its number is returned instead of its text.', 'CANCEL' => 'sets the value will be returned if the user presses the cancel button or closes the window', 'CANCELBUTTON' => 'specifies which button should act as the cancel button', 'OKBUTTON' => 'if set, it specifies which button is used as the OK button it can be a very simple pattern like A|B for example if you have two buttons A and B which should both behave like OK buttons', 'OKPREFIX' => '[Boolean] if set, then if an ok button is pressed, the output will be be preceded by the name of the button. The default is for OK buttons to produce just the output (eg contents of text field), but for other buttons to produce just their names.', 'IMMEDIATE' => '[Boolean] if set, then clicking on a list item will have the same effect as selecting it and then clicking the OK button', 'TITLE' => 'sets the title for the window', 'GTK2FONT' => '[Boolean] tells the font mode to output a font in gtk2 format', 'LIST' => 'specifies items for list or combo mode. See LISTSEP. Supports interpolation', 'REVERSELIST' => '[Boolean] if set, the list items will be shown in reverse order', 'SELECTED' => 'if set, it pre-selects a combo or list item or items, or sets the text or file name for the text,field, and file modes.', 'LISTSELECTION' => 'controls how selection behaviour in the list widget - one of: multiple,single,or browse. single means zero or one item can be selected. browse is like single except there is at least one item selected. multiple means zero or more items can be selected.', 'CLOSEVALUE' => 'sets the value to use if the window is just closed by the user, without them using a button (ie closing it with their window manager controls). The default is to do whatever the cancel value is.', 'WIDTH' => 'if HEIGHT is also set, specifies the minimum window width in pixels.', 'HEIGHT' => 'if WIDTH is also set, specifies the minimum window height in pixels.', 'CENTERED' => '[Boolean] or \"mouse\" if set (default=yes), the window will be automatically centered', 'BUTTONDIR' => 'if set to h or v, it changes the direction buttons are laid out.', 'BUTTONSEP' => 'specifies what character is used to separate button names in the BUTTONS list. See the examples below.', 'LISTSEP' => '(default=newline) specifies what character is used to separate items in the LIST and SELECTED lists. See the examples below.', 'COMMAND' => 'specifies a command to run afterwards with the results appended to the command line', 'COMMANDSEP' => '(default=" "), specifies a different character to split the COMMAND option with.', 'CURSORPOS' => 'if set, and the mode is "text" this parameter specifies the cursor position within the text field - in characters from the start of the text.', 'SAVETEXT' => '[Boolean] if set, and and the mode is "text", then no matter what the result (ie whatever button the user presses), the text from the text field will be saved to the file specified by this parameter. If you specify this, and the user clicks on your OK button, the OK button will just return OK (or whatever you specified for OKVALUE). If you do not specify this, then the OK button prints the text from the text box.', 'MONOSPACED' => '[Boolean] if set (default=no),the font "fixed" will be used for the text box. To specify a different monospaced font, use the FONT parameter', 'FONT' => 'sets the font to use for the text box.', 'X' => 'if CENTERED is false, X and Y will position the window', 'Y' => 'if CENTERED is false, X and Y will position the window', 'PAD' => '[int] the number of pixels of padding between widgets', 'DEFAULTBUTTON' => 'specifies which button should be the default (used if the user hits enter)', 'TEXTREADONLY' => 'specifies that the text field should be made read-only', 'MULTILINE' => '[Boolean] causes \\n within the MESSAGE parameter to be converted to newlines', 'INTERP' => '[Boolean] if set to false, interpolation of parameter values. Can still be overridden for a particular parameter by prefixing it with %', 'TEEFILE' => 'if set, and the mode is tail, then any input read will also be written to the file specified by this parameter', 'SLIDER_RANGE' => '[lower,upper,step,page,digits] sets the parameters of the slider - digits is the number of digits to show ', 'SHOWVALUE' => '[Boolean] if set to false, the slider will not show its value. ', 'NOBUTTONS' => '[Boolean] dont show the buttons', 'NODECORATIONS' => '[Boolean] ask the window manager not to show window decorations (borders etc)', 'SLIDER_ACTION' => 'a command to run each time the value of the slider changes. The value will be substituted for the code %v, and the output of the command will be shown in the gui', 'KEY_ACTIONS' => '[key=>cmd] set some shell commands to run for particular keys: eg Tab=>echo hit tab,Escape=>echo hit escape' ); my @modeDescriptions=( tell => 'shows a message with an OK button', ask => 'shows a message with OK and cancel buttons', buttons => 'specifies that a list of buttons is to be shown', list => 'specifies that a list should be shown with a list of items', combo => 'specifies that a list of items is to be shown in a drop-down box', text => 'specifies that a text box should be shown', field => 'specifies that single line field should be shown', file => 'shows a file selection dialog', filebox => 'shows a text entry field and Browse button for entering a file path', tail => 'reads standard input and shows it in a text field', font => 'shows a font selection dialog', gtk1font=> 'shows a GTK1 (X11) font selection dialog', x11font => 'shows an X11 font selection dialog', gtk2font=> 'shows a GTK2 (pango) font selection dialog', pangofont=> 'shows a Pango font selection dialog', slider=>'shows a slider for the range from SLIDER_RANGE' ); my %paramDescriptions=(@paramDescriptions); my %modeDescriptions=(@modeDescriptions); my @okParams=&evenItems(@paramDescriptions); my @okModes=&evenItems(@modeDescriptions); sub evenItems() { my @evens=(); my $n=0; for my $item (@_) { push(@evens,$item) if($n++ % 2 == 0); } return @evens; } sub formatStrings() { my ($toowide,$indent,$spacing,@items)=@_; $toowide=$toowide||80; $spacing=defined($spacing) ? $spacing : 1; $indent=$indent ? $indent : " "; my @lines=(); my $width=0; my $line=$indent; for my $opt (@items) { my $space=$line ? " "x$spacing : ""; my $str=$space.$opt; my $strlen=length($str); my $nextwidth=$width + $strlen; if($nextwidth > $toowide) { push(@lines,$line); $line=$indent.$str; $nextwidth=length($line); $str=""; } else { $line=$line ? $line.$str : $str; } $width=$nextwidth; } if($line) { push(@lines,$line); } return @lines; } sub shortusage() { my $toowide=80; my $modes=join(" ",&formatStrings($toowide," ",1,@okModes)); my $options=join("\n",&formatStrings($toowide," ",1,@okParams)); my $progDesc= $programName ne $thisProgramName ? "${programName}\[$thisProgramName]" : $programName; return qq{$progDesc version $programVersion usage: $programName [version|help] [MODE] [PARAMETER=value]... valid MODEs are: $modes valid PARAMETERs are: $options specify -h on the command line for more detailed help }; } sub wrapLines() { my ($str)=@_; my @parts=split(/\b/,$str); } sub formatDescriptions() { my ($indent, $leftwidth,$toowide, @list)=@_; my $name; my $descr; my @lines=(); while(my $arg=shift @list) { if($name) { $descr=$arg; my $spacing=$leftwidth-length($name); $spacing=$spacing?" "x$spacing:""; push(@lines,"$indent$name$spacing$descr"); $name=undef; } else { $name=$arg; $descr=undef; } } return @lines; } sub fullusage() { my $modedescriptions=join("\n",&formatDescriptions(" ",8,80,@modeDescriptions)); my $parameterDescriptions=join("\n",&formatDescriptions(" ",14,80,@paramDescriptions)); return shortusage().qq{ The first and only argument specifies the type of prompt and is one of: $modedescriptions The general idea is that a window is shown prompting the user with buttons, a list or drop down box, or a text entry field. When the user finishes, their selection is printed to standard output, unless the COMMAND option is set, in which case the specified command is run with the users selection appended. other details are specified by the PARAMETER=value pairs where the parameters are one of: $parameterDescriptions; Note about 'boolean' parameters: If a parameter is a boolean parameter, it can be set or unset in various ways: - an empty value or any of the values: 0 n no f false off specifies a false value for the parameter. - any of the values: y yes t true on specifies a true value for the parameter. - the parameter by itself is equivalent to PARAMETER=y (ie an true value) - if the paramater is prefixed by NOT it inverts the sense of how the value is interpreted, for example NOTCENTERED or NOTCENTERED=yes is equivalent to CENTERED=no Note about 'supports interpolation': Unless interpolation is disabled by setting the INTERP boolean paramter to false, or unless the parameter name is prefixed with a '%', then if a parameter says it "supports -" above, the following rules apply: - if the value specified is "-", standard input will be read for a list of button names, one per line. - if the value specified ends in in a pipe "|", it is taken as a command to generate the item value. The command is run and it's output becomes the value of the parameter. For example, %MESSAGE=- will read the MESSAGE parameter from standard input. Only ONE option may specify read standard input using -, but multiple ones can use the pipe form. ******************************************************** here are some examples: ******************************************************** Note these examples have been spread over multiple lines for readability. pop up a message 300 pixels wide in the center of the screen: $programName tell MESSAGE="You have new mail." TITLE="New Mail" WIDTH=300 ask the user for an item from a list, shown in a drop-down box: $programName list MESSAGE="pick a value:" LIST="a b c d" a simple yes/no dialog: $programName ask MESSAGE="click OK to continue:" TITLE="continue?" the same dialog, but with custom buttons, and set so that cancelling prints an empty line instead of Cancel, and the window is made 300 pixels wide: $programName ask WIDTH=300 MESSAGE="Do you wish to continue:" \\ BUTTONS="Continue Cancel" CANCELBUTTON="Cancel" CANCEL="" TITLE="continue?" this is a more complex example - it shows a list of choices as well as a few buttons. One of the buttons is specified as an OK button, which means that clicking on it produces the value selected from the list. Another is specified as a cancel button, which produces the CANCEL value. Others will produce the text of the button name. This example also shows how to specify items with spaces in them by specifying an alternate separator(/), and also selects two items: $programName list LISTSELECTION="multiple" BUTTONS="Select Random None" \\ LIST="anchovies/salami/olives/hot chilli sauce/chicken" \\ MESSAGE="pick an extra topping:" TITLE="Add topping?" OKBUTTON="Select" \\ CANCELBUTTON="None" SELECTED="salami/chicken" LISTSEP="/" A simple vertical row of buttons: $programName buttons BUTTONS="button 1/button 2/button 3/button 4" \\ BUTTONSEP="/" BUTTONDIR="v" MESSAGE="Pick a button:" Display a choice of quake 3 mods: /bin/ls -d /usr/local/games/quake3/*/ | \\ egrep -vi '/(tools|help|docs|demos|demoq3)/\$' | xargs -n 1 basename | \\ $programName list %LIST="-" WIDTH=200 HEIGHT=300 MESSAGE="Select a mod:" \\ TITLE="Quake III Arena" SELECTED="uie" or you could run this to show you the subjects of new mail messages: $programName list BUTTONS="OK" WIDTH=500 MESSAGE="You have new mail." LIST="grep '^Subject: ' /var/spool/mail/\$USER | cut -c 10- |" }; } sub versionstr() { return "$programName version $programVersion\n"; } use Gtk2 -init; use Glib qw(TRUE FALSE); #use Gtk2::Atoms; use Gtk2::SimpleList; use strict 'vars'; my %interp=(); my %params=( CENTERED=>$true, INTERP=>$true, MONSPACED=>$false, PAD=>10, # OKPREFIX=>1 SLIDER_RANGE=>'0,100,1,1', SHOWVALUE=>$true ); my $qtype=""; sub processParams() { $qtype=""; my $arg; my $paramRE=join("|",@okParams); my $modeRE=join("|",@okModes); foreach $arg (@ARGV) { if($arg =~ /^[-]*help$/i) { print STDERR &fullusage; exit 0; } elsif ($arg =~ /^(${modeRE})$/) { if($qtype) { print STDERR "warning: arg: $arg : $programName mode already" ." specified as: $qtype\n"; } else { $qtype=$arg; } } elsif ($arg =~ /^-[-]?v(|ersion)/) { print STDERR versionstr()."\n"; exit(0); } elsif($arg =~ /^(-h|--h|help)$/i) { print STDERR fullusage()."\n"; exit(0); } else { my $param=""; my $thisarg=$arg; my $reverse=$false; my $val=undef; my $bool=undef; my $interp=undef; if($thisarg =~ /^%(.*)$/s) { $interp=$true; $thisarg=$1; } #print STDERR "Checking arg: $thisarg\n"; if($thisarg =~ /^([^=]+)(|=(.*))$/s) { $param=$1; if(defined($3) && length($3) > 0) { $val=$3; } } # print STDERR "val=$val\n"; if(!$param) { print STDERR "Unknown argument '$arg'\n"; next; } if($param =~ /^not(.*)/i) { my $p=$1; my $descr= $paramDescriptions{$p}; if($descr =~ /[Boolean]/) { $reverse=$true; $param=$p; } } my $descr=$paramDescriptions{$param}; #print STDERR "DESCRIPTION=$descr\n"; if(defined($descr)) { if(!defined($bool)) { $bool = $descr =~ /\[Boolean\]/; } if($bool) { #as a special case here, a missing value means true $val=defined($val) ? &bool($val) : $true; if($reverse) { $val=!$val; } } $val=defined($val) ? $val : ""; #print STDERR "PARAM='$param' VAL=$val\n"; $params{$param}=$val; if(defined($interp)) { $interp{$param}=$interp; } } else { print STDERR "warning: unknown argument $arg\n"; } } } if($params{"USEENV"}) { #overriding with environment variables foreach $arg (keys %ENV) { #only check all-capitals if ($arg =~ /^(${paramRE})$/) { $params{$arg}=$ENV{$arg}; #print "override:$arg:$params{$arg}\n"; } } } #print "full list of params:\n"; #foreach $arg (keys %params) #{ #print "param:$arg:$params{$arg}\n"; #} } sub normaliseFontDescription($$) { my ($descr)=@_; $descr =~ s/^\s+//g; $descr =~ s/\s+$//g; if(!length($descr)) { return ""; } my @dashsplit=split(/-/,$descr); my @spacesplit=split(/\s+/,$descr); my $fontvers = @dashsplit > 5 ? "Gtk" : "Gtk2"; print STDERR "font vers is $fontvers\n"; my $monospacefont="Monospace"; if($fontvers ne "Gtk2") { print STDERR "font vers is not gtk2, i am converting it\n"; #need to convert gtk1 style font to stupid pango font. #all it really does is take the font name and the point size and divide by ten. # return join(" ",@dashsplit[2,3],int($dashsplit[8]/10)); my @style=(); my $mainfontname=$dashsplit[2]; if($descr =~ /fixed/) { $mainfontname=$monospacefont; } if($descr =~ /bold/i) { push(@style,"Bold"); } if($descr =~ /medium/i) { push(@style,"Medium"); } if($descr =~ /semicondensed/i) { push(@style,"SemiCondensed"); } if($descr =~ /-i-/i) { push(@style,"Italic"); } if($descr =~ /-o-/i) { push(@style,"Oblique"); } print STDERR "style is:".join(",",@style)."\n"; return $mainfontname . ", " . join(" ",@style)." ".($dashsplit[8]/10); } elsif($descr =~ /^fixed$/i) { return $monospacefont; } elsif($descr =~ /^fixed([-\s])(.*)$/) { print STDERR "returning monospaced\n"; return $monospacefont.$2; } else { print STDERR "returning descr:";print STDERR $descr;print STDERR "\n"; return $descr; } } sub tryloadfont() { my ($fontstr)=@_; my $pangofontstr=&normaliseFontDescription($fontstr); print STDERR "pango font str is "; print STDERR $pangofontstr."\n"; return Gtk2::Pango::FontDescription->from_string($pangofontstr); } sub setwidgetfont($$@) { my ($w,$fontstr,$copystyle)=@_; #print STDERR "setwidgetfont, fontstr=$fontstr\n"; my $font=&tryloadfont($fontstr); if(!$font) { #print STDERR "falling back on font: fixed\n"; $font=&tryloadfont("Monospace"); } if($font) { #print STDERR "OK, setting font for widget: $w to font: $font\n"; $w->modify_font($font); } print STDERR "Done setting font\n"; } my @paramDataList=(); my $paramValue; #first value of parsed parameter spec my $paramText; #full text of parsed parameter spec sub parseDataParam($$) { my ($param,$paramSep)=@_; #print STDERR "parsedataparam $param,$paramSep\n"; my $paramSpec=$params{$param}; $paramText=""; $paramValue=""; @paramDataList=(); my $interp=$interp{$param} || $params{INTERP}; if($paramSpec) { my $lastChar=substr($paramSpec,length($paramSpec)-1); if($interp && ($lastChar eq "|")) { open (PARAM_IN,$paramSpec); @paramDataList= () ; close PARAM_IN; chomp @paramDataList; } elsif($interp && ($paramSpec eq "-")) { @paramDataList= () ; chomp @paramDataList; close STDIN; } else { @paramDataList=split /${paramSep}/,$paramSpec; } $paramText=join("\n",@paramDataList); $paramValue=$paramDataList[0]; } #print STDERR "paramtext=$paramText\nparamValue=$paramValue\n"; } #if($ARGV[0] eq "test") #{ # system("pgprompt-test","$0"); # exit(0); #} processParams(); if(! $qtype) { print STDERR shortusage()."\n"; exit(0); } elsif($qtype =~ /^(gtk1|x11)font$/) { exec "pgprompt-gtk1",@ARGV; } my $message=$params{"MESSAGE"}; if($message && $message eq "-") { &parseDataParam("MESSAGE",""); $message=$paramText; } my $windowTitle=$params{"TITLE"}; if(!$windowTitle) { if($message) { $windowTitle=$message; $windowTitle=~ s/\n/ /s; } else { $windowTitle="?"; } } my $textWidget; my $textDoc; my $multilineTextWidget=undef; my $windowWidth=$params{"WIDTH"}; if(!$windowWidth) { $windowWidth=0; } my $windowHeight=$params{"HEIGHT"}; if(!$windowHeight) { $windowHeight=0; } my $windowX=$params{"WINX"}; my $windowY=$params{"WINY"}; my $geometry=$params{"GEOMETRY"}; my $pad=$params{"PAD"}; my $listSep="\n"; if($params{"LISTSEP"}) { $listSep=$params{"LISTSEP"}; } my $buttonSep=" "; if($params{"BUTTONSEP"}) { $buttonSep=$params{"BUTTONSEP"}; } my $cancelValue=""; my $defaultValue = ""; my $defaultText = ""; my $escapeIsCancel = 0; my $okButton="OK"; my $cancelButton="Cancel"; my $defaultButton=$params{DEFAULTBUTTON}; if($params{"OKBUTTON"}) { $okButton=$params{"OKBUTTON"}; } if($params{"CANCELBUTTON"}) { $cancelButton=$params{"CANCELBUTTON"}; $cancelValue = $cancelButton; $escapeIsCancel=$true; } if(defined $params{"CANCEL"}) { $cancelValue=$params{"CANCEL"}; $escapeIsCancel=$true; } if(!defined($defaultButton)) { #print STDERR "setting default button to ok button $okButton\n"; $defaultButton=$okButton; } if(!defined($defaultButton)) { #print STDERR "setting default button to cancel button $defaultButton\n"; $defaultButton=$cancelButton; } #print STDERR "cancel value is $cancelValue\n"; my $returnValue=$cancelValue; my $returnValueGetter=undef; my $returnStatus=-1; #print STDERR "returnStatus starts as $returnStatus\n"; my $fileReturnValue; my $fontReturnValue; sub setReturnStatus($) { my ($newStatus)=@_; $returnStatus=$newStatus; print STDERR "Changed Return status to $returnStatus\n"; } my @buttons=(); if($qtype =~ /tell|tail/) { $escapeIsCancel=$true; @buttons=($okButton); } else { @buttons=($okButton,$cancelButton); } if($params{"BUTTONS"}) { parseDataParam("BUTTONS",$buttonSep); @buttons=@paramDataList; $defaultValue=$buttons[0]; } my $buttonOrientation="h"; if($params{"BUTTONDIR"}) { $buttonOrientation=$params{"BUTTONDIR"}; } my $buttonOrientationIsVert= $buttonOrientation =~ /^(v|vert|vertical|updown|northsouth)/i; my $listSelection="-browse"; if($params{"LISTSELECTION"}) { $listSelection="-".$params{"LISTSELECTION"}; } my %listOrderHash=(); my @listItems=""; if($params{"LIST"}) { parseDataParam("LIST",$listSep); @listItems=@paramDataList; if($params{"REVERSELIST"}) { @listItems=reverse(@listItems); } $defaultValue=$paramValue; } my @selectedValues=(); if(defined($params{"SELECTED"})) { parseDataParam("SELECTED",$listSep); @selectedValues=@paramDataList; $defaultValue=$paramValue; $defaultText=$paramText; } my %keyActions=(); if(defined($params{KEY_ACTIONS})) { for my $actstr (split(/,/, $params{KEY_ACTIONS})) { if($actstr =~ /(.*?)=>(.*)/) { $keyActions{$1}=$2; } } } my @execList; sub do_exit() { if((!defined($returnValue)) && defined($returnValueGetter)) { $returnValue=&$returnValueGetter; if(!$returnValue) { $returnValue=$cancelValue; } } if($params{"COMMAND"}) { my $splitstr=' '; if($params{"COMMANDSEP"}) { $splitstr=$params{"COMMANDSEP"}; } @execList=split /${splitstr}/,$params{"COMMAND"}; my @returnValues= split /\n/, $returnValue; @execList=(@execList,@returnValues); print join(" ",@execList); Gtk2->main_quit(); } elsif($params{"SAVETEXT"}) { if($textWidget) { my $thetext= $textDoc ? $textDoc->get_text( $textDoc->get_start_iter, $textDoc->get_end_iter(), 0) : $textWidget->get_text(($textWidget->get_bounds()),TRUE); open(FH,">" . $params{"SAVETEXT"}); print FH $thetext; close FH; } #print STDERR "printing return value $returnValue to STDOUT\n"; print $returnValue."\n"; close STDOUT; #make sure stoud has been flushed #print STDERR "Calling main_quit\n"; Gtk2->main_quit; } else { #print STDERR "printing return value $returnValue to STDOUT\n"; print $returnValue."\n"; #STDOUT->flush; #print STDERR "closing STDOUT\n"; close STDOUT;#make sure STDOUT has been flushed, the stupid POS #print STDERR "Quitting\n"; #print STDERR "Calling main_quit\n"; Gtk2->main_quit; } } sub destroy_window() { my ($win)=@_; if($win) { #print STDERR "destroy win:$win\n"; destroy $win; } #print STDERR "Destroying window - calling do_exit\n"; do_exit; 0; } sub create_file_selection($) { $fileReturnValue=""; my ($filename)=@_; my $fs_window = Gtk2::FileSelection->new($windowTitle); # $fs_window->position(-mouse); if($filename) { $fs_window->set_filename($filename); } # $fs_window->signal_connect("destroy", sub { destroy $fs_window;}); $fs_window->signal_connect("delete_event", sub { destroy $fs_window; }); $fs_window->ok_button->signal_connect("clicked", sub { setReturnStatus(0); $fileReturnValue=$fs_window->get_filename; destroy $fs_window; }); $fs_window->cancel_button->signal_connect("clicked", sub { setReturnStatus(1); #print STDERR "cancel button clicked, destroying window\n"; destroy $fs_window; }); return $fs_window; } #use Gtk2::Keysyms; my $tabWasTyped=$false; sub handleKeys() { #rint STDERR "handle escape\n"; my ($window,$clickhandler,$widg,$evt)=@_; use Data::Dumper; #print STDERR ::Dumper([$evt]); my $str=Gtk2::Gdk->keyval_name($evt->keyval); if($keyActions{$str}) { system("sh","-c",$keyActions{$str} . " &"); return TRUE; } elsif($str eq "Escape") { if($escapeIsCancel) { $returnValue=$cancelValue; #destroy $window; do_exit(); return TRUE; } } elsif($str eq "Tab") { $tabWasTyped=$true; return FALSE; } elsif($str eq "Return") { my $ctrlHeld = $evt->state * ['control-mask']; #if the user hit tab, they have probably selected the button they want #so we let the Return key go to activate the button they selected #also if they typed return in a text widget, we need to ignore it and let it # #if they held down control it overrides these two cases if((!($tabWasTyped || ($multilineTextWidget && $multilineTextWidget->has_focus() ))) || $ctrlHeld) { #print STDERR "hit return. multiline check\n"; #print STDERR "focus?".$multilineTextWidget->has_focus(); if($clickhandler) { &$clickhandler; return TRUE; } } } return FALSE; } sub setupWindow { my($list,$box1,$box2,$theentry,$cb, $editable,$button,$separator,$text,$slider,$adjustment); our $entry=$theentry; my $window = Gtk2::Window->new(-toplevel); my @realize_handlers=(); my $defaultClicked=undef; #this will be a handler to simulate pressing default button #print STDERR "adding destroy handler in setupWindow\n"; # $window->signal_connect("destroy", \&destroy_window, \$window); $window->set_events( $window->get_events + 'key_press_mask'); # print STDERR "adding delete handler in setupWindow\n"; # $window->signal_connect("delete_event", \&destroy_window, \$window); $window->set_title($windowTitle); $window->set_border_width(0); #not in Gtk2 # $window->border(0); my $vbox = new Gtk2::VBox(0,0); $window->add($vbox); $vbox->show; $box2 = new Gtk2::VBox(0,$pad); $box2->set_border_width($pad); #not in Gtk2 $vbox->pack_start($box2, 1, 1, 0); $box2->show; if($message) { if($params{"MULTILINE"}) { $message =~ s/\\n/\n/g; } my $label = new Gtk2::Label "$message"; # $label->set_alignment(0, 0.5); $label->set_justify('left'); #$entry->set_usize(0, 25); # $entry->set_text($entryValue); # $entry->select_region(0, length($entry->get_text)); $box2->pack_start($label, 0, 0, 0); $label->show; } if($qtype eq "filebox" || $qtype eq "field") { my $box=$box2; if($qtype eq "filebox") { $box = new Gtk2::HBox(0,$pad); $box->set_border_width($pad); #not in Gtk2 $box2->pack_start($box, 0, 1, 0); $box->show; } $entry = new Gtk2::Entry; $textWidget=$entry; #$entry->set_usize(0, 25); $entry->set_text($defaultValue); $entry->select_region(0, length($entry->get_text)); $box->pack_start($entry, 1, 1, 0); $entry->show; #$entry->can_default(1); #$entry->grab_default; $entry->can_focus(1); $entry->grab_focus; if($qtype eq "filebox") { my $button = new Gtk2::Button "Browse..."; $button->signal_connect("clicked", sub { my $filewin=create_file_selection($entry->get_text); $filewin->signal_connect("destroy", sub { if($fileReturnValue) { $entry->set_text($fileReturnValue); } }); show $filewin; }); $box->pack_start($button,0,0,0); $button->show; } } elsif($qtype eq "combo") { $cb = new Gtk2::Combo; $multilineTextWidget=$cb; $cb->set_popdown_strings(@listItems); $cb->entry->set_text($defaultValue); $cb->entry->select_region(0, length($cb->entry->get_text)); $cb->show; $box2->pack_start($cb, 1, 1, 0); } elsif($qtype eq "slider") { my $rangeparam=$params{SLIDER_RANGE}; my $curvalue=$params{SELECTED}; my ($lower,$upper,$step,$page,$digits)= split(/,/,$rangeparam); #print STDERR "upper is $upper\n"; if(!defined($lower)) { $lower = 0; $upper = 100; $step = 1; $page=1; } if(!defined($upper)) { $step = $lower * 10.0; } if(!defined($step)) { $step = ($upper-$lower)/10.0; } if(!defined($page)) { $page = $step; } if(!defined($curvalue)) { $curvalue=$lower; } $upper += $page; #print STDERR "$curvalue $lower $upper $step $page,$page\n"; $adjustment = Gtk2::Adjustment->new($curvalue, $lower,$upper, $step, $page,$page); #if($adjustCodeRef) #{ # $adjustment->signal_connect( "value_changed", $adjustCodeRef, $prefkey ); #} my $acmd=$params{SLIDER_ACTION}; my $vlabel=undef; if($acmd) { $vlabel=Gtk2::Label->new(""); $box2->pack_start($vlabel,1,1,0); } $slider = Gtk2::HScale->new($adjustment); #doesnt work with gtk2 # $scale->set_usize(250,30); $slider->set_update_policy(-delayed); #print STDERR "digits is $digits\n"; $slider->set_digits(defined($digits) ? $digits : 0); $slider->set_draw_value($params{SHOWVALUE}); $slider->show; $box2->pack_start($slider,1,1,0); if($acmd) { $vlabel->set_text(" "); $vlabel->show; $adjustment->signal_connect( "value_changed", sub { my $curvalue=$adjustment->get_value(); my $custcmd=$acmd; #print STDERR "$curvalue\n"; $custcmd =~ s/%v/$curvalue/; #print STDERR "executing:$custcmd\n"; my @output=`$custcmd`; chomp $output[@output-1]; $vlabel->set_text(join("",@output)); 1; } ); } } elsif($qtype eq "tail") { #I use a 'do require' here because I want pgprompt to be standalone #so it should still run without any of my other stuff, even if some #functionality is missing my $d=$runAs; $d =~ s%/[^/]*$%%; my $usefile="$d/csincock/Gtk2/OutputPanel.pm"; #it isnt' working yet tho #do "use '$usefile';" || die "Can't use 'tail' mode because $usefile can't be found:".$!."\ndoh"; use csincock::Gtk2::OutputPanel; my $handler=undef; my $teefileh=undef; if($params{TEEFILE}) { my $teefile=$params{TEEFILE}; if(!($teefile =~ /^>/)) { $teefile=">$teefile"; } open($teefileh,$teefile) or $teefileh=undef; } $handler = sub { my $str=shift; if($teefileh) { print $teefileh $str; } $str =~ tr/\r/\n/; return $str; }; my $outpanel=new csincock::Gtk2::OutputPanel(STDIN,0,$handler); $outpanel->component->show; $box2->pack_start( $outpanel->component, 1, 1, 0 ); $textWidget=$outpanel->textWidget; $textDoc=$textWidget->get_buffer(); $outpanel->go; #=cut } elsif($qtype eq "text") { $textDoc=new Gtk2::TextBuffer(undef); $textWidget = Gtk2::TextView->new_with_buffer($textDoc); $multilineTextWidget=$textWidget; my $scrolled_win = new Gtk2::ScrolledWindow(undef,undef); $scrolled_win->set_policy( 'automatic', 'automatic' ); $textWidget->set_wrap_mode('char'); # my $frame=new Gtk2::Frame(); # $frame->set_border_width(5); # $frame->set_shadow_type('etched-in'); # $frame->add($textWidget); $scrolled_win->add_with_viewport($textWidget); $box2->pack_start( $scrolled_win, 1, 1, 0 ); show $scrolled_win; $textDoc->set_text($defaultText); show $textWidget; # show $frame; $textWidget->can_default(1); $textWidget->grab_default; $textWidget->can_focus(1); $textWidget->grab_focus; if($params{"CURSORPOS"}) { # print STDERR "setting point to ".$params{"CURSORPOS"}."\n"; $textWidget->set_position($params{"CURSORPOS"}); $textWidget->set_point($params{"CURSORPOS"}); } } elsif($qtype =~ /font/i) #equivalent to gfontsel { $returnValue=undef; my $vbox=new Gtk2::VBox(0,0); $vbox->show; my $field=new Gtk2::Entry(); $field->hide;#show; my $fontsel=new Gtk2::FontSelection;$fontsel->show; $vbox->pack_start($field,0,0,0); $vbox->pack_start($fontsel,0,0,0); $box2->pack_start($vbox, 1, 1, 0); if(@selectedValues) { my $font=$selectedValues[0]; if($font =~ / / && !($font =~ /-/)) { my @parts=split(/\s+/,$font); my $foundry="*"; my $family="*"; my $weight="*"; my $slant="*"; my $swidth="*"; my $addstyle="*"; my $pixelsize="*"; my $size="*"; my $resx="*"; my $resy="*"; my $avgwidth="*"; my $spacing="*"; my $charset="*-*"; for (@parts) { if(/^\d+$/) { $size=$_ *10; } elsif(/bold|medium|demibold|regular/i) { $weight=lc(); } elsif(/condensed|normal/i) { $swidth=lc(); } elsif(/italic|obliquie|roman/i) { $slant=lc(); } elsif(/monospaced|proportional/i) { $spacing=lc(); } elsif($family eq "*") { $family=$_; } else { print STDERR "Unrecognised font part: $_ (using it as foundry)\n"; $foundry=$_; } } if($charset eq "*-*") { $charset=$defaultFontCharset; } # my $newfont=join("-","",$foundry,$family,$weight,$slant,$swidth,$addstyle,$pixelsize,$size,$resx,$resy,$spacing,$avgwidth,$charset); #print STDERR "font spec: '$font'\ntranslated to:'$newfont'\n"; # $font=$newfont; #'-*-helvetica- *- *- *- *-*-120-*-*-*-*-*' #-adobe-helvetica-medium-r-normal-*-*-140-*-*-p-*-iso8859-1 # $font=-monotype-arial-bold-r-normal-*-*-140-*-*-p-*-iso8859-1 } $fontsel->set_font_name($font); } ## $fontsel->set_filter('user', ## ['scalable','scalable-bitmap'], ## ['*'], ## ['*'], ## ['*'], ## ['*'], ## ['*'], # ['iso8859-1','iso8859','adobe','adobe-fontspecific'] ## ['iso8859-1','iso8859-1'] ## ['adobe-fontspecific'] ## [$defaultFontCharset,$defaultFontCharset] ## ##); $returnValueGetter=sub { my $newfont = $fontsel->get_font_name; return $newfont; } ; #print STDERR "Return value getter is now: $returnValueGetter\n"; } elsif($qtype eq "list") { my $scrolled_win = new Gtk2::ScrolledWindow(undef, undef); $scrolled_win->set_policy(-automatic, -automatic); $box2->pack_start($scrolled_win, 1, 1, 0); $scrolled_win->show; $list=new Gtk2::SimpleList('blah'=>'text'); my %selhash=(); for my $item (@selectedValues) { $selhash{$item}++; } my @selind=(); my $itemn=0; for my $item (@listItems) { push(@{$list->{data}},[$item]); if($selhash{$item}) { push(@selind,$itemn); } $listOrderHash{$itemn}=$item; if($defaultValue && $item eq $defaultValue) { if(!@selectedValues) { push(@selectedValues,$item); push(@selind,$itemn); } } $itemn++; } $list->set_headers_visible(FALSE); #if add() is used instead of add_with_viewport, then a horrible #effect happens when scrolling by dragging the scroll bar quickly # column for severities #$column->set_sort_column_id (0); $scrolled_win->add_with_viewport($list); $list->show; #print STDERR "list sel = $listSelection\n"; $list->get_selection->set_mode($listSelection); $list->get_selection->unselect_all(); if(!@selind) { if($listSelection eq "-browse" || $listSelection eq "single") { push(@selind,0); } } if($listSelection =~ /multiple|extended|browse/i) { if(@selind>0) { @selind=($selind[0]); } } if(@selind > 1) { #print STDERR "SELECTING rows:".join(",",@selind); $list->select(@selind); } elsif(@selind) { # $list->get_selection->set_mode("-multiple"); # $list->select(@selind); # $list->get_selection->set_mode($listSelection); # $list->select(@selind); # $list->get_selection->set_mode("-multiple"); # $list->select(@selind); # $list->get_selection->set_mode("-single"); # $list->select(@selind); ## $list->get_selection->set_mode("-multiple"); # $list->select(@selind); #the FUCKING RETARTED tree view fails to properly select #the item in any mode except multiple, #unless it has focus $list->grab_focus(); #print STDERR "Selecting single row:".$selind[0]."\n"; my $iter=$list->get_model->iter_nth_child(undef,$selind[0]); #print STDERR "iter=$iter\n"; #print STDERR $list->get_selection->select_iter($iter); #print STDERR "str:".$list->get_model->get_string_from_iter($iter)."\n"; #print STDERR "COUNT:".$list->get_selection->count_selected_rows(); #print STDERR "is selected? " . ($list->get_selection->iter_is_selected($iter)); } #$list->select(10); } if($textWidget) { my $font=undef; if($params{"MONOSPACED"}) { $font="Monospace"; # $font="fixed"; } if($params{"FONT"}) { $font=$params{"FONT"}; } if($font) { &setwidgetfont($textWidget,$font,0); } if(! $params{"TEXTREADONLY"}) { $textWidget->set_editable('1'); } } if (@buttons > 0) { if(! $qtype eq "buttons") { $separator = new Gtk2::HSeparator; $vbox->pack_start($separator, 0, 1, 0); $separator->show; } my $bbox; if($buttonOrientationIsVert) { $bbox = new Gtk2::VBox(0,$pad); } else { $bbox= new Gtk2::HBox(0,$pad); } $bbox->set_border_width($pad); #not in Gtk2 $vbox->pack_start($bbox, 0, 1, 0); $bbox->show; my $btnName; my $btnNum=1; my $buttonHandler = sub { my ($mybtnNum,$btnName)=@_; if($params{"BUTTONNUM"}) { $returnValue=$mybtnNum; } else { $returnValue=$btnName; } #print STDERR "btnNum for $btnName is $mybtnNum\n"; setReturnStatus($mybtnNum); if($btnName =~ /^$okButton$/) { if(!$params{"BUTTONNUM"}) { setReturnStatus(0); } $returnValue=""; if($params{OKPREFIX}) { $returnValue.= ($params{"BUTTONNUM"} ? $mybtnNum : $btnName) . "\n"; } if($entry) { $returnValue.=$entry->get_text; } elsif ($cb) { $returnValue.=$cb->entry->get_text; } elsif($returnValueGetter) { $returnValue .= &$returnValueGetter; } elsif ($textWidget && !$params{"TEXTREADONLY"}) { #if SAVETEXT is set, the text isn't used as the #return value - it is saved to the file instead if(! $params{"SAVETEXT"}) { my $thetext= $textDoc ? $textDoc->get_text( $textDoc->get_start_iter, $textDoc->get_end_iter(), 0) : $textWidget->get_text(($textWidget->get_bounds()),TRUE); $returnValue .= $thetext; } } elsif ($list) { #print STDERR "building return value for list\n"; $returnValue.=$params{COMMAND} ? "" : ($params{OKPREFIX}?"$btnName":""); foreach ($list->get_selected_indices) { #print STDERR "selection $_\n"; if($returnValue) { $returnValue.="\n"; } $returnValue.= ($params{"LISTNUM"}) ? $_+1 : $listOrderHash{$_}; #print STDERR "ret value = $returnValue\n"; } } } elsif($btnName eq $cancelButton) { $returnValue=$cancelValue; } #print STDERR "button handler destroying window\n"; #destroy $window; do_exit(); }; if(!$params{NOBUTTONS}) { foreach $btnName (@buttons) { if($btnName eq "%") { my $sep; if($buttonOrientationIsVert) { $sep = new Gtk2::HSeparator(); } else { $sep = new Gtk2::VSeparator(); } $bbox->pack_start($sep, 1, 1, 0); $sep->show; next; } elsif($btnName eq "%%") { $btnName="%"; } $button = new Gtk2::Button $btnName; my $thisBtnNum=$btnNum; my $handler= sub { #print STDERR "Calling button handler\n"; &$buttonHandler($thisBtnNum,$btnName); #print STDERR "ok, done it\n"; }; #print STDERR "$defaultButton : $btnName \n"; $button->signal_connect("clicked", $handler); $bbox->pack_start($button, 1, 1, 0); if(((!$defaultButton) && ($okButton && $btnName =~ /^$okButton$/)) || ($defaultButton && $btnName eq $defaultButton)) { $defaultClicked=$handler; #print STDERR "defaultClicked handler:$btnName\n"; #print STDERR "using btn $btnNum ($btnName) [$defaultButton] as default\n"; $button->can_default(1); $button->grab_default; } $button->can_default(1); #if(!$default || $default == $btnNum) #{ # $button->grab_default; #} $button->show; $btnNum++; } } } if($windowWidth >= 0 && $windowHeight >= 0) { #print STDERR "WIDTHXHEIGHT=$windowWidth x $windowHeight\n"; $window->set_default_size($windowWidth,$windowHeight); } elsif($windowX && $windowX) { # if(!$windowX) # { # $windowX=$window->get_position->x; # } # if(!$windowY) # { # $windowY=$window->get_position->y; # } # $window->move($windowX,$windowY); } # if($geometry) # { # $window->parse_geometry($geometry); # } if($params{"CENTERED"} eq "mouse") { $window->set_position('mouse'); } elsif($params{"CENTERED"}) { $window->set_position('center'); } else { my $x = $params{"X"}; my $y = $params{"Y"}; $x = defined($x) ? $x : 0; $y = defined($y) ? $y : 0; if(defined($x) || defined($y)) { push(@realize_handlers, sub { # $window->set_uposition($x,$y); #print STDERR ::Dumper([$x,$y]); #print STDERR "MOVE $x $y\n"; #$window->window->move($x,$y); $window->move($x,$y); }); } } if($entry && $defaultClicked) { $entry->signal_connect("activate", sub { &$defaultClicked; 1; }); } if($list && $params{IMMEDIATE}) { if($params{IMMEDIATE} eq "2") { #print STDERR "adding row-activated handler\n"; $list->signal_connect('row-activated', sub { print STDERR "SELECT\n"; if($defaultClicked) { &$defaultClicked; #print STDERR "done default clicked SELECT\n"; } }); } else { $list->get_selection->signal_connect("changed", sub { #print STDERR "CHANGED\n"; if($list->get_selection->count_selected_rows() > 0) { if($defaultClicked) { &$defaultClicked; #print STDERR "done default clicked CHANGED\n"; # exit(0); # Gtk2->main_quit; } } # print STDERR "selection changed returning 1\n"; return 0; }); } } if($params{NODECORATIONS}) { push(@realize_handlers, sub { $window->window->set_decorations([]); }); } if($test_timing) { push(@realize_handlers, sub { #exit immediately so that the startup time can #be measured. # Gtk2->main_quit; }); } if(@realize_handlers) { $window->signal_connect('realize', sub { for my $h (@realize_handlers) { &$h(); } 1; }); } $window->signal_connect("key_press_event", sub { return &handleKeys($window,$defaultClicked,@_); } ); $window->show; } if($qtype eq "file") { my $filewin=create_file_selection($defaultValue); $filewin->signal_connect("destroy", sub { if($fileReturnValue) { $returnValue=$fileReturnValue; } do_exit; } ); show $filewin; } #elsif($qtype eq "font") #{ # my $fontwin=create_font_selection($defaultValue); # $fontwin->signal_connect("destroy", sub { # if($fontReturnValue) # { # $returnValue=$fontReturnValue; # } # do_exit; # } ); # show $fontwin; #} else { setupWindow; } #print STDERR "BEFORE Gtk main loop\n"; if(!$test_timing) { Gtk2->main; } #print STDERR "AFTER Gtk main loop\n"; if(@execList) { system(@execList); } print STDERR "Exiting with return status:$returnStatus\n"; exit $returnStatus;