Git-Like Menus


[Pleased as I was to get mentioned in a lightning talk in this year’s YAPC, I noted that my mention was in the context of writing blog posts that “don’t contain much code.”1  Well, fair enough: I’m a verbose bugger, and a wannabe writer, so my prose does tend to ramble.  But I can do code, dammit.  So, you know ... here’s some code.]

The other day I was working on my music library scripts,2 and I needed a menu for something.  Now, there are oodles and oodles of modules on CPAN to help you write menus.  I’ve looked at most of them, and tried quite a few, but long ago I settled on using the -menu option in IO::Prompter, by the Damian.  For a nice, pretty menu layout—say, something you do as a central feature for a program—it’s tough to beat.  It’s not perfect, by any stretch, but it offers some very nice features, such as (optionally) not requiring ENTER after a menu choice.

But that’s not what I wanted in this case.  What I was looking for here was a quick, compact menu ... sort of like what you get when you’re interactively staging a commit in git (that is, git add -p, or, probably more commonly, git add -i then choose “patch”).  Specifically, the features I wanted were:

  • Quick and dirty (not part of a larger system, no complicated dispatch system, etc).
  • Choose option by letter (not where you scroll around to find the right choice, etc).
  • Compact: fits on one line, but
  • can use ? to see what the options actually do.
  • Can choose your own letters, and put them in whatever order you like.3
  • Don’t require ENTER.4
So, I went cruising through all the menu modules on CPAN again.  I figured it had been a few years since I’d looked, so maybe there was something new out there, or maybe I’d overlooked something, since this menu is a bit different from what I was looking for the first time.  After a couple of hours, I threw up my hands.  Sometimes you just gotta roll your own.


So I want something quick-and-dirty, and I don’t really want to spend a lot of time writing it either.  I need to leverage as much as possible.  Since I want to be able to respond to a single keypress (no ENTER required), and since I know IO::Prompter does that already,5 I’ll base my menu around that module.  Here’s a simple first cut:

