(defun cperl-switch-to-doc-buffer () "Go to the perl documentation buffer and insert the documentation." (interactive) (let ((buf (get-buffer-create cperl-doc-buffer))) (if (interactive-p) (switch-to-buffer-other-window buf) (set-buffer buf)) (if (= (buffer-size) 0) (progn (insert (documentation-property 'cperl-short-docs 'variable-documentation)) (setq buffer-read-only t)))))
(defun cperl-beautify-regexp-piece (b e embed level) ;; b is before the starting delimiter, e before the ending ;; e should be a marker, may be changed, but remains "correct". ;; EMBED is nil iff we process the whole REx. ;; The REx is guarantied to have //x ;; LEVEL shows how many levels deep to go ;; position at enter and at leave is not defined (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos) (if (not embed) (goto-char (1+ b)) (goto-char b) (cond ((looking-at "(\\?\\\\#") ; (?#) wrongly commented when //x-ing (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 (if embed (current-indentation) (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 ; Something before the ending delimiter (goto-char e) (delete-horizontal-space) (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 word "\\|" ; Embedded variable "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3 "\\|" ; $ ^ "[$^]" "\\|" ; simple-code simple-code*? "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5 "\\|" ; Class "\\(\\[\\)" ; 6 "\\|" ; Grouping "\\((\\(\\?\\)?\\)" ; 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))) ;; XXXX POSIX classes?! (while (and (not pos) (re-search-forward "\\[:\\|\\]" e t)) (if (eq (preceding-char) ?:) (or (re-search-forward ":\\]" e t) (error "[:POSIX:]-group in []-group not terminated")) (setq pos t))) (or (eq (preceding-char) ?\]) (error "[]-group not terminated")) (if (eq (following-char) ?\{) (progn (forward-sexp 1) (and (eq (following-char) ??) (forward-char 1))) (re-search-forward "\\=\\([*+?]\\??\\)" e t))) ((match-beginning 7) ; () (goto-char (match-beginning 0)) (setq pos (current-column)) (or (eq pos c1) (progn (delete-horizontal-space) (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)) (if (= level 1) (if (progn ; indent rigidly if multiline ;; In fact does not make a lot of sense, since ;; the starting position can be already lost due ;; to insertion of "\n" and " " (goto-char tmp) (search-forward "\n" m1 t)) (indent-rigidly (point) m1 (- c1 pos))) (setq level (1- level)) (cond ((not (match-beginning 8)) (cperl-beautify-regexp-piece tmp m t level)) ((eq (char-after (+ 2 tmp)) ?\{) ; Code t) ((eq (char-after (+ 2 tmp)) ?\() ; Conditional (goto-char (+ 2 tmp)) (forward-sexp 1) (cperl-beautify-regexp-piece (point) m t level)) ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind (goto-char (+ 3 tmp)) (cperl-beautify-regexp-piece (point) m t level)) (t (cperl-beautify-regexp-piece tmp m t level)))) (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]") (progn (or (eolp) (indent-for-comment)) (beginning-of-line 2)) (delete-horizontal-space) (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) (delete-horizontal-space) (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) (delete-horizontal-space) (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 `%s' in a regexp" (buffer-substring (point) (1+ (point))))) (and inline (end-of-line 2))) ;; Special-case the last line of group (if (and (>= (point) (marker-position e)) (/= (current-indentation) c)) (progn (beginning-of-line) (setq s (point)) (skip-chars-forward " \t") (delete-region s (point)) (indent-to-column c)))))
(defun cperl-make-regexp-x () ;; Returns position of the start ;; XXX this is called too often! Need to cache the result! (save-excursion (or cperl-use-syntax-table-text-property (error "I need to have a regexp marked!")) ;; Find the start (if (looking-at "\\s|") nil ; good already (if (looking-at "\\([smy]\\|qr\\)\\s|") (forward-char 1) (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))) b)))
(defun cperl-beautify-regexp (&optional deep) "Do it. (Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive "P") (setq deep (if deep (prefix-numeric-value deep) -1)) (save-excursion (goto-char (cperl-make-regexp-x)) (let ((b (point)) (e (make-marker))) (forward-sexp 1) (set-marker e (1- (point))) (cperl-beautify-regexp-piece b e nil deep))))
(defun cperl-regext-to-level-start () "Goto start of an enclosing group in regexp. We suppose that the regexp is scanned already." (interactive) (let ((limit (cperl-make-regexp-x)) done) (while (not done) (or (eq (following-char) ?\() (search-backward "(" (1+ limit) t) (error "Cannot find `(' which starts a group")) (setq done (save-excursion (skip-chars-backward "\\") (looking-at "\\(\\\\\\\\\\)*("))) (or done (forward-char -1)))))
(defun cperl-contract-level () "Find an enclosing group in regexp and contract it. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) ;; (save-excursion ; Can't, breaks `cperl-contract-levels' (cperl-regext-to-level-start) (let ((b (point)) (e (make-marker)) s c) (forward-sexp 1) (set-marker e (1- (point))) (goto-char b) (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) (cond ((match-beginning 1) ; #-comment (or c (setq c (current-indentation))) (beginning-of-line 2) ; Skip (setq s (point)) (skip-chars-forward " \t") (delete-region s (point)) (indent-to-column c)) (t (delete-char -1) (just-one-space))))))
(defun cperl-contract-levels () "Find an enclosing group in regexp and contract all the kids. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive) (save-excursion (condition-case nil (cperl-regext-to-level-start) (error ; We are outside outermost group (goto-char (cperl-make-regexp-x)))) (let ((b (point)) (e (make-marker)) s c) (forward-sexp 1) (set-marker e (1- (point))) (goto-char (1+ b)) (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t) (cond ((match-beginning 1) ; Skip nil) (t ; Group (cperl-contract-level)))))))
(defun cperl-beautify-level (&optional deep) "Find an enclosing group in regexp and beautify it. \(Experimental, may change semantics, recheck the result.) We suppose that the regexp is scanned already." (interactive "P") (setq deep (if deep (prefix-numeric-value deep) -1)) (save-excursion (cperl-regext-to-level-start) (let ((b (point)) (e (make-marker))) (forward-sexp 1) (set-marker e (1- (point))) (cperl-beautify-regexp-piece b e nil deep))))
(defun cperl-invert-if-unless () "Change `if (A) {B}' into `B if A;' etc if possible." (interactive) (or (looking-at "\\<") (forward-sexp -1)) (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") (let ((pos1 (point)) pos2 pos3 pos4 pos5 s1 s2 state p pos45 (s0 (buffer-substring (match-beginning 0) (match-end 0)))) (forward-sexp 2) (setq pos3 (point)) (forward-sexp -1) (setq pos2 (point)) (if (eq (following-char) ?\( ) (progn (goto-char pos3) (forward-sexp 1) (setq pos5 (point)) (forward-sexp -1) (setq pos4 (point)) ;; XXXX In fact may be `A if (B); {C}' ... (if (and (eq (following-char) ?\{ ) (progn (cperl-backward-to-noncomment pos3) (eq (preceding-char) ?\) ))) (if (condition-case nil (progn (goto-char pos5) (forward-sexp 1) (forward-sexp -1) (looking-at "\\<els\\(e\\|if\\)\\>")) (error nil)) (error "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0) (goto-char (1- pos5)) (cperl-backward-to-noncomment pos4) (if (eq (preceding-char) ?\;) (forward-char -1)) (setq pos45 (point)) (goto-char pos4) (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t) (setq p (match-beginning 0) s1 (buffer-substring p (match-end 0)) state (parse-partial-sexp pos4 p)) (or (nth 3 state) (nth 4 state) (nth 5 state) (error "`%s' inside `%s' BLOCK" s1 s0)) (goto-char (match-end 0))) ;; Finally got it (goto-char (1+ pos4)) (skip-chars-forward " \t\n") (setq s2 (buffer-substring (point) pos45)) (goto-char pos45) (or (looking-at ";?[ \t\n]*}") (progn (skip-chars-forward "; \t\n") (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5)))))) (and (equal s2 "") (setq s2 "1")) (goto-char (1- pos3)) (cperl-backward-to-noncomment pos2) (or (looking-at "[ \t\n]*)") (goto-char (1- pos3))) (setq p (point)) (goto-char (1+ pos2)) (skip-chars-forward " \t\n") (setq s1 (buffer-substring (point) p)) (delete-region pos4 pos5) (delete-region pos2 pos3) (goto-char pos1) (insert s2 " ") (just-one-space) (forward-word 1) (setq pos1 (point)) (insert " " s1 ";") (delete-horizontal-space) (forward-char -1) (delete-horizontal-space) (goto-char pos1) (just-one-space) (cperl-indent-line)) (error "`%s' (EXPR) not with an {BLOCK}" s0))) (error "`%s' not with an (EXPR)" s0))) (error "Not at `if', `unless', `while', `until', `for' or `foreach'")))
;;; By Anthony Foiani <afoiani@uswest.com> ;;; Getting help on modules in C-h f ? ;;; This is a modified version of `man'. ;;; Need to teach it how to lookup functions (defun cperl-perldoc (word) "Run `perldoc' on WORD." (interactive (list (let* ((default-entry (cperl-word-at-point)) (input (read-string (format "perldoc entry%s: " (if (string= default-entry "") "" (format " (default %s)" default-entry)))))) (if (string= input "") (if (string= default-entry "") (error "No perldoc args given") default-entry) input)))) (require 'man) (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"))) (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." (interactive) (cperl-perldoc (cperl-word-at-point)))
(defcustom pod2man-program "pod2man" "*File name for `pod2man'." :type 'file :group 'cperl)
;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) (defun cperl-pod-to-manpage () "Create a virtual manpage in Emacs from the Perl Online Documentation." (interactive) (require 'man) (let* ((pod2man-args (concat buffer-file-name " | nroff -man ")) (bufname (concat "Man " buffer-file-name)) (buffer (generate-new-buffer bufname))) (save-excursion (set-buffer buffer) (let ((process-environment (copy-sequence process-environment))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") (set-process-sentinel (start-process pod2man-program buffer "sh" "-c" (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")) (flist Man-filter-list)) (while (and flist (car flist)) (let ((pcom (car (car flist))) (pargs (cdr (car flist)))) (setq command (concat command " | " pcom " " (mapconcat '(lambda (phrase) (if (not (stringp phrase)) (error "Malformed Man-filter-list")) phrase) pargs " "))) (setq flist (cdr flist)))) command))
(defun cperl-lazy-install ()) ; Avoid a warning (defun cperl-lazy-unstall ()) ; Avoid a warning
(if (fboundp 'run-with-idle-timer) (progn (defvar cperl-help-shown 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 () "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) (not cperl-lazy-installed)) (progn (add-hook 'post-command-hook 'cperl-lazy-hook) (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 () "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) (setq cperl-lazy-installed nil)) (defun cperl-lazy-hook () (setq cperl-help-shown nil)) (defun cperl-get-help-defer () (if (not (memq major-mode '(perl-mode cperl-mode))) nil (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) (cperl-get-help) (setq cperl-help-shown t)))) (cperl-lazy-install)))
;;; Plug for wrong font-lock:
(defun cperl-font-lock-unfontify-region-function (beg end) (let* ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) before-change-functions after-change-functions deactivate-mark buffer-file-name buffer-file-truename) (remove-text-properties beg end '(face nil)) (when (and (not modified) (buffer-modified-p)) (set-buffer-modified-p nil))))
(defvar cperl-d-l nil) (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") (let ((dbg (point)) (iend end) (istate (car cperl-syntax-state)) start) (and cperl-syntaxify-unwind (setq end (cperl-unwind-to-safe t end))) (setq start (point)) (or cperl-syntax-done-to (setq cperl-syntax-done-to (point-min))) (if (or (not (boundp 'font-lock-hot-pass)) (eval 'font-lock-hot-pass) t) ; Not debugged otherwise ;; Need to forget what is after `start' (setq start (min cperl-syntax-done-to start)) ;; Fontification without a change (setq start (max cperl-syntax-done-to start))) (and (> end start) (setq cperl-syntax-done-to start) ; In case what follows fails (cperl-find-pods-heres start end t nil t)) (if (eq cperl-syntaxify-by-font-lock 'message) (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" dbg iend start end cperl-syntax-done-to istate (car cperl-syntax-state))) ; For debugging nil)) ; Do not iterate
(defun cperl-fontify-update (end) (let ((pos (point)) prop posend) (while (< pos end) (setq prop (get-text-property pos 'cperl-postpone)) (setq posend (next-single-property-change pos 'cperl-postpone nil end)) (and prop (put-text-property pos posend (car prop) (cdr prop))) (setq pos posend))) nil) ; Do not iterate
(defun cperl-update-syntaxification (from to) (if (and cperl-use-syntax-table-text-property cperl-syntaxify-by-font-lock (or (null cperl-syntax-done-to) (< cperl-syntax-done-to to))) (progn (save-excursion (goto-char from) (cperl-fontify-syntaxically to)))))
(defvar cperl-version (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)
;;; cperl-mode.el ends here
1 POD Error
The following errors were encountered while parsing the POD:
=pod directives shouldn't be over one line long! Ignoring all 2 lines of content
To install Env, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Env
CPAN shell
perl -MCPAN -e shell install Env
For more information on module installation, please visit the detailed CPAN module installation guide.