;;; cperl-mode.el --- Perl code editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003 ;; Free Software Foundation, Inc. ;; Author: Ilya Zakharevich and Bob Olson ;; Maintainer: Ilya Zakharevich ;; Keywords: languages, Perl ;; This file is part of GNU Emacs. ;;; This code started from the following message of long time ago ;;; (IZ), but Bob does not maintain this mode any more: ;;; From: olson@mcs.anl.gov (Bob Olson) ;;; Newsgroups: comp.lang.perl ;;; Subject: cperl-mode: Another perl mode for Gnuemacs ;;; Date: 14 Aug 91 15:20:01 GMT ;; Copyright (C) Ilya Zakharevich and Bob Olson ;; This file may be distributed ;; either under the same terms as GNU Emacs, or under the same terms ;; as Perl. You should have received a copy of Perl Artistic license ;; along with the Perl distribution. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de ;;; Commentary: ;; $Id: cperl-mode.el,v 5.0 2003/02/17 01:33:20 vera Exp vera $ ;;; If your Emacs does not default to `cperl-mode' on Perl files: ;;; To use this mode put the following into ;;; your .emacs file: ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) ;; You can either fine-tune the bells and whistles of this mode or ;; bulk enable them by putting ;; (setq cperl-hairy t) ;; in your .emacs file. (Emacs rulers do not consider it politically ;; correct to make whistles enabled by default.) ;; 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'. <<<<<< ;; Additional useful commands to put into your .emacs file (before ;; RMS Emacs 20.3): ;; (setq auto-mode-alist ;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) ;; (setq interpreter-mode-alist (append interpreter-mode-alist ;; '(("miniperl" . perl-mode)))) ;; 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 ;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. ;; Faces used now: three faces for first-class and second-class keywords ;; and control flow words, one for each: comments, string, labels, ;; functions definitions and packages, arrays, hashes, and variable ;; definitions. If you do not see all these faces, your font-lock does ;; not define them, so you need to define them manually. ;; Maybe you have an obsolete font-lock from 19.28 or earlier. Upgrade. ;; If you have a grayscale monitor, and do not have the variable ;; font-lock-display-type bound to 'grayscale, insert ;; (setq font-lock-display-type 'grayscale) ;; into your .emacs file (this is relevant before RMS Emacs 20). ;; This mode supports font-lock, imenu and mode-compile. In the ;; hairy version font-lock is on, but you should activate imenu ;; yourself (note that mode-compile is not standard yet). Well, you ;; can use imenu from keyboard anyway (M-x imenu), but it is better ;; to bind it like that: ;; (define-key global-map [M-S-down-mouse-3] 'imenu) ;;; Font lock bugs as of v4.32: ;; The following kinds of Perl code erroneously start strings: ;; \$` \$' \$" ;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ ;; likewise with m, tr, y, q, qX instead of s ;;; In fact the version of font-lock that this version supports can be ;;; much newer than the version you actually have. This means that a ;;; lot of faces can be set up, but are not visible on your screen ;;; since the coloring rules for this faces are not defined. ;;; Updates: ======================================== ;;; Made less hairy by default: parentheses not electric, ;;; linefeed not magic. Bug with abbrev-mode corrected. ;;;; After 1.4: ;;; Better indentation: ;;; subs inside braces should work now, ;;; Toplevel braces obey customization. ;;; indent-for-comment knows about bad cases, cperl-indent-for-comment ;;; moves cursor to a correct place. ;;; cperl-indent-exp written from the scratch! Slow... (quadratic!) :-( ;;; (50 secs on DB::DB (sub of 430 lines), 486/66) ;;; Minor documentation fixes. ;;; Imenu understands packages as prefixes (including nested). ;;; Hairy options can be switched off one-by-one by setting to null. ;;; Names of functions and variables changed to conform to `cperl-' style. ;;;; After 1.5: ;;; Some bugs with indentation of labels (and embedded subs) corrected. ;;; `cperl-indent-region' done (slow :-()). ;;; `cperl-fill-paragraph' done. ;;; Better package support for `imenu'. ;;; Progress indicator for indentation (with `imenu' loaded). ;;; `Cperl-set' was busted, now setting the individual hairy option ;;; should be better. ;;;; After 1.6: ;;; `cperl-set-style' done. ;;; `cperl-check-syntax' done. ;;; Menu done. ;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'. ;;; Bugs with `cperl-auto-newline' corrected. ;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation ;;; like $hash{. ;;;; 1.7 XEmacs (arius@informatik.uni-erlangen.de): ;;; - use `next-command-event', if `next-command-events' does not exist ;;; - use `find-face' as def. of `is-face' ;;; - corrected def. of `x-color-defined-p' ;;; - added const defs for font-lock-comment-face, ;;; font-lock-keyword-face and font-lock-function-name-face ;;; - added def. of font-lock-variable-name-face ;;; - added (require 'easymenu) inside an `eval-when-compile' ;;; - replaced 4-argument `substitute-key-definition' with ordinary ;;; `define-key's ;;; - replaced `mark-active' in menu definition by `cperl-use-region-p'. ;;; Todo (at least): ;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz) ;;; for portable code? ;;; - should `cperl-mode' do a ;;; (if (featurep 'easymenu) (easy-menu-add cperl-menu)) ;;; or should this be left to the user's `cperl-mode-hook'? ;;; Some bugs introduced by the above fix corrected (IZ ;-). ;;; Some bugs under XEmacs introduced by the correction corrected. ;;; Some more can remain since there are two many different variants. ;;; Please feedback! ;;; We do not support fontification of arrays and hashes under ;;; obsolete font-lock any more. Upgrade. ;;;; after 1.8 Minor bug with parentheses. ;;;; after 1.9 Improvements from Joe Marzot. ;;;; after 1.10 ;;; Does not need easymenu to compile under XEmacs. ;;; `vc-insert-headers' should work better. ;;; Should work with 19.29 and 19.12. ;;; Small improvements to fontification. ;;; Expansion of keywords does not depend on C-? being backspace. ;;; after 1.10+ ;;; 19.29 and 19.12 supported. ;;; `cperl-font-lock-enhanced' deprecated. Use font-lock-extra.el. ;;; Support for font-lock-extra.el. ;;;; After 1.11: ;;; Tools submenu. ;;; Support for perl5-info. ;;; `imenu-go-find-at-position' in Tools requires imenu-go.el (see hints above) ;;; Imenu entries do not work with stock imenu.el. Patch sent to maintainers. ;;; Fontifies `require a if b;', __DATA__. ;;; Arglist for auto-fill-mode was incorrect. ;;;; After 1.12: ;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions ;;; vertically. ;;; `cperl-do-auto-fill' updated for 19.29 style. ;;; `cperl-info-on-command' now has a default. ;;; Workaround for broken C-h on XEmacs. ;;; VC strings escaped. ;;; C-h f now may prompt for function name instead of going on, ;;; controlled by `cperl-info-on-command-no-prompt'. ;;;; After 1.13: ;;; Msb buffer list includes perl files ;;; Indent-for-comment uses indent-to ;;; Can write tag files using etags. ;;;; After 1.14: ;;; Recognizes (tries to ;-) {...} which are not blocks during indentation. ;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block) ;;; Bug with auto-filling comments started with "##" corrected. ;;;; Very slow now: on DB::DB 0.91, 486/66: ;;;Function Name Call Count Elapsed Time Average Time ;;;======================================== ========== ============ ============ ;;;cperl-block-p 469 3.7799999999 0.0080597014 ;;;cperl-get-state 505 163.39000000 0.3235445544 ;;;cperl-comment-indent 12 0.0299999999 0.0024999999 ;;;cperl-backward-to-noncomment 939 4.4599999999 0.0047497337 ;;;cperl-calculate-indent 505 172.22000000 0.3410297029 ;;;cperl-indent-line 505 172.88000000 0.3423366336 ;;;cperl-use-region-p 40 0.0299999999 0.0007499999 ;;;cperl-indent-exp 1 177.97000000 177.97000000 ;;;cperl-to-comment-or-eol 1453 3.9800000000 0.0027391603 ;;;cperl-backward-to-start-of-continued-exp 9 0.0300000000 0.0033333333 ;;;cperl-indent-region 1 177.94000000 177.94000000 ;;;; After 1.15: ;;; Takes into account white space after opening parentheses during indent. ;;; May highlight pods and here-documents: see `cperl-pod-here-scan', ;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info ;;; for indentation so far. ;;; Fontification updated to 19.30 style. ;;; The change 19.29->30 did not add all the required functionality, ;;; but broke "font-lock-extra.el". Get "choose-color.el" from ;;; ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs ;;;; After 1.16: ;;; else # comment ;;; recognized as a start of a block. ;;; Two different font-lock-levels provided. ;;; `cperl-pod-head-face' introduced. Used for highlighting. ;;; `imenu' marks pods, +Packages moved to the head. ;;;; After 1.17: ;;; Scan for pods highlights here-docs too. ;;; Note that the tag of here-doc may be rehighlighted later by lazy-lock. ;;; Only one here-doc-tag per line is supported, and one in comment ;;; or a string may break fontification. ;;; POD headers were supposed to fill one line only. ;;;; After 1.18: ;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme ;;; may break under XEmacs. ;;; `cperl-calculate-indent' dis suppose that `parse-start' was defined. ;;; `fontified' tag is added to fontified text as well as `lazy-lock' (for ;;; compatibility with older lazy-lock.el) (older one overfontifies ;;; something nevertheless :-(). ;;; Will not indent something inside pod and here-documents. ;;; Fontifies the package name after import/no/bootstrap. ;;; Added new entry to menu with meta-info about the mode. ;;;; After 1.19: ;;; Prefontification works much better with 19.29. Should be checked ;;; with 19.30 as well. ;;; Some misprints in docs corrected. ;;; Now $a{-text} and -text => "blah" are fontified as strings too. ;;; Now the pod search is much stricter, so it can help you to find ;;; pod sections which are broken because of whitespace before =blah ;;; - just observe the fontification. ;;;; After 1.20 ;;; Anonymous subs are indented with respect to the level of ;;; indentation of `sub' now. ;;; {} is recognized as hash after `bless' and `return'. ;;; Anonymous subs are split by `cperl-linefeed' as well. ;;; Electric parens embrace a region if present. ;;; To make `cperl-auto-newline' useful, ;;; `cperl-auto-newline-after-colon' is introduced. ;;; `cperl-electric-parens' is now t or nul. The old meaning is moved to ;;; `cperl-electric-parens-string'. ;;; `cperl-toggle-auto-newline' introduced, put on C-c C-a. ;;; `cperl-toggle-abbrev' introduced, put on C-c C-k. ;;; `cperl-toggle-electric' introduced, put on C-c C-e. ;;; Beginning-of-defun-regexp was not anchored. ;;;; After 1.21 ;;; Auto-newline grants `cperl-extra-newline-before-brace' if "{" is typed ;;; after ")". ;;; {} is recognized as expression after `tr' and friends. ;;;; After 1.22 ;;; Entry Hierarchy added to imenu. Very primitive so far. ;;; One needs newer `imenu-go'.el. A patch to `imenu' is needed as well. ;;; Writes its own TAGS files. ;;; Class viewer based on TAGS files. Does not trace @ISA so far. ;;; 19.31: Problems with scan for PODs corrected. ;;; First POD header correctly fontified. ;;; I needed (setq imenu-use-keymap-menu t) to get good imenu in 19.31. ;;; Apparently it makes a lot of hierarchy code obsolete... ;;;; After 1.23 ;;; Tags filler now scans *.xs as well. ;;; The info from *.xs scan is used by the hierarchy viewer. ;;; Hierarchy viewer documented. ;;; Bug in 19.31 imenu documented. ;;;; After 1.24 ;;; New location for info-files mentioned, ;;; Electric-; should work better. ;;; Minor bugs with POD marking. ;;;; After 1.25 (probably not...) ;;; `cperl-info-page' introduced. ;;; To make `uncomment-region' working, `comment-region' would ;;; not insert extra space. ;;; Here documents delimiters better recognized ;;; (empty one, and non-alphanums in quotes handled). May be wrong with 1<<14? ;;; `cperl-db' added, used in menu. ;;; imenu scan removes text-properties, for better debugging ;;; - but the bug is in 19.31 imenu. ;;; formats highlighted by font-lock and prescan, embedded comments ;;; are not treated. ;;; POD/friends scan merged in one pass. ;;; Syntax class is not used for analyzing the code, only char-syntax ;;; may be checked against _ or'ed with w. ;;; Syntax class of `:' changed to be _. ;;; `cperl-find-bad-style' added. ;;;; After 1.25 ;;; When search for here-documents, we ignore commented << in simplest cases. ;;; `cperl-get-help' added, available on C-h v and from menu. ;;; Auto-help added. Default with `cperl-hairy', switchable on/off ;;; with startup variable `cperl-lazy-help-time' and from ;;; menu. Requires `run-with-idle-timer'. ;;; Highlighting of @abc{@efg} was wrong - interchanged two regexps. ;;;; After 1.27 ;;; Indentation: At toplevel after a label - fixed. ;;; 1.27 was put to archives in binary mode ===> DOSish :-( ;;;; After 1.28 ;;; Thanks to Martin Buchholz : misprints in ;;; comments and docstrings corrected, XEmacs support cleaned up. ;;; The closing parenths would enclose the region into matching ;;; parens under the same conditions as the opening ones. ;;; Minor updates to `cperl-short-docs'. ;;; Will not consider <<= as start of here-doc. ;;;; After 1.29 ;;; Added an extra advice to look into Micro-docs. ;-). ;;; Enclosing of region when you press a closing parenth is regulated by ;;; `cperl-electric-parens-string'. ;;; Minor updates to `cperl-short-docs'. ;;; `initialize-new-tags-table' called only if present (Does this help ;;; with generation of tags under XEmacs?). ;;; When creating/updating tag files, new info is written at the old place, ;;; or at the end (is this a wanted behaviour? I need this in perl build directory). ;;;; After 1.30 ;;; All the keywords from keywords.pl included (maybe with dummy explanation). ;;; No auto-help inside strings, comment, here-docs, formats, and pods. ;;; Shrinkwrapping of info, regulated by `cperl-max-help-size', ;;; `cperl-shrink-wrap-info-frame'. ;;; Info on variables as well. ;;; Recognision of HERE-DOCS improved yet more. ;;; Autonewline works on `}' without warnings. ;;; Autohelp works again on $_[0]. ;;;; After 1.31 ;;; perl-descr.el found its author - hi, Johan! ;;; Some support for correct indent after here-docs and friends (may ;;; be superseeded by eminent change to Emacs internals). ;;; Should work with older Emaxen as well ( `-style stuff removed). ;;;; After 1.32 ;;; Started to add support for `syntax-table' property (should work ;;; with patched Emaxen), controlled by ;;; `cperl-use-syntax-table-text-property'. Currently recognized: ;;; All quote-like operators: m, s, y, tr, qq, qw, qx, q, ;;; // in most frequent context: ;;; after block or ;;; ~ { ( = | & + - * ! , ; ;;; or ;;; while if unless until and or not xor split grep map ;;; Here-documents, formats, PODs, ;;; ${...} ;;; 'abc$' ;;; sub a ($); sub a ($) {} ;;; (provide 'cperl-mode) was missing! ;;; `cperl-after-expr-p' is now much smarter after `}'. ;;; `cperl-praise' added to mini-docs. ;;; Utilities try to support subs-with-prototypes. ;;;; After 1.32.1 ;;; `cperl-after-expr-p' is now much smarter after "() {}" and "word {}": ;;; if word is "else, map, grep". ;;; Updated for new values of syntax-table constants. ;;; Uses `help-char' (at last!) (disabled, does not work?!) ;;; A couple of regexps where missing _ in character classes. ;;; -s could be considered as start of regexp, 1../blah/ was not, ;;; as was not /blah/ at start of file. ;;;; After 1.32.2 ;;; "\C-hv" was wrongly "\C-hf" ;;; C-hv was not working on `[index()]' because of [] in skip-chars-*. ;;; `__PACKAGE__' supported. ;;; Thanks for Greg Badros: `cperl-lazy-unstall' is more complete, ;;; `cperl-get-help' is made compatible with `query-replace'. ;;;; As of Apr 15, development version of 19.34 supports ;;;; `syntax-table' text properties. Try setting ;;;; `cperl-use-syntax-table-text-property'. ;;;; After 1.32.3 ;;; We scan for s{}[] as well (in simplest situations). ;;; We scan for $blah'foo as well. ;;; The default is to use `syntax-table' text property if Emacs is good enough. ;;; `cperl-lineup' is put on C-M-| (=C-M-S-\\). ;;; Start of `cperl-beautify-regexp'. ;;;; After 1.32.4 ;;; `cperl-tags-hier-init' did not work in text-mode. ;;; `cperl-noscan-files-regexp' had a misprint. ;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu' ;;; in 19.34. ;;;; After 1.33: ;;; my,local highlight vars after {} too. ;;; TAGS could not be created before imenu was loaded. ;;; `cperl-indent-left-aligned-comments' created. ;;; Logic of `cperl-indent-exp' changed a little bit, should be more ;;; robust w.r.t. multiline strings. ;;; Recognition of blah'foo takes into account strings. ;;; Added '.al' to the list of Perl extensions. ;;; Class hierarchy is "mostly" sorted (need to rethink algorthm ;;; of pruning one-root-branch subtrees to get yet better sorting.) ;;; Regeneration of TAGS was busted. ;;; Can use `syntax-table' property when generating TAGS ;;; (governed by `cperl-use-syntax-table-text-property-for-tags'). ;;;; After 1.35: ;;; Can process several =pod/=cut sections one after another. ;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'. ;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour). ;;; Beautifier for regexps fixed. ;;; `cperl-beautify-level', `cperl-contract-level' coded ;;; ;;;; Emacs's 20.2 problems: ;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work. ;;; Couple of others problems with 20.2 were reported, my ability to check/fix ;;; them is very reduced now. ;;;; After 1.36: ;;; 'C-M-|' in XEmacs fixed ;;;; After 1.37: ;;; &&s was not recognized as start of regular expression; ;;; Will "preprocess" the contents of //e part of s///e too; ;;; What to do with s# blah # foo #e ? ;;; Should handle s;blah;foo;; better. ;;; Now the only known problems with regular expression recognition: ;;;;;;; s/bar/ - different delimiters (end ignored) ;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into one chunk) ;;;;;;; s/foo// - empty subst (made into one chunk + '/') ;;;;;;; s/foo/(bar)/ - start-group at start of subst (internal group will not match backwards) ;;;; After 1.38: ;;; We highlight closing / of s/blah/foo/e; ;;; This handles s# blah # foo #e too; ;;; s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm ;;; is much simpler now; ;;; Next round of changes: s\\\ works, s/foo/, ;;; comments between the first and the second part allowed ;;; Another problem discovered: ;;;;;;; s[foo] e - e part delimited by different <> (will not match) ;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined ;;; - put a stupid workaround for 20.1 ;;;; After 1.39: ;;; Could indent here-docs for comments; ;;; These problems fixed: ;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into two chunk) ;;;;;;; s[foo] e - "e" part delimited by "different" <> (will match) ;;; Matching brackets honor prefices, may expand abbreviations; ;;; When expanding abbrevs, will remove last char only after ;;; self-inserted whitespace; ;;; More convenient "Refress hard constructs" in menu; ;;; `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs' ;;; added (for -batch mode); ;;; Better handling of errors when scanning for Perl constructs; ;;;;;;; Possible "problem" with class hierarchy in Perl distribution ;;;;;;; directory: ./ext duplicates ./lib; ;;; Write relative paths for generated TAGS; ;;;; After 1.40: ;;; s /// may be separated by "\n\f" too; ;;; `s #blah' recognized as a comment; ;;; Would highlight s/abc//s wrong; ;;; Debugging code in `cperl-electric-keywords' was leaking a message; ;;;; After 1.41: ;;; RMS changes for 20.3 merged ;;;; 2.0.1.0: RMS mode (has 3 misprints) ;;;; After 2.0: ;;; RMS whitespace changes for 20.3 merged ;;;; After 2.1: ;;; History updated ;;;; After 2.2: ;;; Merge `c-style-alist' since `c-mode' is no more. (Somebody who ;;; uses the styles should check that they work OK!) ;;; All the variable warnings go away, some undef functions too. ;;;; After 2.3: ;;; Added `cperl-perldoc' (thanks to Anthony Foiani ) ;;; Added `cperl-pod-to-manpage' (thanks to Nick Roberts ) ;;; All the function warnings go away. ;;;; After 2.4: ;;; `Perl doc', `Regexp' submenus created (latter to allow short displays). ;;; `cperl-clobber-lisp-bindings' added. ;;; $a->y() is not y///. ;;; `cperl-after-block-p' was missing a `save-excursion' => wrong results. ;;; `cperl-val' was defined too late. ;;; `cperl-init-faces' was failing. ;;; Init faces when loading `ps-print'. ;;;; After 2.4: ;;; `cperl-toggle-autohelp' implemented. ;;; `while SPACE LESS' was buggy. ;;; `-text' in `[-text => 1]' was not highlighted. ;;; `cperl-after-block-p' was FALSE after `sub f {}'. ;;;; After 2.5: ;;; `foreachmy', `formy' expanded too. ;;; Expand `=pod-directive'. ;;; `cperl-linefeed' behaves reasonable in POD-directive lines. ;;; `cperl-electric-keyword' prints a message, governed by ;;; `cperl-message-electric-keyword'. ;;;; After 2.6: ;;; Typing `}' was not checking for being block or not. ;;; Beautifying levels in RE: Did not know about lookbehind; ;;; finding *which* level was not intuitive; ;;; `cperl-beautify-levels' added. ;;; Allow here-docs contain `=head1' and friends (at least for keywords). ;;;; After 2.7: ;;; Fix for broken `font-lock-unfontify-region-function'. Should ;;; preserve `syntax-table' properties even with `lazy-lock'. ;;;; After 2.8: ;;; Some more compile time warnings crept in. ;;; `cperl-indent-region-fix-else' implemented. ;;; `cperl-fix-line-spacing' implemented. ;;; `cperl-invert-if-unless' implemented (C-c C-t and in Menu). ;;; Upgraded hints to mention 20.2's goods/bads. ;;; Started to use `cperl-extra-newline-before-brace-multiline', ;;; `cperl-break-one-line-blocks-when-indent', ;;; `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'. ;;;; After 2.9: ;;; 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'. ;;; (We expect that starting from 19.33, `font-lock' supports keywords ;;; being a function - what is a correct version?) ;;; Rename `cperl-indent-region-fix-else' to ;;; `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' and `cperl-fix-line-spacing' handle ;;; `continue' too. ;;; Indentation after {BLOCK} knows about map/printf/etc. ;;; Finally: treat after-comma lines as continuation lines. ;;;; After 2.10: ;;; `continue' made electric. ;;; Electric `do' inserts `do/while'. ;;; Some extra compile-time warnings crept in. ;;; `font-lock' of 19.33 could not handle font-lock-keywords being a function ;;; returning a symbol. ;;;; After 2.11: ;;; Changes to make syntaxification to be autoredone via `font-lock'. ;;; Switched on by `cperl-syntaxify-by-font-lock', off by default so far. ;;;; After 2.12: ;;; Remove some commented out chunks. ;;; Styles are slightly updated (a lot of work is needed, especially ;;; with new `cperl-fix-line-spacing'). ;;;; After 2.13: ;;; 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' added on C-c C-w and menu. ;;; `auto-fill-mode' added on C-c C-f and menu. ;;; `PerlStyle' style added. ;;; Message for termination of scan corrected. ;;;; After 2.14: ;;; Did not work with -q ;;;; After 2.15: ;;; `cperl-speed' hints added. ;;; Minor style fixes. ;;;; After 2.15: ;;; Make backspace electric after expansion of `else/continue' too. ;;;; After 2.16: ;;; Starting to merge changes to RMS emacs version. ;;;; After 2.17: ;;; Merged custom stuff and darn `font-lock-constant-face'. ;;;; After 2.18: ;;; Bumped the version to 3.1 ;;;; After 3.1: ;;; Fixed customization to honor cperl-hairy. ;;; Created customization groups. Sent to RMS to include into 2.3. ;;;; After 3.2: ;;; Interaction of `font-lock-hot-pass' and `cperl-syntaxify-by-font-lock'. ;;; (`cperl-after-block-and-statement-beg'): ;;; (`cperl-after-block-p'): ;;; (`cperl-after-expr-p'): It is BLOCK if we reach lim when backup sexp. ;;; (`cperl-indent-region'): Make a marker for END - text added/removed. ;;; (`cperl-style-alist', `cperl-styles-entries') ;;; Include `cperl-merge-trailing-else' where the value is clear. ;;;; After 3.3: ;;; (`cperl-tips'): ;;; (`cperl-problems'): Improvements to docs. ;;;; After 3.4: ;;; (`cperl-mode'): Make lazy syntaxification possible. ;;; (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to ;;; restart syntaxification. ;;; (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now. ;;;; After 3.5: ;;; (`cperl-syntaxify-by-font-lock'): Better default, customizes to ;;; `message' too. ;;;; After 3.6: ;;; (`cperl-find-pods-heres'): changed so that -d ?foo? is a RE. ;;; (`cperl-array-face'): changed name from `font-lock-emphasized-face'. ;;; (`cperl-hash-face'): changed name from `font-lock-other-emphasized-face'. ;;; Use `defface' to define these two extra faces. ;;;; After 3.7: ;;; Can use linear algorithm for indentation if Emacs supports it: ;;; indenting DB::DB (800+ lines) improved from 69 sec to 11 sec ;;; (73 vs 15 with imenu). ;;; (`cperl-emacs-can-parse'): New state. ;;; (`cperl-indent-line'): Corrected to use global state. ;;; (`cperl-calculate-indent'): Likewise. ;;; (`cperl-fix-line-spacing'): Likewise (not used yet). ;;;; After 3.8: ;;; (`cperl-choose-color'): Converted to a function (to be compilable in text-mode). ;;;; After 3.9: ;;; (`cperl-dark-background '): Disable without window-system. ;;;; After 3.10: ;;; Do `defface' only if window-system. ;;;; After 3.11: ;;; (`cperl-fix-line-spacing'): sped up to bail out early. ;;; (`cperl-indent-region'): Disable hooks during the call (how to call them later?). ;;; Now indents 820-line-long function in 6.5 sec (including syntaxification) the first time ;;; (when buffer has few properties), 7.1 sec the second time. ;;;Function Name Call Count Elapsed Time Average Time ;;;========================================= ========== ============ ============ ;;;cperl-indent-exp 1 10.039999999 10.039999999 ;;;cperl-indent-region 1 10.0 10.0 ;;;cperl-indent-line 821 6.2100000000 0.0075639464 ;;;cperl-calculate-indent 821 5.0199999999 0.0061144945 ;;;cperl-backward-to-noncomment 2856 2.0500000000 0.0007177871 ;;;cperl-fontify-syntaxically 2 1.78 0.8900000000 ;;;cperl-find-pods-heres 2 1.78 0.8900000000 ;;;cperl-update-syntaxification 1 1.78 1.78 ;;;cperl-fix-line-spacing 769 1.4800000000 0.0019245773 ;;;cperl-after-block-and-statement-beg 163 1.4100000000 0.0086503067 ;;;cperl-block-p 775 1.1800000000 0.0015225806 ;;;cperl-to-comment-or-eol 3652 1.1200000000 0.0003066812 ;;;cperl-after-block-p 165 1.0500000000 0.0063636363 ;;;cperl-commentify 141 0.22 0.0015602836 ;;;cperl-get-state 813 0.16 0.0001968019 ;;;cperl-backward-to-start-of-continued-exp 26 0.12 0.0046153846 ;;;cperl-delay-update-hook 2107 0.0899999999 4.271...e-05 ;;;cperl-protect-defun-start 141 0.0700000000 0.0004964539 ;;;cperl-after-label 407 0.0599999999 0.0001474201 ;;;cperl-forward-re 139 0.0299999999 0.0002158273 ;;;cperl-comment-indent 26 0.0299999999 0.0011538461 ;;;cperl-use-region-p 8 0.0 0.0 ;;;cperl-lazy-hook 15 0.0 0.0 ;;;cperl-after-expr-p 8 0.0 0.0 ;;;cperl-font-lock-unfontify-region-function 1 0.0 0.0 ;;;Function Name Call Count Elapsed Time Average Time ;;;========================================= ========== ============ ============ ;;;cperl-fix-line-spacing 769 1.4500000000 0.0018855656 ;;;cperl-indent-line 13 0.3100000000 0.0238461538 ;;;cperl-after-block-and-statement-beg 69 0.2700000000 0.0039130434 ;;;cperl-after-block-p 69 0.2099999999 0.0030434782 ;;;cperl-calculate-indent 13 0.1000000000 0.0076923076 ;;;cperl-backward-to-noncomment 177 0.0700000000 0.0003954802 ;;;cperl-get-state 13 0.0 0.0 ;;;cperl-to-comment-or-eol 179 0.0 0.0 ;;;cperl-get-help-defer 1 0.0 0.0 ;;;cperl-lazy-hook 11 0.0 0.0 ;;;cperl-after-expr-p 2 0.0 0.0 ;;;cperl-block-p 13 0.0 0.0 ;;;cperl-after-label 5 0.0 0.0 ;;;; After 3.12: ;;; (`cperl-find-pods-heres'): do not warn on `=cut' if doing a chunk only. ;;;; After 3.13: ;;; (`cperl-mode'): load pseudo-faces on `cperl-find-pods-heres' (for 19.30). ;;; (`x-color-defined-p'): was not compiling on XEmacs ;;; (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE ;;; made into a string. ;;;; After 3.14: ;;; (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step ;;; Recognition of was wrong. ;;; (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones ;;; (`cperl-unwind-to-safe'): New function. ;;; (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position. ;;;; After 3.15: ;;; (`cperl-forward-re'): Highlight the trailing / in s/foo// as string. ;;; Highlight the starting // in s//foo/ as function-name. ;;;; After 3.16: ;;; (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword. ;;;; After 4.0: ;;; (`cperl-find-pods-heres'): `qr' added ;;; (`cperl-electric-keyword'): Likewise ;;; (`cperl-electric-else'): Likewise ;;; (`cperl-to-comment-or-eol'): Likewise ;;; (`cperl-make-regexp-x'): Likewise ;;; (`cperl-init-faces'): Likewise, and `lock' (as overridable?). ;;; (`cperl-find-pods-heres'): Knows that split// is null-RE. ;;; Highlights separators in 3-parts expressions ;;; as labels. ;;;; After 4.1: ;;; (`cperl-find-pods-heres'): <> was considered as a glob ;;; (`cperl-syntaxify-unwind'): New configuration variable ;;; (`cperl-fontify-m-as-s'): New configuration variable ;;;; After 4.2: ;;; (`cperl-find-pods-heres'): of the last line being `=head1' fixed. ;;; Handling of a long construct is still buggy if only the part of ;;; construct touches the updated region (we unwind to the start of ;;; long construct, but the end may have residual properties). ;;; (`cperl-unwind-to-safe'): would not go to beginning of buffer. ;;; (`cperl-electric-pod'): check for after-expr was performed ;;; inside of POD too. ;;;; After 4.3: ;;; (`cperl-backward-to-noncomment'): better treatment of PODs and HEREs. ;;; Indent-line works good, but indent-region does not - at toplevel... ;;; (`cperl-unwind-to-safe'): Signature changed. ;;; (`x-color-defined-p'): was defmacro'ed with a tick. Remove another def. ;;; (`cperl-clobber-mode-lists'): New configuration variable. ;;; (`cperl-array-face'): One of definitions was garbled. ;;;; After 4.4: ;;; (`cperl-not-bad-style-regexp'): Updated. ;;; (`cperl-make-regexp-x'): Misprint in a message. ;;; (`cperl-find-pods-heres'): $a-1 ? foo : bar; was a regexp. ;;; `<< (' was considered a start of POD. ;;; Init: `cperl-is-face' was busted. ;;; (`cperl-make-face'): New macros. ;;; (`cperl-force-face'): New macros. ;;; (`cperl-init-faces'): Corrected to use new macros; ;;; `if' for copying `reference-face' to ;;; `constant-face' was backward. ;;; (`font-lock-other-type-face'): Done via `defface' too. ;;;; After 4.5: ;;; (`cperl-init-faces-weak'): use `cperl-force-face'. ;;; (`cperl-after-block-p'): After END/BEGIN we are a block. ;;; (`cperl-mode'): `font-lock-unfontify-region-function' ;;; was set to a wrong function. ;;; (`cperl-comment-indent'): Commenting __END__ was not working. ;;; (`cperl-indent-for-comment'): Likewise. ;;; (Indenting is still misbehaving at toplevel.) ;;;; After 4.5: ;;; (`cperl-unwind-to-safe'): Signature changed, unwinds end too. ;;; (`cperl-find-pods-heres'): mark qq[]-etc sections as syntax-type=string ;;; (`cperl-fontify-syntaxically'): Unwinds start and end to go out of ;;; long strings (not very successful). ;;; >>>> CPerl should be usable in write mode too now <<<< ;;; (`cperl-syntaxify-by-font-lock'): Better default - off in text-mode. ;;; (`cperl-tips'): Updated docs. ;;; (`cperl-problems'): Updated docs. ;;;; After 4.6: ;;; (`cperl-calculate-indent'): Did not consider `,' as continuation mark for statements. ;;; (`cperl-write-tags'): Correct for XEmacs's `visit-tags-table-buffer'. ;;;; After 4.7: ;;; (`cperl-calculate-indent'): Avoid parse-data optimization at toplevel. ;;; Should indent correctly at toplevel too. ;;; (`cperl-tags-hier-init'): Gross hack to pretend we work (are we?). ;;; (`cperl-find-pods-heres'): Was not processing sub protos after a comment ine. ;;; Was treating $a++ <= 5 as a glob. ;;;; After 4.8: ;;; (toplevel): require custom unprotected => failure on 19.28. ;;; (`cperl-xemacs-p') defined when compile too ;;; (`cperl-tags-hier-init'): Another try to work around XEmacs problems ;;; Better progress messages. ;;; (`cperl-find-tags'): Was writing line/pos in a wrong order, ;;; pos off by 1 and not at beg-of-line. ;;; (`cperl-etags-snarf-tag'): New macro ;;; (`cperl-etags-goto-tag-location'): New macro ;;; (`cperl-write-tags'): When removing old TAGS info was not ;;; relativizing filename ;;;; After 4.9: ;;; (`cperl-version'): New variable. New menu entry ;;;; After 4.10: ;;; (`cperl-tips'): Updated. ;;; (`cperl-non-problems'): Updated. ;;; random: References to future 20.3 removed. ;;;; After 4.11: ;;; (`perl-font-lock-keywords'): Would not highlight `sub foo($$);'. ;;; Docstrings: Menu was described as `CPerl' instead of `Perl' ;;;; After 4.12: ;;; (`cperl-toggle-construct-fix'): Was toggling to t instead of 1. ;;; (`cperl-ps-print-init'): Associate `cperl-array-face', `cperl-hash-face' ;;; remove `font-lock-emphasized-face'. ;;; remove `font-lock-other-emphasized-face'. ;;; remove `font-lock-reference-face'. ;;; remove `font-lock-keyword-face'. ;;; Use `eval-after-load'. ;;; (`cperl-init-faces'): remove init `font-lock-other-emphasized-face'. ;;; remove init `font-lock-emphasized-face'. ;;; remove init `font-lock-keyword-face'. ;;; (`cperl-tips-faces'): New variable and an entry into Mini-docs. ;;; (`cperl-indent-region'): Do not indent whitespace lines ;;; (`cperl-indent-exp'): Was not processing else-blocks. ;;; (`cperl-calculate-indent'): Remove another parse-data optimization ;;; at toplevel: would indent correctly. ;;; (`cperl-get-state'): NOP line removed. ;;;; After 4.13: ;;; (`cperl-ps-print-init'): Remove not-CPerl-related faces. ;;; (`cperl-ps-print'): New function and menu entry. ;;; (`cperl-ps-print-face-properties'): New configuration variable. ;;; (`cperl-invalid-face'): New configuration variable. ;;; (`cperl-nonoverridable-face'): New face. Renamed from ;;; `font-lock-other-type-face'. ;;; (`perl-font-lock-keywords'): Highlight trailing whitespace ;;; (`cperl-contract-levels'): Documentation corrected. ;;; (`cperl-contract-level'): Likewise. ;;;; After 4.14: ;;; (`cperl-ps-print'): `ps-print-face-extension-alist' was not in old Emaxen, ;;; same with `ps-extend-face-list' ;;; (`cperl-ps-extend-face-list'): New macro. ;;;; After 4.15: ;;; (`cperl-init-faces'): Interpolate `cperl-invalid-face'. ;;; (`cperl-forward-re'): Emit a meaningful error instead of a cryptic ;;; one for uncomplete REx near end-of-buffer. ;;; (`cperl-find-pods-heres'): Tolerate unfinished REx at end-of-buffer. ;;;; After 4.16: ;;; (`cperl-find-pods-heres'): `unwind-protect' was left commented. ;;;; After 4.17: ;;; (`cperl-invalid-face'): Change to ''underline. ;;;; After 4.18: ;;; (`cperl-find-pods-heres'): / and ? after : start a REx. ;;; (`cperl-after-expr-p'): Skip labels when checking ;;; (`cperl-calculate-indent'): Correct for labels when calculating ;;; indentation of continuations. ;;; Docstring updated. ;;;; After 4.19: ;;; Minor (mostly spelling) corrections from 20.3.3 merged. ;;;; After 4.20: ;;; (`cperl-tips'): Another workaround added. Sent to RMS for 20.4. ;;;; After 4.21: ;;; (`cperl-praise'): Mention linear-time indent. ;;; (`cperl-find-pods-heres'): @if ? a : b was considered a REx. ;;;; After 4.22: ;;; (`cperl-after-expr-p'): Make true after __END__. ;;; (`cperl-electric-pod'): "SYNOPSIS" was misspelled. ;;;; After 4.23: ;;; (`cperl-beautify-regexp-piece'): Was not allowing for *? after a class. ;;; Allow for POSIX char-classes. ;;; Remove trailing whitespace when ;;; adding new linebreak. ;;; Add a level counter to stop shallow. ;;; Indents unprocessed groups rigidly. ;;; (`cperl-beautify-regexp'): Add an optional count argument to go that ;;; many levels deep. ;;; (`cperl-beautify-level'): Likewise ;;; Menu: Add new entries to Regexp menu to do one level ;;; (`cperl-contract-level'): Was entering an infinite loop ;;; (`cperl-find-pods-heres'): Typo (double quoting). ;;; Was detecting < $file > as FH instead of glob. ;;; Support for comments in RExen (except ;;; for m#\#comment#x), governed by ;;; `cperl-regexp-scan'. ;;; (`cperl-regexp-scan'): New customization variable. ;;; (`cperl-forward-re'): Improve logic of resetting syntax table. ;;;; After 4.23 and: After 4.24: ;;; (`cperl-contract-levels'): Restore position. ;;; (`cperl-beautify-level'): Likewise. ;;; (`cperl-beautify-regexp'): Likewise. ;;; (`cperl-commentify'): Rudimental support for length=1 runs ;;; (`cperl-find-pods-heres'): Process 1-char long REx comments too /a#/x ;;; Processes REx-comments in #-delimited RExen. ;;; MAJOR BUG CORRECTED: after a misparse ;;; a body of a subroutine could be corrupted!!! ;;; One might need to reeval the function body ;;; to fix things. (A similar bug was ;;; present in `cperl-indent-region' eons ago.) ;;; To reproduce: ;; (defun foo () (let ((a '(t))) (insert (format "%s" a)) (setcar a 'BUG) t)) ;; (foo) ;; (foo) ;;; C-x C-e the above three lines (at end-of-line). First evaluation ;;; of `foo' inserts (t), second one inserts (BUG) ?! ;;; ;;; In CPerl it was triggered by inserting then deleting `/' at start of ;;; / a (?# asdf {[(}asdf )ef,/; ;;;; After 4.25: ;;; (`cperl-commentify'): Was recognizing length=2 "strings" as length=1. ;;; (`imenu-example--create-perl-index'): ;;; Was not enforcing syntaxification-to-the-end. ;;; (`cperl-invert-if-unless'): Allow `for', `foreach'. ;;; (`cperl-find-pods-heres'): Quote `cperl-nonoverridable-face'. ;;; Mark qw(), m()x as indentable. ;;; (`cperl-init-faces'): Highlight `sysopen' too. ;;; Highlight $var in `for my $var' too. ;;; (`cperl-invert-if-unless'): Was leaving whitespace at end. ;;; (`cperl-linefeed'): Was splitting $var{$foo} if point after `{'. ;;; (`cperl-calculate-indent'): Remove old commented out code. ;;; Support (primitive) indentation of qw(), m()x. ;;;; After 4.26: ;;; (`cperl-problems'): Mention `fill-paragraph' on comment. \"" and ;;; q [] with intervening newlines. ;;; (`cperl-autoindent-on-semi'): New customization variable. ;;; (`cperl-electric-semi'): Use `cperl-autoindent-on-semi'. ;;; (`cperl-tips'): Mention how to make CPerl the default mode. ;;; (`cperl-mode'): Support `outline-minor-mode' ;;; (Thanks to Mark A. Hershberger). ;;; (`cperl-outline-level'): New function. ;;; (`cperl-highlight-variables-indiscriminately'): New customization var. ;;; (`cperl-init-faces'): Use `cperl-highlight-variables-indiscriminately'. ;;; (Thanks to Sean Kamath ). ;;; (`cperl-after-block-p'): Support CHECK and INIT. ;;; (`cperl-init-faces'): Likewise and "our". ;;; (Thanks to Doug MacEachern ). ;;; (`cperl-short-docs'): Likewise and "our". ;;;; After 4.27: ;;; (`cperl-find-pods-heres'): Recognize \"" as a string. ;;; Mark whitespace and comments between q and [] ;;; as `syntax-type' => `prestring'. ;;; Allow whitespace between << and "FOO". ;;; (`cperl-problems'): Remove \"" and q [] with intervening newlines. ;;; Mention multiple < t. ;;; Do not recognize $opt_s and $opt::s as s///. ;;; (`cperl-perldoc'): Use case-sensitive search (contributed). ;;; (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when ;;; underscore isn't a word char (gdj-contributed). ;;; (`defun-prompt-regexp'): Allow prototypes. ;;; (`cperl-vc-header-alist'): Extract numeric version from the Id. ;;; Toplevel: Put toggle-autohelp into the mode menu. ;;; Better docs for toggle/set/unset autohelp. ;;; (`cperl-electric-backspace-untabify'): New customization variable ;;; (`cperl-after-expr-p'): Works after here-docs, formats, and PODs too ;;; (affects many electric constructs). ;;; (`cperl-calculate-indent'): Takes into account `first-format-line' ==> ;;; works after format. ;;; (`cperl-short-docs'): Make it work with ... too. ;;; "array context" ==> "list context" ;;; (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric ;;; '(' after keyword would insert a doubled paren ;;; (`cperl-electric-paren'): documented affected by `cperl-electric-parens' ;;; (`cperl-electric-rparen'): Likewise ;;; (`cperl-build-manpage'): New function by Nick Roberts ;;; (`cperl-perldoc'): Make it work in XEmacs too ;;;; After 4.36: ;;; (`cperl-find-pods-heres'): Recognize s => 1 and {s} (as a key or varname), ;;; { s:: } and { s::bar::baz } as varnames. ;;; (`cperl-after-expr-p'): Updates syntaxification before checks ;;; (`cperl-calculate-indent'): Likewise ;;; Fix wrong indent of blocks starting with POD ;;; (`cperl-after-block-p'): Optional argument for checking for a pre-block ;;; Recognize `continue' blocks too. ;;; (`cperl-electric-brace'): use `cperl-after-block-p' for detection; ;;; Now works for else/continue/sub blocks ;;; (`cperl-short-docs'): Minor edits; make messages fit 80-column screen ;;;; After 4.37: ;;; `cperl-add-tags-recurse-noxs-fullpath' ;;; added (for -batch mode); ;;; Code: (if (fboundp 'eval-when-compile) (eval-when-compile (condition-case nil (require 'custom) (error nil)) (condition-case nil (require 'man) (error nil)) (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) (defvar cperl-can-font-lock (or cperl-xemacs-p (and (boundp 'emacs-major-version) (or window-system (> emacs-major-version 20))))) (if cperl-can-font-lock (require 'font-lock)) (defvar msb-menu-cond) (defvar gud-perldb-history) (defvar font-lock-background-mode) ; not in Emacs (defvar font-lock-display-type) ; ditto (or (fboundp 'defgroup) (defmacro defgroup (name val doc &rest arr) nil)) (or (fboundp 'custom-declare-variable) (defmacro defcustom (name val doc &rest arr) (` (defvar (, name) (, val) (, doc))))) (or (and (fboundp 'custom-declare-variable) (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work (defmacro defface (&rest arr) nil)) ;; Avoid warning (tmp definitions) (or (fboundp 'x-color-defined-p) (defmacro x-color-defined-p (col) (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) ;; XEmacs >= 19.12 ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) ;; XEmacs 19.11 ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col)))) (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) (` (find-face (, arg)))) (;;(and (fboundp 'face-list) ;; (face-list)) (fboundp 'face-list) (` (member (, arg) (and (fboundp 'face-list) (face-list))))) (t (` (boundp (, arg)))))) (defmacro cperl-make-face (arg descr) ; Takes unquoted arg (cond ((fboundp 'make-face) (` (make-face (quote (, arg))))) (t (` (defvar (, arg) (quote (, arg)) (, descr)))))) (defmacro cperl-force-face (arg descr) ; Takes unquoted arg (` (progn (or (cperl-is-face (quote (, arg))) (cperl-make-face (, arg) (, descr))) (or (boundp (quote (, arg))) ; We use unquoted variants too (defvar (, arg) (quote (, arg)) (, descr)))))) (if cperl-xemacs-p (defmacro cperl-etags-snarf-tag (file line) (` (progn (beginning-of-line 2) (list (, file) (, line))))) (defmacro cperl-etags-snarf-tag (file line) (` (etags-snarf-tag)))) (if cperl-xemacs-p (defmacro cperl-etags-goto-tag-location (elt) (`;;(progn ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) ;; (set-buffer (get-file-buffer (elt (, elt) 0))) ;; Probably will not work due to some save-excursion??? ;; Or save-file-position? ;; (message "Did I get to line %s?" (elt (, elt) 1)) (goto-line (string-to-int (elt (, elt) 1))))) ;;) (defmacro cperl-etags-goto-tag-location (elt) (` (etags-goto-tag-location (, elt))))))) (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) (defvar cperl-can-font-lock (or cperl-xemacs-p (and (boundp 'emacs-major-version) (or window-system (> emacs-major-version 20))))) (condition-case nil (require 'custom) (error nil)) ; Already fixed by eval-when-compile (defun cperl-choose-color (&rest list) (let (answer) (while list (or answer (if (or (x-color-defined-p (car list)) (null (cdr list))) (setq answer (car list)))) (setq list (cdr list))) answer)) (defgroup cperl nil "Major mode for editing Perl code." :prefix "cperl-" :group 'languages) (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 and do constructs look like: if () { } instead of: if () { }" :type 'boolean :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-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-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-indentation-details) (defcustom cperl-brace-offset 0 "*Extra indentation for braces, compared with other text in same context." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-label-offset -2 "*Offset of CPerl label lines relative to usual indentation." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-min-label-indent 1 "*Minimal offset of CPerl label lines." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-continued-statement-offset 2 "*Extra indent for lines not starting new statements." :type 'integer :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-indentation-details) (defcustom cperl-close-paren-offset -1 "*Extra indent for substatements that start with close-parenthesis." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-auto-newline nil "*Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in CPerl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-autoindent-on-semi nil "*Non-nil means automatically indent after insertion of (semi)colon. Active if `cperl-auto-newline' is false." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-auto-newline-after-colon nil "*Non-nil means automatically newline even after colons. Subject to `cperl-auto-newline' setting." :type 'boolean :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-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 '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-electric-lbrace-space nil "*Non-nil (and non-null) means { after $ should be preceded by ` '. Can be overwritten by `cperl-hairy' if nil." :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-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 '(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 transient-mark-mode) (and (boundp 'zmacs-regions) ; For XEmacs zmacs-regions))) "*Not-nil means that electric parens look for active mark. Default is yes if there is visual feedback on mark." :type 'boolean :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 '(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 '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-electric-backspace-untabify t "*Not-nil means electric-backspace will untabify in CPerl." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-hairy nil "*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-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-indentation-details) (defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") (RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")) "*What to use as `vc-header-alist' in CPerl." :type '(repeat (list symbol string)) :group 'cperl) (defcustom cperl-clobber-mode-lists (not (and (boundp 'interpreter-mode-alist) (assoc "miniperl" interpreter-mode-alist) (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) "*Whether to install us into `interpreter-' and `extension' mode lists." :type 'boolean :group 'cperl) (defcustom cperl-info-on-command-no-prompt nil "*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 '(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. Can be overwritten by `cperl-hairy' to be 5 sec if nil." :type '(choice (const null) (const nil) 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-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-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-faces) (defcustom cperl-invalid-face ''underline ; later evaluated by `font-lock' "*The result of evaluation of this expression highlights trailing whitespace." :type 'face :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-faces) (defcustom cperl-fontify-m-as-s t "*Not-nil means highlight 1arg regular expressions operators same as 2arg." :type 'boolean :group 'cperl-faces) (defcustom cperl-highlight-variables-indiscriminately nil "*Non-nil means perform additional highlighting on variables. Currently only changes how scalar variables are highlighted. Note that that variable is only read at initialization time for the variable `perl-font-lock-keywords-2', so changing it after you've entered CPerl mode the first time will have no effect." :type 'boolean :group 'cperl) (defcustom cperl-pod-here-scan t "*Not-nil means look for POD and here-docs sections during startup. You can always make lookup from menu or using \\[cperl-find-pods-heres]." :type 'boolean :group 'cperl-speed) (defcustom cperl-regexp-scan t "*Not-nil means make marking of regular expression more thorough. Effective only with `cperl-pod-here-scan'. Not implemented yet." :type 'boolean :group 'cperl-speed) (defcustom cperl-imenu-addback nil "*Not-nil means add backreferences to generated `imenu's. May require patched `imenu' and `imenu-go'. Obsolete." :type 'boolean :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-help-system) (defcustom cperl-shrink-wrap-info-frame t "*Non-nil means shrink-wrapping of info-buffer-frame allowed." :type 'boolean :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-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-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-speed) (defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$" "*Regexp to match files to scan when generating TAGS." :type 'regexp :group 'cperl) (defcustom cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|CVS\\|blib\\)$" "*Regexp to match files/dirs to skip when generating TAGS." :type 'regexp :group 'cperl) (defcustom cperl-regexp-indent-step nil "*Indentation used when beautifying regexps. If nil, the value of `cperl-indent-level' will be used." :type '(choice integer (const nil)) :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-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 reformatted 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-indent-parens-as-block nil "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks, but for trailing \",\" inside the group, which won't increase indentation. One should tune up `cperl-close-paren-offset' as well." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-syntaxify-by-font-lock (and cperl-can-font-lock (boundp 'parse-sexp-lookup-properties)) "*Non-nil means that CPerl uses `font-lock's routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) (defcustom cperl-syntaxify-unwind t "*Non-nil means that CPerl unwinds to a start of a long construction when syntaxifying a chunk of buffer." :type 'boolean :group 'cperl-speed) (defcustom cperl-ps-print-face-properties '((font-lock-keyword-face nil nil bold shadow) (font-lock-variable-name-face nil nil bold) (font-lock-function-name-face nil nil bold italic box) (font-lock-constant-face nil "LightGray" bold) (cperl-array-face nil "LightGray" bold underline) (cperl-hash-face nil "LightGray" bold italic underline) (font-lock-comment-face nil "LightGray" italic) (font-lock-string-face nil nil italic underline) (cperl-nonoverridable-face nil nil italic underline) (font-lock-type-face nil nil underline) (underline nil "LightGray" strikeout)) "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." :type '(repeat (cons symbol (cons (choice (const nil) string) (cons (choice (const nil) string) (repeat symbol))))) :group 'cperl-faces) (if cperl-can-font-lock (progn (defvar cperl-dark-background (cperl-choose-color "navy" "os2blue" "darkgreen")) (defvar cperl-dark-foreground (cperl-choose-color "orchid1" "orange")) (defface cperl-nonoverridable-face (` ((((class grayscale) (background light)) (:background "Gray90" :italic t :underline t)) (((class grayscale) (background dark)) (:foreground "Gray80" :italic t :underline t :bold t)) (((class color) (background light)) (:foreground "chartreuse3")) (((class color) (background dark)) (:foreground (, cperl-dark-foreground))) (t (:bold t :underline t)))) "Font Lock mode face used to highlight array names." :group 'cperl-faces) (defface cperl-array-face (` ((((class grayscale) (background light)) (:background "Gray90" :bold t)) (((class grayscale) (background dark)) (:foreground "Gray80" :bold t)) (((class color) (background light)) (:foreground "Blue" :background "lightyellow2" :bold t)) (((class color) (background dark)) (:foreground "yellow" :background (, cperl-dark-background) :bold t)) (t (:bold t)))) "Font Lock mode face used to highlight array names." :group 'cperl-faces) (defface cperl-hash-face (` ((((class grayscale) (background light)) (:background "Gray90" :bold t :italic t)) (((class grayscale) (background dark)) (:foreground "Gray80" :bold t :italic t)) (((class color) (background light)) (:foreground "Red" :background "lightyellow2" :bold t :italic t)) (((class color) (background dark)) (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t)) (t (:bold t :italic t)))) "Font Lock mode face used to highlight hash names." :group 'cperl-faces))) ;;; Short extra-docs. (defvar cperl-tips 'please-ignore-this-line "Get maybe newer version of this package from 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. For best results apply to an older Emacs the patches from ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches \(this upgrades syntax-parsing abilities of RMS Emaxen v19.34 and v20.2 up to the level of RMS Emacs v20.3 - a must for a good Perl mode.) As of beginning of 2003, XEmacs may provide a similar ability. 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 too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and later you should use choose-color.el *instead* of font-lock-extra.el \(and you will not get smart highlighting in C :-(). Note that to enable Compile choices in the menu you need to install mode-compile.el. If your Emacs does not default to `cperl-mode' on Perl files, and you want it to: put the following into your .emacs file: (autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t) or (defalias 'perl-mode 'cperl-mode) Get perl5-info from $CPAN/doc/manual/info/perl-info.tar.gz older version was on http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz If you use imenu-go, run imenu on perl5-info buffer (you can do it from Perl menu). If many files are related, generate TAGS files from Tools/Tags submenu in Perl menu. If some class structure is too complicated, use Tools/Hierarchy-view from Perl menu, or hierarchic view of imenu. The second one uses the current buffer only, the first one requires generation of TAGS from Perl/Tools/Tags menu beforehand. Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing. Switch auto-help on/off with Perl/Tools/Auto-help. Though with contemporary Emaxen CPerl mode should maintain the correct parsing of Perl even when editing, sometimes it may be lost. Fix this by M-x norm RET or \\[normal-mode] In cases of more severe confusion sometimes it is helpful to do M-x load-l RET cperl-mode RET M-x norm RET or \\[load-library] cperl-mode RET \\[normal-mode] Before reporting (non-)problems look in the problem section of online micro-docs on what I know about CPerl problems.") (defvar cperl-problems 'please-ignore-this-line "Description of problems in CPerl mode. Some faces will not be shown on some versions of Emacs unless you install choose-color.el, available from ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/ `fill-paragraph' on a comment may leave the point behind the paragraph. Parsing of lines with several <= 19.12 (setq unread-command-events (list (eval '(character-to-event c)))))) (defun cperl-putback-char (c) ; XEmacs <= 19.11 (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings (or (fboundp 'uncomment-region) (defun uncomment-region (beg end) (interactive "r") (comment-region beg end -1))) (defvar cperl-do-not-fontify (if (string< emacs-version "19.30") 'fontified 'lazy-lock) "Text property which inhibits refontification.") (defsubst cperl-put-do-not-fontify (from to &optional post) ;; If POST, do not do it with postponed fontification (if (and post cperl-syntaxify-by-font-lock) nil (put-text-property (max (point-min) (1- from)) to cperl-do-not-fontify t))) (defcustom cperl-mode-hook nil "Hook run by CPerl mode." :type 'hook :group 'cperl) (defvar cperl-syntax-state nil) (defvar cperl-syntax-done-to nil) (defvar cperl-emacs-can-parse (> (length (save-excursion (parse-partial-sexp (point) (point)))) 9)) ;; 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: (and cperl-clobber-mode-lists (setq auto-mode-alist (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) (and (boundp 'interpreter-mode-alist) (setq interpreter-mode-alist (append interpreter-mode-alist '(("miniperl" . perl-mode)))))) (if (fboundp 'eval-when-compile) (eval-when-compile (mapcar (lambda (p) (condition-case nil (require p) (error nil))) '(imenu easymenu etags timer man info)) (if (fboundp 'ps-extend-face-list) (defmacro cperl-ps-extend-face-list (arg) (` (ps-extend-face-list (, arg)))) (defmacro cperl-ps-extend-face-list (arg) (` (error "This version of Emacs has no `ps-extend-face-list'")))) ;; 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? (if cperl-can-font-lock (require 'font-lock)) (require 'cl))) (defvar cperl-mode-abbrev-table nil "Abbrev table in use in CPerl mode buffers.") (add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))) (defvar cperl-mode-map () "Keymap used in CPerl mode.") (if cperl-mode-map nil (setq cperl-mode-map (make-sparse-keymap)) (cperl-define-key "{" 'cperl-electric-lbrace) (cperl-define-key "[" 'cperl-electric-paren) (cperl-define-key "(" 'cperl-electric-paren) (cperl-define-key "<" 'cperl-electric-paren) (cperl-define-key "}" 'cperl-electric-brace) (cperl-define-key "]" 'cperl-electric-rparen) (cperl-define-key ")" 'cperl-electric-rparen) (cperl-define-key ";" 'cperl-electric-semi) (cperl-define-key ":" 'cperl-electric-terminator) (cperl-define-key "\C-j" 'newline-and-indent) (cperl-define-key "\C-c\C-j" 'cperl-linefeed) (cperl-define-key "\C-c\C-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 |)]) ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph) ;;(cperl-define-key "\e;" 'cperl-indent-for-comment) (cperl-define-key "\177" 'cperl-electric-backspace) (cperl-define-key "\t" 'cperl-indent-command) ;; don't clobber the backspace binding: (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command [(control c) (control h) F]) (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]) (cperl-define-key "\C-c\C-hf" ;;(concat (char-to-string help-char) "f") ; does not work (key-binding "\C-hf") [(control c) (control h) f]) (cperl-define-key "\C-c\C-hv" ;;(concat (char-to-string help-char) "v") ; does not work (key-binding "\C-hv") [(control c) (control h) v])) (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-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 c) (control h) v])) (if (and cperl-xemacs-p (<= emacs-minor-version 11) (<= emacs-major-version 19)) (progn ;; substitute-key-definition is usefulness-deenhanced... (cperl-define-key "\M-q" 'cperl-fill-paragraph) (cperl-define-key "\e;" 'cperl-indent-for-comment) (cperl-define-key "\e\C-\\" 'cperl-indent-region)) (substitute-key-definition 'indent-sexp 'cperl-indent-exp cperl-mode-map global-map) (substitute-key-definition 'fill-paragraph 'cperl-fill-paragraph cperl-mode-map global-map) (substitute-key-definition 'indent-region 'cperl-indent-region cperl-mode-map global-map) (substitute-key-definition 'indent-for-comment 'cperl-indent-for-comment cperl-mode-map global-map))) (defvar cperl-menu) (defvar cperl-lazy-installed) (defvar cperl-old-style nil) (condition-case nil (progn (require 'easymenu) (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode" '("Perl" ["Beginning of function" beginning-of-defun t] ["End of function" end-of-defun t] ["Mark function" mark-defun t] ["Indent expression" cperl-indent-exp t] ["Fill paragraph/comment" cperl-fill-paragraph t] "----" ["Line up a construction" cperl-lineup (cperl-use-region-p)] ["Invert if/unless/while etc" cperl-invert-if-unless t] ("Regexp" ["Beautify" cperl-beautify-regexp cperl-use-syntax-table-text-property] ["Beautify one level deep" (cperl-beautify-regexp 1) cperl-use-syntax-table-text-property] ["Beautify a group" cperl-beautify-level cperl-use-syntax-table-text-property] ["Beautify a group one level deep" (cperl-beautify-level 1) cperl-use-syntax-table-text-property] ["Contract a group" cperl-contract-level cperl-use-syntax-table-text-property] ["Contract groups" cperl-contract-levels cperl-use-syntax-table-text-property]) ["Refresh \"hard\" constructions" cperl-find-pods-heres t] "----" ["Indent region" cperl-indent-region (cperl-use-region-p)] ["Comment region" cperl-comment-region (cperl-use-region-p)] ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] "----" ["Run" mode-compile (fboundp 'mode-compile)] ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) (get-buffer "*compilation*"))] ["Next error" next-error (get-buffer "*compilation*")] ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] "----" ["Debugger" cperl-db t] "----" ("Tools" ["Imenu" imenu (fboundp 'imenu)] ["Insert spaces if needed" cperl-find-bad-style t] ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ["CPerl pretty print (exprmntl)" cperl-ps-print (fboundp 'ps-extend-face-list)] ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] ("Tags" ;;; ["Create tags for current file" cperl-etags t] ;;; ["Add tags for current file" (cperl-etags t) t] ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] ;;; ["Add tags for Perl files in directory" (cperl-etags t t) t] ;;; ["Create tags for Perl files in (sub)directories" ;;; (cperl-etags nil 'recursive) t] ;;; ["Add tags for Perl files in (sub)directories" ;;; (cperl-etags t 'recursive) t]) ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" (cperl-write-tags nil t nil t) t] ["Add tags for Perl files in directory" (cperl-write-tags nil nil nil t) t] ["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])) ("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] ["Perldoc" cperl-perldoc t] ["Perldoc on word at point" cperl-perldoc-at-point t] ["View manpage of POD in this file" cperl-build-manpage t] ["Auto-help on" cperl-lazy-install (and (fboundp 'run-with-idle-timer) (not cperl-lazy-installed))] ["Auto-help off" 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-help on Perl constructs" cperl-toggle-autohelp 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] ["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] ["Speed" (describe-variable 'cperl-speed) t] ["Praise" (describe-variable 'cperl-praise) t] ["Faces" (describe-variable 'cperl-tips-faces) t] ["CPerl mode" (describe-function 'cperl-mode) t] ["CPerl version" (message "The version of master-file for this CPerl is %s" cperl-version) t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor." t) (defvar cperl-imenu--function-name-regexp-perl (concat "^\\(" "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?" "\\|" "=head\\([12]\\)[ \t]+\\([^\n]+\\)$" "\\)")) (defvar cperl-outline-regexp (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`")) (defvar cperl-mode-syntax-table nil "Syntax table in use in CPerl mode buffers.") (defvar cperl-string-syntax-table nil "Syntax table in use in CPerl mode string-like chunks.") (if cperl-mode-syntax-table () (setq cperl-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table) (modify-syntax-entry ?/ "." cperl-mode-syntax-table) (modify-syntax-entry ?* "." cperl-mode-syntax-table) (modify-syntax-entry ?+ "." cperl-mode-syntax-table) (modify-syntax-entry ?- "." cperl-mode-syntax-table) (modify-syntax-entry ?= "." cperl-mode-syntax-table) (modify-syntax-entry ?% "." cperl-mode-syntax-table) (modify-syntax-entry ?< "." cperl-mode-syntax-table) (modify-syntax-entry ?> "." cperl-mode-syntax-table) (modify-syntax-entry ?& "." cperl-mode-syntax-table) (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table) (modify-syntax-entry ?\n ">" cperl-mode-syntax-table) (modify-syntax-entry ?# "<" cperl-mode-syntax-table) (modify-syntax-entry ?' "\"" cperl-mode-syntax-table) (modify-syntax-entry ?` "\"" cperl-mode-syntax-table) (if cperl-under-as-char (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)) (modify-syntax-entry ?: "_" cperl-mode-syntax-table) (modify-syntax-entry ?| "." cperl-mode-syntax-table) (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) (modify-syntax-entry ?$ "." cperl-string-syntax-table) (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment ) ;; 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 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) (defvar outline-level) (if (fboundp 'defvaralias) (let ((f 'defvaralias)) ; Some functions deduce stuff from the mode name... (funcall f 'cperl-font-lock-keywords 'perl-font-lock-keywords) (funcall f 'cperl-font-lock-keywords-1 'perl-font-lock-keywords-1) (funcall f 'cperl-font-lock-keywords-2 'perl-font-lock-keywords-2))) (defvar cperl-use-major-mode 'perl-mode) ;;;###autoload (defun cperl-mode () "Major mode for editing Perl code. Expression and list commands understand all C brackets. Tab indents for Perl code. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. Various characters in Perl almost always come in pairs: {}, (), [], sometimes <>. When the user types the first, she gets the second as well, with optional special formatting done on {}. (Disabled by default.) You can always quote (with \\[quoted-insert]) the left \"paren\" to avoid the expansion. The processing of < is special, since most the time you mean \"less\". CPerl mode tries to guess whether you want to type pair <>, and inserts is if it appropriate. You can set `cperl-electric-parens-string' to the string that contains the parenths from the above list you want to be electrical. Electricity of parenths is controlled by `cperl-electric-parens'. You may also set `cperl-electric-parens-mark' to have electric parens 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, 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'. (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 \(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]. 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' 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], 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 span the needed amount of lines. Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', `cperl-pod-face', `cperl-pod-head-face' control processing of POD and 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 \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and `cperl-auto-newline-after-colon' set. `cperl-auto-newline-after-colon' Non-nil means automatically newline even after colons. Subject to `cperl-auto-newline' setting. `cperl-indent-level' Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. `cperl-continued-statement-offset' Extra indentation given to a substatement, such as the then-clause of an if, or body of a while, or just a statement continuation. `cperl-continued-brace-offset' Extra indentation given to a brace that starts a substatement. This is in addition to `cperl-continued-statement-offset'. `cperl-brace-offset' Extra indentation for line if it starts with an open brace. `cperl-brace-imaginary-offset' An open brace following other text is treated as if it the line started this far to the right of the actual line indentation. `cperl-label-offset' Extra indentation for line that is a label. `cperl-min-label-indent' Minimal indentation for line that is a label. Settings for K&R and BSD indentation styles are `cperl-indent-level' 5 8 `cperl-continued-statement-offset' 5 8 `cperl-brace-offset' -5 -8 `cperl-label-offset' -5 -8 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. 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) (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 (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]) (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command [(control c) (control h) f]))) (setq major-mode cperl-use-major-mode) (setq mode-name "CPerl") (if (not cperl-mode-abbrev-table) (let ((prev-a-c abbrevs-changed)) (define-abbrev-table 'cperl-mode-abbrev-table '( ("if" "if" cperl-electric-keyword 0) ("elsif" "elsif" cperl-electric-keyword 0) ("while" "while" cperl-electric-keyword 0) ("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) ("formy" "formy" cperl-electric-keyword 0) ("foreachmy" "foreachmy" cperl-electric-keyword 0) ("do" "do" cperl-electric-keyword 0) ("=pod" "=pod" cperl-electric-pod 0) ("=over" "=over" cperl-electric-pod 0) ("=head1" "=head1" cperl-electric-pod 0) ("=head2" "=head2" cperl-electric-pod 0) ("pod" "pod" cperl-electric-pod 0) ("over" "over" cperl-electric-pod 0) ("head1" "head1" cperl-electric-pod 0) ("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)) (set-syntax-table cperl-mode-syntax-table) (make-local-variable 'outline-regexp) ;; (setq outline-regexp imenu-example--function-name-regexp-perl) (setq outline-regexp cperl-outline-regexp) (make-local-variable 'outline-level) (setq outline-level 'cperl-outline-level) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'indent-line-function) (setq indent-line-function 'cperl-indent-line) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "# ") (make-local-variable 'comment-end) (setq comment-end "") (make-local-variable 'comment-column) (setq comment-column cperl-comment-column) (make-local-variable 'comment-start-skip) (setq comment-start-skip "#+ *") (make-local-variable 'defun-prompt-regexp) (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'cperl-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'indent-region-function) (setq indent-region-function 'cperl-indent-region) ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off! (make-local-variable 'imenu-create-index-function) (setq imenu-create-index-function (function cperl-imenu--create-perl-index)) (make-local-variable 'imenu-sort-function) (setq imenu-sort-function nil) (make-local-variable 'vc-header-alist) (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning (make-local-variable 'font-lock-defaults) (setq font-lock-defaults (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))) (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-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (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-region)) (make-local-variable 'font-lock-unfontify-region-function) (set 'font-lock-unfontify-region-function ; not present with old Emacs 'cperl-font-lock-unfontify-region-function) (make-local-variable '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-local-variable '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) (if (boundp 'normal-auto-fill-function) ; 19.33 and later (set (make-local-variable 'normal-auto-fill-function) 'cperl-do-auto-fill) ; RMS has it as #'cperl-do-auto-fill ??? (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") (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning (and auto-fill-function (memq major-mode '(perl-mode cperl-mode)) (setq auto-fill-function 'cperl-do-auto-fill)))))) (if (cperl-enable-font-lock) (if (cperl-val 'cperl-font-lock) (progn (or cperl-faces-init (cperl-init-faces)) (font-lock-mode 1)))) (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) (if (featurep 'easymenu) (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 (or cperl-syntaxify-by-font-lock (progn (or cperl-faces-init (cperl-init-faces-weak)) (cperl-find-pods-heres))))) ;; Fix for perldb - make default reasonable (defun cperl-db () (interactive) (require 'gud) (perldb (read-from-minibuffer "Run perldb (like this): " (if (consp gud-perldb-history) (car gud-perldb-history) (concat "perl " ;;(file-name-nondirectory ;; I have problems ;; in OS/2 ;; otherwise (buffer-file-name))) nil nil '(gud-perldb-history . 1)))) (defun cperl-msb-fix () ;; Adds perl files to msb menu, supposes that msb is already loaded (setq cperl-msb-fixed t) (let* ((l (length msb-menu-cond)) (last (nth (1- l) msb-menu-cond)) (precdr (nthcdr (- l 2) msb-menu-cond)) ; cdr of this is last (handle (1- (nth 1 last)))) (setcdr precdr (list (list '(memq major-mode '(cperl-mode perl-mode)) handle "Perl Files (%d)") last)))) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in CPerl code ;; based on its context. Do fallback if comment is found wrong. (defvar cperl-wrong-comment) (defvar cperl-st-cfence '(14)) ; Comment-fence (defvar cperl-st-sfence '(15)) ; String-fence (defvar cperl-st-punct '(1)) (defvar cperl-st-word '(2)) (defvar cperl-st-bra '(4 . ?\>)) (defvar cperl-st-ket '(5 . ?\<)) (defun cperl-comment-indent () (let ((p (point)) (c (current-column)) was phony) (if (looking-at "^#") 0 ; Existing comment at bol stays there. ;; Wrong comment found (save-excursion (setq was (cperl-to-comment-or-eol) phony (eq (get-text-property (point) 'syntax-table) cperl-st-cfence)) (if phony (progn (re-search-forward "#\\|$") ; Hmm, what about embedded #? (if (eq (preceding-char) ?\#) (forward-char -1)) (setq was nil))) (if (= (point) p) (progn (skip-chars-backward " \t") (max (1+ (current-column)) ; Else indent at comment column comment-column)) (if was nil (insert comment-start) (backward-char (length comment-start))) (setq cperl-wrong-comment t) (indent-to comment-column 1) ; Indent minimum 1 c))))) ; except leave at least one space. ;;;(defun cperl-comment-indent-fallback () ;;; "Is called if the standard comment-search procedure fails. ;;;Point is at start of real comment." ;;; (let ((c (current-column)) target cnt prevc) ;;; (if (= c comment-column) nil ;;; (setq cnt (skip-chars-backward "[ \t]")) ;;; (setq target (max (1+ (setq prevc ;;; (current-column))) ; Else indent at comment column ;;; comment-column)) ;;; (if (= c comment-column) nil ;;; (delete-backward-char cnt) ;;; (while (< prevc target) ;;; (insert "\t") ;;; (setq prevc (current-column))) ;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) ;;; (while (< prevc target) ;;; (insert " ") ;;; (setq prevc (current-column))))))) (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." (interactive) (let (cperl-wrong-comment) (indent-for-comment) (if cperl-wrong-comment (progn (cperl-to-comment-or-eol) (forward-char (length comment-start)))))) (defun cperl-comment-region (b e arg) "Comment or uncomment each line in the region in CPerl mode. See `comment-region'." (interactive "r\np") (let ((comment-start "#")) (comment-region b e arg))) (defun cperl-uncomment-region (b e arg) "Uncomment or comment each line in the region in CPerl mode. See `comment-region'." (interactive "r\np") (let ((comment-start "#")) (comment-region b e (- arg)))) (defvar cperl-brace-recursing nil) (defun cperl-electric-brace (arg &optional only-before) "Insert character and correct line's indentation. If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the place (even in empty line), but not after. If after \")\" and the inserted char is \"{\", insert extra newline before only if `cperl-extra-newline-before-brace'." (interactive "P") (let (insertpos (other-end (if (and cperl-electric-parens-mark (cperl-mark-active) (< (mark) (point))) (mark) nil))) (if (and other-end (not cperl-brace-recursing) (cperl-val 'cperl-electric-parens) (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))) ;; Need to insert a matching pair (progn (save-excursion (setq insertpos (point-marker)) (goto-char other-end) (setq last-command-char ?\{) (cperl-electric-lbrace arg insertpos)) (forward-char 1)) ;; 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)) (or (cperl-after-expr-p nil "{;)") ;; after sub, else, continue (cperl-after-block-p nil 'pre))) (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 (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." (interactive "P") (let ((cperl-brace-recursing t) (cperl-auto-newline cperl-auto-newline) (other-end (or end (if (and cperl-electric-parens-mark (cperl-mark-active) (> (mark) (point))) (save-excursion (goto-char (mark)) (point-marker)) nil))) pos after) (and (cperl-val 'cperl-electric-lbrace-space) (eq (preceding-char) ?$) (save-excursion (skip-chars-backward "$") (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)")) (insert ?\ )) ;; Check whether we are in comment (if (and (save-excursion (beginning-of-line) (not (looking-at "[ \t]*#"))) (cperl-after-expr-p nil "{;)")) nil (setq cperl-auto-newline nil)) (cperl-electric-brace arg) (and (cperl-val 'cperl-electric-parens) (eq last-command-char ?{) (memq last-command-char (append cperl-electric-parens-string nil)) (or (if other-end (goto-char (marker-position other-end))) t) (setq last-command-char ?} pos (point)) (progn (cperl-electric-brace arg t) (goto-char pos))))) (defun cperl-electric-paren (arg) "Insert an opening parenthesis or a matching pair of parentheses. See `cperl-electric-parens'." (interactive "P") (let ((beg (save-excursion (beginning-of-line) (point))) (other-end (if (and cperl-electric-parens-mark (cperl-mark-active) (> (mark) (point))) (save-excursion (goto-char (mark)) (point-marker)) nil))) (if (and (cperl-val 'cperl-electric-parens) (memq last-command-char (append cperl-electric-parens-string nil)) (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) ;;(not (save-excursion (search-backward "#" beg t))) (if (eq last-command-char ?<) (progn (and abbrev-mode ; later it is too late, may be after `for' (expand-abbrev)) (cperl-after-expr-p nil "{;(,:=")) 1)) (progn (self-insert-command (prefix-numeric-value arg)) (if other-end (goto-char (marker-position other-end))) (insert (make-string (prefix-numeric-value arg) (cdr (assoc last-command-char '((?{ .?}) (?[ . ?]) (?( . ?)) (?< . ?>)))))) (forward-char (- (prefix-numeric-value arg)))) (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-rparen (arg) "Insert a matching pair of parentheses if marking is active. If not, or if we are not at the end of marking range, would self-insert. Affected by `cperl-electric-parens'." (interactive "P") (let ((beg (save-excursion (beginning-of-line) (point))) (other-end (if (and cperl-electric-parens-mark (cperl-val 'cperl-electric-parens) (memq last-command-char (append cperl-electric-parens-string nil)) (cperl-mark-active) (< (mark) (point))) (mark) nil)) p) (if (and other-end (cperl-val 'cperl-electric-parens) (memq last-command-char '( ?\) ?\] ?\} ?\> )) (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) ;;(not (save-excursion (search-backward "#" beg t))) ) (progn (self-insert-command (prefix-numeric-value arg)) (setq p (point)) (if other-end (goto-char other-end)) (insert (make-string (prefix-numeric-value arg) (cdr (assoc last-command-char '((?\} . ?\{) (?\] . ?\[) (?\) . ?\() (?\> . ?\<)))))) (goto-char (1+ p))) (self-insert-command (prefix-numeric-value arg))))) (defun cperl-electric-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)))) my do) (and (save-excursion (condition-case nil (progn (backward-sexp 1) (setq do (looking-at "do\\>"))) (error nil)) (cperl-after-expr-p nil "{;:")) (save-excursion (not (re-search-backward "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (or (looking-at "=cut") (and cperl-use-syntax-table-text-property (not (eq (get-text-property (point) 'syntax-type) 'pod)))))) (save-excursion (forward-sexp -1) (not (memq (following-char) (append "$@%&*" nil)))) (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 (if do "\n" " ()\n")) (insert "{") (cperl-indent-line) (insert "\n") (cperl-indent-line) (insert "\n}") (and do (insert " while ();"))) (t (insert (if do " {\n} while ();" " () {\n}")))) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (if dollar (progn (search-backward "$") (if my (forward-char 1) (delete-char 1))) (search-backward ")") (if (eq last-command-char ?\() (progn ; Avoid "if (())" (delete-backward-char 1) (delete-backward-char -1)))) (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 (forward-word -1) (and (eq (preceding-char) ?=) (progn (setq head1 (looking-at "head1\\>[ \t]*$")) (setq over (and (looking-at "over\\>[ \t]*$") (not (looking-at "over[ \t]*\n\n\n*=item\\>")))) (forward-char -1) (bolp)) (or (get-text-property (point) 'in-pod) (cperl-after-expr-p nil "{;:") (and (re-search-backward ;; "\\(\\`\n?\\|\n\n\\)=\\sw+" "\\(\\`\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 (re-search-forward "^\n=" nil t))) (or notlast (progn (insert "\n\n=cut") (cperl-ensure-newlines 2) (forward-word -2) (if (and head1 (not (save-excursion (forward-char -1) (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" nil t)))) ; Only one (progn (forward-word 1) (setq name (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) p (point)) (insert " NAME\n\n" name " - \n\n=head1 SYNOPSIS\n\n\n\n" "=head1 DESCRIPTION") (cperl-ensure-newlines 4) (goto-char p) (forward-word 2) (end-of-line) (setq really-delete t)) (forward-word 1)))) (if over (progn (setq p (point)) (insert "\n\n=item \n\n\n\n" "=back") (cperl-ensure-newlines 2) (goto-char p) (forward-word 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. 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) (cperl-after-expr-p nil "{;:")) (save-excursion (not (re-search-backward "[#\"'`]\\|\\" beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (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}") (cond (cperl-extra-newline-before-brace (insert "\n") (insert "{") (cperl-indent-line) (insert "\n\n}")) (t (insert " {\n\n}"))) (or (looking-at "[ \t]\\|$") (insert " ")) (cperl-indent-line) (forward-line -1) (cperl-indent-line) (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. 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 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) (>= (point) pos)) ; Not in a comment (or (save-excursion (skip-chars-backward " \t" beg) (forward-char -1) (looking-at "[;{]")) ; After { or ; + spaces (looking-at "[ \t]*}") ; Before } (re-search-forward "\\=[ \t]*;" end t)) ; Before spaces + ; (save-excursion (and (eq (car (parse-partial-sexp pos end -1)) -1) ; Leave the level of parens (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr ; Are at end (cperl-after-block-p (point-min)) (progn (backward-sexp 1) (setq start (point-marker)) (<= start pos))))) ; Redundant? Are after the ; start of parens group. (progn (skip-chars-backward " \t") (or (memq (preceding-char) (append ";{" nil)) (insert ";")) (insert "\n") (forward-line -1) (cperl-indent-line) (goto-char start) (or (looking-at "{[ \t]*$") ; If there is a statement ; before, move it to separate line (progn (forward-char 1) (insert "\n") (cperl-indent-line))) (forward-line 1) ; We are on the target line (cperl-indent-line) (beginning-of-line) (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement ; after, move it to separate line (progn (end-of-line) (search-backward "}" beg) (skip-chars-backward " \t") (or (memq (preceding-char) (append ";{" nil)) (insert ";")) (insert "\n") (cperl-indent-line) (forward-line -1))) (forward-line -1) ; We are on the line before target (end-of-line) (newline-and-indent)) (end-of-line) ; else - no splitting (cond ((and (looking-at "\n[ \t]*{$") (save-excursion (skip-chars-backward " \t") (eq (preceding-char) ?\)))) ; Probably if () {} group ; 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 (