Skip to content

Commit 11e60e4

Browse files
hoelzrohoelzro
committed
Add vimxs.pl
Many thanks to Vincent Pit for his contribution Related to GH #34
1 parent 8cf7f50 commit 11e60e4

File tree

1 file changed

+336
-0
lines changed

1 file changed

+336
-0
lines changed

‎vimxs.pl

Lines changed: 336 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,336 @@
1+
#!/usr/bin/perl
2+
3+
use strict;
4+
use warnings;
5+
6+
use Fatal qw/open/;
7+
use File::Spec;
8+
9+
our $VERSION = '0.201008171';
10+
11+
my $root = $ARGV[0] || '.';
12+
die 'Wrong directory' unless -e $root and -r _ and -x _;
13+
14+
sub perlfile {
15+
my $path = File::Spec->catfile($root, $_[0]);
16+
return $_[1] ? do { open my $fh, '<', $path; $fh } : $path;
17+
}
18+
19+
my (%macros, %functions, %private, %superseded);
20+
21+
my %skip_functions = map { $_ => 1 } qw{
22+
lop
23+
};
24+
25+
my %types = map { $_ => 1 } qw{
26+
pTHX _pTHX pTHX_
27+
pMY_CXT _pMY_CXT pMY_CXT_
28+
my_cxt_t
29+
OPCODE
30+
};
31+
32+
my %skip_types = map { $_ => 1 } qw{
33+
sv av hv he hek cv gv gp io
34+
op unop binop listop svop pvop pmop padop loop logop
35+
cop block subst context stackinfo
36+
token nexttoken
37+
interpreter expectation
38+
jmpenv
39+
any
40+
};
41+
42+
sub maybe_type {
43+
local $_ = $_[0];
44+
45+
return if $skip_types{$_};
46+
47+
++$types{$_};
48+
}
49+
50+
my %variables = map { $_ => 1 } qw{
51+
aTHX _aTHX aTHX_
52+
aMY_CXT _aMY_CXT aMY_CXT_
53+
MY_CXT
54+
SP TARG MARK ORIGMARK
55+
RETVAL items
56+
};
57+
58+
my %constants = map { $_ => 1 } qw{
59+
SVt_PVBM SVt_RV
60+
};
61+
62+
my %strings = map { $_ => 1 } qw{
63+
IVdf UVuf UVof UVxf NVef NVff NVgf
64+
SVf SVf_ SVf32 SVf256
65+
};
66+
67+
my %exceptions = map { $_ => 1 } qw{
68+
dXCPT XCPT_TRY_START XCPT_TRY_END XCPT_CATCH XCPT_RETHROW
69+
};
70+
71+
my %keywords = map { $_ => 1 } qw{
72+
MODULE PACKAGE PREFIX
73+
IN OUTLIST IN_OUTLIST OUT IN_OUT
74+
ENABLE DISABLE
75+
length
76+
OUTPUT: NO_OUTPUT: CODE: INIT: NO_INIT: PREINIT: SCOPE: INPUT: C_ARGS:
77+
PPCODE: REQUIRE: CLEANUP: POSTCALL: BOOT: VERSIONCHECK:
78+
PROTOTYPES: PROTOTYPE: ALIAS: OVERLOAD: FALLBACK:
79+
INTERFACE: INTERFACE_MACRO: INCLUDE: CASE:
80+
};
81+
82+
my %skip_macro = map { $_ => 1 } qw{
83+
void const register volatile NULL
84+
};
85+
86+
sub maybe_macro {
87+
local $_ = $_[0];
88+
my $value = $_[1];
89+
90+
return if $skip_macro{$_}
91+
or $functions{$_} or $private{$_} or $superseded{$_}
92+
or $types{$_} or $variables{$_} or $constants{$_}
93+
or $strings{$_} or $exceptions{$_} or $keywords{$_};
94+
95+
if (/^(?:SV[sfp]|OPf_|OPp[A-Z]+|OA_|CXt_|G_|PERL_MAGIC_)/) {
96+
++$constants{$_};
97+
return;
98+
} elsif (/^\w+_t$/) {
99+
++$types{$_};
100+
return;
101+
}
102+
103+
++$macros{$_};
104+
}
105+
106+
my %clib = (
107+
map( { 'std' . $_ => 'PerlIO_std' . $_ } qw/in out err/ ),
108+
map( { 'f' . $_ => 'PerlIO_' . $_ } qw/open reopen flush close read write puts eof seek getpos setpos error/ ),
109+
map( { my $p = 'PerlIO_' . $_; $_ => $p, "f$_" => $p } qw/printf getc putc/ ),
110+
map( { $_ => 'PerlIO_' . $_ } qw/ungetc rewind clearerr/ ),
111+
'fgets' => 'sv_gets',
112+
'malloc' => 'Newx',
113+
'calloc' => 'Newxz',
114+
'realloc' => 'Renew',
115+
'memcpy' => 'Copy',
116+
'memmove' => 'Move',
117+
'memset' => 'Zero',
118+
'free' => 'Safefree',
119+
'strdup' => 'savepv',
120+
'strstr' => 'instr',
121+
'strcmp' => 'strEQ',
122+
'strncmp' => 'strnEQ',
123+
'strlen' => 'sv_len',
124+
'strcpy' => 'sv_setpv',
125+
'strncpy' => 'sv_setpvn',
126+
'strcat' => 'sv_catpv',
127+
'strncat' => 'sv_catpvn',
128+
'sprintf' => 'sv_setpvf',
129+
map( { my $u = uc; "is$_" => "is$u" } qw/alnum alpha cntrl digit graph lower print punct space upper xdigit/),
130+
map( { my $u = uc; "to$_" => "to$u" } qw/lower upper/),
131+
map( { $_ => ucfirst } qw/atof atol strtol strtoul/),
132+
'strtod' => 'croak', # Dummy
133+
'rand' => 'Drand01',
134+
'srand' => 'seedDrand01',
135+
'exit' => 'my_exit',
136+
'system' => 'croak', # Dummy
137+
'getenv' => 'PerlEnv_getenv',
138+
'setenv' => 'my_putenv'
139+
);
140+
141+
%superseded = map { $_ => 1 } keys %clib;
142+
143+
{
144+
my $intrpvar = perlfile('intrpvar.h', 1);
145+
while (<$intrpvar>) {
146+
if (/^\s*PERLVARI?\s*\(\s*I?(\w+)/) {
147+
++$variables{"PL_$1"}
148+
}
149+
}
150+
}
151+
152+
{
153+
my $pp_proto = perlfile('pp_proto.h', 1);
154+
while (<$pp_proto>) {
155+
if (/^\s*PERL_(?:CK|PP)DEF\s*\((\w+)\)/) {
156+
next if $skip_functions{$1};
157+
++$functions{$1};
158+
}
159+
}
160+
}
161+
162+
{
163+
my $embed = perlfile('embed.fnc', 1);
164+
while (<$embed>) {
165+
next if /^[\s:#]/;
166+
(my $flags, my $name) = /^(\w+)\s*\|.*?\|\s*([^\|\s]+)/;
167+
next unless $flags and $name;
168+
next if $skip_functions{$name};
169+
if ($flags =~ /A/ and $flags !~ /D/) {
170+
if ($flags =~ /m/) {
171+
++$macros{$name} unless $flags =~ /o/;
172+
} else {
173+
++$functions{$name} unless $flags =~ /o/;
174+
++$functions{"Perl_$name"} if $flags =~ /p/;
175+
}
176+
} else {
177+
if ($flags =~ /m/) {
178+
++$private{$name};
179+
} elsif ($flags =~ /[sED]/) {
180+
++$private{$name} unless $flags =~ /o/;
181+
++$private{"Perl_$name"} if $flags =~ /p/;
182+
++$private{"S_$name"} if $flags =~ /s/;
183+
}
184+
}
185+
}
186+
}
187+
188+
my %skip_header = (
189+
'embed.h' => 1,
190+
'pp_proto.h' => 1,
191+
'intrpvar.h' => 1,
192+
);
193+
194+
for my $header (glob perlfile('*.h')) {
195+
next if $skip_header{ (File::Spec->splitpath($header))[2] };
196+
open my $header_fh, '<', $header;
197+
my ($comment, $enum);
198+
while (<$header_fh>) {
199+
s[/\*.*\*/][];
200+
if (s[/\*.*][]) {
201+
$comment = 1;
202+
# Process the beginning of the line
203+
} elsif ($comment) {
204+
$comment = not s[.*\*/][];
205+
next if $comment;
206+
}
207+
if ($enum || s/^\s*typedef\s*enum\s*\w*\s*\{//) {
208+
$enum = !/\}\s*(\w*)\s*;/;
209+
++$types{$1} if $1;
210+
++$constants{$_} for map { /^\s*(\w+)/ ? $1 : () } split /,/, $_;
211+
next;
212+
}
213+
if (/^\s*\#\s*undef\s*(\w+)/) {
214+
delete $macros{$1};
215+
} elsif (my ($macro, $value) = /^\s*\#\s*define\s*(\w+)\s*(\S*)/) {
216+
maybe_macro($macro, $value);
217+
} elsif ( /^\s*typedef.*?(\w+)\s*;/
218+
or /^\s*(?:struct|enum|union)\s+(\w+)\s+[\{;]/) {
219+
maybe_type($1);
220+
} elsif (/\b(?:extern|EXT(?:|ERN(?:_C)?|CONST))\b.*?\b(PL_\w+)\b/) {
221+
++$variables{$1};
222+
}
223+
}
224+
}
225+
226+
{
227+
my $toke = perlfile('toke.c', 1);
228+
while (<$toke>) {
229+
if (/^\s*#\s*define\s*(PL_\w+)/) {
230+
++$variables{$1};
231+
}
232+
}
233+
}
234+
235+
print STDERR "Found " . (keys %functions) . " functions, "
236+
. (keys %macros) . " macros, "
237+
. (keys %variables) . " variables, "
238+
. (keys %constants) . " constants and "
239+
. (keys %types) . " types\n";
240+
241+
my $len = 78;
242+
243+
sub output {
244+
my ($data, $type, $fh) = @_;
245+
$fh = *STDOUT unless $fh;
246+
my $head = "syn keyword xs$type";
247+
my $line = $head;
248+
for (sort keys %$data) {
249+
if (length() + length($line) + 1 >= $len) {
250+
print $fh "$line\n";
251+
$line = $head;
252+
}
253+
$line .= " $_";
254+
}
255+
print $fh "$line\n" if $line;
256+
}
257+
258+
my $vim = \*STDOUT;
259+
260+
my $date = gmtime() . ' UTC';
261+
262+
print $vim <<_VIM_;
263+
" Vim syntax file
264+
" Language: XS (Perl extension interface language)
265+
" Author: Autogenerated from perl headers, on an original basis of Michael W. Dodge <sarge\@pobox.com>
266+
" Maintainer: Vincent Pit <perl\@profvince.com>
267+
" Last Change: $date
268+
269+
" For version 5.x: Clear all syntax items
270+
" For version 6.x: Quit when a syntax file was already loaded
271+
if version < 600
272+
syntax clear
273+
elseif exists("b:current_syntax")
274+
finish
275+
endif
276+
277+
" Read the C syntax to start with
278+
if version < 600
279+
source <sfile>:p:h/c.vim
280+
else
281+
runtime! syntax/c.vim
282+
endif
283+
284+
let xs_superseded = 1 " mark C functions superseded by Perl replacements
285+
let xs_not_core = 1 " mark private core functions
286+
287+
_VIM_
288+
289+
print $vim "if exists(\"xs_superseded\") && xs_superseded\n";
290+
output \%superseded, 'Superseded' => $vim;
291+
print $vim "endif\n";
292+
293+
print $vim "if exists(\"xs_not_core\") && xs_not_core\n";
294+
output \%private, 'Private' => $vim;
295+
print $vim "endif\n";
296+
297+
output \%types, 'Type' => $vim;
298+
output \%strings, 'String' => $vim;
299+
output \%constants, 'Constant' => $vim;
300+
output \%exceptions, 'Exception' => $vim;
301+
output \%keywords, 'Keyword' => $vim;
302+
output \%functions, 'Function' => $vim;
303+
output \%variables, 'Variable' => $vim;
304+
output \%macros, 'Macro' => $vim;
305+
306+
print $vim <<'_VIM_';
307+
308+
" Define the default highlighting.
309+
" For version 5.7 and earlier: only when not done already
310+
" For version 5.8 and later: only when an item doesn't have highlighting yet
311+
if version >= 508 || !exists("did_xs_syntax_inits")
312+
if version < 508
313+
let did_xs_syntax_inits = 1
314+
command -nargs=+ HiLink hi link <args>
315+
else
316+
command -nargs=+ HiLink hi def link <args>
317+
endif
318+
319+
HiLink xsPrivate Error
320+
HiLink xsSuperseded Error
321+
HiLink xsType Type
322+
HiLink xsString String
323+
HiLink xsConstant Constant
324+
HiLink xsException Exception
325+
HiLink xsKeyword Keyword
326+
HiLink xsFunction Function
327+
HiLink xsVariable Identifier
328+
HiLink xsMacro Macro
329+
330+
delcommand HiLink
331+
endif
332+
333+
let b:current_syntax = "xs"
334+
335+
" vim: ts=8
336+
_VIM_

0 commit comments

Comments
 (0)