func mini_menu ($choices, $prompt)
{
    my @choices = split(//, $choices);
    my $opts = join(',', @choices);

my $choice;
PROMPT:
{
print "$prompt [$opts] ";
$choice = prompt -single;

redo PROMPT unless $choices =~ /\Q$choice/;
};

return $choice;
}

(Notice we’re using Method::Signatures here.  I tend to do that a lot.  Go figure.)  So, this is pretty basic.  Remember that splitting on the null pattern is just a quick way to get an array of the individual characters in a string.  Then I put them back together with commas for display, call IO::Prompter’s prompt method with -single (which is the “don’t require ENTER” part), verify that they typed one of the characters I’m expecting, then return what they typed.  Note the \Q in my verification regex: very important in case I want one of my options to be * or +.

You’d call it like so:

my $choice = mini_menu( "arq" => "What do you want to do?" );

where maybe “a” means “add” and “r” means “replace” and “q” means “quit.” Or whatever.  Of course, the user doesn’t know that, eh?  We’d better add the ”? to get help” feature.

func mini_menu ($choices, $prompt, HashRef :$help)
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join(',', @choices);

my $choice;
PROMPT:
{
print "$prompt [$opts] ";
$choice = prompt -single;

if ($help and $choice eq '?')
{
say "$_ - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;
};

return $choice;
}

That was pretty easy.  We’ve already got an array of @choices, so printing out what each one does is just a matter of getting that info from our caller and a quick loop through the array.  And of course we add the help for “help” ourselves.  This means that ? is now not a valid option for inclusion in $choices, but we can just document that.  A slightly bigger issue is that now we’re having to include the choices twice: once in $choices, and once as keys in %$help.  We could dispense with $choices altogether and just use the $help keys, but that would mean we’d have to make help mandatory (which I could live with) and we’d also lose the ability to control the order of our options (which I couldn’t).  Or else we could try to do something clever with passing in a tied hash where key order is preserved, but that adds a whole ‘nother dependency, and makes calling the function a bit messier ... ah, screw it.  We’ll just live with the redundancy.

What else might we want?  Well, I suppose we might want to use something other than comma as our option separator.  Any time you’re hardcoding a string in your code (even one as trivial as this one), you probably want to review that to make sure you’re not locking yourself in unnecessarily.  And it’s trivial to fix:

func mini_menu ($choices, $prompt, HashRef :$help, :$delim = ',')
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join($delim, @choices);

my $choice;
PROMPT:
{
print "$prompt [$opts] ";
$choice = prompt -single;

if ($help and $choice eq '?')
{
say "$_ - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;
};

return $choice;
}

(Yes, technically that hardcoded comma is still in there—we just moved it around.  But the difference in intention is massive.)  Nice.

Now, I said I didn’t want a big, complex dispatch system for this.  But how about a little tiny one, completely optional?  This does add a layer of complexity, both in terms of code and in terms of interface, but I think it’ll be worth it.  Let’s say that we’ll accept an optional hashref of coderefs, and we’ll call the coderef when the user picks the option.  If the coderef is undefined, or if it returns 0, we’ll come back to the user; otherwise, we’ll just do the menu again.  This will be quite helpful for the particular application I have in mind.

func mini_menu ($choices, $prompt, HashRef :$help, HashRef :$dispatch, :$delim = ',')
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join($delim, @choices);

my $choice;
PROMPT:
{
print "$prompt [$opts] ";
$choice = prompt -single;

if ($help and $choice eq '?')
{
say "$_ - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;

if ($dispatch and $dispatch->{$choice})
{
if ( $dispatch->{$choice}->($choice) != 0 )
{
redo PROMPT;
}
}
};

return $choice;
}

There.  Basic, but serviceable.  What else, what else ...  Oh, yeah.  I can tell you from years of experience writing menus that sooner or later I’m going to want my menu to do something right before it prints the options.  Before we added the dispatch system, that was something that could just be done before calling the menu function in the first place.  But now that we have the option of doing some function then showing the menu again, we’re gonna need a way to redo the ... whatever.  Check some status, relist some things which were possibly modified by the dispatch functions, etc.  Sort of a “pre-menu” function.  Okay, let’s jam that in there too:

func mini_menu ($choices, $prompt, HashRef :$help, HashRef :$dispatch, CodeRef :$premenu, :$delim = ',')
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join($delim, @choices);

my $choice;
PROMPT:
{
$premenu->() if $premenu;
print "$prompt [$opts] ";
$choice = prompt -single;

if ($help and $choice eq '?')
{
say "$_ - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;

if ($dispatch and $dispatch->{$choice})
{
if ( $dispatch->{$choice}->($choice) != 0 )
{
redo PROMPT;
}
}
};

return $choice;
}

Excellent.  Except ... well, now we’re going to call that pre-menu function again even when the user just hits ? to see the help.  If the function takes any time at all to do its job, that’ll annoy the user.6  Oooh, here’s a clever way to avoid that: once the user hits ?, $choice is defined.  So we can do the pre-menu thing only if $choice is undef.  And then we’ll just explicitly undef it after dispatch.

func mini_menu ($choices, $prompt, HashRef :$help, HashRef :$dispatch, CodeRef :$premenu, :$delim = ',')
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join($delim, @choices);

my $choice;
PROMPT:
{
$premenu->() if $premenu and not defined $choice;
print "$prompt [$opts] ";
$choice = prompt -single;
$choice = "\n" if length($choice) == 0; # empty string means the user just hit ENTER

if ($help and $choice eq '?')
{
say "$_ - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;

if ($dispatch and $dispatch->{$choice})
{
if ( $dispatch->{$choice}->($choice) != 0 )
{
undef $choice;
redo PROMPT;
}
}
};

return $choice;
}

This actually worked perfectly for my first couple of attempts of using it.  Until I got a bit fancy and tried to include SPACE and ENTER as two of my menu options.  Well, we have two problems with that:

  • Printing a literal space or newline in the help menu doesn’t do anyone much good.
  • When in -single mode, IO::Prompter::prompt doesn’t treat ENTER the same as other keys.  At first I thought it was trying to return a default, but that didn’t turn out to be true.7  But, anyway, when you hit ENTER, you get an empty string back.  So, fine: we’ll just catch that explicitly.
And, voilà:
my %KEYNAMES = ( ' ' => 'SPACE', "\n" => 'ENTER' );
func mini_menu ($choices, $prompt, HashRef :$help, HashRef :$dispatch, CodeRef :$premenu, :$delim = ',')
{
    my @choices = split(//, $choices);
    if ($help)
    {
        push @choices, '?';
        $help->{'?'} = 'print help';
    }
    my $opts = join($delim, map { $KEYNAMES{$_} // $_ } @choices);

my $choice;
PROMPT:
{
$premenu->() if $premenu and not defined $choice;
print "$prompt [$opts] ";
$choice = prompt -single;
$choice = "\n" if length($choice) == 0; # empty string means the user just hit ENTER

if ($help and $choice eq '?')
{
say $KEYNAMES{$_} // $_, " - $help->{$_}" foreach @choices;
redo PROMPT;
}

redo PROMPT unless $choices =~ /\Q$choice/;

if ($dispatch and $dispatch->{$choice})
{
if ( $dispatch->{$choice}->($choice) != 0 )
{
undef $choice;
redo PROMPT;
}
}
};

return $choice;
}

Now, it could still stand a few improvements:

  • More key names, like TAB and ESC.
  • I’m not that thrilled with the name mini_menu.  Suggestions welcome.
  • We now have the option letters in potentially three places: $choices, the keys of %$help, and the keys of %$dispatch.  Double icky.  Still don’t see a good solution though.
  • After staring at the code a bit, I dunno if I like that 0 returns from the dispatch system and anything else stays in.  Originally it was false and true, but that looked even worse: if ( not $dispatch->{$choice}->($choice) ) Maybe it should be reversed ... ?
  • My methodology for when to call &$premenu and when not may be too clever for its own good.  Anything else I could think of involved it calling it more than once place though.  Although perhaps that’s not so bad.
  • Notice we’ve still got a hardcoded string in there: ?.  I personally can’t imagine using anything else for the “help” feature, but someone’s bound to disagree sooner or later.
Still, it’s not too shoddy, and maybe even it could get turned into a little CPAN module for others to use.  Whaddaya think?

BTW, here’s an example of its use in one my MP3 tagging scripts:

    mini_menu("ratsvc \n\$" => "What shall we do with it? ",
        premenu =>   sub {
                            say '';
                            say $album->basename, ':';
                            say '';
                            system qq{ ls -C "$album" };
                            system qq{ check-picard "$album" };
                        },
        help        =>   {
                            r       =>   "reset and reclean",
                            a       =>   "reset artist sort order",
                            t       =>   "reset title sort order",
                            s       =>   "break title into title/subtitle",
                            v       =>   "fix vocals frames",
                            c       =>   "reset comments to v1 values",
                            "\n"    =>   "check again",
                            ' '     =>   "move on",
                            '$'     =>   "go to a command prompt",
                        },
        dispatch    =>   {
                            r       =>   sub { die           qq{ RE-PROCESS "$album"             };   },
                            a       =>   sub { system        qq{ sort-order "$album" A:          }; 1 },
                            t       =>   sub { system        qq{ sort-order "$album" T:          }; 1 },
                            s       =>   sub { name_tweak    qq{ subtitle "$album"               }; 1 },
                            v       =>   sub { system        qq{ comments-from-vocals "$album"   }; 1 },
                            c       =>   sub { system        qq{ comments-from-v1 "$album"       }; 1 },
                            ' '     =>   undef,
                            "\n"    =>   sub { 1 },
                            '$'     =>   sub { system("bash"); 1 },
                        },
    );

In this case the die is just a way to throw control back to the script which called this one.  Everything else is mostly self-explanatory.  (Knowing blogs.perl.org’s tendency to mangle code snippets, I’ve put together the final code and its sample call into a gist.)

I’d love to get any comments and/or thoughts and/or suggestions.


1 You can see it online, right about 47:59.


2 I actually do quite a bit of work on these, although not all of them are as pretty as I’d like.  I’ve been pondering doing another big series on them, since they embody quite a lot of things I love about Perl, from the quick-and-dirty to the opportunity for elegant class design.  But I’ve not gotten organized enough to do it yet.  Maybe one day.


3 This is one of my few complaints about IO::Prompter.  With that, your first option is a and your second option is b and so on.  You can’t change that.


4 Yes, that’s technically different from how the menu works in git.  But I like this way better.


5 And also since I’m already using IO::Prompter for many things in most of my scripts, so I won’t need to add another dependency or another use line.


6 Remember: in this case, the user is me.  I try not to annoy myself any more than absolutely necessary.


7 Possibly that’s a slight bug in IO::Prompter, or possibly it’s a misunderstanding on my part.  Not sure which.


3 Comments

Comments later maybe. Some long lines cut off, copy-paste to read it. Only functional difference: help is not optional.

func mini_menu ($prompt, ArrayRef $choices, CodeRef :$premenu, :$delim = ',')
{
state %keynames = ( ' ' => 'SPACE', "\n" => 'ENTER' );

my $saved_premenu = $premenu;
my $restore_premenu = sub { $premenu = $saved_premenu };
push @$choices, [ '?', 'print help', sub {
say $keynames{$_->[0]} // $_->[0], " - $_->[1]" foreach @$choices;
$premenu = $restore_premenu;
return 0;
} ];

my $opts = join($delim, map { $keynames{$_->[0]} // $_->[0] } @$choices);

my %responses = map {; $_[0], $_[2] // 1 } @$responses;

{
$premenu->() if $premenu;
print "$prompt [$opts] ";
my $choice = prompt -single;
$choice = "\n" if not length($choice); # empty string means the user just hit ENTER
my $reponse = $responses{$choice} or redo;
redo if ref $response and $response->();
}

return $choice;
}

mini_menu("What shall we do with it? ", [
[ r => "reset and reclean", sub { die qq{ RE-PROCESS "$album" }; } ],
[ a => "reset artist sort order", sub { system qq{ sort-order "$album" A: }; 1 } ],
[ t => "reset title sort order", sub { system qq{ sort-order "$album" T: }; 1 } ],
[ s => "break title into title/subtitle", sub { name_tweak qq{ subtitle "$album" }; 1 } ],
[ v => "fix vocals frames", sub { system qq{ comments-from-vocals "$album" }; 1 } ],
[ c => "reset comments to v1 values", sub { system qq{ comments-from-v1 "$album" }; 1 } ],
[ "\n" => "check again" ]
[ ' ' => "move on", sub { 1 } ],
[ '$' => "go to a command prompt", sub { system("bash"); 1 } ],
], premenu => sub {
say '';
say $album->basename, ':';
say '';
system qq{ ls -C "$album" };
system qq{ check-picard "$album" };
});

One tweak though:

Yes I forgot.

definitely cleverer than mine

Too clever, when I look at it again; excuse my moment of fogginess. Obviously it should be

my $saved_premenu = $premenu;
{
    $premenu->() if $premenu;
    $premenu = $saved_premenu;

Then the help callback can just do undef $premenu and the puzzling $restore_premenu closure goes away. That’s exactly the same amount of code as before but the control flow is much more obvious.

(It’s actually close to your original attempt, except it doesn’t solve the problem by artificially assigning two different meanings to an unrelated variable ($choice), and it uses undef for the opposite case as your attempt (for when the menu should not be shown). The only inelegance is that it “restores” $premenu no matter how pointless that is.)

What seems a bit weird is that, if you’re doing a menu that doesn’t require dispatch functions, you end up with an arrayref of arrayrefs to store what is essentially a hash.

Yeah Perl 5 lacks a nice pair notation. I guess you could flatten it to an arrayref where the value of a pair is either a string or an arrayref of string and sub. I.e.:

[
    r    =>  [ "reset and reclean",               sub { die        qq{ RE-PROCESS "$album"             };   } ],
    a    =>  [ "reset artist sort order",         sub { system     qq{ sort-order "$album" A:          }; 1 } ],
    t    =>  [ "reset title sort order",          sub { system     qq{ sort-order "$album" T:          }; 1 } ],
    s    =>  [ "break title into title/subtitle", sub { name_tweak qq{ subtitle "$album"               }; 1 } ],
    v    =>  [ "fix vocals frames",               sub { system     qq{ comments-from-vocals "$album"   }; 1 } ],
    c    =>  [ "reset comments to v1 values",     sub { system     qq{ comments-from-v1 "$album"       }; 1 } ],
    "\n" =>    "check again",
    ' '  =>  [ "move on",                         sub { 1 } ],
    '$'  =>  [ "go to a command prompt",          sub { system("bash"); 1 } ],
]

Then menus without callbacks will be nicer to write. Note that this will make mini_menu more complicated in a few places since now they have to check whether they got a string or an arrayref, whereas in the other version the only check is whether there was a third element in the sub-array or not, which is almost free.

Leave a comment

About Buddy Burden

user-pic 7 years in California, 18 years in Perl, 27 years in computers, 47 years in bare feet.