clojure-lazytest-mode.el

;; Tom Crayford adapted this from clojure-test-mode.el
(require 'clojure-mode)
(require 'cl)
(require 'slime)
(require 'swank-clojure)
(require 'which-func)


;; Faces

(defface clojure-lazytest-failure-face
  '((((class color) (background light))
     :background "orange red")
    (((class color) (background dark))
     :background "firebrick"))
  "Face for failures in Clojure tests."
  :group 'clojure-lazytest-mode)

(defface clojure-lazytest-error-face
  '((((class color) (background light))
     :background "orange1")
    (((class color) (background dark))
     :background "orange4"))
  "Face for errors in Clojure tests."
  :group 'clojure-lazytest-mode)

(defun clojure-lazytest-eval (string &optional handler)
  (slime-eval-async `(swank:eval-and-grab-output ,string)
                    (or handler #'identity)))

(defun clojure-lazytest-eval-sync (string)
  (slime-eval `(swank:eval-and-grab-output ,string)))

(defun clojure-lazytest-load-reporting ()
  "Defines a report function that outputs an a-list for each result"
  (interactive)
  (clojure-lazytest-eval-sync
   "(require 'lazytest.report) (in-ns 'lazytest.report)
        (defn elisp-result [r]
          (cond (pending? r) :pending
                (success? r) :success
                (error? r) :error
                :else :fail))
        (defn elisp-report [r]
          `((:result ~(elisp-result r))
           (:line ~(:line (details r)))
           (:expr ~(:expr (details r)))))"))

(defun clojure-lazytest-get-results ()
  (read
   (car
    (cdr
     (clojure-lazytest-eval-sync
      (format
       "(remove-ns '%s)
        (require '%s :reload)
        (lazytest.color/set-colorize false)
        (let [current-results (lazytest.run/run (lazytest.plan/default-plan))]
           (cons
                 (with-out-str
                    (lazytest.report/print-summary
                       current-results))
              (map lazytest.report/elisp-report
                   (remove lazytest.results/success? current-results))))"
       (slime-current-package)
       (slime-current-package)))))))

(defun clojure-lazytest-message-results ()
  (interactive)
  (message "%s" (clojure-lazytest-get-results)))

(defun clojure-lazytest-run ()
  (interactive)
  (let ((results (clojure-lazytest-get-results)))
    (clojure-lazytest-clear)
   (clojure-lazytest-highlight-problems
    (cdr results))
   (message "%s" (car results))))

(defun clojure-lazytest-highlight-problems (swank-output)
  (dolist (problem swank-output)
    (apply #'clojure-lazytest-highlight-problem
           (mapcar (lambda (x) (cadr x)) problem))))

(defun clojure-lazytest-highlight-problem (event line expr)
  (let ((expr (format "%s" expr)))
   (save-excursion
     (goto-line line)
     (progn
       (let ((beg (point)))
         (end-of-line)
         (let ((overlay (make-overlay beg (point))))
           (overlay-put overlay 'face
                        (if (equal event :fail)
                            'clojure-lazytest-failure-face
                          'clojure-lazytest-error-face))
           (overlay-put overlay 'message expr)))))))

(defun clojure-lazytest-clear ()
  "Remove overlays and clear stored results."
  (interactive)
  (remove-overlays))

(defun clojure-lazytest-show-result ()
  "Show the result of the test under point."
  (interactive)
  (let ((overlay (find-if (lambda (o) (overlay-get o 'message))
                          (overlays-at (point)))))
    (if overlay
        (message (replace-regexp-in-string "%" "%%"
                                           (overlay-get overlay 'message))))))

(defvar clojure-lazytest-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-/") 'clojure-lazytest-run)
    (define-key map (kbd "C-c C-u") 'clojure-lazytest-show-result)
    map)
  "Keymap for Clojure lazytest mode.")

;;;###autoload
(define-minor-mode clojure-lazytest-mode
  "A minor mode for running Clojure lazytests"
  nil " Test" clojure-lazytest-mode-map
  (when (slime-connected-p)
    (run-hooks 'slime-connected-hook)))

;;;###autoload
(progn
  (defun clojure-lazytest-maybe-enable ()
    "Enable clojure-lazytest-mode if the current buffer contains Clojure tests.
Also will enable it if the file is in a test directory."
    (save-excursion
      (save-window-excursion
        (goto-char (point-min))
        (when (search-forward "lazytest" nil t)
            (clojure-lazytest-mode t)))))
  (add-hook 'clojure-mode-hook 'clojure-lazytest-maybe-enable))

(provide 'clojure-lazytest-mode)