Merge changes from CPerl-5.0.
(toplevel): Require man.
(condition-case): Don't autoload tmm-prompt (it's in loaddefs.el).
(cperl-electric-backspace-untabify): New var.
(cperl-electric-backspace): Use it.
(cperl-vc-header-alist): Extract numeric version from the Id.
(cperl-build-manpage): New fun.
(cperl-menu): Use it. Add toggle-autohelp.
(cperl-mode) <defun-prompt_regexp>: Understand prototypes.
(cperl-electric-brace): Use `cperl-after-block-p' for detection.
(cperl-electric-keyword): Make $if (etc: "$@%&*") non-electric.
'(' after keyword would insert a doubled paren.
(cperl-calculate-indent): Update syntaxification before checks.
Fix wrong indent of blocks starting with POD.
(cperl-find-pods-heres): If no end of HERE-doc found, mark to the end
of buffer. This enables recognition of end of HERE-doc "as one types".
Require "\n" after trailing tag of HERE-doc.
\( made non-quoting outside of string/comment (gdj-contributed).
Likewise for \$. Remove `here-doc-group' text property at start
(makes this property reliable).
Text property `first-format-line' ==> t.
Do not recognize $opt_s and $opt::s as s///.
(cperl-after-block-p): Optional arg pre-block to check for a pre-block
Recognize `continue' blocks too.
(cperl-after-expr-p): Update syntaxification before checks. Work after
here-docs, formats, and PODs too (affects many electric constructs).
(cperl-fix-line-spacing): Allow "_" in $vars of foreach etc.
(cperl-perldoc): Use case-sensitive search.
This commit is contained in:
Stefan Monnier
parent
83261a2f13
commit
f739b53bda
1 changed files with 263 additions and 124 deletions
|
|
@ -69,6 +69,9 @@
|
|||
|
||||
;; Some macros are needed for `defcustom'
|
||||
(eval-when-compile
|
||||
(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
|
||||
|
|
@ -120,8 +123,7 @@
|
|||
`(goto-line (string-to-int (elt ,elt 1))))
|
||||
;;)
|
||||
(defmacro cperl-etags-goto-tag-location (elt)
|
||||
`(etags-goto-tag-location ,elt)))
|
||||
(autoload 'tmm-prompt "tmm"))
|
||||
`(etags-goto-tag-location ,elt))))
|
||||
|
||||
(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
|
||||
|
||||
|
|
@ -321,6 +323,11 @@ 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',
|
||||
|
|
@ -335,8 +342,8 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
|
|||
:type 'integer
|
||||
:group 'cperl-indentation-details)
|
||||
|
||||
(defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
|
||||
(RCS "$rcs = ' $Id\$ ' ;"))
|
||||
(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)
|
||||
|
|
@ -1128,57 +1135,58 @@ the faces: please specify bold, italic, underline, shadow and box.)
|
|||
;;; ["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-pod-to-manpage t]
|
||||
["Auto-help on" cperl-lazy-install
|
||||
(and (fboundp 'run-with-idle-timer)
|
||||
(not cperl-lazy-installed))]
|
||||
["Auto-help off" (eval '(cperl-lazy-unstall))
|
||||
(and (fboundp 'run-with-idle-timer)
|
||||
cperl-lazy-installed)])
|
||||
("Toggle..."
|
||||
["Auto newline" cperl-toggle-auto-newline t]
|
||||
["Electric parens" cperl-toggle-electric t]
|
||||
["Electric keywords" cperl-toggle-abbrev t]
|
||||
["Fix whitespace on indent" cperl-toggle-construct-fix t]
|
||||
["Auto fill" auto-fill-mode t])
|
||||
("Indent styles..."
|
||||
["CPerl" (cperl-set-style "CPerl") t]
|
||||
["PerlStyle" (cperl-set-style "PerlStyle") t]
|
||||
["GNU" (cperl-set-style "GNU") t]
|
||||
["C++" (cperl-set-style "C++") t]
|
||||
["FSF" (cperl-set-style "FSF") t]
|
||||
["BSD" (cperl-set-style "BSD") t]
|
||||
["Whitesmith" (cperl-set-style "Whitesmith") t]
|
||||
["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]
|
||||
["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-emacs"
|
||||
cperl-version) t]))))
|
||||
["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]
|
||||
["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-Emacs"
|
||||
cperl-version) t]))))
|
||||
(error nil))
|
||||
|
||||
(autoload 'c-macro-expand "cmacexp"
|
||||
|
|
@ -1469,7 +1477,7 @@ or as help on variables `cperl-tips', `cperl-problems',
|
|||
(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]*([^()]*)[ \t]*\\)?[ \t]*")
|
||||
(make-local-variable 'comment-indent-function)
|
||||
(setq comment-indent-function 'cperl-comment-indent)
|
||||
(make-local-variable 'parse-sexp-ignore-comments)
|
||||
|
|
@ -1692,7 +1700,9 @@ char is \"{\", insert extra newline before only if
|
|||
(save-excursion
|
||||
(up-list (- (prefix-numeric-value arg)))
|
||||
;;(cperl-after-block-p (point-min))
|
||||
(cperl-after-expr-p nil "{;)"))
|
||||
(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))
|
||||
|
|
@ -1772,7 +1782,8 @@ char is \"{\", insert extra newline before only if
|
|||
(goto-char pos)))))
|
||||
|
||||
(defun cperl-electric-paren (arg)
|
||||
"Insert a matching pair of parentheses."
|
||||
"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
|
||||
|
|
@ -1807,7 +1818,8 @@ char is \"{\", insert extra newline before only if
|
|||
|
||||
(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."
|
||||
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
|
||||
|
|
@ -1867,6 +1879,8 @@ to nil."
|
|||
(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"
|
||||
|
|
@ -1896,7 +1910,11 @@ to nil."
|
|||
(if my
|
||||
(forward-char 1)
|
||||
(delete-char 1)))
|
||||
(search-backward ")"))
|
||||
(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
|
||||
|
|
@ -2185,8 +2203,8 @@ If in POD, insert appropriate lines."
|
|||
(self-insert-command (prefix-numeric-value arg)))))
|
||||
|
||||
(defun cperl-electric-backspace (arg)
|
||||
"Backspace-untabify, or remove the whitespace around the point inserted
|
||||
by an electric key."
|
||||
"Backspace, or remove the whitespace around the point inserted by an electric
|
||||
key. Will untabify if `cperl-electric-backspace-untabify' is non-nil."
|
||||
(interactive "p")
|
||||
(if (and cperl-auto-newline
|
||||
(memq last-command '(cperl-electric-semi
|
||||
|
|
@ -2210,7 +2228,9 @@ by an electric key."
|
|||
(setq p (point))
|
||||
(skip-chars-backward " \t\n")
|
||||
(delete-region (point) p))
|
||||
(backward-delete-char-untabify arg))))
|
||||
(if cperl-electric-backspace-untabify
|
||||
(backward-delete-char-untabify arg)
|
||||
(delete-backward-char arg)))))
|
||||
|
||||
(defun cperl-inside-parens-p ()
|
||||
(condition-case ()
|
||||
|
|
@ -2370,6 +2390,7 @@ 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."
|
||||
(cperl-update-syntaxification (point) (point))
|
||||
(save-excursion
|
||||
(if (or
|
||||
(and (memq (get-text-property (point) 'syntax-type)
|
||||
|
|
@ -2467,7 +2488,8 @@ and closing parentheses and brackets."
|
|||
(progn
|
||||
(forward-sexp -1)
|
||||
(skip-chars-backward " \t")
|
||||
(looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))))
|
||||
(looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
|
||||
(get-text-property (point) 'first-format-line))
|
||||
(progn
|
||||
(if (and parse-data
|
||||
(not (eq char-after ?\C-j)))
|
||||
|
|
@ -2545,7 +2567,8 @@ and closing parentheses and brackets."
|
|||
(append (if is-block " ;{" " ,;{") '(nil)))
|
||||
(and (eq (preceding-char) ?\})
|
||||
(cperl-after-block-and-statement-beg
|
||||
containing-sexp))))
|
||||
containing-sexp))
|
||||
(get-text-property (point) 'first-format-line)))
|
||||
;; This line is continuation of preceding line's statement;
|
||||
;; indent `cperl-continued-statement-offset' more than the
|
||||
;; previous line of the statement.
|
||||
|
|
@ -2586,11 +2609,16 @@ and closing parentheses and brackets."
|
|||
(forward-char 1)
|
||||
(setq old-indent (current-indentation))
|
||||
(let ((colon-line-end 0))
|
||||
(while (progn (skip-chars-forward " \t\n")
|
||||
(looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
|
||||
(while
|
||||
(progn (skip-chars-forward " \t\n")
|
||||
(looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
|
||||
;; Skip over comments and labels following openbrace.
|
||||
(cond ((= (following-char) ?\#)
|
||||
(forward-line 1))
|
||||
((= (following-char) ?\=)
|
||||
(goto-char
|
||||
(or (next-single-property-change (point) 'in-pod)
|
||||
(point-max)))) ; do not loop if no syntaxification
|
||||
;; label:
|
||||
(t
|
||||
(save-excursion (end-of-line)
|
||||
|
|
@ -3050,7 +3078,8 @@ Returns true if comment is found."
|
|||
;; The body is marked `syntax-type' ==> `here-doc'
|
||||
;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
|
||||
;; c) FORMATs:
|
||||
;; After-initial-line--to-end is marked `syntax-type' ==> `format'
|
||||
;; First line (to =) marked `first-format-line' ==> t
|
||||
;; After-this--to-end is marked `syntax-type' ==> `format'
|
||||
;; d) 'Q'uoted string:
|
||||
;; part between markers inclusive is marked `syntax-type' ==> `string'
|
||||
;; part between `q' and the first marker is marked `syntax-type' ==> `prestring'
|
||||
|
|
@ -3147,7 +3176,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
"\\([^\"'`\n]*\\)" ; 3 + 1
|
||||
"\\3"
|
||||
"\\|"
|
||||
;; Second variant: Identifier or \ID or empty
|
||||
;; Second variant: Identifier or \ID (same as 'ID') or empty
|
||||
"\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
|
||||
;; Do not have <<= or << 30 or <<30 or << $blah.
|
||||
;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
|
||||
|
|
@ -3178,7 +3207,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
"__\\(END\\|DATA\\)__"
|
||||
;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
|
||||
"\\|"
|
||||
"\\\\\\(['`\"]\\)")
|
||||
"\\\\\\(['`\"($]\\)")
|
||||
""))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
|
|
@ -3195,6 +3224,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
cperl-postpone t
|
||||
syntax-subtype t
|
||||
rear-nonsticky t
|
||||
here-doc-group t
|
||||
first-format-line t
|
||||
indentable t))
|
||||
;; Need to remove face as well...
|
||||
(goto-char min)
|
||||
|
|
@ -3239,7 +3270,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
max e '(syntax-type t in-pod t syntax-table t
|
||||
cperl-postpone t
|
||||
syntax-subtype t
|
||||
here-doc-group t
|
||||
rear-nonsticky t
|
||||
first-format-line t
|
||||
indentable t))
|
||||
(setq tmpend tb)))
|
||||
(put-text-property b e 'in-pod t)
|
||||
|
|
@ -3287,6 +3320,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
;;"<<"
|
||||
;; "\\(" ; 1 + 1
|
||||
;; ;; First variant "BLAH" or just ``.
|
||||
;; "[ \t]*" ; Yes, whitespace is allowed!
|
||||
;; "\\([\"'`]\\)" ; 2 + 1
|
||||
;; "\\([^\"'`\n]*\\)" ; 3 + 1
|
||||
;; "\\3"
|
||||
|
|
@ -3328,30 +3362,34 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
(setq b (point))
|
||||
;; We do not search to max, since we may be called from
|
||||
;; some hook of fontification, and max is random
|
||||
(cond ((re-search-forward (concat "^" qtag "$")
|
||||
stop-point 'toend)
|
||||
(if cperl-pod-here-fontify
|
||||
(progn
|
||||
;; Highlight the ending delimiter
|
||||
(cperl-postpone-fontification (match-beginning 0) (match-end 0)
|
||||
'face font-lock-constant-face)
|
||||
(cperl-put-do-not-fontify b (match-end 0) t)
|
||||
;; Highlight the HERE-DOC
|
||||
(cperl-postpone-fontification 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)
|
||||
(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)
|
||||
(if (> e1 max)
|
||||
(setq tmpend tb)))
|
||||
(t (message "End of here-document `%s' not found." tag)
|
||||
(or (car err-l) (setcar err-l b))))))
|
||||
(or (and (re-search-forward (concat "^" qtag "$")
|
||||
stop-point 'toend)
|
||||
(eq (following-char) ?\n))
|
||||
(progn ; Pretend we matched at the end
|
||||
(goto-char (point-max))
|
||||
(re-search-forward "\\'")
|
||||
(message "End of here-document `%s' not found." tag)
|
||||
(or (car err-l) (setcar err-l b))))
|
||||
(if cperl-pod-here-fontify
|
||||
(progn
|
||||
;; Highlight the ending delimiter
|
||||
(cperl-postpone-fontification (match-beginning 0) (match-end 0)
|
||||
'face font-lock-constant-face)
|
||||
(cperl-put-do-not-fontify b (match-end 0) t)
|
||||
;; Highlight the HERE-DOC
|
||||
(cperl-postpone-fontification 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)
|
||||
(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)
|
||||
(if (> e1 max)
|
||||
(setq tmpend tb))))
|
||||
;; format
|
||||
((match-beginning 8)
|
||||
;; 1+6=7 extra () before this:
|
||||
|
|
@ -3363,6 +3401,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
"")
|
||||
tb (match-beginning 0))
|
||||
(setq argument nil)
|
||||
(put-text-property (save-excursion
|
||||
(beginning-of-line)
|
||||
(point))
|
||||
b 'first-format-line 't)
|
||||
(if cperl-pod-here-fontify
|
||||
(while (and (eq (forward-line) 0)
|
||||
(not (looking-at "^[.;]$")))
|
||||
|
|
@ -3415,13 +3457,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
bb (char-after (1- (match-beginning b1))) ; tmp holder
|
||||
;; bb == "Not a stringy"
|
||||
bb (if (eq b1 10) ; user variables/whatever
|
||||
(or
|
||||
(memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
|
||||
(and (eq bb ?-) (eq c ?s)) ; -s file test
|
||||
(and (eq bb ?\&)
|
||||
(not (eq (char-after ; &&m/blah/
|
||||
(- (match-beginning b1) 2))
|
||||
?\&))))
|
||||
(and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
|
||||
(cond ((eq bb ?-) (eq c ?s)) ; -s file test
|
||||
((eq bb ?\:) ; $opt::s
|
||||
(eq (char-after
|
||||
(- (match-beginning b1) 2))
|
||||
?\:))
|
||||
((eq bb ?\>) ; $foo->s
|
||||
(eq (char-after
|
||||
(- (match-beginning b1) 2))
|
||||
?\-))
|
||||
((eq bb ?\&)
|
||||
(not (eq (char-after ; &&m/blah/
|
||||
(- (match-beginning b1) 2))
|
||||
?\&)))
|
||||
(t t)))
|
||||
;; <file> or <$file>
|
||||
(and (eq c ?\<)
|
||||
;; Do not stringify <FH>, <$fh> :
|
||||
|
|
@ -3434,6 +3484,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
(or bb
|
||||
(if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
|
||||
(setq argument ""
|
||||
b1 nil
|
||||
bb ; Not a regexp?
|
||||
(progn
|
||||
(not
|
||||
|
|
@ -3472,16 +3523,58 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
(looking-at "\\s|")))))))
|
||||
b (1- b))
|
||||
;; s y tr m
|
||||
;; Check for $a->y
|
||||
(if (and (eq (preceding-char) ?>)
|
||||
(eq (char-after (- (point) 2)) ?-))
|
||||
;; Check for $a -> y
|
||||
(setq b1 (preceding-char)
|
||||
go (point))
|
||||
(if (and (eq b1 ?>)
|
||||
(eq (char-after (- go 2)) ?-))
|
||||
;; Not a regexp
|
||||
(setq bb t))))
|
||||
(or bb (setq state (parse-partial-sexp
|
||||
state-point b nil nil state)
|
||||
state-point b))
|
||||
(setq bb (or bb (nth 3 state) (nth 4 state)))
|
||||
(goto-char b)
|
||||
(if (or bb (nth 3 state) (nth 4 state))
|
||||
(or bb
|
||||
(progn
|
||||
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
|
||||
(goto-char (match-end 0))
|
||||
(skip-chars-forward " \t\n\f"))
|
||||
(cond ((and (eq (following-char) ?\})
|
||||
(eq b1 ?\{))
|
||||
;; Check for $a[23]->{ s }, @{s} and *{s::foo}
|
||||
(goto-char (1- go))
|
||||
(skip-chars-backward " \t\n\f")
|
||||
(if (memq (preceding-char) (append "$@%&*" nil))
|
||||
(setq bb t) ; @{y}
|
||||
(condition-case nil
|
||||
(forward-sexp -1)
|
||||
(error nil)))
|
||||
(if (or bb
|
||||
(looking-at ; $foo -> {s}
|
||||
"[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{")
|
||||
(and ; $foo[12] -> {s}
|
||||
(memq (following-char) '(?\{ ?\[))
|
||||
(progn
|
||||
(forward-sexp 1)
|
||||
(looking-at "\\([ \t\n]*->\\)?[ \t\n]*{"))))
|
||||
(setq bb t)
|
||||
(goto-char b)))
|
||||
((and (eq (following-char) ?=)
|
||||
(eq (char-after (1+ (point))) ?\>))
|
||||
;; Check for { foo => 1, s => 2 }
|
||||
;; Apparently s=> is never a substitution...
|
||||
(setq bb t))
|
||||
((and (eq (following-char) ?:)
|
||||
(eq b1 ?\{) ; Check for $ { s::bar }
|
||||
(looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}")
|
||||
(progn
|
||||
(goto-char (1- go))
|
||||
(skip-chars-backward " \t\n\f")
|
||||
(memq (preceding-char)
|
||||
(append "$@%&*" nil))))
|
||||
(setq bb t)))))
|
||||
(if bb
|
||||
(goto-char i)
|
||||
;; Skip whitespace and comments...
|
||||
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
|
||||
|
|
@ -3703,7 +3796,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
(cperl-commentify b bb nil)
|
||||
(setq end t))
|
||||
(goto-char bb))
|
||||
((match-beginning 17) ; "\\\\\\(['`\"]\\)"
|
||||
((match-beginning 17) ; "\\\\\\(['`\"($]\\)"
|
||||
;; Trailing backslash ==> non-quoting outside string/comment
|
||||
(setq bb (match-end 0)
|
||||
b (match-beginning 0))
|
||||
(goto-char b)
|
||||
|
|
@ -3752,19 +3846,22 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
|
|||
(if (< p (point)) (goto-char p))
|
||||
(setq stop t)))))))
|
||||
|
||||
(defun cperl-after-block-p (lim)
|
||||
(defun cperl-after-block-p (lim &optional pre-block)
|
||||
"Return true if the preceeding } ends a block or a following { starts one.
|
||||
Would not look before LIM. If PRE-BLOCK is nil checks preceeding }.
|
||||
otherwise following {."
|
||||
;; We suppose that the preceding char is }.
|
||||
(save-excursion
|
||||
(condition-case nil
|
||||
(progn
|
||||
(forward-sexp -1)
|
||||
(or pre-block (forward-sexp -1))
|
||||
(cperl-backward-to-noncomment lim)
|
||||
(or (eq (point) lim)
|
||||
(eq (preceding-char) ?\) ) ; if () {} sub f () {}
|
||||
(if (eq (char-syntax (preceding-char)) ?w) ; else {}
|
||||
(save-excursion
|
||||
(forward-sexp -1)
|
||||
(or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
|
||||
(or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
|
||||
;; sub f {}
|
||||
(progn
|
||||
(cperl-backward-to-noncomment lim)
|
||||
|
|
@ -3781,15 +3878,28 @@ TEST is the expression to evaluate at the found position. If absent,
|
|||
CHARS is a string that contains good characters to have before us (however,
|
||||
`}' is treated \"smartly\" if it is not in the list)."
|
||||
(let ((lim (or lim (point-min)))
|
||||
stop p)
|
||||
stop p pr)
|
||||
(cperl-update-syntaxification (point) (point))
|
||||
(save-excursion
|
||||
(while (and (not stop) (> (point) lim))
|
||||
(skip-chars-backward " \t\n\f" lim)
|
||||
(setq p (point))
|
||||
(beginning-of-line)
|
||||
;;(memq (setq pr (get-text-property (point) 'syntax-type))
|
||||
;; '(pod here-doc here-doc-delim))
|
||||
(if (get-text-property (point) 'here-doc-group)
|
||||
(progn
|
||||
(goto-char
|
||||
(previous-single-property-change (point) 'here-doc-group))
|
||||
(beginning-of-line 0)))
|
||||
(if (get-text-property (point) 'in-pod)
|
||||
(progn
|
||||
(goto-char
|
||||
(previous-single-property-change (point) 'in-pod))
|
||||
(beginning-of-line 0)))
|
||||
(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
|
||||
;; Else: last iteration, or a label
|
||||
(cperl-to-comment-or-eol)
|
||||
(cperl-to-comment-or-eol) ; Will not move past "." after a format
|
||||
(skip-chars-backward " \t")
|
||||
(if (< p (point)) (goto-char p))
|
||||
(setq p (point))
|
||||
|
|
@ -3808,7 +3918,10 @@ CHARS is a string that contains good characters to have before us (however,
|
|||
(if test (eval test)
|
||||
(or (memq (preceding-char) (append (or chars "{;") nil))
|
||||
(and (eq (preceding-char) ?\})
|
||||
(cperl-after-block-p lim)))))))))
|
||||
(cperl-after-block-p lim))
|
||||
(and (eq (following-char) ?.) ; in format: see comment above
|
||||
(eq (get-text-property (point) 'syntax-type)
|
||||
'format)))))))))
|
||||
|
||||
(defun cperl-backward-to-start-of-continued-exp (lim)
|
||||
(if (memq (preceding-char) (append ")]}\"'`" nil))
|
||||
|
|
@ -3931,7 +4044,7 @@ Returns some position at the last line."
|
|||
(if (looking-at
|
||||
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
|
||||
(progn
|
||||
(forward-word 3)
|
||||
(forward-sexp 3)
|
||||
(delete-horizontal-space)
|
||||
(insert
|
||||
(make-string cperl-indent-region-fix-constructs ?\ ))
|
||||
|
|
@ -5394,13 +5507,13 @@ in subdirectories too."
|
|||
(if (cperl-val 'cperl-electric-parens) "" "not ")))
|
||||
|
||||
(defun cperl-toggle-autohelp ()
|
||||
"Toggle the state of automatic help message in CPerl mode.
|
||||
See `cperl-lazy-help-time' too."
|
||||
"Toggle the state of Auto-Help on Perl constructs (put in the message area).
|
||||
Delay of auto-help controlled by `cperl-lazy-help-time'."
|
||||
(interactive)
|
||||
(if (fboundp 'run-with-idle-timer)
|
||||
(progn
|
||||
(if cperl-lazy-installed
|
||||
(eval '(cperl-lazy-unstall))
|
||||
(cperl-lazy-unstall)
|
||||
(cperl-lazy-install))
|
||||
(message "Perl help messages will %sbe automatically shown now."
|
||||
(if cperl-lazy-installed "" "not ")))
|
||||
|
|
@ -6131,12 +6244,13 @@ than a line. Your contribution to update/shorten it is appreciated."
|
|||
(defvar cperl-short-docs 'please-ignore-this-line
|
||||
;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
|
||||
"# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
|
||||
... Range (list context); flip/flop [no flop when flip] (scalar context).
|
||||
! ... Logical negation.
|
||||
... != ... Numeric inequality.
|
||||
... !~ ... Search pattern, substitution, or translation (negated).
|
||||
$! In numeric context: errno. In a string context: error string.
|
||||
$\" The separator which joins elements of arrays interpolated in strings.
|
||||
$# The output format for printed numbers. Initial value is %.15g or close.
|
||||
$# The output format for printed numbers. Default is %.15g or close.
|
||||
$$ Process number of this script. Changes in the fork()ed child process.
|
||||
$% The current page number of the currently selected output channel.
|
||||
|
||||
|
|
@ -6163,7 +6277,7 @@ $, The output field separator for the print operator.
|
|||
$- The number of lines left on the page.
|
||||
$. The current input line number of the last filehandle that was read.
|
||||
$/ The input record separator, newline by default.
|
||||
$0 Name of the file containing the perl script being executed. May be set.
|
||||
$0 Name of the file containing the current perl script (read/write).
|
||||
$: String may be broken after these characters to fill ^-lines in a format.
|
||||
$; Subscript separator for multi-dim array emulation. Default \"\\034\".
|
||||
$< The real uid of this process.
|
||||
|
|
@ -6240,12 +6354,12 @@ $~ The name of the current report format.
|
|||
-x File is executable by effective uid.
|
||||
-z File has zero size.
|
||||
. Concatenate strings.
|
||||
.. Alternation, also range operator.
|
||||
.. Range (list context); flip/flop (scalar context) operator.
|
||||
.= Concatenate assignment strings
|
||||
... / ... Division. /PATTERN/ioxsmg Pattern match
|
||||
... /= ... Division assignment.
|
||||
/PATTERN/ioxsmg Pattern match.
|
||||
... < ... Numeric less than. <pattern> Glob. See <NAME>, <> as well.
|
||||
... < ... Numeric less than. <pattern> Glob. See <NAME>, <> as well.
|
||||
<NAME> Reads line from filehandle NAME (a bareword or dollar-bareword).
|
||||
<pattern> Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
|
||||
<> Reads line from union of files in @ARGV (= command line) and STDIN.
|
||||
|
|
@ -6263,7 +6377,7 @@ $~ The name of the current report format.
|
|||
?PATTERN? One-time pattern match.
|
||||
@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.
|
||||
@_ Parameter array for subroutines; result of split() unless in list context.
|
||||
\\ 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.
|
||||
|
|
@ -6969,14 +7083,21 @@ We suppose that the regexp is scanned already."
|
|||
default-entry)
|
||||
input))))
|
||||
(require 'man)
|
||||
(let* ((is-func (and
|
||||
(let* ((case-fold-search nil)
|
||||
(is-func (and
|
||||
(string-match "^[a-z]+$" word)
|
||||
(string-match (concat "^" word "\\>")
|
||||
(documentation-property
|
||||
'cperl-short-docs
|
||||
'variable-documentation))))
|
||||
(manual-program (if is-func "perldoc -f" "perldoc")))
|
||||
(Man-getpage-in-background word)))
|
||||
(cond
|
||||
(cperl-xemacs-p
|
||||
(let ((Manual-program "perldoc")
|
||||
(Manual-switches (if is-func (list "-f"))))
|
||||
(manual-entry word)))
|
||||
(t
|
||||
(Man-getpage-in-background word)))))
|
||||
|
||||
(defun cperl-perldoc-at-point ()
|
||||
"Run a `perldoc' on the word around point."
|
||||
|
|
@ -7006,6 +7127,19 @@ We suppose that the regexp is scanned already."
|
|||
(format (cperl-pod2man-build-command) pod2man-args))
|
||||
'Man-bgproc-sentinel)))))
|
||||
|
||||
;;; Updated version by him too
|
||||
(defun cperl-build-manpage ()
|
||||
"Create a virtual manpage in Emacs from the POD in the file."
|
||||
(interactive)
|
||||
(require 'man)
|
||||
(cond
|
||||
(cperl-xemacs-p
|
||||
(let ((Manual-program "perldoc"))
|
||||
(manual-entry buffer-file-name)))
|
||||
(t
|
||||
(let* ((manual-program "perldoc"))
|
||||
(Man-getpage-in-background buffer-file-name)))))
|
||||
|
||||
(defun cperl-pod2man-build-command ()
|
||||
"Builds the entire background manpage and cleaning command."
|
||||
(let ((command (concat pod2man-program " %s 2>/dev/null"))
|
||||
|
|
@ -7024,6 +7158,7 @@ We suppose that the regexp is scanned already."
|
|||
command))
|
||||
|
||||
(defun cperl-lazy-install ()) ; Avoid a warning
|
||||
(defun cperl-lazy-unstall ()) ; Avoid a warning
|
||||
|
||||
(if (fboundp 'run-with-idle-timer)
|
||||
(progn
|
||||
|
|
@ -7034,6 +7169,8 @@ We suppose that the regexp is scanned already."
|
|||
"Non-nil means that the lazy-help handlers are installed now.")
|
||||
|
||||
(defun cperl-lazy-install ()
|
||||
"Switches on Auto-Help on Perl constructs (put in the message area).
|
||||
Delay of auto-help controlled by `cperl-lazy-help-time'."
|
||||
(interactive)
|
||||
(make-variable-buffer-local 'cperl-help-shown)
|
||||
(if (and (cperl-val 'cperl-lazy-help-time)
|
||||
|
|
@ -7047,6 +7184,8 @@ We suppose that the regexp is scanned already."
|
|||
(setq cperl-lazy-installed t))))
|
||||
|
||||
(defun cperl-lazy-unstall ()
|
||||
"Switches off Auto-Help on Perl constructs (put in the message area).
|
||||
Delay of auto-help controlled by `cperl-lazy-help-time'."
|
||||
(interactive)
|
||||
(remove-hook 'post-command-hook 'cperl-lazy-hook)
|
||||
(cancel-function-timers 'cperl-get-help-defer)
|
||||
|
|
@ -7123,7 +7262,7 @@ We suppose that the regexp is scanned already."
|
|||
(cperl-fontify-syntaxically to)))))
|
||||
|
||||
(defvar cperl-version
|
||||
(let ((v "Revision: 4.35"))
|
||||
(let ((v "Revision: 5.0"))
|
||||
(string-match ":\\s *\\([0-9.]+\\)" v)
|
||||
(substring v (match-beginning 1) (match-end 1)))
|
||||
"Version of IZ-supported CPerl package this file is based on.")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue