;;; cperl-mode.el --- Perl code editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003
+;; Copyright (C) 1985,86,87,91,92,93,94,95,96,97,98,99,2000,03,2004
;; Free Software Foundation, Inc.
;; Author: Ilya Zakharevich and Bob Olson
;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<<
;; or as help on variables `cperl-tips', `cperl-problems', <<<<<<
-;; `cperl-praise', `cperl-speed'. <<<<<<
+;; `cperl-praise', `cperl-speed'. <<<<<<
;; The mode information (on C-h m) provides some customization help.
;; If you use font-lock feature of this mode, it is advisable to use
;; 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
`(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))
: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',
: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)
(((class color) (background dark))
(:foreground ,cperl-dark-foreground))
(t (:weight bold :underline t)))
- "Font Lock mode face used to highlight array names."
+ "Font Lock mode face used non-overridable keywords and modifiers of regexps."
:group 'cperl-faces)
(defface cperl-array-face
(defun cperl-putback-char (c) ; Emacs 19
(set 'unread-command-events (list c))) ; Avoid undefined warning
-(if (boundp 'unread-command-events)
- (if cperl-xemacs-p
- (defun cperl-putback-char (c) ; XEmacs >= 19.12
- (setq unread-command-events (list (eval '(character-to-event c))))))
- (defun cperl-putback-char (c) ; XEmacs <= 19.11
- (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings
+(if cperl-xemacs-p
+ (defun cperl-putback-char (c) ; XEmacs >= 19.12
+ (setq unread-command-events (list (eval '(character-to-event c))))))
(or (fboundp 'uncomment-region)
(defun uncomment-region (beg end)
(substitute-key-definition
'indent-sexp 'cperl-indent-exp
cperl-mode-map global-map)
- (substitute-key-definition
- 'fill-paragraph 'cperl-fill-paragraph
- cperl-mode-map global-map)
(substitute-key-definition
'indent-region 'cperl-indent-region
cperl-mode-map global-map)
["End of function" end-of-defun t]
["Mark function" mark-defun t]
["Indent expression" cperl-indent-exp t]
- ["Fill paragraph/comment" cperl-fill-paragraph t]
+ ["Fill paragraph/comment" fill-paragraph t]
"----"
["Line up a construction" cperl-lineup (cperl-use-region-p)]
["Invert if/unless/while etc" cperl-invert-if-unless t]
;;; ["Add tags for Perl files in (sub)directories"
;;; (cperl-etags t 'recursive) t])
;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
- ["Create tags for current file" (cperl-write-tags nil t) t]
- ["Add tags for current file" (cperl-write-tags) t]
- ["Create tags for Perl files in directory"
- (cperl-write-tags nil t nil t) t]
- ["Add tags for Perl files in directory"
- (cperl-write-tags nil nil nil t) t]
- ["Create tags for Perl files in (sub)directories"
- (cperl-write-tags nil t t t) t]
- ["Add tags for Perl files in (sub)directories"
- (cperl-write-tags nil nil t t) t]))
- ("Perl docs"
- ["Define word at point" imenu-go-find-at-position
- (fboundp 'imenu-go-find-at-position)]
- ["Help on function" cperl-info-on-command t]
- ["Help on function at point" cperl-info-on-current-command t]
- ["Help on symbol at point" cperl-get-help t]
- ["Perldoc" cperl-perldoc t]
- ["Perldoc on word at point" cperl-perldoc-at-point t]
- ["View manpage of POD in this file" cperl-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"
(setq paragraph-separate paragraph-start)
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
+ (set (make-local-variable 'fill-paragraph-function) 'cperl-fill-paragraph)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'cperl-indent-line)
(make-local-variable 'require-final-newline)
(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\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
(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))
(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
(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
(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"
(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
(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
(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)))))
+
+(put 'cperl-electric-backspace 'delete-selection 'supersede)
(defun cperl-inside-parens-p ()
(condition-case ()
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)
(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)))
(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.
(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)
(cperl-calculate-indent))
(current-indentation))))))))))))))
-(defvar cperl-indent-alist
- '((string nil)
- (comment nil)
- (toplevel 0)
- (toplevel-after-parenth 2)
- (toplevel-continued 2)
- (expression 1))
- "Alist of indentation rules for CPerl mode.
-The values mean:
- nil: do not indent;
- number: add this amount of indentation.
-
-Not finished, not used.")
-
-(defun cperl-where-am-i (&optional parse-start start-state)
- ;; Unfinished
- "Return a list of lists ((TYPE POS)...) of good points before the point.
-POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
-
-Not finished, not used."
- (save-excursion
- (let* ((start-point (point))
- (s-s (cperl-get-state))
- (start (nth 0 s-s))
- (state (nth 1 s-s))
- (prestart (nth 3 s-s))
- (containing-sexp (car (cdr state)))
- (case-fold-search nil)
- (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
- (cond ((nth 3 state) ; In string
- (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
- ((nth 4 state) ; In comment
- (setq res (cons '(comment) res)))
- ((null containing-sexp)
- ;; Line is at top level.
- ;; Indent like the previous top level line
- ;; unless that ends in a closeparen without semicolon,
- ;; in which case this line is the first argument decl.
- (cperl-backward-to-noncomment (or parse-start (point-min)))
- ;;(skip-chars-backward " \t\f\n")
- (cond
- ((or (bobp)
- (memq (preceding-char) (append ";}" nil)))
- (setq res (cons (list 'toplevel start) res)))
- ((eq (preceding-char) ?\) )
- (setq res (cons (list 'toplevel-after-parenth start) res)))
- (t
- (setq res (cons (list 'toplevel-continued start) res)))))
- ((/= (char-after containing-sexp) ?{)
- ;; line is expression, not statement:
- ;; indent to just after the surrounding open.
- ;; skip blanks if we do not close the expression.
- (setq res (cons (list 'expression-blanks
- (progn
- (goto-char (1+ containing-sexp))
- (or (looking-at "[ \t]*\\(#\\|$\\)")
- (skip-chars-forward " \t"))
- (point)))
- (cons (list 'expression containing-sexp) res))))
- ((progn
- ;; Containing-expr starts with \{. Check whether it is a hash.
- (goto-char containing-sexp)
- (not (cperl-block-p)))
- (setq res (cons (list 'expression-blanks
- (progn
- (goto-char (1+ containing-sexp))
- (or (looking-at "[ \t]*\\(#\\|$\\)")
- (skip-chars-forward " \t"))
- (point)))
- (cons (list 'expression containing-sexp) res))))
- (t
- ;; Statement level.
- (setq res (cons (list 'in-block containing-sexp) res))
- ;; Is it a continuation or a new statement?
- ;; Find previous non-comment character.
- (cperl-backward-to-noncomment containing-sexp)
- ;; Back up over label lines, since they don't
- ;; affect whether our line is a continuation.
- ;; Back up comma-delimited lines too ?????
- (while (or (eq (preceding-char) ?\,)
- (save-excursion (cperl-after-label)))
- (if (eq (preceding-char) ?\,)
- ;; Will go to beginning of line, essentially
- ;; Will ignore embedded sexpr XXXX.
- (cperl-backward-to-start-of-continued-exp containing-sexp))
- (beginning-of-line)
- (cperl-backward-to-noncomment containing-sexp))
- ;; Now we get the answer.
- (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
- ;; This line is continuation of preceding line's statement.
- (list (list 'statement-continued containing-sexp))
- ;; This line starts a new statement.
- ;; Position following last unclosed open.
- (goto-char containing-sexp)
- ;; Is line first statement after an open-brace?
- (or
- ;; If no, find that first statement and indent like
- ;; it. If the first statement begins with label, do
- ;; not believe when the indentation of the label is too
- ;; small.
- (save-excursion
- (forward-char 1)
- (let ((colon-line-end 0))
- (while (progn (skip-chars-forward " \t\n" start-point)
- (and (< (point) start-point)
- (looking-at
- "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
- ;; Skip over comments and labels following openbrace.
- (cond ((= (following-char) ?\#)
- ;;(forward-line 1)
- (end-of-line))
- ;; label:
- (t
- (save-excursion (end-of-line)
- (setq colon-line-end (point)))
- (search-forward ":"))))
- ;; Now at the point, after label, or at start
- ;; of first statement in the block.
- (and (< (point) start-point)
- (if (> colon-line-end (point))
- ;; Before statement after label
- (if (> (current-indentation)
- cperl-min-label-indent)
- (list (list 'label-in-block (point)))
- ;; Do not believe: `max' is involved
- (list
- (list 'label-in-block-min-indent (point))))
- ;; Before statement
- (list 'statement-in-block (point))))))
- ;; If no previous statement,
- ;; indent it relative to line brace is on.
- ;; For open brace in column zero, don't let statement
- ;; start there too. If cperl-indent-level is zero,
- ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
- ;; For open-braces not the first thing in a line,
- ;; add in cperl-brace-imaginary-offset.
-
- ;; If first thing on a line: ?????
- (+ (if (and (bolp) (zerop cperl-indent-level))
- (+ cperl-brace-offset cperl-continued-statement-offset)
- cperl-indent-level)
- ;; Move back over whitespace before the openbrace.
- ;; If openbrace is not first nonwhite thing on the line,
- ;; add the cperl-brace-imaginary-offset.
- (progn (skip-chars-backward " \t")
- (if (bolp) 0 cperl-brace-imaginary-offset))
- ;; If the openbrace is preceded by a parenthesized exp,
- ;; move to the beginning of that;
- ;; possibly a different line
- (progn
- (if (eq (preceding-char) ?\))
- (forward-sexp -1))
- ;; Get initial indentation of the line we are on.
- ;; If line starts with label, calculate label indentation
- (if (save-excursion
- (beginning-of-line)
- (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))
- (current-indentation))))))))
- res)))
+;; (defvar cperl-indent-alist
+;; '((string nil)
+;; (comment nil)
+;; (toplevel 0)
+;; (toplevel-after-parenth 2)
+;; (toplevel-continued 2)
+;; (expression 1))
+;; "Alist of indentation rules for CPerl mode.
+;; The values mean:
+;; nil: do not indent;
+;; number: add this amount of indentation.
+
+;; Not finished, not used.")
+
+;; (defun cperl-where-am-i (&optional parse-start start-state)
+;; ;; Unfinished
+;; "Return a list of lists ((TYPE POS)...) of good points before the point.
+;; ;; POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
+
+;; ;; Not finished, not used."
+;; (save-excursion
+;; (let* ((start-point (point))
+;; (s-s (cperl-get-state))
+;; (start (nth 0 s-s))
+;; (state (nth 1 s-s))
+;; (prestart (nth 3 s-s))
+;; (containing-sexp (car (cdr state)))
+;; (case-fold-search nil)
+;; (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
+;; (cond ((nth 3 state) ; In string
+;; (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
+;; ((nth 4 state) ; In comment
+;; (setq res (cons '(comment) res)))
+;; ((null containing-sexp)
+;; ;; Line is at top level.
+;; ;; Indent like the previous top level line
+;; ;; unless that ends in a closeparen without semicolon,
+;; ;; in which case this line is the first argument decl.
+;; (cperl-backward-to-noncomment (or parse-start (point-min)))
+;; ;;(skip-chars-backward " \t\f\n")
+;; (cond
+;; ((or (bobp)
+;; (memq (preceding-char) (append ";}" nil)))
+;; (setq res (cons (list 'toplevel start) res)))
+;; ((eq (preceding-char) ?\) )
+;; (setq res (cons (list 'toplevel-after-parenth start) res)))
+;; (t
+;; (setq res (cons (list 'toplevel-continued start) res)))))
+;; ((/= (char-after containing-sexp) ?{)
+;; ;; line is expression, not statement:
+;; ;; indent to just after the surrounding open.
+;; ;; skip blanks if we do not close the expression.
+;; (setq res (cons (list 'expression-blanks
+;; (progn
+;; (goto-char (1+ containing-sexp))
+;; (or (looking-at "[ \t]*\\(#\\|$\\)")
+;; (skip-chars-forward " \t"))
+;; (point)))
+;; (cons (list 'expression containing-sexp) res))))
+;; ((progn
+;; ;; Containing-expr starts with \{. Check whether it is a hash.
+;; (goto-char containing-sexp)
+;; (not (cperl-block-p)))
+;; (setq res (cons (list 'expression-blanks
+;; (progn
+;; (goto-char (1+ containing-sexp))
+;; (or (looking-at "[ \t]*\\(#\\|$\\)")
+;; (skip-chars-forward " \t"))
+;; (point)))
+;; (cons (list 'expression containing-sexp) res))))
+;; (t
+;; ;; Statement level.
+;; (setq res (cons (list 'in-block containing-sexp) res))
+;; ;; Is it a continuation or a new statement?
+;; ;; Find previous non-comment character.
+;; (cperl-backward-to-noncomment containing-sexp)
+;; ;; Back up over label lines, since they don't
+;; ;; affect whether our line is a continuation.
+;; ;; Back up comma-delimited lines too ?????
+;; (while (or (eq (preceding-char) ?\,)
+;; (save-excursion (cperl-after-label)))
+;; (if (eq (preceding-char) ?\,)
+;; ;; Will go to beginning of line, essentially
+;; ;; Will ignore embedded sexpr XXXX.
+;; (cperl-backward-to-start-of-continued-exp containing-sexp))
+;; (beginning-of-line)
+;; (cperl-backward-to-noncomment containing-sexp))
+;; ;; Now we get the answer.
+;; (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
+;; ;; This line is continuation of preceding line's statement.
+;; (list (list 'statement-continued containing-sexp))
+;; ;; This line starts a new statement.
+;; ;; Position following last unclosed open.
+;; (goto-char containing-sexp)
+;; ;; Is line first statement after an open-brace?
+;; (or
+;; ;; If no, find that first statement and indent like
+;; ;; it. If the first statement begins with label, do
+;; ;; not believe when the indentation of the label is too
+;; ;; small.
+;; (save-excursion
+;; (forward-char 1)
+;; (let ((colon-line-end 0))
+;; (while (progn (skip-chars-forward " \t\n" start-point)
+;; (and (< (point) start-point)
+;; (looking-at
+;; "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
+;; ;; Skip over comments and labels following openbrace.
+;; (cond ((= (following-char) ?\#)
+;; ;;(forward-line 1)
+;; (end-of-line))
+;; ;; label:
+;; (t
+;; (save-excursion (end-of-line)
+;; (setq colon-line-end (point)))
+;; (search-forward ":"))))
+;; ;; Now at the point, after label, or at start
+;; ;; of first statement in the block.
+;; (and (< (point) start-point)
+;; (if (> colon-line-end (point))
+;; ;; Before statement after label
+;; (if (> (current-indentation)
+;; cperl-min-label-indent)
+;; (list (list 'label-in-block (point)))
+;; ;; Do not believe: `max' is involved
+;; (list
+;; (list 'label-in-block-min-indent (point))))
+;; ;; Before statement
+;; (list 'statement-in-block (point))))))
+;; ;; If no previous statement,
+;; ;; indent it relative to line brace is on.
+;; ;; For open brace in column zero, don't let statement
+;; ;; start there too. If cperl-indent-level is zero,
+;; ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
+;; ;; For open-braces not the first thing in a line,
+;; ;; add in cperl-brace-imaginary-offset.
+
+;; ;; If first thing on a line: ?????
+;; (+ (if (and (bolp) (zerop cperl-indent-level))
+;; (+ cperl-brace-offset cperl-continued-statement-offset)
+;; cperl-indent-level)
+;; ;; Move back over whitespace before the openbrace.
+;; ;; If openbrace is not first nonwhite thing on the line,
+;; ;; add the cperl-brace-imaginary-offset.
+;; (progn (skip-chars-backward " \t")
+;; (if (bolp) 0 cperl-brace-imaginary-offset))
+;; ;; If the openbrace is preceded by a parenthesized exp,
+;; ;; move to the beginning of that;
+;; ;; possibly a different line
+;; (progn
+;; (if (eq (preceding-char) ?\))
+;; (forward-sexp -1))
+;; ;; Get initial indentation of the line we are on.
+;; ;; If line starts with label, calculate label indentation
+;; (if (save-excursion
+;; (beginning-of-line)
+;; (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))
+;; (current-indentation))))))))
+;; res)))
(defun cperl-calculate-indent-within-comment ()
"Return the indentation amount for line, assuming that
(goto-char (1- cpoint)))))
(setq stop-in t) ; Finish
(forward-char -1))
- (setq stop-in t))) ; Finish
+ (setq stop-in t))) ; Finish
(nth 4 state))))
(defsubst cperl-1- (p)
;; 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'
"\\([^\"'`\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
"__\\(END\\|DATA\\)__"
;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
"\\|"
- "\\\\\\(['`\"]\\)")
+ "\\\\\\(['`\"($]\\)")
""))))
(unwind-protect
(progn
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)
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)
;;"<<"
;; "\\(" ; 1 + 1
;; ;; First variant "BLAH" or just ``.
+ ;; "[ \t]*" ; Yes, whitespace is allowed!
;; "\\([\"'`]\\)" ; 2 + 1
;; "\\([^\"'`\n]*\\)" ; 3 + 1
;; "\\3"
(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:
"")
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 "^[.;]$")))
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> :
(or bb
(if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
(setq argument ""
+ b1 nil
bb ; Not a regexp?
(progn
(not
(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]*\\)+")
(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)
(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)
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))
(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))
(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 ?\ ))
;; Stolen from lisp-mode with a lot of improvements
(defun cperl-fill-paragraph (&optional justify iteration)
- "Like \\[fill-paragraph], but handle CPerl comments.
+ "Like `fill-paragraph', but handle CPerl comments.
If any of the current line is a comment, fill the comment or the
block of it that point is in, preserving the comment's initial
indentation and initial hashes. Behaves usually outside of comment."
- (interactive "P")
+ ;; (interactive "P") ; Only works when called from fill-paragraph. -stef
(let (;; Non-nil if the current line contains a comment.
has-comment
(looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
(point)))
;; Remove existing hashes
- (goto-char (point-min))
- (while (progn (forward-line 1) (< (point) (point-max)))
- (skip-chars-forward " \t")
- (and (looking-at "#+")
- (delete-char (- (match-end 0) (match-beginning 0)))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (progn (forward-line 1) (< (point) (point-max)))
+ (skip-chars-forward " \t")
+ (and (looking-at "#+")
+ (delete-char (- (match-end 0) (match-beginning 0))))))
;; Lines with only hashes on them can be paragraph boundaries.
(let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
(let ((c (save-excursion (beginning-of-line)
(cperl-to-comment-or-eol) (point)))
(s (memq (following-char) '(?\ ?\t))) marker)
- (if (>= c (point)) nil
+ (if (>= c (point))
+ ;; Don't break line inside code: only inside comment.
+ nil
(setq marker (point-marker))
- (cperl-fill-paragraph)
+ (fill-paragraph nil)
(goto-char marker)
;; Is not enough, sometimes marker is a start of line
(if (bolp) (progn (re-search-forward "#+[ \t]*")
(defvar cperl-guessed-background nil
"Display characteristics as guessed by cperl.")
;; (or (fboundp 'x-color-defined-p)
- ;; (defalias '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)
Chosing \"Current\" style will not change style, so this may be used for
side-effect of memorizing only."
(interactive
- (let ((list (mapcar (function (lambda (elt) (list (car elt))))
+ (let ((list (mapcar (function (lambda (elt) (list (car elt))))
cperl-style-alist)))
(list (completing-read "Enter style: " list nil 'insist))))
(or cperl-old-style
MINSHIFT is the minimal amount of space to insert before the construction.
STEP is the tabwidth to position constructions.
If STEP is nil, `cperl-lineup-step' will be used
-\(or `cperl-indent-level', if `cperl-lineup-step' is `nil').
+\(or `cperl-indent-level', if `cperl-lineup-step' is nil).
Will not move the position at the start to the left."
(interactive "r")
(let (search col tcol seen b e)
(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 ")))
(string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
(elt elt 3)))
;; Need to insert the name without package as well
- (setq lst (cons (cons (substring (elt elt 3)
+ (setq lst (cons (cons (substring (elt elt 3)
(match-beginning 1)
(match-end 1))
(cdr elt))
(setq cperl-unreadable-ok t
tm nil) ; Return empty list
(error "Aborting: unreadable directory %s" file)))))))
- (mapcar (function
+ (mapcar (function
(lambda (file)
(cond
((string-match cperl-noscan-files-regexp file)
(defvar cperl-bad-style-regexp
(mapconcat 'identity
'("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
- "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
+ "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
"\\|")
"Finds places such that insertion of a whitespace may help a lot.")
(defvar cperl-not-bad-style-regexp
- (mapconcat
+ (mapconcat
'identity
'("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++
"[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
(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.
$- 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.
-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.
?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.
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."
(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"))
command))
(defun cperl-lazy-install ()) ; Avoid a warning
+(defun cperl-lazy-unstall ()) ; Avoid a warning
(if (fboundp 'run-with-idle-timer)
(progn
"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)
(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)
(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.")
(provide 'cperl-mode)
+;;; arch-tag: 42e5b19b-e187-4537-929f-1a7408980ce6
;;; cperl-mode.el ends here