Find file
Fetching contributors…
Cannot retrieve contributors at this time
327 lines (274 sloc) 9.79 KB
;;; midje-mode.el --- Minor mode for Midje tests
;; Version: 0.1
;; This is a minor mode designed to be used with clojure-mode.el and slime.el
;; Usage:
;; (require 'midje-mode)
;; (require 'clojure-jump-to-file)
;;; Code:
(require 'clojure-mode)
(require 'slime)
(require 'newcomment)
(require 'midje-mode-praise)
(defvar midje-running-fact nil) ;; KLUDGE!
(defvar midje-comments ";.;.")
(defvar last-checked-midje-fact nil)
(defvar midje-fact-regexp "^(facts?\\([[:space:]]\\|$\\)")
(defvar midje-syntax-table nil)
;; Callbacks
(defun midje-insert-above-fact (result)
(if (bolp) (forward-char)) ; at first character of defun, beginning-of-defun moves back.
(midje-provide-result-info result))
(defun midje-insert-below-code-under-test (result)
(midje-provide-result-info result))
;; Util
(defun midje-at-start-of-identifier? ()
(not (string= (string (char-syntax (char-before))) "w")))
(defun midje-identifier ()
"Return text of nearest identifier."
(when (not midje-syntax-table)
(setq midje-syntax-table (make-syntax-table (syntax-table)))
(modify-syntax-entry ?- "w" midje-syntax-table)
(modify-syntax-entry ?? "w" midje-syntax-table)
(modify-syntax-entry ?! "w" midje-syntax-table))
(with-syntax-table midje-syntax-table
(let ((beg (if (midje-at-start-of-identifier?)
(progn (backward-word) (point)))))
(buffer-substring-no-properties beg (point))))))
(defun midje-to-unfinished ()
(goto-char (point-min))
(search-forward-regexp "(\\(.*/\\)?unfinished"))
(defun midje-within-unfinished? ()
(let ((target (point))
(setq unfinished-beg (point))
(setq unfinished-end (point))
(and (>= target unfinished-beg)
(<= target unfinished-end))))))
(defun midje-tidy-unfinished ()
(midje-to-unfinished) (let ((fill-prefix "")) (fill-paragraph nil))
(let ((beg (point)))
(indent-region beg (point))))
(defun midje-eval-unfinished ()
(defun midje-add-identifier-to-unfinished-list (identifier)
(midje-to-unfinished) (insert " ") (insert identifier)
(defun midje-remove-identifier-from-unfinished-list ()
(let ((identifier (midje-identifier)))
(with-syntax-table midje-syntax-table
(unless (midje-at-start-of-identifier?) (backward-word))
(kill-word nil)
(defun midje-add-defn-after-unfinished (identifier)
(insert "(defn ")
(insert identifier)
(insert " [])")
(insert "(fact \"\")")
(search-backward "[]")
(defun midje-provide-result-info (result)
(destructuring-bind (output value) result
(if (string= output "")
(midje-insert-failure-message output))))
(defun midje-insert-failure-message (str &optional justify)
(let ((start-point (point))
(end-point (progn (insert str) (point))))
(midje-add-midje-comments start-point end-point)
(goto-char start-point)
(unless (string= ";" (char-to-string (char-after)))
(delete-char 1))))
(defun midje-display-reward ()
(let ((start (point)))
(insert (midje-random-praise))
(narrow-to-region start (point))
(goto-char (point-min))
(fill-paragraph nil)
(midje-add-midje-comments (point-min) (point-max))))))
(defun midje-add-midje-comments (start-point end-point)
(let ((comment-start midje-comments)
(comment-empty-lines t))
(comment-region start-point end-point)))
(defun midje-on-fact? ()
(goto-char (point-min))
(search-forward "fact" nil t))))
(defun midje-doto-facts (fun)
(goto-char (point-min))
(while (re-search-forward midje-fact-regexp nil t)
(funcall fun))))
(add-hook 'midje-mode-hook 'midje-colorize)
(defun midje-colorize ()
(flet ((f (keywords face)
(cons (concat "\\<\\("
(mapconcat 'symbol-name keywords "\\|")
(list (f '(fact facts future-fact future-facts tabular provided)
(f '(just contains has has-suffix has-prefix
truthy falsey anything exactly roughly throws)
'("=>\\|=not=>" . font-lock-negation-char-face) ; arrows
'("\\<\\.+[a-zA-z]+\\.+\\>" . 'font-lock-type-face))))) ; metaconstants
;; Interactive
(defun midje-next-fact ()
(re-search-forward midje-fact-regexp))
(defun midje-previous-fact ()
(re-search-backward midje-fact-regexp))
(defun midje-clear-comments ()
"Midje uses comments to display test results. Delete
all such comments."
(goto-char (point-min))
(let ((kill-whole-line t))
(while (search-forward midje-comments nil t)
(defun midje-check-fact-near-point ()
"Used when `point' is on or just after a Midje fact.
Check that fact and also save it for use of
(let ((string (save-excursion
(buffer-substring-no-properties (mark) (point)))))
(setq last-checked-midje-fact string)
(slime-eval-async `(swank:eval-and-grab-output ,string)
(defun midje-recheck-last-fact-checked ()
"Used when `point` is on or just after a def* form.
Has the Clojure REPL compile that form, then rechecks
the last fact checked (by `midje-check-fact-near-point')."
(setq midje-running-fact t)
; Callback is slime-compilation-finished, then midje-after-compilation-check-fact
;; This is a HACK. I want to add midje-after-compilation-check-fact to
;; the slime-compilation-finished-hook, but I can't seem to override the
;; :options declaration in the original slime.el defcustom.
(unless (fboundp 'original-slime-compilation-finished)
(setf (symbol-function 'original-slime-compilation-finished)
(symbol-function 'slime-compilation-finished)))
(defun slime-compilation-finished (result)
(original-slime-compilation-finished result)
(with-struct (slime-compilation-result. notes duration successp) result
(if successp (midje-after-compilation-check-fact))))
(defun midje-after-compilation-check-fact ()
(if midje-running-fact
(slime-eval-async `(swank:eval-and-grab-output ,last-checked-midje-fact)
(setq midje-running-fact nil))
(defun midje-check-fact ()
"If on or near a Midje fact, check it with
`midje-check-fact-near-point'. Otherwise, compile the
nearby Clojure form and recheck the last fact checked
(with `midje-recheck-last-fact-checked')."
(if (midje-on-fact?)
(defun midje-hide-all-facts ()
(midje-doto-facts #'hs-hide-block))
(defun midje-show-all-facts ()
(midje-doto-facts #'hs-show-block))
(defun midje-focus-on-this-fact ()
(defun midje-unfinished ()
(if (midje-within-unfinished?)
(midje-add-defn-after-unfinished (midje-remove-identifier-from-unfinished-list))
(midje-add-identifier-to-unfinished-list (midje-identifier))))
(defvar midje-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c ,") 'midje-check-fact)
(define-key map (kbd "C-c .") 'midje-check-fact)
(define-key map (kbd "C-c C-,") 'midje-check-fact-near-point)
(define-key map (kbd "C-c C-.") 'midje-recheck-last-fact-checked)
(define-key map (kbd "C-c k") 'midje-clear-comments)
(define-key map (kbd "C-c f") 'midje-focus-on-this-fact)
(define-key map (kbd "C-c h") 'midje-hide-all-facts)
(define-key map (kbd "C-c s") 'midje-show-all-facts)
(define-key map (kbd "C-c n") 'midje-next-fact)
(define-key map (kbd "C-c p") 'midje-previous-fact)
(define-key map (kbd "C-c u") 'midje-unfinished)
"Keymap for Midje mode.")
(define-minor-mode midje-mode
"A minor mode for running Midje tests when in `slime-mode'.
nil " Midje" midje-mode-map
;; This doesn't seem to work.
;; (custom-add-option 'slime-compilation-finished-hook
;; 'midje-post-compilation-action)
(hs-minor-mode 1))
(defun midje-mode-maybe-enable ()
"Enable midje-mode if the current buffer contains a \"midje.\" string."
(let ((regexp "midje\\."))
(when (or (re-search-backward regexp nil t)
(re-search-forward regexp nil t))
(midje-mode t)))))
(add-hook 'clojure-mode-hook 'midje-mode-maybe-enable))
(eval-after-load 'clojure-mode
(fact 'defun)
(facts 'defun)
(against-background 'defun)
(provided 0)))
(provide 'midje-mode)
;;; midje-mode.el ends here