Commit 5bd52f0e authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Can use linear algorithm for indentation if Emacs supports it.

(cperl-after-expr-p):	It is BLOCK if we reach lim when backup sexp.
(cperl-after-block-p):	Likewise.
(cperl-after-block-and-statement-beg): Likewise.
(cperl-after-block-p):	After END/BEGIN we are a block.
(cperl-after-expr-p):	Skip labels when checking
(cperl-indent-region):	Make a marker for END - text added/removed.
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.
(cperl-indent-region):	Do not indent whitespace lines
(cperl-style-alist)
	Include `cperl-merge-trailing-else' where the value is clear.
(cperl-styles-entries): Likewise.
(cperl-problems):	Improvements to docs.
(cperl-tips):		Likewise.
(cperl-non-problems):	Likewise.
(cperl-mode):		Make lazy syntaxification possible.
Loads pseudo-faces for the sake of `cperl-find-pods-heres' (for 19.30).
`font-lock-unfontify-region-function' was set to a wrong function.

(cperl-find-pods-heres): Safe a position in buffer where it is safe to
restart syntaxification.  Changed so that -d ?foo? is a RE. Do
not warn on `=cut' if doing a chunk only. 1 << 6 was OK,
but 1<<6 was considered as HERE-doc.
<file/glob> made into a string.
Postpone addition of faces after syntactic step.
Recognition of <FH> was wrong.
Highlight `gem' in s///gem as a keyword.  `qr' recognized.
Knows that split// is null-RE.
Highlights separators in 3-parts expressions as labels.
<> was considered as a glob.
Would err if the last line is `=head1'.
$a-1 ? foo : bar; was a considered a regexp.
`<< (' was considered a start of HERE-doc.
mark qq[]-etc sections as syntax-type=string
Was not processing sub protos after a comment ine.
Was treating $a++ <= 5 as a glob.
Tolerate unfinished REx at end-of-buffer.
`unwind-protect' was left commented.
/ and ? after : start a REx.

(cperl-syntaxify-by-font-lock): Set to t, should be safe now.
Better default, customizes to `message' too, off in text-mode.

(cperl-array-face): Renamed from `font-lock-emphasized-face',
`defface'd.
(cperl-hash-face): Renamed from `font-lock-other-emphasized-face'.
`defface'd.
(cperl-emacs-can-parse):	New state variable.
(cperl-indent-line):	Corrected to use global state.
(cperl-calculate-indent):	Likewise.
(cperl-fix-line-spacing):	Likewise (not used yet).
(cperl-calculate-indent):	Did not consider `,' as
continuation mark for statements.
(cperl-calculate-indent): Avoid parse-data optimization at toplevel.
Remove another parse-data optimization at toplevel: would
indent correctly.
Correct for labels when calculating indentation of continuations.
Docstring updated.
(cperl-choose-color):	Converted to a function (to be
compilable in text-mode).
(cperl-dark-background):	Disable without window-system.
Do `defface' only if window-system.
(cperl-fix-line-spacing):	sped up to bail out early.
(x-color-defined-p): was not compiling on XEmacs
Was defmacro'ed with a tick.  Remove another def.
(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.
(cperl-fontify-syntaxically): Unwinds start and end to go out of
			     long strings (not very successful).
(cperl-forward-re):	Highlight the trailing / in s/foo// as string.
Highlight the starting // in s//foo/ as function-name.
Emit a meaningful error instead of a cryptic one for an
uncomplete REx near end-of-buffer.

(cperl-electric-keyword):	`qr' recognized.
(cperl-electric-else):		Likewise
(cperl-to-comment-or-eol):	Likewise
(cperl-make-regexp-x):	Likewise
(cperl-init-faces):	Likewise, and `lock' (as overridable?).
Corrected to use new macros;
`if' for copying `reference-face' to `constant-face' was backward.
remove init `font-lock-other-emphasized-face',
`font-lock-emphasized-face', `font-lock-keyword-face'.
Interpolate `cperl-invalid-face'.
(cperl-make-regexp-x):	Misprint in a message.
(cperl-syntaxify-unwind): New configuration variable
(cperl-fontify-m-as-s):	New configuration variable
(cperl-electric-pod):	check for after-expr was performed
inside of POD too.
(cperl-backward-to-noncomment):	better treatment of PODs and HEREs.
(cperl-clobber-mode-lists): New configuration variable.
(cperl-not-bad-style-regexp):	Updated.
Init:			`cperl-is-face' was busted.
(cperl-make-face):	New macros.
(cperl-force-face):	New macros.
(font-lock-other-type-face): Done via `defface' too.
(cperl-nonoverridable-face):	New face.  Renamed from
`font-lock-other-type-face'.
(cperl-init-faces-weak):	use `cperl-force-face'.
(cperl-comment-indent):	Commenting __END__ was not working.
(cperl-indent-for-comment):	Likewise.
(cperl-write-tags):	Correct for XEmacs's `visit-tags-table-buffer'.
When removing old TAGS info was not relativizing filename.
(cperl-tags-hier-init):	Gross hack to pretend we work (are we?).
Another try to work around XEmacs problems.  Better progress messages.
(toplevel):		require custom unprotected => failure on 19.28.
(cperl-xemacs-p):	defined when compile too
(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-version):	New variable.  New menu entry
random docstrings:	References to "future" 20.3 removed.
Menu was described as `CPerl' instead of `Perl'
(perl-font-lock-keywords): Would not highlight `sub foo($$);'.
(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', `font-lock-other-emphasized-face',
`font-lock-reference-face', `font-lock-keyword-face'.
Use `eval-after-load'.
Remove not-CPerl-related faces.
(cperl-tips-faces):	New variable and an entry into Mini-docs.
(cperl-indent-exp):	Was not processing else-blocks.
(cperl-get-state):	NOP line removed.
(cperl-ps-print):	New function and menu entry.
(cperl-ps-print-face-properties):	New configuration variable.
(cperl-invalid-face):	New configuration variable.
(perl-font-lock-keywords):	Highlight trailing whitespace
(cperl-contract-levels):	Documentation corrected.
(cperl-contract-level):		Likewise.
(cperl-ps-extend-face-list):	New macro.
(cperl-invalid-face):	Change to ''underline.
parent 75e4db34
......@@ -62,6 +62,61 @@
;;; Code:
;; Some macros are needed for `defcustom'
(if (fboundp 'eval-when-compile)
(eval-when-compile
(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
(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
(` (defconst (, 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
(defconst (, 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)))))))
(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-"
......@@ -257,6 +312,16 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
: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.
......@@ -293,11 +358,21 @@ Font for POD headers."
: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-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]."
......@@ -401,12 +476,86 @@ may be merged to be on the same line when indenting a region."
:type 'boolean
:group 'cperl-indentation-details)
(defcustom cperl-syntaxify-by-font-lock nil
(defcustom cperl-syntaxify-by-font-lock
(and window-system
(boundp 'parse-sexp-lookup-properties))
"*Non-nil means that CPerl uses `font-lock's routines for syntaxification.
Not debugged yet."
Having it TRUE may be not completely debugged yet."
:type '(choice (const message) boolean)
:group 'cperl-speed)
(defcustom cperl-syntaxify-unwind
t
"*Non-nil means that CPerl unwinds to a start of along 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 window-system
(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.
......@@ -419,6 +568,13 @@ and/or
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.) You will not get much from XEmacs, it's syntax abilities are
too primitive.
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
......@@ -434,27 +590,41 @@ 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 CPerl menu). If many files are related, generate TAGS files from
Tools/Tags submenu in CPerl menu.
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 CPerl menu, or hierarchic view of imenu. The second one uses the
from Perl menu, or hierarchic view of imenu. The second one uses the
current buffer only, the first one requires generation of TAGS from
CPerl/Tools/Tags menu beforehand.
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
Run CPerl/Tools/Insert-spaces-if-needed to fix your lazy typing.
In cases of more severe confusion sometimes it is helpful to do
Switch auto-help on/off with CPerl/Tools/Auto-help.
M-x load-l RET cperl-mode RET
M-x norm RET
Before reporting (non-)problems look in the problem section on what I
know about them.")
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
"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/
Even with newer Emacsen interaction of `font-lock' and
Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
20.1. Most problems below are corrected starting from this version of
Emacs, and all of them should go with (future) RMS's version 20.3.
Note that even with newer Emacsen interaction of `font-lock' and
syntaxification is not cleaned up. You may get slightly different
colors basing on the order of fontification and syntaxification. This
might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but
......@@ -480,9 +650,10 @@ to insert it as $ {aaa} (legal in perl5, not in perl4).
Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
as /($|\\s)/. Note that such a transposition is not always possible.
The solution is to upgrade your Emacs. Note that Emacs 20.2 has some
bugs related to `syntax-table' text properties. Patches are available
on the main CPerl download site, and on CPAN.
The solution is to upgrade your Emacs or patch an older one. Note
that RMS's 20.2 has some bugs related to `syntax-table' text
properties. Patches are available on the main CPerl download site,
and on CPAN.
If these bugs cannot be fixed on your machine (say, you have an inferior
environment and cannot recompile), you may still disable all the fancy stuff
......@@ -490,7 +661,9 @@ via `cperl-use-syntax-table-text-property'." )
(defvar cperl-non-problems 'please-ignore-this-line
"As you know from `problems' section, Perl syntax is too hard for CPerl on
older Emacsen.
older Emacsen. Here is what you can do if you cannot upgrade, or if
you want to switch off these capabilities on RMS Emacs 20.2 (+patches) or 20.3
or better. Please skip this docs if you run a capable Emacs already.
Most of the time, if you write your own code, you may find an equivalent
\(and almost as readable) expression (what is discussed below is usually
......@@ -538,6 +711,7 @@ To speed up coloring the following compromises exist:
Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
`car' before `imenu-choose-buffer-index' in `imenu'.
`imenu-add-to-menubar' in 20.2 is broken.
A lot of things on XEmacs may be broken too, judging by bug reports I
recieve. Note that some releases of XEmacs are better than the others
as far as bugs reports I see are concerned.")
......@@ -549,8 +723,11 @@ as far as bugs reports I see are concerned.")
1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
mode - but the latter number may have improved too in last years) even
without `syntax-table' property; When using this property, it should
handle 99.995% of lines correct - or somesuch.
with old Emaxen which do not support `syntax-table' property.
When using `syntax-table' property for syntax assist hints, it should
handle 99.995% of lines correct - or somesuch. It automatically
updates syntax assist hints when you edit your script.
2) It is generally believed to be \"the most user-friendly Emacs
package\" whatever it may mean (I doubt that the people who say similar
......@@ -599,6 +776,10 @@ voice);
to
B if A;
n) Highlights (by user-choice) either 3-delimiters constructs
(such as tr/a/b/), or regular expressions and `y/tr'.
o) Highlights trailing whitespace.
5) The indentation engine was very smart, but most of tricks may be
not needed anymore with the support for `syntax-table' property. Has
progress indicator for indentation (with `imenu' loaded).
......@@ -655,8 +836,46 @@ B) Speed of editing operations.
syntax-engine-helping scan, thus will make many more Perl
constructs be wrongly recognized by CPerl, thus may lead to
wrongly matched parentheses, wrong indentation, etc.
One can unset `cperl-syntaxify-unwind'. This might speed up editing
of, say, long POD sections.
")
(defvar cperl-tips-faces 'please-ignore-this-line
"CPerl mode uses following faces for highlighting:
cperl-array-face Array names
cperl-hash-face Hash names
font-lock-comment-face Comments, PODs and whatever is considered
syntaxically to be not code
font-lock-constant-face HERE-doc delimiters, labels, delimiters of
2-arg operators s/y/tr/ or of RExen,
font-lock-function-name-face Special-cased m// and s//foo/, _ as
a target of a file tests, file tests,
subroutine names at the moment of definition
(except those conflicting with Perl operators),
package names (when recognized), format names
font-lock-keyword-face Control flow switch constructs, declarators
cperl-nonoverridable-face Non-overridable keywords, modifiers of RExen
font-lock-string-face Strings, qw() constructs, RExen, POD sections,
literal parts and the terminator of formats
and whatever is syntaxically considered
as string literals
font-lock-type-face Overridable keywords
font-lock-variable-name-face Variable declarations, indirect array and
hash names, POD headers/item names
cperl-invalid-face Trailing whitespace
Note that in several situations the highlighting tries to inform about
possible confusion, such as different colors for function names in
declarations depending on what they (do not) override, or special cases
m// and s/// which do not do what one would expect them to do.
Help with best setup of these faces for printout requested (for each of
the faces: please specify bold, italic, underline, shadow and box.)
\(Not finished.)")
;;; Portability stuff:
......@@ -713,9 +932,12 @@ B) Speed of editing operations.
'lazy-lock)
"Text property which inhibits refontification.")
(defsubst cperl-put-do-not-fontify (from to)
(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))
to cperl-do-not-fontify t)))
(defcustom cperl-mode-hook nil
"Hook run by `cperl-mode'."
......@@ -724,6 +946,8 @@ B) Speed of editing operations.
(defvar cperl-syntax-state nil)
(defvar cperl-syntax-done-to nil)
(defvar cperl-emacs-can-parse (> (length (save-excursion
(parse-partial-sexp 1 1))) 9))
;; Make customization possible "in reverse"
(defsubst cperl-val (symbol &optional default hairy)
......@@ -734,11 +958,12 @@ B) Speed of editing operations.
;;; 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)))))
;;; '(("miniperl" . perl-mode))))))
(if (fboundp 'eval-when-compile)
(eval-when-compile
(condition-case nil
......@@ -759,31 +984,18 @@ B) Speed of editing operations.
(condition-case nil
(require 'info)
(error nil))
(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 (or (string-match "XEmacs\\|Lucid" emacs-version)
window-system)
(require 'font-lock))
(require 'cl)
;; Avoid warning (tmp definitions)
(or (fboundp 'x-color-defined-p)
(defalias 'x-color-defined-p
(cond ((fboundp 'color-defined-p) 'color-defined-p)
;; XEmacs >= 19.12
((fboundp 'valid-color-name-p) 'valid-color-name-p)
;; XEmacs 19.11
(t 'x-valid-color-name-p))))
(fset 'cperl-is-face
(cond ((fboundp 'find-face)
(symbol-function 'find-face))
((and (fboundp 'face-list)
(face-list))
(function (lambda (face)
(member face (and (fboundp 'face-list)
(face-list))))))
(t
(function (lambda (face) (boundp face))))))))
(require 'cl)))
(defvar cperl-mode-abbrev-table nil
"Abbrev table in use in Cperl-mode buffers.")
......@@ -820,14 +1032,8 @@ B) Speed of editing operations.
(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-current-command
[(control c) (control h) f])
(cperl-define-key "\C-c\C-hF" 'cperl-info-on-command
[(control c) (control h) F])
(cperl-define-key "\C-c\C-hv"
;;(concat (char-to-string help-char) "v") ; does not work
'cperl-get-help
[(control c) (control h) v])
(if (cperl-val 'cperl-clobber-lisp-bindings)
(progn
(cperl-define-key "\C-hf"
......@@ -837,7 +1043,21 @@ B) Speed of editing operations.
(cperl-define-key "\C-hv"
;;(concat (char-to-string help-char) "v") ; does not work
'cperl-get-help
[(control h) v])))
[(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
......@@ -902,6 +1122,8 @@ B) Speed of editing operations.
["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]
......@@ -960,7 +1182,11 @@ B) Speed of editing operations.
["Non-problems" (describe-variable 'cperl-non-problems) t]
["Speed" (describe-variable 'cperl-speed) t]
["Praise" (describe-variable 'cperl-praise) t]
["CPerl mode" (describe-function 'cperl-mode) 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"
......@@ -1271,7 +1497,7 @@ or as help on variables `cperl-tips', `cperl-problems',
;; Fix broken font-lock:
(or (boundp 'font-lock-unfontify-region-function)
(set 'font-lock-unfontify-region-function
'font-lock-default-unfontify-buffer))
'font-lock-default-unfontify-region))
(make-variable-buffer-local 'font-lock-unfontify-region-function)
(set 'font-lock-unfontify-region-function
'cperl-font-lock-unfontify-region-function)
......@@ -1306,11 +1532,12 @@ or as help on variables `cperl-tips', `cperl-problems',
(run-hooks 'cperl-mode-hook)
;; After hooks since fontification will break this
(if cperl-pod-here-scan
(or (and (boundp 'font-lock-mode)
(eval 'font-lock-mode) ; Avoid warning
(boundp 'font-lock-hot-pass) ; Newer font-lock
cperl-syntaxify-by-font-lock)
(cperl-find-pods-heres))))
(or ;;(and (boundp 'font-lock-mode)
;; (eval 'font-lock-mode) ; Avoid warning
;; (boundp 'font-lock-hot-pass) ; Newer font-lock
cperl-syntaxify-by-font-lock ;;)
(progn (or cperl-faces-init (cperl-init-faces-weak))
(cperl-find-pods-heres)))))
;; Fix for perldb - make default reasonable
(defvar gud-perldb-history)
......@@ -1348,13 +1575,28 @@ or as help on variables `cperl-tips', `cperl-problems',
;; 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)
(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))
(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")
......@@ -1609,7 +1851,7 @@ to nil."
(save-excursion
(not
(re-search-backward
"[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
"[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
beg t)))
(save-excursion (or (not (re-search-backward "^=" nil t))
(or
......@@ -1681,6 +1923,7 @@ to nil."
(forward-char -1)
(bolp))
(or
(get-text-property (point) 'in-pod)
(cperl-after-expr-p nil "{;:")
(and (re-search-backward
"\\(\\`\n?\\|\n\n\\)=\\sw+" (point-min) t)
......@@ -1741,7 +1984,7 @@ to nil."
(save-excursion
(not
(re-search-backward
"[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
"[#\"'`]\\|\\<q\\(\\|[wqxr]\\)\\>"
beg t)))
(save-excursion (or (not (re-search-backward "^=" nil t))
(looking-at "=cut")
......@@ -1980,6 +2223,7 @@ means indent rigidly all the lines of the expression starting after point
so that this line becomes properly indented.
The relative indentation among the lines of the expression are preserved."
(interactive "P")
(cperl-update-syntaxification (point) (point))
(if whole-exp
;; If arg, always indent this line as Perl
;; and shift remaining lines of expression the same amount.
......@@ -2003,13 +2247,13 @@ The relative indentation among the lines of the expression are preserved."
(insert-tab)
(cperl-indent-line))))
(defun cperl-indent-line (&optional symbol)
(defun cperl-indent-line (&optional parse-data)
"Indent current line as Perl code.
Return the amount the indentation changed by."
(let (indent i beg shift-amt
(case-fold-search nil)
(pos (- (point-max) (point))))
(setq indent (cperl-calculate-indent nil symbol)
(setq indent (cperl-calculate-indent parse-data)
i indent)
(beginning-of-line)
(setq beg (point))
......@@ -2056,16 +2300,20 @@ Return the amount the indentation changed by."
(looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
(defun cperl-get-state (&optional parse-start start-state)
;; returns list (START STATE DEPTH PRESTART), START is a good place
;; to start parsing, STATE is what is returned by
;; `parse-partial-sexp'. DEPTH is true is we are immediately after
;; end of block which contains START. PRESTART is the position
;; basing on which START was found.
;; returns list (START STATE DEPTH PRESTART),
;; START is a good place to start parsing, or equal to
;; PARSE-START if preset,
;; STATE is what is returned by `parse-partial-sexp'.
;; DEPTH is true is we are immediately after end of block
;; which contains START.
;; PRESTART is the position basing on which START was found.
(save-excursion
(let ((start-point (point)) depth state start prestart)
(if parse-start
(if (and parse-start
(<= parse-start start-point))
(goto-char parse-start)
(beginning-of-defun))
(beginning-of-defun)
(setq start-state nil))
(setq prestart (point))
(if start-state nil
;; Try to go out, if sub is not on the outermost level
......@@ -2079,7 +2327,6 @@ Return the amount the indentation changed by."
(beginning-of-line 2))) ; Go to the next line.
(if start (goto-char start))) ; Not at the start of file
(setq start (point))
(if (< start start-point) (setq parse-start start))
(or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
(list start state depth prestart))))
......@@ -2095,7 +2342,7 @@ Return the amount the indentation changed by."
(backward-sexp)
;; Need take into account `bless', `return', `tr',...
(or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
(not (looking-at "\\(bless\\|return\\|qw\\|tr\\|[smy]\\)\\>")))
(not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
(progn
(skip-chars-backward " \t\n\f")
(and (memq (char-syntax (preceding-char)) '(?w ?_))
......@@ -2106,10 +2353,13 @@ Return the amount the indentation changed by."
(defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
(defun cperl-calculate-indent (&optional parse-start symbol)
(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
"Return appropriate indentation for current line as Perl code.
In usual case returns an integer: the column to indent to.
Returns nil if line starts inside a string, t if in a comment."
Returns nil if line starts inside a string, t if in a comment.
Will not correct the indentation for labels, but will correct it for braces
and closing parentheses and brackets.."
(save-excursion
(if (or
(memq (get-text-property (point) 'syntax-type)
......@@ -2148,15 +2398,22 @@ Returns nil if line starts inside a string, t if in a comment."
(setq pre-indent-point (point)))))))
(goto-char pre-indent-point)
(let* ((case-fold-search nil)
(s-s (cperl-get-state))
(start (nth 0 s-s))
(s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))