511 |
:type 'boolean |
:type 'boolean |
512 |
:group 'cperl-indentation-details) |
:group 'cperl-indentation-details) |
513 |
|
|
514 |
(defcustom cperl-syntaxify-by-font-lock |
(defcustom cperl-syntaxify-by-font-lock |
515 |
(and window-system |
(and window-system |
516 |
(boundp 'parse-sexp-lookup-properties)) |
(boundp 'parse-sexp-lookup-properties)) |
517 |
"*Non-nil means that CPerl uses `font-lock's routines for syntaxification." |
"*Non-nil means that CPerl uses `font-lock's routines for syntaxification." |
518 |
:type '(choice (const message) boolean) |
:type '(choice (const message) boolean) |
620 |
|
|
621 |
(defalias 'perl-mode 'cperl-mode) |
(defalias 'perl-mode 'cperl-mode) |
622 |
|
|
623 |
Get perl5-info from |
Get perl5-info from |
624 |
$CPAN/doc/manual/info/perl-info.tar.gz |
$CPAN/doc/manual/info/perl-info.tar.gz |
625 |
older version was on |
older version was on |
626 |
http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz |
http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz |
840 |
syntaxically to be not code |
syntaxically to be not code |
841 |
`font-lock-constant-face' HERE-doc delimiters, labels, delimiters of |
`font-lock-constant-face' HERE-doc delimiters, labels, delimiters of |
842 |
2-arg operators s/y/tr/ or of RExen, |
2-arg operators s/y/tr/ or of RExen, |
843 |
`font-lock-function-name-face' Special-cased m// and s//foo/, _ as |
`font-lock-function-name-face' Special-cased m// and s//foo/, _ as |
844 |
a target of a file tests, file tests, |
a target of a file tests, file tests, |
845 |
subroutine names at the moment of definition |
subroutine names at the moment of definition |
846 |
(except those conflicting with Perl operators), |
(except those conflicting with Perl operators), |
1910 |
head1 notlast name p really-delete over) |
head1 notlast name p really-delete over) |
1911 |
(and (save-excursion |
(and (save-excursion |
1912 |
(forward-word -1) |
(forward-word -1) |
1913 |
(and |
(and |
1914 |
(eq (preceding-char) ?=) |
(eq (preceding-char) ?=) |
1915 |
(progn |
(progn |
1916 |
(setq head1 (looking-at "head1\\>[ \t]*$")) |
(setq head1 (looking-at "head1\\>[ \t]*$")) |
1922 |
(get-text-property (point) 'in-pod) |
(get-text-property (point) 'in-pod) |
1923 |
(cperl-after-expr-p nil "{;:") |
(cperl-after-expr-p nil "{;:") |
1924 |
(and (re-search-backward |
(and (re-search-backward |
1925 |
;; "\\(\\`\n?\\|\n\n\\)=\\sw+" |
;; "\\(\\`\n?\\|\n\n\\)=\\sw+" |
1926 |
"\\(\\`\n?\\|^\n\\)=\\sw+" |
"\\(\\`\n?\\|^\n\\)=\\sw+" |
1927 |
(point-min) t) |
(point-min) t) |
1928 |
(not (or |
(not (or |
1929 |
(looking-at "=cut") |
(looking-at "=cut") |
1938 |
(insert "\n\n=cut") |
(insert "\n\n=cut") |
1939 |
(cperl-ensure-newlines 2) |
(cperl-ensure-newlines 2) |
1940 |
(forward-word -2) |
(forward-word -2) |
1941 |
(if (and head1 |
(if (and head1 |
1942 |
(not |
(not |
1943 |
(save-excursion |
(save-excursion |
1944 |
(forward-char -1) |
(forward-char -1) |
1945 |
(re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" |
(re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" |
1946 |
nil t)))) ; Only one |
nil t)))) ; Only one |
1947 |
(progn |
(progn |
1948 |
(forward-word 1) |
(forward-word 1) |
1949 |
(setq name (file-name-sans-extension |
(setq name (file-name-sans-extension |
1950 |
(file-name-nondirectory (buffer-file-name))) |
(file-name-nondirectory (buffer-file-name))) |
2466 |
(list pre-indent-point))) |
(list pre-indent-point))) |
2467 |
0) |
0) |
2468 |
cperl-continued-statement-offset)))) |
cperl-continued-statement-offset)))) |
2469 |
((not |
((not |
2470 |
(or (setq is-block |
(or (setq is-block |
2471 |
(and (setq delim (= (char-after containing-sexp) ?{)) |
(and (setq delim (= (char-after containing-sexp) ?{)) |
2472 |
(save-excursion ; Is it a hash? |
(save-excursion ; Is it a hash? |
2517 |
;;; (skip-chars-forward " \t")) |
;;; (skip-chars-forward " \t")) |
2518 |
;;; (+ (current-column) ; Correct indentation of trailing ?\} |
;;; (+ (current-column) ; Correct indentation of trailing ?\} |
2519 |
;;; (if (eq char-after ?\}) (+ cperl-indent-level |
;;; (if (eq char-after ?\}) (+ cperl-indent-level |
2520 |
;;; cperl-close-paren-offset) |
;;; cperl-close-paren-offset) |
2521 |
;;; 0))) |
;;; 0))) |
2522 |
(t |
(t |
2523 |
;; Statement level. Is it a continuation or a new statement? |
;; Statement level. Is it a continuation or a new statement? |
2544 |
(memq (preceding-char) |
(memq (preceding-char) |
2545 |
(append (if is-block " ;{" " ,;{") '(nil))) |
(append (if is-block " ;{" " ,;{") '(nil))) |
2546 |
(and (eq (preceding-char) ?\}) |
(and (eq (preceding-char) ?\}) |
2547 |
(cperl-after-block-and-statement-beg |
(cperl-after-block-and-statement-beg |
2548 |
containing-sexp)))) |
containing-sexp)))) |
2549 |
;; This line is continuation of preceding line's statement; |
;; This line is continuation of preceding line's statement; |
2550 |
;; indent `cperl-continued-statement-offset' more than the |
;; indent `cperl-continued-statement-offset' more than the |
2557 |
(+ (if (memq char-after (append "}])" nil)) |
(+ (if (memq char-after (append "}])" nil)) |
2558 |
0 ; Closing parenth |
0 ; Closing parenth |
2559 |
cperl-continued-statement-offset) |
cperl-continued-statement-offset) |
2560 |
(if (or is-block |
(if (or is-block |
2561 |
(not delim) |
(not delim) |
2562 |
(not (eq char-after ?\}))) |
(not (eq char-after ?\}))) |
2563 |
0 |
0 |
2618 |
(+ (if (and (bolp) (zerop cperl-indent-level)) |
(+ (if (and (bolp) (zerop cperl-indent-level)) |
2619 |
(+ cperl-brace-offset cperl-continued-statement-offset) |
(+ cperl-brace-offset cperl-continued-statement-offset) |
2620 |
cperl-indent-level) |
cperl-indent-level) |
2621 |
(if (or is-block |
(if (or is-block |
2622 |
(not delim) |
(not delim) |
2623 |
(not (eq char-after ?\}))) |
(not (eq char-after ?\}))) |
2624 |
0 |
0 |
3097 |
(or max (setq max (point-max))) |
(or max (setq max (point-max))) |
3098 |
(let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb |
(let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb |
3099 |
is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 |
is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 |
3100 |
(cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend |
(cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend |
3101 |
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) |
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) |
3102 |
(modified (buffer-modified-p)) |
(modified (buffer-modified-p)) |
3103 |
(after-change-functions nil) |
(after-change-functions nil) |
3121 |
(if (boundp 'font-lock-function-name-face) |
(if (boundp 'font-lock-function-name-face) |
3122 |
font-lock-function-name-face |
font-lock-function-name-face |
3123 |
'font-lock-function-name-face)) |
'font-lock-function-name-face)) |
3124 |
(font-lock-comment-face |
(font-lock-comment-face |
3125 |
(if (boundp 'font-lock-comment-face) |
(if (boundp 'font-lock-comment-face) |
3126 |
font-lock-comment-face |
font-lock-comment-face |
3127 |
'font-lock-comment-face)) |
'font-lock-comment-face)) |
3128 |
(cperl-nonoverridable-face |
(cperl-nonoverridable-face |
3129 |
(if (boundp 'cperl-nonoverridable-face) |
(if (boundp 'cperl-nonoverridable-face) |
3130 |
cperl-nonoverridable-face |
cperl-nonoverridable-face |
3131 |
'cperl-nonoverridable-face)) |
'cperl-nonoverridable-face)) |
3134 |
max)) |
max)) |
3135 |
(search |
(search |
3136 |
(concat |
(concat |
3137 |
"\\(\\`\n?\\|^\n\\)=" |
"\\(\\`\n?\\|^\n\\)=" |
3138 |
"\\|" |
"\\|" |
3139 |
;; One extra () before this: |
;; One extra () before this: |
3140 |
"<<" |
"<<" |
3208 |
(setq tmpend nil) ; Valid for most cases |
(setq tmpend nil) ; Valid for most cases |
3209 |
(cond |
(cond |
3210 |
((match-beginning 1) ; POD section |
((match-beginning 1) ; POD section |
3211 |
;; "\\(\\`\n?\\|^\n\\)=" |
;; "\\(\\`\n?\\|^\n\\)=" |
3212 |
(if (looking-at "cut\\>") |
(if (looking-at "cut\\>") |
3213 |
(if ignore-max |
(if ignore-max |
3214 |
nil ; Doing a chunk only |
nil ; Doing a chunk only |
3234 |
(setq e (point)) |
(setq e (point)) |
3235 |
(and (> e max) |
(and (> e max) |
3236 |
(progn |
(progn |
3237 |
(remove-text-properties |
(remove-text-properties |
3238 |
max e '(syntax-type t in-pod t syntax-table t |
max e '(syntax-type t in-pod t syntax-table t |
3239 |
cperl-postpone t |
cperl-postpone t |
3240 |
syntax-subtype t |
syntax-subtype t |
3250 |
(put-text-property (cperl-1- b) (point) 'syntax-type 'pod) |
(put-text-property (cperl-1- b) (point) 'syntax-type 'pod) |
3251 |
(cperl-put-do-not-fontify b (point) t) |
(cperl-put-do-not-fontify b (point) t) |
3252 |
;; mark the non-literal parts as PODs |
;; mark the non-literal parts as PODs |
3253 |
(if cperl-pod-here-fontify |
(if cperl-pod-here-fontify |
3254 |
(cperl-postpone-fontification b (point) 'face face t)) |
(cperl-postpone-fontification b (point) 'face face t)) |
3255 |
(re-search-forward "\n\n[^ \t\f\n]" e 'toend) |
(re-search-forward "\n\n[^ \t\f\n]" e 'toend) |
3256 |
(beginning-of-line) |
(beginning-of-line) |
3257 |
(setq b (point))) |
(setq b (point))) |
3258 |
(put-text-property (cperl-1- (point)) e 'syntax-type 'pod) |
(put-text-property (cperl-1- (point)) e 'syntax-type 'pod) |
3259 |
(cperl-put-do-not-fontify (point) e t) |
(cperl-put-do-not-fontify (point) e t) |
3260 |
(if cperl-pod-here-fontify |
(if cperl-pod-here-fontify |
3261 |
(progn |
(progn |
3262 |
;; mark the non-literal parts as PODs |
;; mark the non-literal parts as PODs |
3263 |
(cperl-postpone-fontification (point) e 'face face t) |
(cperl-postpone-fontification (point) e 'face face t) |
3264 |
(goto-char bb) |
(goto-char bb) |
3265 |
(if (looking-at |
(if (looking-at |
3266 |
"=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") |
"=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") |
3267 |
;; mark the headers |
;; mark the headers |
3268 |
(cperl-postpone-fontification |
(cperl-postpone-fontification |
3269 |
(match-beginning 1) (match-end 1) |
(match-beginning 1) (match-end 1) |
3270 |
'face head-face)) |
'face head-face)) |
3271 |
(while (re-search-forward |
(while (re-search-forward |
3273 |
"^\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" |
"^\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" |
3274 |
e 'toend) |
e 'toend) |
3275 |
;; mark the headers |
;; mark the headers |
3276 |
(cperl-postpone-fontification |
(cperl-postpone-fontification |
3277 |
(match-beginning 1) (match-end 1) |
(match-beginning 1) (match-end 1) |
3278 |
'face head-face)))) |
'face head-face)))) |
3279 |
(cperl-commentify bb e nil) |
(cperl-commentify bb e nil) |
3558 |
(progn |
(progn |
3559 |
(forward-word 1) ; skip modifiers s///s |
(forward-word 1) ; skip modifiers s///s |
3560 |
(if tail (cperl-commentify tail (point) t)) |
(if tail (cperl-commentify tail (point) t)) |
3561 |
(cperl-postpone-fontification |
(cperl-postpone-fontification |
3562 |
e1 (point) 'face 'cperl-nonoverridable-face))) |
e1 (point) 'face 'cperl-nonoverridable-face))) |
3563 |
;; Check whether it is m// which means "previous match" |
;; Check whether it is m// which means "previous match" |
3564 |
;; and highlight differently |
;; and highlight differently |
3565 |
(setq is-REx |
(setq is-REx |
3566 |
(and (string-match "^\\([sm]?\\|qr\\)$" argument) |
(and (string-match "^\\([sm]?\\|qr\\)$" argument) |
3567 |
(or (not (= (length argument) 0)) |
(or (not (= (length argument) 0)) |
3568 |
(not (eq c ?\<))))) |
(not (eq c ?\<))))) |
3569 |
(if (and is-REx |
(if (and is-REx |
3570 |
(eq e (+ 2 b)) |
(eq e (+ 2 b)) |
3571 |
;; split // *is* using zero-pattern |
;; split // *is* using zero-pattern |
3572 |
(save-excursion |
(save-excursion |
3616 |
(progn (setq was-comment nil) |
(progn (setq was-comment nil) |
3617 |
(forward-char 1)) |
(forward-char 1)) |
3618 |
(if (match-beginning 2) |
(if (match-beginning 2) |
3619 |
(progn |
(progn |
3620 |
(beginning-of-line 2) |
(beginning-of-line 2) |
3621 |
(if (> (point) e) |
(if (> (point) e) |
3622 |
(goto-char (1- e)))) |
(goto-char (1- e)))) |
3632 |
(setq REx-comment-end (point)) |
(setq REx-comment-end (point)) |
3633 |
(cperl-commentify |
(cperl-commentify |
3634 |
REx-comment-start REx-comment-end nil) |
REx-comment-start REx-comment-end nil) |
3635 |
(cperl-postpone-fontification |
(cperl-postpone-fontification |
3636 |
REx-comment-start REx-comment-end |
REx-comment-start REx-comment-end |
3637 |
'face font-lock-comment-face)))))) |
'face font-lock-comment-face)))))) |
3638 |
(if (and is-REx is-x-REx) |
(if (and is-REx is-x-REx) |
3639 |
(put-text-property (1+ b) (1- e) |
(put-text-property (1+ b) (1- e) |
3640 |
'syntax-subtype 'x-REx))) |
'syntax-subtype 'x-REx))) |
3641 |
(if i2 |
(if i2 |
3642 |
(progn |
(progn |
3708 |
(goto-char b) |
(goto-char b) |
3709 |
(skip-chars-backward "\\\\") |
(skip-chars-backward "\\\\") |
3710 |
;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) |
;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) |
3711 |
(setq state (parse-partial-sexp |
(setq state (parse-partial-sexp |
3712 |
state-point b nil nil state) |
state-point b nil nil state) |
3713 |
state-point b) |
state-point b) |
3714 |
(if (or (nth 3 state) (nth 4 state) ) |
(if (or (nth 3 state) (nth 4 state) ) |
3919 |
(beginning-of-line))) |
(beginning-of-line))) |
3920 |
;; Looking at: |
;; Looking at: |
3921 |
;; foreach my $var |
;; foreach my $var |
3922 |
(if (looking-at |
(if (looking-at |
3923 |
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") |
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") |
3924 |
(progn |
(progn |
3925 |
(forward-word 2) |
(forward-word 2) |
3928 |
(beginning-of-line))) |
(beginning-of-line))) |
3929 |
;; Looking at: |
;; Looking at: |
3930 |
;; foreach my $var ( |
;; foreach my $var ( |
3931 |
(if (looking-at |
(if (looking-at |
3932 |
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") |
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") |
3933 |
(progn |
(progn |
3934 |
(forward-word 3) |
(forward-word 3) |
3938 |
(beginning-of-line))) |
(beginning-of-line))) |
3939 |
;; Looking at: |
;; Looking at: |
3940 |
;; } foreach my $var () { |
;; } foreach my $var () { |
3941 |
(if (looking-at |
(if (looking-at |
3942 |
"[ \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]*{") |
"[ \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]*{") |
3943 |
(progn |
(progn |
3944 |
(setq ml (match-beginning 8)) |
(setq ml (match-beginning 8)) |
4332 |
marker (make-marker)) |
marker (make-marker)) |
4333 |
(set-text-properties 0 (length name) nil name) |
(set-text-properties 0 (length name) nil name) |
4334 |
(set-marker marker (match-end 3)) |
(set-marker marker (match-end 3)) |
4335 |
(if (eq fchar ?p) |
(if (eq fchar ?p) |
4336 |
(setq name (concat "package " name)) |
(setq name (concat "package " name)) |
4337 |
(cond ((string-match "[:']" name) |
(cond ((string-match "[:']" name) |
4338 |
(setq meth t)) |
(setq meth t)) |
4340 |
(t |
(t |
4341 |
(setq name (concat package name) meth t)))) |
(setq name (concat package name) meth t)))) |
4342 |
(setq index (cons name marker)) |
(setq index (cons name marker)) |
4343 |
(if (eq fchar ?p) |
(if (eq fchar ?p) |
4344 |
(push index index-pack-alist) |
(push index index-pack-alist) |
4345 |
(push index index-alist)) |
(push index index-alist)) |
4346 |
(if meth (push index index-meth-alist)) |
(if meth (push index index-meth-alist)) |
4429 |
(t 3))) ; should not happen |
(t 3))) ; should not happen |
4430 |
|
|
4431 |
|
|
4432 |
(defvar cperl-compilation-error-regexp-alist |
(defvar cperl-compilation-error-regexp-alist |
4433 |
;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). |
;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). |
4434 |
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" |
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" |
4435 |
2 3)) |
2 3)) |
4658 |
3 font-lock-variable-name-face))) |
3 font-lock-variable-name-face))) |
4659 |
'("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" |
'("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" |
4660 |
4 font-lock-variable-name-face))) |
4 font-lock-variable-name-face))) |
4661 |
(setq |
(setq |
4662 |
t-font-lock-keywords-1 |
t-font-lock-keywords-1 |
4663 |
(and (fboundp 'turn-on-font-lock) ; Check for newer font-lock |
(and (fboundp 'turn-on-font-lock) ; Check for newer font-lock |
4664 |
(not cperl-xemacs-p) ; not yet as of XEmacs 19.12 |
(not cperl-xemacs-p) ; not yet as of XEmacs 19.12 |
4689 |
(append t-font-lock-keywords-1 |
(append t-font-lock-keywords-1 |
4690 |
(list '("[$*]{?\\(\\sw+\\)" 1 |
(list '("[$*]{?\\(\\sw+\\)" 1 |
4691 |
font-lock-variable-name-face))))) |
font-lock-variable-name-face))))) |
4692 |
(setq cperl-font-lock-keywords-1 |
(setq cperl-font-lock-keywords-1 |
4693 |
(if cperl-syntaxify-by-font-lock |
(if cperl-syntaxify-by-font-lock |
4694 |
(cons 'cperl-fontify-update |
(cons 'cperl-fontify-update |
4695 |
t-font-lock-keywords) |
t-font-lock-keywords) |
5504 |
(format "File %s unreadable. Continue? " ifile)) |
(format "File %s unreadable. Continue? " ifile)) |
5505 |
(setq cperl-unreadable-ok t) |
(setq cperl-unreadable-ok t) |
5506 |
(error "Aborting: unreadable file %s" ifile))))) |
(error "Aborting: unreadable file %s" ifile))))) |
5507 |
(if (not file) |
(if (not file) |
5508 |
(message "Unreadable file %s" ifile) |
(message "Unreadable file %s" ifile) |
5509 |
(message "Scanning file %s ..." file) |
(message "Scanning file %s ..." file) |
5510 |
(if (and cperl-use-syntax-table-text-property-for-tags |
(if (and cperl-use-syntax-table-text-property-for-tags |
5614 |
(erase |
(erase |
5615 |
(erase-buffer) |
(erase-buffer) |
5616 |
(setq erase 'ignore))) |
(setq erase 'ignore))) |
5617 |
(let ((files |
(let ((files |
5618 |
(condition-case err |
(condition-case err |
5619 |
(directory-files file t |
(directory-files file t |
5620 |
(if recurse nil cperl-scan-files-regexp) |
(if recurse nil cperl-scan-files-regexp) |
5621 |
t) |
t) |
5622 |
(error |
(error |
5623 |
(if cperl-unreadable-ok nil |
(if cperl-unreadable-ok nil |
5624 |
(if (y-or-n-p |
(if (y-or-n-p |
5625 |
(format "Directory %s unreadable. Continue? " file)) |
(format "Directory %s unreadable. Continue? " file)) |
5626 |
(setq cperl-unreadable-ok t |
(setq cperl-unreadable-ok t |
5627 |
tm nil) ; Return empty list |
tm nil) ; Return empty list |
5628 |
(error "Aborting: unreadable directory %s" file))))))) |
(error "Aborting: unreadable directory %s" file))))))) |
5629 |
(mapcar (function (lambda (file) |
(mapcar (function (lambda (file) |
6681 |
(set-marker m1 (point)) |
(set-marker m1 (point)) |
6682 |
(if (= level 1) |
(if (= level 1) |
6683 |
(if (progn ; indent rigidly if multiline |
(if (progn ; indent rigidly if multiline |
6684 |
;; In fact does not make a lot of sense, since |
;; In fact does not make a lot of sense, since |
6685 |
;; the starting position can be already lost due |
;; the starting position can be already lost due |
6686 |
;; to insertion of "\n" and " " |
;; to insertion of "\n" and " " |
6687 |
(goto-char tmp) |
(goto-char tmp) |
6831 |
(set-marker e (1- (point))) |
(set-marker e (1- (point))) |
6832 |
(goto-char b) |
(goto-char b) |
6833 |
(while (re-search-forward "\\(#\\)\\|\n" e 'to-end) |
(while (re-search-forward "\\(#\\)\\|\n" e 'to-end) |
6834 |
(cond |
(cond |
6835 |
((match-beginning 1) ; #-comment |
((match-beginning 1) ; #-comment |
6836 |
(or c (setq c (current-indentation))) |
(or c (setq c (current-indentation))) |
6837 |
(beginning-of-line 2) ; Skip |
(beginning-of-line 2) ; Skip |
6858 |
(set-marker e (1- (point))) |
(set-marker e (1- (point))) |
6859 |
(goto-char (1+ b)) |
(goto-char (1+ b)) |
6860 |
(while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) |
(while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) |
6861 |
(cond |
(cond |
6862 |
((match-beginning 1) ; Skip |
((match-beginning 1) ; Skip |
6863 |
nil) |
nil) |
6864 |
(t ; Group |
(t ; Group |
7091 |
(defun cperl-fontify-syntaxically (end) |
(defun cperl-fontify-syntaxically (end) |
7092 |
;; Some vars for debugging only |
;; Some vars for debugging only |
7093 |
;; (message "Syntaxifying...") |
;; (message "Syntaxifying...") |
7094 |
(let (start (dbg (point)) (iend end) |
(let (start (dbg (point)) (iend end) |
7095 |
(istate (car cperl-syntax-state))) |
(istate (car cperl-syntax-state))) |
7096 |
(and cperl-syntaxify-unwind |
(and cperl-syntaxify-unwind |
7097 |
(setq end (cperl-unwind-to-safe t end))) |
(setq end (cperl-unwind-to-safe t end))) |