Browse files

[inseparable changes from patch from perl5.003_07 to perl5.003_08]

 CORE LANGUAGE CHANGES

Subject: Bitwise op sign rationalization
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h pp_hot.c proto.h sv.c t/op/bop.t

    Make bitwise ops result in unsigned values, unless C<use
    integer> is in effect.  Includes initial support for UVs.

Subject: Defined scoping for C<my> in control structures
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c

    Finally defines semantics of "my" in control expressions,
    like the condition of "if" and "while".  In all cases, scope
    of a "my" var extends to the end of the entire control
    structure.  Also adds new construct "for my", which
    automatically declares the control variable "my" and limits
    its scope to the loop.

Subject: Fix ++/-- after int conversion (e.g. 'printf "%d"')
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c pp_hot.c sv.c

    This patch makes Perl correctly ignore SvIVX() if either
    NOK or POK is true, since SvIVX() may be a truncated or
    overflowed version of the real value.

Subject: Make code match Camel II re: functions that use $_
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: opcode.pl

Subject: Provide scalar context on left side of "->"
From: Chip Salzenberg <chip@atlantic.net>
Files: perly.c perly.y

Subject: Quote bearword package/handle FOO in "funcname FOO => 'bar'"
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

 OTHER CORE CHANGES

Subject: Warn on overflow of octal and hex integers
From: Chip Salzenberg <chip@atlantic.net>
Files: proto.h toke.c util.c

Subject: If -w active, warn for commas and hashes ('#') in qw()
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

Subject: Fixes for pack('w')
From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
Files: pp.c t/op/pack.t

Subject: More complete output from sv_dump()
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: sv.c

Subject: Major '..' and debugger patches
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h

Subject: Fix for formline()
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c t/op/write.t

Subject: Fix stack botch in untie and binmode
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp_sys.c

Subject: Complete EMBED, including symbols from interp.sym
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c perl.h pp_sys.c proto.h regexec.c toke.c util.c x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h

    New define EMBEDMYMALLOC makes embedding total by
    avoiding "Mymalloc" etc.

Subject: Support old embedding for people who want it
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST Makefile.SH old_embed.pl old_global.sym

 PORTABILITY

Subject: Miscellaneous VMS fixes
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl perl.h perl_exp.SH proto.h t/TEST t/io/read.t t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs vms/perlvms.pod vms/test.com vms/vms.c

Subject: DJGPP patches (MS-DOS)
From: "Douglas E. Wegscheid" <wegscd@whirlpool.com>
Files: doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c perl.h pp_sys.c proto.h sv.c util.c

Subject: Patch to make Perl work under AmigaOS
From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c
  • Loading branch information...
1 parent c822f08 commit 55497cffdd24c959994f9a8ddd56db8ce85e1c5b Perl 5 Porters committed with Chip Salzenberg Nov 19, 1996
Showing with 7,247 additions and 2,977 deletions.
  1. +151 −0 Changes
  2. +3 −1 MANIFEST
  3. +4 −3 Makefile.SH
  4. +89 −8 README.os2
  5. +18 −0 config_H
  6. +9 −3 configure
  7. +6 −4 doio.c
  8. +29 −1 dosish.h
  9. +905 −231 emacs/cperl-mode.el
  10. +199 −31 embed.h
  11. +11 −13 embed.pl
  12. +1 −1 ext/DynaLoader/dlutils.c
  13. +1 −1 ext/IO/lib/IO/File.pm
  14. +1 −1 ext/IO/lib/IO/Handle.pm
  15. +1 −1 ext/SDBM_File/sdbm/sdbm.c
  16. +25 −13 ext/SDBM_File/sdbm/sdbm.h
  17. +46 −23 global.sym
  18. +8 −25 handy.h
  19. +43 −0 hints/amigaos.sh
  20. +28 −2 hints/freebsd.sh
  21. +13 −16 hints/machten.sh
  22. +1 −1 installman
  23. +17 −14 installperl
  24. +0 −4 lib/AutoLoader.pm
  25. +1 −0 lib/AutoSplit.pm
  26. +21 −2 lib/Carp.pm
  27. +17 −4 lib/Cwd.pm
  28. +183 −4 lib/ExtUtils/Liblist.pm
  29. +9 −3 lib/ExtUtils/MM_Unix.pm
  30. +40 −68 lib/ExtUtils/MM_VMS.pm
  31. +1 −1 lib/ExtUtils/typemap
  32. +4 −2 lib/ExtUtils/xsubpp
  33. +12 −6 lib/File/Basename.pm
  34. +14 −8 lib/File/Copy.pm
  35. +2 −1 lib/File/Find.pm
  36. +3 −1 lib/FindBin.pm
  37. +1 −1 lib/Getopt/Long.pm
  38. +2 −2 lib/Math/BigInt.pm
  39. +17 −1 lib/Math/Complex.pm
  40. +7 −7 lib/Pod/Text.pm
  41. +3 −2 lib/Sys/Syslog.pm
  42. +2 −5 lib/Term/Cap.pm
  43. +2 −0 lib/Term/Complete.pm
  44. +1 −1 lib/Text/ParseWords.pm
  45. +1 −1 lib/Text/Soundex.pm
  46. +5 −5 lib/Time/Local.pm
  47. +1 −1 lib/abbrev.pl
  48. +2 −2 lib/bigint.pl
  49. +1 −1 lib/complete.pl
  50. +19 −2 lib/diagnostics.pm
  51. +3 −3 lib/getcwd.pl
  52. +4 −5 lib/getopts.pl
  53. +3 −3 lib/look.pl
  54. +423 −104 lib/perl5db.pl
  55. +13 −5 lib/sigtrap.pm
  56. +4 −24 lib/strict.pm
  57. +6 −1 lib/subs.pm
  58. +1 −1 lib/syslog.pl
  59. +3 −0 lib/termcap.pl
  60. +9 −100 lib/timelocal.pl
  61. +5 −0 lib/vars.pm
  62. +124 −22 malloc.c
  63. +10 −0 mg.c
  64. +104 −0 old_embed.pl
  65. +1,082 −0 old_global.sym
  66. +37 −11 op.c
  67. +14 −13 opcode.h
  68. +11 −11 opcode.pl
  69. +8 −0 os2/Changes
  70. +2 −0 os2/Makefile.SHs
  71. +43 −4 os2/os2.c
  72. +5 −0 os2/os2ish.h
  73. +1 −1 patchlevel.h
  74. +5 −5 perl.c
  75. +49 −27 perl.h
  76. +1 −1 perl_exp.SH
  77. +1,365 −1,356 perly.c
  78. +75 −56 perly.c.diff
  79. +25 −23 perly.h
  80. +97 −37 perly.y
  81. +1 −1 pod/buildtoc
  82. +26 −42 pod/perldata.pod
  83. +43 −12 pod/perldiag.pod
  84. +3 −3 pod/perlembed.pod
  85. +34 −4 pod/perlfunc.pod
  86. +202 −31 pod/perlguts.pod
  87. +236 −26 pod/perlmod.pod
  88. +14 −13 pod/perlobj.pod
  89. +17 −7 pod/perlop.pod
  90. +30 −10 pod/perlre.pod
  91. +24 −6 pod/perlref.pod
  92. +5 −4 pod/perlrun.pod
  93. +58 −41 pod/perlsub.pod
  94. +22 −17 pod/perlsyn.pod
  95. +44 −10 pod/perltoc.pod
  96. +32 −2 pod/perltrap.pod
  97. +6 −3 pod/pod2man.PL
  98. +215 −77 pp.c
  99. +9 −0 pp.h
  100. +45 −12 pp_ctl.c
  101. +5 −8 pp_hot.c
  102. +21 −23 pp_sys.c
  103. +23 −29 proto.h
  104. +4 −4 regexec.c
  105. +20 −0 scope.c
  106. +26 −12 scope.h
  107. +58 −19 sv.c
  108. +2 −0 sv.h
  109. +1 −1 t/README
  110. +5 −1 t/TEST
  111. +4 −0 t/io/read.t
  112. +28 −15 t/lib/db-btree.t
  113. +8 −10 t/lib/db-recno.t
  114. +1 −1 t/lib/findbin.t
  115. +3 −1 t/lib/getopt.t
  116. +4 −1 t/lib/searchdict.t
  117. +28 −8 t/op/bop.t
  118. +10 −9 t/op/pack.t
  119. +24 −13 t/op/tie.t
  120. +33 −1 t/op/write.t
  121. +119 −66 toke.c
  122. +36 −19 universal.c
  123. +40 −31 util.c
  124. +10 −0 utils/h2xs.PL
  125. +7 −7 utils/perldoc.PL
  126. +1 −1 utils/pl2pm.PL
  127. +1 −1 vms/Makefile
  128. +2 −2 vms/config.vms
  129. +34 −2 vms/descrip.mms
  130. +4 −2 vms/ext/Stdio/Stdio.pm
  131. +3 −3 vms/ext/Stdio/Stdio.xs
  132. +2 −2 vms/genconfig.pl
  133. +17 −0 vms/perlvms.pod
  134. +2 −0 vms/test.com
  135. +5 −5 vms/vms.c
  136. +3 −2 x2p/Makefile.SH
  137. +14 −3 x2p/a2p.h
  138. +1 −1 x2p/a2p.pod
  139. +1 −1 x2p/s2p.PL
  140. +45 −9 x2p/util.c
  141. +14 −2 x2p/util.h
