;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
-;; $Id: cperl-mode.el,v 1.31+ 1996/12/09 08:03:14 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.33 1997/03/14 06:45:51 ilya Exp ilya $
;;; To use this mode put the following into your .emacs file:
;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<<
;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<<
-;;; `cperl-non-problems'. <<<<<<
+;;; `cperl-non-problems', `cperl-praise'. <<<<<<
;;; Additional useful commands to put into your .emacs file:
;; (setq interpreter-mode-alist (append interpreter-mode-alist
;; '(("miniperl" . perl-mode))))
-;;; The mode information (on C-h m) provides customization help.
+;;; 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 (available on ELisp
;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
;;;; 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'.
+;;; 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.
;;;; 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.
+;;; 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.
+(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+\f
(defvar cperl-extra-newline-before-brace nil
"*Non-nil means that if, elsif, while, until, else, for, foreach
and do constructs look like:
Can be overwritten by `cperl-hairy' if nil.")
(defvar cperl-electric-lbrace-space nil
- "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '.
+ "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '.
Can be overwritten by `cperl-hairy' if nil.")
(defvar cperl-electric-parens-string "({[]})<"
"*Non-nil means shrink-wrapping of info-buffer-frame allowed.")
(defvar cperl-info-page "perl"
- "Name of the info page containing perl docs.
+ "*Name of the info page containing perl docs.
Older version of this page was called `perl5', newer `perl'.")
+(defvar cperl-use-syntax-table-text-property
+ (and (not cperl-xemacs-p)
+ (string< "19.34.94" emacs-version)) ; Not all .94 are good, but anyway
+ "*Non-nil means CPerl sets up and uses `syntax-table' text property.")
+
+(defvar cperl-scan-files-regexp "\\.\\([Pp][Llm]\\|xs\\)$"
+ "*Regexp to match files to scan when generating TAGS.")
+
+(defvar cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$"
+ "*Regexp to match files/dirs to skip when generating TAGS.")
+
+(defvar cperl-regexp-indent-step nil
+ "*indentation used when beautifying regexps.
+If `nil', the value of `cperl-indent-level' will be used.")
+
\f
;;; Short extra-docs.
This may be confusing, since the regexp s#//#/#\; may be highlighted
as a comment, but it will be recognized as a regexp by the indentation
code. Or the opposite case, when a pod section is highlighted, but
-breaks the indentation of the following code.
+may break the indentation of the following code (though indentation
+should work if the balance of delimiters is not broken by POD).
The main trick (to make $ a \"backslash\") makes constructions like
${aaa} look like unbalanced braces. The only trick I can think of is
Most the time, if you write your own code, you may find an equivalent
\(and almost as readable) expression.
-Try to help it: add comments with embedded quotes to fix CPerl
+Try to help CPerl: add comments with embedded quotes to fix CPerl
misunderstandings about the end of quotation:
$a='500$'; # ';
You won't need it too often. The reason: $ \"quotes\" the following
character (this saves a life a lot of times in CPerl), thus due to
-Emacs parsing rules it does not consider tick after the dollar as a
-closing one, but as a usual character.
+Emacs parsing rules it does not consider tick (i.e., ' ) after a
+dollar as a closing one, but as a usual character.
Now the indentation code is pretty wise. The only drawback is that it
relies on Emacs parsing to find matching parentheses. And Emacs
`car' before `imenu-choose-buffer-index' in `imenu'.
")
+(defvar cperl-praise 'please-ignore-this-line
+ "RMS asked me to list good things about CPerl. Here they go:
+
+0) It uses the newest `syntax-table' property ;-);
+
+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.
+
+2) It is generally belived to be \"the most user-friendly Emacs
+package\" whatever it may mean (I doubt that the people who say similar
+things tried _all_ the rest of Emacs ;-), but this was not a lonely
+voice);
+
+3) Everything is customizable, one-by-one or in a big sweep;
+
+4) It has many easily-accessable \"tools\":
+ a) Can run program, check syntax, start debugger;
+ b) Can lineup vertically \"middles\" of rows, like `=' in
+ a = b;
+ cc = d;
+ c) Can insert spaces where this impoves readability (in one
+ interactive sweep over the buffer);
+ d) Has support for imenu, including:
+ 1) Separate unordered list of \"interesting places\";
+ 2) Separate TOC of POD sections;
+ 3) Separate list of packages;
+ 4) Hierarchical view of methods in (sub)packages;
+ 5) and functions (by the full name - with package);
+ e) Has an interface to INFO docs for Perl; The interface is
+ very flexible, including shrink-wrapping of
+ documentation buffer/frame;
+ f) Has a builtin list of one-line explanations for perl constructs.
+ g) Can show these explanations if you stay long enough at the
+ corresponding place (or on demand);
+ h) Has an enhanced fontification (using 3 or 4 additional faces
+ comparing to font-lock - basically, different
+ namespaces in Perl have different colors);
+ i) Can construct TAGS basing on its knowledge of Perl syntax,
+ the standard menu has 6 different way to generate
+ TAGS (if by directory, .xs files - with C-language
+ bindings - are included in the scan);
+ j) Can build a hierarchical view of classes (via imenu) basing
+ on generated TAGS file;
+ k) Has electric parentheses, electric newlines, uses Abbrev
+ for electric logical constructs
+ while () {}
+ with different styles of expansion (context sensitive
+ to be not so bothering). Electric parentheses behave
+ \"as they should\" in a presence of a visible region.
+ l) Changes msb.el \"on the fly\" to insert a group \"Perl files\";
+
+5) The indentation engine was very smart, but most of tricks may be
+not needed anymore with the support for `syntax-table' property. Has
+progress indicator for indentation (with `imenu' loaded).
+
+6) Indent-region improves inline-comments as well;
+
+7) Fill-paragraph correctly handles multi-line comments;
+")
+
\f
;;; Portability stuff:
-(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
(defmacro cperl-define-key (fsf-key definition &optional xemacs-key)
- `(define-key cperl-mode-map
- ,(if xemacs-key
- `(if cperl-xemacs-p ,xemacs-key ,fsf-key)
- fsf-key)
- ,definition))
+ (` (define-key cperl-mode-map
+ (, (if xemacs-key
+ (` (if cperl-xemacs-p (, xemacs-key) (, fsf-key)))
+ fsf-key))
+ (, definition))))
(defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
(where-is-internal 'backward-delete-char-untabify)))
(cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
(cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
(cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+ (cperl-define-key [?\C-\M-\|] 'cperl-lineup)
;;(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-hf" 'cperl-info-on-command [(control h) f])
(cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
[(control c) (control h) f])
- (cperl-define-key "\C-hv" 'cperl-get-help [(control h) v])
+ (cperl-define-key "\C-hf"
+ ;;(concat (char-to-string help-char) "f") ; does not work
+ 'cperl-info-on-command
+ [(control h) f])
+ (cperl-define-key "\C-hv"
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ 'cperl-get-help
+ [(control h) v])
(if (and cperl-xemacs-p
(<= emacs-minor-version 11) (<= emacs-major-version 19))
(progn
["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)]
+ ["Beautify a regexp" cperl-beautify-regexp
+ cperl-use-syntax-table-text-property]
"----"
["Indent region" cperl-indent-region (cperl-use-region-p)]
["Comment region" cperl-comment-region (cperl-use-region-p)]
("Micro-docs"
["Tips" (describe-variable 'cperl-tips) t]
["Problems" (describe-variable 'cperl-problems) t]
- ["Non-problems" (describe-variable 'cperl-non-problems) t]))))
+ ["Non-problems" (describe-variable 'cperl-non-problems) t]
+ ["Praise" (describe-variable 'cperl-praise) t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
(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 ?_ "w" 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)
+ (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 )
+)
\f
is nil. It is also possible to switch this on/off from the
menu. 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. In a future version results of scan may be used
(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]*")
+ (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)[ \t]*")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
'((perl-font-lock-keywords
perl-font-lock-keywords-1
perl-font-lock-keywords-2))))
+ (if cperl-use-syntax-table-text-property
+ (progn
+ (make-variable-buffer-local 'parse-sexp-lookup-properties)
+ (setq parse-sexp-lookup-properties t)))
(or (fboundp 'cperl-old-auto-fill-mode)
(progn
(fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
(skip-chars-backward "$")
(looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
(insert ? ))
- (if (cperl-after-expr-p nil "{};)") nil (setq cperl-auto-newline nil))
+ (if (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 ?{)
(>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
;;(not (save-excursion (search-backward "#" beg t)))
(if (eq last-command-char ?<)
- (cperl-after-expr-p nil "{};(,:=")
+ (cperl-after-expr-p nil "{;(,:=")
1))
(progn
(insert last-command-char)
(dollar (eq last-command-char ?$)))
(and (save-excursion
(backward-sexp 1)
- (cperl-after-expr-p nil "{};:"))
+ (cperl-after-expr-p nil "{;:"))
(save-excursion
(not
(re-search-backward
(let ((beg (save-excursion (beginning-of-line) (point))))
(and (save-excursion
(backward-sexp 1)
- (cperl-after-expr-p nil "{};:"))
+ (cperl-after-expr-p nil "{;:"))
(save-excursion
(not
(re-search-backward
(setq indent (cperl-calculate-indent nil symbol))
(beginning-of-line)
(setq beg (point))
- (cond ((eq indent nil)
+ (cond ((or (eq indent nil) (eq indent t))
(setq indent (current-indentation)))
;;((eq indent t) ; Never?
;; (setq indent (cperl-calculate-indent-within-comment)))
(t
(skip-chars-forward " \t")
(if (listp indent) (setq indent (car indent)))
- (cond ((looking-at "[A-Za-z]+:[^:]")
+ (cond ((looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
(and (> indent 0)
(setq indent (max cperl-min-label-indent
(+ indent cperl-label-offset)))))
(progn
(backward-sexp)
(looking-at
- "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*[#{]")))))))))
+ "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*\\(([^()]*)[ \t\n\f]*\\)?[#{]")))))))))
+
+(defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
(defun cperl-calculate-indent (&optional parse-start symbol)
"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."
(save-excursion
- (if (memq (get-text-property (point) 'syntax-type) '(pod here-doc)) nil
- (beginning-of-line)
- (let* ((indent-point (point))
- (case-fold-search nil)
+ (if (or
+ (memq (get-text-property (point) 'syntax-type)
+ '(pod here-doc here-doc-delim format))
+ ;; before start of POD - whitespace found since do not have 'pod!
+ (and (looking-at "[ \t]*\n=")
+ (error "Spaces before pod section!")))
+ nil
+ (beginning-of-line)
+ (let ((indent-point (point))
+ (char-after (save-excursion
+ (skip-chars-forward " \t")
+ (following-char)))
+ (in-pod (get-text-property (point) 'in-pod))
+ (pre-indent-point (point))
+ p prop look-prop)
+ (cond
+ (in-pod
+ ;; In the verbatim part, probably code example. What to do???
+ )
+ (t
+ (save-excursion
+ ;; Not in pod
+ (cperl-backward-to-noncomment nil)
+ (setq p (max (point-min) (1- (point)))
+ prop (get-text-property p 'syntax-type)
+ look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
+ 'syntax-type))
+ (if (memq prop '(pod here-doc format here-doc-delim))
+ (progn
+ (goto-char (or (previous-single-property-change p look-prop)
+ (point-min)))
+ (beginning-of-line)
+ (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))
(state (nth 1 s-s))
(containing-sexp (car (cdr state)))
- (char-after (save-excursion
- (skip-chars-forward " \t")
- (following-char)))
(start-indent (save-excursion
(goto-char start)
(- (current-indentation)
(t
;; Statement level. Is it a continuation or a new statement?
;; Find previous non-comment character.
- (goto-char indent-point)
+ (goto-char pre-indent-point)
(cperl-backward-to-noncomment containing-sexp)
;; Back up over label lines, since they don't
;; affect whether our line is a continuation.
(skip-chars-backward " \t")
(if (and (eq (preceding-char) ?b)
(progn
- (forward-word -1)
+ (forward-sexp -1)
(looking-at "sub\\>"))
(setq old-indent
(nth 1
;; If line starts with label, calculate label indentation
(if (save-excursion
(beginning-of-line)
- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+ (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
(cperl-calculate-indent
(if (and parse-start (<= parse-start (point)))
parse-start)))
- (current-indentation)))))))))))))
+ (current-indentation))))))))))))))
(defvar cperl-indent-alist
'((string nil)
;; If line starts with label, calculate label indentation
(if (save-excursion
(beginning-of-line)
- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+ (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
(cperl-calculate-indent
Returns true if comment is found."
(let (state stop-in cpoint (lim (progn (end-of-line) (point))))
(beginning-of-line)
- (if (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)
+ (if (or
+ (eq (get-text-property (point) 'syntax-type) 'pod)
+ (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))
(if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
;; Else
(while (not stop-in)
)
(nth 4 state))))
+(defsubst cperl-1- (p)
+ (max (point-min) (1- p)))
+
+(defsubst cperl-1+ (p)
+ (min (point-max) (1+ p)))
+
+(defvar cperl-st-cfence '(14)) ; Comment-fence
+(defvar cperl-st-sfence '(15)) ; String-fence
+(defvar cperl-st-punct '(1))
+(defvar cperl-st-word '(2))
+
+(defun cperl-protect-defun-start (s e)
+ ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
+ (save-excursion
+ (goto-char s)
+ (while (re-search-forward "^\\s(" e 'to-end)
+ (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
+
+(defun cperl-commentify (bb e string)
+ (if cperl-use-syntax-table-text-property
+ (progn
+ ;; We suppose that e is _after_ the end of construction, as after eol.
+ (setq string (if string cperl-st-sfence cperl-st-cfence))
+ (put-text-property bb (1+ bb) 'syntax-table string)
+ (put-text-property bb (1+ bb) 'rear-nonsticky t)
+ (put-text-property (1- e) e 'syntax-table string)
+ (put-text-property (1- e) e 'rear-nonsticky t)
+ (if (and (eq string cperl-st-sfence) (> (- e 2) bb))
+ (put-text-property (1+ bb) (1- e)
+ 'syntax-table cperl-string-syntax-table))
+ (cperl-protect-defun-start bb e))))
+
(defun cperl-find-pods-heres (&optional min max)
"Scans the buffer for POD sections and here-documents.
If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
(interactive)
(or min (setq min (point-min)))
(or max (setq max (point-max)))
- (let (face head-face here-face b e bb tag qtag err b1 e1 argument
+ (let (face head-face here-face b e bb tag qtag err b1 e1 argument st i c
(cperl-pod-here-fontify (eval cperl-pod-here-fontify))
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
(modified (buffer-modified-p))
(after-change-functions nil)
+ (state-point (point-min)) state
(search
(concat
"\\(\\`\n?\\|\n\n\\)="
"\\)"
"\\|"
;; 1+6 extra () before this:
- "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
+ "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
+ (if cperl-use-syntax-table-text-property
+ (concat
+ "\\|"
+ ;; 1+6+2=9 extra () before this:
+ "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
+ "\\|"
+ ;; 1+6+2+1=10 extra () before this:
+ "\\([?/]\\)" ; /blah/ or ?blah?
+ "\\|"
+ ;; 1+6+2+1+1=11 extra () before this:
+ "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
+ "\\|"
+ ;; 1+6+2+1+1+2=13 extra () before this:
+ "\\$\\(['{]\\)"
+ "\\|"
+ ;; 1+6+2+1+1+2+1=14 extra () before this:
+ "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+ ""))))
(unwind-protect
(progn
(save-excursion
(setq face cperl-pod-face
head-face cperl-pod-head-face
here-face cperl-here-face))
- (remove-text-properties min max '(syntax-type t))
+ (remove-text-properties min max
+ '(syntax-type t in-pod t syntax-table t))
;; Need to remove face as well...
(goto-char min)
(while (re-search-forward search max t)
;; "\\(\\`\n?\\|\n\n\\)="
(if (looking-at "\n*cut\\>")
(progn
- (message "=cut is not preceeded by a pod section")
- (setq err (point)))
+ (message "=cut is not preceded by a pod section")
+ (or err (setq err (point))))
(beginning-of-line)
(setq b (point) bb b)
(or (re-search-forward "\n\n=cut\\>" max 'toend)
- (message "Cannot find the end of a pod section"))
- (beginning-of-line 3)
+ (progn
+ (message "Cannot find the end of a pod section")
+ (or err (setq err b))))
+ (beginning-of-line 2) ; An empty line after =cut is not POD!
(setq e (point))
(put-text-property b e 'in-pod t)
(goto-char b)
(while (re-search-forward "\n\n[ \t]" e t)
+ ;; We start 'pod 1 char earlier to include the preceding line
(beginning-of-line)
- (put-text-property b (point) 'syntax-type 'pod)
+ (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
(cperl-put-do-not-fontify b (point))
;;(put-text-property (max (point-min) (1- b))
;; (point) cperl-do-not-fontify t)
(re-search-forward "\n\n[^ \t\f\n]" e 'toend)
(beginning-of-line)
(setq b (point)))
- (put-text-property (point) e 'syntax-type 'pod)
+ (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
(cperl-put-do-not-fontify (point) e)
;;(put-text-property (max (point-min) (1- (point)))
;; e cperl-do-not-fontify t)
(progn (put-text-property (point) e 'face face)
(goto-char bb)
(if (looking-at
- "=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
+ "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
(put-text-property
(match-beginning 1) (match-end 1)
'face head-face))
(while (re-search-forward
;; One paragraph
- "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
+ "\n\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
e 'toend)
(put-text-property
(match-beginning 1) (match-end 1)
'face head-face))))
+ (cperl-commentify bb e nil)
(goto-char e)))
;; Here document
+ ;; We do only one here-per-line
;; 1 () ahead
;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
((match-beginning 2) ; 1 + 1
- ;; Abort in comment (_extremely_ simplified):
+ ;; Abort in comment:
(setq b (point))
- (if (save-excursion
- (beginning-of-line)
- (search-forward "#" b t))
- nil
+ (setq state (parse-partial-sexp state-point b nil nil state)
+ state-point b)
+ (if ;;(save-excursion
+ ;; (beginning-of-line)
+ ;; (search-forward "#" b t))
+ (or (nth 3 state) (nth 4 state))
+ (goto-char (match-end 2))
(if (match-beginning 5) ;4 + 1
(setq b1 (match-beginning 5) ; 4 + 1
e1 (match-end 5)) ; 4 + 1
;; cperl-do-not-fontify t)
(put-text-property b (match-beginning 0)
'face here-face)))
+ (setq e1 (cperl-1+ (match-end 0)))
(put-text-property b (match-beginning 0)
'syntax-type 'here-doc)
- (cperl-put-do-not-fontify b (match-beginning 0)))
- (t (message "End of here-document `%s' not found." tag)))))
+ (put-text-property (match-beginning 0) e1
+ 'syntax-type 'here-doc-delim)
+ (put-text-property b e1
+ 'here-doc-group t)
+ (cperl-commentify b e1 nil)
+ (cperl-put-do-not-fontify b (match-end 0)))
+ (t (message "End of here-document `%s' not found." tag)
+ (or err (setq err b))))))
;; format
- (t
+ ((match-beginning 8)
;; 1+6=7 extra () before this:
- ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
+ ;;"^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
(setq b (point)
name (if (match-beginning 8) ; 7 + 1
(buffer-substring (match-beginning 8) ; 7 + 1
(end-of-line)
(put-text-property b1 (point)
'face font-lock-string-face)
+ (cperl-commentify b1 (point) nil)
(cperl-put-do-not-fontify b1 (point)))))
(re-search-forward (concat "^[.;]$") max 'toend))
(beginning-of-line)
(progn
(put-text-property (point) (+ (point) 2)
'face font-lock-string-face)
+ (cperl-commentify (point) (+ (point) 2) nil)
(cperl-put-do-not-fontify (point) (+ (point) 2)))
- (message "End of format `%s' not found." name))
+ (message "End of format `%s' not found." name)
+ (or err (setq err b)))
(forward-line)
(put-text-property b (point) 'syntax-type 'format)
;;; (cond ((re-search-forward (concat "^[.;]$") max 'toend)
;;; 'syntax-type 'format)
;;; (cperl-put-do-not-fontify b (match-beginning 0)))
;;; (t (message "End of format `%s' not found." name)))
- )))
+ )
+ ;; Regexp:
+ ((or (match-beginning 10) (match-beginning 11))
+ ;; 1+6+2=9 extra () before this:
+ ;; "\\<\\(qx?\\|[my]\\)\\>"
+ (setq b1 (if (match-beginning 10) 10 11)
+ argument (buffer-substring
+ (match-beginning b1) (match-end b1))
+ b (point)
+ i b
+ c (char-after (match-beginning b1))
+ bb (or
+ (memq (char-after (1- (match-beginning b1)))
+ '(?\$ ?\@ ?\% ?\& ?\*))
+ (and
+ (eq (char-after (1- (match-beginning b1))) ?-)
+ (eq (char-after (match-beginning b1)) ?s))))
+ (or bb
+ (if (eq b1 11) ; bare /blah/ or ?blah?
+ (setq argument ""
+ bb
+ (progn
+ (goto-char (match-beginning b1))
+ (cperl-backward-to-noncomment (point-min))
+ (not (or (memq (preceding-char)
+ (append (if (eq c ?\?)
+ ;; $a++ ? 1 : 2
+ "~{(=|&*!,;"
+ "~{(=|&+-*!,;") nil))
+ (and (eq (preceding-char) ?\})
+ (cperl-after-block-p (point-min)))
+ (and (eq (char-syntax (preceding-char)) ?w)
+ (progn
+ (forward-sexp -1)
+ (looking-at
+ "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\)\\>")))
+ (and (eq (preceding-char) ?.)
+ (eq (char-after (- (point) 2)) ?.))
+ (bobp))))
+ b (1- b))))
+ (or bb (setq state (parse-partial-sexp
+ state-point b nil nil state)
+ state-point b))
+ (goto-char b)
+ (if (or bb (nth 3 state) (nth 4 state))
+ (goto-char i)
+ (skip-chars-forward " \t")
+ ;; qtag means two-argument matcher, may be reset to
+ ;; 2 or 3 later if some special quoting is needed.
+ (setq b (point)
+ tag (char-after b)
+ qtag (if (string-match "^\\([sy]\\|tr\\)$" argument) t)
+ e1 (cdr (assoc tag '(( ?\( . ?\) )
+ ( ?\[ . ?\] )
+ ( ?\{ . ?\} )
+ ( ?\< . ?\> )
+ ))))
+ ;; What if tag == ?\\ ????
+ (or st
+ (progn
+ (setq st (make-syntax-table) i 0)
+ (while (< i 256)
+ (modify-syntax-entry i "." st)
+ (setq i (1+ i)))
+ (modify-syntax-entry ?\\ "\\" st)))
+ ;; Whether we have an intermediate point
+ (setq i nil)
+ ;; Prepare the syntax table:
+ (cond
+ ;; $ has TeXish matching rules, so $$ equiv $...
+ ((and qtag
+ (not e1)
+ (eq tag (char-after (cperl-1+ b)))
+ (eq tag (char-after (+ 2 b))))
+ (setq qtag 3)) ; s///
+ ((and qtag
+ (not e1)
+ (eq tag (char-after (cperl-1+ b))))
+ (setq qtag nil)) ; s//blah/, will work anyway
+ ((and (not e1)
+ (eq tag (char-after (cperl-1+ b))))
+ (setq qtag 2)) ; m//
+ ((not e1)
+ (modify-syntax-entry tag "$" st)) ; m/blah/, s/x//, s/x/y/
+ (t ; s{}(), m[]
+ (modify-syntax-entry tag (concat "(" (list e1)) st)
+ (modify-syntax-entry e1 (concat ")" (list tag)) st)))
+ (if (numberp qtag)
+ (forward-char qtag)
+ (condition-case bb
+ (progn
+ (set-syntax-table st)
+ (forward-sexp 1) ; Wrong if m// - taken care of...
+ (if qtag
+ (if e1
+ (progn
+ (setq i (point))
+ (set-syntax-table cperl-mode-syntax-table)
+ (forward-sexp 1)) ; Should be smarter?
+ ;; "$" has funny matching rules
+ (if (/= (char-after (- (point) 2))
+ (preceding-char))
+ (progn
+ ;; Commenting \\ is dangerous, what about ( ?
+ (if (eq (following-char) ?\\) nil
+ (setq i (point)))
+ (forward-char -1)
+ (forward-sexp 1)))
+ )))
+ (error (goto-char (point-max))
+ (message
+ "End of `%s%c ... %c' string not found: %s"
+ argument tag (or e1 tag) bb)
+ (or err (setq err b)))))
+ (set-syntax-table cperl-mode-syntax-table)
+ (if (null i)
+ (cperl-commentify b (point) t)
+ (cperl-commentify b i t)
+ (if (looking-at "\\sw*e") nil ; s///e
+ (cperl-commentify i (point) t)))
+ (if (eq (char-syntax (following-char)) ?w)
+ (forward-word 1)) ; skip modifiers s///s
+ (modify-syntax-entry tag "." st)
+ (if e1 (modify-syntax-entry e1 "." st))))
+ ((match-beginning 13) ; sub with prototypes
+ (setq b (match-beginning 0))
+ (if (memq (char-after (1- b))
+ '(?\$ ?\@ ?\% ?\& ?\*))
+ nil
+ (setq state (parse-partial-sexp
+ state-point (1- b) nil nil state)
+ state-point (1- b))
+ (if (or (nth 3 state) (nth 4 state))
+ nil
+ ;; Mark as string
+ (cperl-commentify (match-beginning 13) (match-end 13) t))
+ (goto-char (match-end 0))))
+ ((and (match-beginning 14)
+ (eq (preceding-char) ?\')) ; $'
+ (setq b (1- (point))
+ state (parse-partial-sexp
+ state-point (1- b) nil nil state)
+ state-point (1- b))
+ (if (nth 3 state) ; in string
+ (progn
+ (put-text-property (1- b) b 'syntax-table cperl-st-punct)
+ (put-text-property (1- b) b 'rear-nonsticky t)))
+ (goto-char (1+ b)))
+ ((match-beginning 14) ; ${
+ (setq bb (match-beginning 0))
+ (put-text-property bb (1+ bb) 'syntax-table cperl-st-punct)
+ (put-text-property bb (1+ bb) 'rear-nonsticky t))
+ (t ; old $abc'efg syntax
+ (setq bb (match-end 0))
+ (put-text-property (1- bb) bb 'syntax-table cperl-st-word))))
;;; (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
;;; (if (looking-at "\n*cut\\>")
;;; (progn
-;;; (message "=cut is not preceeded by a pod section")
+;;; (message "=cut is not preceded by a pod section")
;;; (setq err (point)))
;;; (beginning-of-line)
(message "Scan for pods, formats and here-docs completed.")))
(and (buffer-modified-p)
(not modified)
- (set-buffer-modified-p nil)))))
+ (set-buffer-modified-p nil))
+ (set-syntax-table cperl-mode-syntax-table))))
(defun cperl-backward-to-noncomment (lim)
;; Stops at lim or after non-whitespace that is not in comment
(if (< p (point)) (goto-char p))
(setq stop t)))))
+(defun cperl-after-block-p (lim)
+ ;; We suppose that the preceding char is }.
+ (save-excursion
+ (condition-case nil
+ (progn
+ (forward-sexp -1)
+ (cperl-backward-to-noncomment lim)
+ (or (eq (preceding-char) ?\) ) ; if () {}
+ (and (eq (char-syntax (preceding-char)) ?w) ; else {}
+ (progn
+ (forward-sexp -1)
+ (looking-at "\\(else\\|grep\\|map\\)\\>")))
+ (cperl-after-expr-p lim)))
+ (error nil))))
+
(defun cperl-after-expr-p (&optional lim chars test)
"Returns true if the position is good for start of expression.
TEST is the expression to evaluate at the found position. If absent,
-CHARS is a string that contains good characters to have before us."
- (let (stop p)
+CHARS is a string that contains good characters to have before us (however,
+`}' is treated \"smartly\" if it is not in the list)."
+ (let (stop p
+ (lim (or lim (point-min))))
(save-excursion
- (while (and (not stop) (> (point) (or lim 1)))
+ (while (and (not stop) (> (point) lim))
(skip-chars-backward " \t\n\f" lim)
(setq p (point))
(beginning-of-line)
(setq stop t)))
(or (bobp)
(progn
- (backward-char 1)
(if test (eval test)
- (memq (following-char) (append (or chars "{};") nil))))))))
+ (or (memq (preceding-char) (append (or chars "{;") nil))
+ (and (eq (preceding-char) ?\})
+ (cperl-after-block-p lim)))))))))
(defun cperl-backward-to-start-of-continued-exp (lim)
(if (memq (preceding-char) (append ")]}\"'`" nil))
comment-column))
(setq old-comm-indent nil)))
(if (and old-comm-indent
- (= (current-indentation) old-comm-indent))
+ (= (current-indentation) old-comm-indent)
+ (not (eq (get-text-property (point) 'syntax-type) 'pod)))
(let ((comment-column new-comm-indent))
(indent-for-comment)))
(progn
(or comm
(progn
(if (setq old-comm-indent (and (cperl-to-comment-or-eol)
+ (not (eq (get-text-property (point) 'syntax-type) 'pod))
(current-column)))
(progn (indent-for-comment)
(skip-chars-backward " \t")
(imenu-progress-message pm 100)
(message nil)))))
-(defun cperl-slash-is-regexp (&optional pos)
- (save-excursion
- (goto-char (if pos pos (1- (point))))
- (and
- (not (memq (get-text-property (point) 'face)
- '(font-lock-string-face font-lock-comment-face)))
- (cperl-after-expr-p nil nil '
- (or (looking-at "[^]a-zA-Z0-9_)}]")
- (eq (get-text-property (point) 'face)
- 'font-lock-keyword-face))))))
+;;(defun cperl-slash-is-regexp (&optional pos)
+;; (save-excursion
+;; (goto-char (if pos pos (1- (point))))
+;; (and
+;; (not (memq (get-text-property (point) 'face)
+;; '(font-lock-string-face font-lock-comment-face)))
+;; (cperl-after-expr-p nil nil '
+;; (or (looking-at "[^]a-zA-Z0-9_)}]")
+;; (eq (get-text-property (point) 'face)
+;; 'font-lock-keyword-face))))))
;; Stolen from lisp-mode with a lot of improvements
(or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
(defvar imenu-example--function-name-regexp-perl
- "^\\([ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\|=head\\([12]\\)[ \t]+\\([^\n]+\\)$\\)")
+ (concat
+ "^\\("
+ "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?"
+ "\\|"
+ "=head\\([12]\\)[ \t]+\\([^\n]+\\)$"
+ "\\)"))
(defun cperl-imenu-addback (lst &optional isback name)
;; We suppose that the lst is a DAG, unless the first element only
(imenu-progress-message prev-pos)
;;(backward-up-list 1)
(cond
- ((match-beginning 2) ; package or sub
+ ((and
+ (match-beginning 2) ; package or sub
+ ;; Skip if quoted (will not skip multi-line ''-comments :-():
+ (null (get-text-property (match-beginning 1) 'syntax-table))
+ (null (get-text-property (match-beginning 1) 'syntax-type))
+ (null (get-text-property (match-beginning 1) 'in-pod)))
(save-excursion
(goto-char (match-beginning 2))
(setq fchar (following-char))
)
- (setq char (following-char) meth nil)
- (setq p (point))
+ ;; (if (looking-at "([^()]*)[ \t\n\f]*")
+ ;; (goto-char (match-end 0))) ; Messes what follows
+ (setq char (following-char)
+ meth nil
+ p (point))
(while (and ends-ranges (>= p (car ends-ranges)))
;; delete obsolete entries
(setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
(push index index-alist))
(if meth (push index index-meth-alist))
(push index index-unsorted-alist)))
- (t ; Pod section
+ ((match-beginning 5) ; Pod section
;; (beginning-of-line)
(setq index (imenu-example--name-and-position)
- name (buffer-substring (match-beginning 5) (match-end 5)))
+ name (buffer-substring (match-beginning 6) (match-end 6)))
(set-text-properties 0 (length name) nil name)
- (if (eq (char-after (match-beginning 4)) ?2)
+ (if (eq (char-after (match-beginning 5)) ?2)
(setq name (concat " " name)))
(setcar index name)
(setq index1 (cons (concat "=" name) (cdr index)))
"ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
"time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
"w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
- "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
+ "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\|PACKAGE__\\)"
"\\)\\>") 2 'font-lock-type-face)
;; In what follows we use `other' style
;; for nonoverwritable builtins
;; "\\|")
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
- '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
+ '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
font-lock-function-name-face)
'("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
2 font-lock-function-name-face)
(defun cperl-imenu-info-imenu-search ()
(if (looking-at "^-X[ \t\n]") nil
(re-search-backward
- "^\n\\([-a-zA-Z]+\\)[ \t\n]")
+ "^\n\\([-a-zA-Z_]+\\)[ \t\n]")
(forward-line 1)))
(defun cperl-imenu-info-imenu-name ()
in subdirectories too."
(interactive)
(let ((cmd "etags")
- (args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\([{#]\\|$\\)\\)/\\4/"))
+ (args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([{#]\\|$\\)\\)/\\4/"))
res)
(if add (setq args (cons "-a" args)))
(or files (setq files (list buffer-file-name)))
(erase-buffer)
(setq erase 'ignore)))
(let ((files
- (directory-files file t (if recurse nil "\\.[Pp][Llm]$") t)))
+ (directory-files file t
+ (if recurse nil cperl-scan-files-regexp)
+ t)))
(mapcar (function (lambda (file)
(cond
- ((string-match "/\\.\\.?$" file) nil)
+ ((string-match cperl-noscan-files-regexp file)
+ nil)
((not (file-directory-p file))
- (if (string-match "\\.\\([Pp][Llm]\\|xs\\)$" file)
+ (if (string-match cperl-scan-files-regexp file)
(cperl-write-tags file erase recurse nil t)))
((not recurse) nil)
(t (cperl-write-tags file erase recurse t t)))))
(initialize-new-tags-table))))))
(defvar cperl-tags-hier-regexp-list
- "^\\(\\(package\\)\\>\\|sub\\>[^\n]+::\\|[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::\\|[ \t]*BOOT:\C-?[^\n]+::\\)")
+ (concat
+ "^\\("
+ "\\(package\\)\\>"
+ "\\|"
+ "sub\\>[^\n]+::"
+ "\\|"
+ "[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::" ; XSUB?
+ "\\|"
+ "[ \t]*BOOT:\C-?[^\n]+::" ; BOOT section
+ "\\)"))
(defvar cperl-hierarchy '(() ())
"Global hierarchy of classes")
(setq pos (match-beginning 0)
pack (match-beginning 2))
(beginning-of-line)
- (if (looking-at "\\([^\n]+\\)\C-?\\([^\n]+\\)\C-a\\([0-9]+\\),\\([0-9]+\\)")
+ (if (looking-at (concat
+ "\\([^\n]+\\)"
+ "\C-?"
+ "\\([^\n]+\\)"
+ "\C-a"
+ "\\([0-9]+\\)"
+ ","
+ "\\([0-9]+\\)"))
(progn
(setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
name (buffer-substring (match-beginning 2) (match-end 2))
(if window-system
(x-popup-menu t (nth 2 cperl-hierarchy))
(require 'tmm)
- (tmm-prompt t (nth 2 cperl-hierarchy))))
+ (tmm-prompt (nth 2 cperl-hierarchy))))
(if (and update (listp update))
(progn (while (cdr update) (setq update (cdr update)))
(setq update (car update)))) ; Get the last from the list
(cons (car elt)
(cperl-menu-to-keymap list))))
(t
- (list (cdr elt) (car elt))))))
+ (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
(cperl-list-fold menu "Root" imenu-max-items)))))
\f
(defvar cperl-not-bad-style-regexp
(mapconcat 'identity
'("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++
- "[a-zA-Z0-9][|&][a-zA-Z0-9$]" ; abc|def abc&def are often used.
- "&[(a-zA-Z0-9$]" ; &subroutine &(var->field)
+ "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
+ "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field)
"<\\$?\\sw+\\(\\.\\sw+\\)?>" ; <IN> <stdin.h>
"-[a-zA-Z][ \t]+[_$\"'`]" ; -f file
"-[0-9]" ; -5
"||"
"&&"
"[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
- "-[a-zA-Z0-9]+[ \t]*=>" ; -option => value
+ "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value
;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
;;"[*/+-|&<.]+="
)
;; Try to backtrace
(cond
((looking-at "[a-zA-Z0-9_:]") ; symbol
- (skip-chars-backward "[a-zA-Z0-9_:]")
+ (skip-chars-backward "a-zA-Z0-9_:")
(cond
((and (eq (preceding-char) ?^) ; $^I
(eq (char-after (- (point) 2)) ?\$))
((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
(forward-char -1))
((looking-at "[-!&*+,-./<=>?\\\\^|~]")
- (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
+ (skip-chars-backward "-!&*+,-./<=>?\\\\^|~")
(cond
((and (eq (preceding-char) ?\$)
(not (eq (char-after (- (point) 2)) ?\$))) ; $-
The data for these docs is a little bit obsolete and may be in fact longer
than a line. Your contribution to update/shorten it is appreciated."
(interactive)
- (save-excursion
- (let ((word (cperl-word-at-point-hard)))
- (if word
- (if (and cperl-help-from-timer ; Bail out if not in mainland
- (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
- (or (memq (get-text-property (point) 'face)
- '(font-lock-comment-face font-lock-string-face))
- (memq (get-text-property (point) 'syntax-type)
- '(pod here-doc format))))
- nil
- (cperl-describe-perl-symbol word))
- (if cperl-message-on-help-error
- (message "Nothing found for %s..."
- (buffer-substring (point) (+ 5 (point)))))))))
+ (save-match-data ; May be called "inside" query-replace
+ (save-excursion
+ (let ((word (cperl-word-at-point-hard)))
+ (if word
+ (if (and cperl-help-from-timer ; Bail out if not in mainland
+ (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
+ (or (memq (get-text-property (point) 'face)
+ '(font-lock-comment-face font-lock-string-face))
+ (memq (get-text-property (point) 'syntax-type)
+ '(pod here-doc format))))
+ nil
+ (cperl-describe-perl-symbol word))
+ (if cperl-message-on-help-error
+ (message "Nothing found for %s..."
+ (buffer-substring (point) (min (+ 5 (point)) (point-max))))))))))
;;; Stolen from perl-descr.el by Johan Vromans:
@ARGV Command line arguments (not including the command name - see $0).
@INC List of places to look for perl scripts during do/include/use.
@_ Parameter array for subroutines. Also used by split unless in array context.
-\\ Creates a reference to whatever follows, like \$var.
+\\ Creates reference to what follows, like \$var, or quotes non-\w in strings.
\\0 Octal char, e.g. \\033.
\\E Case modification terminator. See \\Q, \\L, and \\U.
\\L Lowercase until \\E . See also \l, lc.
\\c Control character, e.g. \\c[ .
\\e Escape character (octal 033).
\\f Formfeed character (octal 014).
-\\l Lowercase the next character. See also \\L and \\u, lcfirst,
-\\n Newline character (octal 012).
-\\r Return character (octal 015).
+\\l Lowercase the next character. See also \\L and \\u, lcfirst.
+\\n Newline character (octal 012 on most systems).
+\\r Return character (octal 015 on most systems).
\\t Tab character (octal 011).
-\\u Upcase the next character. See also \\U and \\l, ucfirst,
+\\u Upcase the next character. See also \\U and \\l, ucfirst.
\\x Hex character, e.g. \\x1b.
-^ ... Bitwise exclusive or.
+... ^ ... Bitwise exclusive or.
__END__ Ends program source.
__DATA__ Ends program source.
__FILE__ Current (source) filename.
__LINE__ Current line in current source.
+__PACKAGE__ Current package.
ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
ARGVOUT Output filehandle with -i flag.
BEGIN { ... } Immediately executed (during compilation) piece of code.
delete($HASH{KEY})
die(LIST)
do { ... }|SUBR while|until EXPR executes at least once
-do(EXPR|SUBR([LIST]))
+do(EXPR|SUBR([LIST])) (with while|until executes at least once)
dump LABEL
each(%HASH)
endgrent
oct(EXPR)
open(FILEHANDLE[,EXPR])
opendir(DIRHANDLE,EXPR)
-ord(EXPR)
+ord(EXPR) ASCII value of the first char of the string.
pack(TEMPLATE,LIST)
package NAME Introduces package context.
-pipe(READHANDLE,WRITEHANDLE)
+pipe(READHANDLE,WRITEHANDLE) Create a pair of filehandles on ends of a pipe.
pop(ARRAY)
print [FILEHANDLE] [(LIST)]
printf [FILEHANDLE] (FORMAT,LIST)
vec(EXPR,OFFSET,BITS)
wait
waitpid(PID,FLAGS)
-wantarray
+wantarray Returns true if the sub/eval is called in list context.
warn(LIST)
while (EXPR) { ... } EXPR while EXPR
write[(EXPR|FILEHANDLE)]
abs [ EXPR ] absolute value
... and ... Low-precedence synonym for &&.
bless REFERENCE [, PACKAGE] Makes reference into an object of a package.
-chomp Docs missing
-chr Docs missing
+chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
+chr Converts a number to char with the same ordinal.
else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
exists $HASH{KEY} True if the key exists.
-format Docs missing
-formline Docs missing
+format [NAME] = Start of output format. Ended by a single dot (.) on a line.
+formline PICTURE, LIST Backdoor into \"format\" processing.
glob EXPR Synonym of <EXPR>.
lc [ EXPR ] Returns lowercased EXPR.
lcfirst [ EXPR ] Returns EXPR with lower-cased first letter.
-map Docs missing
+map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST.
no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method.
-... not ... Low-precedence synonym for ! - negation.
+not ... Low-precedence synonym for ! - negation.
... or ... Low-precedence synonym for ||.
pos STRING Set/Get end-position of the last match over this string, see \\G.
-quotemeta [ EXPR ] Quote metacharacters.
-qw Docs missing
+quotemeta [ EXPR ] Quote regexp metacharacters.
+qw/WORD1 .../ Synonym of split('', 'WORD1 ...')
readline FH Synonym of <FH>.
readpipe CMD Synonym of `CMD`.
ref [ EXPR ] Type of EXPR when dereferenced.
-sysopen Docs missing
-tie Docs missing
-tied Docs missing
+sysopen FH, FILENAME, MODE [, PERM] (MODE is numeric, see Fcntl.)
+tie VAR, PACKAGE, LIST Hide an object behind a simple Perl variable.
+tied Returns internal object for a tied data.
uc [ EXPR ] Returns upcased EXPR.
ucfirst [ EXPR ] Returns EXPR with upcased first letter.
-untie Docs missing
+untie VAR Unlink an object from a simple Perl variable.
use PACKAGE [SYMBOL1, ...] Compile-time `require' with consequent `import'.
... xor ... Low-precedence synonym for exclusive or.
prototype \&SUB Returns prototype of the function given a reference.
'variable-documentation))
(setq buffer-read-only t)))))
+(defun cperl-beautify-regexp-piece (b e embed)
+ ;; b is before the starting delimiter, e before the ending
+ ;; e should be a marker, may be changed, but remains "correct".
+ (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline)
+ (if (not embed)
+ (goto-char (1+ b))
+ (goto-char b)
+ (cond ((looking-at "(\\?\\\\#") ; badly commented (?#)
+ (forward-char 2)
+ (delete-char 1)
+ (forward-char 1))
+ ((looking-at "(\\?[^a-zA-Z]")
+ (forward-char 3))
+ ((looking-at "(\\?") ; (?i)
+ (forward-char 2))
+ (t
+ (forward-char 1))))
+ (setq c (1- (current-column))
+ c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
+ (or (looking-at "[ \t]*[\n#]")
+ (progn
+ (insert "\n")))
+ (goto-char e)
+ (beginning-of-line)
+ (if (re-search-forward "[^ \t]" e t)
+ (progn
+ (goto-char e)
+ (insert "\n")
+ (indent-to-column c)
+ (set-marker e (point))))
+ (goto-char b)
+ (end-of-line 2)
+ (while (< (point) (marker-position e))
+ (beginning-of-line)
+ (setq s (point)
+ inline t)
+ (skip-chars-forward " \t")
+ (delete-region s (point))
+ (indent-to-column c1)
+ (while (and
+ inline
+ (looking-at
+ (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1
+ "\\|"
+ "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
+ "\\|"
+ "[$^]"
+ "\\|"
+ "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
+ "\\|"
+ "\\(\\[\\)" ; 6
+ "\\|"
+ "\\((\\(\\?\\)?\\)" ; 7 8
+ "\\|"
+ "\\(|\\)" ; 9
+ )))
+ (goto-char (match-end 0))
+ (setq spaces t)
+ (cond ((match-beginning 1) ; Alphanum word + junk
+ (forward-char -1))
+ ((or (match-beginning 3) ; $ab[12]
+ (and (match-beginning 5) ; X* X+ X{2,3}
+ (eq (preceding-char) ?\{)))
+ (forward-char -1)
+ (forward-sexp 1))
+ ((match-beginning 6) ; []
+ (setq tmp (point))
+ (if (looking-at "\\^?\\]")
+ (goto-char (match-end 0)))
+ (or (re-search-forward "\\]\\([*+{?]\\)?" e t)
+ (progn
+ (goto-char (1- tmp))
+ (error "[]-group not terminated")))
+ (if (not (eq (preceding-char) ?\{)) nil
+ (forward-char -1)
+ (forward-sexp 1)))
+ ((match-beginning 7) ; ()
+ (goto-char (match-beginning 0))
+ (or (eq (current-column) c1)
+ (progn
+ (insert "\n")
+ (indent-to-column c1)))
+ (setq tmp (point))
+ (forward-sexp 1)
+ ;; (or (forward-sexp 1)
+ ;; (progn
+ ;; (goto-char tmp)
+ ;; (error "()-group not terminated")))
+ (set-marker m (1- (point)))
+ (set-marker m1 (point))
+ (cperl-beautify-regexp-piece tmp m t)
+ (goto-char m1)
+ (cond ((looking-at "[*+?]\\??")
+ (goto-char (match-end 0)))
+ ((eq (following-char) ?\{)
+ (forward-sexp 1)
+ (if (eq (following-char) ?\?)
+ (forward-char))))
+ (skip-chars-forward " \t")
+ (setq spaces nil)
+ (if (looking-at "[#\n]")
+ (beginning-of-line 2)
+ (insert "\n"))
+ (end-of-line)
+ (setq inline nil))
+ ((match-beginning 9) ; |
+ (forward-char -1)
+ (setq tmp (point))
+ (beginning-of-line)
+ (if (re-search-forward "[^ \t]" tmp t)
+ (progn
+ (goto-char tmp)
+ (insert "\n"))
+ ;; first at line
+ (delete-region (point) tmp))
+ (indent-to-column c)
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (setq spaces nil)
+ (if (looking-at "[#\n]")
+ (beginning-of-line 2)
+ (insert "\n"))
+ (end-of-line)
+ (setq inline nil)))
+ (or (looking-at "[ \t\n]")
+ (not spaces)
+ (insert " "))
+ (skip-chars-forward " \t"))
+ (or (looking-at "[#\n]")
+ (error "unknown code in a regexp"))
+ (and inline (end-of-line 2)))
+ ))
+
+(defun cperl-beautify-regexp ()
+ "do it. (Experimental, may change semantics, recheck afterwards.)
+We suppose that the regexp is scanned already."
+ (interactive)
+ (or cperl-use-syntax-table-text-property
+ (error "I need to have regex marked!"))
+ ;; Find the start
+ (re-search-backward "\\s|") ; Assume it is scanned already.
+ ;;(forward-char 1)
+ (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
+ (sub-p (eq (preceding-char) ?s)) s)
+ (forward-sexp 1)
+ (set-marker e (1- (point)))
+ (setq delim (preceding-char))
+ (if (and sub-p (eq delim (char-after (- (point) 2))))
+ (error "Possible s/blah// - do not know how to deal with"))
+ (if sub-p (forward-sexp 1))
+ (if (looking-at "\\sw*x")
+ (setq have-x t)
+ (insert "x"))
+ ;; Protect fragile " ", "#"
+ (if have-x nil
+ (goto-char (1+ b))
+ (while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
+ (forward-char -1)
+ (insert "\\")
+ (forward-char 1)))
+ (cperl-beautify-regexp-piece b e nil)))
+
(if (fboundp 'run-with-idle-timer)
(progn
(defvar cperl-help-shown nil
"Non-nil means that the help was already shown now.")
- (defvar cperl-help-timer nil
- "Non-nil means that the help was already shown now.")
+ (defvar cperl-lazy-installed nil
+ "Non-nil means that the lazy-help handlers are installed now.")
(defun cperl-lazy-install ()
(interactive)
(make-variable-buffer-local 'cperl-help-shown)
- (if (cperl-val cperl-lazy-help-time)
+ (if (and (cperl-val 'cperl-lazy-help-time)
+ (not cperl-lazy-installed))
(progn
(add-hook 'post-command-hook 'cperl-lazy-hook)
- (setq cperl-help-timer
- (run-with-idle-timer
- (cperl-val cperl-lazy-help-time 1000000 5)
- t
- 'cperl-get-help-defer)))))
+ (run-with-idle-timer
+ (cperl-val 'cperl-lazy-help-time 1000000 5)
+ t
+ 'cperl-get-help-defer)
+ (setq cperl-lazy-installed t))))
(defun cperl-lazy-unstall ()
(interactive)
(remove-hook 'post-command-hook 'cperl-lazy-hook)
- (cancel-timer cperl-help-timer))
+ (cancel-function-timers 'cperl-get-help-defer)
+ (setq cperl-lazy-installed nil))
(defun cperl-lazy-hook ()
(setq cperl-help-shown nil))
(cperl-get-help)
(setq cperl-help-shown t))))
(cperl-lazy-install)))
+
+(provide 'cperl-mode)
projects / p5sagit/p5-mst-13.2.git / commitdiff