Community

Code: Select all

#! /usr/local/bin/perl

##########################################################################################
#
# align.clip.pl
#
# TextPad macro.
# Aligns selected text at specified symbols.
# The symbols can be specified literally or as matches to regular expressions.
# The alignment can be squeezed to any given minimum.
# The clipboard is used, but is left as it was.
#
# Options
#   -r      Symbols are represented as regular expressions
#   -r-     Symbols are represented literally (default)
#   -sN     White space preceding a symbol should be squeezed to a minimum of N spaces
#   -s      = -s1 (default)
#   -s-     White space preceding a symbol should not be squeezed
#   -z      Reselect the selection (default)
#   -z-     Don't reselect the selection
#
# Parameters
#   sym...  the symbols to align
#
# Examples
#
#   Default; minimum number of spaces before an aligned symbol is squeezed to 1:
#     align.clip.pl
#       $a=42;
#       $abcd=567;
#       $abc=56789;
#     ->
#       $a    =42    ;
#       $abcd =567   ;
#       $abc  =56789 ;
#
#   Minimum number of spaces before an aligned symbol is squeezed to 0:
#     align.clip.pl -s0
#       $a =42 ;
#       $abcd =567 ;
#       $abc =56789 ;
#     ->
#       $a   =42   ;
#       $abcd=567  ;
#       $abc =56789;
#
#   Spaces before aligned symbols are not squeezed; each symbol is aligned to its
#   existing rightmost position (relative to the position of any preceding symbol):
#     align.clip.pl -s-
#       $a   =42;
#       $abcd  =567;
#       $abc =56789;
#     ->
#       $a     =42   ;
#       $abcd  =567  ;
#       $abc   =56789;
#
#   Regular expressions
#     align.clip.pl [!=] [ms]?/ ;
#       $a=~/42/;
#       $ab=~m/56/;
#       $abcd!~s/42/;
#     ->
#       $a    =~ /42/  ;
#       $ab   =~ m/56/ ;
#       $abcd !~ s/42/ ;
#
##########################################################################################


use warnings ;
use strict   ;

use Win32::Clipboard               ;
use Win32::GuiTest qw ( SendKeys ) ;
use Win32::GUI                     ;


##########################################################################################
#
# Forward declaration
#
sub diddle ( $$$$ ) ;


##########################################################################################
#
# main
#
{
  ######################################################################################
  #
  # Handle options
  #
  my $regOpt = 'r' ;
  my $sqzOpt = 's' ;
  my $resOpt = 'z' ;

  my %opts ;

  while ( @ARGV > 0 && ( substr $ARGV[ 0 ], 0, 1 ) eq '-' && length $ARGV[ 0 ] > 1 )
  { $opts{ substr $ARGV[ 0 ], 1, 1 } = substr $ARGV[ 0 ], 2 ;
    shift ;
  }

  my $isRegex = defined $opts{ $regOpt } && $opts{ $regOpt } ne '-' ;
  my $sqzWid  = $opts{ $sqzOpt } ;
  $sqzWid =   ! defined $sqzWid || $sqzWid eq '-' ? undef
            : $sqzWid !~ /^[0-9]+$/               ? 1
            :                                       $sqzWid ;
  my $resel   = ! defined $opts{ $resOpt } || $opts{ $resOpt } eq '' ;


  ######################################################################################
  #
  # Handle arguments
  #
  my $rSyms = @ARGV ? \@ARGV : [ '=', ';' ]  ; # get args (default: ('=', ';'))


  ######################################################################################
  #
  # Do it
  #
  my $clip   = Win32::Clipboard                ; # fetch the clipboard

  # Save current contents of clipboard
  #
  my $oldSel = $clip->GetText || ''            ; # fetch current clipboard text

  # Fetch the selected text, align it, copy it over selection (via clipboard both ways)
  #
  SendKeys "^c"                                ; # copy selection to clipboard
  my $text   = $clip->GetText || ''            ; # fetch clipboard text
  my $isBlck = $clip->GetAs ( 49908 )          ; # fetch block mode indicator

  if ( ! $isBlck )
  {
    my ( $nLines, $tixt ) =
      diddle $rSyms, \$text, $isRegex, $sqzWid ; # diddle the text
    $clip->Set ( $tixt )                       ; # set clipboard to diddled text
    SendKeys "^v"                              ; # paste it over the selection
    ( $resel ) and
      SendKeys "+{Up $nLines}", 0              ; # reselect the selection
  }
  else
  {
    Win32::GUI::MessageBox 0, "The editor is in block select mode.\n" .
                              "This action would bugger the text,\n"  .
                              "so I won't perform it"
                            , "align.clip.regex", MB_OK ;
  }

  # Restore contents of clipboard
  #
  $clip->Set ( $oldSel )                       ; # restore clipboard text
}


##########################################################################################
#
# diddle
#
# Params
#   $rSyms    ref to array of symbols to align
#   $rText    ref to text to be diddled
#   $isRegex  symbols are regexes; o.w. they're literal
#   $sqzWid   alignment is adjusted so min num spaces before a symbol is $sqzWid
# Result
#   @         ( num_lines, diddled_text )
#
# Takes the text referred to by $rText and adds spaces to align occurrences of the
# symbols in the list referred to by $rSyms.
# If $isRegex, the symbols are regex matches; o.w. they're literal.
# If $sqzWid is defined, min num spaces before an aligned symbol is squeezed to $sqzWid.
#
sub diddle ( $$$$ )
{
  my ( $rSyms, $rText, $isRegex, $sqzWid ) = @_ ;

  my @text   = split /\n/, $$rText ;                  # the text as an array of lines
  my $nLines = @text               ;                  # num lines of text
  my $rePre  = ''                  ;                  # anchor all searches to beginning

  for my $sym ( @$rSyms )                             # for each symbol in turn
  {
    if ( ! $isRegex )
    { $sym =  "\Q$sym\E"                              # quote regex special characters
    }
    else
    { $sym =~ s/(^|[^\\])[(]([^?]|$)/$1(?:$2/g ;      # make all parentheses non-capturing
      $sym =~ s/(^|[^\\])[\$]/$1\\r?\$/g       ;      # make all anchor '$'s accept
    }                                                 #   preceding "\r"s

    my $pos   = 0 ;                                   # aligned position of current symbol
    my @pairs ;                                       # a (lhs, rhs) pair for each line

    my $re = qr/^((?:$rePre)?.*?[^ ]?)( *)($sym.*)/ ; # regex for next split

    for my $line ( @text )                            # run over the entire text
    {
      # Split the current line at the current symbol.

      my ( $lhs, $pad, $rhs ) = $line =~ $re ;        # split the line before the symbol

      defined $lhs or $lhs ||= $line ;                # in case the symbol
      defined $pad or $pad ||= ''    ;                #   or while space
      defined $rhs or $rhs ||= ''    ;                #   wasn't found

      ( defined $sqzWid && $rhs ) and
        $pad = ' ' x $sqzWid ;

      $lhs .= $pad ;

      my $len = length $lhs ;

      ( $rhs ) and                                    # adjust position of symbol
        $pos = $len > $pos ? $len : $pos ;            #   as necessary

      push @pairs, [ $lhs, $rhs ] ;
    }

    # Now we know the required alignment position of the current symbol.
    # Overwrite the array of lines with lines in which the symbol is aligned.

    @text = () ;

    for my $rPair ( @pairs )
    {
      my ( $lhs, $rhs ) = @$rPair ;
                                                      # stick the line back together
      push @text, $rhs ? sprintf "%-${pos}s%s", $lhs, $rhs : $lhs ;
    }

    $rePre = "(?:$rePre)?.*?$sym" ;                   # parentheses must be non-capturing;
                                                      # previous symbols are optional
  }

  ( $nLines, join "\n", @text ) ;
}