View
151 Changes
@@ -8,6 +8,157 @@ or in the .../src/5/0/unsupported directory for sub-version
releases.)
----------------
+Version 5.003_08
+----------------
+
+This patch was a compendium of various fixes and enhancements from
+many people. Here are some of the more significant changes.
+
+
+ CORE LANGUAGE CHANGES
+
+ Title: "Make C<no FOO> fail if C<unimport FOO> fails"
+ From: Tim Bunce <Tim.Bunce@ig.co.uk>
+ Files: gv.c
+
+ Title: "Bitwise op sign rationalization"
+ (Make bitwise ops result in unsigned values, unless C<use
+ integer> is in effect. Includes initial support for UVs.)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h
+ pp_hot.c proto.h sv.c t/op/bop.t
+
+ Title: "Defined scoping for C<my> in control structures"
+ (Finally defines semantics of "my" in control expressions,
+ like the condition of "if" and "while". In all cases, scope
+ of a "my" var extends to the end of the entire control
+ structure. Also adds new construct "for my", which
+ automatically declares the control variable "my" and limits
+ its scope to the loop.)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c
+
+ Title: "Fix ++/-- after int conversion (e.g. 'printf "%d"')"
+ (This patch makes Perl correctly ignore SvIVX() if either
+ NOK or POK is true, since SvIVX() may be a truncated or
+ overflowed version of the real value.)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: pp.c pp_hot.c sv.c
+
+ Title: "Make code match Camel II re: functions that use $_"
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Files: opcode.pl
+
+ Title: "Provide scalar context on left side of "->""
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: perly.c perly.y
+
+ Title: "Quote bearword package/handle FOO in "funcname FOO => 'bar'""
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: toke.c
+
+
+ OTHER CORE CHANGES
+
+ Title: "Warn on overflow of octal and hex integers"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: proto.h toke.c util.c
+
+ Title: "If -w active, warn for commas and hashes ('#') in qw()"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: toke.c
+
+ Title: "Fixes for pack('w')"
+ From: Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
+ Files: pp.c t/op/pack.t
+
+ Title: "More complete output from sv_dump()"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Files: sv.c
+
+ Title: "Major '..' and debugger patches"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Files: lib/perl5db.pl op.c pp_ctl.c scope.c scope.h
+
+ Title: "Fix for formline()"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Files: global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c
+ t/op/write.t
+
+ Title: "Fix stack botch in untie and binmode"
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Files: pp_sys.c
+
+ Title: "Complete EMBED, including symbols from interp.sym"
+ (New define EMBEDMYMALLOC makes embedding total by
+ avoiding "Mymalloc" etc.)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: MANIFEST embed.pl ext/DynaLoader/dlutils.c
+ ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c
+ perl.h pp_sys.c proto.h regexec.c toke.c util.c
+ x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h
+
+ Title: "Support old embedding for people who want it"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: MANIFEST Makefile.SH old_embed.pl old_global.sym
+
+
+ PORTABILITY
+
+ Title: "Miscellaneous VMS fixes"
+ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+ Files: lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm
+ lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl
+ perl.h perl_exp.SH proto.h t/TEST t/io/read.t
+ t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL
+ vms/Makefile vms/config.vms vms/descrip.mms
+ vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs
+ vms/perlvms.pod vms/test.com vms/vms.c
+
+ Title: "DJGPP patches (MS-DOS)"
+ From: "Douglas E. Wegscheid" <wegscd@whirlpool.com>
+ Files: doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h
+ lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c
+ perl.h pp_sys.c proto.h sv.c util.c
+
+ Title: "Plan 9 update"
+ From: Luther Huffman <lutherh@infinet.com>
+ Files: plan9/buildinfo plan9/config.plan9 plan9/exclude
+ plan9/genconfig.pl plan9/mkfile plan9/setup.rc
+
+ Title: "Patch to make Perl work under AmigaOS"
+ From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
+ Files: MANIFEST hints/amigaos.sh installman lib/File/Basename.pm
+ lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c
+
+ LIBRARY AND EXTENSIONS
+
+ Title: "DB_File 1.05"
+ From: Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-hash.t
+
+ Title: "Getopts::Std patch for hash support"
+ From: Stephen Zander <stephen.zander@interlock.mckesson.com>
+ Files: lib/Getopt/Std.pm
+
+ Title: "Kludge for bareword handles"
+ (Add 'require IO::Handle' at beginning of FileHandle.pm)
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: ext/FileHandle/FileHandle.pm
+
+ Title: "Re: strtod / strtol patch for POSIX module"
+ From: hammen@gothamcity.jsc.nasa.gov (David Hammen)
+ Files: Configure config_h.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
+ ext/POSIX/POSIX.xs t/lib/posix.t
+
+ BUNDLED UTILITIES
+
+ Title: "Fix a2p translation of '{print "a" "b" "c"}'"
+ From: Chip Salzenberg <chip@atlantic.net>
+ Files: x2p/a2p.c x2p/a2p.y
+
+
+----------------
Version 5.003_07
----------------
View
4 MANIFEST
@@ -202,6 +202,7 @@ hints/README.NeXT Notes about NeXT hints.
hints/README.hints Notes about hints.
hints/aix.sh Hints for named architecture
hints/altos486.sh Hints for named architecture
+hints/amigaos.sh Hints for named architecture
hints/apollo.sh Hints for named architecture
hints/aux.sh Hints for named architecture
hints/bsdos.sh Hints for named architecture
@@ -386,6 +387,8 @@ miniperlmain.c Basic perl w/o dynamic loading or extensions
mv-if-diff Script to mv a file if it changed
myconfig Prints summary of the current configuration
nostdio.h Cause compile error on stdio calls
+old_embed.pl Produces embed.h using old_global.sym
+old_global.sym Old list of symbols to hide when embedded
op.c Opcode syntax tree code
op.h Opcode syntax tree header
opcode.h Automatically generated opcode header
@@ -708,7 +711,6 @@ x2p/a2p.y A yacc grammer for awk
x2p/a2py.c Awk compiler, sort of
x2p/cflags.SH A script that emits C compilation flags per file
x2p/find2perl.PL A find to perl translator
-x2p/handy.h Handy definitions
x2p/hash.c Associative arrays again
x2p/hash.h Public declarations for the above
x2p/s2p.PL Sed to perl translator
View
7 Makefile.SH
@@ -342,9 +342,10 @@ run_byacc: FORCE
@ echo 'Expect' 130 shift/reduce and 1 reduce/reduce conflict
$(BYACC) -d perly.y
sh $(shellflags) ./perly.fixer y.tab.c perly.c
- sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' perly.c >perly.tmp && mv perly.tmp perly.c
- mv y.tab.h perly.h
- echo 'extern YYSTYPE yylval;' >>perly.h
+ sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
+ -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c
+ echo 'extern YYSTYPE yylval;' >>y.tab.h
+ cmp -s y.tab.h perly.h && rm -f y.tab.h || mv y.tab.h perly.h
- perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
# We don't want to regenerate perly.c and perly.h, but they might
View
97 README.os2
@@ -144,9 +144,12 @@ Cf. L<Prerequisites>.
=item B<EMX>
-B<EMX> runtime is required. Note that it is possible to make F<perl_.exe>
-to run under DOS without any external support by binding F<emx.exe> to
-it, see L<emxbind>.
+B<EMX> runtime is required (may be substituted by B<RSX>). Note that
+it is possible to make F<perl_.exe> to run under DOS without any
+external support by binding F<emx.exe> to it, see L<emxbind>. Note
+that under DOS for best results one should use B<RSX> runtime, which
+has much more functions working (like C<fork>, C<popen> and so on). In
+fact B<RSX> is required if there is no C<VCPI> present.
Only the latest runtime is supported, currently C<0.9c>.
@@ -161,7 +164,13 @@ The runtime component should have the name F<emxrt.zip>.
To run Perl on C<DPMS> platforms one needs B<RSX> runtime. This is
needed under DOS-inside-OS/2, Win0.31, Win0.95 and WinNT (see
-L<"Other OSes">).
+L<"Other OSes">). I do not know whether B<RSX> would work with C<VCPI>
+only, as B<EMX> would.
+
+Having B<RSX> and the latest F<sh.exe> one gets a fully functional
+B<*nix>-ish environment under DOS, say, C<fork>, C<``> and
+pipe-C<open> work. In fact, MakeMaker works (for static build), so one
+can have Perl development environment under DOS.
One can get B<RSX> from, say
@@ -170,6 +179,10 @@ One can get B<RSX> from, say
Contact the author on C<rainer@mathematik.uni-bielefeld.de>.
+The latest F<sh.exe> with DOS hooks is available at
+
+ ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2/sh_dos.exe
+
=item B<HPFS>
Perl does not care about file systems, but to install the whole perl
@@ -254,9 +267,22 @@ meta-characters.
=head2 I cannot run extenal programs
+=over 4
+
+=item
+
Did you run your programs with C<-w> switch? See
L<Starting OS/2 programs under Perl>.
+=item
+
+Do you try to run I<internal> shell commands, like C<`copy a b`>
+(internal for F<cmd.exe>), or C<`glob a*b`> (internal for ksh)? You
+need to specify your shell explicitely, like C<`cmd /c copy a b`>,
+since Perl cannot deduce which commands are internal to your shell.
+
+=back
+
=head2 I cannot embed perl into my program, or use F<perl.dll> from my
program.
@@ -273,6 +299,16 @@ I had reports it does not work. Somebody would need to fix it.
=back
+=head2 C<``> and pipe-C<open> do not work under DOS.
+
+This may a variant of just L<"I cannot run extenal programs">, or a
+deeper problem. Basically: you I<need> B<RSX> (see L<"Prerequisites">)
+for these commands to work, and you need a port of F<sh.exe> which
+understands command arguments. One of such ports is listed in
+L<"Prerequisites"> under B<RSX>.
+
+I do not know whether C<DPMI> is required.
+
=head1 INSTALLATION
=head2 Automatic binary installation
@@ -674,7 +710,7 @@ Now run
make test
-Some tests (4..6) should fail. Some perl invocations should end in a
+Some tests (5..7) should fail. Some perl invocations should end in a
segfault (system error C<SYS3175>). To get finer error reports,
cd t
@@ -692,7 +728,8 @@ The report you get may look like
Note that using `make test' target two more tests may fail: C<op/exec:1>
because of (mis)feature of C<pdksh>, and C<lib/posix:15>, which checks
-that the buffers are not flushed on C<_exit>.
+that the buffers are not flushed on C<_exit> (this is a bug in the test
+which assumes that tty output is buffered).
The reasons for failed tests are:
@@ -961,8 +998,22 @@ eventually).
=item
-Since <lockf> is present in B<EMX>, but is not functional, the same is
-true for perl.
+Since <flock> is present in B<EMX>, but is not functional, the same is
+true for perl. Here is the list of things which may be "broken" on
+EMX (from EMX docs):
+
+ - The functions recvmsg(), sendmsg(), and socketpair() are not
+ implemented.
+ - sock_init() is not required and not implemented.
+ - flock() is not yet implemented (dummy function).
+ - kill:
+ Special treatment of PID=0, PID=1 and PID=-1 is not implemented.
+ - waitpid:
+ WUNTRACED
+ Not implemented.
+ waitpid() is not implemented for negative values of PID.
+
+Note that C<kill -9> does not work with the current version of EMX.
=item
@@ -974,6 +1025,36 @@ the current C<pdksh>.
=back
+=head2 Modifications
+
+Perl modifies some standard C library calls in the following ways:
+
+=over 9
+
+=item C<popen>
+
+C<my_popen> always uses F<sh.exe>, cf. L<"PERL_SH_DIR">.
+
+=item C<tmpnam>
+
+is created using C<TMP> or C<TEMP> environment variable, via
+C<tempnam>.
+
+=item C<tmpfile>
+
+If the current directory is not writable, it is created using modified
+C<tmpnam>, so there may be a race condition.
+
+=item C<ctermid>
+
+a dummy implementation.
+
+=item C<stat>
+
+C<os2_stat> special-cases F</dev/tty> and F</dev/con>.
+
+=back
+
=head1 Perl flavors
Because of ideosyncrasies of OS/2 one cannot have all the eggs in the
View
18 config_H
@@ -786,6 +786,24 @@
#define HAS_SYS_ERRLIST /**/
#define Strerror(e) strerror(e)
+/* HAS_STRTOD:
+ * This symbol, if defined, indicates that the strtod routine is
+ * available to translate strings to doubles.
+ */
+#define HAS_STRTOD /**/
+
+/* HAS_STRTOL:
+ * This symbol, if defined, indicates that the strtol routine is
+ * available to translate strings to integers.
+ */
+#define HAS_STRTOL /**/
+
+/* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to translate strings to integers.
+ */
+#define HAS_STRTOUL /**/
+
/* HAS_STRXFRM:
* This symbol, if defined, indicates that the strxfrm() routine is
* available to transform strings.
View
12 configure
@@ -21,12 +21,18 @@
#
(exit $?0) || exec sh $0 $argv:q
-if test $0 -ef `echo $0 | sed -e s/configure/Configure/`; then
- echo "You're configure and Configure scripts seem to be identical."
+
+case "$0" in
+*configure)
+ if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
+ echo "Your configure and Configure scripts seem to be identical."
echo "This can happen on filesystems that aren't fully case sensitive."
echo "You'll have to explicitely extract Configure and run that."
exit 1
-fi
+ fi
+ ;;
+esac
+
opts=''
verbose=''
create='-e'
View
10 doio.c
@@ -418,7 +418,7 @@ register GV *gv;
(void)unlink(SvPVX(sv));
(void)rename(oldname,SvPVX(sv));
do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
-#endif /* MSDOS */
+#endif /* DOSISH */
#else
(void)UNLINK(SvPVX(sv));
if (link(oldname,SvPVX(sv)) < 0) {
@@ -1057,7 +1057,7 @@ char *cmd;
return FALSE;
}
-#endif
+#endif /* OS2 */
I32
apply(type,mark,sp)
@@ -1108,6 +1108,8 @@ register SV **sp;
#ifdef HAS_KILL
case OP_KILL:
TAINT_PROPER("kill");
+ if (mark == sp)
+ break;
s = SvPVx(*++mark, na);
tot = sp - mark;
if (isUPPER(*s)) {
@@ -1258,7 +1260,7 @@ register struct stat *statbufp;
*/
return (bit & statbufp->st_mode) ? TRUE : FALSE;
-#else /* ! MSDOS */
+#else /* ! DOSISH */
if ((effective ? euid : uid) == 0) { /* root is special */
if (bit == S_IXUSR) {
if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
@@ -1279,7 +1281,7 @@ register struct stat *statbufp;
else if (statbufp->st_mode & bit >> 6)
return TRUE; /* ok as "other" */
return FALSE;
-#endif /* ! MSDOS */
+#endif /* ! DOSISH */
}
#endif /* ! VMS */
View
30 dosish.h
@@ -1,11 +1,39 @@
#define ABORT() abort();
-#define BIT_BUCKET "\dev\nul"
+#define SH_PATH "/bin/sh"
+
+#ifdef DJGPP
+#define BIT_BUCKET "nul"
+#define OP_BINARY O_BINARY
+void Perl_DJGPP_init();
+#define PERL_SYS_INIT(argcp, argvp) STMT_START { \
+ Perl_DJGPP_init(); } STMT_END
+#else
#define PERL_SYS_INIT(c,v)
+#define BIT_BUCKET "\dev\nul"
+#endif
+
#define PERL_SYS_TERM()
#define dXSUB_SYS int dummy
#define TMPPATH "plXXXXXX"
+/*
+ * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were
+ * running on DOS, *and* if we had to cope with 16 bit memory addressing
+ * constraints, *and* we need to have memory allocated as unsigned long.
+ *
+ * with the advent of *real* compilers for DOS, they are not locked together.
+ * MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have
+ * 16 bit memory addressing constraints".
+ *
+ * if you need the last, try #DEFINE MEM_SIZE unsigned long.
+ */
+#ifdef MSDOS
+ #ifndef DJGPP
+ #define HAS_64K_LIMIT
+ #endif
+#endif
+
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype) to insure
View
1,136 emacs/cperl-mode.el
@@ -10,7 +10,7 @@
;; This file is not (yet) part of GNU Emacs. It may be distributed
;; either under the same terms as GNU Emacs, or under the same terms
-;; as Perl. You should have recieved a copy of Perl Artistic license
+;; as Perl. You should have received a copy of Perl Artistic license
;; along with the Perl distribution.
;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -24,13 +24,15 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
-;; $Id: cperl-mode.el,v 1.25 1996/09/06 09:51:41 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.29 1996/11/18 23:10:26 ilya Exp ilya $
;;; To use this mode put the following into your .emacs file:
@@ -53,7 +55,7 @@
;;; The mode information (on C-h m) provides customization help.
;;; If you use font-lock feature of this mode, it is advisable to use
-;;; eather lazy-lock-mode or fast-lock-mode (available on ELisp
+;;; either lazy-lock-mode or fast-lock-mode (available on ELisp
;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
;;; Faces used now: three faces for first-class and second-class keywords
@@ -63,12 +65,12 @@
;;; not define them, so you need to define them manually. Maybe you have
;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
-;;; If you have grayscale monitor, and do not have the variable
+;;; If you have a grayscale monitor, and do not have the variable
;;; font-lock-display-type bound to 'grayscale, insert
;;; (setq font-lock-display-type 'grayscale)
-;;; to your .emacs file.
+;;; into your .emacs file.
;;;; This mode supports font-lock, imenu and mode-compile. In the
;;;; hairy version font-lock is on, but you should activate imenu
@@ -289,7 +291,7 @@
;;; Electric-; should work better.
;;; Minor bugs with POD marking.
-;;;; After 1.25
+;;;; After 1.25 (probably not...)
;;; `cperl-info-page' introduced.
;;; To make `uncomment-region' working, `comment-region' would
;;; not insert extra space.
@@ -302,10 +304,30 @@
;;; are not treated.
;;; POD/friends scan merged in one pass.
;;; Syntax class is not used for analyzing the code, only char-syntax
-;;; may be cecked against _ or'ed with w.
+;;; may be checked against _ or'ed with w.
;;; Syntax class of `:' changed to be _.
;;; `cperl-find-bad-style' added.
+;;;; After 1.25
+;;; When search for here-documents, we ignore commented << in simplest cases.
+;;; `cperl-get-help' added, available on C-h v and from menu.
+;;; Auto-help added. Default with `cperl-hairy', switchable on/off
+;;; with startup variable `cperl-lazy-help-time' and from
+;;; menu. Requires `run-with-idle-timer'.
+;;; Highlighting of @abc{@efg} was wrong - interchanged two regexps.
+
+;;;; After 1.27
+;;; Indentation: At toplevel after a label - fixed.
+;;; 1.27 was put to archives in binary mode ===> DOSish :-(
+
+;;;; After 1.28
+;;; Thanks to Martin Buchholz <mrb@Eng.Sun.COM>: misprints in
+;;; comments and docstrings corrected, XEmacs support cleaned up.
+;;; The closing parenths would enclose the region into matching
+;;; parens under the same conditions as the opening ones.
+;;; Minor updates to `cperl-short-docs'.
+;;; Will not consider <<= as start of here-doc.
+
(defvar cperl-extra-newline-before-brace nil
"*Non-nil means that if, elsif, while, until, else, for, foreach
and do constructs look like:
@@ -409,6 +431,9 @@ Can be overwritten by `cperl-hairy' if nil.")
The opposite behaviour is always available if prefixed with C-c.
Can be overwritten by `cperl-hairy' if nil.")
+(defvar cperl-lazy-help-time nil
+ "*Not-nil (and non-null) means to show lazy help after given idle time.")
+
(defvar cperl-pod-face 'font-lock-comment-face
"*The result of evaluation of this expression is used for pod highlighting.")
@@ -431,7 +456,7 @@ You can always make lookup from menu or using \\[cperl-find-pods-heres].")
May require patched `imenu' and `imenu-go'.")
(defvar cperl-info-page "perl"
- "Name of the info page containging perl docs.
+ "Name of the info page containing perl docs.
Older version of this page was called `perl5', newer `perl'.")
@@ -469,6 +494,8 @@ CPerl/Tools/Tags menu beforehand.
Run CPerl/Tools/Insert-spaces-if-needed to fix your lazy typing.
+Switch auto-help on/off with CPerl/Tools/Auto-help.
+
Before reporting (non-)problems look in the problem section on what I
know about them.")
@@ -479,26 +506,26 @@ It may be corrected on the level of C code, please look in the
`non-problems' section if you want to volunteer.
CPerl mode tries to corrects some Emacs misunderstandings, however,
-for effeciency reasons the degree of correction is different for
+for efficiency reasons the degree of correction is different for
different operations. The partially corrected problems are: POD
sections, here-documents, regexps. The operations are: highlighting,
indentation, electric keywords, electric braces.
This may be confusing, since the regexp s#//#/#\; may be highlighted
-as a comment, but it will recognized as a regexp by the indentation
+as a comment, but it will be recognized as a regexp by the indentation
code. Or the opposite case, when a pod section is highlighted, but
breaks the indentation of the following code.
The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think out is
+${aaa} look like unbalanced braces. The only trick I can think of is
to insert it as $ {aaa} (legal in perl5, not in perl4).
Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transpositinon is not always possible
+as /($|\\s)/. Note that such a transposition is not always possible
:-(. " )
(defvar cperl-non-problems 'please-ignore-this-line
-"As you know from `problems' section, Perl syntax too hard for CPerl.
+"As you know from `problems' section, Perl syntax is too hard for CPerl.
Most the time, if you write your own code, you may find an equivalent
\(and almost as readable) expression.
@@ -530,7 +557,7 @@ b) Supply the code to me (IZ).
Pods are treated _very_ rudimentally. Here-documents are not treated
at all (except highlighting and inhibiting indentation). (This may
change some time. RMS approved making syntax lookup recognize text
-attributes, but volonteers are needed to change Emacs C code.)
+attributes, but volunteers are needed to change Emacs C code.)
To speed up coloring the following compromises exist:
a) sub in $mypackage::sub may be highlighted.
@@ -546,8 +573,13 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
;;; Portability stuff:
-(defsubst cperl-xemacs-p ()
- (string-match "XEmacs\\|Lucid" emacs-version))
+(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+(defmacro cperl-define-key (fsf-key definition &optional xemacs-key)
+ `(define-key cperl-mode-map
+ ,(if xemacs-key
+ `(if cperl-xemacs-p ,xemacs-key ,fsf-key)
+ fsf-key)
+ ,definition))
(defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
(where-is-internal 'backward-delete-char-untabify)))
@@ -556,7 +588,7 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
(and (vectorp del-back-ch) (= (length del-back-ch) 1)
(setq del-back-ch (aref del-back-ch 0)))
-(if (cperl-xemacs-p)
+(if cperl-xemacs-p
(progn
;; "Active regions" are on: use region only if active
;; "Active regions" are off: use region unconditionally
@@ -568,10 +600,10 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
(defun cperl-mark-active () mark-active))
(defsubst cperl-enable-font-lock ()
- (or (cperl-xemacs-p) window-system))
+ (or cperl-xemacs-p window-system))
(if (boundp 'unread-command-events)
- (if (cperl-xemacs-p)
+ (if cperl-xemacs-p
(defun cperl-putback-char (c) ; XEmacs >= 19.12
(setq unread-command-events (list (character-to-event c))))
(defun cperl-putback-char (c) ; Emacs 19
@@ -628,39 +660,37 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
(if cperl-mode-map nil
(setq cperl-mode-map (make-sparse-keymap))
- (define-key cperl-mode-map "{" 'cperl-electric-lbrace)
- (define-key cperl-mode-map "[" 'cperl-electric-paren)
- (define-key cperl-mode-map "(" 'cperl-electric-paren)
- (define-key cperl-mode-map "<" 'cperl-electric-paren)
- (define-key cperl-mode-map "}" 'cperl-electric-brace)
- (define-key cperl-mode-map ";" 'cperl-electric-semi)
- (define-key cperl-mode-map ":" 'cperl-electric-terminator)
- (define-key cperl-mode-map "\C-j" 'newline-and-indent)
- (define-key cperl-mode-map "\C-c\C-j" 'cperl-linefeed)
- (define-key cperl-mode-map "\C-c\C-a" 'cperl-toggle-auto-newline)
- (define-key cperl-mode-map "\C-c\C-k" 'cperl-toggle-abbrev)
- (define-key cperl-mode-map "\C-c\C-e" 'cperl-toggle-electric)
- (define-key cperl-mode-map "\e\C-q" 'cperl-indent-exp) ; Usually not bound
- ;;(define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
- ;;(define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
- (define-key cperl-mode-map "\177" 'cperl-electric-backspace)
- (define-key cperl-mode-map "\t" 'cperl-indent-command)
- (if (cperl-xemacs-p)
- ;; don't clobber the backspace binding:
- (define-key cperl-mode-map [(control h) f] 'cperl-info-on-command)
- (define-key cperl-mode-map "\C-hf" 'cperl-info-on-command))
- (if (cperl-xemacs-p)
- ;; don't clobber the backspace binding:
- (define-key cperl-mode-map [(control c) (control h) f]
- 'cperl-info-on-current-command)
- (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-current-command))
- (if (and (cperl-xemacs-p)
+ (cperl-define-key "{" 'cperl-electric-lbrace)
+ (cperl-define-key "[" 'cperl-electric-paren)
+ (cperl-define-key "(" 'cperl-electric-paren)
+ (cperl-define-key "<" 'cperl-electric-paren)
+ (cperl-define-key "}" 'cperl-electric-brace)
+ (cperl-define-key "]" 'cperl-electric-rparen)
+ (cperl-define-key ")" 'cperl-electric-rparen)
+ (cperl-define-key ";" 'cperl-electric-semi)
+ (cperl-define-key ":" 'cperl-electric-terminator)
+ (cperl-define-key "\C-j" 'newline-and-indent)
+ (cperl-define-key "\C-c\C-j" 'cperl-linefeed)
+ (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
+ (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
+ (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
+ (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+ ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
+ ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
+ (cperl-define-key "\177" 'cperl-electric-backspace)
+ (cperl-define-key "\t" 'cperl-indent-command)
+ ;; don't clobber the backspace binding:
+ (cperl-define-key "\C-hf" 'cperl-info-on-command [(control h) f])
+ (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
+ [(control c) (control h) f])
+ (cperl-define-key "\C-hv" 'cperl-get-help [(control h) v])
+ (if (and cperl-xemacs-p
(<= emacs-minor-version 11) (<= emacs-major-version 19))
(progn
;; substitute-key-definition is usefulness-deenhanced...
- (define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
- (define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
- (define-key cperl-mode-map "\e\C-\\" 'cperl-indent-region))
+ (cperl-define-key "\M-q" 'cperl-fill-paragraph)
+ (cperl-define-key "\e;" 'cperl-indent-for-comment)
+ (cperl-define-key "\e\C-\\" 'cperl-indent-region))
(substitute-key-definition
'indent-sexp 'cperl-indent-exp
cperl-mode-map global-map)
@@ -728,7 +758,11 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
["Define word at point" imenu-go-find-at-position
(fboundp 'imenu-go-find-at-position)]
["Help on function" cperl-info-on-command t]
- ["Help on function at point" cperl-info-on-current-command t])
+ ["Help on function at point" cperl-info-on-current-command t]
+ ["Help on symbol at point" cperl-get-help t]
+ ["Auto-help on" cperl-lazy-install (fboundp 'run-with-idle-timer)]
+ ["Auto-help off" cperl-lazy-unstall
+ (fboundp 'run-with-idle-timer)])
("Toggle..."
["Auto newline" cperl-toggle-auto-newline t]
["Electric parens" cperl-toggle-electric t]
@@ -830,13 +864,13 @@ between the braces. If CPerl decides that you want to insert
it will not do any expansion. See also help on variable
`cperl-extra-newline-before-brace'.
-\\[cperl-linefeed] is a convinience replacement for typing carriage
+\\[cperl-linefeed] is a convenience replacement for typing carriage
return. It places you in the next line with proper indentation, or if
you type it inside the inline block of control construct, like
foreach (@lines) {print; print}
and you are on a boundary of a statement inside braces, it will
transform the construct into a multiline and will place you into an
-apporpriately indented blank line. If you need a usual
+appropriately indented blank line. If you need a usual
`newline-and-indent' behaviour, it is on \\[newline-and-indent],
see documentation on `cperl-electric-linefeed'.
@@ -862,6 +896,15 @@ These keys run commands `cperl-info-on-current-command' and
`cperl-info-on-command', which one is which is controlled by variable
`cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy').
+Even if you have no info-format documentation, short one-liner-style
+help is available on \\[cperl-get-help].
+
+It is possible to show this help automatically after some idle
+time. This is regulated by variable `cperl-lazy-help-time'. Default
+with `cperl-hairy' is 5 secs idle time if the value of this variable
+is nil. It is also possible to switch this on/off from the
+menu. Requires `run-with-idle-timer'.
+
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
`cperl-pod-face', `cperl-pod-head-face' control processing of pod and
here-docs sections. In a future version results of scan may be used
@@ -926,15 +969,10 @@ with no args."
(local-set-key "\C-C\C-J" 'newline-and-indent)))
(if (cperl-val 'cperl-info-on-command-no-prompt)
(progn
- (if (cperl-xemacs-p)
- ;; don't clobber the backspace binding:
- (local-set-key [(control h) f] 'cperl-info-on-current-command)
- (local-set-key "\C-hf" 'cperl-info-on-current-command))
- (if (cperl-xemacs-p)
- ;; don't clobber the backspace binding:
- (local-set-key [(control c) (control h) f]
- 'cperl-info-on-command)
- (local-set-key "\C-c\C-hf" 'cperl-info-on-command))))
+ ;; don't clobber the backspace binding:
+ (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
+ (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
+ [(control c) (control h) f])))
(setq major-mode 'perl-mode)
(setq mode-name "CPerl")
(if (not cperl-mode-abbrev-table)
@@ -1009,6 +1047,8 @@ with no args."
(and (boundp 'msb-menu-cond)
(not cperl-msb-fixed)
(cperl-msb-fix))
+ (if (featurep 'easymenu)
+ (easy-menu-add cperl-menu)) ; A NOP under FSF Emacs.
(run-hooks 'cperl-mode-hook)
;; After hooks since fontification will break this
(if cperl-pod-here-scan (cperl-find-pods-heres)))
@@ -1089,7 +1129,7 @@ with no args."
;;; (setq prevc (current-column)))))))
(defun cperl-indent-for-comment ()
- "Substite for `indent-for-comment' in CPerl."
+ "Substitute for `indent-for-comment' in CPerl."
(interactive)
(let (cperl-wrong-comment)
(indent-for-comment)
@@ -1111,62 +1151,83 @@ See `comment-region'."
(let ((comment-start "#"))
(comment-region b e (- arg))))
+(defvar cperl-brace-recursing nil)
+
(defun cperl-electric-brace (arg &optional only-before)
"Insert character and correct line's indentation.
If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
place (even in empty line), but not after. If after \")\" and the inserted
char is \"{\", insert extra newline before only if
`cperl-extra-newline-before-brace'."
(interactive "P")
- (let (insertpos)
- (if (and (not arg) ; No args, end (of empty line or auto)
- (eolp)
- (or (and (null only-before)
- (save-excursion
- (skip-chars-backward " \t")
- (bolp)))
- (and (eq last-command-char ?\{) ; Do not insert newline
- ;; if after ")" and `cperl-extra-newline-before-brace'
- ;; is nil, do not insert extra newline.
- (not cperl-extra-newline-before-brace)
- (save-excursion
- (skip-chars-backward " \t")
- (eq (preceding-char) ?\))))
- (if cperl-auto-newline
- (progn (cperl-indent-line) (newline) t) nil)))
+ (let (insertpos
+ (other-end (if (and cperl-electric-parens-mark
+ (cperl-mark-active)
+ (< (mark) (point)))
+ (mark)
+ nil)))
+ (if (and other-end
+ (not cperl-brace-recursing)
+ (cperl-val 'cperl-electric-parens)
+ (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)))
+ ;; Need to insert a matching pair
(progn
- (if cperl-auto-newline
- (setq insertpos (point)))
- (insert last-command-char)
- (cperl-indent-line)
- (if (and cperl-auto-newline (null only-before))
- (progn
- (newline)
- (cperl-indent-line)))
(save-excursion
- (if insertpos (progn (goto-char insertpos)
- (search-forward (make-string
- 1 last-command-char))
- (setq insertpos (1- (point)))))
- (delete-char -1))))
- (if insertpos
- (save-excursion
- (goto-char insertpos)
- (self-insert-command (prefix-numeric-value arg)))
- (self-insert-command (prefix-numeric-value arg)))))
+ (setq insertpos (point-marker))
+ (goto-char other-end)
+ (setq last-command-char ?\{)
+ (cperl-electric-lbrace arg insertpos))
+ (forward-char 1))
+ (if (and (not arg) ; No args, end (of empty line or auto)
+ (eolp)
+ (or (and (null only-before)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+ (and (eq last-command-char ?\{) ; Do not insert newline
+ ;; if after ")" and `cperl-extra-newline-before-brace'
+ ;; is nil, do not insert extra newline.
+ (not cperl-extra-newline-before-brace)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (eq (preceding-char) ?\))))
+ (if cperl-auto-newline
+ (progn (cperl-indent-line) (newline) t) nil)))
+ (progn
+ (if cperl-auto-newline
+ (setq insertpos (point)))
+ (insert last-command-char)
+ (cperl-indent-line)
+ (if (and cperl-auto-newline (null only-before))
+ (progn
+ (newline)
+ (cperl-indent-line)))
+ (save-excursion
+ (if insertpos (progn (goto-char insertpos)
+ (search-forward (make-string
+ 1 last-command-char))
+ (setq insertpos (1- (point)))))
+ (delete-char -1))))
+ (if insertpos
+ (save-excursion
+ (goto-char insertpos)
+ (self-insert-command (prefix-numeric-value arg)))
+ (self-insert-command (prefix-numeric-value arg))))))
-(defun cperl-electric-lbrace (arg)
+(defun cperl-electric-lbrace (arg &optional end)
"Insert character, correct line's indentation, correct quoting by space."
(interactive "P")
(let (pos after
+ (cperl-brace-recursing t)
(cperl-auto-newline cperl-auto-newline)
- (other-end (if (and cperl-electric-parens-mark
- (cperl-mark-active)
- (> (mark) (point)))
- (save-excursion
- (goto-char (mark))
- (point-marker))
- nil)))
+ (other-end (or end
+ (if (and cperl-electric-parens-mark
+ (cperl-mark-active)
+ (> (mark) (point)))
+ (save-excursion
+ (goto-char (mark))
+ (point-marker))
+ nil))))
(and (cperl-val 'cperl-electric-lbrace-space)
(eq (preceding-char) ?$)
(save-excursion
@@ -1215,10 +1276,39 @@ char is \"{\", insert extra newline before only if
(insert last-command-char)
)))
+(defun cperl-electric-rparen (arg)
+ "Insert a matching pair of parentheses if marking is active.
+If not, or if we are not at the end of marking range, would self-insert."
+ (interactive "P")
+ (let ((beg (save-excursion (beginning-of-line) (point)))
+ (other-end (if (and cperl-electric-parens-mark
+ (cperl-mark-active)
+ (< (mark) (point)))
+ (mark)
+ nil))
+ p)
+ (if (and other-end
+ (cperl-val 'cperl-electric-parens)
+ (memq last-command-char '( ?\) ?\] ?\} ?\> ))
+ (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
+ ;;(not (save-excursion (search-backward "#" beg t)))
+ )
+ (progn
+ (insert last-command-char)
+ (setq p (point))
+ (if other-end (goto-char other-end))
+ (insert (cdr (assoc last-command-char '((?\} . ?\{)
+ (?\] . ?\[)
+ (?\) . ?\()
+ (?\> . ?\<)))))
+ (goto-char (1+ p)))
+ (call-interactively 'self-insert-command)
+ )))
+
(defun cperl-electric-keyword ()
"Insert a construction appropriate after a keyword."
(let ((beg (save-excursion (beginning-of-line) (point)))
- (dollar (eq (preceding-char) ?$)))
+ (dollar (eq last-command-char ?$)))
(and (save-excursion
(backward-sexp 1)
(cperl-after-expr-p nil "{};:"))
@@ -1659,7 +1749,12 @@ Returns nil if line starts inside a string, t if in a comment."
;; Now add a little if this is a continuation line.
(if (or (bobp)
(memq (preceding-char) (append " ;}" nil)) ; Was ?\)
- (memq char-after (append ")]}" nil)))
+ (memq char-after (append ")]}" nil))
+ (and (eq (preceding-char) ?\:) ; label
+ (progn
+ (forward-sexp -1)
+ (skip-chars-backward " \t")
+ (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))
0
cperl-continued-statement-offset))))
((/= (char-after containing-sexp) ?{)
@@ -1721,7 +1816,7 @@ Returns nil if line starts inside a string, t if in a comment."
(or
;; If no, find that first statement and indent like
;; it. If the first statement begins with label, do
- ;; not belive when the indentation of the label is too
+ ;; not believe when the indentation of the label is too
;; small.
(save-excursion
(forward-char 1)
@@ -1744,7 +1839,7 @@ Returns nil if line starts inside a string, t if in a comment."
(if (> (current-indentation)
cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
- ;; Do not belive: `max' is involved
+ ;; Do not believe: `max' is involved
(+ old-indent cperl-indent-level))
(current-column)))))
;; If no previous statement,
@@ -1894,7 +1989,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
(or
;; If no, find that first statement and indent like
;; it. If the first statement begins with label, do
- ;; not belive when the indentation of the label is too
+ ;; not believe when the indentation of the label is too
;; small.
(save-excursion
(forward-char 1)
@@ -1920,7 +2015,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
(if (> (current-indentation)
cperl-min-label-indent)
(list (list 'label-in-block (point)))
- ;; Do not belive: `max' is involved
+ ;; Do not believe: `max' is involved
(list
(list 'label-in-block-min-indent (point))))
;; Before statement
@@ -2042,7 +2137,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\(\\`\n?\\|\n\n\\)="
"\\|"
;; One extra () before this:
- "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
+ "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)[^=]\\)" ; [^=] to avoid <<=.
"\\|"
;; 1+5 extra () before this:
"^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
@@ -2105,74 +2200,82 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(match-beginning 1) (match-end 1)
'face head-face))))
(goto-char e)))
- ;; 1 () ahead
- ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
- ((match-beginning 2) ; 1 + 1
- (if (match-beginning 5) ;4 + 1
- (setq b1 (match-beginning 5) ; 4 + 1
- e1 (match-end 5)) ; 4 + 1
- (setq b1 (match-beginning 4) ; 3 + 1
- e1 (match-end 4))) ; 3 + 1
- (setq tag (buffer-substring b1 e1)
- qtag (regexp-quote tag))
- (cond (cperl-pod-here-fontify
- (put-text-property b1 e1 'face font-lock-reference-face)
- (cperl-put-do-not-fontify b1 e1)))
- (forward-line)
- (setq b (point))
- (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
- (if cperl-pod-here-fontify
- (progn
- (put-text-property (match-beginning 0) (match-end 0)
- 'face font-lock-reference-face)
- (cperl-put-do-not-fontify b (match-end 0))
- ;;(put-text-property (max (point-min) (1- b))
- ;; (min (point-max)
- ;; (1+ (match-end 0)))
- ;; cperl-do-not-fontify t)
- (put-text-property b (match-beginning 0)
- 'face here-face)))
- (put-text-property b (match-beginning 0)
- 'syntax-type 'here-doc)
- (cperl-put-do-not-fontify b (match-beginning 0)))
- (t (message "End of here-document `%s' not found." tag))))
- (t
- ;; 1+5=6 extra () before this:
- ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
- (setq b (point)
- name (if (match-beginning 7) ; 6 + 1
- (buffer-substring (match-beginning 7) ; 6 + 1
- (match-end 7)) ; 6 + 1
- ""))
- (setq argument nil)
- (if cperl-pod-here-fontify
- (while (and (eq (forward-line) 0)
- (not (looking-at "^[.;]$")))
- (cond
- ((looking-at "^#")) ; Skip comments
- ((and argument ; Skip argument multi-lines
- (looking-at "^[ \t]*{"))
- (forward-sexp 1)
- (setq argument nil))
- (argument ; Skip argument lines
- (setq argument nil))
- (t ; Format line
- (setq b1 (point))
- (setq argument (looking-at "^[^\n]*[@^]"))
- (end-of-line)
- (put-text-property b1 (point)
- 'face font-lock-string-face)
- (cperl-put-do-not-fontify b1 (point)))))
- (re-search-forward (concat "^[.;]$") max 'toend))
- (beginning-of-line)
- (if (looking-at "^[.;]$")
- (progn
- (put-text-property (point) (+ (point) 2)
- 'face font-lock-string-face)
- (cperl-put-do-not-fontify (point) (+ (point) 2)))
- (message "End of format `%s' not found." name))
- (forward-line)
- (put-text-property b (point) 'syntax-type 'format)
+ ;; Here document
+ ;; 1 () ahead
+ ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
+ ((match-beginning 2) ; 1 + 1
+ ;; Abort in comment (_extremely_ simplified):
+ (setq b (point))
+ (if (save-excursion
+ (beginning-of-line)
+ (search-forward "#" b t))
+ nil
+ (if (match-beginning 5) ;4 + 1
+ (setq b1 (match-beginning 5) ; 4 + 1
+ e1 (match-end 5)) ; 4 + 1
+ (setq b1 (match-beginning 4) ; 3 + 1
+ e1 (match-end 4))) ; 3 + 1
+ (setq tag (buffer-substring b1 e1)
+ qtag (regexp-quote tag))
+ (cond (cperl-pod-here-fontify
+ (put-text-property b1 e1 'face font-lock-reference-face)
+ (cperl-put-do-not-fontify b1 e1)))
+ (forward-line)
+ (setq b (point))
+ (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
+ (if cperl-pod-here-fontify
+ (progn
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face font-lock-reference-face)
+ (cperl-put-do-not-fontify b (match-end 0))
+ ;;(put-text-property (max (point-min) (1- b))
+ ;; (min (point-max)
+ ;; (1+ (match-end 0)))
+ ;; cperl-do-not-fontify t)
+ (put-text-property b (match-beginning 0)
+ 'face here-face)))
+ (put-text-property b (match-beginning 0)
+ 'syntax-type 'here-doc)
+ (cperl-put-do-not-fontify b (match-beginning 0)))
+ (t (message "End of here-document `%s' not found." tag)))))
+ ;; format
+ (t
+ ;; 1+5=6 extra () before this:
+ ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
+ (setq b (point)
+ name (if (match-beginning 7) ; 6 + 1
+ (buffer-substring (match-beginning 7) ; 6 + 1
+ (match-end 7)) ; 6 + 1
+ ""))
+ (setq argument nil)
+ (if cperl-pod-here-fontify
+ (while (and (eq (forward-line) 0)
+ (not (looking-at "^[.;]$")))
+ (cond
+ ((looking-at "^#")) ; Skip comments
+ ((and argument ; Skip argument multi-lines
+ (looking-at "^[ \t]*{"))
+ (forward-sexp 1)
+ (setq argument nil))
+ (argument ; Skip argument lines
+ (setq argument nil))
+ (t ; Format line
+ (setq b1 (point))
+ (setq argument (looking-at "^[^\n]*[@^]"))
+ (end-of-line)
+ (put-text-property b1 (point)
+ 'face font-lock-string-face)
+ (cperl-put-do-not-fontify b1 (point)))))
+ (re-search-forward (concat "^[.;]$") max 'toend))
+ (beginning-of-line)
+ (if (looking-at "^[.;]$")
+ (progn
+ (put-text-property (point) (+ (point) 2)
+ 'face font-lock-string-face)
+ (cperl-put-do-not-fontify (point) (+ (point) 2)))
+ (message "End of format `%s' not found." name))
+ (forward-line)
+ (put-text-property b (point) 'syntax-type 'format)
;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend)
;;; (if cperl-pod-here-fontify
;;; (progn
@@ -2183,7 +2286,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;;; 'syntax-type 'format)
;;; (cperl-put-do-not-fontify b (match-beginning 0)))
;;; (t (message "End of format `%s' not found." name)))
- )))
+ )))
;;; (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
;;; (if (looking-at "\n*cut\\>")
;;; (progn
@@ -2734,36 +2837,43 @@ indentation and initial hashes. Behaves usually outside of comment."
"\\|") ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
; In what follows we use `type' style
- ; for overwritable buildins
+ ; for overwritable builtins
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2"
- ;; "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr"
- ;; "chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
- ;; "crypt" "dbmclose" "dbmopen" "die" "dump" "endgrent" "endhostent"
- ;; "endnetent" "endprotoent" "endpwent" "endservent" "eof" "eq" "exec"
- ;; "exit" "exp" "fcntl" "fileno" "flock" "fork" "formline" "ge" "getc"
- ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" "gethostbyname"
- ;; "gethostent" "getlogin" "getnetbyaddr" "getnetbyname" "getnetent"
- ;; "getpeername" "getpgrp" "getppid" "getpriority" "getprotobyname"
- ;; "getprotobynumber" "getprotoent" "getpwent" "getpwnam" "getpwuid"
- ;; "getservbyname" "getservbyport" "getservent" "getsockname"
- ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" "ioctl"
- ;; "join" "kill" "lc" "lcfirst" "le" "length" "link" "listen"
- ;; "localtime" "log" "lstat" "lt" "mkdir" "msgctl" "msgget" "msgrcv"
- ;; "msgsnd" "ne" "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
- ;; "quotemeta" "rand" "read" "readdir" "readline" "readlink"
- ;; "readpipe" "recv" "ref" "rename" "require" "reset" "reverse"
- ;; "rewinddir" "rindex" "rmdir" "seek" "seekdir" "select" "semctl"
- ;; "semget" "semop" "send" "setgrent" "sethostent" "setnetent"
- ;; "setpgrp" "setpriority" "setprotoent" "setpwent" "setservent"
- ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" "shutdown"
- ;; "sin" "sleep" "socket" "socketpair" "sprintf" "sqrt" "srand" "stat"
- ;; "substr" "symlink" "syscall" "sysread" "system" "syswrite" "tell"
- ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" "umask" "unlink"
- ;; "unpack" "utime" "values" "vec" "wait" "waitpid" "wantarray" "warn"
- ;; "write" "x" "xor"
+ ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm"
+ ;; "and" "atan2" "bind" "binmode" "bless" "caller"
+ ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
+ ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
+ ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
+ ;; "endhostent" "endnetent" "endprotoent" "endpwent"
+ ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fcntl"
+ ;; "fileno" "flock" "fork" "formline" "ge" "getc"
+ ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
+ ;; "gethostbyname" "gethostent" "getlogin"
+ ;; "getnetbyaddr" "getnetbyname" "getnetent"
+ ;; "getpeername" "getpgrp" "getppid" "getpriority"
+ ;; "getprotobyname" "getprotobynumber" "getprotoent"
+ ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
+ ;; "getservbyport" "getservent" "getsockname"
+ ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
+ ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
+ ;; "link" "listen" "localtime" "log" "lstat" "lt"
+ ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
+ ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
+ ;; "quotemeta" "rand" "read" "readdir" "readline"
+ ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
+ ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
+ ;; "seekdir" "select" "semctl" "semget" "semop" "send"
+ ;; "setgrent" "sethostent" "setnetent" "setpgrp"
+ ;; "setpriority" "setprotoent" "setpwent" "setservent"
+ ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
+ ;; "shutdown" "sin" "sleep" "socket" "socketpair"
+ ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
+ ;; "syscall" "sysread" "system" "syswrite" "tell"
+ ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
+ ;; "umask" "unlink" "unpack" "utime" "values" "vec"
+ ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
"a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
"b\\(in\\(d\\|mode\\)\\|less\\)\\|"
"c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
@@ -2797,18 +2907,20 @@ indentation and initial hashes. Behaves usually outside of comment."
"x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
"\\)\\>") 2 'font-lock-type-face)
;; In what follows we use `other' style
- ;; for nonoverwritable buildins
- ;; Somehow 's', 'm' are not autogenerated???
+ ;; for nonoverwritable builtins
+ ;; Somehow 's', 'm' are not auto-generated???
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp" "chop"
- ;; "defined" "delete" "do" "each" "else" "elsif" "eval" "exists" "for"
- ;; "foreach" "format" "goto" "grep" "if" "keys" "last" "local" "map"
- ;; "my" "next" "no" "package" "pop" "pos" "print" "printf" "push" "q"
- ;; "qq" "qw" "qx" "redo" "return" "scalar" "shift" "sort" "splice"
- ;; "split" "study" "sub" "tie" "tr" "undef" "unless" "unshift" "untie"
- ;; "until" "use" "while" "y"
+ ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp"
+ ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
+ ;; "eval" "exists" "for" "foreach" "format" "goto"
+ ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
+ ;; "no" "package" "pop" "pos" "print" "printf" "push"
+ ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift"
+ ;; "sort" "splice" "split" "study" "sub" "tie" "tr"
+ ;; "undef" "unless" "unshift" "untie" "until" "use"
+ ;; "while" "y"
"AUTOLOAD\\|BEGIN\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
"o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
"END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|"
@@ -2825,7 +2937,7 @@ indentation and initial hashes. Behaves usually outside of comment."
;; "#include" "#define" "#undef")
;; "\\|")
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
- font-lock-function-name-face) ; Not very good, triggers at "[a-z]"
+ font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
'("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
font-lock-function-name-face)
'("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
@@ -2871,20 +2983,21 @@ indentation and initial hashes. Behaves usually outside of comment."
(setq
t-font-lock-keywords-1
(and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
- (not (cperl-xemacs-p)) ; not yet as of XEmacs 19.12
- '(("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
+ (not cperl-xemacs-p) ; not yet as of XEmacs 19.12
+ '(
+ ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
+ (if (eq (char-after (match-beginning 2)) ?%)
+ font-lock-other-emphasized-face
+ font-lock-emphasized-face)
+ t) ; arrays and hashes
+ ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
(if (eq (char-after (match-beginning 3)) ?{)
font-lock-other-emphasized-face
font-lock-emphasized-face) ; arrays and hashes
font-lock-variable-name-face) ; Just to put something
t)
- ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
- (if (eq (char-after (match-beginning 2)) ?%)
- font-lock-other-emphasized-face
- font-lock-emphasized-face)
- t) ; arrays and hashes
;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
;;; Too much noise from \s* @s[ and friends
;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)"
@@ -2996,7 +3109,7 @@ indentation and initial hashes. Behaves usually outside of comment."
'font-lock-other-type-face
"Face to use for data types from another group.")
)
- (if (not (cperl-xemacs-p)) nil
+ (if (not cperl-xemacs-p) nil
(or (boundp 'font-lock-comment-face)
(defconst font-lock-comment-face
'font-lock-comment-face
@@ -3183,7 +3296,7 @@ Available styles are GNU, K&R, BSD and Whitesmith."
(mode-compile)))
(defun cperl-info-buffer ()
- ;; Returns buffer with documentation. Creats if missing
+ ;; Returns buffer with documentation. Creates if missing
(let ((info (get-buffer "*info-perl*")))
(if info info
(save-window-excursion
@@ -3283,7 +3396,7 @@ Available styles are GNU, K&R, BSD and Whitesmith."
(defun cperl-lineup (beg end &optional step minshift)
"Lineup construction in a region.
Beginning of region should be at the start of a construction.
-All first occurences of this construction in the lines that are
+All first occurrences of this construction in the lines that are
partially contained in the region are lined up at the same column.
MINSHIFT is the minimal amount of space to insert before the construction.
@@ -3324,7 +3437,7 @@ Will not move the position at the start to the left."
(setq tcol (current-column) seen t)
(if (> tcol col) (setq col tcol)))
(or seen
- (error "The construction to line up occured only once"))
+ (error "The construction to line up occurred only once"))
(goto-char beg)
(setq col (+ col minshift))
(if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
@@ -3596,7 +3709,7 @@ in subdirectories too."
;; Name known
(setcdr cons1 (cons (cons fileind (vector file info))
(cdr cons1)))
- ;; First occurence of the name, start alist
+ ;; First occurrence of the name, start alist
(setq cons1 (cons name (list (cons fileind (vector file info)))))
(if pack
(setcar (cdr cperl-hierarchy)
@@ -3852,3 +3965,564 @@ Currently it is tuned to C and Perl syntax."
found-bad found)))
(not not-found)))
+
+;;; Getting help
+(defvar cperl-have-help-regexp
+ ;;(concat "\\("
+ (mapconcat
+ 'identity
+ '("[$@%*&][0-9a-zA-Z_:]+" ; Usual variable
+ "[$@]\\^[a-zA-Z]" ; Special variable
+ "[$@][^ \n\t]" ; Special variable
+ "-[a-zA-Z]" ; File test
+ "\\\\[a-zA-Z0]" ; Special chars
+ "[-!&*+,-./<=>?\\\\^|~]+" ; Operator
+ "[a-zA-Z_0-9:]+" ; symbol or number
+ "x="
+ "#!"
+ )
+ ;;"\\)\\|\\("
+ "\\|"
+ )
+ ;;"\\)"
+ ;;)
+ "Matches places in the buffer we can find help for.")
+
+(defvar cperl-message-on-help-error t)
+
+(defun cperl-get-help ()
+ "Get one-line docs on the symbol at the point.
+The data for these docs is a little bit obsolete and may be in fact longer
+than a line. Your contribution to update/shorten it is appreciated."
+ (interactive)
+ (save-excursion
+ ;; Get to the something meaningful
+ (or (eobp) (eolp) (forward-char 1))
+ (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]"
+ (save-excursion (beginning-of-line) (point))
+ 'to-beg)
+ ;; (cond
+ ;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
+ ;; (skip-chars-backward " \n\t\r({[]});,")
+ ;; (or (bobp) (backward-char 1))))
+ ;; Try to backtrace
+ (cond
+ ((looking-at "[a-zA-Z0-9_:]") ; symbol
+ (skip-chars-backward "[a-zA-Z0-9_:]")
+ (cond
+ ((and (eq (preceding-char) ?^) ; $^I
+ (eq (char-after (- (point) 2)) ?\$))
+ (forward-char -2))
+ ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob
+ (forward-char -1)))
+ (if (and (eq (preceding-char) ?\<)
+ (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH>
+ (forward-char -1)))
+ ((and (looking-at "=") (eq (preceding-char) ?x)) ; x=
+ (forward-char -1))
+ ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
+ (forward-char -1))
+ ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
+ (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
+ (cond
+ ((and (eq (preceding-char) ?\$)
+ (not (eq (char-after (- (point) 2)) ?\$))) ; $-
+ (forward-char -1))
+ ((and (eq (following-char) ?\>)
+ (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char)))
+ (save-excursion
+ (forward-sexp -1)
+ (and (eq (preceding-char) ?\<)
+ (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH>
+ (search-backward "<"))))
+ ((and (eq (following-char) ?\$)
+ (eq (preceding-char) ?\<)
+ (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh>
+ (forward-char -1)))
+ ;;(or (eobp) (forward-char 1))
+ (if (looking-at cperl-have-help-regexp)
+ (cperl-describe-perl-symbol
+ (buffer-substring (match-beginning 0) (match-end 0)))
+ (if cperl-message-on-help-error
+ (message "Nothing found for %s..."
+ (buffer-substring (point) (+ 5 (point))))))))
+
+;;; Stolen from perl-descr.el by Johan Vromans:
+
+(defvar cperl-doc-buffer " *perl-doc*"
+ "Where the documentation can be found.")
+
+(defun cperl-describe-perl-symbol (val)
+ "Display the documentation of symbol at point, a Perl operator."
+ ;; We suppose that the current position is at the start of the symbol
+ ;; when we convert $_[5] to @_
+ (let (;;(fn (perl-symbol-at-point))
+ (enable-recursive-minibuffers t)
+ ;;val
+ args-file regexp)
+ ;; (interactive
+ ;; (let ((fn (perl-symbol-at-point))
+ ;; (enable-recursive-minibuffers t)
+ ;; val args-file regexp)
+ ;; (setq val (read-from-minibuffer
+ ;; (if fn
+ ;; (format "Symbol (default %s): " fn)
+ ;; "Symbol: ")))
+ ;; (if (string= val "")
+ ;; (setq val fn))
+ (cond
+ ((string-match "^[&*][a-zA-Z_]" val)
+ (setq val (concat (substring val 0 1) "NAME")))
+ ((looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+ (if (= ?\[ (char-after (match-beginning 1)))
+ (setq val (concat "@" (substring val 1)))
+ (setq val (concat "%" (substring val 1)))))
+ ((and (string= val "x") (looking-at "x="))
+ (setq val "x="))
+ ((string-match "^\\$[\C-a-\C-z]" val)
+ (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))
+ ((and (string= "<" val) (looking-at "<\\$?[a-zA-Z0-9_:]+>"))
+ (setq val "<NAME>")))
+;;; (if (string-match "^[&*][a-zA-Z_]" val)
+;;; (setq val (concat (substring val 0 1) "NAME"))
+;;; (if (looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+;;; (if (= ?\[ (char-after (match-beginning 1)))
+;;; (setq val (concat "@" (substring val 1)))
+;;; (setq val (concat "%" (substring val 1))))
+;;; (if (and (string= val "x") (looking-at "x="))
+;;; (setq val "x=")
+;;; (if (looking-at "[$@][a-zA-Z_:0-9]")
+;;; ))))
+ (setq regexp (concat "^" "\\([^a-zA-Z0-9_:]+[ \t]\\)?"
+ (regexp-quote val)
+ "\\([ \t([/]\\|$\\)"))
+
+ ;; get the buffer with the documentation text
+ (cperl-switch-to-doc-buffer)
+
+ ;; lookup in the doc
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (list
+ (if (re-search-forward regexp (point-max) t)
+ (save-excursion
+ (beginning-of-line 1)
+ (let ((lnstart (point)))
+ (end-of-line)
+ (message "%s" (buffer-substring lnstart (point)))))
+ (if cperl-message-on-help-error
+ (message "No definition for %s" val)))))))
+
+(defvar cperl-short-docs "Ignore my value"
+ "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
+! Logical negation.
+!= Numeric inequality.
+!~ Search pattern, substitution, or translation (negated).
+$! In numeric context: errno. In a string context: error string.
+$\" The separator which joins elements of arrays interpolated in strings.
+$# The output format for printed numbers. Initial value is %.20g.
+$$ The process number of the perl running this script. Altered (in the child process) by fork().
+$% The current page number of the currently selected output channel.
+
+ The following variables are always local to the current block:
+
+$1 Match of the 1st set of parentheses in the last match (auto-local).
+$2 Match of the 2nd set of parentheses in the last match (auto-local).
+$3 Match of the 3rd set of parentheses in the last match (auto-local).
+$4 Match of the 4th set of parentheses in the last match (auto-local).
+$5 Match of the 5th set of parentheses in the last match (auto-local).
+$6 Match of the 6th set of parentheses in the last match (auto-local).
+$7 Match of the 7th set of parentheses in the last match (auto-local).
+$8 Match of the 8th set of parentheses in the last match (auto-local).
+$9 Match of the 9th set of parentheses in the last match (auto-local).
+$& The string matched by the last pattern match (auto-local).
+$' The string after what was matched by the last match (auto-local).
+$` The string before what was matched by the last match (auto-local).
+
+$( The real gid of this process.
+$) The effective gid of this process.
+$* Deprecated: Set to 1 to do multiline matching within a string.
+$+ The last bracket matched by the last search pattern.
+$, The output field separator for the print operator.
+$- The number of lines left on the page.
+$. The current input line number of the last filehandle that was read.
+$/ The input record separator, newline by default.
+$0 The name of the file containing the perl script being executed. May be set
+$: The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
+$; The subscript separator for multi-dimensional array emulation. Default is \"\\034\".
+$< The real uid of this process.
+$= The page length of the current output channel. Default is 60 lines.
+$> The effective uid of this process.
+$? The status returned by the last ``, pipe close or `system'.
+$@ The perl error message from the last eval or do @var{EXPR} command.
+$ARGV The name of the current file used with <> .
+$[ Deprecated: The index of the first element/char in an array/string.
+$\\ The output record separator for the print operator.
+$] The perl version string as displayed with perl -v.
+$^ The name of the current top-of-page format.
+$^A The current value of the write() accumulator for format() lines.
+$^D The value of the perl debug (-D) flags.
+$^E Information about the last system error other than that provided by $!.
+$^F The highest system file descriptor, ordinarily 2.
+$^H The current set of syntax checks enabled by `use strict'.
+$^I The value of the in-place edit extension (perl -i option).
+$^L What formats output to perform a formfeed. Default is \f.
+$^O The operating system name under which this copy of Perl was built.
+$^P Internal debugging flag.
+$^T The time the script was started. Used by -A/-M/-C file tests.
+$^W True if warnings are requested (perl -w flag).
+$^X The name under which perl was invoked (argv[0] in C-speech).
+$_ The default input and pattern-searching space.
+$| Flag for auto-flush after write/print on the currently selected output channel. Default is 0.
+$~ The name of the current report format.
+% Modulo division.
+%= Modulo division assignment.
+%ENV Contains the current environment.
+%INC List of files that have been require-d or do-ne.
+%SIG Used to set signal handlers for various signals.
+& Bitwise and.
+&& Logical and.
+&&= Logical and assignment.
+&= Bitwise and assignment.
+* Multiplication.
+** Exponentiation.
+*NAME Refers to all objects represented by NAME. *NAM1 = *NAM2 makes NAM1 a reference to NAM2.
+&NAME(arg0, ...) Subroutine call. Arguments go to @_.
++ Addition.
+++ Auto-increment (magical on strings).
++= Addition assignment.
+, Comma operator.
+- Subtraction.
+-- Auto-decrement.
+-= Subtraction assignment.
+-A Access time in days since script started.
+-B File is a non-text (binary) file.
+-C Inode change time in days since script started.
+-M Age in days since script started.
+-O File is owned by real uid.
+-R File is readable by real uid.
+-S File is a socket .
+-T File is a text file.
+-W File is writable by real uid.
+-X File is executable by real uid.
+-b File is a block special file.
+-c File is a character special file.
+-d File is a directory.
+-e File exists .
+-f File is a plain file.
+-g File has setgid bit set.
+-k File has sticky bit set.
+-l File is a symbolic link.
+-o File is owned by effective uid.
+-p File is a named pipe (FIFO).
+-r File is readable by effective uid.
+-s File has non-zero size.
+-t Tests if filehandle (STDIN by default) is opened to a tty.
+-u File has setuid bit set.
+-w File is writable by effective uid.
+-x File is executable by effective uid.
+-z File has zero size.
+. Concatenate strings.
+.. Alternation, also range operator.
+.= Concatenate assignment strings
+/ Division. /PATTERN/ioxsmg Pattern match
+/= Division assignment.
+/PATTERN/ioxsmg Pattern match.
+< Numeric less than. <pattern> Glob. See <NAME>, <> as well.
+<NAME> Reads line from filehandle NAME. NAME must be bareword/dollar-bareword.
+<pattern> Glob. (Unless pattern is bareword/dollar-bareword - see <NAME>)
+<> Reads line from union of files in @ARGV (= command line) and STDIN.
+<< Bitwise shift left. << start of HERE-DOCUMENT.
+<= Numeric less than or equal to.
+<=> Numeric compare.
+= Assignment.
+== Numeric equality.
+=~ Search pattern, substitution, or translation
+> Numeric greater than.
+>= Numeric greater than or equal to.
+>> Bitwise shift right.
+>>= Bitwise shift right assignment.
+? : Alternation (if-then-else) operator. ?PAT? Backwards pattern match.
+?PATTERN? Backwards pattern match.
+@ARGV Command line arguments (not including the command name - see $0).
+@INC List of places to look for perl scripts during do/include/use.
+@_ Parameter array for subroutines. Also used by split unless in array context.
+\\ Creates a reference to whatever follows, like \$var.
+\\0 Octal char, e.g. \\033.
+\\E Case modification terminator. See \\Q, \\L, and \\U.
+\\L Lowercase until \\E .
+\\U Upcase until \\E .
+\\Q Quote metacharacters until \\E .
+\\a Alarm character (octal 007).
+\\b Backspace character (octal 010).
+\\c Control character, e.g. \\c[ .
+\\e Escape character (octal 033).
+\\f Formfeed character (octal 014).
+\\l Lowercase of next character. See also \\L and \\u,
+\\n Newline character (octal 012).
+\\r Return character (octal 015).
+\\t Tab character (octal 011).
+\\u Upcase of next character. See also \\U and \\l,
+\\x Hex character, e.g. \\x1b.
+^ Bitwise exclusive or.
+__END__ End of program source.
+__DATA__ End of program source.
+__FILE__ Current (source) filename.
+__LINE__ Current line in current source.
+ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
+ARGVOUT Output filehandle with -i flag.
+BEGIN { block } Immediately executed (during compilation) piece of code.
+END { block } Pseudo-subroutine executed after the script finishes.
+DATA Input filehandle for what follows after __END__ or __DATA__.
+accept(NEWSOCKET,GENERICSOCKET)
+alarm(SECONDS)
+atan2(X,Y)
+bind(SOCKET,NAME)
+binmode(FILEHANDLE)
+caller[(LEVEL)]
+chdir(EXPR)
+chmod(LIST)
+chop[(LIST|VAR)]
+chown(LIST)
+chroot(FILENAME)
+close(FILEHANDLE)
+closedir(DIRHANDLE)
+cmp String compare.
+connect(SOCKET,NAME)
+continue of { block } continue { block }. Is executed after `next' or at end.
+cos(EXPR)
+crypt(PLAINTEXT,SALT)
+dbmclose(ASSOC_ARRAY)
+dbmopen(ASSOC,DBNAME,MODE)
+defined(EXPR)
+delete($ASSOC{KEY})
+die(LIST)
+do { ... }|SUBR while|until EXPR executes at least once
+do(EXPR|SUBR([LIST]))
+dump LABEL
+each(ASSOC_ARRAY)
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof[([FILEHANDLE])]
+eq String equality.
+eval(EXPR) or eval { BLOCK }
+exec(LIST)
+exit(EXPR)
+exp(EXPR)
+fcntl(FILEHANDLE,FUNCTION,SCALAR)
+fileno(FILEHANDLE)
+flock(FILEHANDLE,OPERATION)
+for (EXPR;EXPR;EXPR) { ... }
+foreach [VAR] (@ARRAY) { ... }
+fork
+ge String greater than or equal.
+getc[(FILEHANDLE)]
+getgrent
+getgrgid(GID)
+getgrnam(NAME)
+gethostbyaddr(ADDR,ADDRTYPE)
+gethostbyname(NAME)
+gethostent
+getlogin
+getnetbyaddr(ADDR,ADDRTYPE)
+getnetbyname(NAME)
+getnetent
+getpeername(SOCKET)
+getpgrp(PID)
+getppid
+getpriority(WHICH,WHO)
+getprotobyname(NAME)
+getprotobynumber(NUMBER)
+getprotoent
+getpwent
+getpwnam(NAME)
+getpwuid(UID)
+getservbyname(NAME,PROTO)
+getservbyport(PORT,PROTO)
+getservent
+getsockname(SOCKET)
+getsockopt(SOCKET,LEVEL,OPTNAME)
+gmtime(EXPR)
+goto LABEL
+grep(EXPR,LIST)
+gt String greater than.
+hex(EXPR)
+if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
+index(STR,SUBSTR[,OFFSET])
+int(EXPR)
+ioctl(FILEHANDLE,FUNCTION,SCALAR)
+join(EXPR,LIST)
+keys(ASSOC_ARRAY)
+kill(LIST)
+last [LABEL]
+le String less than or equal.
+length(EXPR)
+link(OLDFILE,NEWFILE)
+listen(SOCKET,QUEUESIZE)
+local(LIST)
+localtime(EXPR)
+log(EXPR)
+lstat(EXPR|FILEHANDLE|VAR)
+lt String less than.
+m/PATTERN/iogsmx
+mkdir(FILENAME,MODE)
+msgctl(ID,CMD,ARG)
+msgget(KEY,FLAGS)
+msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
+msgsnd(ID,MSG,FLAGS)
+my VAR or my (VAR1,...) Introduces a lexical variable ($VAR, @ARR, or %HASH).
+ne String inequality.
+next [LABEL]
+oct(EXPR)
+open(FILEHANDLE[,EXPR])
+opendir(DIRHANDLE,EXPR)
+ord(EXPR)
+pack(TEMPLATE,LIST)
+package Introduces package context.
+pipe(READHANDLE,WRITEHANDLE)
+pop(ARRAY)
+print [FILEHANDLE] [(LIST)]
+printf [FILEHANDLE] (FORMAT,LIST)
+push(ARRAY,LIST)
+q/STRING/ Synonym for 'STRING'
+qq/STRING/ Synonym for \"STRING\"
+qx/STRING/ Synonym for `STRING`
+rand[(EXPR)]
+read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+readdir(DIRHANDLE)
+readlink(EXPR)
+recv(SOCKET,SCALAR,LEN,FLAGS)
+redo [LABEL]
+rename(OLDNAME,NEWNAME)
+require [FILENAME | PERL_VERSION]
+reset[(EXPR)]
+return(LIST)
+reverse(LIST)
+rewinddir(DIRHANDLE)
+rindex(STR,SUBSTR[,OFFSET])
+rmdir(FILENAME)
+s/PATTERN/REPLACEMENT/gieoxsm
+scalar(EXPR)
+seek(FILEHANDLE,POSITION,WHENCE)
+seekdir(DIRHANDLE,POS)
+select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT)
+semctl(ID,SEMNUM,CMD,ARG)
+semget(KEY,NSEMS,SIZE,FLAGS)
+semop(KEY,...)
+send(SOCKET,MSG,FLAGS[,TO])
+setgrent
+sethostent(STAYOPEN)
+setnetent(STAYOPEN)
+setpgrp(PID,PGRP)
+setpriority(WHICH,WHO,PRIORITY)
+setprotoent(STAYOPEN)
+setpwent
+setservent(STAYOPEN)
+setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)
+shift[(ARRAY)]
+shmctl(ID,CMD,ARG)
+shmget(KEY,SIZE,FLAGS)
+shmread(ID,VAR,POS,SIZE)
+shmwrite(ID,STRING,POS,SIZE)
+shutdown(SOCKET,HOW)
+sin(EXPR)
+sleep[(EXPR)]
+socket(SOCKET,DOMAIN,TYPE,PROTOCOL)
+socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)
+sort [SUBROUTINE] (LIST)
+splice(ARRAY,OFFSET[,LENGTH[,LIST]])
+split[(/PATTERN/[,EXPR[,LIMIT]])]
+sprintf(FORMAT,LIST)
+sqrt(EXPR)
+srand(EXPR)
+stat(EXPR|FILEHANDLE|VAR)
+study[(SCALAR)]
+sub [NAME [(format)]] { BODY } or sub [NAME [(format)]];
+substr(EXPR,OFFSET[,LEN])
+symlink(OLDFILE,NEWFILE)
+syscall(LIST)
+sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+system(LIST)
+syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+tell[(FILEHANDLE)]
+telldir(DIRHANDLE)
+time
+times
+tr/SEARCHLIST/REPLACEMENTLIST/cds
+truncate(FILE|EXPR,LENGTH)
+umask[(EXPR)]
+undef[(EXPR)]
+unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
+unlink(LIST)
+unpack(TEMPLATE,EXPR)
+unshift(ARRAY,LIST)
+until (EXPR) { ... } or EXPR until EXPR
+utime(LIST)
+values(ASSOC_ARRAY)
+vec(EXPR,OFFSET,BITS)
+wait
+waitpid(PID,FLAGS)
+wantarray
+warn(LIST)
+while (EXPR) { ... } or EXPR while EXPR
+write[(EXPR|FILEHANDLE)]
+x Repeat string or array.
+x= Repetition assignment.
+y/SEARCHLIST/REPLACEMENTLIST/