[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el |
|
Date: |
Tue, 20 Nov 2001 09:20:12 -0500 |
Index: emacs/lisp/progmodes/cperl-mode.el
diff -u emacs/lisp/progmodes/cperl-mode.el:1.24
emacs/lisp/progmodes/cperl-mode.el:1.25
--- emacs/lisp/progmodes/cperl-mode.el:1.24 Mon Jul 16 08:22:59 2001
+++ emacs/lisp/progmodes/cperl-mode.el Fri Oct 12 14:11:06 2001
@@ -235,6 +235,12 @@
:type 'boolean
:group 'cperl-autoinsert-details)
+(defcustom cperl-autoindent-on-semi nil
+ "*Non-nil means automatically indent after insertion of (semi)colon.
+Active if `cperl-auto-newline' is false."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
+
(defcustom cperl-auto-newline-after-colon nil
"*Non-nil means automatically newline even after colons.
Subject to `cperl-auto-newline' setting."
@@ -379,12 +385,27 @@
:type 'boolean
:group 'cperl-faces)
+(defcustom cperl-highlight-variables-indiscriminately nil
+ "*Non-nil means perform additional highlighting on variables.
+Currently only changes how scalar variables are highlighted.
+Note that that variable is only read at initialization time for
+the variable `cperl-font-lock-keywords-2', so changing it after you've
+entered `cperl-mode' the first time will have no effect."
+ :type 'boolean
+ :group 'cperl)
+
(defcustom cperl-pod-here-scan t
"*Not-nil means look for pod and here-docs sections during startup.
You can always make lookup from menu or using \\[cperl-find-pods-heres]."
:type 'boolean
:group 'cperl-speed)
+(defcustom cperl-regexp-scan t
+ "*Not-nil means make marking of regular expression more thorough.
+Effective only with `cperl-pod-here-scan'. Not implemented yet."
+ :type 'boolean
+ :group 'cperl-speed)
+
(defcustom cperl-imenu-addback nil
"*Not-nil means add backreferences to generated `imenu's.
May require patched `imenu' and `imenu-go'. Obsolete."
@@ -482,11 +503,17 @@
:type 'boolean
:group 'cperl-indentation-details)
-(defcustom cperl-syntaxify-by-font-lock
- (and window-system
+(defcustom cperl-indent-parens-as-block nil
+ "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks,
+but for trailing \",\" inside the group, which won't increase indentation.
+One should tune up `cperl-close-paren-offset' as well."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
+(defcustom cperl-syntaxify-by-font-lock
+ (and window-system
(boundp 'parse-sexp-lookup-properties))
- "*Non-nil means that CPerl uses `font-lock's routines for syntaxification.
-Having it TRUE may be not completely debugged yet."
+ "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
@@ -631,16 +658,22 @@
install choose-color.el, available from
ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/
+`fill-paragraph' on a comment may leave the point behind the
+paragraph. Parsing of lines with several <<EOF is not implemented
+yet.
+
Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
20.1. Most problems below are corrected starting from this version of
-Emacs, and all of them should go with (future) RMS's version 20.3.
+Emacs, and all of them should go with RMS's version 20.3. (Or apply
+patches to Emacs 19.33/34 - see tips.) XEmacs is very backward in
+this respect.
+
+Note that even with newer Emacsen in some very rare cases the details
+of interaction of `font-lock' and syntaxification may be not cleaned
+up yet. You may get slightly different colors basing on the order of
+fontification and syntaxification. Say, the initial faces is correct,
+but editing the buffer breaks this.
-Note that even with newer Emacsen interaction of `font-lock' and
-syntaxification is not cleaned up. You may get slightly different
-colors basing on the order of fontification and syntaxification. This
-might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but
-the corresponding code is still extremely buggy.
-
Even with older Emacsen CPerl mode tries to corrects some Emacs
misunderstandings, however, for efficiency reasons the degree of
correction is different for different operations. The partially
@@ -702,7 +735,7 @@
By similar reasons
s\"abc\"def\";
-would confuse CPerl a lot.
+could confuse CPerl a lot.
If you still get wrong indentation in situation that you think the
code should be able to parse, try:
@@ -788,8 +821,10 @@
B if A;
n) Highlights (by user-choice) either 3-delimiters constructs
- (such as tr/a/b/), or regular expressions and `y/tr'.
- o) Highlights trailing whitespace.
+ (such as tr/a/b/), or regular expressions and `y/tr';
+ o) Highlights trailing whitespace;
+ p) Is able to manipulate Perl Regular Expressions to ease
+ conversion to a more readable form.
5) The indentation engine was very smart, but most of tricks may be
not needed anymore with the support for `syntax-table' property. Has
@@ -1103,12 +1138,16 @@
["Fill paragraph/comment" cperl-fill-paragraph t]
"----"
["Line up a construction" cperl-lineup (cperl-use-region-p)]
- ["Invert if/unless/while/until" cperl-invert-if-unless t]
+ ["Invert if/unless/while etc" cperl-invert-if-unless t]
("Regexp"
["Beautify" cperl-beautify-regexp
cperl-use-syntax-table-text-property]
+ ["Beautify one level deep" (cperl-beautify-regexp 1)
+ cperl-use-syntax-table-text-property]
["Beautify a group" cperl-beautify-level
cperl-use-syntax-table-text-property]
+ ["Beautify a group one level deep" (cperl-beautify-level 1)
+ cperl-use-syntax-table-text-property]
["Contract a group" cperl-contract-level
cperl-use-syntax-table-text-property]
["Contract groups" cperl-contract-levels
@@ -1439,6 +1478,10 @@
("formy" "formy" cperl-electric-keyword 0)
("foreachmy" "foreachmy" cperl-electric-keyword 0)
("do" "do" cperl-electric-keyword 0)
+ ("=pod" "=pod" cperl-electric-pod 0)
+ ("=over" "=over" cperl-electric-pod 0)
+ ("=head1" "=head1" cperl-electric-pod 0)
+ ("=head2" "=head2" cperl-electric-pod 0)
("pod" "pod" cperl-electric-pod 0)
("over" "over" cperl-electric-pod 0)
("head1" "head1" cperl-electric-pod 0)
@@ -1447,6 +1490,11 @@
(setq local-abbrev-table cperl-mode-abbrev-table)
(abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
(set-syntax-table cperl-mode-syntax-table)
+ (make-local-variable 'outline-regexp)
+ ;; (setq outline-regexp imenu-example--function-name-regexp-perl)
+ (setq outline-regexp cperl-outline-regexp)
+ (make-local-variable 'outline-level)
+ (setq outline-level 'cperl-outline-level)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat "^$\\|" page-delimiter))
(make-local-variable 'paragraph-separate)
@@ -1910,21 +1958,22 @@
(memq this-command '(self-insert-command newline))))
head1 notlast name p really-delete over)
(and (save-excursion
- (condition-case nil
- (backward-sexp 1)
- (error nil))
- (and
+ (forward-word -1)
+ (and
(eq (preceding-char) ?=)
(progn
- (setq head1 (looking-at "head1\\>"))
- (setq over (looking-at "over\\>"))
+ (setq head1 (looking-at "head1\\>[ \t]*$"))
+ (setq over (and (looking-at "over\\>[ \t]*$")
+ (not (looking-at "over[ \t]*\n\n\n*=item\\>"))))
(forward-char -1)
(bolp))
(or
(get-text-property (point) 'in-pod)
(cperl-after-expr-p nil "{;:")
(and (re-search-backward
- "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t)
+ ;; "\\(\\`\n?\\|\n\n\\)=\\sw+"
+ "\\(\\`\n?\\|^\n\\)=\\sw+"
+ (point-min) t)
(not (or
(looking-at "=cut")
(and cperl-use-syntax-table-text-property
@@ -1932,20 +1981,20 @@
'pod)))))))))
(progn
(save-excursion
- (setq notlast (search-forward "\n\n=" nil t)))
+ (setq notlast (re-search-forward "^\n=" nil t)))
(or notlast
(progn
(insert "\n\n=cut")
(cperl-ensure-newlines 2)
- (forward-sexp -2)
- (if (and head1
- (not
+ (forward-word -2)
+ (if (and head1
+ (not
(save-excursion
(forward-char -1)
(re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"
nil t)))) ; Only one
- (progn
- (forward-sexp 1)
+ (progn
+ (forward-word 1)
(setq name (file-name-sans-extension
(file-name-nondirectory (buffer-file-name)))
p (point))
@@ -1954,10 +2003,10 @@
"=head1 DESCRIPTION")
(cperl-ensure-newlines 4)
(goto-char p)
- (forward-sexp 2)
+ (forward-word 2)
(end-of-line)
(setq really-delete t))
- (forward-sexp 1))))
+ (forward-word 1))))
(if over
(progn
(setq p (point))
@@ -1965,7 +2014,7 @@
"=back")
(cperl-ensure-newlines 2)
(goto-char p)
- (forward-sexp 1)
+ (forward-word 1)
(end-of-line)
(setq really-delete t)))
(if (and delete really-delete)
@@ -2034,6 +2083,7 @@
; Leave the level of parens
(looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr
; Are at end
+ (cperl-after-block-p (point-min))
(progn
(backward-sexp 1)
(setq start (point-marker))
@@ -2121,7 +2171,9 @@
(interactive "P")
(if cperl-auto-newline
(cperl-electric-terminator arg)
- (self-insert-command (prefix-numeric-value arg))))
+ (self-insert-command (prefix-numeric-value arg))
+ (if cperl-autoindent-on-semi
+ (cperl-indent-line))))
(defun cperl-electric-terminator (arg)
"Insert character and correct line's indentation."
@@ -2360,8 +2412,9 @@
and closing parentheses and brackets.."
(save-excursion
(if (or
- (memq (get-text-property (point) 'syntax-type)
- '(pod here-doc here-doc-delim format))
+ (and (memq (get-text-property (point) 'syntax-type)
+ '(pod here-doc here-doc-delim format))
+ (not (get-text-property (point) 'indentable)))
;; before start of POD - whitespace found since do not have 'pod!
(and (looking-at "[ \t]*\n=")
(error "Spaces before pod section!"))
@@ -2375,7 +2428,7 @@
(following-char)))
(in-pod (get-text-property (point) 'in-pod))
(pre-indent-point (point))
- p prop look-prop)
+ p prop look-prop is-block delim)
(cond
(in-pod
;; In the verbatim part, probably code example. What to do???
@@ -2412,48 +2465,18 @@
(setcar (cddr parse-data) start))
;; Before this point: end of statement
(setq old-indent (nth 3 parse-data))))
- ;; (or parse-start (null symbol)
- ;; (setq parse-start (symbol-value symbol)
- ;; start-indent (nth 2 parse-start)
- ;; parse-start (car parse-start)))
- ;; (if parse-start
- ;; (goto-char parse-start)
- ;; (beginning-of-defun))
- ;; ;; Try to go out
- ;; (while (< (point) indent-point)
- ;; (setq start (point) parse-start start moved nil
- ;; state (parse-partial-sexp start indent-point -1))
- ;; (if (> (car state) -1) nil
- ;; ;; The current line could start like }}}, so the indentation
- ;; ;; corresponds to a different level than what we reached
- ;; (setq moved t)
- ;; (beginning-of-line 2))) ; Go to the next line.
- ;; (if start ; Not at the start of
file
- ;; (progn
- ;; (goto-char start)
- ;; (setq start-indent (current-indentation))
- ;; (if moved ; Should correct...
- ;; (setq start-indent (- start-indent
cperl-indent-level))))
- ;; (setq start-indent 0))
- ;; (if (< (point) indent-point) (setq parse-start (point)))
- ;; (or state (setq state (parse-partial-sexp
- ;; (point) indent-point -1 nil start-state)))
- ;; (setq containing-sexp
- ;; (or (car (cdr state))
- ;; (and (>= (nth 6 state) 0) old-containing-sexp))
- ;; old-containing-sexp nil start-state nil)
-;;;; (while (< (point) indent-point)
-;;;; (setq parse-start (point))
-;;;; (setq state (parse-partial-sexp (point) indent-point -1 nil
start-state))
-;;;; (setq containing-sexp
-;;;; (or (car (cdr state))
-;;;; (and (>= (nth 6 state) 0) old-containing-sexp))
-;;;; old-containing-sexp nil start-state nil))
- ;; (if symbol (set symbol (list indent-point state start-indent)))
- ;; (goto-char indent-point)
- (cond ((or (nth 3 state) (nth 4 state))
+ (cond ((get-text-property (point) 'indentable)
+ ;; indent to just after the surrounding open,
+ ;; skip blanks if we do not close the expression.
+ (goto-char (1+ (previous-single-property-change (point)
'indentable)))
+ (or (memq char-after (append ")]}" nil))
+ (looking-at "[ \t]*\\(#\\|$\\)")
+ (skip-chars-forward " \t"))
+ (current-column))
+ ((or (nth 3 state) (nth 4 state))
;; return nil or t if should not change this line
(nth 4 state))
+ ;; XXXX Do we need to special-case this?
((null containing-sexp)
;; Line is at top level. May be data or function definition,
;; or may be function argument declaration.
@@ -2492,9 +2515,15 @@
(list pre-indent-point)))
0)
cperl-continued-statement-offset))))
- ((/= (char-after containing-sexp) ?{)
- ;; line is expression, not statement:
- ;; indent to just after the surrounding open,
+ ((not
+ (or (setq is-block
+ (and (setq delim (= (char-after containing-sexp) ?{))
+ (save-excursion ; Is it a hash?
+ (goto-char containing-sexp)
+ (cperl-block-p))))
+ cperl-indent-parens-as-block))
+ ;; group is an expression, not a block:
+ ;; indent to just after the surrounding open parens,
;; skip blanks if we do not close the expression.
(goto-char (1+ containing-sexp))
(or (memq char-after (append ")]}" nil))
@@ -2506,13 +2535,39 @@
(goto-char containing-sexp)
(not (cperl-block-p)))
(goto-char (1+ containing-sexp))
- (or (eq char-after ?\})
+ (or (memq char-after
+ (append (if delim "}" ")]}") nil))
(looking-at "[ \t]*\\(#\\|$\\)")
(skip-chars-forward " \t"))
- (+ (current-column) ; Correct indentation of trailing ?\}
- (if (eq char-after ?\}) (+ cperl-indent-level
- cperl-close-paren-offset)
+ (+ (current-column)
+ (if (and delim
+ (eq char-after ?\}))
+ ;; Correct indentation of trailing ?\}
+ (+ cperl-indent-level cperl-close-paren-offset)
0)))
+;;; ((and (/= (char-after containing-sexp) ?{)
+;;; (not cperl-indent-parens-as-block))
+;;; ;; line is expression, not statement:
+;;; ;; indent to just after the surrounding open,
+;;; ;; skip blanks if we do not close the expression.
+;;; (goto-char (1+ containing-sexp))
+;;; (or (memq char-after (append ")]}" nil))
+;;; (looking-at "[ \t]*\\(#\\|$\\)")
+;;; (skip-chars-forward " \t"))
+;;; (current-column))
+;;; ((progn
+;;; ;; Containing-expr starts with \{. Check whether it is a hash.
+;;; (goto-char containing-sexp)
+;;; (and (not (cperl-block-p))
+;;; (not cperl-indent-parens-as-block)))
+;;; (goto-char (1+ containing-sexp))
+;;; (or (eq char-after ?\})
+;;; (looking-at "[ \t]*\\(#\\|$\\)")
+;;; (skip-chars-forward " \t"))
+;;; (+ (current-column) ; Correct indentation of trailing ?\}
+;;; (if (eq char-after ?\}) (+ cperl-indent-level
+;;; cperl-close-paren-offset)
+;;; 0)))
(t
;; Statement level. Is it a continuation or a new statement?
;; Find previous non-comment character.
@@ -2534,11 +2589,12 @@
(beginning-of-line)
(cperl-backward-to-noncomment containing-sexp))
;; Now we get the answer.
- ;; Had \?, too:
- (if (not (or (memq (preceding-char) (append " ;{" '(nil)))
+ (if (not (or (eq (1- (point)) containing-sexp)
+ (memq (preceding-char)
+ (append (if is-block " ;{" " ,;{") '(nil)))
(and (eq (preceding-char) ?\})
- (cperl-after-block-and-statement-beg
- containing-sexp)))) ; Was ?\,
+ (cperl-after-block-and-statement-beg
+ containing-sexp))))
;; This line is continuation of preceding line's statement;
;; indent `cperl-continued-statement-offset' more than the
;; previous line of the statement.
@@ -2550,6 +2606,12 @@
(+ (if (memq char-after (append "}])" nil))
0 ; Closing parenth
cperl-continued-statement-offset)
+ (if (or is-block
+ (not delim)
+ (not (eq char-after ?\})))
+ 0
+ ;; Now it is a hash reference
+ (+ cperl-indent-level cperl-close-paren-offset))
(if (looking-at "\\w+[ \t]*:")
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
@@ -2605,6 +2667,12 @@
(+ (if (and (bolp) (zerop cperl-indent-level))
(+ cperl-brace-offset cperl-continued-statement-offset)
cperl-indent-level)
+ (if (or is-block
+ (not delim)
+ (not (eq char-after ?\})))
+ 0
+ ;; Now it is a hash reference
+ (+ cperl-indent-level cperl-close-paren-offset))
;; Move back over whitespace before the openbrace.
;; If openbrace is not first nonwhite thing on the line,
;; add the cperl-brace-imaginary-offset.
@@ -2892,8 +2960,11 @@
nil
;; We suppose that e is _after_ the end of construction, as after eol.
(setq string (if string cperl-st-sfence cperl-st-cfence))
- (cperl-modify-syntax-type bb string)
- (cperl-modify-syntax-type (1- e) string)
+ (if (> bb (- e 2))
+ ;; one-char string/comment?!
+ (cperl-modify-syntax-type bb cperl-st-punct)
+ (cperl-modify-syntax-type bb string)
+ (cperl-modify-syntax-type (1- e) string))
(if (and (eq string cperl-st-sfence) (> (- e 2) bb))
(put-text-property (1+ bb) (1- e)
'syntax-table cperl-string-syntax-table))
@@ -2903,6 +2974,7 @@
(not cperl-pod-here-fontify)
(put-text-property bb e 'face (if string 'font-lock-string-face
'font-lock-comment-face)))))
+
(defvar cperl-starters '(( ?\( . ?\) )
( ?\[ . ?\] )
( ?\{ . ?\} )
@@ -2912,7 +2984,7 @@
&optional ostart oend)
;; Works *before* syntax recognition is done
;; May modify syntax-type text property if the situation is too hard
- (let (b starter ender st i i2 go-forward)
+ (let (b starter ender st i i2 go-forward reset-st)
(skip-chars-forward " \t")
;; ender means matching-char matcher.
(setq b (point)
@@ -2945,9 +3017,13 @@
(not ender))
;; $ has TeXish matching rules, so $$ equiv $...
(forward-char 2)
+ (setq reset-st (syntax-table))
(set-syntax-table st)
(forward-sexp 1)
- (set-syntax-table cperl-mode-syntax-table)
+ (if (<= (point) (1+ b))
+ (error "Unfinished regular expression"))
+ (set-syntax-table reset-st)
+ (setq reset-st nil)
;; Now the problem is with m;blah;;
(and (not ender)
(eq (preceding-char)
@@ -2984,6 +3060,8 @@
ender (nth 2 ender)))))
(error (goto-char lim)
(setq set-st nil)
+ (if reset-st
+ (set-syntax-table reset-st))
(or end
(message
"End of `%s%s%c ... %c' string/RE not found: %s"
@@ -3022,6 +3100,7 @@
;; After-initial-line--to-end is marked `syntax-type' ==> `format'
;; d) 'Q'uoted string:
;; part between markers inclusive is marked `syntax-type' ==>
`string'
+;; part between `q' and the first marker is marked `syntax-type'
==> `prestring'
(defun cperl-unwind-to-safe (before &optional end)
;; if BEFORE, go to the previous start-of-line on each step of unwinding
@@ -3038,6 +3117,11 @@
(goto-char (setq pos (cperl-1- pos))))
;; Up to the start
(goto-char (point-min))))
+ ;; Skip empty lines
+ (and (looking-at "\n*=")
+ (/= 0 (skip-chars-backward "\n"))
+ (forward-char))
+ (setq pos (point))
(if end
;; Do the same for end, going small steps
(progn
@@ -3046,6 +3130,10 @@
end (next-single-property-change end 'syntax-type)))
(or end pos)))))
+(defvar cperl-nonoverridable-face)
+(defvar font-lock-function-name-face)
+(defvar font-lock-comment-face)
+
(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
"Scans the buffer for hard-to-parse Perl constructions.
If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
@@ -3057,7 +3145,8 @@
cperl-syntax-done-to min))
(or max (setq max (point-max)))
(let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
- (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
+ is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2
+ (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
(modified (buffer-modified-p))
(after-change-functions nil)
@@ -3068,7 +3157,8 @@
(point-min)))
(state (if use-syntax-state
(cdr cperl-syntax-state)))
- (st-l '(nil)) (err-l '(nil)) i2
+ ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates
from a function call to a function call!
+ (st-l (list nil)) (err-l (list nil))
;; Somehow font-lock may be not loaded yet...
(font-lock-string-face (if (boundp 'font-lock-string-face)
font-lock-string-face
@@ -3080,7 +3170,11 @@
(if (boundp 'font-lock-function-name-face)
font-lock-function-name-face
'font-lock-function-name-face))
- (cperl-nonoverridable-face
+ (font-lock-comment-face
+ (if (boundp 'font-lock-comment-face)
+ font-lock-comment-face
+ 'font-lock-comment-face))
+ (cperl-nonoverridable-face
(if (boundp 'cperl-nonoverridable-face)
cperl-nonoverridable-face
'cperl-nonoverridable-face))
@@ -3089,13 +3183,14 @@
max))
(search
(concat
- "\\(\\`\n?\\|\n\n\\)="
+ "\\(\\`\n?\\|^\n\\)="
"\\|"
;; One extra () before this:
"<<"
"\\(" ; 1 + 1
;; First variant "BLAH" or just ``.
- "\\([\"'`]\\)" ; 2 + 1
+ "[ \t]*" ; Yes, whitespace is allowed!
+ "\\([\"'`]\\)" ; 2 + 1 = 3
"\\([^\"'`\n]*\\)" ; 3 + 1
"\\3"
"\\|"
@@ -3127,7 +3222,10 @@
"\\(\\<sub[ \t\n\f]+\\|[&address@hidden)[a-zA-Z0-9_]*'"
;; 1+6+2+1+1+2+1+1=15 extra () before this:
"\\|"
- "__\\(END\\|DATA\\)__" ; Commented - does not help with
indent...
+ "__\\(END\\|DATA\\)__"
+ ;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
+ "\\|"
+ "\\\\\\(['`\"]\\)"
)
""))))
(unwind-protect
@@ -3142,7 +3240,10 @@
here-face cperl-here-face))
(remove-text-properties min max
'(syntax-type t in-pod t syntax-table t
- cperl-postpone t))
+ cperl-postpone t
+ syntax-subtype t
+ rear-nonsticky t
+ indentable t))
;; Need to remove face as well...
(goto-char min)
(and (eq system-type 'emx)
@@ -3156,8 +3257,8 @@
(setq tmpend nil) ; Valid for most cases
(cond
((match-beginning 1) ; POD section
- ;; "\\(\\`\n?\\|\n\n\\)="
- (if (looking-at "\n*cut\\>")
+ ;; "\\(\\`\n?\\|^\n\\)="
+ (if (looking-at "cut\\>")
(if ignore-max
nil ; Doing a chunk only
(message "=cut is not preceded by a POD section")
@@ -3170,24 +3271,27 @@
b1 nil) ; error condition
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
- (or (re-search-forward "\n\n=cut\\>" stop-point 'toend)
+ (or (re-search-forward "^\n=cut\\>" stop-point 'toend)
(progn
- (message "End of a POD section not marked by =cut")
- (setq b1 t)
- (or (car err-l) (setcar err-l b))))
+ (goto-char b)
+ (if (re-search-forward "\n=cut\\>" stop-point 'toend)
+ (progn
+ (message "=cut is not preceded by an empty line")
+ (setq b1 t)
+ (or (car err-l) (setcar err-l b))))))
(beginning-of-line 2) ; An empty line after =cut is not POD!
(setq e (point))
- (if (and b1 (eobp))
- ;; Unrecoverable error
- nil
(and (> e max)
- (progn
- (remove-text-properties
- max e '(syntax-type t in-pod t syntax-table t
- 'cperl-postpone t))
- (setq tmpend tb)))
+ (progn
+ (remove-text-properties
+ max e '(syntax-type t in-pod t syntax-table t
+ cperl-postpone t
+ syntax-subtype t
+ rear-nonsticky t
+ indentable t))
+ (setq tmpend tb)))
(put-text-property b e 'in-pod t)
- (put-text-property b e 'syntax-type 'in-pod)
+ (put-text-property b e 'syntax-type 'in-pod)
(goto-char b)
(while (re-search-forward "\n\n[ \t]" e t)
;; We start 'pod 1 char earlier to include the preceding
line
@@ -3212,19 +3316,19 @@
;; mark the headers
(cperl-postpone-fontification
(match-beginning 1) (match-end 1)
- 'face head-face))
- (while (re-search-forward
- ;; One paragraph
- "\n\n=[a-zA-Z0-9_]+\\>[
\t]*\\(\\(\n?[^\n]\\)+\\)$"
- e 'toend)
- ;; mark the headers
- (cperl-postpone-fontification
+ 'face head-face))
+ (while (re-search-forward
+ ;; One paragraph
+ "^\n=[a-zA-Z0-9_]+\\>[
\t]*\\(\\(\n?[^\n]\\)+\\)$"
+ e 'toend)
+ ;; mark the headers
+ (cperl-postpone-fontification
(match-beginning 1) (match-end 1)
'face head-face))))
(cperl-commentify bb e nil)
(goto-char e)
(or (eq e (point-max))
- (forward-char -1))))) ; Prepare for immediate pod start.
+ (forward-char -1)))) ; Prepare for immediate pod start.
;; Here document
;; We do only one here-per-line
;; ;; One extra () before this:
@@ -3359,19 +3463,19 @@
bb (char-after (1- (match-beginning b1))) ; tmp holder
;; bb == "Not a stringy"
bb (if (eq b1 10) ; user variables/whatever
- (or
- (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
- (and (eq bb ?-) (eq c ?s)) ; -s file test
- (and (eq bb ?\&) ; &&m/blah/
- (not (eq (char-after
- (- (match-beginning b1) 2))
+ (or
+ (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
+ (and (eq bb ?-) (eq c ?s)) ; -s file test
+ (and (eq bb ?\&)
+ (not (eq (char-after ; &&m/blah/
+ (- (match-beginning b1) 2))
?\&))))
;; <file> or <$file>
(and (eq c ?\<)
- ;; Do not stringify <FH> :
+ ;; Do not stringify <FH>, <$fh> :
(save-match-data
(looking-at
- "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s
*\\)?>"))))
+ "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>"))))
tb (match-beginning 0))
(goto-char (match-beginning b1))
(cperl-backward-to-noncomment (point-min))
@@ -3393,8 +3497,8 @@
(and (eq (char-syntax (preceding-char))
?w)
(progn
(forward-sexp -1)
-;;; After these keywords `/' starts a RE. One should add all the
-;;; functions/builtins which expect an argument, but ...
+;; After these keywords `/' starts a RE. One should add all the
+;; functions/builtins which expect an argument, but ...
(if (eq (preceding-char) ?-)
;; -d ?foo? is a RE
(looking-at "[a-zA-Z]\\>")
@@ -3427,9 +3531,12 @@
(goto-char b)
(if (or bb (nth 3 state) (nth 4 state))
(goto-char i)
+ ;; Skip whitespace and comments...
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
(goto-char (match-end 0))
(skip-chars-forward " \t\n\f"))
+ (if (> (point) b)
+ (put-text-property b (point) 'syntax-type 'prestring))
;; qtag means two-arg matcher, may be reset to
;; 2 or 3 later if some special quoting is needed.
;; e1 means matching-char matcher.
@@ -3452,16 +3559,23 @@
tail (if (and i (not tag))
(1- e1))
e (if i i e1) ; end of the first part
- qtag nil) ; need to preserve backslashitis
+ qtag nil ; need to preserve backslashitis
+ is-x-REx nil) ; REx has //x modifier
;; Commenting \\ is dangerous, what about ( ?
(and i tail
(eq (char-after i) ?\\)
(setq qtag t))
+ (if (looking-at "\\sw*x") ; qr//x
+ (setq is-x-REx t))
(if (null i)
;; Considered as 1arg form
(progn
(cperl-commentify b (point) t)
(put-text-property b (point) 'syntax-type 'string)
+ (if (or is-x-REx
+ ;; ignore other text properties:
+ (string-match "^qw$" argument))
+ (put-text-property b (point) 'indentable t))
(and go
(setq e1 (cperl-1+ e1))
(or (eobp)
@@ -3478,9 +3592,13 @@
(progn
(cperl-modify-syntax-type (1- (point))
cperl-st-ket)
(cperl-modify-syntax-type i cperl-st-bra)))
- (put-text-property b i 'syntax-type 'string))
+ (put-text-property b i 'syntax-type 'string)
+ (if is-x-REx
+ (put-text-property b i 'indentable t)))
(cperl-commentify b1 (point) t)
(put-text-property b (point) 'syntax-type 'string)
+ (if is-x-REx
+ (put-text-property b i 'indentable t))
(if qtag
(cperl-modify-syntax-type (1+ i) cperl-st-punct))
(setq tail nil)))
@@ -3489,13 +3607,16 @@
(progn
(forward-word 1) ; skip modifiers s///s
(if tail (cperl-commentify tail (point) t))
- (cperl-postpone-fontification
- e1 (point) 'face cperl-nonoverridable-face)))
+ (cperl-postpone-fontification
+ e1 (point) 'face 'cperl-nonoverridable-face)))
;; Check whether it is m// which means "previous match"
;; and highlight differently
- (if (and (eq e (+ 2 b))
- (string-match "^\\([sm]?\\|qr\\)$" argument)
- ;; <> is already filtered out
+ (setq is-REx
+ (and (string-match "^\\([sm]?\\|qr\\)$" argument)
+ (or (not (= (length argument) 0))
+ (not (eq c ?\<)))))
+ (if (and is-REx
+ (eq e (+ 2 b))
;; split // *is* using zero-pattern
(save-excursion
(condition-case nil
@@ -3516,7 +3637,56 @@
(cperl-postpone-fontification
b (cperl-1+ b) 'face font-lock-constant-face)
(cperl-postpone-fontification
- (1- e) e 'face font-lock-constant-face))))
+ (1- e) e 'face font-lock-constant-face)))
+ (if (and is-REx cperl-regexp-scan)
+ ;; Process RExen better
+ (save-excursion
+ (goto-char (1+ b))
+ (while
+ (and (< (point) e)
+ (re-search-forward
+ (if is-x-REx
+ (if (eq (char-after b) ?\#)
+ "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
+ "\\((\\?#\\)\\|\\(#\\)")
+ (if (eq (char-after b) ?\#)
+ "\\((\\?\\\\#\\)"
+ "\\((\\?#\\)"))
+ (1- e) 'to-end))
+ (goto-char (match-beginning 0))
+ (setq REx-comment-start (point)
+ was-comment t)
+ (if (save-excursion
+ (and
+ ;; XXX not working if outside delimiter is #
+ (eq (preceding-char) ?\\)
+ (= (% (skip-chars-backward "$\\\\") 2) -1)))
+ ;; Not a comment, avoid loop:
+ (progn (setq was-comment nil)
+ (forward-char 1))
+ (if (match-beginning 2)
+ (progn
+ (beginning-of-line 2)
+ (if (> (point) e)
+ (goto-char (1- e))))
+ ;; Works also if the outside delimiters are ().
+ (or (search-forward ")" (1- e) 'toend)
+ (message
+ "Couldn't find end of (?#...)-comment in a
REx, pos=%s"
+ REx-comment-start))))
+ (if (>= (point) e)
+ (goto-char (1- e)))
+ (if was-comment
+ (progn
+ (setq REx-comment-end (point))
+ (cperl-commentify
+ REx-comment-start REx-comment-end nil)
+ (cperl-postpone-fontification
+ REx-comment-start REx-comment-end
+ 'face font-lock-comment-face))))))
+ (if (and is-REx is-x-REx)
+ (put-text-property (1+ b) (1- e)
+ 'syntax-subtype 'x-REx)))
(if i2
(progn
(cperl-postpone-fontification
@@ -3569,7 +3739,7 @@
(goto-char bb))
;; 1+6+2+1+1+2+1+1=15 extra () before this:
;; "__\\(END\\|DATA\\)__"
- (t ; __END__, __DATA__
+ ((match-beginning 16) ; __END__, __DATA__
(setq bb (match-end 0)
b (match-beginning 0)
state (parse-partial-sexp
@@ -3580,7 +3750,21 @@
;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
(cperl-commentify b bb nil)
(setq end t))
- (goto-char bb)))
+ (goto-char bb))
+ ((match-beginning 17) ; "\\\\\\(['`\"]\\)"
+ (setq bb (match-end 0)
+ b (match-beginning 0))
+ (goto-char b)
+ (skip-chars-backward "\\\\")
+ ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1))
+ (setq state (parse-partial-sexp
+ state-point b nil nil state)
+ state-point b)
+ (if (or (nth 3 state) (nth 4 state) )
+ nil
+ (cperl-modify-syntax-type b cperl-st-punct))
+ (goto-char bb))
+ (t (error "Error in regexp of the sniffer")))
(if (> (point) stop-point)
(progn
(if end
@@ -3629,7 +3813,7 @@
(if (eq (char-syntax (preceding-char)) ?w) ; else {}
(save-excursion
(forward-sexp -1)
- (or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\)\\>")
+ (or (looking-at
"\\(else\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
;; sub f {}
(progn
(cperl-backward-to-noncomment lim)
@@ -3784,8 +3968,8 @@
(beginning-of-line)))
;; Looking at:
;; foreach my $var
- (if (looking-at
- "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)\\(\t*\\|[ \t][
\t]+\\)[^ \t\n]")
+ (if (looking-at
+ "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][
\t]+\\)[^ \t\n]")
(progn
(forward-word 2)
(delete-horizontal-space)
@@ -3793,8 +3977,8 @@
(beginning-of-line)))
;; Looking at:
;; foreach my $var (
- (if (looking-at
- "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)[
\t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
+ (if (looking-at
+ "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[
\t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
(progn
(forward-word 3)
(delete-horizontal-space)
@@ -3803,8 +3987,8 @@
(beginning-of-line)))
;; Looking at:
;; } foreach my $var () {
- (if (looking-at
- "[ \t]*\\(}[
\t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([
t]+\\(my\\|local\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[
\t\n]*{\\)\\|[ \t]*{")
+ (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))
(re-search-forward "[({]")
@@ -4145,12 +4329,13 @@
(let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
(index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
(index-meth-alist '()) meth
- packages ends-ranges p
+ packages ends-ranges p marker
(prev-pos 0) char fchar index index1 name (end-range 0) package)
(goto-char (point-min))
(if noninteractive
(message "Scanning Perl for index")
(imenu-progress-message prev-pos 0))
+ (cperl-update-syntaxification (point-max) (point-max))
;; Search for the function
(progn ;;save-match-data
(while (re-search-forward
@@ -4167,7 +4352,7 @@
nil)
((and
(match-beginning 2) ; package or sub
- ;; Skip if quoted (will not skip multi-line ''-comments :-():
+ ;; Skip if quoted (will not skip multi-line ''-strings :-():
(null (get-text-property (match-beginning 1) 'syntax-table))
(null (get-text-property (match-beginning 1) 'syntax-type))
(null (get-text-property (match-beginning 1) 'in-pod)))
@@ -4177,7 +4362,7 @@
)
;; (if (looking-at "([^()]*)[ \t\n\f]*")
;; (goto-char (match-end 0))) ; Messes what follows
- (setq char (following-char)
+ (setq char (following-char) ; ?\; for "sub foo () ;"
meth nil
p (point))
(while (and ends-ranges (>= p (car ends-ranges)))
@@ -4200,17 +4385,19 @@
;; )
;; Skip this function name if it is a prototype declaration.
(if (and (eq fchar ?s) (eq char ?\;)) nil
- (setq index (imenu-example--name-and-position))
- (if (eq fchar ?p) nil
- (setq name (buffer-substring (match-beginning 3) (match-end 3)))
- (set-text-properties 0 (length name) nil name)
+ (setq name (buffer-substring (match-beginning 3) (match-end 3))
+ marker (make-marker))
+ (set-text-properties 0 (length name) nil name)
+ (set-marker marker (match-end 3))
+ (if (eq fchar ?p)
+ (setq name (concat "package " name))
(cond ((string-match "[:']" name)
(setq meth t))
((> p end-range) nil)
(t
(setq name (concat package name) meth t))))
- (setcar index name)
- (if (eq fchar ?p)
+ (setq index (cons name marker))
+ (if (eq fchar ?p)
(push index index-pack-alist)
(push index index-alist))
(if meth (push index index-meth-alist))
@@ -4282,8 +4469,27 @@
(nreverse index-unsorted-alist))
index-alist))
(cperl-imenu-addback index-alist)))
+
+
+(defvar cperl-outline-regexp
+ (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`"))
-(defvar cperl-compilation-error-regexp-alist
+;; Suggested by Mark A. Hershberger
+(defun cperl-outline-level ()
+ (looking-at outline-regexp)
+ (cond ((not (match-beginning 1)) 0) ; beginning-of-file
+ ((match-beginning 2)
+ (if (eq (char-after (match-beginning 2)) ?p)
+ 0 ; package
+ 1)) ; sub
+ ((match-beginning 5)
+ (if (eq (char-after (match-beginning 5)) ?1)
+ 1 ; head1
+ 2)) ; head2
+ (t 3))) ; should not happen
+
+
+(defvar cperl-compilation-error-regexp-alist
;; This look like a paranoiac regexp: could anybody find a better one?
(which WORK).
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
2 3))
@@ -4361,7 +4567,7 @@
'("if" "until" "while" "elsif" "else" "unless" "for"
"foreach" "continue" "exit" "die" "last" "goto" "next"
"redo" "return" "local" "exec" "sub" "do" "dump" "use"
- "require" "package" "eval" "my" "BEGIN" "END")
+ "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
"\\|") ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
; In what follows we use `type' style
@@ -4398,7 +4604,7 @@
;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
;; "shutdown" "sin" "sleep" "socket" "socketpair"
;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
- ;; "syscall" "sysread" "system" "syswrite" "tell"
+ ;; "syscall" "sysopen" "sysread" "system" "syswrite" "tell"
;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
;; "umask" "unlink" "unpack" "utime" "values" "vec"
;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
@@ -4427,7 +4633,7 @@
"\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
"ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
"m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
- "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|tem\\|write\\)\\|"
+
"write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\)\\|"
"mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
"ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
"time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
@@ -4440,7 +4646,7 @@
(list
(concat
"\\(^\\|address@hidden&\\]\\)\\<\\("
- ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp"
+ ;; "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"
@@ -4449,10 +4655,10 @@
;; "sort" "splice" "split" "study" "sub" "tie" "tr"
;; "undef" "unless" "unshift" "untie" "until" "use"
;; "while" "y"
- "AUTOLOAD\\|BEGIN\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
+
"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\\)\\|if\\|keys\\|"
- "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|"
+
"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\\)\\|"
@@ -4490,8 +4696,12 @@
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)
+ ;;; '("\\(address@hidden|\\$#\\)\\(\\sw+\\)"
+ ;;; (2 (cons font-lock-variable-name-face '(underline))))
(cond ((featurep 'font-lock-extra)
- '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)\\([ \t]*,\\)?"
+ '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)\\([ \t]*,\\)?"
(3 font-lock-variable-name-face)
(4 '(another 4 nil
("\\=[ \t]*,[ \t]*\\(address@hidden:]+\\)\\([
\t]*,\\)?"
@@ -4499,16 +4709,16 @@
(2 '(restart 2 nil) nil t)))
nil t))) ; local variables, multiple
(font-lock-anchored
- '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)"
+ '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)"
(3 font-lock-variable-name-face)
("\\=[ \t]*,[ \t]*\\(address@hidden:]+\\)"
nil nil
(1 font-lock-variable-name-face))))
- (t '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)"
+ (t '("^[ \t{}]*\\(my\\|local\\our\\)[ \t]*\\(([
\t]*\\)?\\(address@hidden:]+\\)"
3 font-lock-variable-name-face)))
- '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
- 2 font-lock-variable-name-face)))
- (setq
+ '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[
\t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
+ 4 font-lock-variable-name-face)))
+ (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
@@ -4534,15 +4744,20 @@
;; (if (cperl-slash-is-regexp)
;; font-lock-function-name-face 'default) nil t))
)))
- (setq cperl-font-lock-keywords-1
+ (if cperl-highlight-variables-indiscriminately
+ (setq t-font-lock-keywords-1
+ (append t-font-lock-keywords-1
+ (list '("[$*]{?\\(\\sw+\\)" 1
+ font-lock-variable-name-face)))))
+ (setq cperl-font-lock-keywords-1
(if cperl-syntaxify-by-font-lock
(cons 'cperl-fontify-update
t-font-lock-keywords)
t-font-lock-keywords)
cperl-font-lock-keywords cperl-font-lock-keywords-1
cperl-font-lock-keywords-2 (append
- cperl-font-lock-keywords-1
- t-font-lock-keywords-1)))
+ cperl-font-lock-keywords-1
+ t-font-lock-keywords-1)))
(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
(if (or (featurep 'choose-color) (featurep 'font-lock-extra))
(eval ; Avoid a warning
@@ -5333,19 +5548,29 @@
(imenu-progress-message prev-pos 100))
index-alist))
-(defun cperl-find-tags (file xs topdir)
+(defvar cperl-unreadable-ok nil)
+
+(defun cperl-find-tags (ifile xs topdir)
(let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel
- (cperl-pod-here-fontify nil))
+ (cperl-pod-here-fontify nil) f file)
(save-excursion
(if b (set-buffer b)
(cperl-setup-tmp-buf))
(erase-buffer)
- (setq file (car (insert-file-contents file)))
+ (condition-case err
+ (setq file (car (insert-file-contents ifile)))
+ (error (if cperl-unreadable-ok nil
+ (if (y-or-n-p
+ (format "File %s unreadable. Continue? " ifile))
+ (setq cperl-unreadable-ok t)
+ (error "Aborting: unreadable file %s" ifile)))))
+ (if (not file)
+ (message "Unreadable file %s" ifile)
(message "Scanning file %s ..." file)
(if (and cperl-use-syntax-table-text-property-for-tags
(not xs))
(condition-case err ; after __END__ may have garbage
- (cperl-find-pods-heres)
+ (cperl-find-pods-heres nil nil noninteractive)
(error (message "While scanning for syntax: %s" err))))
(if xs
(setq lst (cperl-xsub-scan))
@@ -5362,8 +5587,8 @@
(point)
(1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
(buffer-substring (progn
- (skip-chars-forward
- ":_a-zA-Z0-9")
+ (goto-char (cdr elt))
+ ;; After name now...
(or (eolp) (forward-char 1))
(point))
(progn
@@ -5406,7 +5631,7 @@
(erase-buffer)
(or noninteractive
(message "Scanning file %s finished" file))
- ret)))
+ ret))))
(defun cperl-add-tags-recurse-noxs ()
"Add to TAGS data for Perl and XSUB files in the current directory and kids.
@@ -5435,7 +5660,7 @@
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
(case-fold-search (eq system-type 'emx))
- xs rel)
+ xs rel tm)
(save-excursion
(cond (inbuffer nil) ; Already there
((file-exists-p tags-file-name)
@@ -5449,10 +5674,18 @@
(erase
(erase-buffer)
(setq erase 'ignore)))
- (let ((files
- (directory-files file t
- (if recurse nil cperl-scan-files-regexp)
- t)))
+ (let ((files
+ (condition-case err
+ (directory-files file t
+ (if recurse nil cperl-scan-files-regexp)
+ t)
+ (error
+ (if cperl-unreadable-ok nil
+ (if (y-or-n-p
+ (format "Directory %s unreadable. Continue? " file))
+ (setq cperl-unreadable-ok t
+ tm nil) ; Return empty list
+ (error "Aborting: unreadable directory %s" file)))))))
(mapcar (function (lambda (file)
(cond
((string-match cperl-noscan-files-regexp file)
@@ -6129,6 +6362,8 @@
ARGVOUT Output filehandle with -i flag.
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.
+INIT { ... } Pseudo-subroutine executed before the script starts running.
DATA Input filehandle for what follows after __END__ or __DATA__.
accept(NEWSOCKET,GENERICSOCKET)
alarm(SECONDS)
@@ -6230,6 +6465,7 @@
msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
msgsnd(ID,MSG,FLAGS)
my VAR or my (VAR1,...) Introduces a lexical variable ($VAR, @ARR, or
%HASH).
+our VAR or our (VAR1,...) Lexically enable a global variable ($V, @A, or %H).
... ne ... String inequality.
next [LABEL]
oct(EXPR)
@@ -6398,14 +6634,18 @@
'variable-documentation))
(setq buffer-read-only t)))))
-(defun cperl-beautify-regexp-piece (b e embed)
+(defun cperl-beautify-regexp-piece (b e embed level)
;; b is before the starting delimiter, e before the ending
;; e should be a marker, may be changed, but remains "correct".
- (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code)
+ ;; EMBED is nil iff we process the whole REx.
+ ;; The REx is guarantied to have //x
+ ;; LEVEL shows how many levels deep to go
+ ;; position at enter and at leave is not defined
+ (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos)
(if (not embed)
(goto-char (1+ b))
(goto-char b)
- (cond ((looking-at "(\\?\\\\#") ; badly commented (?#)
+ (cond ((looking-at "(\\?\\\\#") ; (?#) wrongly commented when //x-ing
(forward-char 2)
(delete-char 1)
(forward-char 1))
@@ -6423,8 +6663,9 @@
(goto-char e)
(beginning-of-line)
(if (re-search-forward "[^ \t]" e t)
- (progn
+ (progn ; Something before the ending delimiter
(goto-char e)
+ (delete-horizontal-space)
(insert "\n")
(indent-to-column c)
(set-marker e (point))))
@@ -6467,17 +6708,27 @@
(setq tmp (point))
(if (looking-at "\\^?\\]")
(goto-char (match-end 0)))
- (or (re-search-forward "\\]\\([*+{?]\\)?" e t)
+ ;; XXXX POSIX classes?!
+ (while (and (not pos)
+ (re-search-forward "\\[:\\|\\]" e t))
+ (if (eq (preceding-char) ?:)
+ (or (re-search-forward ":\\]" e t)
+ (error "[:POSIX:]-group in []-group not terminated"))
+ (setq pos t)))
+ (or (eq (preceding-char) ?\])
+ (error "[]-group not terminated"))
+ (if (eq (following-char) ?\{)
(progn
- (goto-char (1- tmp))
- (error "[]-group not terminated")))
- (if (not (eq (preceding-char) ?\{)) nil
- (forward-char -1)
- (forward-sexp 1)))
+ (forward-sexp 1)
+ (and (eq (following-char) ??)
+ (forward-char 1)))
+ (re-search-forward "\\=\\([*+?]\\??\\)" e t)))
((match-beginning 7) ; ()
(goto-char (match-beginning 0))
- (or (eq (current-column) c1)
+ (setq pos (current-column))
+ (or (eq pos c1)
(progn
+ (delete-horizontal-space)
(insert "\n")
(indent-to-column c1)))
(setq tmp (point))
@@ -6488,20 +6739,29 @@
;; (error "()-group not terminated")))
(set-marker m (1- (point)))
(set-marker m1 (point))
- (cond
- ((not (match-beginning 8))
- (cperl-beautify-regexp-piece tmp m t))
- ((eq (char-after (+ 2 tmp)) ?\{) ; Code
- t)
- ((eq (char-after (+ 2 tmp)) ?\() ; Conditional
- (goto-char (+ 2 tmp))
- (forward-sexp 1)
- (cperl-beautify-regexp-piece (point) m t))
- ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind
- (goto-char (+ 3 tmp))
- (cperl-beautify-regexp-piece (point) m t))
- (t
- (cperl-beautify-regexp-piece tmp m t)))
+ (if (= level 1)
+ (if (progn ; indent rigidly if multiline
+ ;; In fact does not make a lot of sense, since
+ ;; the starting position can be already lost due
+ ;; to insertion of "\n" and " "
+ (goto-char tmp)
+ (search-forward "\n" m1 t))
+ (indent-rigidly (point) m1 (- c1 pos)))
+ (setq level (1- level))
+ (cond
+ ((not (match-beginning 8))
+ (cperl-beautify-regexp-piece tmp m t level))
+ ((eq (char-after (+ 2 tmp)) ?\{) ; Code
+ t)
+ ((eq (char-after (+ 2 tmp)) ?\() ; Conditional
+ (goto-char (+ 2 tmp))
+ (forward-sexp 1)
+ (cperl-beautify-regexp-piece (point) m t level))
+ ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind
+ (goto-char (+ 3 tmp))
+ (cperl-beautify-regexp-piece (point) m t level))
+ (t
+ (cperl-beautify-regexp-piece tmp m t level))))
(goto-char m1)
(cond ((looking-at "[*+?]\\??")
(goto-char (match-end 0)))
@@ -6515,6 +6775,7 @@
(progn
(or (eolp) (indent-for-comment))
(beginning-of-line 2))
+ (delete-horizontal-space)
(insert "\n"))
(end-of-line)
(setq inline nil))
@@ -6525,6 +6786,7 @@
(if (re-search-forward "[^ \t]" tmp t)
(progn
(goto-char tmp)
+ (delete-horizontal-space)
(insert "\n"))
;; first at line
(delete-region (point) tmp))
@@ -6534,6 +6796,7 @@
(setq spaces nil)
(if (looking-at "[#\n]")
(beginning-of-line 2)
+ (delete-horizontal-space)
(insert "\n"))
(end-of-line)
(setq inline nil)))
@@ -6542,8 +6805,8 @@
(insert " "))
(skip-chars-forward " \t"))
(or (looking-at "[#\n]")
- (error "unknown code \"%s\" in a regexp" (buffer-substring (point)
- (1+
(point)))))
+ (error "unknown code \"%s\" in a regexp"
+ (buffer-substring (point) (1+ (point)))))
(and inline (end-of-line 2)))
;; Special-case the last line of group
(if (and (>= (point) (marker-position e))
@@ -6558,6 +6821,7 @@
(defun cperl-make-regexp-x ()
;; Returns position of the start
+ ;; XXX this is called too often! Need to cache the result!
(save-excursion
(or cperl-use-syntax-table-text-property
(error "I need to have a regexp marked!"))
@@ -6588,15 +6852,19 @@
(forward-char 1)))
b)))
-(defun cperl-beautify-regexp ()
+(defun cperl-beautify-regexp (&optional deep)
"do it. (Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
- (interactive)
- (goto-char (cperl-make-regexp-x))
- (let ((b (point)) (e (make-marker)))
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (cperl-beautify-regexp-piece b e nil)))
+ (interactive "P")
+ (if deep
+ (prefix-numeric-value deep)
+ (setq deep -1))
+ (save-excursion
+ (goto-char (cperl-make-regexp-x))
+ (let ((b (point)) (e (make-marker)))
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (cperl-beautify-regexp-piece b e nil deep))))
(defun cperl-regext-to-level-start ()
"Goto start of an enclosing group in regexp.
@@ -6618,15 +6886,16 @@
\(Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
(interactive)
- (cperl-regext-to-level-start)
- (let ((b (point)) (e (make-marker)) s c)
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (goto-char b)
- (while (re-search-forward "\\(#\\)\\|\n" e t)
- (cond
- ((match-beginning 1) ; #-comment
- (or c (setq c (current-indentation)))
+ ;; (save-excursion ; Can't, breaks `cperl-contract-levels'
+ (cperl-regext-to-level-start)
+ (let ((b (point)) (e (make-marker)) s c)
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (goto-char b)
+ (while (re-search-forward "\\(#\\)\\|\n" e 'to-end)
+ (cond
+ ((match-beginning 1) ; #-comment
+ (or c (setq c (current-indentation)))
(beginning-of-line 2) ; Skip
(setq s (point))
(skip-chars-forward " \t")
@@ -6641,9 +6910,10 @@
\(Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
(interactive)
- (condition-case nil
- (cperl-regext-to-level-start)
- (error ; We are outside outermost group
+ (save-excursion
+ (condition-case nil
+ (cperl-regext-to-level-start)
+ (error ; We are outside outermost group
(goto-char (cperl-make-regexp-x))))
(let ((b (point)) (e (make-marker)) s c)
(forward-sexp 1)
@@ -6651,28 +6921,32 @@
(goto-char (1+ b))
(while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t)
(cond
- ((match-beginning 1) ; Skip
- nil)
- (t ; Group
- (cperl-contract-level))))))
+ ((match-beginning 1) ; Skip
+ nil)
+ (t ; Group
+ (cperl-contract-level)))))))
-(defun cperl-beautify-level ()
+(defun cperl-beautify-level (&optional deep)
"Find an enclosing group in regexp and beautify it.
\(Experimental, may change semantics, recheck the result.)
We suppose that the regexp is scanned already."
- (interactive)
- (cperl-regext-to-level-start)
- (let ((b (point)) (e (make-marker)))
- (forward-sexp 1)
- (set-marker e (1- (point)))
- (cperl-beautify-regexp-piece b e nil)))
+ (interactive "P")
+ (if deep
+ (prefix-numeric-value deep)
+ (setq deep -1))
+ (save-excursion
+ (cperl-regext-to-level-start)
+ (let ((b (point)) (e (make-marker)))
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (cperl-beautify-regexp-piece b e nil deep))))
(defun cperl-invert-if-unless ()
- "Change `if (A) {B}' into `B if A;' if possible."
+ "Change `if (A) {B}' into `B if A;' etc if possible."
(interactive)
(or (looking-at "\\<")
(forward-sexp -1))
- (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\)\\>")
+ (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")
(let ((pos1 (point))
pos2 pos3 pos4 pos5 s1 s2 state p pos45
(s0 (buffer-substring (match-beginning 0) (match-end 0))))
@@ -6743,6 +7017,7 @@
(forward-word 1)
(setq pos1 (point))
(insert " " s1 ";")
+ (delete-horizontal-space)
(forward-char -1)
(delete-horizontal-space)
(goto-char pos1)
@@ -6750,7 +7025,7 @@
(cperl-indent-line))
(error "`%s' (EXPR) not with an {BLOCK}" s0)))
(error "`%s' not with an (EXPR)" s0)))
- (error "Not at `if', `unless', `while', or `unless'")))
+ (error "Not at `if', `unless', `while', `unless', `for' or `foreach'")))
;;; By Anthony Foiani <address@hidden>
;;; Getting help on modules in C-h f ?
@@ -6879,7 +7154,8 @@
(defvar cperl-d-l nil)
(defun cperl-fontify-syntaxically (end)
;; Some vars for debugging only
- (let (start (dbg (point)) (iend end)
+ ;; (message "Syntaxifying...")
+ (let (start (dbg (point)) (iend end)
(istate (car cperl-syntax-state)))
(and cperl-syntaxify-unwind
(setq end (cperl-unwind-to-safe t end)))
@@ -6896,12 +7172,6 @@
(and (> end start)
(setq cperl-syntax-done-to start) ; In case what follows fails
(cperl-find-pods-heres start end t nil t))
- ;;(setq cperl-d-l (cons (format "Syntaxifying %s..%s from %s to %s\n"
- ;; dbg end start cperl-syntax-done-to)
- ;; cperl-d-l))
- ;;(let ((standard-output (get-buffer "*Messages*")))
- ;;(princ (format "Syntaxifying %s..%s from %s to %s\n"
- ;; dbg end start cperl-syntax-done-to)))
(if (eq cperl-syntaxify-by-font-lock 'message)
(message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s"
dbg iend
@@ -6929,7 +7199,7 @@
(cperl-fontify-syntaxically to)))))
(defvar cperl-version
- (let ((v "Revision: 4.23"))
+ (let ((v "Revision: 4.32"))
(string-match ":\\s *\\([0-9.]+\\)" v)
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el,
Stefan Monnier <=