(require 'cperl-mode)

(defvar cperl-block-symbols '("else" "do" "eval"))

(defun block-symbol-regexp ()
  (format "%s *"
          (regexp-opt cperl-block-symbols)))


(define-key cperl-mode-map (kbd "{")
  (lambda ()
    (interactive)
    (if mark-active
        (call-interactively 'smart-brace-region)
      (call-interactively 'insert-smart-open-brace))))

(defun insert-smart-open-brace ()
  (interactive)
  (cond ((or (looking-back "^[ 	]*sub .*")
             (zerop (current-column)))
         (end-of-line)
         (newline-and-indent)
         (insert "{")
         (indent-according-to-mode)
         (newline-and-indent))
        ((or (looking-back ") ?")
             (looking-back (block-symbol-regexp)))
         (end-of-line)
         (just-one-space)
         (insert "{")
         (newline-and-indent))
        (t (insert "{"))))



(define-key cperl-mode-map (kbd "}") 'insert-smart-close-brace)


(defun smart-brace-region (beg end)
  (interactive "r")
  (let ((open (save-excursion
                (goto-char beg)
                (point-marker)))
        (close (save-excursion
                 (goto-char end)
                 (point-marker))))
    (save-excursion
      (goto-char (marker-position open))
      (insert-smart-open-brace)
      (delete-blank-lines)
      (goto-char (marker-position close))
      (insert-smart-close-brace)
      (backward-list)
      (cperl-indent-exp))))

(defun insert-smart-close-brace ()
  (interactive)
  (cond ((save-excursion
           (backward-up-list)
           (or (and (looking-back "^ *")
                    (looking-at "{$"))
               (looking-back ") *")
               (looking-back (block-symbol-regexp))))
         (end-of-line)
         (delete-blank-lines)
         (unless (looking-at "^[ 	]*$")
           (newline))
         (insert "}")
         (indent-according-to-mode)
         (delete-horizontal-space)
         (newline)
         (backward-char 1))
        (t
         (unless (ignore-errors (save-excursion
                                  (beginning-of-defun)
                                  (forward-list)
                                  t))
           (insert "}")))))


(define-skeleton cperl-insert-args
  "Insert an arglist-style expression"
  nil
  > "my (" _ ") = @_;")

(define-key cperl-mode-map (kbd "C-\\")
  (lambda ()
    (interactive)
    (cond ((save-excursion
             (beginning-of-line)
             (looking-at ".*@_;"))
           (end-of-line)
           (dotimes (i 2) (newline-and-indent)))
          (t (call-interactively 'cperl-insert-args)))))

(defun split-string-at-point ()
  (interactive)
  (insert "\" .\"")
  (backward-char)
  (newline-and-indent))

(define-key cperl-mode-map (kbd "C-c C-s")
  'split-string-at-point)

(provide 'perl-braces)