File Coverage

blib/lib/Regexp/Common/Emacs.pm

Criterion	Covered	Total	%
statement	20	20	100.0
branch	1	2	50.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	27	28	96.4

# Copyright 2012, 2013, 2014, 2015 Kevin Ryde

# This file is part of Regexp-Common-Other.
#
# Regexp-Common-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Regexp-Common-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Regexp-Common-Other.  If not, see .


package Regexp::Common::Emacs;
use 5.005;
use strict;
use Carp;

# no import(), don't want %RE or builtins, and will call pattern() by full name
use Regexp::Common ();

use vars '$VERSION';
$VERSION = 14;

## no critic (RequireInterpolationOfMetachars)

# uncomment this to run the ### lines
# use Smart::Comments;


# "[:digit:]" in perl 5.6 where available
# "0-9"       in perl 5.005 and earlier
use constant DIGIT => do {
  local $^W = 0;
  eval q{'0' =~ /[[:digit:]]/ ? '[:digit:]' : '0-9'}
    || die "Oops, eval for [:digit:] error: ",$@;
};
### DIGIT: DIGIT()


# Ending with "~", per Emacs manual info "(emacs)Backup Names" and function
# backup-file-name-p
# Eg. "foo.c~" or "foo.c.~123~"
#
Regexp::Common::pattern
  (name   => ['Emacs','backup'],
   create => sub {
     my ($self, $flags) = @_;
     ### $flags

     if (exists $flags->{'-single'}) {
       # presumed from single only
       # $1=whole
       # $2=basename
       if (exists $flags->{'-keep'}) {
         return '(?k:(?k:.+)~$)';
       } else {
         return '.~$';
       }
     }

     if (exists $flags->{'-numbered'}) {
       if (! exists $flags->{'-notnumbered'}) {
         # numbered only
         # $1=whole
         # $2=basename
         # $3=number
         if (exists $flags->{'-keep'}) {
           return '(?k:(?k:.+)\.~(?k:\d+)~$)';
         } else {
           return '.\.~\d+~$';
         }
       }
     } else {
       if (exists $flags->{'-notnumbered'}) {
         # not numbered only
         # $1=whole
         # $2=basename
         #
         # .* \D~         z~       non-digit
         # .* [^~]\d+~    z123~    non-~
         # .* [^.]~\d+~   z~123~   non-.
         # ^  \.~\d+~     .~123~   basename empty
         #
         return '(?k:(?k:.*(?:\D|(?:[^~'.DIGIT().']|(?:[^.]|^\.)~)\d+))~$)';
       }
     }

     # numbered or not numbered
     if (exists $flags->{'-keep'}) {
       # $1=whole
       # $2=basename
       # $3=number or undef
       return '(?k:(?k:.+?)(?:\.~(?k:\d+))?~$)';
     } else {
       return '.~$';
     }

   });

# begin and end with "#", per Emacs function auto-save-file-name-p
Regexp::Common::pattern
  (name   => ['Emacs','autosave'],
   create => '^(?k:#(?k:.+)#$)');

# file-locked-p and C source MAKE_LOCK_NAME()
Regexp::Common::pattern
  (name   => ['Emacs','lockfile'],
   create => sub {
     my ($self, $flags) = @_;
     if (exists $flags->{'-keep'}) {
       return '^(?k:\.\#(?k:.+))$';
     } else {
       return '^\.\#.';
     }
   });

# any of backup,autosave,lockfile
#      (.+) ~$    backup
# ^#   (.+) #$    autosave
# ^\.# (.+)     lockfile
Regexp::Common::pattern
  (name   => ['Emacs','skipfile'],
   create => sub {
     my ($self, $flags) = @_;
     if (exists $flags->{'-keep'}) {
       return '^(?k:\.\#.+|\#.+\#|.+~)$';
     } else {
       return '^(?:\.\#.|\#.+\#$)|.~$';
     }
   });

1;
__END__