Chip Salzenberg > perl5.004 > emacs/cperl-mode.el


Annotate this POD

Source   Latest Release: perl-5.12.5

Top-level heading. =head2 Second-level heading. =head3 Third-level heading (is there such?). =over [ NUMBER ] Start list. =item [ TITLE ] Start new item in the list. =back End list. ^

(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) ;; b is before the starting delimiter, e before the ending ;; e should be a marker, may be changed, but remains "correct". (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline) (if (not embed) (goto-char (1+ b)) (goto-char b) (cond ((looking-at "(\\?\\\\#") ; badly commented (?#) (forward-char 2) (delete-char 1) (forward-char 1)) ((looking-at "(\\?[^a-zA-Z]") (forward-char 3)) ((looking-at "(\\?") ; (?i) (forward-char 2)) (t (forward-char 1)))) (setq c (1- (current-column)) c1 (+ c (or cperl-regexp-indent-step cperl-indent-level))) (or (looking-at "[ \t]*[\n#]") (progn (insert "\n"))) (goto-char e) (beginning-of-line) (if (re-search-forward "[^ \t]" e t) (progn (goto-char e) (insert "\n") (indent-to-column c) (set-marker e (point)))) (goto-char b) (end-of-line 2) (while (< (point) (marker-position e)) (beginning-of-line) (setq s (point) inline t) (skip-chars-forward " \t") (delete-region s (point)) (indent-to-column c1) (while (and inline (looking-at (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 "\\|" "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3 "\\|" "[$^]" "\\|" "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5 "\\|" "\\(\\[\\)" ; 6 "\\|" "\\((\\(\\?\\)?\\)" ; 7 8 "\\|" "\\(|\\)" ; 9 ))) (goto-char (match-end 0)) (setq spaces t) (cond ((match-beginning 1) ; Alphanum word + junk (forward-char -1)) ((or (match-beginning 3) ; $ab[12] (and (match-beginning 5) ; X* X+ X{2,3} (eq (preceding-char) ?\{))) (forward-char -1) (forward-sexp 1)) ((match-beginning 6) ; [] (setq tmp (point)) (if (looking-at "\\^?\\]") (goto-char (match-end 0))) (or (re-search-forward "\\]\\([*+{?]\\)?" e t) (progn (goto-char (1- tmp)) (error "[]-group not terminated"))) (if (not (eq (preceding-char) ?\{)) nil (forward-char -1) (forward-sexp 1))) ((match-beginning 7) ; () (goto-char (match-beginning 0)) (or (eq (current-column) c1) (progn (insert "\n") (indent-to-column c1))) (setq tmp (point)) (forward-sexp 1) ;; (or (forward-sexp 1) ;; (progn ;; (goto-char tmp) ;; (error "()-group not terminated"))) (set-marker m (1- (point))) (set-marker m1 (point)) (cperl-beautify-regexp-piece tmp m t) (goto-char m1) (cond ((looking-at "[*+?]\\??") (goto-char (match-end 0))) ((eq (following-char) ?\{) (forward-sexp 1) (if (eq (following-char) ?\?) (forward-char)))) (skip-chars-forward " \t") (setq spaces nil) (if (looking-at "[#\n]") (beginning-of-line 2) (insert "\n")) (end-of-line) (setq inline nil)) ((match-beginning 9) ; | (forward-char -1) (setq tmp (point)) (beginning-of-line) (if (re-search-forward "[^ \t]" tmp t) (progn (goto-char tmp) (insert "\n")) ;; first at line (delete-region (point) tmp)) (indent-to-column c) (forward-char 1) (skip-chars-forward " \t") (setq spaces nil) (if (looking-at "[#\n]") (beginning-of-line 2) (insert "\n")) (end-of-line) (setq inline nil))) (or (looking-at "[ \t\n]") (not spaces) (insert " ")) (skip-chars-forward " \t")) (or (looking-at "[#\n]") (error "unknown code in a regexp")) (and inline (end-of-line 2))) ))

(defun cperl-beautify-regexp () "do it. (Experimental, may change semantics, recheck afterwards.) We suppose that the regexp is scanned already." (interactive) (or cperl-use-syntax-table-text-property (error "I need to have regex marked!")) ;; Find the start (re-search-backward "\\s|") ; Assume it is scanned already. ;;(forward-char 1) (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) (sub-p (eq (preceding-char) ?s)) s) (forward-sexp 1) (set-marker e (1- (point))) (setq delim (preceding-char)) (if (and sub-p (eq delim (char-after (- (point) 2)))) (error "Possible s/blah// - do not know how to deal with")) (if sub-p (forward-sexp 1)) (if (looking-at "\\sw*x") (setq have-x t) (insert "x")) ;; Protect fragile " ", "#" (if have-x nil (goto-char (1+ b)) (while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too? (forward-char -1) (insert "\\") (forward-char 1))) (cperl-beautify-regexp-piece b e nil)))

(if (fboundp 'run-with-idle-timer) (progn (defvar cperl-help-shown nil "Non-nil means that the help was already shown now.")

      (defvar cperl-lazy-installed nil
        "Non-nil means that the lazy-help handlers are installed now.")

      (defun cperl-lazy-install ()
        (make-variable-buffer-local 'cperl-help-shown)
        (if (and (cperl-val 'cperl-lazy-help-time)
                 (not cperl-lazy-installed))
              (add-hook 'post-command-hook 'cperl-lazy-hook)
               (cperl-val 'cperl-lazy-help-time 1000000 5) 
              (setq cperl-lazy-installed t))))

      (defun cperl-lazy-unstall ()
        (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 (eq major-mode 'perl-mode)) nil
          (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
            (setq cperl-help-shown t))))

(provide 'cperl-mode)

syntax highlighting: