prove.el

   1 ;;; prove.el --- Compilation mode for prove
   2
   3 ;; Copyright (C) 2008 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6 ;; Version: 0.2
   7
   8 ;; This file is not currently part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program ; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; (require 'prove)
  28 ;; M-x prove
  29
  30 ;; Errors are foldable, you can toggle their visibility by putting
  31 ;; point on an error line and hitting tab. If you want folding
  32 ;; everytime set `prove-collapse-tree-on-finish' to non-nil.
  33
  34 ;; If you use prove rather than perl to run the tests then make sure
  35 ;; you include the -v switch.
  36
  37 (require 'compile)
  38
  39 (defvar prove-mode-command "prove -v "
  40   "The command to offer by default when running `prove'.")
  41 (defvar prove-mode-history nil
  42   "The previously run proves.")
  43 (defvar prove-collapse-tree-on-finish nil
  44   "Collapse the tests when compilation has finished")
  45
  46 (defvar prove-mode-hook nil
  47   "Hook run when prove mode starts")
  48
  49 (add-to-list 'compilation-finish-functions 'prove-compile-finish)
  50
  51 ;; ok, not ok faces
  52 (copy-face 'font-lock-warning-face 'prove-mode-not-ok-face)
  53 (copy-face 'font-lock-keyword-face 'prove-mode-ok-face)
  54 (set-face-attribute 'prove-mode-ok-face nil
  55                     :foreground "LightGreen")
  56 (set-face-attribute 'prove-mode-not-ok-face nil
  57                     :foreground "IndianRed3")
  58
  59 ;; 2nd or 3rd last line (describing the overall failure)
  60 (copy-face 'prove-mode-ok-face 'prove-mode-overall-success-face)
  61 (copy-face 'prove-mode-not-ok-face 'prove-mode-overall-failure-face)
  62 (set-face-attribute 'prove-mode-overall-success-face nil
  63                     :foreground "Green")
  64 (set-face-attribute 'prove-mode-overall-failure-face nil
  65                     :foreground "Red")
  66
  67 ;; test count
  68 (copy-face 'prove-mode-not-ok-face 'prove-mode-test-count-face)
  69 (set-face-attribute 'prove-mode-test-count-face nil
  70                     :foreground "Yellow")
  71
  72 (defvar prove-mode-font-lock-keywords
  73   '(("^\\(not ok\\) \\([[:digit:]]+\\)" . 'prove-mode-not-ok-face)
  74     ("^#.+$" . 'font-lock-comment-face)
  75     ("^ok \\([[:digit:]]+\\)" . 'prove-mode-ok-face)
  76     ("^All tests successful." . 'prove-mode-overall-success-face)
  77     ("^Failed [[:digit:]]+/[[:digit:]]+ test scripts"
  78      . 'prove-mode-overall-failure-face)
  79     ("^[[:digit:]]+\\.\\{2\\}[[:digit:]]+$"
  80      . 'prove-mode-test-count-face)
  81     ("^ok$" . 'prove-mode-overall-success-face)
  82     ("^dubious$" . 'prove-mode-overall-failure-face)
  83     ;; this is for the running of prove without -v
  84     ("\\.\\{2,\\} \\(ok\\)$" 1 'prove-mode-ok-face))
  85   "Faces for prove-mode.")
  86
  87 (defvar prove-mode-error-regexps
  88   (list
  89    (list (concat "#[[:blank:]]+\\(?:at\\|in\\) \\(.+?\\) "
  90                  "\\(?:at\\)? line \\([[:digit:]]+\\)") 1 2)
  91    (list ".+at \\(.+?\\) line \\([[:digit:]]+\\)" 1 2))
  92   "Hyperlink and highlight anything matching these.")
  93
  94 (define-compilation-mode prove-mode "Prove"
  95   "Prove compilation mode."
  96   (set (make-local-variable 'outline-regexp)
  97        (concat "^\\(\\(?:not \\)?ok [[:digit:]]+\\|"
  98                "[[:blank:]]Test returned status\\|"
  99                "All tests successful."
 100                "\\).*"))
 101   (set (make-local-variable 'outline-level) (lambda () 1))
 102   (set (make-local-variable 'compilation-error-regexp-alist)
 103        prove-mode-error-regexps)
 104   (set (make-local-variable 'compilation-scroll-output) t)
 105   (set (make-local-variable 'compilation-mode-font-lock-keywords)
 106        prove-mode-font-lock-keywords)
 107   (local-set-key (kbd "r") 'prove-rename-buffer)
 108   (local-set-key (kbd "k") 'prove-get-testname)
 109   (local-set-key (kbd "<tab>") 'prove-toggle-headline)
 110   (outline-minor-mode))
 111
 112 (defun prove-toggle-headline ()
 113   "Toggle the visibility of a test."
 114   (interactive)
 115   (unless (looking-at outline-regexp)
 116     (outline-previous-heading))
 117   (if (get-char-property (point-at-eol) 'invisible)
 118       (show-subtree)
 119       (hide-subtree)))
 120
 121 (defun prove-compile-finish (buf status)
 122   "Hide all headline bodies."
 123   (when (and (string= mode-name "Prove")
 124              prove-collapse-tree-on-finish)
 125     (hide-body)
 126     (outline-previous-heading)
 127     (show-subtree)))
 128
 129 (defun prove-rename-buffer ()
 130   "Simply, rename the current prove buffer to describe the
 131 command (and uniquify)."
 132   (interactive)
 133   (rename-buffer
 134    (concat "*"  prove-mode-command " in " default-directory "*") t))
 135
 136 (defun prove-build-command ()
 137   "Construct a command to offer the user when `prove' is run. See
 138   `prove-mode-command'."
 139   prove-mode-command)
 140
 141 (easy-mmode-defmap prove-minibuffer-local-map
 142   '(("\C-i" . comint-dynamic-complete-filename))
 143   "Keymap for minibuffer prompting of prove startup command."
 144   :inherit minibuffer-local-map)
 145
 146 (defun prove-get-testname ()
 147   "Search for the last (closed) test filename and put it into the
 148 kill ring."
 149   (interactive)
 150   (save-excursion
 151     (re-search-backward "^\\(t/[[:digit:]].+?\\)\\.\\{4\\}")
 152     (kill-new (match-string 1))
 153     (message (match-string 1))))
 154
 155 (defun prove (command-args)
 156   "Run prove (or perl) and highlight and linkify the resulting
 157 tap."
 158   (interactive
 159    (list (read-from-minibuffer "Run perl/prove (like this): "
 160                                (prove-build-command)
 161                                prove-minibuffer-local-map
 162                                nil
 163                                'prove-mode-history)))
 164   (compilation-start command-args 'prove-mode)
 165   (run-mode-hooks 'prove-mode-hook))
 166
 167 (provide 'prove)