From: Jonathan Rockway <jon@jrock.us>
To: emacs-devel@gnu.org
Subject: path: cperl-mode.el support for Perl 5.10
Date: Tue, 22 Jan 2008 16:46:53 -0600 [thread overview]
Message-ID: <1201042013.8106.15.camel@bar.jrock.us> (raw)
[-- Attachment #1.1.1: Type: text/plain, Size: 793 bytes --]
Hi all,
I recently patched cperl-mode.el so that it supports new Perl 5.10
keywords, namely "given/when/default/break", "say", "UNITCHECK", and
"state". I have a few other patches brewing, which I rambled about on
my website (http://blog.jrock.us/articles/Emacs%20and%20Perl%
205.10.pod); basically some refactoring to make the regexes more
readable, support for adding your syntax via customize (now that it's
easy to add syntax to Perl with Devel::Declare), and perhaps splitting
the mode into separate files (cperl-syntax, cperl-refactor, etc.) for
ease of maintainability (opening a 10000 line file can be scary :).
Also, I haven't heard from Ilya recently... if he's no longer
maintaining cperl-mode, I don't have any problem taking over.
Regards,
Jonathan Rockway
[-- Attachment #1.1.2: cperl-patch --]
[-- Type: text/x-patch, Size: 16153 bytes --]
*** /home/jon/tmp/emacs/lisp/progmodes/cperl-mode.el 2008-01-22 14:46:32.000000000 -0600
--- /home/jon/cperl-mode-latest.el 2008-01-22 16:36:09.000000000 -0600
***************
*** 3914,3920 ****
(progn
(forward-sexp -2)
(not
! (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
(and (not (match-beginning 6)) ; Empty
--- 3914,3920 ----
(progn
(forward-sexp -2)
(not
! (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
(and (not (match-beginning 6)) ; Empty
***************
*** 4101,4107 ****
(not (memq (preceding-char)
'(?$ ?@ ?& ?%)))
(looking-at
! "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))))
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
--- 4101,4107 ----
(not (memq (preceding-char)
'(?$ ?@ ?& ?%)))
(looking-at
! "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>")))))
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
***************
*** 4793,4799 ****
(save-excursion
(forward-sexp -1)
;; else {} but not else::func {}
! (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
(not (looking-at "\\(\\sw\\|_\\)+::")))
;; sub f {}
(progn
--- 4793,4799 ----
(save-excursion
(forward-sexp -1)
;; else {} but not else::func {}
! (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|UNITCHECK\\|CHECK\\|INIT\\)\\>")
(not (looking-at "\\(\\sw\\|_\\)+::")))
;; sub f {}
(progn
***************
*** 4917,4923 ****
(forward-sexp -1)
(not
(looking-at
! "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>")))))))
\f
(defun cperl-indent-exp ()
--- 4917,4923 ----
(forward-sexp -1)
(not
(looking-at
! "\\(map\\|grep\\|say\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>")))))))
\f
(defun cperl-indent-exp ()
***************
*** 4953,4965 ****
(if (eq (following-char) ?$ ) ; for my $var (list)
(progn
(forward-sexp -1)
! (if (looking-at "\\(my\\|local\\|our\\)\\>")
(forward-sexp -1))))
(if (looking-at
(concat "\\(\\elsif\\|if\\|unless\\|while\\|until"
"\\|for\\(each\\)?\\>\\(\\("
cperl-maybe-white-and-comment-rex
! "\\(my\\|local\\|our\\)\\)?"
cperl-maybe-white-and-comment-rex
"\\$[_a-zA-Z0-9]+\\)?\\)\\>"))
(progn
--- 4953,4965 ----
(if (eq (following-char) ?$ ) ; for my $var (list)
(progn
(forward-sexp -1)
! (if (looking-at "\\(state\\|my\\|local\\|our\\)\\>")
(forward-sexp -1))))
(if (looking-at
(concat "\\(\\elsif\\|if\\|unless\\|while\\|until"
"\\|for\\(each\\)?\\>\\(\\("
cperl-maybe-white-and-comment-rex
! "\\(state\\|my\\|local\\|our\\)\\)?"
cperl-maybe-white-and-comment-rex
"\\$[_a-zA-Z0-9]+\\)?\\)\\>"))
(progn
***************
*** 5048,5054 ****
;; Looking at:
;; foreach my $var
(if (looking-at
! "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")
(progn
(forward-word 2)
(delete-horizontal-space)
--- 5048,5054 ----
;; Looking at:
;; foreach my $var
(if (looking-at
! "[ \t]*\\<for\\(each\\)?[ \t]+\\(state\\|my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]")
(progn
(forward-word 2)
(delete-horizontal-space)
***************
*** 5057,5063 ****
;; Looking at:
;; foreach my $var (
(if (looking-at
! "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
(progn
(forward-sexp 3)
(delete-horizontal-space)
--- 5057,5063 ----
;; Looking at:
;; foreach my $var (
(if (looking-at
! "[ \t]*\\<for\\(each\\)?[ \t]+\\(state\\|my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
(progn
(forward-sexp 3)
(delete-horizontal-space)
***************
*** 5067,5073 ****
;; Looking at (with or without "}" at start, ending after "({"):
;; } foreach my $var () OR {
(if (looking-at
! "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
(progn
(setq ml (match-beginning 8)) ; "(" or "{" after control word
(re-search-forward "[({]")
--- 5067,5073 ----
;; Looking at (with or without "}" at start, ending after "({"):
;; } foreach my $var () OR {
(if (looking-at
! "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
(progn
(setq ml (match-beginning 8)) ; "(" or "{" after control word
(re-search-forward "[({]")
***************
*** 5632,5641 ****
"\\(^\\|[^$@%&\\]\\)\\<\\("
(mapconcat
'identity
! '("if" "until" "while" "elsif" "else" "unless" "for"
"foreach" "continue" "exit" "die" "last" "goto" "next"
! "redo" "return" "local" "exec" "sub" "do" "dump" "use" "our"
! "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
"\\|") ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
; In what follows we use `type' style
--- 5632,5645 ----
"\\(^\\|[^$@%&\\]\\)\\<\\("
(mapconcat
'identity
! '("if" "until" "while" "elsif" "else"
! "given" "when" "default" "break"
! "unless" "for"
"foreach" "continue" "exit" "die" "last" "goto" "next"
! "redo" "return" "local" "exec" "sub" "do" "dump"
! "use" "our"
! "require" "package" "eval" "my" "state"
! "BEGIN" "END" "CHECK" "INIT" "UNITCHECK")
"\\|") ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
; In what follows we use `type' style
***************
*** 5714,5737 ****
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
! ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "__END__" "chomp"
! ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
! ;; "eval" "exists" "for" "foreach" "format" "goto"
;; "grep" "if" "keys" "last" "local" "map" "my" "next"
;; "no" "our" "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\\|CHECK\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
"o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
! "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
"l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
"p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
! "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
! "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
"u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
! "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
"\\)\\>") 2 'cperl-nonoverridable-face)
;; (mapconcat 'identity
--- 5718,5741 ----
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
! ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK" "__END__" "chomp"
! ;; "break" "chop" "default" "defined" "delete" "do" "each" "else" "elsif"
! ;; "eval" "exists" "for" "foreach" "format" "given" "goto"
;; "grep" "if" "keys" "last" "local" "map" "my" "next"
;; "no" "our" "package" "pop" "pos" "print" "printf" "push"
! ;; "q" "qq" "qw" "qx" "redo" "return" "say" "scalar" "shift"
! ;; "sort" "splice" "split" "state" "study" "sub" "tie" "tr"
;; "undef" "unless" "unshift" "untie" "until" "use"
! ;; "when" "while" "y"
! "AUTOLOAD\\|BEGIN\\|\\(UNIT\\)?CHECK\\|break\\|cho\\(p\\|mp\\)\\|d\\(e\\(f\\(ault|ined\\)\\|lete\\)\\|"
"o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
! "END\\|for\\(\\|each\\|mat\\)\\|g\\(iven\\|rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
"l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
"p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
! "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(ay\\|pli\\(ce\\|t\\)\\|"
! "calar\\|t\\(ate\\|udy\\)\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
"u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
! "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
"\\)\\>") 2 'cperl-nonoverridable-face)
;; (mapconcat 'identity
***************
*** 5785,5798 ****
font-lock-string-face t)
'("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
font-lock-constant-face) ; labels
! '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
2 font-lock-constant-face)
;; Uncomment to get perl-mode-like vars
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
;;; (2 (cons font-lock-variable-name-face '(underline))))
(cond ((featurep 'font-lock-extra)
! '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
(3 font-lock-variable-name-face)
(4 '(another 4 nil
("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
--- 5789,5802 ----
font-lock-string-face t)
'("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
font-lock-constant-face) ; labels
! '("\\<\\(continue\\|next\\|last\\|redo\\|break\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
2 font-lock-constant-face)
;; Uncomment to get perl-mode-like vars
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
;;; (2 (cons font-lock-variable-name-face '(underline))))
(cond ((featurep 'font-lock-extra)
! '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
(3 font-lock-variable-name-face)
(4 '(another 4 nil
("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
***************
*** 5801,5807 ****
nil t))) ; local variables, multiple
(font-lock-anchored
;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
! `(,(concat "\\<\\(my\\|local\\|our\\)"
cperl-maybe-white-and-comment-rex
"\\(("
cperl-maybe-white-and-comment-rex
--- 5805,5811 ----
nil t))) ; local variables, multiple
(font-lock-anchored
;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
! `(,(concat "\\<\\(state\\|my\\|local\\|our\\)"
cperl-maybe-white-and-comment-rex
"\\(("
cperl-maybe-white-and-comment-rex
***************
*** 5849,5857 ****
'syntax-type 'multiline))
(setq cperl-font-lock-multiline-start nil)))
(3 font-lock-variable-name-face))))
! (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
3 font-lock-variable-name-face)))
! '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
4 font-lock-variable-name-face)
;; Avoid $!, and s!!, qq!! etc. when not fontifying syntaxically
'("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
--- 5853,5861 ----
'syntax-type 'multiline))
(setq cperl-font-lock-multiline-start nil)))
(3 font-lock-variable-name-face))))
! (t '("^[ \t{}]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
3 font-lock-variable-name-face)))
! '("\\<for\\(each\\)?\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
4 font-lock-variable-name-face)
;; Avoid $!, and s!!, qq!! etc. when not fontifying syntaxically
'("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
***************
*** 7294,7299 ****
--- 7298,7304 ----
"\\$." ; $|
"<<[a-zA-Z_'\"`]" ; <<FOO, <<'FOO'
"||"
+ "//"
"&&"
"[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
"-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value
***************
*** 7634,7639 ****
--- 7639,7645 ----
... = ... Assignment.
... == ... Numeric equality.
... =~ ... Search pattern, substitution, or translation
+ ... ~~ .. Smart match
... > ... Numeric greater than.
... >= ... Numeric greater than or equal to.
... >> ... Bitwise shift right.
***************
*** 7671,7676 ****
--- 7677,7683 ----
BEGIN { ... } Immediately executed (during compilation) piece of code.
END { ... } Pseudo-subroutine executed after the script finishes.
CHECK { ... } Pseudo-subroutine executed after the script is compiled.
+ UNITCHECK { ... }
INIT { ... } Pseudo-subroutine executed before the script starts running.
DATA Input filehandle for what follows after __END__ or __DATA__.
accept(NEWSOCKET,GENERICSOCKET)
***************
*** 7678,7683 ****
--- 7685,7691 ----
atan2(X,Y)
bind(SOCKET,NAME)
binmode(FILEHANDLE)
+ break Break out of a given/when statement
caller[(LEVEL)]
chdir(EXPR)
chmod(LIST)
***************
*** 7693,7698 ****
--- 7701,7707 ----
crypt(PLAINTEXT,SALT)
dbmclose(%HASH)
dbmopen(%HASH,DBNAME,MODE)
+ default { ... } default case for given/when block
defined(EXPR)
delete($HASH{KEY})
die(LIST)
***************
*** 7745,7750 ****
--- 7754,7760 ----
getservent
getsockname(SOCKET)
getsockopt(SOCKET,LEVEL,OPTNAME)
+ given (EXPR) { [ when (EXPR) { ... } ]+ [ default { ... } ]? }
gmtime(EXPR)
goto LABEL
... gt ... String greater than.
***************
*** 7805,7810 ****
--- 7815,7821 ----
rindex(STR,SUBSTR[,OFFSET])
rmdir(FILENAME)
s/PATTERN/REPLACEMENT/gieoxsm
+ say [FILEHANDLE] [(LIST)]
scalar(EXPR)
seek(FILEHANDLE,POSITION,WHENCE)
seekdir(DIRHANDLE,POS)
***************
*** 7839,7844 ****
--- 7850,7856 ----
sqrt(EXPR)
srand(EXPR)
stat(EXPR|FILEHANDLE|VAR)
+ state VAR or state (VAR1,...) Introduces a static lexical variable
study[(SCALAR)]
sub [NAME [(format)]] { BODY } sub NAME [(format)]; sub [(format)] {...}
substr(EXPR,OFFSET[,LEN])
***************
*** 7874,7879 ****
--- 7886,7892 ----
y/SEARCHLIST/REPLACEMENTLIST/
... | ... Bitwise or.
... || ... Logical or.
+ ... // ... Defined-or.
~ ... Unary bitwise complement.
#! OS interpreter indicator. If contains `perl', used for options, and -x.
AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'.
[-- Attachment #1.2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 189 bytes --]
[-- Attachment #2: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
next reply other threads:[~2008-01-22 22:46 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-01-22 22:46 Jonathan Rockway [this message]
2008-01-23 6:00 ` path: cperl-mode.el support for Perl 5.10 Stephen J. Turnbull
2008-01-23 21:40 ` Richard Stallman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1201042013.8106.15.camel@bar.jrock.us \
--to=jon@jrock.us \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).