Mercurial > emacs
changeset 22293:0544aa57ff27
(cperl-style-alist): New variable, since `c-mode'
is no longer loaded.
- (Somebody who uses the styles should check that they work OK!)
- (a lot of work is needed, especially with new
`cperl-fix-line-spacing').
Old value of style is memorized when choosing a new style, may be
restored from the same menu.
(cperl-perldoc, cperl-pod-to-manpage): New commands; thanks to
Anthony Foiani <afoiani@uswest.com> and Nick Roberts
<Nick.Roberts@src.bae.co.uk>.
(`Perl doc', `Regexp'): New submenus (latter to allow short displays).
(cperl-clobber-lisp-bindings): New cfg variable.
(cperl-find-pods-heres): $a->y() is not y///.
(cperl-after-block-p): Add save-excursion.
(cperl-init-faces): Was failing.
Init faces when loading `ps-print'.
(cperl-toggle-autohelp): New command.
(cperl-electric-paren): `while SPACE LESS' was buggy.
(cperl-init-faces): `-text' in `[-text => 1]' was not highlighted.
(cperl-after-block-p): was FALSE after `sub f {}'.
(cperl-electric-keyword): `foreachmy', `formy' expanded too,
Expands `=pod-directive'.
(cperl-linefeed): behaves reasonable in POD-directive lines.
(cperl-message-electric-keyword): new cfg variable.
(cperl-electric-keyword): print a message, governed by
`cperl-message-electric-keyword'.
(cperl-electric-paren): Typing `}' was not checking for being
block or not.
(cperl-beautify-regexp-piece): Did not know about lookbehind;
finding *which* level to work with was not intuitive.
(cperl-beautify-levels): New command.
(cperl-electric-keyword): Allow here-docs contain `=head1'
and friends for keyword expansion.
Fix for broken `font-lock-unfontify-region-function'. Should
preserve `syntax-table' properties even with `lazy-lock'.
(cperl-indent-region-fix-else): New command.
(cperl-fix-line-spacing): New command.
(cperl-invert-if-unless): New command (C-c C-t and in Menu).
(cperl-hints): mention 20.2's goods/bads.
(cperl-extra-newline-before-brace-multiline): Started to use it.
(cperl-break-one-line-blocks-when-indent): New cfg variable.
(cperl-fix-hanging-brace-when-indent): New cfg variable.
(cperl-merge-trailing-else): New cfg variable.
Workaround for another `font-lock's `syntax-table' text-property bug.
`zerop' could be applied to nil.
At last, may work with `font-lock' without setting `cperl-font-lock'.
(cperl-indent-region-fix-constructs): Renamed from
`cperl-indent-region-fix-constructs'.
(cperl-fix-line-spacing): could be triggered inside strings, would not
know what to do with BLOCKs of map/printf/etc.
(cperl-merge-trailing-else): Handle `continue' too.
(cperl-fix-line-spacing): Likewise.
(cperl-calculate-indent): Knows about map/printf/etc before {BLOCK};
treat after-comma lines as continuation lines.
(cperl-mode): `continue' made electric.
(cperl-electric-keyword): Electric `do' inserts `do/while'.
(cperl-fontify-syntaxically): New function.
(cperl-syntaxify-by-font-lock): New cfg variable.
Make syntaxification to be autoredone via `font-lock',
switched on by `cperl-syntaxify-by-font-lock', off by default so far.
Remove some commented out chunks.
(cperl-set-style-back): Old value of style is memorized when
choosing a new style, may be restored from the same menu.
Mode-documentation added to micro-docs.
(cperl-praise): updated.
(cperl-toggle-construct-fix): New command. Added on C-c C-w and menu.
(auto-fill-mode): added on C-c C-f and menu.
(cperl-style-alist): `PerlStyle' style added.
(cperl-find-pods-heres): Message for termination of scan corrected.
(cperl-speed): New variable with hints.
(cperl-electric-else): Make backspace electric after
expansion of `else/continue' too.
Fixed customization to honor cperl-hairy.
Created customization groups.
All the compile-time warnings fixed.
(cperl-syntaxify-by-font-lock): Interaction with `font-lock-hot-pass'
fixed.
(cperl-after-block-and-statement-beg): It is BLOCK if we reach lim
when backup sexp.
(cperl-after-block-p, cperl-after-expr-p): Likewise.
(cperl-indent-region): Make a marker for END - text added/removed.
(cperl-style-alist): Include `cperl-merge-trailing-else'
where the value is clear.
(cperl-styles-entries): Likewise.
(cperl-tips, cperl-problems): Improvements to docs.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sat, 30 May 1998 15:43:16 +0000 |
| parents | a4324fe3e21e |
| children | 9dd312681e15 |
| files | lisp/progmodes/cperl-mode.el |
| diffstat | 1 files changed, 1487 insertions(+), 619 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/cperl-mode.el Sat May 30 15:14:47 1998 +0000 +++ b/lisp/progmodes/cperl-mode.el Sat May 30 15:43:16 1998 +0000 @@ -39,7 +39,7 @@ ;;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< ;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< -;;; `cperl-non-problems', `cperl-praise'. <<<<<< +;;; `cperl-non-problems', `cperl-praise', `cperl-speed'. <<<<<< ;;; The mode information (on C-h m) provides some customization help. ;;; If you use font-lock feature of this mode, it is advisable to use @@ -66,9 +66,39 @@ (defgroup cperl nil "Major mode for editing Perl code." :prefix "cperl-" - :group 'languages) - -(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) + :group 'languages + :version "20.3") + +(defgroup cperl-indentation-details nil + "Indentation." + :prefix "cperl-" + :group 'cperl) + +(defgroup cperl-affected-by-hairy nil + "Variables affected by `cperl-hairy'." + :prefix "cperl-" + :group 'cperl) + +(defgroup cperl-autoinsert-details nil + "Auto-insert tuneup." + :prefix "cperl-" + :group 'cperl) + +(defgroup cperl-faces nil + "Fontification colors." + :prefix "cperl-" + :group 'cperl) + +(defgroup cperl-speed nil + "Speed vs. validity tuneup." + :prefix "cperl-" + :group 'cperl) + +(defgroup cperl-help-system nil + "Help system tuneup." + :prefix "cperl-" + :group 'cperl) + (defcustom cperl-extra-newline-before-brace nil "*Non-nil means that if, elsif, while, until, else, for, foreach @@ -84,50 +114,58 @@ } " :type 'boolean - :group 'cperl) + :group 'cperl-autoinsert-details) + +(defcustom cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace + "*Non-nil means the same as `cperl-extra-newline-before-brace', but +for constructs with multiline if/unless/while/until/for/foreach condition." + :type 'boolean + :group 'cperl-autoinsert-details) (defcustom cperl-indent-level 2 "*Indentation of CPerl statements with respect to containing block." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-lineup-step nil "*`cperl-lineup' will always lineup at multiple of this number. If `nil', the value of `cperl-indent-level' will be used." :type '(choice (const nil) integer) - :group 'cperl) + :group 'cperl-indentation-details) + (defcustom cperl-brace-imaginary-offset 0 "*Imagined indentation of a Perl open brace that actually follows a statement. An open brace following other text is treated as if it were this far to the right of the start of its line." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-brace-offset 0 "*Extra indentation for braces, compared with other text in same context." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-label-offset -2 "*Offset of CPerl label lines relative to usual indentation." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-min-label-indent 1 "*Minimal offset of CPerl label lines." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-continued-statement-offset 2 "*Extra indent for lines not starting new statements." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. This is in addition to cperl-continued-statement-offset." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-close-paren-offset -1 "*Extra indent for substatements that start with close-parenthesis." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-auto-newline nil "*Non-nil means automatically newline before and after braces, @@ -136,43 +174,46 @@ Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set." :type 'boolean - :group 'cperl) + :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." :type 'boolean - :group 'cperl) + :group 'cperl-autoinsert-details) (defcustom cperl-tab-always-indent t "*Non-nil means TAB in CPerl mode should always reindent the current line, regardless of where in the line point is when the TAB command is used." :type 'boolean - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-font-lock nil "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) (defcustom cperl-electric-lbrace-space nil "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) (defcustom cperl-electric-parens-string "({[]})<" "*String of parentheses that should be electric in CPerl. Closing ones are electric only if the region is highlighted." :type 'string - :group 'cperl) + :group 'cperl-affected-by-hairy) (defcustom cperl-electric-parens nil "*Non-nil (and non-null) means parentheses should be electric in CPerl. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) + +(defvar zmacs-regions) ; Avoid warning + (defcustom cperl-electric-parens-mark (and window-system (or (and (boundp 'transient-mark-mode) ; For Emacs @@ -182,30 +223,34 @@ "*Not-nil means that electric parens look for active mark. Default is yes if there is visual feedback on mark." :type 'boolean - :group 'cperl) + :group 'cperl-autoinsert-details) (defcustom cperl-electric-linefeed nil "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy. In any case these two mean plain and hairy linefeeds together. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) (defcustom cperl-electric-keywords nil "*Not-nil (and non-null) means keywords are electric in CPerl. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) (defcustom cperl-hairy nil - "*Not-nil means all the bells and whistles are enabled in CPerl." + "*Not-nil means most of the bells and whistles are enabled in CPerl. +Affects: `cperl-font-lock', `cperl-electric-lbrace-space', +`cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords', +`cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings', +`cperl-lazy-help-time'." :type 'boolean - :group 'cperl) + :group 'cperl-affected-by-hairy) (defcustom cperl-comment-column 32 "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)." :type 'integer - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;") (RCS "$rcs = ' $Id\$ ' ;")) @@ -217,74 +262,82 @@ "*Not-nil (and non-null) means not to prompt on C-h f. The opposite behaviour is always available if prefixed with C-c. Can be overwritten by `cperl-hairy' if nil." - :type 'boolean - :group 'cperl) + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) + +(defcustom cperl-clobber-lisp-bindings nil + "*Not-nil (and non-null) means not overwrite C-h f. +The function is available on \\[cperl-info-on-command], \\[cperl-get-help]. +Can be overwritten by `cperl-hairy' if nil." + :type '(choice (const null) boolean) + :group 'cperl-affected-by-hairy) (defcustom cperl-lazy-help-time nil - "*Not-nil (and non-null) means to show lazy help after given idle time." - :type 'boolean - :group 'cperl) + "*Not-nil (and non-null) means to show lazy help after given idle time. +Can be overwritten by `cperl-hairy' to be 5 sec if nil." + :type '(choice (const null) integer) + :group 'cperl-affected-by-hairy) (defcustom cperl-pod-face 'font-lock-comment-face "*The result of evaluation of this expression is used for pod highlighting." :type 'face - :group 'cperl) + :group 'cperl-faces) (defcustom cperl-pod-head-face 'font-lock-variable-name-face "*The result of evaluation of this expression is used for pod highlighting. Font for POD headers." :type 'face - :group 'cperl) + :group 'cperl-faces) (defcustom cperl-here-face 'font-lock-string-face "*The result of evaluation of this expression is used for here-docs highlighting." :type 'face - :group 'cperl) + :group 'cperl-faces) (defcustom cperl-pod-here-fontify '(featurep 'font-lock) "*Not-nil after evaluation means to highlight pod and here-docs sections." :type 'boolean - :group 'cperl) + :group 'cperl-faces) (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) + :group 'cperl-speed) (defcustom cperl-imenu-addback nil "*Not-nil means add backreferences to generated `imenu's. -May require patched `imenu' and `imenu-go'." +May require patched `imenu' and `imenu-go'. Obsolete." :type 'boolean - :group 'cperl) + :group 'cperl-help-system) (defcustom cperl-max-help-size 66 "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents." :type '(choice integer (const nil)) - :group 'cperl) + :group 'cperl-help-system) (defcustom cperl-shrink-wrap-info-frame t "*Non-nil means shrink-wrapping of info-buffer-frame allowed." :type 'boolean - :group 'cperl) + :group 'cperl-help-system) (defcustom cperl-info-page "perl" "*Name of the info page containing perl docs. Older version of this page was called `perl5', newer `perl'." :type 'string - :group 'cperl) + :group 'cperl-help-system) (defcustom cperl-use-syntax-table-text-property (boundp 'parse-sexp-lookup-properties) "*Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean - :group 'cperl) + :group 'cperl-speed) (defcustom cperl-use-syntax-table-text-property-for-tags cperl-use-syntax-table-text-property "*Non-nil means: set up and use `syntax-table' text property generating TAGS." :type 'boolean - :group 'cperl) + :group 'cperl-speed) (defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$" "*Regexp to match files to scan when generating TAGS." @@ -300,18 +353,61 @@ "*Indentation used when beautifying regexps. If `nil', the value of `cperl-indent-level' will be used." :type '(choice integer (const nil)) - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-indent-left-aligned-comments t "*Non-nil means that the comment starting in leftmost column should indent." :type 'boolean - :group 'cperl) + :group 'cperl-indentation-details) (defcustom cperl-under-as-char t "*Non-nil means that the _ (underline) should be treated as word char." :type 'boolean :group 'cperl) +(defcustom cperl-extra-perl-args "" + "*Extra arguments to use when starting Perl. +Currently used with `cperl-check-syntax' only." + :type 'string + :group 'cperl) + +(defcustom cperl-message-electric-keyword t + "*Non-nil means that the `cperl-electric-keyword' prints a help message." + :type 'boolean + :group 'cperl-help-system) + +(defcustom cperl-indent-region-fix-constructs 1 + "*Amount of space to insert between `}' and `else' or `elsif' +in `cperl-indent-region'. Set to nil to leave as is. Values other +than 1 and nil will probably not work." + :type '(choice (const nil) (const 1)) + :group 'cperl-indentation-details) + +(defcustom cperl-break-one-line-blocks-when-indent t + "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs +need to be reformated into multiline ones when indenting a region." + :type 'boolean + :group 'cperl-indentation-details) + +(defcustom cperl-fix-hanging-brace-when-indent t + "*Non-nil means that BLOCK-end `}' may be put on a separate line +when indenting a region. +Braces followed by else/elsif/while/until are excepted." + :type 'boolean + :group 'cperl-indentation-details) + +(defcustom cperl-merge-trailing-else t + "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue +may be merged to be on the same line when indenting a region." + :type 'boolean + :group 'cperl-indentation-details) + +(defcustom cperl-syntaxify-by-font-lock nil + "*Non-nil means that CPerl uses `font-lock's routines for syntaxification. +Not debugged yet." + :type 'boolean + :group 'cperl-speed) + ;;; Short extra-docs. @@ -321,6 +417,8 @@ ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs and/or ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl +Subdirectory `cperl-mode' may contain yet newer development releases and/or +patches to related files. Get support packages choose-color.el (or font-lock-extra.el before 19.30), imenu-go.el from the same place. \(Look for other files there @@ -353,16 +451,15 @@ know about them.") (defvar cperl-problems 'please-ignore-this-line -"Emacs has a _very_ restricted syntax parsing engine. - -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 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. +"Emacs had a _very_ restricted syntax parsing engine (until RMS's Emacs +20.1). + +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 +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 be recognized as a regexp by the indentation @@ -375,14 +472,23 @@ 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 transposition is not always possible -:-(. " ) +as /($|\\s)/. Note that such a transposition is not always possible. + +The solution is to upgrade your Emacs. Note that RMS's 20.2 has some +bugs related to `syntax-table' text properties. Patches are available +on the main CPerl download site, and on CPAN. + +If these bugs cannot be fixed on your machine (say, you have an inferior +environment and cannot recompile), you may still disable all the fancy stuff +via `cperl-use-syntax-table-text-property'." ) (defvar cperl-non-problems 'please-ignore-this-line -"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. +"As you know from `problems' section, Perl syntax is too hard for CPerl on +older Emacsen. + +Most of the time, if you write your own code, you may find an equivalent +\(and almost as readable) expression (what is discussed below is usually +not relevant on newer Emacsen, since they can do it automatically). Try to help CPerl: add comments with embedded quotes to fix CPerl misunderstandings about the end of quotation: @@ -392,19 +498,21 @@ You won't need it too often. The reason: $ \"quotes\" the following character (this saves a life a lot of times in CPerl), thus due to Emacs parsing rules it does not consider tick (i.e., ' ) after a -dollar as a closing one, but as a usual character. - -Now the indentation code is pretty wise. The only drawback is that it -relies on Emacs parsing to find matching parentheses. And Emacs -*cannot* match parentheses in Perl 100% correctly. So +dollar as a closing one, but as a usual character. This is usually +correct, but not in the above context. + +Even with older Emacsen the indentation code is pretty wise. The only +drawback is that it relied on Emacs parsing to find matching +parentheses. And Emacs *could not* match parentheses in Perl 100% +correctly. So 1 if s#//#/#; -will not break indentation, but +would not break indentation, but 1 if ( s#//#/# ); -will. +would. Upgrade. By similar reasons s\"abc\"def\"; -will confuse CPerl a lot. +would confuse CPerl a lot. If you still get wrong indentation in situation that you think the code should be able to parse, try: @@ -412,10 +520,8 @@ a) Check what Emacs thinks about balance of your parentheses. 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 volunteers are needed to change Emacs C code.) +Pods were treated _very_ rudimentally. Here-documents were not +treated at all (except highlighting and inhibiting indentation). Upgrade. To speed up coloring the following compromises exist: a) sub in $mypackage::sub may be highlighted. @@ -425,7 +531,10 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove `car' before `imenu-choose-buffer-index' in `imenu'. -") +`imenu-add-to-menubar' in 20.2 is broken. +Most things on XEmacs are broken too, judging by bug reports I recieve. +Note that some releases of XEmacs are better than the others as far as bugs +reports I see are concerned.") (defvar cperl-praise 'please-ignore-this-line "RMS asked me to list good things about CPerl. Here they go: @@ -468,7 +577,7 @@ namespaces in Perl have different colors); i) Can construct TAGS basing on its knowledge of Perl syntax, the standard menu has 6 different way to generate - TAGS (if by directory, .xs files - with C-language + TAGS (if \"by directory\", .xs files - with C-language bindings - are included in the scan); j) Can build a hierarchical view of classes (via imenu) basing on generated TAGS file; @@ -479,20 +588,75 @@ to be not so bothering). Electric parentheses behave \"as they should\" in a presence of a visible region. l) Changes msb.el \"on the fly\" to insert a group \"Perl files\"; + m) Can convert from + if (A) { B } + to + B if A; 5) The indentation engine was very smart, but most of tricks may be not needed anymore with the support for `syntax-table' property. Has progress indicator for indentation (with `imenu' loaded). -6) Indent-region improves inline-comments as well; +6) Indent-region improves inline-comments as well; also corrects +whitespace *inside* the conditional/loop constructs. 7) Fill-paragraph correctly handles multi-line comments; + +8) Can switch to different indentation styles by one command, and restore +the settings present before the switch. + +9) When doing indentation of control constructs, may correct +line-breaks/spacing between elements of the construct. +") + +(defvar cperl-speed 'please-ignore-this-line + "This is an incomplete compendium of what is available in other parts +of CPerl documentation. (Please inform me if I skept anything.) + +There is a perception that CPerl is slower than alternatives. This part +of documentation is designed to overcome this misconception. + +*By default* CPerl tries to enable the most comfortable settings. +From most points of view, correctly working package is infinitely more +comfortable than a non-correctly working one, thus by default CPerl +prefers correctness over speed. Below is the guide how to change +settings if your preferences are different. + +A) Speed of loading the file. When loading file, CPerl may perform a +scan which indicates places which cannot be parsed by primitive Emacs +syntax-parsing routines, and marks them up so that either + + A1) CPerl may work around these deficiencies (for big chunks, mostly + PODs and HERE-documents), or + A2) On capable Emaxen CPerl will use improved syntax-handlings + which reads mark-up hints directly. + + The scan in case A2 is much more comprehensive, thus may be slower. + + User can disable syntax-engine-helping scan of A2 by setting + `cperl-use-syntax-table-text-property' + variable to nil (if it is set to t). + + One can disable the scan altogether (both A1 and A2) by setting + `cperl-pod-here-scan' + to nil. + +B) Speed of editing operations. + + One can add a (minor) speedup to editing operations by setting + `cperl-use-syntax-table-text-property' + variable to nil (if it is set to t). This will disable + syntax-engine-helping scan, thus will make many more Perl + constructs be wrongly recognized by CPerl, thus may lead to + wrongly matched parentheses, wrong indentation, etc. ") ;;; Portability stuff: +(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) + (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) (` (define-key cperl-mode-map (, (if xemacs-key @@ -508,13 +672,13 @@ (and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) +(defun cperl-mark-active () (mark)) ; Avoid undefined warning (if cperl-xemacs-p (progn ;; "Active regions" are on: use region only if active ;; "Active regions" are off: use region unconditionally (defun cperl-use-region-p () - (if zmacs-regions (mark) t)) - (defun cperl-mark-active () (mark))) + (if zmacs-regions (mark) t))) (defun cperl-use-region-p () (if transient-mark-mode mark-active t)) (defun cperl-mark-active () mark-active)) @@ -522,14 +686,15 @@ (defsubst cperl-enable-font-lock () (or cperl-xemacs-p window-system)) +(defun cperl-putback-char (c) ; Emacs 19 + (set 'unread-command-events (list c))) ; Avoid undefined warning + (if (boundp 'unread-command-events) (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 - (setq unread-command-events (list c)))) + (setq unread-command-events (list (eval '(character-to-event c)))))) (defun cperl-putback-char (c) ; XEmacs <= 19.11 - (setq unread-command-event (character-to-event c)))) + (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings (or (fboundp 'uncomment-region) (defun uncomment-region (beg end) @@ -551,6 +716,15 @@ :type 'hook :group 'cperl) +(defvar cperl-syntax-state nil) +(defvar cperl-syntax-done-to nil) + +;; Make customization possible "in reverse" +(defsubst cperl-val (symbol &optional default hairy) + (cond + ((eq (symbol-value symbol) 'null) default) + (cperl-hairy (or hairy t)) + (t (symbol-value symbol)))) ;;; Probably it is too late to set these guys already, but it can help later: @@ -567,6 +741,18 @@ (condition-case nil (require 'easymenu) (error nil)) + (condition-case nil + (require 'etags) + (error nil)) + (condition-case nil + (require 'timer) + (error nil)) + (condition-case nil + (require 'man) + (error nil)) + (condition-case nil + (require 'info) + (error nil)) ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, ;; macros instead of defsubsts don't work on Emacs, so we do the ;; expansion manually. Any other suggestions? @@ -574,7 +760,24 @@ window-system) (require 'font-lock)) (require 'cl) - )) + ;; Avoid warning (tmp definitions) + (or (fboundp 'x-color-defined-p) + (defalias 'x-color-defined-p + (cond ((fboundp 'color-defined-p) 'color-defined-p) + ;; XEmacs >= 19.12 + ((fboundp 'valid-color-name-p) 'valid-color-name-p) + ;; XEmacs 19.11 + (t 'x-valid-color-name-p)))) + (fset 'cperl-is-face + (cond ((fboundp 'find-face) + (symbol-function 'find-face)) + ((and (fboundp 'face-list) + (face-list)) + (function (lambda (face) + (member face (and (fboundp 'face-list) + (face-list)))))) + (t + (function (lambda (face) (boundp face)))))))) (defvar cperl-mode-abbrev-table nil "Abbrev table in use in Cperl-mode buffers.") @@ -596,9 +799,13 @@ (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-t" 'cperl-invert-if-unless) (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-w" 'cperl-toggle-construct-fix) + (cperl-define-key "\C-c\C-f" 'auto-fill-mode) (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric) + (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp) (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound (cperl-define-key [?\C-\M-\|] 'cperl-lineup [(control meta |)]) @@ -609,14 +816,22 @@ ;; don't clobber the backspace binding: (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command [(control c) (control h) f]) - (cperl-define-key "\C-hf" - ;;(concat (char-to-string help-char) "f") ; does not work - 'cperl-info-on-command - [(control h) f]) - (cperl-define-key "\C-hv" + (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command + [(control c) (control h) F]) + (cperl-define-key "\C-c\C-hv" ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help - [(control h) v]) + [(control c) (control h) v]) + (if (cperl-val 'cperl-clobber-lisp-bindings) + (progn + (cperl-define-key "\C-hf" + ;;(concat (char-to-string help-char) "f") ; does not work + 'cperl-info-on-command + [(control h) f]) + (cperl-define-key "\C-hv" + ;;(concat (char-to-string help-char) "v") ; does not work + 'cperl-get-help + [(control h) v]))) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn @@ -638,6 +853,8 @@ cperl-mode-map global-map))) (defvar cperl-menu) +(defvar cperl-lazy-installed) +(defvar cperl-old-style nil) (condition-case nil (progn (require 'easymenu) @@ -650,12 +867,16 @@ ["Fill paragraph/comment" cperl-fill-paragraph t] "----" ["Line up a construction" cperl-lineup (cperl-use-region-p)] - ["Beautify a regexp" cperl-beautify-regexp - cperl-use-syntax-table-text-property] - ["Beautify a group in regexp" cperl-beautify-level - cperl-use-syntax-table-text-property] - ["Contract a group in regexp" cperl-contract-level - cperl-use-syntax-table-text-property] + ["Invert if/unless/while/until" cperl-invert-if-unless t] + ("Regexp" + ["Beautify" cperl-beautify-regexp + cperl-use-syntax-table-text-property] + ["Beautify a group" cperl-beautify-level + cperl-use-syntax-table-text-property] + ["Contract a group" cperl-contract-level + cperl-use-syntax-table-text-property] + ["Contract groups" cperl-contract-levels + cperl-use-syntax-table-text-property]) ["Refresh \"hard\" constructions" cperl-find-pods-heres t] "----" ["Indent region" cperl-indent-region (cperl-use-region-p)] @@ -695,31 +916,45 @@ ["Create tags for Perl files in (sub)directories" (cperl-write-tags nil t t t) t] ["Add tags for Perl files in (sub)directories" - (cperl-write-tags nil nil t t) t]) + (cperl-write-tags nil nil t t) t])) + ("Perl docs" ["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 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)]) + ["Perldoc" cperl-perldoc t] + ["Perldoc on word at point" cperl-perldoc-at-point t] + ["View manpage of POD in this file" cperl-pod-to-manpage t] + ["Auto-help on" cperl-lazy-install + (and (fboundp 'run-with-idle-timer) + (not cperl-lazy-installed))] + ["Auto-help off" (eval '(cperl-lazy-unstall)) + (and (fboundp 'run-with-idle-timer) + cperl-lazy-installed)]) ("Toggle..." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] ["Electric keywords" cperl-toggle-abbrev t] - ) + ["Fix whitespace on indent" cperl-toggle-construct-fix t] + ["Auto fill" auto-fill-mode t]) ("Indent styles..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] ["FSF" (cperl-set-style "FSF") t] ["BSD" (cperl-set-style "BSD") t] - ["Whitesmith" (cperl-set-style "Whitesmith") t]) + ["Whitesmith" (cperl-set-style "Whitesmith") t] + ["Current" (cperl-set-style "Current") t] + ["Memorized" (cperl-set-style-back) cperl-old-style]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] ["Non-problems" (describe-variable 'cperl-non-problems) t] - ["Praise" (describe-variable 'cperl-praise) t])))) + ["Speed" (describe-variable 'cperl-speed) t] + ["Praise" (describe-variable 'cperl-praise) t] + ["CPerl mode" (describe-function 'cperl-mode) t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" @@ -762,22 +997,13 @@ -;; Make customization possible "in reverse" -;;(defun cperl-set (symbol to) -;; (or (eq (symbol-value symbol) 'null) (set symbol to))) -(defsubst cperl-val (symbol &optional default hairy) - (cond - ((eq (symbol-value symbol) 'null) default) - (cperl-hairy (or hairy t)) - (t (symbol-value symbol)))) - -;; provide an alias for working with emacs 19. the perl-mode that comes -;; with it is really bad, and this lets us seamlessly replace it. -;;;###autoload -(fset 'perl-mode 'cperl-mode) -(defvar cperl-faces-init) +(defvar cperl-faces-init nil) ;; Fix for msb.el (defvar cperl-msb-fixed nil) +(defvar font-lock-syntactic-keywords) +(defvar perl-font-lock-keywords) +(defvar perl-font-lock-keywords-1) +(defvar perl-font-lock-keywords-2) ;;;###autoload (defun cperl-mode () "Major mode for editing Perl code. @@ -800,65 +1026,83 @@ look for active mark and \"embrace\" a region if possible.' CPerl mode provides expansion of the Perl control constructs: - if, else, elsif, unless, while, until, for, and foreach. -=========(Disabled by default, see `cperl-electric-keywords'.) -The user types the keyword immediately followed by a space, which causes -the construct to be expanded, and the user is positioned where she is most -likely to want to be. -eg. when the user types a space following \"if\" the following appears in -the buffer: - if () { or if () - } { - } -and the cursor is between the parentheses. The user can then type some -boolean expression within the parens. Having done that, typing -\\[cperl-linefeed] places you, appropriately indented on a new line -between the braces. If CPerl decides that you want to insert -\"English\" style construct like + + if, else, elsif, unless, while, until, continue, do, + for, foreach, formy and foreachmy. + +and POD directives (Disabled by default, see `cperl-electric-keywords'.) + +The user types the keyword immediately followed by a space, which +causes the construct to be expanded, and the point is positioned where +she is most likely to want to be. eg. when the user types a space +following \"if\" the following appears in the buffer: if () { or if () +} { } and the cursor is between the parentheses. The user can then +type some boolean expression within the parens. Having done that, +typing \\[cperl-linefeed] places you - appropriately indented - on a +new line between the braces (if you typed \\[cperl-linefeed] in a POD +directive line, then appropriate number of new lines is inserted). + +If CPerl decides that you want to insert \"English\" style construct like + bite if angry; -it will not do any expansion. See also help on variable -`cperl-extra-newline-before-brace'. + +it will not do any expansion. See also help on variable +`cperl-extra-newline-before-brace'. (Note that one can switch the +help message on expansion by setting `cperl-message-electric-keyword' +to nil.) \\[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 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'. +Use \\[cperl-invert-if-unless] to change a construction of the form + + if (A) { B } + +into + + B if A; + \\{cperl-mode-map} -Setting the variable `cperl-font-lock' to t switches on -font-lock-mode, `cperl-electric-lbrace-space' to t switches on -electric space between $ and {, `cperl-electric-parens-string' is the -string that contains parentheses that should be electric in CPerl (see -also `cperl-electric-parens-mark' and `cperl-electric-parens'), +Setting the variable `cperl-font-lock' to t switches on font-lock-mode +\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches +on electric space between $ and {, `cperl-electric-parens-string' is +the string that contains parentheses that should be electric in CPerl +\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'), setting `cperl-electric-keywords' enables electric expansion of control structures in CPerl. `cperl-electric-linefeed' governs which one of two linefeed behavior is preferable. You can enable all these options simultaneously (recommended mode of use) by setting `cperl-hairy' to t. In this case you can switch separate options off -by setting them to `null'. Note that one may undo the extra whitespace -inserted by semis and braces in `auto-newline'-mode by consequent -\\[cperl-electric-backspace]. +by setting them to `null'. Note that one may undo the extra +whitespace inserted by semis and braces in `auto-newline'-mode by +consequent \\[cperl-electric-backspace]. If your site has perl5 documentation in info format, you can use commands \\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it. 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'). +`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings' +\(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'. +help is available on \\[cperl-get-help], and one can run perldoc or +man via menu. + +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' (if the value of `cperl-lazy-help-time' is nil) is 5 +secs idle time . It is also possible to switch this on/off from the +menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'. Use \\[cperl-lineup] to vertically lineup some construction - put the beginning of the region at the start of construction, and make region @@ -866,13 +1110,15 @@ 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 -for indentation too, currently they are used for highlighting only. +here-docs sections. With capable Emaxen results of scan are used +for indentation too, otherwise they are used for highlighting only. Variables controlling indentation style: `cperl-tab-always-indent' Non-nil means TAB in CPerl mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. + `cperl-indent-left-aligned-comments' + Non-nil means that the comment starting in leftmost column should indent. `cperl-auto-newline' Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in Perl code. The following @@ -908,25 +1154,31 @@ `cperl-brace-offset' -5 -8 `cperl-label-offset' -5 -8 -If `cperl-indent-level' is 0, the statement after opening brace in column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'. +CPerl knows several indentation styles, and may bulk set the +corresponding variables. Use \\[cperl-set-style] to do this. Use +\\[cperl-set-style-back] to restore the memorized preexisting values +\(both available from menu). + +If `cperl-indent-level' is 0, the statement after opening brace in +column 0 is indented on +`cperl-brace-offset'+`cperl-continued-statement-offset'. Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook' -with no args." +with no args. + +DO NOT FORGET to read micro-docs (available from `Perl' menu) +or as help on variables `cperl-tips', `cperl-problems', +`cperl-non-problems', `cperl-praise', `cperl-speed'." (interactive) (kill-all-local-variables) - ;;(if cperl-hairy - ;; (progn - ;; (cperl-set 'cperl-font-lock cperl-hairy) - ;; (cperl-set 'cperl-electric-lbrace-space cperl-hairy) - ;; (cperl-set 'cperl-electric-parens "{[(<") - ;; (cperl-set 'cperl-electric-keywords cperl-hairy) - ;; (cperl-set 'cperl-electric-linefeed cperl-hairy))) (use-local-map cperl-mode-map) (if (cperl-val 'cperl-electric-linefeed) (progn (local-set-key "\C-J" 'cperl-linefeed) (local-set-key "\C-C\C-J" 'newline-and-indent))) - (if (cperl-val 'cperl-info-on-command-no-prompt) + (if (and + (cperl-val 'cperl-clobber-lisp-bindings) + (cperl-val 'cperl-info-on-command-no-prompt)) (progn ;; don't clobber the backspace binding: (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) @@ -943,9 +1195,16 @@ ("until" "until" cperl-electric-keyword 0) ("unless" "unless" cperl-electric-keyword 0) ("else" "else" cperl-electric-else 0) + ("continue" "continue" cperl-electric-else 0) ("for" "for" cperl-electric-keyword 0) ("foreach" "foreach" cperl-electric-keyword 0) - ("do" "do" cperl-electric-keyword 0))) + ("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))) (setq abbrevs-changed prev-a-c))) (setq local-abbrev-table cperl-mode-abbrev-table) (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0)) @@ -983,25 +1242,50 @@ (make-local-variable 'imenu-sort-function) (setq imenu-sort-function nil) (make-local-variable 'vc-header-alist) - (setq vc-header-alist cperl-vc-header-alist) + (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning (make-local-variable 'font-lock-defaults) (setq font-lock-defaults - (if (string< emacs-version "19.30") - '(perl-font-lock-keywords-2) + (cond + ((string< emacs-version "19.30") + '(perl-font-lock-keywords-2)) + ((string< emacs-version "19.33") ; Which one to use? '((perl-font-lock-keywords perl-font-lock-keywords-1 - perl-font-lock-keywords-2)))) + perl-font-lock-keywords-2))) + (t + '((cperl-load-font-lock-keywords + cperl-load-font-lock-keywords-1 + cperl-load-font-lock-keywords-2))))) + (make-local-variable 'cperl-syntax-state) (if cperl-use-syntax-table-text-property (progn (make-variable-buffer-local 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! - (set 'parse-sexp-lookup-properties t))) + (set 'parse-sexp-lookup-properties t) + ;; Fix broken font-lock: + (or (boundp 'font-lock-unfontify-region-function) + (set 'font-lock-unfontify-region-function + 'font-lock-default-unfontify-buffer)) + (make-variable-buffer-local 'font-lock-unfontify-region-function) + (set 'font-lock-unfontify-region-function + 'cperl-font-lock-unfontify-region-function) + (make-variable-buffer-local 'cperl-syntax-done-to) + ;; Another bug: unless font-lock-syntactic-keywords, font-lock + ;; ignores syntax-table text-property. (t) is a hack + ;; to make font-lock think that font-lock-syntactic-keywords + ;; are defined + (make-variable-buffer-local 'font-lock-syntactic-keywords) + (setq font-lock-syntactic-keywords + (if cperl-syntaxify-by-font-lock + '(t (cperl-fontify-syntaxically)) + '(t))))) + (make-local-variable 'cperl-old-style) (or (fboundp 'cperl-old-auto-fill-mode) (progn (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) (defun auto-fill-mode (&optional arg) (interactive "P") - (cperl-old-auto-fill-mode arg) + (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning (and auto-fill-function (eq major-mode 'perl-mode) (setq auto-fill-function 'cperl-do-auto-fill))))) (if (cperl-enable-font-lock) @@ -1012,12 +1296,17 @@ (not cperl-msb-fixed) (cperl-msb-fix)) (if (featurep 'easymenu) - (easy-menu-add cperl-menu)) ; A NOP in Emacs. + (easy-menu-add cperl-menu)) ; A NOP in RMS Emacs. (run-hooks 'cperl-mode-hook) ;; After hooks since fontification will break this - (if cperl-pod-here-scan (cperl-find-pods-heres))) + (if cperl-pod-here-scan + (or (and (boundp 'font-lock-mode) + (eval 'font-lock-mode) ; Avoid warning + (boundp 'font-lock-hot-pass)) ; Newer font-lock + (cperl-find-pods-heres)))) ;; Fix for perldb - make default reasonable +(defvar gud-perldb-history) (defun cperl-db () (interactive) (require 'gud) @@ -1032,7 +1321,7 @@ nil nil '(gud-perldb-history . 1)))) - +(defvar msb-menu-cond) (defun cperl-msb-fix () ;; Adds perl files to msb menu, supposes that msb is already loaded (setq cperl-msb-fixed t) @@ -1140,41 +1429,52 @@ (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 - (self-insert-command (prefix-numeric-value arg)) - (cperl-indent-line) - (if cperl-auto-newline - (setq insertpos (1- (point)))) - (if (and cperl-auto-newline (null only-before)) - (progn - (newline) - (cperl-indent-line))) + ;: Check whether we close something "usual" with `}' + (if (and (eq last-command-char ?\}) + (not + (condition-case nil + (save-excursion + (up-list (- (prefix-numeric-value arg))) + ;;(cperl-after-block-p (point-min)) + (cperl-after-expr-p nil "{;)")) + (error nil)))) + ;; Just insert the guy + (self-insert-command (prefix-numeric-value arg)) + (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 + (self-insert-command (prefix-numeric-value arg)) + (cperl-indent-line) + (if cperl-auto-newline + (setq insertpos (1- (point)))) + (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 - (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)))))) + (goto-char insertpos) + (self-insert-command (prefix-numeric-value arg))) + (self-insert-command (prefix-numeric-value arg))))))) (defun cperl-electric-lbrace (arg &optional end) "Insert character, correct line's indentation, correct quoting by space." @@ -1276,14 +1576,21 @@ (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-keyword () - "Insert a construction appropriate after a keyword." + "Insert a construction appropriate after a keyword. +Help message may be switched off by setting `cperl-message-electric-keyword' +to nil." (let ((beg (save-excursion (beginning-of-line) (point))) (dollar (and (eq last-command-char ?$) (eq this-command 'self-insert-command))) (delete (and (memq last-command-char '(?\ ?\n ?\t ?\f)) - (memq this-command '(self-insert-command newline))))) + (memq this-command '(self-insert-command newline)))) + my do) (and (save-excursion - (backward-sexp 1) + (condition-case nil + (progn + (backward-sexp 1) + (setq do (looking-at "do\\>"))) + (error nil)) (cperl-after-expr-p nil "{;:")) (save-excursion (not @@ -1291,34 +1598,128 @@ "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) - (looking-at "=cut"))) + (or + (looking-at "=cut") + (and cperl-use-syntax-table-text-property + (not (eq (get-text-property (point) + 'syntax-type) + 'pod)))))) (progn + (and (eq (preceding-char) ?y) + (progn ; "foreachmy" + (forward-char -2) + (insert " ") + (forward-char 2) + (setq my t dollar t + delete + (memq this-command '(self-insert-command newline))))) (and dollar (insert " $")) (cperl-indent-line) ;;(insert " () {\n}") (cond (cperl-extra-newline-before-brace - (insert " ()\n") + (insert (if do "\n" " ()\n")) (insert "{") (cperl-indent-line) (insert "\n") (cperl-indent-line) - (insert "\n}")) + (insert "\n}") + (and do (insert " while ();"))) (t - (insert " () {\n}")) + (insert (if do " {\n} while ();" " () {\n}"))) ) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (if dollar (progn (search-backward "$") - (delete-char 1) - (forward-char -1) - (forward-char 1)) + (if my + (forward-char 1) + (delete-char 1))) (search-backward ")")) (if delete + (cperl-putback-char cperl-del-back-ch)) + (if cperl-message-electric-keyword + (message "Precede char by C-q to avoid expansion")))))) + +(defun cperl-ensure-newlines (n &optional pos) + "Make sure there are N newlines after the point." + (or pos (setq pos (point))) + (if (looking-at "\n") + (forward-char 1) + (insert "\n")) + (if (> n 1) + (cperl-ensure-newlines (1- n) pos) + (goto-char pos))) + +(defun cperl-electric-pod () + "Insert a POD chunk appropriate after a =POD directive." + (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f)) + (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 + (eq (preceding-char) ?=) + (progn + (setq head1 (looking-at "head1\\>")) + (setq over (looking-at "over\\>")) + (forward-char -1) + (bolp)) + (or + (cperl-after-expr-p nil "{;:") + (and (re-search-backward + "\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t) + (not (or + (looking-at "=cut") + (and cperl-use-syntax-table-text-property + (not (eq (get-text-property (point) 'syntax-type) + 'pod))))))))) + (progn + (save-excursion + (setq notlast (search-forward "\n\n=" nil t))) + (or notlast + (progn + (insert "\n\n=cut") + (cperl-ensure-newlines 2) + (forward-sexp -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) + (setq name (file-name-sans-extension + (file-name-nondirectory (buffer-file-name))) + p (point)) + (insert " NAME\n\n" name + " - \n\n=head1 SYNOPSYS\n\n\n\n" + "=head1 DESCRIPTION") + (cperl-ensure-newlines 4) + (goto-char p) + (forward-sexp 2) + (end-of-line) + (setq really-delete t)) + (forward-sexp 1)))) + (if over + (progn + (setq p (point)) + (insert "\n\n=item \n\n\n\n" + "=back") + (cperl-ensure-newlines 2) + (goto-char p) + (forward-sexp 1) + (end-of-line) + (setq really-delete t))) + (if (and delete really-delete) (cperl-putback-char cperl-del-back-ch)))))) (defun cperl-electric-else () - "Insert a construction appropriate after a keyword." + "Insert a construction appropriate after a keyword. +Help message may be switched off by setting `cperl-message-electric-keyword' +to nil." (let ((beg (save-excursion (beginning-of-line) (point)))) (and (save-excursion (backward-sexp 1) @@ -1329,7 +1730,11 @@ "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) - (looking-at "=cut"))) + (looking-at "=cut") + (and cperl-use-syntax-table-text-property + (not (eq (get-text-property (point) + 'syntax-type) + 'pod))))) (progn (cperl-indent-line) ;;(insert " {\n\n}") @@ -1346,14 +1751,18 @@ (cperl-indent-line) (forward-line -1) (cperl-indent-line) - (cperl-putback-char cperl-del-back-ch))))) + (cperl-putback-char cperl-del-back-ch) + (setq this-command 'cperl-electric-else) + (if cperl-message-electric-keyword + (message "Precede char by C-q to avoid expansion")))))) (defun cperl-linefeed () - "Go to end of line, open a new line and indent appropriately." + "Go to end of line, open a new line and indent appropriately. +If in POD, insert appropriate lines." (interactive) (let ((beg (save-excursion (beginning-of-line) (point))) (end (save-excursion (end-of-line) (point))) - (pos (point)) start) + (pos (point)) start over cut res) (if (and ; Check if we need to split: ; i.e., on a boundary and inside "{...}" (save-excursion (cperl-to-comment-or-eol) @@ -1373,7 +1782,7 @@ (progn (backward-sexp 1) (setq start (point-marker)) - (<= start pos))))) ; RedundantAre after the + (<= start pos))))) ; Redundant? Are after the ; start of parens group. (progn (skip-chars-backward " \t") @@ -1406,7 +1815,7 @@ (forward-line -1) ; We are on the line before target (end-of-line) (newline-and-indent)) - (end-of-line) ; else + (end-of-line) ; else - no splitting (cond ((and (looking-at "\n[ \t]*{$") (save-excursion @@ -1415,6 +1824,37 @@ ; with an extra newline. (forward-line 2) (cperl-indent-line)) + ((save-excursion ; In POD header + (forward-paragraph -1) + ;; (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\b") + ;; We are after \n now, so look for the rest + (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+") + (progn + (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>")) + (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>")) + t))) + (if (and over + (progn + (forward-paragraph -1) + (forward-word 1) + (setq pos (point)) + (setq cut (buffer-substring (point) + (save-excursion + (end-of-line) + (point)))) + (delete-char (- (save-excursion (end-of-line) (point)) + (point))) + (setq res (expand-abbrev)) + (save-excursion + (goto-char pos) + (insert cut)) + res)) + nil + (cperl-ensure-newlines (if cut 2 4)) + (forward-line 2))) + ((get-text-property (point) 'in-pod) ; In POD section + (cperl-ensure-newlines 4) + (forward-line 2)) ((looking-at "\n[ \t]*$") ; Next line is empty - use it. (forward-line 1) (cperl-indent-line)) @@ -1467,12 +1907,6 @@ (progn (newline) (cperl-indent-line))) -;; (save-excursion -;; (if insertpos (progn (goto-char (marker-position insertpos)) -;; (search-forward (make-string -;; 1 last-command-char)) -;; (setq insertpos (1- (point))))) -;; (delete-char -1)))) (save-excursion (if insertpos (goto-char (1- (marker-position insertpos))) (forward-char -1)) @@ -1484,7 +1918,8 @@ (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-backspace (arg) - "Backspace-untabify, or remove the whitespace inserted by an electric key." + "Backspace-untabify, or remove the whitespace around the point inserted +by an electric key." (interactive "p") (if (and cperl-auto-newline (memq last-command '(cperl-electric-semi @@ -1497,7 +1932,18 @@ (setq p (point)) (skip-chars-backward " \t\n") (delete-region (point) p)) - (backward-delete-char-untabify arg))) + (and (eq last-command 'cperl-electric-else) + ;; We are removing the whitespace *inside* cperl-electric-else + (setq this-command 'cperl-electric-else-really)) + (if (and cperl-auto-newline + (eq last-command 'cperl-electric-else-really) + (memq (preceding-char) '(?\ ?\t ?\n))) + (let (p) + (skip-chars-forward " \t\n") + (setq p (point)) + (skip-chars-backward " \t\n") + (delete-region (point) p)) + (backward-delete-char-untabify arg)))) (defun cperl-inside-parens-p () (condition-case () @@ -1511,8 +1957,8 @@ (defun cperl-indent-command (&optional whole-exp) "Indent current line as Perl code, or in some cases insert a tab character. -If `cperl-tab-always-indent' is non-nil (the default), always indent current line. -Otherwise, indent the current line only if point is at the left margin +If `cperl-tab-always-indent' is non-nil (the default), always indent current +line. Otherwise, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. A numeric argument, regardless of its value, @@ -1534,7 +1980,7 @@ (goto-char beg) (forward-line 1) (setq beg (point))) - (if (> end beg) + (if (and shift-amt (> end beg)) (indent-code-rigidly beg end shift-amt "#"))) (if (and (not cperl-tab-always-indent) (save-excursion @@ -1546,15 +1992,15 @@ (defun cperl-indent-line (&optional symbol) "Indent current line as Perl code. Return the amount the indentation changed by." - (let (indent - beg shift-amt + (let (indent i beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) - (setq indent (cperl-calculate-indent nil symbol)) + (setq indent (cperl-calculate-indent nil symbol) + i indent) (beginning-of-line) (setq beg (point)) (cond ((or (eq indent nil) (eq indent t)) - (setq indent (current-indentation))) + (setq indent (current-indentation) i nil)) ;;((eq indent t) ; Never? ;; (setq indent (cperl-calculate-indent-within-comment))) ;;((looking-at "[ \t]*#") @@ -1573,8 +2019,9 @@ ((= (following-char) ?{) (setq indent (+ indent cperl-brace-offset)))))) (skip-chars-forward " \t") - (setq shift-amt (- indent (current-column))) - (if (zerop shift-amt) + (setq shift-amt (and i (- indent (current-column)))) + (if (or (not shift-amt) + (zerop shift-amt)) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) @@ -1626,7 +2073,6 @@ ;; Positions is before ?\{. Checks whether it starts a block. ;; No save-excursion! (cperl-backward-to-noncomment (point-min)) - ;;(skip-chars-backward " \t\n\f") (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp ; Label may be mixed up with `$blah :' (save-excursion (cperl-after-label)) @@ -1750,13 +2196,15 @@ (if (= (following-char) ?{) cperl-continued-brace-offset 0) (progn (cperl-backward-to-noncomment (or parse-start (point-min))) - ;;(skip-chars-backward " \t\f\n") ;; Look at previous line that's at column 0 ;; to determine whether we are in top-level decls ;; or function's arg decls. Set basic-indent accordingly. ;; Now add a little if this is a continuation line. (if (or (bobp) - (memq (preceding-char) (append " ;}" nil)) ; Was ?\) + (eq (preceding-char) ?\;) + ;; Had ?\) too + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg start)) (memq char-after (append ")]}" nil)) (and (eq (preceding-char) ?\:) ; label (progn @@ -1805,7 +2253,11 @@ (beginning-of-line) (cperl-backward-to-noncomment containing-sexp)) ;; Now we get the answer. - (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\, + ;; Had \?, too: + (if (not (or (memq (preceding-char) (append " ;{" '(nil))) + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg + containing-sexp)))) ; Was ?\, ;; This line is continuation of preceding line's statement; ;; indent `cperl-continued-statement-offset' more than the ;; previous line of the statement. @@ -1913,12 +2365,16 @@ "Alist of indentation rules for CPerl mode. The values mean: nil: do not indent; - number: add this amount of indentation.") + number: add this amount of indentation. + +Not finished, not used.") (defun cperl-where-am-i (&optional parse-start start-state) ;; Unfinished "Return a list of lists ((TYPE POS)...) of good points before the point. -POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'." +POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'. + +Not finished, not used." (save-excursion (let* ((start-point (point)) (s-s (cperl-get-state)) @@ -2094,13 +2550,6 @@ (setq state (parse-partial-sexp (point) lim nil nil nil t)) ; stop at comment ;; If fails (beginning-of-line inside sexp), then contains not-comment - ;; Do simplified processing - ;;(if (re-search-forward "[^$]#" lim 1) - ;; (progn - ;; (forward-char -1) - ;; (skip-chars-backward " \t\n\f" lim)) - ;; (goto-char lim)) ; No `#' at all - ;;) (if (nth 4 state) ; After `#'; ; (nth 2 state) can be ; beginning of m,s,qq and so @@ -2259,73 +2708,87 @@ (if ender (modify-syntax-entry ender "." st)))) (list i i2 ender starter go-forward))) -(defun cperl-find-pods-heres (&optional min max non-inter end) +(defvar font-lock-string-face) +(defvar font-lock-reference-face) +(defvar font-lock-constant-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 the sections using `cperl-pod-head-face', `cperl-pod-face', `cperl-here-face'." (interactive) - (or min (setq min (point-min))) + (or min (setq min (point-min) + cperl-syntax-state nil + 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 state - (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go - (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) - (modified (buffer-modified-p)) - (after-change-functions nil) - (state-point (point-min)) - (st-l '(nil)) (err-l '(nil)) i2 - ;; Somehow font-lock may be not loaded yet... - (font-lock-string-face (if (boundp 'font-lock-string-face) - font-lock-string-face - 'font-lock-string-face)) - (search - (concat - "\\(\\`\n?\\|\n\n\\)=" - "\\|" - ;; One extra () before this: - "<<" - "\\(" - ;; First variant "BLAH" or just ``. - "\\([\"'`]\\)" - "\\([^\"'`\n]*\\)" - "\\3" - "\\|" - ;; Second variant: Identifier or empty - "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" - ;; Check that we do not have <<= or << 30 or << $blah. - "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" - "\\)" - "\\|" - ;; 1+6 extra () before this: - "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" - (if cperl-use-syntax-table-text-property - (concat - "\\|" - ;; 1+6+2=9 extra () before this: - "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" - "\\|" - ;; 1+6+2+1=10 extra () before this: - "\\([?/]\\)" ; /blah/ or ?blah? - "\\|" - ;; 1+6+2+1+1=11 extra () before this: - "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" - "\\|" - ;; 1+6+2+1+1+2=13 extra () before this: - "\\$\\(['{]\\)" - "\\|" - ;; 1+6+2+1+1+2+1=14 extra () before this: - "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" - ;; 1+6+2+1+1+2+1+1=15 extra () before this: - "\\|" - "__\\(END\\|DATA\\)__" ; Commented - does not help with indent... - ) - "")))) + (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail + (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go + (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) + (modified (buffer-modified-p)) + (after-change-functions nil) + (use-syntax-state (and cperl-syntax-state + (>= min (car cperl-syntax-state)))) + (state-point (if use-syntax-state + (car cperl-syntax-state) + (point-min))) + (state (if use-syntax-state + (cdr cperl-syntax-state))) + (st-l '(nil)) (err-l '(nil)) i2 + ;; Somehow font-lock may be not loaded yet... + (font-lock-string-face (if (boundp 'font-lock-string-face) + font-lock-string-face + 'font-lock-string-face)) + (stop-point (if ignore-max + (point-max) + max)) + (search + (concat + "\\(\\`\n?\\|\n\n\\)=" + "\\|" + ;; One extra () before this: + "<<" + "\\(" + ;; First variant "BLAH" or just ``. + "\\([\"'`]\\)" + "\\([^\"'`\n]*\\)" + "\\3" + "\\|" + ;; Second variant: Identifier or empty + "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" + ;; Check that we do not have <<= or << 30 or << $blah. + "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" + "\\)" + "\\|" + ;; 1+6 extra () before this: + "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" + (if cperl-use-syntax-table-text-property + (concat + "\\|" + ;; 1+6+2=9 extra () before this: + "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>" + "\\|" + ;; 1+6+2+1=10 extra () before this: + "\\([?/]\\)" ; /blah/ or ?blah? + "\\|" + ;; 1+6+2+1+1=11 extra () before this: + "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" + "\\|" + ;; 1+6+2+1+1+2=13 extra () before this: + "\\$\\(['{]\\)" + "\\|" + ;; 1+6+2+1+1+2+1=14 extra () before this: + "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" + ;; 1+6+2+1+1+2+1+1=15 extra () before this: + "\\|" + "__\\(END\\|DATA\\)__" ; Commented - does not help with indent... + ) + "")))) (unwind-protect (progn (save-excursion (or non-inter (message "Scanning for \"hard\" Perl constructions...")) - (if cperl-pod-here-fontify + (and cperl-pod-here-fontify ;; We had evals here, do not know why... (setq face cperl-pod-face head-face cperl-pod-head-face @@ -2334,12 +2797,14 @@ '(syntax-type t in-pod t syntax-table t)) ;; Need to remove face as well... (goto-char min) - (if (and (eq system-type 'emx) - (looking-at "extproc[ \t]")) ; Analogue of #! - (cperl-commentify min - (save-excursion (end-of-line) (point)) - nil)) - (while (re-search-forward search max t) + (and (eq system-type 'emx) + (looking-at "extproc[ \t]") ; Analogue of #! + (cperl-commentify min + (save-excursion (end-of-line) (point)) + nil)) + (while (and + (< (point) max) + (re-search-forward search max t)) (cond ((match-beginning 1) ; POD section ;; "\\(\\`\n?\\|\n\n\\)=" @@ -2350,12 +2815,17 @@ (beginning-of-line) (setq b (point) bb b) - (or (re-search-forward "\n\n=cut\\>" max 'toend) + ;; 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) (progn (message "End of a POD section not marked by =cut") (or (car err-l) (setcar err-l b)))) (beginning-of-line 2) ; An empty line after =cut is not POD! (setq e (point)) + (and (> e max) + (remove-text-properties max e + '(syntax-type t in-pod t syntax-table t))) (put-text-property b e 'in-pod t) (goto-char b) (while (re-search-forward "\n\n[ \t]" e t) @@ -2363,16 +2833,12 @@ (beginning-of-line) (put-text-property (cperl-1- b) (point) 'syntax-type 'pod) (cperl-put-do-not-fontify b (point)) - ;;(put-text-property (max (point-min) (1- b)) - ;; (point) cperl-do-not-fontify t) (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) (re-search-forward "\n\n[^ \t\f\n]" e 'toend) (beginning-of-line) (setq b (point))) (put-text-property (cperl-1- (point)) e 'syntax-type 'pod) (cperl-put-do-not-fontify (point) e) - ;;(put-text-property (max (point-min) (1- (point))) - ;; e cperl-do-not-fontify t) (if cperl-pod-here-fontify (progn (put-text-property (point) e 'face face) (goto-char bb) @@ -2401,10 +2867,7 @@ (setq b (point)) (setq state (parse-partial-sexp state-point b nil nil state) state-point b) - (if ;;(save-excursion - ;; (beginning-of-line) - ;; (search-forward "#" b t)) - (or (nth 3 state) (nth 4 state)) + (if (or (nth 3 state) (nth 4 state)) (goto-char (match-end 2)) (if (match-beginning 5) ;4 + 1 (setq b1 (match-beginning 5) ; 4 + 1 @@ -2418,16 +2881,15 @@ (cperl-put-do-not-fontify b1 e1))) (forward-line) (setq b (point)) - (cond ((re-search-forward (concat "^" qtag "$") max 'toend) + ;; We do not search to max, since we may be called from + ;; some hook of fontification, and max is random + (cond ((re-search-forward (concat "^" qtag "$") + stop-point 'toend) (if cperl-pod-here-fontify (progn (put-text-property (match-beginning 0) (match-end 0) 'face font-lock-constant-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))) (setq e1 (cperl-1+ (match-end 0))) @@ -2470,7 +2932,9 @@ 'face font-lock-string-face) (cperl-commentify b1 (point) nil) (cperl-put-do-not-fontify b1 (point))))) - (re-search-forward (concat "^[.;]$") max 'toend)) + ;; We do not search to max, since we may be called from + ;; some hook of fontification, and max is random + (re-search-forward "^[.;]$" stop-point 'toend)) (beginning-of-line) (if (looking-at "^[.;]$") (progn @@ -2481,18 +2945,7 @@ (message "End of format `%s' not found." name) (or (car err-l) (setcar err-l b))) (forward-line) - (put-text-property b (point) 'syntax-type 'format) -;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend) -;;; (if cperl-pod-here-fontify -;;; (progn -;;; (put-text-property b (match-end 0) -;;; 'face font-lock-string-face) -;;; (cperl-put-do-not-fontify b (match-end 0)))) -;;; (put-text-property b (match-end 0) -;;; 'syntax-type 'format) -;;; (cperl-put-do-not-fontify b (match-beginning 0))) -;;; (t (message "End of format `%s' not found." name))) - ) + (put-text-property b (point) 'syntax-type 'format)) ;; Regexp: ((or (match-beginning 10) (match-beginning 11)) ;; 1+6+2=9 extra () before this: @@ -2515,40 +2968,48 @@ (not (eq (char-after (- (match-beginning b1) 2)) ?\&)))))) + (goto-char (match-beginning b1)) + (cperl-backward-to-noncomment (point-min)) (or bb (if (eq b1 11) ; bare /blah/ or ?blah? (setq argument "" - bb ; Not a regexp? - (progn - (goto-char (match-beginning b1)) - (cperl-backward-to-noncomment (point-min)) - (not - ;; What is below: regexp-p? - (and - (or (memq (preceding-char) - (append (if (eq c ?\?) - ;; $a++ ? 1 : 2 - "~{(=|&*!,;" - "~{(=|&+-*!,;") nil)) - (and (eq (preceding-char) ?\}) - (cperl-after-block-p (point-min))) - (and (eq (char-syntax (preceding-char)) ?w) - (progn - (forward-sexp -1) - (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))) - (and (eq (preceding-char) ?.) - (eq (char-after (- (point) 2)) ?.)) - (bobp)) - ;; m|blah| ? foo : bar; - (not - (and (eq c ?\?) - cperl-use-syntax-table-text-property - (not (bobp)) - (progn - (forward-char -1) - (looking-at "\\s|"))))))) - b (1- b)))) + bb ; Not a regexp? + (progn + (not + ;; What is below: regexp-p? + (and + (or (memq (preceding-char) + (append (if (eq c ?\?) + ;; $a++ ? 1 : 2 + "~{(=|&*!,;" + "~{(=|&+-*!,;") nil)) + (and (eq (preceding-char) ?\}) + (cperl-after-block-p (point-min))) + (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 ... + (looking-at + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))) + (and (eq (preceding-char) ?.) + (eq (char-after (- (point) 2)) ?.)) + (bobp)) + ;; m|blah| ? foo : bar; + (not + (and (eq c ?\?) + cperl-use-syntax-table-text-property + (not (bobp)) + (progn + (forward-char -1) + (looking-at "\\s|"))))))) + b (1- b)) + ;; s y tr m + ;; Check for $a->y + (if (and (eq (preceding-char) ?>) + (eq (char-after (- (point) 2)) ?-)) + ;; Not a regexp + (setq bb t)))) (or bb (setq state (parse-partial-sexp state-point b nil nil state) state-point b)) @@ -2562,9 +3023,11 @@ ;; 2 or 3 later if some special quoting is needed. ;; e1 means matching-char matcher. (setq b (point) - i (cperl-forward-re max end - (string-match "^\\([sy]\\|tr\\)$" argument) - t st-l err-l argument) + ;; We do not search to max, since we may be called from + ;; some hook of fontification, and max is random + i (cperl-forward-re stop-point end + (string-match "^\\([sy]\\|tr\\)$" argument) + t st-l err-l argument) i2 (nth 1 i) ; start of the second part e1 (nth 2 i) ; ender, true if matching second part go (nth 4 i) ; There is a 1-char part after the end @@ -2593,7 +3056,7 @@ (cperl-modify-syntax-type i cperl-st-bra)))) (cperl-commentify i2 (point) t) (if e - (cperl-modify-syntax-type (1+ i) cperl-st-punct)) + (cperl-modify-syntax-type (1+ i) cperl-st-punct)) (setq tail nil))) (if (eq (char-syntax (following-char)) ?w) (progn @@ -2615,7 +3078,7 @@ ;; 1+6+2+1+1+2=13 extra () before this: ;; "\\$\\(['{]\\)" ((and (match-beginning 14) - (eq (preceding-char) ?\')) ; $' + (eq (preceding-char) ?\')) ; $' (setq b (1- (point)) state (parse-partial-sexp state-point (1- b) nil nil state) @@ -2654,111 +3117,18 @@ (cperl-commentify b bb nil) (setq end t)) (goto-char bb))) - (if (> (point) max) + (if (> (point) stop-point) (progn (if end (message "Garbage after __END__/__DATA__ ignored") (message "Unbalanced syntax found while scanning") (or (car err-l) (setcar err-l b))) - (goto-char max)))) -;;; (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t) -;;; (if (looking-at "\n*cut\\>") -;;; (progn -;;; (message "=cut is not preceded by a pod section") -;;; (setq err (point))) -;;; (beginning-of-line) - -;;; (setq b (point) bb b) -;;; (or (re-search-forward "\n\n=cut\\>" max 'toend) -;;; (message "Cannot find the end of a pod section")) -;;; (beginning-of-line 3) -;;; (setq e (point)) -;;; (put-text-property b e 'in-pod t) -;;; (goto-char b) -;;; (while (re-search-forward "\n\n[ \t]" e t) -;;; (beginning-of-line) -;;; (put-text-property b (point) 'syntax-type 'pod) -;;; (cperl-put-do-not-fontify b (point)) -;;; ;;(put-text-property (max (point-min) (1- b)) -;;; ;; (point) cperl-do-not-fontify t) -;;; (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) -;;; (re-search-forward "\n\n[^ \t\f\n]" e 'toend) -;;; (beginning-of-line) -;;; (setq b (point))) -;;; (put-text-property (point) e 'syntax-type 'pod) -;;; (cperl-put-do-not-fontify (point) e) -;;; ;;(put-text-property (max (point-min) (1- (point))) -;;; ;; e cperl-do-not-fontify t) -;;; (if cperl-pod-here-fontify -;;; (progn (put-text-property (point) e 'face face) -;;; (goto-char bb) -;;; (if (looking-at -;;; "=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$") -;;; (put-text-property -;;; (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) -;;; (put-text-property -;;; (match-beginning 1) (match-end 1) -;;; 'face head-face)))) -;;; (goto-char e))) -;;; (goto-char min) -;;; (while (re-search-forward -;;; ;; We exclude \n to avoid misrecognition inside quotes. -;;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\2\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)" -;;; max t) -;;; (if (match-beginning 4) -;;; (setq b1 (match-beginning 4) -;;; e1 (match-end 4)) -;;; (setq b1 (match-beginning 3) -;;; e1 (match-end 3))) -;;; (setq tag (buffer-substring b1 e1) -;;; qtag (regexp-quote tag)) -;;; (cond (cperl-pod-here-fontify -;;; (put-text-property b1 e1 'face font-lock-constant-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-constant-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)))) -;;; (goto-char min) -;;; (while (re-search-forward -;;; "^[ \t]*format[ \t]*\\(\\([a-zA-Z0-9_]+[ \t]*\\)?\\)=[ \t]*$" -;;; max t) -;;; (setq b (point) -;;; name (buffer-substring (match-beginning 1) -;;; (match-end 1))) -;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend) -;;; (if cperl-pod-here-fontify -;;; (progn -;;; (put-text-property b (match-end 0) -;;; 'face font-lock-string-face) -;;; (cperl-put-do-not-fontify b (match-end 0)))) -;;; (put-text-property b (match-end 0) -;;; 'syntax-type 'format) -;;; (cperl-put-do-not-fontify b (match-beginning 0))) -;;; (t (message "End of format `%s' not found." name)))) - ) + (goto-char stop-point)))) + (setq cperl-syntax-state (cons state-point state) + cperl-syntax-done-to (max (point) max))) (if (car err-l) (goto-char (car err-l)) - (or noninteractive - (message "Scan for \"hard\" Perl constructions completed.")))) + (or non-inter + (message "Scanning for \"hard\" Perl constructions... done")))) (and (buffer-modified-p) (not modified) (set-buffer-modified-p nil)) @@ -2787,12 +3157,19 @@ (progn (forward-sexp -1) (cperl-backward-to-noncomment lim) - (or (eq (preceding-char) ?\) ) ; if () {} - (and (eq (char-syntax (preceding-char)) ?w) ; else {} - (progn - (forward-sexp -1) - (looking-at "\\(else\\|grep\\|map\\)\\>"))) - (cperl-after-expr-p lim))) + (or (eq (preceding-char) ?\) ) ; if () {} sub f () {} + (if (eq (char-syntax (preceding-char)) ?w) ; else {} + (save-excursion + (forward-sexp -1) + (or (looking-at "\\(else\\|grep\\|map\\)\\>") + ;; sub f {} + (progn + (cperl-backward-to-noncomment lim) + (and (eq (char-syntax (preceding-char)) ?w) + (progn + (forward-sexp -1) + (looking-at "sub\\>")))))) + (cperl-after-expr-p lim)))) (error nil)))) (defun cperl-after-expr-p (&optional lim chars test) @@ -2828,6 +3205,21 @@ (goto-char (1+ lim))) (skip-chars-forward " \t")) +(defun cperl-after-block-and-statement-beg (lim) + ;; We assume that we are after ?\} + (and + (cperl-after-block-p lim) + (save-excursion + (forward-sexp -1) + (cperl-backward-to-noncomment (point-min)) + (or (bobp) + (not (= (char-syntax (preceding-char)) ?w)) + (progn + (forward-sexp -1) + (not + (looking-at + "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>"))))))) + (defvar innerloop-done nil) (defvar last-depth nil) @@ -2835,7 +3227,10 @@ (defun cperl-indent-exp () "Simple variant of indentation of continued-sexp. Should be slow. Will not indent comment if it starts at `comment-indent' -or looks like continuation of the comment on the previous line." +or looks like continuation of the comment on the previous line. + +If `cperl-indent-region-fix-constructs', will improve spacing on +conditional/loop constructs." (interactive) (save-excursion (let ((tmp-end (progn (end-of-line) (point))) top done) @@ -2854,17 +3249,186 @@ (setq done t))) (goto-char tmp-end) (setq tmp-end (point-marker))) + (if cperl-indent-region-fix-constructs + (cperl-fix-line-spacing tmp-end)) (cperl-indent-region (point) tmp-end)))) +(defun cperl-fix-line-spacing (&optional end) + "Improve whitespace in a conditional/loop construct." + (interactive) + (or end + (setq end (point-max))) + (let (p pp ml + (cperl-indent-region-fix-constructs + (or cperl-indent-region-fix-constructs 1))) + (save-excursion + (beginning-of-line) + ;; Looking at: + ;; } + ;; else + (if (and cperl-merge-trailing-else + (looking-at + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) + (progn + (search-forward "}") + (setq p (point)) + (skip-chars-forward " \t\n") + (delete-region p (point)) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; } else + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (progn + (search-forward "}") + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; else { + (if (looking-at + "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") + (progn + (forward-word 1) + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; foreach my $var + (if (looking-at + "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") + (progn + (forward-word 2) + (delete-horizontal-space) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (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#]") + (progn + (forward-word 3) + (delete-horizontal-space) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + ;; Looking at: + ;; } foreach my $var () { + (if (looking-at + "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\(\\([ t]+\\(my\\|local\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + (progn + (setq ml (match-beginning 8)) + (re-search-forward "[({]") + (forward-char -1) + (setq p (point)) + (if (eq (following-char) ?\( ) + (progn + (forward-sexp 1) + (setq pp (point))) + ;; after `else' or nothing + (if ml ; after `else' + (skip-chars-backward " \t\n") + (beginning-of-line)) + (setq pp nil)) + ;; Now after the sexp before the brace + ;; Multiline expr should be special + (setq ml (and pp (save-excursion (goto-char p) + (search-forward "\n" pp t)))) + (if (and (or (not pp) (< pp end)) + (looking-at "[ \t\n]*{")) + (progn + (cond + ((bolp) ; Were before `{', no if/else/etc + nil) + ((looking-at "\\(\t*\\| [ \t]+\\){") + (delete-horizontal-space) + (if (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace) + (progn + (delete-horizontal-space) + (insert "\n") + (if (cperl-indent-line) + (cperl-fix-line-spacing end))) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )))) + ((and (looking-at "[ \t]*\n") + (not (if ml + cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace))) + (setq pp (point)) + (skip-chars-forward " \t\n") + (delete-region pp (point)) + (insert + (make-string cperl-indent-region-fix-constructs ?\ )))) + ;; Now we are before `{' + (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") + (progn + (skip-chars-forward " \t\n") + (setq pp (point)) + (forward-sexp 1) + (setq p (point)) + (goto-char pp) + (setq ml (search-forward "\n" p t)) + (if (or cperl-break-one-line-blocks-when-indent ml) + ;; not good: multi-line BLOCK + (progn + (goto-char (1+ pp)) + (delete-horizontal-space) + (insert "\n") + (if (cperl-indent-line) + (cperl-fix-line-spacing end)))))))))) + (beginning-of-line) + (setq p (point) pp (save-excursion (end-of-line) (point))) + ;; Now check whether there is a hanging `}' + ;; Looking at: + ;; } blah + (if (and + cperl-fix-hanging-brace-when-indent + (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) + (condition-case nil + (progn + (up-list 1) + (if (and (<= (point) pp) + (eq (preceding-char) ?\} ) + (cperl-after-block-and-statement-beg (point-min))) + t + (goto-char p) + nil)) + (error nil))) + (progn + (forward-char -1) + (skip-chars-backward " \t") + (if (bolp) + ;; `}' was the first thing on the line, insert NL *after* it. + (progn + (cperl-indent-line) + (search-forward "}") + (delete-horizontal-space) + (insert "\n")) + (delete-horizontal-space) + (or (eq (preceding-char) ?\;) + (bolp) + (and (eq (preceding-char) ?\} ) + (cperl-after-block-p (point-min))) + (insert ";")) + (insert "\n")) + (if (cperl-indent-line) + (cperl-fix-line-spacing end)) + (beginning-of-line)))))) + (defun cperl-indent-region (start end) "Simple variant of indentation of region in CPerl mode. Should be slow. Will not indent comment if it starts at `comment-indent' or looks like continuation of the comment on the previous line. Indents all the lines whose first character is between START and END -inclusive." +inclusive. + +If `cperl-indent-region-fix-constructs', will improve spacing on +conditional/loop constructs." (interactive "r") (save-excursion - (let (st comm indent-info old-comm-indent new-comm-indent + (let (st comm indent-info old-comm-indent new-comm-indent p pp i (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) (goto-char start) (setq old-comm-indent (and (cperl-to-comment-or-eol) @@ -2891,9 +3455,12 @@ (let ((comment-column new-comm-indent)) (indent-for-comment))) (progn - (cperl-indent-line 'indent-info) + (setq i (cperl-indent-line 'indent-info)) (or comm + (not i) (progn + (if cperl-indent-region-fix-constructs + (cperl-fix-line-spacing end)) (if (setq old-comm-indent (and (cperl-to-comment-or-eol) (not (memq (get-text-property (point) @@ -2909,17 +3476,6 @@ (imenu-progress-message pm 100) (message nil))))) -;;(defun cperl-slash-is-regexp (&optional pos) -;; (save-excursion -;; (goto-char (if pos pos (1- (point)))) -;; (and -;; (not (memq (get-text-property (point) 'face) -;; '(font-lock-string-face font-lock-comment-face))) -;; (cperl-after-expr-p nil nil ' -;; (or (looking-at "[^]a-zA-Z0-9_)}]") -;; (eq (get-text-property (point) 'face) -;; 'font-lock-keyword-face)))))) - ;; Stolen from lisp-mode with a lot of improvements (defun cperl-fill-paragraph (&optional justify iteration) @@ -3076,7 +3632,6 @@ nil t) (or noninteractive (imenu-progress-message prev-pos)) - ;;(backward-up-list 1) (cond ((and ; Skip some noise if building tags (match-beginning 2) ; package or sub @@ -3215,18 +3770,35 @@ cperl-compilation-error-regexp-alist))) -(defvar cperl-faces-init nil) - (defun cperl-windowed-init () "Initialization under windowed version." - (add-hook 'font-lock-mode-hook - (function - (lambda () - (if (or - (eq major-mode 'perl-mode) - (eq major-mode 'cperl-mode)) - (progn - (or cperl-faces-init (cperl-init-faces)))))))) + (if (or (featurep 'ps-print) cperl-faces-init) + ;; Need to init anyway: + (or cperl-faces-init (cperl-init-faces)) + (add-hook 'font-lock-mode-hook + (function + (lambda () + (if (or + (eq major-mode 'perl-mode) + (eq major-mode 'cperl-mode)) + (progn + (or cperl-faces-init (cperl-init-faces))))))) + (if (fboundp 'eval-after-load) + (eval-after-load + "ps-print" + '(or cperl-faces-init (cperl-init-faces)))))) + +(defun cperl-load-font-lock-keywords () + (or cperl-faces-init (cperl-init-faces)) + perl-font-lock-keywords) + +(defun cperl-load-font-lock-keywords-1 () + (or cperl-faces-init (cperl-init-faces)) + perl-font-lock-keywords-1) + +(defun cperl-load-font-lock-keywords-2 () + (or cperl-faces-init (cperl-init-faces)) + perl-font-lock-keywords-2) (defvar perl-font-lock-keywords-1 nil "Additional expressions to highlight in Perl mode. Minimal set.") @@ -3235,6 +3807,8 @@ (defvar perl-font-lock-keywords-2 nil "Additional expressions to highlight in Perl mode. Maximal set") +(defvar font-lock-background-mode) +(defvar font-lock-display-type) (defun cperl-init-faces () (condition-case nil (progn @@ -3243,8 +3817,6 @@ (featurep 'font-lock-extra) (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - ;;(defvar cperl-font-lock-enhanced nil - ;; "Set to be non-nil if font-lock allows active highlights.") (if (fboundp 'font-lock-fontify-anchored-keywords) (setq font-lock-anchored t)) (setq @@ -3381,7 +3953,7 @@ (1 font-lock-string-face t)))) (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) - '("[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 + '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 font-lock-constant-face) ; labels @@ -3438,7 +4010,8 @@ t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) - (font-lock-require-faces + (eval ; Avoid a warning + '(font-lock-require-faces (list ;; Color-light Color-dark Gray-light Gray-dark Mono (list 'font-lock-comment-face @@ -3512,7 +4085,7 @@ "gray90"] t t - nil))) + nil)))) (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") (or (fboundp 'x-color-defined-p) @@ -3527,64 +4100,40 @@ (or (boundp 'font-lock-type-face) (defconst font-lock-type-face 'font-lock-type-face - "Face to use for data types.") - ) + "Face to use for data types.")) (or (boundp 'font-lock-other-type-face) (defconst font-lock-other-type-face 'font-lock-other-type-face - "Face to use for data types from another group.") - ) + "Face to use for data types from another group.")) (if (not cperl-xemacs-p) nil (or (boundp 'font-lock-comment-face) (defconst font-lock-comment-face 'font-lock-comment-face - "Face to use for comments.") - ) + "Face to use for comments.")) (or (boundp 'font-lock-keyword-face) (defconst font-lock-keyword-face 'font-lock-keyword-face - "Face to use for keywords.") - ) + "Face to use for keywords.")) (or (boundp 'font-lock-function-name-face) (defconst font-lock-function-name-face 'font-lock-function-name-face - "Face to use for function names.") - ) - ) - ;;(if (featurep 'font-lock) - (if (face-equal font-lock-type-face font-lock-comment-face) - (defconst font-lock-type-face - 'font-lock-type-face - "Face to use for basic data types.") - ) -;;; (if (fboundp 'eval-after-load) -;;; (eval-after-load "font-lock" -;;; '(if (face-equal font-lock-type-face -;;; font-lock-comment-face) -;;; (defconst font-lock-type-face -;;; 'font-lock-type-face -;;; "Face to use for basic data types.") -;;; ))) ; This does not work :-( Why?! -;;; ; Workaround: added to font-lock-m-h -;;; ) + "Face to use for function names."))) (or (boundp 'font-lock-other-emphasized-face) (defconst font-lock-other-emphasized-face 'font-lock-other-emphasized-face - "Face to use for another type of emphasizing.") - ) + "Face to use for another type of emphasizing.")) (or (boundp 'font-lock-emphasized-face) (defconst font-lock-emphasized-face 'font-lock-emphasized-face - "Face to use for emphasizing.") - ) + "Face to use for emphasizing.")) ;; Here we try to guess background (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode 'light)) (face-list (and (fboundp 'face-list) (face-list))) - is-face) - (fset 'is-face + cperl-is-face) + (fset 'cperl-is-face (cond ((fboundp 'find-face) (symbol-function 'find-face)) (face-list @@ -3597,7 +4146,12 @@ 'gray background) "Background as guessed by CPerl mode") - (if (is-face 'font-lock-type-face) nil + (if (and + (not (cperl-is-face 'font-lock-constant-face)) + (cperl-is-face 'font-lock-reference-face)) + nil + (copy-face 'font-lock-reference-face 'font-lock-constant-face)) + (if (cperl-is-face 'font-lock-type-face) nil (copy-face 'default 'font-lock-type-face) (cond ((eq background 'light) @@ -3612,7 +4166,7 @@ "pink"))) (t (set-face-background 'font-lock-type-face "gray90")))) - (if (is-face 'font-lock-other-type-face) + (if (cperl-is-face 'font-lock-other-type-face) nil (copy-face 'font-lock-type-face 'font-lock-other-type-face) (cond @@ -3626,7 +4180,7 @@ (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) - (if (is-face 'font-lock-other-emphasized-face) nil + (if (cperl-is-face 'font-lock-other-emphasized-face) nil (copy-face 'bold-italic 'font-lock-other-emphasized-face) (cond ((eq background 'light) @@ -3644,7 +4198,7 @@ "darkgreen" "dark green")))) (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) - (if (is-face 'font-lock-emphasized-face) nil + (if (cperl-is-face 'font-lock-emphasized-face) nil (copy-face 'bold 'font-lock-emphasized-face) (cond ((eq background 'light) @@ -3660,9 +4214,9 @@ "darkgreen" "dark green")))) (t (set-face-background 'font-lock-emphasized-face "gray90")))) - (if (is-face 'font-lock-variable-name-face) nil + (if (cperl-is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) - (if (is-face 'font-lock-constant-face) nil + (if (cperl-is-face 'font-lock-constant-face) nil (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) (error nil))) @@ -3678,11 +4232,13 @@ (append '(font-lock-emphasized-face font-lock-keyword-face font-lock-variable-name-face + font-lock-constant-face font-lock-reference-face font-lock-other-emphasized-face) ps-bold-faces)) (setq ps-italic-faces (append '(font-lock-other-type-face + font-lock-constant-face font-lock-reference-face font-lock-other-emphasized-face) ps-italic-faces)) @@ -3696,29 +4252,106 @@ (if (cperl-enable-font-lock) (cperl-windowed-init)) +(defconst cperl-styles-entries + '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset + cperl-label-offset cperl-extra-newline-before-brace + cperl-continued-statement-offset)) + +(defconst cperl-style-alist + '(("CPerl" ; =GNU without extra-newline-before-brace + (cperl-indent-level . 2) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-extra-newline-before-brace . nil) + (cperl-continued-statement-offset . 2)) + ("PerlStyle" ; CPerl with 4 as indent + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -4) + (cperl-extra-newline-before-brace . nil) + (cperl-continued-statement-offset . 4)) + ("GNU" + (cperl-indent-level . 2) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-extra-newline-before-brace . t) + (cperl-continued-statement-offset . 2)) + ("K&R" + (cperl-indent-level . 5) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -5) + (cperl-label-offset . -5) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-continued-statement-offset . 5)) + ("BSD" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -4) + (cperl-label-offset . -4) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-continued-statement-offset . 4)) + ("C++" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . -4) + (cperl-label-offset . -4) + (cperl-continued-statement-offset . 4) + (cperl-extra-newline-before-brace . t)) + ("Current") + ("Whitesmith" + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -4) + ;;(cperl-extra-newline-before-brace . nil) ; ??? + (cperl-continued-statement-offset . 4))) + "(Experimental) list of variables to set to get a particular indentation style. +Should be used via `cperl-set-style' or via CPerl menu.") + (defun cperl-set-style (style) "Set CPerl-mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. -Available styles are GNU, K&R, BSD and Whitesmith." +The list of styles is in `cperl-style-alist', available styles +are GNU, K&R, BSD, C++ and Whitesmith. + +The current value of style is memorized (unless there is a memorized +data already), may be restored by `cperl-set-style-back'. + +Chosing \"Current\" style will not change style, so this may be used for +side-effect of memorizing only." (interactive (let ((list (mapcar (function (lambda (elt) (list (car elt)))) - c-style-alist))) + cperl-style-alist))) (list (completing-read "Enter style: " list nil 'insist)))) - (let ((style (cdr (assoc style c-style-alist))) setting str sym) + (or cperl-old-style + (setq cperl-old-style + (mapcar (function + (lambda (name) + (cons name (eval name)))) + cperl-styles-entries))) + (let ((style (cdr (assoc style cperl-style-alist))) setting str sym) (while style (setq setting (car style) style (cdr style)) - (setq str (symbol-name (car setting))) - (and (string-match "^c-" str) - (setq str (concat "cperl-" (substring str 2))) - (setq sym (intern-soft str)) - (boundp sym) - (set sym (cdr setting)))))) + (set (car setting) (cdr setting))))) + +(defun cperl-set-style-back () + "Restore a style memorised by `cperl-set-style'." + (interactive) + (or cperl-old-style (error "The style was not changed")) + (let (setting) + (while cperl-old-style + (setq setting (car cperl-old-style) + cperl-old-style (cdr cperl-old-style)) + (set (car setting) (cdr setting))))) (defun cperl-check-syntax () (interactive) (require 'mode-compile) - (let ((perl-dbg-flags "-wc")) - (mode-compile))) + (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc"))) + (eval '(mode-compile)))) ; Avoid a warning (defun cperl-info-buffer (type) ;; Returns buffer with documentation. Creates if missing. @@ -4001,6 +4634,27 @@ (message "Parentheses will %sbe auto-doubled now." (if (cperl-val 'cperl-electric-parens) "" "not "))) +(defun cperl-toggle-autohelp () + "Toggle the state of automatic help message in CPerl mode. +See `cperl-lazy-help-time' too." + (interactive) + (if (fboundp 'run-with-idle-timer) + (progn + (if cperl-lazy-installed + (eval '(cperl-lazy-unstall)) + (cperl-lazy-install)) + (message "Perl help messages will %sbe automatically shown now." + (if cperl-lazy-installed "" "not "))) + (message "Cannot automatically show Perl help messages - run-with-idle-timer missing."))) + +(defun cperl-toggle-construct-fix () + "Toggle whether `indent-region'/`indent-sexp' fix whitespace too." + (interactive) + (setq cperl-indent-region-fix-constructs + (not cperl-indent-region-fix-constructs)) + (message "indent-region/indent-sexp will %sbe automatically fix whitespace." + (if cperl-indent-region-fix-constructs "" "not "))) + ;;;; Tags file creation. (defvar cperl-tmp-buffer " *cperl-tmp*") @@ -4061,10 +4715,6 @@ (push index index-alist))))) (or noninteractive (imenu-progress-message prev-pos 100)) - ;;(setq index-alist - ;; (if (default-value 'imenu-sort-function) - ;; (sort index-alist (default-value 'imenu-sort-function)) - ;; (nreverse index-alist))) index-alist)) (defun cperl-find-tags (file xs topdir) @@ -4532,6 +5182,7 @@ found-bad found))) (not not-found))) + ;;; Getting help (defvar cperl-have-help-regexp ;;(concat "\\(" @@ -4914,7 +5565,6 @@ 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 @@ -5042,7 +5692,7 @@ ... | ... Bitwise or. ... || ... Logical or. ~ ... Unary bitwise complement. -#! OS interpreter indicator. If has `perl', used for options, and -x. +#! OS interpreter indicator. If contains `perl', used for options, and -x. AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. CORE:: Prefix to access builtin function if imported sub obscures it. SUPER:: Prefix to lookup for a method in @ISA classes. @@ -5066,6 +5716,7 @@ glob EXPR Synonym of <EXPR>. lc [ EXPR ] Returns lowercased EXPR. lcfirst [ EXPR ] Returns EXPR with lower-cased first letter. +grep EXPR,LIST or grep {BLOCK} LIST Filters LIST via EXPR/BLOCK. map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST. no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. not ... Low-precedence synonym for ! - negation. @@ -5207,6 +5858,9 @@ (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))) (goto-char m1) @@ -5264,11 +5918,16 @@ )) (defun cperl-make-regexp-x () + ;; Returns position of the start (save-excursion (or cperl-use-syntax-table-text-property (error "I need to have regex marked!")) ;; Find the start - (re-search-backward "\\s|") ; Assume it is scanned already. + (if (looking-at "\\s|") + nil ; good already + (if (looking-at "[smy]\\s|") + (forward-char 1) + (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) (sub-p (eq (preceding-char) ?s)) s) @@ -5294,65 +5953,237 @@ "do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) - (cperl-make-regexp-x) - (re-search-backward "\\s|") ; Assume it is scanned already. - ;;(forward-char 1) + (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))) +(defun cperl-regext-to-level-start () + "Goto start of an enclosing group in regexp. +We suppose that the regexp is scanned already." + (interactive) + (let ((limit (cperl-make-regexp-x)) done) + (while (not done) + (or (eq (following-char) ?\() + (search-backward "(" (1+ limit) t) + (error "Cannot find `(' which starts a group")) + (setq done + (save-excursion + (skip-chars-backward "\\") + (looking-at "\\(\\\\\\\\\\)*("))) + (or done (forward-char -1))))) + (defun cperl-contract-level () "Find an enclosing group in regexp and contract it. Unfinished. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) - (let ((bb (cperl-make-regexp-x)) done) - (while (not done) - (or (eq (following-char) ?\() - (search-backward "(" (1+ bb) t) - (error "Cannot find `(' which starts a group")) - (setq done - (save-excursion - (skip-chars-backward "\\") - (looking-at "\\(\\\\\\\\\\)*("))) - (or done (forward-char -1))) - (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))) - (beginning-of-line 2) ; Skip - (setq s (point)) - (skip-chars-forward " \t") - (delete-region s (point)) - (indent-to-column c)) - (t - (delete-char -1) - (just-one-space))))))) + (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))) + (beginning-of-line 2) ; Skip + (setq s (point)) + (skip-chars-forward " \t") + (delete-region s (point)) + (indent-to-column c)) + (t + (delete-char -1) + (just-one-space)))))) + +(defun cperl-contract-levels () + "Find an enclosing group in regexp and contract all the kids. Unfinished. +\(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 + (goto-char (cperl-make-regexp-x)))) + (let ((b (point)) (e (make-marker)) s c) + (forward-sexp 1) + (set-marker e (1- (point))) + (goto-char (1+ b)) + (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) + (cond + ((match-beginning 1) ; Skip + nil) + (t ; Group + (cperl-contract-level)))))) (defun cperl-beautify-level () "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) - (let ((bb (cperl-make-regexp-x)) done) - (while (not done) - (or (eq (following-char) ?\() - (search-backward "(" (1+ bb) t) - (error "Cannot find `(' which starts a group")) - (setq done - (save-excursion - (skip-chars-backward "\\") - (looking-at "\\(\\\\\\\\\\)*("))) - (or done (forward-char -1))) - (let ((b (point)) (e (make-marker))) - (forward-sexp 1) - (set-marker e (1- (point))) - (cperl-beautify-regexp-piece b e nil)))) + (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))) + +(defun cperl-invert-if-unless () + "Changes `if (A) {B}' into `B if A;' if possible." + (interactive) + (or (looking-at "\\<") + (forward-sexp -1)) + (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\)\\>") + (let ((pos1 (point)) + pos2 pos3 pos4 pos5 s1 s2 state p pos45 + (s0 (buffer-substring (match-beginning 0) (match-end 0)))) + (forward-sexp 2) + (setq pos3 (point)) + (forward-sexp -1) + (setq pos2 (point)) + (if (eq (following-char) ?\( ) + (progn + (goto-char pos3) + (forward-sexp 1) + (setq pos5 (point)) + (forward-sexp -1) + (setq pos4 (point)) + ;; XXXX In fact may be `A if (B); {C}' ... + (if (and (eq (following-char) ?\{ ) + (progn + (cperl-backward-to-noncomment pos3) + (eq (preceding-char) ?\) ))) + (if (condition-case nil + (progn + (goto-char pos5) + (forward-sexp 1) + (forward-sexp -1) + (looking-at "\\<els\\(e\\|if\\)\\>")) + (error nil)) + (error + "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0) + (goto-char (1- pos5)) + (cperl-backward-to-noncomment pos4) + (if (eq (preceding-char) ?\;) + (forward-char -1)) + (setq pos45 (point)) + (goto-char pos4) + (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t) + (setq p (match-beginning 0) + s1 (buffer-substring p (match-end 0)) + state (parse-partial-sexp pos4 p)) + (or (nth 3 state) + (nth 4 state) + (nth 5 state) + (error "`%s' inside `%s' BLOCK" s1 s0)) + (goto-char (match-end 0))) + ;; Finally got it + (goto-char (1+ pos4)) + (skip-chars-forward " \t\n") + (setq s2 (buffer-substring (point) pos45)) + (goto-char pos45) + (or (looking-at ";?[ \t\n]*}") + (progn + (skip-chars-forward "; \t\n") + (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5)))))) + (and (equal s2 "") + (setq s2 "1")) + (goto-char (1- pos3)) + (cperl-backward-to-noncomment pos2) + (or (looking-at "[ \t\n]*)") + (goto-char (1- pos3))) + (setq p (point)) + (goto-char (1+ pos2)) + (skip-chars-forward " \t\n") + (setq s1 (buffer-substring (point) p)) + (delete-region pos4 pos5) + (delete-region pos2 pos3) + (goto-char pos1) + (insert s2 " ") + (just-one-space) + (forward-word 1) + (setq pos1 (point)) + (insert " " s1 ";") + (forward-char -1) + (delete-horizontal-space) + (goto-char pos1) + (just-one-space) + (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'"))) + +;;; By Anthony Foiani <afoiani@uswest.com> +;;; Getting help on modules in C-h f ? +;;; Need to teach it how to lookup functions +(defvar Man-filter-list) +(defun cperl-perldoc (word) + "Run a 'perldoc' on WORD." + (interactive + (list (let* ((default-entry (cperl-word-at-point)) + (input (read-string + (format "perldoc entry%s: " + (if (string= default-entry "") + "" + (format " (default %s)" default-entry)))))) + (if (string= input "") + (if (string= default-entry "") + (error "No perldoc args given") + default-entry) + input)))) + (let* ((is-func (and + (string-match "^[a-z]+$" word) + (string-match (concat "^" word "\\>") + (documentation-property + 'cperl-short-docs + 'variable-documentation)))) + (manual-program (if is-func "perldoc -f" "perldoc"))) + (require 'man) + (Man-getpage-in-background word))) + +(defun cperl-perldoc-at-point () + "Run a 'perldoc' on WORD." + (interactive) + (cperl-perldoc (cperl-word-at-point))) + +;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) +(defvar pod2man-program "pod2man") + +(defun cperl-pod-to-manpage () + "Create a virtual manpage in emacs from the Perl Online Documentation" + (interactive) + (require 'man) + (let* ((pod2man-args (concat buffer-file-name " | nroff -man ")) + (bufname (concat "Man " buffer-file-name)) + (buffer (generate-new-buffer bufname))) + (save-excursion + (set-buffer buffer) + (let ((process-environment (copy-sequence process-environment))) + ;; Prevent any attempt to use display terminal fanciness. + (setenv "TERM" "dumb") + (set-process-sentinel + (start-process pod2man-program buffer "sh" "-c" + (format (cperl-pod2man-build-command) pod2man-args)) + 'Man-bgproc-sentinel))))) + +(defun cperl-pod2man-build-command () + "Builds the entire background manpage and cleaning command." + (let ((command (concat pod2man-program " %s 2>/dev/null")) + (flist Man-filter-list)) + (while (and flist (car flist)) + (let ((pcom (car (car flist))) + (pargs (cdr (car flist)))) + (setq command + (concat command " | " pcom " " + (mapconcat '(lambda (phrase) + (if (not (stringp phrase)) + (error "Malformed Man-filter-list")) + phrase) + pargs " "))) + (setq flist (cdr flist)))) + command)) + +(defun cperl-lazy-install ()) ; Avoid a warning (if (fboundp 'run-with-idle-timer) (progn @@ -5391,6 +6222,43 @@ (setq cperl-help-shown t)))) (cperl-lazy-install))) + +;;; Plug for wrong font-lock: + +(defun cperl-font-lock-unfontify-region-function (beg end) + (let* ((modified (buffer-modified-p)) (buffer-undo-list t) + (inhibit-read-only t) (inhibit-point-motion-hooks t) + before-change-functions after-change-functions + deactivate-mark buffer-file-name buffer-file-truename) + (remove-text-properties beg end '(face nil)) + (when (and (not modified) (buffer-modified-p)) + (set-buffer-modified-p nil)))) + +(defvar cperl-d-l nil) +(defun cperl-fontify-syntaxically (end) + (let ((start (point)) (dbg (point))) + (or cperl-syntax-done-to + (setq cperl-syntax-done-to (point-min))) + (if (or (not (boundp 'font-lock-hot-pass)) + (eval 'font-lock-hot-pass)) + ;; Need to forget what is after `start' + (setq start (min cperl-syntax-done-to start)) + ;; Fontification without a change + (setq start (max cperl-syntax-done-to start))) + (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 1) + (message "Syntaxifying %s..%s from %s to %s" + dbg end start cperl-syntax-done-to)) ; For debugging + nil)) ; Do not iterate + (provide 'cperl-mode) ;;; cperl-mode.el ends here